mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-28 14:00:31 +02:00
Code Activity

Implement tree-il-fold in terms of make-tree-il-folder.

Browse source 
* module/language/tree-il.scm (tree-il-fold): Implement using
  make-tree-il-folder.  This is an incompatible change: there is no more
  "leaf" procedure, and tree-il-fold only works on tree-il and not
  lists.

* module/language/tree-il/analyze.scm (<tree-analysis>, analyze-tree):
  Adapt to tree-il-fold change, losing the "leaf" handler.
  (unused-variable-analysis, unused-toplevel-analysis)
  (unbound-variable-analysis, arity-analysis): Adapt to tree-analysis
  change.

* module/language/tree-il/canonicalize.scm (tree-il-any)
* module/language/tree-il/cse.scm (build-assigned-var-table)
* module/language/tree-il/peval.scm (tree-il-any, build-var-table)
  (peval): Adapt to tree-il-fold change.

* test-suite/tests/tree-il.test ("tree-il-fold"): Adapt tests for new
  interface and expectations.
This commit is contained in:
Andy Wingo 2013-05-28 12:06:30 -04:00
parent 99b4da8fb2
commit 007f671afc
6 changed files with 46 additions and 163 deletions
Download patch file Download diff file Expand all files Collapse all files

35
test-suite/tests/tree-il.test
View file

@ -722,24 +722,19 @@
(with-test-prefix "tree-il-fold"
(pass-if "empty tree"
(let ((leaf? #f) (up? #f) (down? #f) (mark (list 'mark)))
(pass-if "void"
(let ((up 0) (down 0) (mark (list 'mark)))
(and (eq? mark
(tree-il-fold (lambda (x y) (set! leaf? #t) y)
(lambda (x y) (set! down? #t) y)
(lambda (x y) (set! up? #t) y)
(tree-il-fold (lambda (x y) (set! down (1+ down)) y)
(lambda (x y) (set! up (1+ up)) y)
mark
'()))
(not leaf?)
(not up?)
(not down?))))
(make-void #f)))
(= up 1)
(= down 1))))
(pass-if "lambda and application"
(let* ((leaves '()) (ups '()) (downs '())
(let* ((ups '()) (downs '())
(result (tree-il-fold (lambda (x y)
(set! leaves (cons x leaves))
(1+ y))
(lambda (x y)
(set! downs (cons x downs))
(1+ y))
(lambda (x y)
@ -754,13 +749,15 @@
(lexical x x1)
(lexical y y1)))
#f))))))
(and (equal? (map strip-source leaves)
(list (make-lexical-ref #f 'y 'y1)
(and (= result 12)
(equal? (map strip-source (list-head (reverse ups) 3))
(list (make-toplevel-ref #f '+)
(make-lexical-ref #f 'x 'x1)
(make-toplevel-ref #f '+)))
(= (length downs) 3)
(equal? (reverse (map strip-source ups))
(map strip-source downs))))))
(make-lexical-ref #f 'y 'y1)))
(equal? (map strip-source (reverse (list-head downs 3)))
(list (make-toplevel-ref #f '+)
(make-lexical-ref #f 'x 'x1)
(make-lexical-ref #f 'y 'y1)))))))
;;;