summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNoah Lavine <nlavine@haverford.edu>2011-12-14 21:16:28 -0500
committerNoah Lavine <nlavine@haverford.edu>2011-12-14 21:16:28 -0500
commit6302eb94191ed0b17306048a38b90e5e7ee78133 (patch)
tree71ec54f2ae22ef8033059265fcb3481af99c3dea
parentbb32549299e2b3228562a3202787ef0499950b47 (diff)
downloadguile-6302eb94191ed0b17306048a38b90e5e7ee78133.tar.gz
Prepare for Analyzing
* module/analyzer/analyze.scm: the first-draft of a real analyzer.
-rw-r--r--module/analyzer/analyze.scm22
1 files changed, 16 insertions, 6 deletions
diff --git a/module/analyzer/analyze.scm b/module/analyzer/analyze.scm
index 2e8c5989b..0e5a6a63f 100644
--- a/module/analyzer/analyze.scm
+++ b/module/analyzer/analyze.scm
@@ -105,9 +105,9 @@ points to the value-set of this expression's return value.
(environment-lookup (cdr env) name))))
(define default-environment
- `( (cons . ,(value-set-with-values 'cons))
- (car . ,(value-set-with-values 'car))
- (cdr . ,(value-set-with-values 'cdr))
+ `( (cons . ,(value-set-with-values prim-cons))
+ (car . ,(value-set-with-values prim-car ))
+ (cdr . ,(value-set-with-values prim-cdr ))
))
(define (primitive-lookup name)
@@ -287,12 +287,22 @@ points to the value-set of this expression's return value.
proc args)
(if (and (value-set-has-values?
(annotated-tree-il-return-value-set proc))
+ (value-set-has-no-properties?
+ (annotated-tree-il-return-value-set proc))
(every (lambda (x) (value-set-has-values?
(annotated-tree-il-return-value-set x)))
args))
- (begin
- ))))
-)))
+ (let loop ((procs (value-set-values
+ (annotated-tree-il-return-value-set proc))))
+ (if (not (null? procs))
+ (begin
+ (let ((eval (primitive-procedure-evaluator (car procs))))
+ (apply eval return-value-set
+ (map annotated-tree-il-return-value-set
+ args)))
+ (loop (cdr procs)))))
+ )))
+ )))
(define (go sexp)
(set! *values-need-inference* (make-set-queue))