[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, master, updated. v2.1.0-45-g9b96563
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] GNU Guile branch, master, updated. v2.1.0-45-g9b96563 |
|
Date: |
Sun, 16 Jun 2013 14:51:50 +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=9b965638e9e6cfe927807dbacc86212cc638967b
The branch, master has been updated
via 9b965638e9e6cfe927807dbacc86212cc638967b (commit)
via e6450062a19bf5d0072d117b69be95c2641c23ab (commit)
from b34b66b346ef7c09878112d7cf6d757bb1906344 (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 9b965638e9e6cfe927807dbacc86212cc638967b
Author: Andy Wingo <address@hidden>
Date: Sun Jun 16 15:06:59 2013 +0200
<dynwind> no longer has "pre" or "post" fields
* module/language/tree-il.scm (<tree-il>): Remove pre and post fields
from <dynwind>. A dynwind now assumes that in normal entry and exit,
that the code runs the winders and unwinders using <seq> and
<let-values> and such things.
(parse-tree-il, unparse-tree-il, make-tree-il-folder, pre-post-order):
Adapt <dynwind> users.
* module/language/tree-il/analyze.scm (analyze-lexicals):
* module/language/tree-il/compile-glil.scm (flatten-lambda-case):
* module/language/tree-il/cse.scm (cse):
* module/language/tree-il/debug.scm (verify-tree-il):
* module/language/tree-il/effects.scm (make-effects-analyzer): Adapt.
* module/language/tree-il/peval.scm (peval):
* module/language/tree-il/primitives.scm (*primitive-expand-table*):
Produce tree-il that calls the winder and unwinder. Recognize
singly-valued dynamic-wind expressions.
* test-suite/tests/peval.test ("partial evaluation"): Add tests.
commit e6450062a19bf5d0072d117b69be95c2641c23ab
Author: Andy Wingo <address@hidden>
Date: Sun Jun 16 15:02:34 2013 +0200
Reduce call-with-values to let for singly-valued producers
* module/language/tree-il/peval.scm (singly-valued-expression?): Add
support for conditionals. In the future we should add more
expressions here.
(peval): Don't inline values into the body of a dynwind, as that could
cause the consumer to run in the wrong dynamic context.
If the producer is singly-valued and the consumer just has a rest arg,
reduce to "let" and cons up a list in the consumer. This may reduce
further.
* test-suite/tests/peval.test ("partial evaluation"): Add a test.
-----------------------------------------------------------------------
Summary of changes:
module/language/tree-il.scm | 29 +++----
module/language/tree-il/analyze.scm | 12 +--
module/language/tree-il/compile-glil.scm | 38 +++------
module/language/tree-il/cse.scm | 8 +--
module/language/tree-il/debug.scm | 4 +-
module/language/tree-il/effects.scm | 4 +-
module/language/tree-il/peval.scm | 123 ++++++++++++++++++-----------
module/language/tree-il/primitives.scm | 41 +++++++----
test-suite/tests/peval.test | 65 ++++++++++++----
9 files changed, 184 insertions(+), 140 deletions(-)
diff --git a/module/language/tree-il.scm b/module/language/tree-il.scm
index 580bc6c..b800912 100644
--- a/module/language/tree-il.scm
+++ b/module/language/tree-il.scm
@@ -46,7 +46,7 @@
<letrec> letrec? make-letrec letrec-src letrec-in-order?
letrec-names letrec-gensyms letrec-vals letrec-body
<fix> fix? make-fix fix-src fix-names fix-gensyms fix-vals fix-body
<let-values> let-values? make-let-values let-values-src
let-values-exp let-values-body
- <dynwind> dynwind? make-dynwind dynwind-src dynwind-winder
dynwind-pre dynwind-body dynwind-post dynwind-unwinder
+ <dynwind> dynwind? make-dynwind dynwind-src dynwind-winder
dynwind-body dynwind-unwinder
<dynlet> dynlet? make-dynlet dynlet-src dynlet-fluids dynlet-vals
dynlet-body
<dynref> dynref? make-dynref dynref-src dynref-fluid
<dynset> dynset? make-dynset dynset-src dynset-fluid dynset-exp
@@ -136,7 +136,7 @@
(define-type (<tree-il> #:common-slots (src) #:printer print-tree-il)
(<fix> names gensyms vals body)
(<let-values> exp body)
- (<dynwind> winder pre body post unwinder)
+ (<dynwind> winder body unwinder)
(<dynref> fluid)
(<dynset> fluid exp)
(<prompt> tag body handler)
@@ -249,10 +249,8 @@
(('let-values exp body)
(make-let-values loc (retrans exp) (retrans body)))
- (('dynwind winder pre body post unwinder)
- (make-dynwind loc (retrans winder) (retrans pre)
- (retrans body)
- (retrans post) (retrans unwinder)))
+ (('dynwind winder body unwinder)
+ (make-dynwind loc (retrans winder) (retrans body) (retrans unwinder)))
(('dynlet fluids vals body)
(make-dynlet loc (map retrans fluids) (map retrans vals) (retrans body)))
@@ -341,10 +339,10 @@
(($ <let-values> src exp body)
`(let-values ,(unparse-tree-il exp) ,(unparse-tree-il body)))
- (($ <dynwind> src winder pre body post unwinder)
- `(dynwind ,(unparse-tree-il winder) ,(unparse-tree-il pre)
+ (($ <dynwind> src winder body unwinder)
+ `(dynwind ,(unparse-tree-il winder)
,(unparse-tree-il body)
- ,(unparse-tree-il post) ,(unparse-tree-il unwinder)))
+ ,(unparse-tree-il unwinder)))
(($ <dynlet> src fluids vals body)
`(dynlet ,(map unparse-tree-il fluids) ,(map unparse-tree-il vals)
@@ -426,12 +424,10 @@
(($ <let-values> src exp body)
(let*-values (((seed ...) (foldts exp seed ...)))
(foldts body seed ...)))
- (($ <dynwind> src winder pre body post unwinder)
+ (($ <dynwind> src winder body unwinder)
(let*-values (((seed ...) (foldts winder seed ...))
- ((seed ...) (foldts pre seed ...))
- ((seed ...) (foldts body seed ...))
- ((seed ...) (foldts post seed ...)))
- (foldts unwinder seed ...)))
+ ((seed ...) (foldts unwinder seed ...)))
+ (foldts body seed ...)))
(($ <dynlet> src fluids vals body)
(let*-values (((seed ...) (fold-values foldts fluids seed ...))
((seed ...) (fold-values foldts vals seed ...)))
@@ -531,9 +527,8 @@ This is an implementation of `foldts' as described by Andy
Wingo in
(($ <let-values> src exp body)
(make-let-values src (lp exp) (lp body)))
- (($ <dynwind> src winder pre body post unwinder)
- (make-dynwind src
- (lp winder) (lp pre) (lp body) (lp post) (lp unwinder)))
+ (($ <dynwind> src winder body unwinder)
+ (make-dynwind src (lp winder) (lp body) (lp unwinder)))
(($ <dynlet> src fluids vals body)
(make-dynlet src (map lp fluids) (map lp vals) (lp body)))
diff --git a/module/language/tree-il/analyze.scm
b/module/language/tree-il/analyze.scm
index aff05d7..84a044c 100644
--- a/module/language/tree-il/analyze.scm
+++ b/module/language/tree-il/analyze.scm
@@ -337,10 +337,8 @@
((<let-values> exp body)
(lset-union eq? (step exp) (step body)))
- ((<dynwind> winder pre body post unwinder)
- (lset-union eq? (step winder) (step pre)
- (step body)
- (step post) (step unwinder)))
+ ((<dynwind> winder body unwinder)
+ (lset-union eq? (step winder) (step body) (step unwinder)))
((<dynlet> fluids vals body)
(apply lset-union eq? (step body) (map step (append fluids vals))))
@@ -513,10 +511,8 @@
((<let-values> exp body)
(max (recur exp) (recur body)))
- ((<dynwind> winder pre body post unwinder)
- (max (recur winder) (recur pre)
- (recur body)
- (recur post) (recur unwinder)))
+ ((<dynwind> winder body unwinder)
+ (max (recur winder) (recur body) (recur unwinder)))
((<dynlet> fluids vals body)
(apply max (recur body) (map recur (append fluids vals))))
diff --git a/module/language/tree-il/compile-glil.scm
b/module/language/tree-il/compile-glil.scm
index 353bd03..c06a1f6 100644
--- a/module/language/tree-il/compile-glil.scm
+++ b/module/language/tree-il/compile-glil.scm
@@ -934,11 +934,7 @@
(clear-stack-slots context gensyms)
(emit-code #f (make-glil-unbind))))))
- ;; much trickier than i thought this would be, at first, due to the need
- ;; to have body's return value(s) on the stack while the unwinder runs,
- ;; then proceed with returning or dropping or what-have-you, interacting
- ;; with RA and MVRA. What have you, I say.
- ((<dynwind> src winder pre body post unwinder)
+ ((<dynwind> src winder body unwinder)
(define (thunk? x)
(and (lambda? x)
(null? (lambda-case-gensyms (lambda-body x)))))
@@ -957,60 +953,52 @@
(make-void #f)
(make-wrong-type-arg x))))
- ;; We know at this point that `winder' and `unwinder' are
- ;; constant expressions and can be duplicated.
+ ;; The `winder' and `unwinder' of a dynwind are constant
+ ;; expressions and can be duplicated.
(if (not (thunk? winder))
(emit-thunk-check winder))
(comp-push winder)
(if (not (thunk? unwinder))
(emit-thunk-check unwinder))
(comp-push unwinder)
- (comp-drop pre)
(emit-code #f (make-glil-call 'wind 2))
(case context
((tail)
(let ((MV (make-label)))
(comp-vals body MV)
- ;; one value: unwind...
+ ;; One value. Unwind and return the value.
(emit-code #f (make-glil-call 'unwind 0))
- (comp-drop post)
- ;; ...and return the val
(emit-code #f (make-glil-call 'return 1))
(emit-label MV)
- ;; multiple values: unwind...
+ ;; Multiple values. Unwind and return the values.
(emit-code #f (make-glil-call 'unwind 0))
- (comp-drop post)
- ;; and return the values.
(emit-code #f (make-glil-call 'return/nvalues 1))))
((push)
- ;; we only want one value. so ask for one value
+ ;; We only want one value, so ask for one value and then
+ ;; unwind, leaving the value on the stack.
(comp-push body)
- ;; and unwind, leaving the val on the stack
- (emit-code #f (make-glil-call 'unwind 0))
- (comp-drop post))
+ (emit-code #f (make-glil-call 'unwind 0)))
((vals)
(let ((MV (make-label)))
(comp-vals body MV)
- ;; one value: push 1 and fall through to MV case
+ ;; Transform a singly-valued return to a multiple-value
+ ;; return and fall through to MV case.
(emit-code #f (make-glil-const 1))
(emit-label MV)
- ;; multiple values: unwind...
+ ;; Multiple values: unwind and go to the MVRA.
(emit-code #f (make-glil-call 'unwind 0))
- (comp-drop post)
- ;; and goto the MVRA.
(emit-branch #f 'br MVRA)))
((drop)
- ;; compile body, discarding values. then unwind...
+ ;; Compile body, discarding values. Then unwind and fall
+ ;; through, or goto RA if there is one.
(comp-drop body)
(emit-code #f (make-glil-call 'unwind 0))
- (comp-drop post)
- ;; and fall through, or goto RA if there is one.
(if RA
(emit-branch #f 'br RA)))))
diff --git a/module/language/tree-il/cse.scm b/module/language/tree-il/cse.scm
index 9531149..4c50114 100644
--- a/module/language/tree-il/cse.scm
+++ b/module/language/tree-il/cse.scm
@@ -442,18 +442,14 @@
((consumer db**) (visit consumer (concat db* db) env
ctx)))
(return (make-let-values src producer consumer)
(concat db** db*))))
- (($ <dynwind> src winder pre body post unwinder)
+ (($ <dynwind> src winder body unwinder)
(let*-values (((winder db*) (visit winder db env 'value))
((db**) db*)
((unwinder db*) (visit unwinder db env 'value))
((db**) (concat db* db**))
- ((pre db*) (visit pre (concat db** db) env 'effect))
- ((db**) (concat db* db**))
((body db*) (visit body (concat db** db) env ctx))
- ((db**) (concat db* db**))
- ((post db*) (visit post (concat db** db) env 'effect))
((db**) (concat db* db**)))
- (return (make-dynwind src winder pre body post unwinder)
+ (return (make-dynwind src winder body unwinder)
db**)))
(($ <dynlet> src fluids vals body)
(let*-values (((fluids db*) (parallel-visit fluids db env 'value))
diff --git a/module/language/tree-il/debug.scm
b/module/language/tree-il/debug.scm
index 65fd58e..6a3b3dc 100644
--- a/module/language/tree-il/debug.scm
+++ b/module/language/tree-il/debug.scm
@@ -216,11 +216,9 @@
(for-each (cut visit <> env) fluids)
(for-each (cut visit <> env) vals)
(visit body env))))
- (($ <dynwind> src winder pre body post unwinder)
+ (($ <dynwind> src winder body unwinder)
(visit winder env)
- (visit pre env)
(visit body env)
- (visit post env)
(visit unwinder env))
(($ <dynref> src fluid)
(visit fluid env))
diff --git a/module/language/tree-il/effects.scm
b/module/language/tree-il/effects.scm
index b5586e2..b9b34a1 100644
--- a/module/language/tree-il/effects.scm
+++ b/module/language/tree-il/effects.scm
@@ -211,11 +211,9 @@ of an expression."
(logior (compute-effects producer)
(compute-effects consumer)
(cause &type-check)))
- (($ <dynwind> _ winder pre body post unwinder)
+ (($ <dynwind> _ winder body unwinder)
(logior (compute-effects winder)
- (compute-effects pre)
(compute-effects body)
- (compute-effects post)
(compute-effects unwinder)))
(($ <dynlet> _ fluids vals body)
(logior (accumulate-effects fluids)
diff --git a/module/language/tree-il/peval.scm
b/module/language/tree-il/peval.scm
index 3755380..27da460 100644
--- a/module/language/tree-il/peval.scm
+++ b/module/language/tree-il/peval.scm
@@ -101,6 +101,11 @@
(($ <primcall> _ (? singly-valued-primitive?)) #t)
(($ <primcall> _ 'values (val)) #t)
(($ <lambda>) #t)
+ (($ <conditional> _ test consequent alternate)
+ (and (singly-valued-expression? consequent)
+ (singly-valued-expression? alternate)))
+ (($ <dynwind> _ winder body unwinder)
+ (singly-valued-expression? body))
(else #f)))
(define (truncate-values x)
@@ -538,6 +543,10 @@ top-level bindings from ENV and return the resulting
expression."
(($ <prompt>) #f)
(($ <abort>) #f)
+ ;; Bail on dynwinds, as that would cause the consumer to run in
+ ;; the wrong dynamic context.
+ (($ <dynwind>) #f)
+
;; Propagate to tail positions.
(($ <let> src names gensyms vals body)
(let ((body (loop body)))
@@ -558,10 +567,6 @@ top-level bindings from ENV and return the resulting
expression."
(make-let-values src exp
(make-lambda-case src2 req opt rest kw
inits gensyms body #f)))))
- (($ <dynwind> src winder pre body post unwinder)
- (let ((body (loop body)))
- (and body
- (make-dynwind src winder pre body post unwinder))))
(($ <dynlet> src fluids vals body)
(let ((body (loop body)))
(and body
@@ -975,6 +980,19 @@ top-level bindings from ENV and return the resulting
expression."
(for-tail
(make-let src (list req-name) (list req-sym) (list producer)
body)))
+ ((and ($ <lambda-case> src () #f rest #f () (rest-sym) body #f)
+ (? (lambda _ (singly-valued-expression? producer))))
+ (let ((tmp (gensym "tmp ")))
+ (record-new-temporary! 'tmp tmp 1)
+ (for-tail
+ (make-let
+ src (list 'tmp) (list tmp) (list producer)
+ (make-let
+ src (list rest) (list rest-sym)
+ (list
+ (make-primcall #f 'list
+ (list (make-lexical-ref #f 'tmp tmp))))
+ body)))))
(($ <lambda-case> src req opt rest #f inits gensyms body #f)
(let* ((nmin (length req))
(nmax (and (not rest) (+ nmin (if opt (length opt)
0)))))
@@ -984,10 +1002,11 @@ top-level bindings from ENV and return the resulting
expression."
(else #f))))
(_ #f))
(make-let-values lv-src producer (for-tail consumer)))))
- (($ <dynwind> src winder pre body post unwinder)
- (make-dynwind src (for-value winder) (for-effect pre)
+ (($ <dynwind> src winder body unwinder)
+ (make-dynwind src
+ (for-value winder)
(for-tail body)
- (for-effect post) (for-value unwinder)))
+ (for-value unwinder)))
(($ <dynlet> src fluids vals body)
(make-dynlet src (map for-value fluids) (map for-value vals)
(for-tail body)))
@@ -1106,47 +1125,57 @@ top-level bindings from ENV and return the resulting
expression."
(for-tail (make-let-values src (make-call src producer '())
consumer)))
(($ <primcall> src 'dynamic-wind (w thunk u))
+ (define (with-temporaries exps refcount k)
+ (let* ((pairs (map (match-lambda
+ ((and exp (? constant-expression?))
+ (cons #f exp))
+ (exp
+ (let ((sym (gensym "tmp ")))
+ (record-new-temporary! 'tmp sym refcount)
+ (cons sym exp))))
+ exps))
+ (tmps (filter car pairs)))
+ (match tmps
+ (() (k exps))
+ (tmps
+ (make-let src
+ (make-list (length tmps) 'tmp)
+ (map car tmps)
+ (map cdr tmps)
+ (k (map (match-lambda
+ ((#f . val) val)
+ ((sym . _)
+ (make-lexical-ref #f 'tmp sym)))
+ pairs)))))))
+ (define (make-begin0 src first second)
+ (make-let-values
+ src
+ first
+ (let ((vals (gensym "vals ")))
+ (record-new-temporary! 'vals vals 1)
+ (make-lambda-case
+ #f
+ '() #f 'vals #f '() (list vals)
+ (make-seq
+ src
+ second
+ (make-primcall #f 'apply
+ (list
+ (make-primitive-ref #f 'values)
+ (make-lexical-ref #f 'vals vals))))
+ #f))))
(for-tail
- (cond
- ((not (constant-expression? w))
- (cond
- ((not (constant-expression? u))
- (let ((w-sym (gensym "w ")) (u-sym (gensym "u ")))
- (record-new-temporary! 'w w-sym 2)
- (record-new-temporary! 'u u-sym 2)
- (make-let src '(w u) (list w-sym u-sym) (list w u)
- (make-dynwind
- src
- (make-lexical-ref #f 'w w-sym)
- (make-call #f (make-lexical-ref #f 'w w-sym) '())
- (make-call #f thunk '())
- (make-call #f (make-lexical-ref #f 'u u-sym) '())
- (make-lexical-ref #f 'u u-sym)))))
- (else
- (let ((w-sym (gensym "w ")))
- (record-new-temporary! 'w w-sym 2)
- (make-let src '(w) (list w-sym) (list w)
- (make-dynwind
- src
- (make-lexical-ref #f 'w w-sym)
- (make-call #f (make-lexical-ref #f 'w w-sym) '())
- (make-call #f thunk '())
- (make-call #f u '())
- u))))))
- ((not (constant-expression? u))
- (let ((u-sym (gensym "u ")))
- (record-new-temporary! 'u u-sym 2)
- (make-let src '(u) (list u-sym) (list u)
- (make-dynwind
- src
- w
- (make-call #f w '())
- (make-call #f thunk '())
- (make-call #f (make-lexical-ref #f 'u u-sym) '())
- (make-lexical-ref #f 'u u-sym)))))
- (else
- (make-dynwind src w (make-call #f w '()) (make-call #f thunk '())
- (make-call #f u '()) u)))))
+ (with-temporaries
+ (list w u) 2
+ (match-lambda
+ ((w u)
+ (make-seq src
+ (make-call src w '())
+ (make-begin0 src
+ (make-dynwind src w
+ (make-call src thunk '())
+ u)
+ (make-call src u '()))))))))
(($ <primcall> src 'values exps)
(cond
diff --git a/module/language/tree-il/primitives.scm
b/module/language/tree-il/primitives.scm
index cbda2db..4a1b98d 100644
--- a/module/language/tree-il/primitives.scm
+++ b/module/language/tree-il/primitives.scm
@@ -544,20 +544,33 @@
'@dynamic-wind
(case-lambda
((src pre expr post)
- (let ((PRE (gensym "pre-"))
- (POST (gensym "post-")))
- (make-let
- src
- '(pre post)
- (list PRE POST)
- (list pre post)
- (make-dynwind
- src
- (make-lexical-ref #f 'pre PRE)
- (make-call #f (make-lexical-ref #f 'pre PRE) '())
- expr
- (make-call #f (make-lexical-ref #f 'post POST) '())
- (make-lexical-ref #f 'post POST)))))))
+ (let* ((PRE (gensym "pre-"))
+ (POST (gensym "post-"))
+ (winder (make-lexical-ref #f 'winder PRE))
+ (unwinder (make-lexical-ref #f 'unwinder POST)))
+ (define (make-begin0 src first second)
+ (make-let-values
+ src
+ first
+ (let ((vals (gensym "vals ")))
+ (make-lambda-case
+ #f
+ '() #f 'vals #f '() (list vals)
+ (make-seq
+ src
+ second
+ (make-primcall #f 'apply
+ (list
+ (make-primitive-ref #f 'values)
+ (make-lexical-ref #f 'vals vals))))
+ #f))))
+ (make-let src '(pre post) (list PRE POST) (list pre post)
+ (make-seq src
+ (make-call src winder '())
+ (make-begin0
+ src
+ (make-dynwind src winder expr unwinder)
+ (make-call src unwinder '()))))))))
(hashq-set! *primitive-expand-table*
'fluid-ref
diff --git a/test-suite/tests/peval.test b/test-suite/tests/peval.test
index 8f237b8..7322d61 100644
--- a/test-suite/tests/peval.test
+++ b/test-suite/tests/peval.test
@@ -984,6 +984,15 @@
(primcall list (const 1) (const 2)))
(pass-if-peval
+ ;; When we can't inline let-values but can prove that the producer
+ ;; has just one value, reduce to "let" (which can then fold
+ ;; further).
+ (call-with-values (lambda () (if foo 1 2))
+ (lambda args
+ (apply values args)))
+ (if (toplevel foo) (const 1) (const 2)))
+
+ (pass-if-peval
;; Constant folding: cons of #nil does not make list
(cons 1 #nil)
(primcall cons (const 1) (const '#nil)))
@@ -1054,28 +1063,50 @@
(seq (call (toplevel random)) (const #t)))
(pass-if-peval
- ;; Non-constant guards get lexical bindings.
+ ;; Non-constant guards get lexical bindings, invocation of winder and
+ ;; unwinder lifted out. Unfortunately both have the generic variable
+ ;; name "tmp", so we can't distinguish them in this test, and they
+ ;; also collide in generic names with the single-value result from
+ ;; the dynwind; alack.
(dynamic-wind foo (lambda () bar) baz)
- (let (w u) (_ _) ((toplevel foo) (toplevel baz))
- (dynwind (lexical w _)
- (call (lexical w _))
- (toplevel bar)
- (call (lexical u _))
- (lexical u _))))
+ (let (tmp tmp) (_ _) ((toplevel foo) (toplevel baz))
+ (seq (call (lexical tmp _))
+ (let (tmp) (_) ((dynwind (lexical tmp _)
+ (toplevel bar)
+ (lexical tmp _)))
+ (seq (call (lexical tmp _))
+ (lexical tmp _))))))
(pass-if-peval
;; Constant guards don't need lexical bindings.
(dynamic-wind (lambda () foo) (lambda () bar) (lambda () baz))
- (dynwind
- (lambda ()
- (lambda-case
- ((() #f #f #f () ()) (toplevel foo))))
- (toplevel foo)
- (toplevel bar)
- (toplevel baz)
- (lambda ()
- (lambda-case
- ((() #f #f #f () ()) (toplevel baz))))))
+ (seq (toplevel foo)
+ (let (tmp) (_) ((dynwind (lambda ()
+ (lambda-case
+ ((() #f #f #f () ()) (toplevel foo))))
+ (toplevel bar)
+ (lambda ()
+ (lambda-case
+ ((() #f #f #f () ()) (toplevel baz))))))
+ (seq (toplevel baz)
+ (lexical tmp _)))))
+
+ (pass-if-peval
+ ;; Dynwind bodies that return an unknown number of values need a
+ ;; let-values.
+ (dynamic-wind (lambda () foo) (lambda () (bar)) (lambda () baz))
+ (seq (toplevel foo)
+ (let-values (dynwind (lambda ()
+ (lambda-case
+ ((() #f #f #f () ()) (toplevel foo))))
+ (call (toplevel bar))
+ (lambda ()
+ (lambda-case
+ ((() #f #f #f () ()) (toplevel baz)))))
+ (lambda-case
+ ((() #f vals #f () (_))
+ (seq (toplevel baz)
+ (primcall @apply (primitive values) (lexical vals _))))))))
(pass-if-peval
;; Prompt is removed if tag is unreferenced
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, master, updated. v2.1.0-45-g9b96563,
Andy Wingo <=