summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2023-01-07 22:03:53 -0500
committerDavid Thompson <dthompson2@worcester.edu>2023-06-08 08:14:41 -0400
commit519b3ec07265d65900707830ae439afa01137481 (patch)
tree6258c537018670538cdfb208f37ba47cf22bad6b
parent1fca41ed98b74bf4224ada808489b4b770d3ddf6 (diff)
call-with-values
-rw-r--r--infer2.scm41
1 files changed, 30 insertions, 11 deletions
diff --git a/infer2.scm b/infer2.scm
index 03a8d32..015f897 100644
--- a/infer2.scm
+++ b/infer2.scm
@@ -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))