summaryrefslogtreecommitdiff
path: root/infer2.scm
diff options
context:
space:
mode:
Diffstat (limited to 'infer2.scm')
-rw-r--r--infer2.scm37
1 files changed, 37 insertions, 0 deletions
diff --git a/infer2.scm b/infer2.scm
index 4097530..569792d 100644
--- a/infer2.scm
+++ b/infer2.scm
@@ -124,6 +124,29 @@
,(annotate-exp consequent env)
,(annotate-exp alternate env))))
+(define-matcher (annotate:values ('values vals ...) env)
+ (define vals* (map (lambda (val) (annotate-exp val env)) vals))
+ (define val-types
+ (map (lambda (val)
+ (match (texp-types val)
+ ((type) type)
+ (types (error "expressions in values must return 1 value" val))))
+ vals*))
+ (make-texp val-types `(values ,@vals*)))
+
+(define-matcher (annotate:let ('let (((? symbol? vars) vals) ...) body) env)
+ (define vals* (map (lambda (val) (annotate-exp val env)) vals))
+ (define val-types (map (lambda (val)
+ (match (texp-types val)
+ ((type) type)
+ (_ (error "let bindings must return 1 value" val))))
+ vals*))
+ (define env* (append (map cons vars val-types) env))
+ (define body* (annotate-exp body env*))
+ (pk 'body* body*)
+ (make-texp (texp-types body*)
+ `(let ,(map list vars vals*) ,body*)))
+
(define-matcher (annotate:lambda ('lambda ((? symbol? args) ...) body) env)
(define parameter-types (map (lambda (_name) (fresh-type-variable)) args))
(define env* (append (map cons args parameter-types) env))
@@ -146,6 +169,8 @@
annotate:float
annotate:var
annotate:if
+ annotate:values
+ annotate:let
annotate:lambda
annotate:call))
@@ -183,6 +208,16 @@
(program-constraints consequent)
(program-constraints alternate)))
+(define-matcher (constrain:values ((? type? types) ...)
+ ('values (? texp? vals) ...))
+ (append-map program-constraints vals))
+
+(define-matcher (constrain:let ((? type? types) ...)
+ ('let (((? symbol? vars) (? texp? vals)) ...)
+ (? texp? body)))
+ (append (program-constraints body)
+ (append-map program-constraints vals)))
+
(define-matcher (constrain:lambda ((? procedure-type? type))
('lambda ((? symbol? args) ...)
(? texp? body)))
@@ -200,6 +235,8 @@
(define %program-constraints
(compose-matchers constrain:if
+ constrain:values
+ constrain:let
constrain:lambda
constrain:call
constrain:other))