[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, wip-compiler, updated. v2.1.0-140-g146
From: |
Noah Lavine |
Subject: |
[Guile-commits] GNU Guile branch, wip-compiler, updated. v2.1.0-140-g14654b5 |
Date: |
Sat, 17 Dec 2011 15:30:35 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=14654b5b0fe9bfdea7f02c03774bd4f389607f41
The branch, wip-compiler has been updated
via 14654b5b0fe9bfdea7f02c03774bd4f389607f41 (commit)
from f8a333e8a5468b57f22b1a139b18f8e1a0d706fe (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 14654b5b0fe9bfdea7f02c03774bd4f389607f41
Author: Noah Lavine <address@hidden>
Date: Sat Dec 17 10:29:35 2011 -0500
Add verify
* module/analyzer/analyze.scm: recognize the 'verify' function as
special, and add infrastructure for making sure that all verifies
pass.
* test-suite/tests/analyzer.test: add the most basic tests for
verify.
-----------------------------------------------------------------------
Summary of changes:
module/analyzer/analyze.scm | 43 ++++++++++++++++++++++++++++++++-------
test-suite/tests/analyzer.test | 10 ++++++++-
2 files changed, 44 insertions(+), 9 deletions(-)
diff --git a/module/analyzer/analyze.scm b/module/analyzer/analyze.scm
index f3590c0..d705626 100644
--- a/module/analyzer/analyze.scm
+++ b/module/analyzer/analyze.scm
@@ -115,10 +115,23 @@ points to the value-set of this expression's return value.
(environment-lookup default-environment name))
(define-syntax-rule (push! list obj)
- (set! list (cons list obj)))
+ (set! list (cons obj list)))
(define *values-need-inference* (make-set-queue))
+(define *verifies* '())
+
+
+;; this procedure is called on a node whose child node gained a
+;; value. it decides what to do about this. the parent can be #f, which
+;; means the child is at the top level
+(define (child-gained-value! parent)
+ (match parent
+ (#f #t)
+ (($ <a-call> _ _ _ _ _ _)
+ (set-queue-insert! *values-need-inference* parent))
+ (else #t)))
+
;; this procedure
;; - converts tree-il to annotated tree-il.
;; - annotates nodes with their parents.
@@ -136,8 +149,7 @@ points to the value-set of this expression's return value.
#t ; can-return?
(value-set-nothing) ; return-value-set
)))
- (if parent
- (set-queue-insert! *values-need-inference* parent))
+ (child-gained-value! parent)
ret))
(($ <const> src exp)
(let ((ret
@@ -146,8 +158,7 @@ points to the value-set of this expression's return value.
(value-set-with-values exp) ; return-value-set
exp
)))
- (if parent
- (set-queue-insert! *values-need-inference* parent))
+ (child-gained-value! parent)
ret))
(($ <primitive-ref> src name)
(let ((ret
@@ -155,8 +166,7 @@ points to the value-set of this expression's return value.
#t ; can-return?
(primitive-lookup name) ;
return-value-set
name)))
- (if parent
- (set-queue-insert! *values-need-inference* parent))
+ (child-gained-value! parent)
ret))
(($ <lexical-ref> src name gensym)
(make-a-lexical-ref src parent
@@ -213,6 +223,7 @@ points to the value-set of this expression's return value.
'())))
(set! (a-verify-exps ret)
(map (lambda (x) (rec ret x env)) args))
+ (push! *verifies* ret)
ret))
(($ <call> src proc args)
(let ((ret (make-a-call src parent
@@ -278,6 +289,20 @@ points to the value-set of this expression's return value.
(error "No fix yet!"))
)))
+(define (all-verifies-pass?)
+ (let outer ((v *verifies*))
+ (if (null? v)
+ #t
+ (let inner ((exps (a-verify-exps (car v))))
+ (cond ((null? exps) (outer (cdr v)))
+ ((and (value-set-has-values?
+ (annotated-tree-il-return-value-set (car exps)))
+ (not (value-set-has-value?
+ (annotated-tree-il-return-value-set (car exps))
+ #f)))
+ (inner (cdr exps)))
+ (else #f))))))
+
(define *tree* '())
;; This function starts with the annotated tree-il nodes in
@@ -315,10 +340,12 @@ points to the value-set of this expression's return value.
(define (go sexp)
(set! *values-need-inference* (make-set-queue))
+ (set! *verifies* '())
(set! *tree*
(tree-il->annotated-tree-il!
(compile sexp #:to 'tree-il)))
- (pretty-print *tree*))
+ (infer-value-sets!)
+ (all-verifies-pass?))
#|
diff --git a/test-suite/tests/analyzer.test b/test-suite/tests/analyzer.test
index 9e9ac3c..1206caa 100644
--- a/test-suite/tests/analyzer.test
+++ b/test-suite/tests/analyzer.test
@@ -1,6 +1,7 @@
(use-modules (test-suite lib)
(analyzer set-queue)
- (analyzer value-sets))
+ (analyzer value-sets)
+ (analyzer analyze))
;; test the set queue functions
@@ -133,3 +134,10 @@
(begin (vs-cdr vs-t4 (value-set-nothing))
(true? (value-set-nothing? vs-t4))))
+;; test the actual analyzer!
+
+(pass-if "(verify #f)"
+ (not (go '(verify #f))))
+
+(pass-if "(verify #t)"
+ (true? (go '(verify #t))))
hooks/post-receive
--
GNU Guile
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, wip-compiler, updated. v2.1.0-140-g14654b5,
Noah Lavine <=