(module types mzscheme
(require (lib "struct.ss")
(lib "match.ss")
(lib "list.ss")
(lib "trace.ss")
(all-except (lib "unit.ss") rename)
"planet-requires.ss"
"signatures.ss"
"effect-structs.ss"
"big-unit.ss"
"effects.ss")
(require (planet "environment.ss" ("cobbe" "environment.plt" 3 0)))
(require-libs)
(define-syntax ->
(syntax-rules (:)
[(_ dom ... rng)
(make-funty (list (make-arr* (list dom ...) rng)))]
[(_ dom ... rng : eff1 eff2)
(make-funty (list (make-arr* (list dom ...) rng #f eff1 eff2)))]))
(define-syntax ->*
(syntax-rules (:)
[(_ dom rng)
(make-funty (list (make-arr* dom rng)))]
[(_ dom rst rng)
(make-funty (list (make-arr* dom rng rst)))]
[(_ dom rng : eff1 eff2)
(make-funty (list (make-arr* dom rng #f eff1 eff2)))]
[(_ dom rst rng : eff1 eff2)
(make-funty (list (make-arr* dom rng rst eff1 eff2)))]))
(define-syntax cl->
(syntax-rules (:)
[(_ [(dom ...) rng] ...)
(make-funty (list (make-arr* (list dom ...) rng) ...))]
[(_ [(dom ...) rng : eff1 eff2] ...)
(make-funty (list (make-arr* (list dom ...) rng #f eff1 eff2) ...))]))
(provide-signature-elements type-printer^)
(provide-signature-elements effect-structs^)
(require "type-structs.ss")
(provide (all-defined)
(all-from-except "type-structs.ss" make-arr make-mu)
(rename make-arr* make-arr)
(rename make-mu* make-mu))
(define-syntax define/match
(syntax-rules ()
[(_ nm cl ...) (define nm (match-lambda* cl ...))]))
(define make-arr*
(case-lambda [(dom rng) (make-arr* dom rng #f (list) (list))]
[(dom rng rest) (make-arr dom rng rest (list) (list))]
[(dom rng rest eff1 eff2) (make-arr dom rng rest eff1 eff2)]))
(define (make-poly* tvars t)
(if (null? tvars) t (make-poly tvars t)))
(define (make-mu* v t)
(if (set:member? v (fv t)) (make-mu v t) t))
(define N (make-base-type 'Number))
(define B (make-base-type 'Boolean))
(define Sym (make-base-type 'Symbol))
(define -Void (make-base-type 'Void))
(define -Bytes (make-base-type 'Bytes))
(define -String (make-base-type 'String))
(define -Keyword (make-base-type 'Keyword))
(define -Char (make-base-type 'Char))
(define -Port (make-base-type 'Port))
(define -Syntax (make-base-type 'Syntax))
(define -Prompt-Tag (make-base-type 'Prompt-Tag))
(define -Cont-Mark-Set (make-base-type 'Continuation-Mark-Set))
(define -Path (make-base-type 'Path))
(define -Namespace (make-base-type 'Namespace))
(define -Output-Port (make-base-type 'Output-Port))
(define -Input-Port (make-base-type 'Input-Port))
(define Univ (make-univ))
(define Dyn (make-dynamic))
)