only typecheck left

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))))]
+                        (closureV-env lam-val))))]))
-    [(listE lst) (listV (map (lambda (x) (interp x env)) lst))])) ;; TODO COME BACK TO
+
+(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)))]
+    [(guessTE)(varT (gen-tvar-id!) (box (none)))]
-    [(listTE e) .... ]))
+    [(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)))))
+