mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-22 03:30:22 +02:00
Code Activity

fix apply and call/cc in drop contexts

Browse source 
* module/language/tree-il/compile-glil.scm (flatten): Actually apply only
  needs one arg after the proc. And shit, call/cc and apply in drop
  contexts also need to be able to return arbitrary numbers of values;
  work it by trampolining through their applicative (non-@) definitions.
  Also, simplify the single-valued drop case to avoid the
  truncate-values.

* module/language/tree-il/inline.scm (call/cc):
* module/language/tree-il/optimize.scm (*interesting-primitive-names*):
  Define call/cc as "interesting". Perhaps we should be hashing on value
  and not on variable.

* test-suite/tests/tree-il.test ("application"): Fix up test for new,
  sleeker output. (Actually the GLIL is more verbose, but the assembly is
  better.)
  ("apply", "call/cc"): Add some more tests.
This commit is contained in:
Andy Wingo 2009-05-21 21:13:24 +02:00
parent 30a5e062d0
commit 0f423f20aa
4 changed files with 82 additions and 17 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -71,9 +71,11 @@
(assert-tree-il->glil/pmatch
(begin (apply (toplevel foo) (const 1)) (void))
(program 0 0 0 0 () (toplevel ref foo) (const 1) (mv-call 1 ,l1)
(const 1) (label ,l2) (mv-bind () #f) (unbind)
(call drop 1) (branch br ,l2)
(label ,l3) (mv-bind () #f) (unbind)
(label ,l4)
(void) (call return 1))
(eq? l1 l2))
(and (eq? l1 l3) (eq? l2 l4)))
(assert-tree-il->glil
(apply (toplevel foo) (apply (toplevel bar)))
(program 0 0 0 0 () (toplevel ref foo) (toplevel ref bar) (call call 0)
@ -415,3 +417,43 @@
(unbind)
(unbind))
(eq? l1 l2)))
(with-test-prefix "apply"
(assert-tree-il->glil
(apply (primitive @apply) (toplevel foo) (toplevel bar))
(program 0 0 0 0 () (toplevel ref foo) (toplevel ref bar) (call goto/apply 2)))
(assert-tree-il->glil/pmatch
(begin (apply (primitive @apply) (toplevel foo) (toplevel bar)) (void))
(program 0 0 0 0 ()
(toplevel ref apply) (toplevel ref foo) (toplevel ref bar) (mv-call 2 ,l1)
(call drop 1) (branch br ,l2) (label ,l3) (mv-bind () #f) (unbind)
(label ,l4)
(void) (call return 1))
(and (eq? l1 l3) (eq? l2 l4)))
(assert-tree-il->glil
(apply (toplevel foo) (apply (toplevel @apply) (toplevel bar) (toplevel baz)))
(program 0 0 0 0 ()
(toplevel ref foo)
(toplevel ref bar) (toplevel ref baz) (call apply 2)
(call goto/args 1))))
(with-test-prefix "call/cc"
(assert-tree-il->glil
(apply (primitive @call-with-current-continuation) (toplevel foo))
(program 0 0 0 0 () (toplevel ref foo) (call goto/cc 1)))
(assert-tree-il->glil/pmatch
(begin (apply (primitive @call-with-current-continuation) (toplevel foo)) (void))
(program 0 0 0 0 ()
(toplevel ref call-with-current-continuation) (toplevel ref foo) (mv-call 1 ,l1)
(call drop 1) (branch br ,l2) (label ,l3) (mv-bind () #f) (unbind)
(label ,l4)
(void) (call return 1))
(and (eq? l1 l3) (eq? l2 l4)))
(assert-tree-il->glil
(apply (toplevel foo)
(apply (toplevel @call-with-current-continuation) (toplevel bar)))
(program 0 0 0 0 ()
(toplevel ref foo)
(toplevel ref bar) (call call/cc 1)
(call goto/args 1))))