[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, master, updated. v2.1.0-581-g3652769
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] GNU Guile branch, master, updated. v2.1.0-581-g3652769 |
|
Date: |
Sun, 12 Jan 2014 11:44:18 +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=3652769585f6bb8f9feb4f5c03381a567f26b7f0
The branch, master has been updated
via 3652769585f6bb8f9feb4f5c03381a567f26b7f0 (commit)
via 97cfb467f921406925bc12686f175f2221a92795 (commit)
from 310866418b17cc4b340d325c960a4fb9f7b7d629 (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 3652769585f6bb8f9feb4f5c03381a567f26b7f0
Author: Andy Wingo <address@hidden>
Date: Sun Jan 12 12:37:05 2014 +0100
Rename $ktrunc to $kreceive
* module/language/cps.scm ($kreceive): Rename from ktrunc.
* module/language/cps/arities.scm:
* module/language/cps/compile-bytecode.scm:
* module/language/cps/dce.scm:
* module/language/cps/dfg.scm:
* module/language/cps/effects-analysis.scm:
* module/language/cps/elide-values.scm:
* module/language/cps/simplify.scm:
* module/language/cps/slot-allocation.scm:
* module/language/cps/verify.scm:
* module/language/tree-il/compile-cps.scm: Adapt all users.
commit 97cfb467f921406925bc12686f175f2221a92795
Author: Andy Wingo <address@hidden>
Date: Sun Jan 12 12:28:12 2014 +0100
Returning too many values to call-with-values raises a runtime error
* module/language/cps/compile-bytecode.scm (compile-fun): Now that all
$call expressions continue to $ktail or $ktrunc, remove the $kargs
case, and make receive-values bail if too many values are returned.
-----------------------------------------------------------------------
Summary of changes:
module/language/cps.scm | 20 ++++++++--------
module/language/cps/arities.scm | 6 ++--
module/language/cps/compile-bytecode.scm | 29 +++--------------------
module/language/cps/dce.scm | 8 +++---
module/language/cps/dfg.scm | 4 +-
module/language/cps/effects-analysis.scm | 4 +-
module/language/cps/elide-values.scm | 4 +-
module/language/cps/simplify.scm | 10 ++++----
module/language/cps/slot-allocation.scm | 26 ++++++++++----------
module/language/cps/verify.scm | 2 +-
module/language/tree-il/compile-cps.scm | 36 +++++++++++++++---------------
11 files changed, 64 insertions(+), 85 deletions(-)
diff --git a/module/language/cps.scm b/module/language/cps.scm
index 8aac42b..b4bcbb5 100644
--- a/module/language/cps.scm
+++ b/module/language/cps.scm
@@ -53,7 +53,7 @@
;;;
;;; There are some Guile-specific quirks as well:
;;;
-;;; - $ktrunc represents a continuation that receives multiple values,
+;;; - $kreceive represents a continuation that receives multiple values,
;;; but which truncates them to some number of required values,
;;; possibly with a rest list.
;;;
@@ -118,7 +118,7 @@
$cont
;; Continuation bodies.
- $kif $ktrunc $kargs $kentry $ktail $kclause
+ $kif $kreceive $kargs $kentry $ktail $kclause
;; Expressions.
$void $const $prim $fun $call $primcall $values $prompt
@@ -170,7 +170,7 @@
;; Continuations
(define-cps-type $cont k cont)
(define-cps-type $kif kt kf)
-(define-cps-type $ktrunc arity k)
+(define-cps-type $kreceive arity k)
(define-cps-type $kargs names syms body)
(define-cps-type $kentry self tail clauses)
(define-cps-type $ktail)
@@ -199,13 +199,13 @@
(make-$arity req opt rest kw allow-other-keys?))))
(define-syntax build-cont-body
- (syntax-rules (unquote $kif $ktrunc $kargs $kentry $ktail $kclause)
+ (syntax-rules (unquote $kif $kreceive $kargs $kentry $ktail $kclause)
((_ (unquote exp))
exp)
((_ ($kif kt kf))
(make-$kif kt kf))
- ((_ ($ktrunc req rest kargs))
- (make-$ktrunc (make-$arity req '() rest '() #f) kargs))
+ ((_ ($kreceive req rest kargs))
+ (make-$kreceive (make-$arity req '() rest '() #f) kargs))
((_ ($kargs (name ...) (sym ...) body))
(make-$kargs (list name ...) (list sym ...) (build-cps-term body)))
((_ ($kargs names syms body))
@@ -303,8 +303,8 @@
(sym ,(parse-cps body))))
(('kif kt kf)
(build-cont-body ($kif kt kf)))
- (('ktrunc req rest k)
- (build-cont-body ($ktrunc req rest k)))
+ (('kreceive req rest k)
+ (build-cont-body ($kreceive req rest k)))
(('kargs names syms body)
(build-cont-body ($kargs names syms ,(parse-cps body))))
(('kentry self tail clauses)
@@ -361,8 +361,8 @@
`(k ,sym ,(unparse-cps body)))
(($ $kif kt kf)
`(kif ,kt ,kf))
- (($ $ktrunc ($ $arity req () rest '() #f) k)
- `(ktrunc ,req ,rest ,k))
+ (($ $kreceive ($ $arity req () rest '() #f) k)
+ `(kreceive ,req ,rest ,k))
(($ $kargs () () body)
`(kseq ,(unparse-cps body)))
(($ $kargs names syms body)
diff --git a/module/language/cps/arities.scm b/module/language/cps/arities.scm
index 052208f..6c589a3 100644
--- a/module/language/cps/arities.scm
+++ b/module/language/cps/arities.scm
@@ -1,6 +1,6 @@
;;; Continuation-passing style (CPS) intermediate language (IL)
-;; Copyright (C) 2013 Free Software Foundation, Inc.
+;; Copyright (C) 2013, 2014 Free Software Foundation, Inc.
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -58,7 +58,7 @@
(kvoid ($kargs () ()
($continue kunspec src ($void)))))
($continue kvoid src ,exp)))))
- (($ $ktrunc arity kargs)
+ (($ $kreceive arity kargs)
,(match arity
(($ $arity () () rest () #f)
(if rest
@@ -99,7 +99,7 @@
($continue k src
($primcall 'return (v))))))
($continue k* src ,exp)))))))
- (($ $ktrunc arity kargs)
+ (($ $kreceive arity kargs)
,(match arity
(($ $arity (_) () rest () #f)
(if rest
diff --git a/module/language/cps/compile-bytecode.scm
b/module/language/cps/compile-bytecode.scm
index 5b03f6d..e5c6ef8 100644
--- a/module/language/cps/compile-bytecode.scm
+++ b/module/language/cps/compile-bytecode.scm
@@ -204,7 +204,7 @@
(and (= k-idx (1+ n))
(< (+ n 2) (cfa-k-count cfa))
(cfa-k-sym cfa (+ n 2)))))
- (($ $ktrunc ($ $arity req () rest () #f) kargs)
+ (($ $kreceive ($ $arity req () rest () #f) kargs)
(compile-trunc label k exp (length req)
(and rest
(match (vector-ref contv (cfa-k-idx cfa kargs))
@@ -259,24 +259,6 @@
(emit-load-static-procedure asm dst k))
(($ $fun src meta free ($ $cont k))
(emit-make-closure asm dst k (length free)))
- (($ $call proc args)
- (let* ((proc-slot (lookup-call-proc-slot label allocation))
- (nargs (1+ (length args)))
- (arg-slots (map (lambda (x) (+ x proc-slot)) (iota nargs))))
- (for-each (match-lambda
- ((src . dst) (emit-mov asm dst src)))
- (lookup-parallel-moves label allocation))
- (for-each maybe-load-constant arg-slots (cons proc args))
- (emit-call asm proc-slot nargs)
- (cond
- (dst
- (emit-receive asm dst proc-slot nlocals))
- (else
- ;; FIXME: Only allow more values if there is a rest arg.
- ;; Express values truncation by the presence of an
- ;; unused rest arg instead of implicitly.
- (emit-receive-values asm proc-slot #t 1)
- (emit-reset-frame asm nlocals)))))
(($ $primcall 'current-module)
(emit-current-module asm dst))
(($ $primcall 'cached-toplevel-box (scope name bound?))
@@ -331,7 +313,7 @@
(($ $values ()) #f)
(($ $prompt escape? tag handler)
(match (lookup-cont handler)
- (($ $ktrunc ($ $arity req () rest () #f) khandler-body)
+ (($ $kreceive ($ $arity req () rest () #f) khandler-body)
(let ((receive-args (gensym "handler"))
(nreq (length req))
(proc-slot (lookup-call-proc-slot handler allocation)))
@@ -481,11 +463,8 @@
=> (lambda (dst)
(emit-receive asm dst proc-slot nlocals)))
(else
- ;; FIXME: Only allow more values if there is a rest arg.
- ;; Express values truncation by the presence of an unused
- ;; rest arg instead of implicitly.
- (unless (zero? nreq)
- (emit-receive-values asm proc-slot #t nreq))
+ (unless (and (zero? nreq) rest-var)
+ (emit-receive-values asm proc-slot (->bool rest-var) nreq))
(when (and rest-var (maybe-slot rest-var))
(emit-bind-rest asm (+ proc-slot 1 nreq)))
(for-each (match-lambda
diff --git a/module/language/cps/dce.scm b/module/language/cps/dce.scm
index b32dea0..98c1f2c 100644
--- a/module/language/cps/dce.scm
+++ b/module/language/cps/dce.scm
@@ -73,7 +73,7 @@
(($ $kargs _ _ body)
(match (find-call body)
(($ $continue k) (cont-defs k))))
- (($ $ktrunc arity kargs)
+ (($ $kreceive arity kargs)
(cont-defs kargs))
(($ $kclause arity ($ $cont kargs ($ $kargs names syms)))
syms)
@@ -156,7 +156,7 @@
(when (value-live? def)
(mark-live! use)))
args defs))))))))))
- (($ $ktrunc arity kargs) #f)
+ (($ $kreceive arity kargs) #f)
(($ $kif) #f)
(($ $kclause arity ($ $cont kargs ($ $kargs names syms body)))
(for-each mark-live! syms))
@@ -219,14 +219,14 @@
(build-cps-cont
(sym ($kclause ,arity
,(must-visit-cont body))))))
- (($ $ktrunc ($ $arity req () rest () #f) kargs)
+ (($ $kreceive ($ $arity req () rest () #f) kargs)
(let ((defs (vector-ref defs n)))
(if (and-map value-live? defs)
(list (build-cps-cont (sym ,cont)))
(let-gensyms (adapt)
(list (make-adaptor adapt kargs defs)
(build-cps-cont
- (sym ($ktrunc req rest adapt))))))))
+ (sym ($kreceive req rest adapt))))))))
(_ (list (build-cps-cont (sym ,cont))))))))))
(define (visit-conts conts)
(append-map visit-cont conts))
diff --git a/module/language/cps/dfg.scm b/module/language/cps/dfg.scm
index 59e61e5..dd612eb 100644
--- a/module/language/cps/dfg.scm
+++ b/module/language/cps/dfg.scm
@@ -822,7 +822,7 @@ BODY for each body continuation in the prompt."
(use-k! kt)
(use-k! kf))
- (($ $ktrunc arity k)
+ (($ $kreceive arity k)
(use-k! k))
(($ $letrec names syms funs body)
@@ -949,7 +949,7 @@ BODY for each body continuation in the prompt."
(define (find-defining-expression sym dfg)
(match (find-defining-term sym dfg)
(#f #f)
- (($ $ktrunc) #f)
+ (($ $kreceive) #f)
(($ $kclause) #f)
(term (find-expression term))))
diff --git a/module/language/cps/effects-analysis.scm
b/module/language/cps/effects-analysis.scm
index 9db88b7..46c7e88 100644
--- a/module/language/cps/effects-analysis.scm
+++ b/module/language/cps/effects-analysis.scm
@@ -1,6 +1,6 @@
;;; Effects analysis on CPS
-;; Copyright (C) 2011, 2012, 2013 Free Software Foundation, Inc.
+;; Copyright (C) 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -466,7 +466,7 @@
(match (lookup-cont (cfa-k-sym cfa n) (dfg-cont-table dfg))
(($ $kargs names syms body)
(expression-effects (find-expression body) dfg))
- (($ $ktrunc arity kargs)
+ (($ $kreceive arity kargs)
(match arity
(($ $arity _ () #f () #f) (cause &type-check))
(($ $arity () () _ () #f) (cause &allocation))
diff --git a/module/language/cps/elide-values.scm
b/module/language/cps/elide-values.scm
index 6069612..d6590aa 100644
--- a/module/language/cps/elide-values.scm
+++ b/module/language/cps/elide-values.scm
@@ -1,6 +1,6 @@
;;; Continuation-passing style (CPS) intermediate language (IL)
-;; Copyright (C) 2013 Free Software Foundation, Inc.
+;; Copyright (C) 2013, 2014 Free Software Foundation, Inc.
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -60,7 +60,7 @@
,(rewrite-cps-term (lookup-cont k conts)
(($ $ktail)
($continue k src ($values vals)))
- (($ $ktrunc ($ $arity req () rest () #f) kargs)
+ (($ $kreceive ($ $arity req () rest () #f) kargs)
,(cond
((and (not rest) (= (length vals) (length req)))
(build-cps-term
diff --git a/module/language/cps/simplify.scm b/module/language/cps/simplify.scm
index 904ec0b..0e3c831 100644
--- a/module/language/cps/simplify.scm
+++ b/module/language/cps/simplify.scm
@@ -89,7 +89,7 @@
(sym ($kentry self ,tail ,(visit-conts clauses))))
(($ $kclause arity body)
(sym ($kclause ,arity ,(must-visit-cont body))))
- ((or ($ $ktrunc) ($ $kif))
+ ((or ($ $kreceive) ($ $kif))
(sym ,cont)))))))
(define (visit-conts conts)
(filter-map visit-cont conts))
@@ -135,8 +135,8 @@
(sym ($kentry self ,tail ,(map (cut visit-cont <> sym) clauses))))
(($ $cont sym ($ $kclause arity body))
(sym ($kclause ,arity ,(visit-cont body sym))))
- (($ $cont sym ($ $ktrunc ($ $arity req () rest () #f) kargs))
- (sym ($ktrunc req rest (reduce kargs scope))))
+ (($ $cont sym ($ $kreceive ($ $arity req () rest () #f) kargs))
+ (sym ($kreceive req rest (reduce kargs scope))))
(($ $cont sym ($ $kif kt kf))
(sym ($kif (reduce kt scope) (reduce kf scope))))))
(define (visit-term term scope)
@@ -175,7 +175,7 @@
(for-each visit-cont clauses))
(($ $cont sym ($ $kclause arity body))
(visit-cont body))
- (($ $cont sym (or ($ $ktail) ($ $ktrunc) ($ $kif)))
+ (($ $cont sym (or ($ $ktail) ($ $kreceive) ($ $kif)))
#f)))
(define (visit-term term)
(match term
@@ -230,7 +230,7 @@
(sym ($kentry self ,tail ,(map must-visit-cont clauses))))
(($ $kclause arity body)
(sym ($kclause ,arity ,(must-visit-cont body))))
- ((or ($ $ktrunc) ($ $kif))
+ ((or ($ $kreceive) ($ $kif))
(sym ,cont)))))))
(define (visit-term term)
(match term
diff --git a/module/language/cps/slot-allocation.scm
b/module/language/cps/slot-allocation.scm
index 5e92a6a..946257b 100644
--- a/module/language/cps/slot-allocation.scm
+++ b/module/language/cps/slot-allocation.scm
@@ -77,16 +77,16 @@
;; are called "call moves", and moves to handle a return are "return
;; moves".
;;
- ;; $ktrunc continuations record a proc slot and a set of return moves
+ ;; $kreceive continuations record a proc slot and a set of return moves
;; to adapt multiple values from the stack to local variables.
;;
;; Tail calls record arg moves, but no proc slot.
;;
;; Non-tail calls record arg moves and a call slot. Multiple-valued
- ;; returns will have an associated $ktrunc continuation, which records
+ ;; returns will have an associated $kreceive continuation, which records
;; the same proc slot, but has return moves.
;;
- ;; $prompt handlers are $ktrunc continuations like any other.
+ ;; $prompt handlers are $kreceive continuations like any other.
;;
;; $values expressions with more than 1 value record moves but have no
;; proc slot.
@@ -357,28 +357,28 @@ are comparable with eqv?. A tmp slot may be used."
;; Results of function calls that are not used don't need to be
;; allocated to slots.
(define (compute-unused-results!)
- (define (ktrunc-get-kargs n)
+ (define (kreceive-get-kargs n)
(match (vector-ref contv n)
- (($ $ktrunc arity kargs) (cfa-k-idx cfa kargs))
+ (($ $kreceive arity kargs) (cfa-k-idx cfa kargs))
(_ #f)))
(let ((candidates (make-bitvector (vector-length contv) #f)))
- ;; Find all $kargs that are the successors of $ktrunc nodes.
+ ;; Find all $kargs that are the successors of $kreceive nodes.
(let lp ((n 0))
(when (< n (vector-length contv))
- (and=> (ktrunc-get-kargs n)
+ (and=> (kreceive-get-kargs n)
(lambda (kargs)
(bitvector-set! candidates kargs #t)))
(lp (1+ n))))
- ;; For $kargs that only have $ktrunc predecessors, remove unused
+ ;; For $kargs that only have $kreceive predecessors, remove unused
;; variables from the needs-slotv set.
(let lp ((n 0))
(let ((n (bit-position #t candidates n)))
(when n
(match (cfa-predecessors cfa n)
- ;; At least one ktrunc is in the predecessor set, so we
+ ;; At least one kreceive is in the predecessor set, so we
;; only need to do the check for nodes with >1
;; predecessor.
- ((or (_) ((? ktrunc-get-kargs) ...))
+ ((or (_) ((? kreceive-get-kargs) ...))
(for-each (lambda (var)
(when (dead-after-def? (cfa-k-sym cfa n) var dfa)
(bitvector-set! needs-slotv var #f)))
@@ -486,7 +486,7 @@ are comparable with eqv?. A tmp slot may be used."
(bump-nlocals! tail-nlocals)
(hashq-set! call-allocations label
(make-call-allocation #f moves))))
- (($ $ktrunc arity kargs)
+ (($ $kreceive arity kargs)
(let* ((proc-slot (compute-call-proc-slot post-live))
(call-slots (map (cut + proc-slot <>) (iota (length uses))))
(pre-live (fold allocate! pre-live uses call-slots))
@@ -571,7 +571,7 @@ are comparable with eqv?. A tmp slot may be used."
(define (allocate-prompt label k handler nargs)
(match (vector-ref contv (cfa-k-idx cfa handler))
- (($ $ktrunc arity kargs)
+ (($ $kreceive arity kargs)
(let* ((handler-live (recompute-live-slots handler nargs))
(proc-slot (compute-prompt-handler-proc-slot handler-live))
(result-vars (vector-ref defv (cfa-k-idx cfa kargs)))
@@ -639,7 +639,7 @@ are comparable with eqv?. A tmp slot may be used."
(allocate-prompt label k handler nargs))
(_ #f)))
(lp (1+ n) post-live))
- ((or ($ $ktrunc) ($ $kif) ($ $ktail))
+ ((or ($ $kreceive) ($ $kif) ($ $ktail))
(lp (1+ n) post-live)))))))
(define (visit-entry)
diff --git a/module/language/cps/verify.scm b/module/language/cps/verify.scm
index 94c111e..9da5037 100644
--- a/module/language/cps/verify.scm
+++ b/module/language/cps/verify.scm
@@ -59,7 +59,7 @@
(($ $kif kt kf)
(check-var kt k-env)
(check-var kf k-env))
- (($ $ktrunc ($ $arity ((? symbol?) ...) () (or #f (? symbol?)) () #f) k)
+ (($ $kreceive ($ $arity ((? symbol?) ...) () (or #f (? symbol?)) () #f)
k)
(check-var k k-env))
(($ $kargs ((? symbol? name) ...) ((? symbol? sym) ...) body)
(unless (= (length name) (length sym))
diff --git a/module/language/tree-il/compile-cps.scm
b/module/language/tree-il/compile-cps.scm
index 1960023..6e987a3 100644
--- a/module/language/tree-il/compile-cps.scm
+++ b/module/language/tree-il/compile-cps.scm
@@ -178,7 +178,7 @@
($continue k src ($primcall 'box (phi))))))
,(make-body kbox))))
(make-body k)))
- (let-gensyms (knext kbound kunbound ktrunc krest val rest)
+ (let-gensyms (knext kbound kunbound kreceive krest val rest)
(build-cps-term
($letk ((knext ($kargs (name) (subst-sym) ,body)))
,(maybe-box
@@ -189,9 +189,9 @@
($values (sym)))))
(krest ($kargs (name 'rest) (val rest)
($continue k src ($values (val)))))
- (ktrunc ($ktrunc (list name) 'rest krest))
+ (kreceive ($kreceive (list name) 'rest krest))
(kunbound ($kargs () ()
- ,(convert init ktrunc subst))))
+ ,(convert init kreceive subst))))
,(unbound? src sym kunbound kbound))))))))))))
;; exp k-name alist -> term
@@ -209,11 +209,11 @@
((subst #f) (k subst))
(#f (k sym))))
(else
- (let-gensyms (ktrunc karg arg rest)
+ (let-gensyms (kreceive karg arg rest)
(build-cps-term
($letk ((karg ($kargs ('arg 'rest) (arg rest) ,(k arg)))
- (ktrunc ($ktrunc '(arg) 'rest karg)))
- ,(convert exp ktrunc subst)))))))
+ (kreceive ($kreceive '(arg) 'rest karg)))
+ ,(convert exp kreceive subst)))))))
;; (exp ...) ((v-name ...) -> term) -> term
(define (convert-args exps k)
(match exps
@@ -429,12 +429,12 @@
(let ((hnames (append hreq (if hrest (list hrest) '()))))
(let-gensyms (khargs khbody kret kprim prim kpop krest vals kbody)
(build-cps-term
- ;; FIXME: Attach hsrc to $ktrunc.
+ ;; FIXME: Attach hsrc to $kreceive.
($letk* ((khbody ($kargs hnames hsyms
,(fold box-bound-var
(convert hbody k subst)
hnames hsyms)))
- (khargs ($ktrunc hreq hrest khbody))
+ (khargs ($kreceive hreq hrest khbody))
(kpop ($kargs ('rest) (vals)
($letk ((kret
($kargs () ()
@@ -447,7 +447,7 @@
($prim 'values))))))
($continue kret src
($primcall 'unwind ())))))
- (krest ($ktrunc '() 'rest kpop)))
+ (krest ($kreceive '() 'rest kpop)))
,(if escape-only?
(build-cps-term
($letk ((kbody ($kargs () ()
@@ -539,25 +539,25 @@
($continue k src ($primcall 'box-set! (box exp)))))))))
(($ <seq> src head tail)
- (let-gensyms (ktrunc kseq vals)
+ (let-gensyms (kreceive kseq vals)
(build-cps-term
($letk* ((kseq ($kargs ('vals) (vals)
,(convert tail k subst)))
- (ktrunc ($ktrunc '() 'vals kseq)))
- ,(convert head ktrunc subst)))))
+ (kreceive ($kreceive '() 'vals kseq)))
+ ,(convert head kreceive subst)))))
(($ <let> src names syms vals body)
(let lp ((names names) (syms syms) (vals vals))
(match (list names syms vals)
((() () ()) (convert body k subst))
(((name . names) (sym . syms) (val . vals))
- (let-gensyms (ktrunc klet rest)
+ (let-gensyms (kreceive klet rest)
(build-cps-term
($letk* ((klet ($kargs (name 'rest) (sym rest)
,(box-bound-var name sym
(lp names syms vals))))
- (ktrunc ($ktrunc (list name) 'rest klet)))
- ,(convert val ktrunc subst))))))))
+ (kreceive ($kreceive (list name) 'rest klet)))
+ ,(convert val kreceive subst))))))))
(($ <fix> src names gensyms funs body)
;; Some letrecs can be contified; that happens later.
@@ -582,14 +582,14 @@
(($ <let-values> src exp
($ <lambda-case> lsrc req #f rest #f () syms body #f))
(let ((names (append req (if rest (list rest) '()))))
- (let-gensyms (ktrunc kargs)
+ (let-gensyms (kreceive kargs)
(build-cps-term
($letk* ((kargs ($kargs names syms
,(fold box-bound-var
(convert body k subst)
names syms)))
- (ktrunc ($ktrunc req rest kargs)))
- ,(convert exp ktrunc subst))))))))
+ (kreceive ($kreceive req rest kargs)))
+ ,(convert exp kreceive subst))))))))
(define (build-subst exp)
"Compute a mapping from lexical gensyms to substituted gensyms. The
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, master, updated. v2.1.0-581-g3652769,
Andy Wingo <=