diff options
author | Noah Lavine <nlavine@haverford.edu> | 2011-12-14 21:16:28 -0500 |
---|---|---|
committer | Noah Lavine <nlavine@haverford.edu> | 2011-12-14 21:16:28 -0500 |
commit | 6302eb94191ed0b17306048a38b90e5e7ee78133 (patch) | |
tree | 71ec54f2ae22ef8033059265fcb3481af99c3dea | |
parent | bb32549299e2b3228562a3202787ef0499950b47 (diff) | |
download | guile-6302eb94191ed0b17306048a38b90e5e7ee78133.tar.gz |
Prepare for Analyzing
* module/analyzer/analyze.scm: the first-draft of a real analyzer.
-rw-r--r-- | module/analyzer/analyze.scm | 22 |
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)) |