diff --git a/.dir-locals.el b/.dir-locals.el index b9e2f2cf1..d3cee5c80 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -26,7 +26,7 @@ (eval . (put '$letconst 'scheme-indent-function 1)) (eval . (put '$continue 'scheme-indent-function 2)) (eval . (put '$kargs 'scheme-indent-function 2)) - (eval . (put '$kentry 'scheme-indent-function 4)) + (eval . (put '$kfun 'scheme-indent-function 4)) (eval . (put '$kclause 'scheme-indent-function 1)) (eval . (put '$fun 'scheme-indent-function 1)))) (emacs-lisp-mode . ((indent-tabs-mode . nil))) diff --git a/module/language/cps.scm b/module/language/cps.scm index 079da59c1..056a71f29 100644 --- a/module/language/cps.scm +++ b/module/language/cps.scm @@ -57,11 +57,11 @@ ;;; but which truncates them to some number of required values, ;;; possibly with a rest list. ;;; -;;; - $kentry labels an entry point for a $fun (a function), and +;;; - $kfun labels an entry point for a $fun (a function), and ;;; contains a $ktail representing the formal argument which is the ;;; function's continuation. ;;; -;;; - $kentry also contain a $kclause continuation, corresponding to +;;; - $kfun also contain a $kclause continuation, corresponding to ;;; the first case-lambda clause of the function. $kclause actually ;;; contains the clause body, and the subsequent clause (if any). ;;; This is because the $kclause logically matches or doesn't match @@ -72,14 +72,14 @@ ;;; ;;; (match f ;;; (($ $fun free -;;; ($ $cont kentry -;;; ($ $kentry src meta self ($ $cont ktail ($ $ktail)) +;;; ($ $cont kfun +;;; ($ $kfun src meta self ($ $cont ktail ($ $ktail)) ;;; ($ $kclause arity ;;; ($ $cont kbody ($ $kargs names syms body)) ;;; alternate)))) ;;; #t)) ;;; -;;; A $continue to ktail is in tail position. $kentry, $kclause, +;;; A $continue to ktail is in tail position. $kfun, $kclause, ;;; and $ktail will never be seen elsewhere in a CPS term. ;;; ;;; - $prompt continues to the body of the prompt, having pushed on a @@ -119,7 +119,7 @@ $cont ;; Continuation bodies. - $kif $kreceive $kargs $kentry $ktail $kclause + $kif $kreceive $kargs $kfun $ktail $kclause ;; Expressions. $void $const $prim $fun $call $callk $primcall $values $prompt @@ -179,7 +179,7 @@ (define-cps-type $kif kt kf) (define-cps-type $kreceive arity k) (define-cps-type $kargs names syms body) -(define-cps-type $kentry src meta self tail clause) +(define-cps-type $kfun src meta self tail clause) (define-cps-type $ktail) (define-cps-type $kclause arity cont alternate) @@ -229,7 +229,7 @@ (make-$arity req opt rest kw allow-other-keys?)))) (define-syntax build-cont-body - (syntax-rules (unquote $kif $kreceive $kargs $kentry $ktail $kclause) + (syntax-rules (unquote $kif $kreceive $kargs $kfun $ktail $kclause) ((_ (unquote exp)) exp) ((_ ($kif kt kf)) @@ -242,8 +242,8 @@ (make-$kargs (list name ...) (list sym ...) (build-cps-term body))) ((_ ($kargs names syms body)) (make-$kargs names syms (build-cps-term body))) - ((_ ($kentry src meta self tail clause)) - (make-$kentry src meta self (build-cps-cont tail) (build-cps-cont clause))) + ((_ ($kfun src meta self tail clause)) + (make-$kfun src meta self (build-cps-cont tail) (build-cps-cont clause))) ((_ ($ktail)) (make-$ktail)) ((_ ($kclause arity cont alternate)) @@ -344,9 +344,9 @@ (build-cont-body ($kreceive req rest k))) (('kargs names syms body) (build-cont-body ($kargs names syms ,(parse-cps body)))) - (('kentry src meta self tail clause) + (('kfun src meta self tail clause) (build-cont-body - ($kentry (src exp) meta self ,(parse-cps tail) + ($kfun (src exp) meta self ,(parse-cps tail) ,(and=> clause parse-cps)))) (('ktail) (build-cont-body @@ -413,8 +413,8 @@ `(kseq ,(unparse-cps body))) (($ $kargs names syms body) `(kargs ,names ,syms ,(unparse-cps body))) - (($ $kentry src meta self tail clause) - `(kentry ,meta ,self ,(unparse-cps tail) ,(unparse-cps clause))) + (($ $kfun src meta self tail clause) + `(kfun ,meta ,self ,(unparse-cps tail) ,(unparse-cps clause))) (($ $ktail) `(ktail)) (($ $kclause ($ $arity req opt rest kw allow-other-keys?) body alternate) @@ -466,7 +466,7 @@ (($ $kargs names syms body) (term-folder body seed ...)) - (($ $kentry src meta self tail clause) + (($ $kfun src meta self tail clause) (let-values (((seed ...) (cont-folder tail seed ...))) (if clause (cont-folder clause seed ...) @@ -519,7 +519,7 @@ (($ $letrec names vars funs body) (lp body (fold max max-var vars))) (_ max-var)))) - (($ $kentry src meta self) + (($ $kfun src meta self) (max self max-var)) (_ max-var)))) fun @@ -552,8 +552,8 @@ (($ $kclause arity ($ $cont kbody) ($ $cont kalt)) (proc kbody kalt)) - (($ $kentry src meta self tail ($ $cont clause)) (proc clause)) + (($ $kfun src meta self tail ($ $cont clause)) (proc clause)) - (($ $kentry src meta self tail #f) (proc)) + (($ $kfun src meta self tail #f) (proc)) (($ $ktail) (proc)))) diff --git a/module/language/cps/arities.scm b/module/language/cps/arities.scm index 34b32692f..fe6e47537 100644 --- a/module/language/cps/arities.scm +++ b/module/language/cps/arities.scm @@ -35,7 +35,7 @@ (define (fix-clause-arities clause dfg) (let ((ktail (match clause (($ $cont _ - ($ $kentry src meta _ ($ $cont ktail) _)) ktail)))) + ($ $kfun src meta _ ($ $cont ktail) _)) ktail)))) (define (visit-term term) (rewrite-cps-term term (($ $letk conts body) @@ -182,8 +182,8 @@ ,cont))) (rewrite-cps-cont clause - (($ $cont sym ($ $kentry src meta self tail clause)) - (sym ($kentry src meta self ,tail ,(and clause (visit-cont clause)))))))) + (($ $cont sym ($ $kfun src meta self tail clause)) + (sym ($kfun src meta self ,tail ,(and clause (visit-cont clause)))))))) (define (fix-arities* fun dfg) (rewrite-cps-exp fun diff --git a/module/language/cps/closure-conversion.scm b/module/language/cps/closure-conversion.scm index 16711f45c..479a5906f 100644 --- a/module/language/cps/closure-conversion.scm +++ b/module/language/cps/closure-conversion.scm @@ -128,11 +128,11 @@ convert functions to flat closures." (values (build-cps-cont (sym ($kargs names syms ,body))) free))) - (($ $cont sym ($ $kentry src meta self tail clause)) + (($ $cont sym ($ $kfun src meta self tail clause)) (receive (clause free) (if clause (cc clause self (list self)) (values #f '())) - (values (build-cps-cont (sym ($kentry src meta self ,tail ,clause))) + (values (build-cps-cont (sym ($kfun src meta self ,tail ,clause))) free))) (($ $cont sym ($ $kclause arity body alternate)) @@ -159,7 +159,7 @@ convert functions to flat closures." (match in (() (values (bindings body) free)) (((name sym ($ $fun () (and fun-body - ($ $cont _ ($ $kentry src))))) . in) + ($ $cont _ ($ $kfun src))))) . in) (receive (fun-body fun-free) (cc fun-body #f '()) (lp in (lambda (body) @@ -269,8 +269,8 @@ convert functions to flat closures." ,cont))) (rewrite-cps-cont body - (($ $cont sym ($ $kentry src meta self tail clause)) - (sym ($kentry src meta self ,tail ,(and clause (visit-cont clause))))))) + (($ $cont sym ($ $kfun src meta self tail clause)) + (sym ($kfun src meta self ,tail ,(and clause (visit-cont clause))))))) (define (convert-closures exp) "Convert free reference in @var{exp} to primcalls to @code{free-ref}, diff --git a/module/language/cps/compile-bytecode.scm b/module/language/cps/compile-bytecode.scm index 35cc12b7b..853364047 100644 --- a/module/language/cps/compile-bytecode.scm +++ b/module/language/cps/compile-bytecode.scm @@ -116,7 +116,7 @@ (define (compile-entry) (let ((label (dfg-min-label dfg))) (match (lookup-cont label dfg) - (($ $kentry src meta self tail clause) + (($ $kfun src meta self tail clause) (when src (emit-source asm src)) (emit-begin-program asm label meta) @@ -471,7 +471,7 @@ (emit-call-label asm proc-slot nargs k)))))) (match f - (($ $fun free ($ $cont k ($ $kentry src meta self tail clause))) + (($ $fun free ($ $cont k ($ $kfun src meta self tail clause))) (compile-entry))))) (define (visit-funs proc exp) @@ -495,7 +495,7 @@ (when alternate (visit-funs proc alternate))) - (($ $cont sym ($ $kentry src meta self tail clause)) + (($ $cont sym ($ $kfun src meta self tail clause)) (when clause (visit-funs proc clause))) diff --git a/module/language/cps/constructors.scm b/module/language/cps/constructors.scm index 9cebf572a..be1c964d8 100644 --- a/module/language/cps/constructors.scm +++ b/module/language/cps/constructors.scm @@ -34,8 +34,8 @@ (rewrite-cps-cont cont (($ $cont sym ($ $kargs names syms body)) (sym ($kargs names syms ,(visit-term body)))) - (($ $cont sym ($ $kentry src meta self tail clause)) - (sym ($kentry src meta self ,tail ,(and clause (visit-cont clause))))) + (($ $cont sym ($ $kfun src meta self tail clause)) + (sym ($kfun src meta self ,tail ,(and clause (visit-cont clause))))) (($ $cont sym ($ $kclause arity body alternate)) (sym ($kclause ,arity ,(visit-cont body) ,(and alternate (visit-cont alternate))))) diff --git a/module/language/cps/contification.scm b/module/language/cps/contification.scm index 477e00318..a9db3bf60 100644 --- a/module/language/cps/contification.scm +++ b/module/language/cps/contification.scm @@ -187,7 +187,7 @@ (if (scope-contains? k-scope term-k) term-k (match (lookup-cont k-scope dfg) - (($ $kentry src meta self tail clause) + (($ $kfun src meta self tail clause) ;; K is the tail of some function. If that function ;; has just one clause, return that clause. Otherwise ;; bail. @@ -225,7 +225,7 @@ (match cont (($ $cont sym ($ $kargs _ _ body)) (visit-term body sym)) - (($ $cont sym ($ $kentry src meta self tail clause)) + (($ $cont sym ($ $kfun src meta self tail clause)) (when clause (visit-cont clause))) (($ $cont sym ($ $kclause arity body alternate)) (visit-cont body) @@ -251,9 +251,9 @@ (if (null? rec) '() (list rec))) - (((and elt (n s ($ $fun free ($ $cont kentry)))) + (((and elt (n s ($ $fun free ($ $cont kfun)))) . nsf) - (if (recursive? kentry) + (if (recursive? kfun) (lp nsf (cons elt rec)) (cons (list elt) (lp nsf rec))))))) (define (extract-arities+bodies clauses) @@ -265,7 +265,7 @@ (match fun ((($ $fun free ($ $cont fun-k - ($ $kentry src meta self ($ $cont tail-k ($ $ktail)) + ($ $kfun src meta self ($ $cont tail-k ($ $ktail)) clause))) ...) (call-with-values (lambda () (extract-arities+bodies clause)) @@ -280,7 +280,7 @@ (match exp (($ $fun free ($ $cont fun-k - ($ $kentry src meta self ($ $cont tail-k ($ $ktail)) clause))) + ($ $kfun src meta self ($ $cont tail-k ($ $ktail)) clause))) (if (and=> (bound-symbol k) (lambda (sym) (contify-fun term-k sym self tail-k @@ -350,8 +350,8 @@ ,#f) (($ $cont sym ($ $kargs names syms body)) (sym ($kargs names syms ,(visit-term body sym)))) - (($ $cont sym ($ $kentry src meta self tail clause)) - (sym ($kentry src meta self ,tail ,(and clause (visit-cont clause))))) + (($ $cont sym ($ $kfun src meta self tail clause)) + (sym ($kfun src meta self ,tail ,(and clause (visit-cont clause))))) (($ $cont sym ($ $kclause arity body alternate)) (sym ($kclause ,arity ,(visit-cont body) ,(and alternate (visit-cont alternate))))) diff --git a/module/language/cps/cse.scm b/module/language/cps/cse.scm index 89ea5465c..9ce49756b 100644 --- a/module/language/cps/cse.scm +++ b/module/language/cps/cse.scm @@ -222,14 +222,14 @@ be that both true and false proofs are available." (($ $kclause arity ($ $cont kargs ($ $kargs names syms))) syms) (($ $kif) '()) - (($ $kentry src meta self) (list self)) + (($ $kfun src meta self) (list self)) (($ $ktail) '()))) (lp (1+ n)))) defs)) (define (compute-label-and-var-ranges fun) (match fun - (($ $fun free ($ $cont kentry ($ $kentry src meta self))) + (($ $fun free ($ $cont kfun ($ $kfun src meta self))) ((make-cont-folder #f min-label label-count min-var var-count) (lambda (k cont min-label label-count min-var var-count) (let ((min-label (min k min-label)) @@ -246,11 +246,11 @@ be that both true and false proofs are available." (+ var-count (length vars)))) (($ $letk conts body) (lp body min-var var-count)) (_ (values min-label label-count min-var var-count))))) - (($ $kentry src meta self) + (($ $kfun src meta self) (values min-label label-count (min self min-var) (1+ var-count))) (_ (values min-label label-count min-var var-count))))) - fun kentry 0 self 0)))) + fun kfun 0 self 0)))) (define (compute-idoms dfg min-label label-count) (define (label->idx label) (- label min-label)) @@ -423,16 +423,16 @@ be that both true and false proofs are available." (vector-ref var-substs idx) var))) - (define (visit-entry-cont cont) + (define (visit-fun-cont cont) (rewrite-cps-cont cont (($ $cont label ($ $kargs names vars body)) (label ($kargs names vars ,(visit-term body label)))) - (($ $cont label ($ $kentry src meta self tail clause)) - (label ($kentry src meta self ,tail - ,(and clause (visit-entry-cont clause))))) + (($ $cont label ($ $kfun src meta self tail clause)) + (label ($kfun src meta self ,tail + ,(and clause (visit-fun-cont clause))))) (($ $cont label ($ $kclause arity ($ $cont kbody body) alternate)) (label ($kclause ,arity ,(visit-cont kbody body) - ,(and alternate (visit-entry-cont alternate))))))) + ,(and alternate (visit-fun-cont alternate))))))) (define (visit-cont label cont) (rewrite-cps-cont cont @@ -513,7 +513,7 @@ be that both true and false proofs are available." (rewrite-cps-exp fun (($ $fun free body) - ($fun (map subst-var free) ,(visit-entry-cont body))))) + ($fun (map subst-var free) ,(visit-fun-cont body))))) (define (cse fun dfg) (call-with-values (lambda () (compute-equivalent-subexpressions fun dfg)) diff --git a/module/language/cps/dce.scm b/module/language/cps/dce.scm index ef6f3c4cf..73ae7e379 100644 --- a/module/language/cps/dce.scm +++ b/module/language/cps/dce.scm @@ -71,7 +71,7 @@ (($ $kclause arity ($ $cont kargs ($ $kargs names syms))) syms) (($ $kif) #f) - (($ $kentry src meta self) (list self)) + (($ $kfun src meta self) (list self)) (($ $ktail) #f))) (lp (1+ n)))) defs)) @@ -163,7 +163,7 @@ (($ $kif) #f) (($ $kclause arity ($ $cont kargs ($ $kargs names syms body))) (for-each mark-live! syms)) - (($ $kentry src meta self) + (($ $kfun src meta self) (mark-live! self)) (($ $ktail) #f)) (lp (1- n)))))))) @@ -209,10 +209,10 @@ (build-cps-cont (label ($kargs names syms ,(visit-term body label)))))))) - (($ $kentry src meta self tail clause) + (($ $kfun src meta self tail clause) (list (build-cps-cont - (label ($kentry src meta self ,tail + (label ($kfun src meta self ,tail ,(and clause (visit-cont clause))))))) (($ $kclause arity body alternate) (list diff --git a/module/language/cps/dfg.scm b/module/language/cps/dfg.scm index af9130e37..a3d6b5a77 100644 --- a/module/language/cps/dfg.scm +++ b/module/language/cps/dfg.scm @@ -326,7 +326,7 @@ body continuation in the prompt." (match fun (($ $fun free - ($ $cont kentry ($ $kentry src meta self ($ $cont ktail tail)))) + ($ $cont kfun ($ $kfun src meta self ($ $cont ktail tail)))) (call-with-values (lambda () (compute-reverse-control-flow-order ktail dfg)) @@ -822,13 +822,13 @@ body continuation in the prompt." (match fun (($ $fun free - ($ $cont kentry + ($ $cont kfun (and entry - ($ $kentry src meta self ($ $cont ktail tail) clause)))) - (declare-block! kentry entry #f 0) - (add-def! self kentry) + ($ $kfun src meta self ($ $cont ktail tail) clause)))) + (declare-block! kfun entry #f 0) + (add-def! self kfun) - (declare-block! ktail tail kentry) + (declare-block! ktail tail kfun) (let lp ((clause clause)) (match clause @@ -836,8 +836,8 @@ body continuation in the prompt." (($ $cont kclause (and clause ($ $kclause arity ($ $cont kbody body) alternate))) - (declare-block! kclause clause kentry) - (link-blocks! kentry kclause) + (declare-block! kclause clause kfun) + (link-blocks! kfun kclause) (declare-block! kbody body kclause) (link-blocks! kclause kbody) @@ -883,7 +883,7 @@ body continuation in the prompt." (else min-var)) (fold max max-var vars) (+ var-count (length vars)))))) - (($ $kentry src meta self) + (($ $kfun src meta self) (values min-label max-label (1+ label-count) (min* self min-var) (max self max-var) (1+ var-count))) (_ (values min-label max-label (1+ label-count) diff --git a/module/language/cps/effects-analysis.scm b/module/language/cps/effects-analysis.scm index a8e7cb2a8..49b408805 100644 --- a/module/language/cps/effects-analysis.scm +++ b/module/language/cps/effects-analysis.scm @@ -487,7 +487,7 @@ (($ $arity _ () _ () #f) (logior (cause &allocation) (cause &type-check))))) (($ $kif) &no-effects) - (($ $kentry) (cause &type-check)) + (($ $kfun) (cause &type-check)) (($ $kclause) (cause &type-check)) (($ $ktail) &no-effects))) (lp (1+ n)))) diff --git a/module/language/cps/elide-values.scm b/module/language/cps/elide-values.scm index 1eb94c5bf..e75aa9840 100644 --- a/module/language/cps/elide-values.scm +++ b/module/language/cps/elide-values.scm @@ -40,8 +40,8 @@ (rewrite-cps-cont cont (($ $cont sym ($ $kargs names syms body)) (sym ($kargs names syms ,(visit-term body)))) - (($ $cont sym ($ $kentry src meta self tail clause)) - (sym ($kentry src meta self ,tail ,(and clause (visit-cont clause))))) + (($ $cont sym ($ $kfun src meta self tail clause)) + (sym ($kfun src meta self ,tail ,(and clause (visit-cont clause))))) (($ $cont sym ($ $kclause arity body alternate)) (sym ($kclause ,arity ,(visit-cont body) ,(and alternate (visit-cont alternate))))) diff --git a/module/language/cps/prune-bailouts.scm b/module/language/cps/prune-bailouts.scm index 9a8d51712..81b2581ef 100644 --- a/module/language/cps/prune-bailouts.scm +++ b/module/language/cps/prune-bailouts.scm @@ -50,8 +50,8 @@ (rewrite-cps-cont cont (($ $cont label ($ $kargs names vars body)) (label ($kargs names vars ,(visit-term body ktail)))) - (($ $cont label ($ $kentry src meta self tail clause)) - (label ($kentry src meta self ,tail + (($ $cont label ($ $kfun src meta self tail clause)) + (label ($kfun src meta self ,tail ,(and clause (visit-cont clause ktail))))) (($ $cont label ($ $kclause arity body alternate)) (label ($kclause ,arity ,(visit-cont body ktail) @@ -88,10 +88,10 @@ (rewrite-cps-exp fun (($ $fun free - ($ $cont kentry - ($ $kentry src meta self ($ $cont ktail ($ $ktail)) clause))) + ($ $cont kfun + ($ $kfun src meta self ($ $cont ktail ($ $ktail)) clause))) ($fun free - (kentry ($kentry src meta self (ktail ($ktail)) + (kfun ($kfun src meta self (ktail ($ktail)) ,(and clause (visit-cont clause ktail)))))))) (define (prune-bailouts fun) diff --git a/module/language/cps/prune-top-level-scopes.scm b/module/language/cps/prune-top-level-scopes.scm index b15928d97..8f6c0247c 100644 --- a/module/language/cps/prune-top-level-scopes.scm +++ b/module/language/cps/prune-top-level-scopes.scm @@ -41,7 +41,7 @@ (hashq-set! k->scope-var k var))) (($ $cont k ($ $kargs names syms body)) (visit-term body)) - (($ $cont k ($ $kentry src meta self tail clause)) + (($ $cont k ($ $kfun src meta self tail clause)) (when clause (visit-cont clause))) (($ $cont k ($ $kclause arity body alternate)) (visit-cont body) @@ -94,8 +94,8 @@ (rewrite-cps-cont cont (($ $cont sym ($ $kargs names syms body)) (sym ($kargs names syms ,(visit-term body)))) - (($ $cont sym ($ $kentry src meta self tail clause)) - (sym ($kentry src meta self ,tail ,(and clause (visit-cont clause))))) + (($ $cont sym ($ $kfun src meta self tail clause)) + (sym ($kfun src meta self ,tail ,(and clause (visit-cont clause))))) (($ $cont sym ($ $kclause arity body alternate)) (sym ($kclause ,arity ,(visit-cont body) ,(and alternate (visit-cont alternate))))) diff --git a/module/language/cps/reify-primitives.scm b/module/language/cps/reify-primitives.scm index 33b6aa7f5..3c5e5bcd3 100644 --- a/module/language/cps/reify-primitives.scm +++ b/module/language/cps/reify-primitives.scm @@ -117,11 +117,11 @@ (rewrite-cps-cont cont (($ $cont sym ($ $kargs names syms body)) (sym ($kargs names syms ,(visit-term body)))) - (($ $cont sym ($ $kentry src meta self (and tail ($ $cont ktail)) #f)) + (($ $cont sym ($ $kfun src meta self (and tail ($ $cont ktail)) #f)) ;; A case-lambda with no clauses. Reify a clause. - (sym ($kentry src meta self ,tail ,(reify-clause ktail)))) - (($ $cont sym ($ $kentry src meta self tail clause)) - (sym ($kentry src meta self ,tail ,(visit-cont clause)))) + (sym ($kfun src meta self ,tail ,(reify-clause ktail)))) + (($ $cont sym ($ $kfun src meta self tail clause)) + (sym ($kfun src meta self ,tail ,(visit-cont clause)))) (($ $cont sym ($ $kclause arity body alternate)) (sym ($kclause ,arity ,(visit-cont body) ,(and alternate (visit-cont alternate))))) diff --git a/module/language/cps/renumber.scm b/module/language/cps/renumber.scm index 38dabf391..1415f8cc7 100644 --- a/module/language/cps/renumber.scm +++ b/module/language/cps/renumber.scm @@ -92,7 +92,7 @@ (match cont (($ $kargs names vars body) (visit-term body)) - (($ $kentry src meta self tail clause) + (($ $kfun src meta self tail clause) (visit-cont tail) (when clause (visit-cont clause))) @@ -131,7 +131,7 @@ (when reachable? (for-each rename! vars)) (visit-term body reachable?)) - (($ $kentry src meta self tail clause) + (($ $kfun src meta self tail clause) (unless reachable? (error "entry should be reachable")) (rename! self) (visit-cont tail) @@ -168,8 +168,8 @@ (collect-conts fun) (match fun - (($ $fun free (and entry ($ $cont kentry))) - (set! next-label (sort-conts kentry labels next-label)) + (($ $fun free (and entry ($ $cont kfun))) + (set! next-label (sort-conts kfun labels next-label)) (visit-cont entry) (for-each compute-names-in-fun (reverse queue))))) @@ -211,9 +211,9 @@ (rewrite-cps-cont cont (($ $kargs names vars body) (label ($kargs names (map rename vars) ,(visit-term body)))) - (($ $kentry src meta self tail clause) + (($ $kfun src meta self tail clause) (label - ($kentry src meta (rename self) ,(must-visit-cont tail) + ($kfun src meta (rename self) ,(must-visit-cont tail) ,(and clause (must-visit-cont clause))))) (($ $ktail) (label ($ktail))) diff --git a/module/language/cps/self-references.scm b/module/language/cps/self-references.scm index 4f597f12e..7a2c57d34 100644 --- a/module/language/cps/self-references.scm +++ b/module/language/cps/self-references.scm @@ -35,8 +35,8 @@ (rewrite-cps-cont cont (($ $cont label ($ $kargs names vars body)) (label ($kargs names vars ,(visit-term body)))) - (($ $cont label ($ $kentry src meta self tail clause)) - (label ($kentry src meta self ,tail + (($ $cont label ($ $kfun src meta self tail clause)) + (label ($kfun src meta self ,tail ,(and clause (visit-cont clause))))) (($ $cont label ($ $kclause arity body alternate)) (label ($kclause ,arity ,(visit-cont body) @@ -71,7 +71,7 @@ (define (visit-recursive-fun fun var) (match fun - (($ $fun free (and cont ($ $cont _ ($ $kentry src meta self)))) + (($ $fun free (and cont ($ $cont _ ($ $kfun src meta self)))) (resolve-self-references fun (acons var self env))))) (rewrite-cps-exp fun diff --git a/module/language/cps/simplify.scm b/module/language/cps/simplify.scm index cae5c21e0..3bb269a55 100644 --- a/module/language/cps/simplify.scm +++ b/module/language/cps/simplify.scm @@ -39,7 +39,7 @@ (match cont (($ $cont sym ($ $kargs names syms body)) (visit-term body sym syms)) - (($ $cont sym ($ $kentry src meta self tail clause)) + (($ $cont sym ($ $kfun src meta self tail clause)) (when clause (visit-cont clause))) (($ $cont sym ($ $kclause arity body alternate)) (visit-cont body) @@ -89,8 +89,8 @@ (rewrite-cps-cont cont (($ $cont sym ($ $kargs names syms body)) (sym ($kargs names syms ,(visit-term body sym)))) - (($ $cont sym ($ $kentry src meta self tail clause)) - (sym ($kentry src meta self ,tail + (($ $cont sym ($ $kfun src meta self tail clause)) + (sym ($kfun src meta self ,tail ,(and clause (visit-cont clause sym))))) (($ $cont sym ($ $kclause arity body alternate)) (sym ($kclause ,arity ,(visit-cont body sym) @@ -130,7 +130,7 @@ (match cont (($ $cont sym ($ $kargs names syms body)) (visit-term body)) - (($ $cont sym ($ $kentry src meta self tail clause)) + (($ $cont sym ($ $kfun src meta self tail clause)) (when clause (visit-cont clause))) (($ $cont sym ($ $kclause arity body alternate)) (visit-cont body) @@ -186,8 +186,8 @@ (rewrite-cps-cont cont (($ $kargs names syms body) (sym ($kargs names syms ,(visit-term body)))) - (($ $kentry src meta self tail clause) - (sym ($kentry src meta self ,tail + (($ $kfun src meta self tail clause) + (sym ($kfun src meta self ,tail ,(and clause (must-visit-cont clause))))) (($ $kclause arity body alternate) (sym ($kclause ,arity ,(must-visit-cont body) diff --git a/module/language/cps/slot-allocation.scm b/module/language/cps/slot-allocation.scm index 85f69b53d..9f1899fd4 100644 --- a/module/language/cps/slot-allocation.scm +++ b/module/language/cps/slot-allocation.scm @@ -337,7 +337,7 @@ are comparable with eqv?. A tmp slot may be used." (let lp ((n 0)) (when (< n (vector-length usev)) (match (lookup-cont (idx->label n) dfg) - (($ $kentry src meta self) + (($ $kfun src meta self) (vector-set! defv n (list (dfa-var-idx dfa self)))) (($ $kargs names syms body) (vector-set! defv n (map (cut dfa-var-idx dfa <>) syms)) @@ -671,7 +671,7 @@ are comparable with eqv?. A tmp slot may be used." (error "Unexpected clause order")))) (visit-clauses next live)))))) (match (lookup-cont (idx->label 0) dfg) - (($ $kentry src meta self) + (($ $kfun src meta self) (visit-clauses 1 (allocate-defs! 0 (empty-live-slots)))))) (compute-constants!) diff --git a/module/language/cps/specialize-primcalls.scm b/module/language/cps/specialize-primcalls.scm index f10a76a37..b40cf8c3e 100644 --- a/module/language/cps/specialize-primcalls.scm +++ b/module/language/cps/specialize-primcalls.scm @@ -41,8 +41,8 @@ (rewrite-cps-cont cont (($ $cont sym ($ $kargs names syms body)) (sym ($kargs names syms ,(visit-term body)))) - (($ $cont sym ($ $kentry src meta self tail clause)) - (sym ($kentry src meta self ,tail + (($ $cont sym ($ $kfun src meta self tail clause)) + (sym ($kfun src meta self ,tail ,(and clause (visit-cont clause))))) (($ $cont sym ($ $kclause arity body alternate)) (sym ($kclause ,arity ,(visit-cont body) diff --git a/module/language/cps/verify.scm b/module/language/cps/verify.scm index ada8b7cd0..4352f20a3 100644 --- a/module/language/cps/verify.scm +++ b/module/language/cps/verify.scm @@ -82,7 +82,7 @@ (error "name and sym lengths don't match" name sym)) (visit-term body k-env (add-vars sym v-env))) (_ - ;; $kclause, $kentry, and $ktail are only ever seen in $fun. + ;; $kclause, $kfun, and $ktail are only ever seen in $fun. (error "unexpected cont body" cont)))) (define (visit-clause clause k-env v-env) @@ -117,7 +117,7 @@ (match fun (($ $fun (free ...) ($ $cont kbody - ($ $kentry src meta self ($ $cont ktail ($ $ktail)) clause))) + ($ $kfun src meta self ($ $cont ktail ($ $ktail)) clause))) (when (and meta (not (and (list? meta) (and-map pair? meta)))) (error "meta should be alist" meta)) (for-each (cut check-var <> v-env) free) diff --git a/module/language/tree-il/compile-cps.scm b/module/language/tree-il/compile-cps.scm index f0d4667ae..e2b4fb3b0 100644 --- a/module/language/tree-il/compile-cps.scm +++ b/module/language/tree-il/compile-cps.scm @@ -294,11 +294,11 @@ arity gensyms inits))) ,(convert-clauses alternate ktail)))))))))) (if (current-topbox-scope) - (let-fresh (kentry ktail) (self) + (let-fresh (kfun ktail) (self) (build-cps-term ($continue k fun-src ($fun '() - (kentry ($kentry fun-src meta self (ktail ($ktail)) + (kfun ($kfun fun-src meta self (ktail ($ktail)) ,(convert-clauses body ktail))))))) (let ((scope-id (fresh-scope-id))) (let-fresh (kscope) () @@ -605,7 +605,7 @@ integer." (let-fresh (kinit ktail kclause kbody) (init) (build-cps-exp ($fun '() - (kinit ($kentry src '() init (ktail ($ktail)) + (kinit ($kfun src '() init (ktail ($ktail)) (kclause ($kclause ('() '() #f '() #f) (kbody ($kargs () ()