[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 04/04: Remove "free" field of $fun
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] 04/04: Remove "free" field of $fun |
|
Date: |
Wed, 01 Apr 2015 08:27:47 +0000 |
wingo pushed a commit to branch master
in repository guile.
commit 50fcdfece306a437ebad326679245e206cfbe6b2
Author: Andy Wingo <address@hidden>
Date: Thu Mar 26 14:10:09 2015 +0100
Remove "free" field of $fun
* module/language/cps.scm ($fun): Remove unused "free" field.
* module/language/cps/arities.scm:
* module/language/cps/closure-conversion.scm:
* module/language/cps/constructors.scm:
* module/language/cps/contification.scm:
* module/language/cps/cse.scm:
* module/language/cps/dce.scm:
* module/language/cps/dfg.scm:
* module/language/cps/elide-values.scm:
* module/language/cps/prune-bailouts.scm:
* module/language/cps/prune-top-level-scopes.scm:
* module/language/cps/renumber.scm:
* module/language/cps/self-references.scm:
* module/language/cps/simplify.scm:
* module/language/cps/specialize-primcalls.scm:
* module/language/cps/type-fold.scm:
* module/language/cps/verify.scm:
* module/language/tree-il/compile-cps.scm: Adapt all callers.
---
module/language/cps.scm | 16 ++++++++--------
module/language/cps/arities.scm | 8 ++++----
module/language/cps/closure-conversion.scm | 8 ++++----
module/language/cps/constructors.scm | 4 ++--
module/language/cps/contification.scm | 14 +++++++-------
module/language/cps/cse.scm | 6 +++---
module/language/cps/dce.scm | 12 ++++++------
module/language/cps/dfg.scm | 6 +++---
module/language/cps/elide-values.scm | 4 ++--
module/language/cps/prune-bailouts.scm | 4 ++--
module/language/cps/prune-top-level-scopes.scm | 2 +-
module/language/cps/renumber.scm | 8 ++++----
module/language/cps/self-references.scm | 8 ++++----
module/language/cps/simplify.scm | 18 +++++++++---------
module/language/cps/specialize-primcalls.scm | 4 ++--
module/language/cps/type-fold.scm | 4 ++--
module/language/cps/verify.scm | 3 +--
module/language/tree-il/compile-cps.scm | 2 +-
18 files changed, 65 insertions(+), 66 deletions(-)
diff --git a/module/language/cps.scm b/module/language/cps.scm
index 3e0748f..befa20f 100644
--- a/module/language/cps.scm
+++ b/module/language/cps.scm
@@ -71,7 +71,7 @@
;;; That's to say that a $fun can be matched like this:
;;;
;;; (match f
-;;; (($ $fun free
+;;; (($ $fun
;;; ($ $cont kfun
;;; ($ $kfun src meta self ($ $cont ktail ($ $ktail))
;;; ($ $kclause arity
@@ -189,7 +189,7 @@
;; Expressions.
(define-cps-type $const val)
(define-cps-type $prim name)
-(define-cps-type $fun free body) ; Higher-order.
+(define-cps-type $fun body) ; Higher-order.
(define-cps-type $rec names syms funs) ; Higher-order.
(define-cps-type $closure label nfree) ; First-order.
(define-cps-type $branch k exp)
@@ -268,7 +268,7 @@
((_ (unquote exp)) exp)
((_ ($const val)) (make-$const val))
((_ ($prim name)) (make-$prim name))
- ((_ ($fun free body)) (make-$fun free (build-cps-cont body)))
+ ((_ ($fun body)) (make-$fun (build-cps-cont body)))
((_ ($rec names gensyms funs)) (make-$rec names gensyms funs))
((_ ($closure k nfree)) (make-$closure k nfree))
((_ ($call proc (unquote args))) (make-$call proc args))
@@ -381,8 +381,8 @@
(build-cps-exp ($const exp)))
(('prim name)
(build-cps-exp ($prim name)))
- (('fun free body)
- (build-cps-exp ($fun free ,(parse-cps body))))
+ (('fun body)
+ (build-cps-exp ($fun ,(parse-cps body))))
(('closure k nfree)
(build-cps-exp ($closure k nfree)))
(('rec (name sym fun) ...)
@@ -439,8 +439,8 @@
`(const ,val))
(($ $prim name)
`(prim ,name))
- (($ $fun free body)
- `(fun ,free ,(unparse-cps body)))
+ (($ $fun body)
+ `(fun ,(unparse-cps body)))
(($ $closure k nfree)
`(closure ,k ,nfree))
(($ $rec names syms funs)
@@ -490,7 +490,7 @@
(define (fun-folder fun seed ...)
(match fun
- (($ $fun free body)
+ (($ $fun body)
(cont-folder body seed ...))))
(define (term-folder term seed ...)
diff --git a/module/language/cps/arities.scm b/module/language/cps/arities.scm
index 7448eb0..fa7cc14 100644
--- a/module/language/cps/arities.scm
+++ b/module/language/cps/arities.scm
@@ -133,16 +133,16 @@
($ $prim)
($ $values (_)))
,(adapt-exp 1 k src exp))
- (($ $fun free body)
+ (($ $fun body)
,(adapt-exp 1 k src (build-cps-exp
- ($fun free ,(fix-arities* body dfg)))))
+ ($fun ,(fix-arities* body dfg)))))
(($ $rec names syms funs)
;; Assume $rec expressions have the correct arity.
($continue k src
($rec names syms (map (lambda (fun)
(rewrite-cps-exp fun
- (($ $fun free body)
- ($fun free ,(fix-arities* body dfg)))))
+ (($ $fun body)
+ ($fun ,(fix-arities* body dfg)))))
funs))))
((or ($ $call) ($ $callk))
;; In general, calls have unknown return arity. For that
diff --git a/module/language/cps/closure-conversion.scm
b/module/language/cps/closure-conversion.scm
index 8848e07..49ff30f 100644
--- a/module/language/cps/closure-conversion.scm
+++ b/module/language/cps/closure-conversion.scm
@@ -99,14 +99,14 @@
(union (visit-cont cont bound) free))
(visit-term body bound)
conts))
- (($ $continue k src ($ $fun () body))
+ (($ $continue k src ($ $fun body))
(match (lookup-predecessors k dfg)
((_) (match (lookup-cont k dfg)
(($ $kargs (name) (var))
(add-named-fun! var body))))
(_ #f))
(visit-cont body bound))
- (($ $continue k src ($ $rec names vars (($ $fun () cont) ...)))
+ (($ $continue k src ($ $rec names vars (($ $fun cont) ...)))
(hashq-set! letrec-conts k (lookup-cont k dfg))
(let ((bound (append vars bound)))
(for-each add-named-fun! vars cont)
@@ -443,7 +443,7 @@ bound to @var{var}, and continue with @var{body}."
(($ $continue k src (or ($ $const) ($ $prim)))
term)
- (($ $continue k src ($ $fun () ($ $cont kfun)))
+ (($ $continue k src ($ $fun ($ $cont kfun)))
(let ((fun-free (hashq-ref free-vars kfun)))
(match (cons (well-known? kfun) fun-free)
((known?)
@@ -479,7 +479,7 @@ bound to @var{var}, and continue with @var{body}."
(visit-term body)))))
(match in
(() (bindings body))
- (((name var ($ $fun ()
+ (((name var ($ $fun
(and fun-body
($ $cont kfun ($ $kfun src))))) . in)
(let ((fun-free (hashq-ref free-vars kfun)))
diff --git a/module/language/cps/constructors.scm
b/module/language/cps/constructors.scm
index 1416f17..bbe779d 100644
--- a/module/language/cps/constructors.scm
+++ b/module/language/cps/constructors.scm
@@ -94,8 +94,8 @@
,term)))
(define (visit-fun fun)
(rewrite-cps-exp fun
- (($ $fun free body)
- ($fun free ,(inline-constructors* body)))))
+ (($ $fun body)
+ ($fun ,(inline-constructors* body)))))
(visit-cont fun))
diff --git a/module/language/cps/contification.scm
b/module/language/cps/contification.scm
index 88bc097..1f70231 100644
--- a/module/language/cps/contification.scm
+++ b/module/language/cps/contification.scm
@@ -216,7 +216,7 @@
(define (visit-fun term)
(match term
- (($ $fun free body)
+ (($ $fun body)
(visit-cont body))))
(define (visit-cont cont)
(match cont
@@ -236,7 +236,7 @@
(visit-term body term-k))
(($ $continue k src exp)
(match exp
- (($ $fun free
+ (($ $fun
($ $cont fun-k
($ $kfun src meta self ($ $cont tail-k ($ $ktail)) clause)))
(if (and=> (bound-symbol k)
@@ -261,7 +261,7 @@
(if (null? rec)
'()
(list rec)))
- (((and elt (n s ($ $fun free ($ $cont kfun))))
+ (((and elt (n s ($ $fun ($ $cont kfun))))
. nsf)
(if (recursive? kfun)
(lp nsf (cons elt rec))
@@ -273,7 +273,7 @@
(match component
(((name sym fun) ...)
(match fun
- ((($ $fun free
+ ((($ $fun
($ $cont fun-k
($ $kfun src meta self ($ $cont tail-k ($ $ktail))
clause)))
@@ -342,8 +342,8 @@
,body)))))))
(define (visit-fun term)
(rewrite-cps-exp term
- (($ $fun free body)
- ($fun free ,(visit-cont body)))))
+ (($ $fun body)
+ ($fun ,(visit-cont body)))))
(define (visit-cont cont)
(rewrite-cps-cont cont
(($ $cont label ($ $kargs names syms body))
@@ -381,7 +381,7 @@
(splice-continuations
term-k
(match exp
- (($ $fun free
+ (($ $fun
($ $cont fun-k ($ $kfun src meta self ($ $cont tail-k))))
;; If the function's tail continuation has been substituted,
;; that means it has been contified.
diff --git a/module/language/cps/cse.scm b/module/language/cps/cse.scm
index 3534596..c8a57ca 100644
--- a/module/language/cps/cse.scm
+++ b/module/language/cps/cse.scm
@@ -287,7 +287,7 @@ could be that both true and false proofs are available."
(match exp
(($ $const val) (cons 'const val))
(($ $prim name) (cons 'prim name))
- (($ $fun free body) #f)
+ (($ $fun body) #f)
(($ $rec names syms funs) #f)
(($ $call proc args) #f)
(($ $callk k proc args) #f)
@@ -469,8 +469,8 @@ could be that both true and false proofs are available."
(define (visit-fun fun)
(rewrite-cps-exp fun
- (($ $fun free body)
- ($fun (map subst-var free) ,(cse body dfg)))))
+ (($ $fun body)
+ ($fun ,(cse body dfg)))))
(define (visit-exp* k src exp)
(match exp
diff --git a/module/language/cps/dce.scm b/module/language/cps/dce.scm
index 0be9d61..34ffc3a 100644
--- a/module/language/cps/dce.scm
+++ b/module/language/cps/dce.scm
@@ -199,13 +199,13 @@
(match exp
((or ($ $const) ($ $prim))
#f)
- (($ $fun free body)
+ (($ $fun body)
(visit-fun body))
(($ $rec names syms funs)
(for-each (lambda (sym fun)
(when (value-live? sym)
(match fun
- (($ $fun free body)
+ (($ $fun body)
(visit-fun body)))))
syms funs))
(($ $prompt escape? tag handler)
@@ -320,20 +320,20 @@
(($ $continue k src exp)
(if (bitvector-ref live-conts (label->idx term-k))
(match exp
- (($ $fun free body)
+ (($ $fun body)
(build-cps-term
- ($continue k src ($fun free ,(visit-fun body)))))
+ ($continue k src ($fun ,(visit-fun body)))))
(($ $rec names syms funs)
(rewrite-cps-term
(filter-map
(lambda (name sym fun)
(and (value-live? sym)
(match fun
- (($ $fun free body)
+ (($ $fun body)
(list name
sym
(build-cps-exp
- ($fun free ,(visit-fun body))))))))
+ ($fun ,(visit-fun body))))))))
names syms funs)
(()
($continue k src ($values ())))
diff --git a/module/language/cps/dfg.scm b/module/language/cps/dfg.scm
index 6cba764..22bc159 100644
--- a/module/language/cps/dfg.scm
+++ b/module/language/cps/dfg.scm
@@ -660,7 +660,7 @@ body continuation in the prompt."
(($ $prompt escape? tag handler)
(use! tag)
(link-blocks! label handler))
- (($ $fun free body)
+ (($ $fun body)
(when global?
(visit-fun body)))
(($ $rec names syms funs)
@@ -668,7 +668,7 @@ body continuation in the prompt."
(error "$rec should not be present when building a local DFG"))
(for-each (lambda (fun)
(match fun
- (($ $fun free body)
+ (($ $fun body)
(visit-fun body))))
funs))))
@@ -748,7 +748,7 @@ body continuation in the prompt."
(match exp
(($ $const val) (format port "const address@hidden" val))
(($ $prim name) (format port "prim ~a" name))
- (($ $fun free ($ $cont kbody)) (format port "fun k~a"
kbody))
+ (($ $fun ($ $cont kbody)) (format port "fun k~a" kbody))
(($ $rec names syms funs) (format port "rec~{ v~a~}" syms))
(($ $closure label nfree) (format port "closure k~a (~a
free)" label nfree))
(($ $call proc args) (format port "call~{ v~a~}" (cons
proc args)))
diff --git a/module/language/cps/elide-values.scm
b/module/language/cps/elide-values.scm
index 100ad1f..dadbd40 100644
--- a/module/language/cps/elide-values.scm
+++ b/module/language/cps/elide-values.scm
@@ -98,8 +98,8 @@
,term)))
(define (visit-fun fun)
(rewrite-cps-exp fun
- (($ $fun free cont)
- ($fun free ,(visit-cont cont)))))
+ (($ $fun cont)
+ ($fun ,(visit-cont cont)))))
(visit-cont fun))
diff --git a/module/language/cps/prune-bailouts.scm
b/module/language/cps/prune-bailouts.scm
index cc0c08b..c224f45 100644
--- a/module/language/cps/prune-bailouts.scm
+++ b/module/language/cps/prune-bailouts.scm
@@ -87,8 +87,8 @@
(define (visit-fun fun)
(rewrite-cps-exp fun
- (($ $fun free body)
- ($fun free ,(prune-bailouts* body)))))
+ (($ $fun body)
+ ($fun ,(prune-bailouts* body)))))
(rewrite-cps-cont fun
(($ $cont kfun
diff --git a/module/language/cps/prune-top-level-scopes.scm
b/module/language/cps/prune-top-level-scopes.scm
index f300db4..4839b71 100644
--- a/module/language/cps/prune-top-level-scopes.scm
+++ b/module/language/cps/prune-top-level-scopes.scm
@@ -81,7 +81,7 @@
(_ #t)))))
(define (visit-fun fun)
(match fun
- (($ $fun free body)
+ (($ $fun body)
(visit-cont body))))
(visit-cont fun)
diff --git a/module/language/cps/renumber.scm b/module/language/cps/renumber.scm
index 58968a7..8a1c7a0 100644
--- a/module/language/cps/renumber.scm
+++ b/module/language/cps/renumber.scm
@@ -219,14 +219,14 @@
(($ $letk conts body)
(for-each visit-cont conts)
(visit-term body reachable?))
- (($ $continue k src ($ $fun free body))
+ (($ $continue k src ($ $fun body))
(when reachable?
(set! queue (cons body queue))))
(($ $continue k src ($ $rec names syms funs))
(when reachable?
(set! queue (fold (lambda (fun queue)
(match fun
- (($ $fun free body)
+ (($ $fun body)
(cons body queue))))
queue
funs))))
@@ -327,8 +327,8 @@
($prompt escape? (rename tag) (relabel handler))))))
(define (visit-fun fun)
(rewrite-cps-exp fun
- (($ $fun free body)
- ($fun (map rename free) ,(must-visit-cont body)))))
+ (($ $fun body)
+ ($fun ,(must-visit-cont body)))))
(match term
(($ $cont)
diff --git a/module/language/cps/self-references.scm
b/module/language/cps/self-references.scm
index 6cf2545..45e2389 100644
--- a/module/language/cps/self-references.scm
+++ b/module/language/cps/self-references.scm
@@ -54,8 +54,8 @@
(define (visit-exp exp)
(rewrite-cps-exp exp
((or ($ $const) ($ $prim)) ,exp)
- (($ $fun free body)
- ($fun free ,(resolve-self-references body env)))
+ (($ $fun body)
+ ($fun ,(resolve-self-references body env)))
(($ $rec names vars funs)
($rec names vars (map visit-recursive-fun funs vars)))
(($ $call proc args)
@@ -73,7 +73,7 @@
(define (visit-recursive-fun fun var)
(rewrite-cps-exp fun
- (($ $fun free (and cont ($ $cont _ ($ $kfun src meta self))))
- ($fun free ,(resolve-self-references cont (acons var self env))))))
+ (($ $fun (and cont ($ $cont _ ($ $kfun src meta self))))
+ ($fun ,(resolve-self-references cont (acons var self env))))))
(visit-cont fun))
diff --git a/module/language/cps/simplify.scm b/module/language/cps/simplify.scm
index 8f3b630..10e9d0a 100644
--- a/module/language/cps/simplify.scm
+++ b/module/language/cps/simplify.scm
@@ -61,7 +61,7 @@
#f)))
(define (visit-fun fun)
(match fun
- (($ $fun free body)
+ (($ $fun body)
(visit-cont body))))
(visit-cont fun)
table))
@@ -139,8 +139,8 @@
($continue (reduce k scope) src ,exp))))
(define (visit-fun fun)
(rewrite-cps-exp fun
- (($ $fun free body)
- ($fun free ,(visit-cont body #f)))))
+ (($ $fun body)
+ ($fun ,(visit-cont body #f)))))
(visit-cont fun #f)))
(define (compute-beta-reductions fun)
@@ -189,7 +189,7 @@
#f)))
(define (visit-fun fun)
(match fun
- (($ $fun free body)
+ (($ $fun body)
(visit-cont body))))
(visit-cont fun)
(values var-table k-table)))
@@ -253,8 +253,8 @@
(build-cps-exp ($prompt escape? (subst tag) handler)))))
(define (visit-fun fun)
(rewrite-cps-exp fun
- (($ $fun free body)
- ($fun (map subst free) ,(must-visit-cont body)))))
+ (($ $fun body)
+ ($fun ,(must-visit-cont body)))))
(must-visit-cont fun)))
;; Rewrite the scope tree to reflect the dominator tree. Precondition:
@@ -281,12 +281,12 @@
(define (visit-fun fun)
(rewrite-cps-exp fun
- (($ $fun free body)
- ($fun free ,(visit-fun-cont body)))))
+ (($ $fun body)
+ ($fun ,(visit-fun-cont body)))))
(define (visit-exp k src exp)
(rewrite-cps-term exp
- (($ $fun free body)
+ (($ $fun body)
($continue k src ,(visit-fun exp)))
(($ $rec names syms funs)
($continue k src ($rec names syms (map visit-fun funs))))
diff --git a/module/language/cps/specialize-primcalls.scm
b/module/language/cps/specialize-primcalls.scm
index 3a840dd..e5b76fb 100644
--- a/module/language/cps/specialize-primcalls.scm
+++ b/module/language/cps/specialize-primcalls.scm
@@ -101,7 +101,7 @@
(define (visit-fun fun)
(rewrite-cps-exp fun
- (($ $fun free body)
- ($fun free ,(visit-cont body)))))
+ (($ $fun body)
+ ($fun ,(visit-cont body)))))
(visit-cont fun))))
diff --git a/module/language/cps/type-fold.scm
b/module/language/cps/type-fold.scm
index c13f7fb..ba66ec3 100644
--- a/module/language/cps/type-fold.scm
+++ b/module/language/cps/type-fold.scm
@@ -430,8 +430,8 @@
(_ ,term)))
(define (visit-fun fun)
(rewrite-cps-exp fun
- (($ $fun free body)
- ($fun free ,(fold-constants* body dfg)))))
+ (($ $fun body)
+ ($fun ,(fold-constants* body dfg)))))
(rewrite-cps-cont fun
(($ $cont kfun ($ $kfun src meta self tail clause))
(kfun ($kfun src meta self ,tail ,(visit-cont clause))))))))))
diff --git a/module/language/cps/verify.scm b/module/language/cps/verify.scm
index e10cf83..6c23107 100644
--- a/module/language/cps/verify.scm
+++ b/module/language/cps/verify.scm
@@ -127,8 +127,7 @@
(define (visit-fun fun k-env v-env)
(match fun
- (($ $fun (free ...) entry)
- (for-each (cut check-var <> v-env) free)
+ (($ $fun entry)
(visit-entry entry '() v-env))
(_
(error "unexpected $fun" fun))))
diff --git a/module/language/tree-il/compile-cps.scm
b/module/language/tree-il/compile-cps.scm
index 65bec09..4e515f7 100644
--- a/module/language/tree-il/compile-cps.scm
+++ b/module/language/tree-il/compile-cps.scm
@@ -296,7 +296,7 @@
(let-fresh (kfun ktail) (self)
(build-cps-term
($continue k fun-src
- ($fun '()
+ ($fun
(kfun ($kfun fun-src meta self (ktail ($ktail))
,(convert-clauses body ktail)))))))
(let ((scope-id (fresh-scope-id)))
- [Guile-commits] branch master updated (dfa11aa -> 50fcdfe), Andy Wingo, 2015/04/01
- [Guile-commits] 02/04: Precise range inference on <, <=, >=, > branches, Andy Wingo, 2015/04/01
- [Guile-commits] 01/04: Fix intmap bug for maps with only one element, Andy Wingo, 2015/04/01
- [Guile-commits] 04/04: Remove "free" field of $fun,
Andy Wingo <=
- [Guile-commits] 03/04: Replace $letrec with $rec, Andy Wingo, 2015/04/01