X-Git-Url: http://git.lukelau.me/?p=scheme.git;a=blobdiff_plain;f=typecheck.scm;h=7eb4fa96606d786b5e58d17f2d2601f4f52c85a3;hp=197798e104a7595f5637646cb102f2d9d99f44d5;hb=91145e54f41ee88f1e279a80430b3f5ed4e7a8c6;hpb=31e29e5a1880862f7786abd7f1df911f5acf651d

diff --git a/typecheck.scm b/typecheck.scm
index 197798e..7eb4fa9 100644
--- a/typecheck.scm
+++ b/typecheck.scm
@@ -10,6 +10,7 @@
   (case t
     ('int #t)
     ('bool #t)
+    ('void #t)
     (else #f)))
 
 (define (pretty-type t)
@@ -46,7 +47,6 @@
       (car xs)
       (last (cdr xs))))
 				
-					
 (define (normalize prog) ; (+ a b) -> ((+ a) b)
   (case (ast-type prog)
     ('lambda 
@@ -60,17 +60,12 @@
 	 `(,(normalize (car prog)) ,(normalize (cadr prog))) ; (f a)
 	 `(,(list (normalize (car prog)) (normalize (cadr prog)))
 	   ,(normalize (caddr prog))))) ; (f a b)
-    ;; (list (list (normalize (car prog))
-    ;; 	    (normalize (cadr prog))) (normalize (caddr prog))))) ; (f a b)
     ('let
 	(append (list 'let
 		      (map (lambda (x) `(,(car x) ,(normalize (cadr x))))
 			   (let-bindings prog)))
 		(map normalize (let-body prog))))
-    ('if `(if ,(normalize (cadr prog))
-	      ,(normalize (caddr prog))
-	      ,(normalize (cadddr prog))))
-    (else prog)))
+    (else (ast-traverse normalize prog))))
 
 (define (builtin-type x)
   (case x
@@ -80,6 +75,7 @@
     ('! '(abs bool bool))
     ('= '(abs int (abs int bool)))
     ('bool->int '(abs bool int))
+    ('print '(abs string void))
     (else #f)))
 
 ; we typecheck the lambda calculus only (only single arg lambdas)
@@ -95,6 +91,7 @@
 	  (case (ast-type x)
 	   ('int-literal (list '() 'int))
 	   ('bool-literal (list '() 'bool))
+	   ('string-literal (list '() 'string))
 	   ('builtin (list '() (builtin-type x)))
 
 	   ('if