(module type-environments mzscheme
(provide (all-defined))
(require (planet "environment.ss" ("cobbe" "environment.plt" 3 0))
"tc-utils.ss"
"types-aux.ss" "types.ss"
"subst.ss"
(lib "list.ss"))
(define-syntax (define-tname-env stx)
(syntax-case stx ()
[(_ var [nm ty] ...)
#'(begin
(define-syntax nm (lambda (stx) (raise-syntax-error 'type-check "type name used out of context" stx))) ...
(define var
(list (list #'nm ty) ...)))]))
(define-tname-env initial-type-names
[atom A]
[Atom A]
[Void -Void]
[number N]
[Number N]
[boolean B]
[symbol Sym]
[Boolean B]
[Symbol Sym]
[str -String]
[String -String]
[Any Univ]
[top Univ]
[Port -Port]
[Path -Path]
[num-exp -NE]
[Char -Char]
[Option (-poly (a) (Un (make-value #f) a))]
[Sexp -Sexp]
[List (-lst Univ)]
[Listof -Listof]
[list-of -Listof]
[Namespace -Namespace]
)
(define initial-tvar-env
(symbol-env))
(define current-tvars (make-parameter initial-tvar-env))
(define (extend env k v) (extend-env (list k) (list v) env))
(define (extend/values kss vss env)
(foldr (lambda (ks vs env)
(cond [(and (list? ks) (list? vs))
(extend-env ks vs env)]
[(or (list? ks) (list? vs))
(tc-error "not both lists in extend/values")]
[else (extend-env (list ks) (list vs) env)]))
env kss vss))
(define (extend-multiple env ids types)
(extend-env ids types env))
)