wip
This commit is contained in:
parent
1432f7fb4b
commit
232bd43a7d
@ -89,7 +89,8 @@
|
|||||||
(interp (closureV-body lam-val)
|
(interp (closureV-body lam-val)
|
||||||
(BindValue (closureV-param lam-val)
|
(BindValue (closureV-param lam-val)
|
||||||
arg-val
|
arg-val
|
||||||
(closureV-env lam-val))))]))
|
(closureV-env lam-val))))]
|
||||||
|
[(listE lst) (listV (map (lambda (x) (interp x env)) lst))])) ;; TODO COME BACK TO
|
||||||
|
|
||||||
(define (lookup name env)
|
(define (lookup name env)
|
||||||
(type-case ValueEnv env
|
(type-case ValueEnv env
|
||||||
@ -233,7 +234,8 @@
|
|||||||
[(boolTE) (boolT)]
|
[(boolTE) (boolT)]
|
||||||
[(arrowTE a b) (arrowT (parse-type a)
|
[(arrowTE a b) (arrowT (parse-type a)
|
||||||
(parse-type b))]
|
(parse-type b))]
|
||||||
[(guessTE) (varT (gen-tvar-id!) (box (none)))]))
|
[(guessTE) (varT (gen-tvar-id!) (box (none)))]
|
||||||
|
[(listTE e) .... ]))
|
||||||
(define (type-lookup name-to-find env)
|
(define (type-lookup name-to-find env)
|
||||||
(type-case TypeEnv env
|
(type-case TypeEnv env
|
||||||
[(EmptyTypeEnv ) (error 'type-lookup "free variable, so no type")]
|
[(EmptyTypeEnv ) (error 'type-lookup "free variable, so no type")]
|
||||||
@ -321,6 +323,10 @@
|
|||||||
(begin
|
(begin
|
||||||
(unify! a1 a2 expr)
|
(unify! a1 a2 expr)
|
||||||
(unify! b1 b2 expr))]
|
(unify! b1 b2 expr))]
|
||||||
|
[else (type-error expr t1 t2)])]
|
||||||
|
[(listT a2)
|
||||||
|
(type-case Type t1
|
||||||
|
[(listT a1) (unify! a1 a2 expr)]
|
||||||
[else (type-error expr t1 t2)])])]))
|
[else (type-error expr t1 t2)])])]))
|
||||||
|
|
||||||
(define (typecheck [exp : Exp] [env : TypeEnv]) : Type
|
(define (typecheck [exp : Exp] [env : TypeEnv]) : Type
|
||||||
@ -369,6 +375,7 @@
|
|||||||
(let* ([arg-type (parse-type te)]
|
(let* ([arg-type (parse-type te)]
|
||||||
[res-type (typecheck body (BindType name arg-type env))])
|
[res-type (typecheck body (BindType name arg-type env))])
|
||||||
(arrowT arg-type res-type))]
|
(arrowT arg-type res-type))]
|
||||||
|
[(listE list) .... ]
|
||||||
))
|
))
|
||||||
|
|
||||||
;; ----------------------------------------
|
;; ----------------------------------------
|
||||||
@ -525,3 +532,43 @@
|
|||||||
#;(test/exn (typecheck (recE 'f (arrowTE (numTE) (numTE)) (idE 'f) (appE (idE 'f) (numE 10)))
|
#;(test/exn (typecheck (recE 'f (arrowTE (numTE) (numTE)) (idE 'f) (appE (idE 'f) (numE 10)))
|
||||||
(EmptyTypeEnv))
|
(EmptyTypeEnv))
|
||||||
"no type"))
|
"no type"))
|
||||||
|
|
||||||
|
;; New list tests
|
||||||
|
;; ------------------------------------
|
||||||
|
|
||||||
|
(module+ test
|
||||||
|
(test (unify! (listT (boolT)) (listT (boolT)) 'test) (void))
|
||||||
|
(test/exn (unify! (listT (boolT)) (listT (numT)) 'test) "no type")
|
||||||
|
(test/exn (unify! (boolT) (listT (numT)) 'test) "no type")
|
||||||
|
(test/exn (unify! (listT (numT)) (boolT) 'test) "no type"))
|
||||||
|
|
||||||
|
(module+ test
|
||||||
|
(test (run `{list 1 2}) (listV (list (numV 1) (numV 2))))
|
||||||
|
(test (run `{list false true false}) (listV (list (boolV #f) (boolV #t) (boolV #f)))))
|
||||||
|
|
||||||
|
(module+ test
|
||||||
|
;; lists of numbers
|
||||||
|
(test/type `{list 1 2} (listT (numT)))
|
||||||
|
|
||||||
|
;; report error for mixed types
|
||||||
|
(test/notype `{list 1 true})
|
||||||
|
|
||||||
|
;; infer type of list
|
||||||
|
(test/type `{lam {x : num} {list x}} (arrowT (numT) (listT (numT))))
|
||||||
|
|
||||||
|
;; functions taking list parameters
|
||||||
|
(test/type `{lam {x : {listof num}} x}
|
||||||
|
(arrowT (listT (numT)) (listT (numT))))
|
||||||
|
|
||||||
|
;; report error for mixed inferred types
|
||||||
|
(test/notype `{lam {x : num} {list true x}})
|
||||||
|
|
||||||
|
;; infer type of function parameter from list element
|
||||||
|
(test/type `{lam {x : ?} {list x 1}} (arrowT (numT) (listT (numT))))
|
||||||
|
|
||||||
|
;; complain about cyclic type (Y-combinator) inside list
|
||||||
|
(test/notype `{lam {x : ?} {list {x x}}})
|
||||||
|
|
||||||
|
;; infer type of list from function application
|
||||||
|
(test/type `{{lam {x : ?} {list x}} 2} (listT (numT)))
|
||||||
|
)
|
||||||
|
Loading…
x
Reference in New Issue
Block a user