projects
/
scheme.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
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)