Add more binary ops

[scheme.git] / typecheck.scm

diff --git a/typecheck.scm b/typecheck.scm
index eaff75efbe6fdf313e0522216c5e07d2486c75ac..59e652ad9da26f36906a80964c9956179ecdad9f 100644 (file)
--- a/typecheck.scm
+++ b/typecheck.scm
@@ -43,6 +43,14 @@
            (map normalize (let-body prog))))
    (else prog)))
 
            (map normalize (let-body prog))))
    (else prog)))
 

+(define (builtin-type x)
+  (case x
+    ('+ '(abs int (abs int int)))
+    ('- '(abs int (abs int int)))
+    ('* '(abs int (abs int int)))
+    ('! '(abs bool bool))
+    ('bool->int '(abs bool int))
+    (else #f)))

 
 ; we typecheck the lambda calculus only (only single arg lambdas)
 (define (typecheck prog)
 
 ; we typecheck the lambda calculus only (only single arg lambdas)
 (define (typecheck prog)


@@ -57,10 +65,8 @@
          (cond
           ((integer? x) (list '() 'int))
           ((boolean? x) (list '() 'bool))
          (cond
           ((integer? x) (list '() 'int))
           ((boolean? x) (list '() 'bool))

-          ((eq? x 'inc) (list '() '(abs int int)))
-          ((eq? x '+)   (list '() '(abs int (abs int int))))
+          ((builtin-type x) (list '() (builtin-type x)))

           ((symbol? x)  (list '() (env-lookup env x)))
           ((symbol? x)  (list '() (env-lookup env x)))

-

           ((let? x)
            (let ((new-env (fold-left
                            (lambda (acc bind)
           ((let? x)
            (let ((new-env (fold-left
                            (lambda (acc bind)