diff options
| -rw-r--r-- | infer2.scm | 41 |
1 files changed, 30 insertions, 11 deletions
@@ -251,11 +251,6 @@ ,(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 single-type 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) @@ -293,6 +288,17 @@ (cons operator* args*))) +(define-matcher (annotate:values ('values vals ...) env) + (define vals* (map (lambda (val) (annotate-exp val env)) vals)) + (define val-types (map single-type vals*)) + (make-texp val-types `(values ,@vals*))) + +(define-matcher (annotate:call-with-values ('call-with-values producer consumer) + env) + (define producer* (annotate-exp producer env)) + (define consumer* (annotate-exp consumer env)) + (make-texp (texp-types consumer*) + `(call-with-values ,producer* ,consumer*))) (define annotate-exp (compose-matchers annotate:bool @@ -300,10 +306,11 @@ annotate:float annotate:var annotate:if - annotate:values annotate:let annotate:begin annotate:lambda + annotate:values + annotate:call-with-values annotate:call)) (define (annotate-exp* exp) @@ -339,10 +346,6 @@ (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))) @@ -379,13 +382,29 @@ (append (program-constraints operator) (append-map program-constraints operands)))) +(define-matcher (constrain:values ((? type? types) ...) + ('values (? texp? vals) ...)) + (append-map program-constraints vals)) + +(define-matcher (constrain:call-with-values ((? procedure-type? type)) + ('call-with-values + (? texp? producer) + (? texp? consumer))) + (define params (procedure-type-parameter-types type)) + (cons (pk 'constrain-call-with-values + (constrain (texp-types producer) + (list (make-procedure-type '() params)))) + (append (program-constraints producer) + (program-constraints consumer)))) + (define %program-constraints (compose-matchers constrain:if - constrain:values constrain:let constrain:begin constrain:for-all-lambda constrain:lambda + constrain:values + constrain:call-with-values constrain:call constrain:other)) |