Add more binary ops

diff --git a/codegen.scm b/codegen.scm
index 76fa6717c46d9d1ae69a4dd28d9fcbb135739d05..3a01dff778e94f79f675bd26c6f19a39509a9e64 100644 (file)
--- a/codegen.scm
+++ b/codegen.scm
@@ -9,19 +9,35 @@
 (define (codegen-add xs si env)
   (define (go ys)
     (if (null? ys)
-      (emit "movq %rbx, %rax")
+      (emit "movq ~a(%rsp), %rax" si)
       (begin
        (let ((y (car ys)))
             (if (integer? y)
-                (emit "addq $~a, %rbx" y)
+                (emit "addq $~a, ~a(%rsp)" y si)
                 (begin
-                  (codegen-expr y si env)
-                  (emit "addq %rax, %rbx"))))
+                  (codegen-expr y (- si wordsize) env)
+                  (emit "addq %rax, ~a(%rsp)" si))))
        (go (cdr ys)))))
   (begin
-    (emit "movq $0, %rbx")
+                                       ; use si(%rsp) as the accumulator
+    (emit "movq $0, ~a(%rsp)" si)
     (go xs)))
 
+(define (codegen-binop opcode)
+  (lambda (a b si env)
+    (codegen-expr b si env)
+    (emit "movq %rax, ~a(%rsp)" si)
+    (codegen-expr a (- si wordsize) env)
+    (emit "~a ~a(%rsp), %rax" opcode si)))
+
+(define codegen-sub (codegen-binop "sub"))
+(define codegen-mul (codegen-binop "imul"))
+
+(define (codegen-not x si env)
+  (codegen-expr x si env)
+  (emit "xorq $-1, %rax")
+  (emit "andq $1, %rax"))
+
 (define (range s n)
   (if (= 0 n) '()
       (append (range s (- n 1))
@@ -47,14 +63,21 @@
     (emit "movq ~a(%rsp), %rax" offset)))
 
 (define (codegen-expr e si env)
-  (cond ((and (list? e) (eq? (car e) '+))
-        (codegen-add (cdr e) si env))
+  (cond ((app? e)
+        (case (car e)
+          ('+ (codegen-add (cdr e) si env))
+          ('- (codegen-sub (cadr e) (caddr e) si env))
+          ('* (codegen-mul (cadr e) (caddr e) si env))
+          ('! (codegen-not (cadr e) si env))
+          ('bool->int (codegen-expr (cadr e) si env))
+          (else (error #f "can't handle anything else yet"))))
        ((let? e) (codegen-let
                   (let-bindings e)
                   (let-body e)
                   si
                   env))
        ((var? e) (codegen-var e si env))
+       ((boolean? e) (emit "movq $~a, %rax" (if e 1 0)))
        (else (emit "movq $~a, %rax" e))))
 
 (define (codegen program)

diff --git a/main.scm b/main.scm
index 29c03e5c9c6cfc8a97e63cd44f2d0b16aff5e9eb..289840b38db3ee0fb75d91bd42bab6297f40f977 100644 (file)
--- a/main.scm
+++ b/main.scm
@@ -1,6 +1,6 @@
 (load "codegen.scm")
 
 (compile-to-binary
- (if (>= (length (command-line)) 1)
+ (if (> (length (command-line)) 1)
      (call-with-input-file (cadr (command-line)) read)
      (read)))

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)))
 
+(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)
@@ -57,10 +65,8 @@
          (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)))
-
           ((let? x)
            (let ((new-env (fold-left
                            (lambda (acc bind)