diff --git a/Assignments/03.rkt b/Assignments/03.rkt index f2f7093..389e18c 100644 --- a/Assignments/03.rkt +++ b/Assignments/03.rkt @@ -35,7 +35,6 @@ [listT (element : Type)] ;; New [varT (id : Number) (val : (Boxof (Optionof Type)))]) - (define-type ValueEnv [EmptyValueEnv] [BindValue (name : Symbol) @@ -68,6 +67,7 @@ [(plusE l r) (num+ (interp l env) (interp r env))] [(minusE l r) (num- (interp l env) (interp r env))] [(timesE l r) (num* (interp l env) (interp r env))] + [(listE elements) (listV (map (lambda (x) (interp x env)) elements))] [(idE name) (lookup name env)] [(if0E test then-part else-part) (if (numzero? (interp test env)) @@ -89,8 +89,13 @@ (interp (closureV-body lam-val) (BindValue (closureV-param lam-val) arg-val - (closureV-env lam-val))))] - [(listE lst) (listV (map (lambda (x) (interp x env)) lst))])) ;; TODO COME BACK TO + (closureV-env lam-val))))])) + +(define (run s-expr) + (interp (parse s-expr) (EmptyValueEnv))) + +(define (check s-expr) + (typecheck (parse s-expr) (EmptyTypeEnv))) (define (lookup name env) (type-case ValueEnv env @@ -120,6 +125,8 @@ [(true) (boolE #t)] [(false) (boolE #f)] [else (idE sym)]))] + [(s-exp-match? `(list ANY ...) sx) + (listE (map (lambda (elt) (parse elt)) (rest (s-exp->list sx))))] [(s-exp-match? `(lam (SYMBOL : ANY) ANY) sx) (let* ([args (sx-ref sx 1)] [id (s-exp->symbol (sx-ref args 0))] @@ -154,7 +161,9 @@ [(bool) (boolTE)] [(?) (guessTE)])] [(s-exp-match? `(ANY -> ANY) sx) - (arrowTE (parse-te (sx-ref sx 0)) (parse-te (sx-ref sx 2)))])) + (arrowTE (parse-te (sx-ref sx 0)) (parse-te (sx-ref sx 2)))] + [(s-exp-match? `(listof ANY) sx) + (listTE (parse-te (sx-ref sx 1)))])) (module+ test (define fact-rec @@ -234,8 +243,8 @@ [(boolTE) (boolT)] [(arrowTE a b) (arrowT (parse-type a) (parse-type b))] - [(guessTE) (varT (gen-tvar-id!) (box (none)))] - [(listTE e) .... ])) + [(guessTE)(varT (gen-tvar-id!) (box (none)))] + [(listTE element-te) (listT (parse-type element-te))])) (define (type-lookup name-to-find env) (type-case TypeEnv env [(EmptyTypeEnv ) (error 'type-lookup "free variable, so no type")] @@ -317,18 +326,24 @@ [(varT id2 is2) (unify-type-var! t2 t1 expr)] [(numT) (unify-assert! t1 (numT) expr)] [(boolT) (unify-assert! t1 (boolT) expr)] + [(listT element-type) + (type-case Type t1 + [(listT other-element-type) (unify! element-type other-element-type expr)] + [else (type-error expr t1 t2)])] [(arrowT a2 b2) (type-case Type t1 [(arrowT a1 b1) (begin (unify! a1 a2 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)])])])) +(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")) + (define (typecheck [exp : Exp] [env : TypeEnv]) : Type (type-case Exp exp [(numE n) (numT)] @@ -375,15 +390,12 @@ (let* ([arg-type (parse-type te)] [res-type (typecheck body (BindType name arg-type env))]) (arrowT arg-type res-type))] - [(listE list) .... ] + [(listE elements) (begin + (define type-list (map (lambda (x) (typecheck x env)) elements)) + + (listT )] )) - ;; ---------------------------------------- -(define (run s-expr) - (interp (parse s-expr) (EmptyValueEnv))) - -(define (check s-expr) - (typecheck (parse s-expr) (EmptyTypeEnv))) (define-syntax-rule (test/type expr type) (test @@ -422,6 +434,10 @@ (numV 3)) ) +(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 (print-only-errors #t) @@ -532,20 +548,6 @@ #;(test/exn (typecheck (recE 'f (arrowTE (numTE) (numTE)) (idE 'f) (appE (idE 'f) (numE 10))) (EmptyTypeEnv)) "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))) @@ -572,3 +574,14 @@ ;; infer type of list from function application (test/type `{{lam {x : ?} {list x}} 2} (listT (numT))) ) + +(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))))) +