diff options
| author | Andy Wingo <wingo@pobox.com> | 2013-06-27 11:25:34 +0200 |
|---|---|---|
| committer | Andy Wingo <wingo@pobox.com> | 2013-06-27 22:02:35 +0200 |
| commit | 39caffe79b3d159590b5ce1ccf8fe28c3d5cfdc6 (patch) | |
| tree | 94994ed36aed8426e5287953396350e92db1b5dc /module/language/tree-il/peval.scm | |
| parent | 1773bc7dd5f4c8a1d13c7cf2015f3a04c9299eeb (diff) | |
| download | guile-39caffe79b3d159590b5ce1ccf8fe28c3d5cfdc6.tar.gz | |
remove @apply memoizer
* libguile/memoize.c (memoize): Recognize a primcall to 'apply as
SCM_M_APPLY.
(@apply): Remove @apply memoizer.
(unmemoize): Unmemoize using "apply", not "@apply".
* libguile/memoize.h:
* libguile/expand.c (scm_sym_atapply): Remove.
* module/ice-9/boot-9.scm (apply): Re-implement using apply primcall.
Use case-lambda, so as to give an appropriate minimum arity.
* module/language/tree-il/compile-glil.scm (flatten-lambda-case):
Compile a primcall of "apply" specially, not "@apply".
* module/language/tree-il/peval.scm (peval): Match primcalls to "apply",
not "@apply". Residualize "apply" primcalls.
* module/language/tree-il/primitives.scm (*interesting-primitive-names*):
(*multiply-valued-primitives*): Remove @apply, and apply primitive
expander.
* test-suite/tests/peval.test:
* test-suite/tests/tree-il.test: Update tests to expect residualized
"apply".
* test-suite/tests/procprop.test ("procedure-arity"): Update test for
better apply arity.
* test-suite/tests/strings.test ("string"): Update expected error.
Diffstat (limited to 'module/language/tree-il/peval.scm')
| -rw-r--r-- | module/language/tree-il/peval.scm | 10 |
1 files changed, 5 insertions, 5 deletions
diff --git a/module/language/tree-il/peval.scm b/module/language/tree-il/peval.scm index 27da46068..a7504fdf8 100644 --- a/module/language/tree-il/peval.scm +++ b/module/language/tree-il/peval.scm @@ -861,7 +861,7 @@ top-level bindings from ENV and return the resulting expression." (names ... rest) (gensyms ... rest-sym) (vals ... ($ <primcall> _ 'list rest-args)) - ($ <primcall> asrc (or 'apply '@apply) + ($ <primcall> asrc 'apply (proc args ... ($ <lexical-ref> _ (? (cut eq? <> rest)) @@ -1192,7 +1192,7 @@ top-level bindings from ENV and return the resulting expression." (for-tail (list->seq src (append (cdr vals) (list (car vals))))) (make-primcall src 'values vals)))))) - (($ <primcall> src (or 'apply '@apply) (proc args ... tail)) + (($ <primcall> src 'apply (proc args ... tail)) (let lp ((tail* (find-definition tail 1)) (speculative? #t)) (define (copyable? x) ;; Inlining a result from find-definition effectively copies it, @@ -1205,7 +1205,7 @@ top-level bindings from ENV and return the resulting expression." (for-tail (make-call src proc (append args args*))))) (($ <primcall> _ 'cons ((and head (? copyable?)) (and tail (? copyable?)))) - (for-tail (make-primcall src '@apply + (for-tail (make-primcall src 'apply (cons proc (append args (list head tail)))))) (($ <primcall> _ 'list @@ -1215,7 +1215,7 @@ top-level bindings from ENV and return the resulting expression." (if speculative? (lp (for-value tail) #f) (let ((args (append (map for-value args) (list tail*)))) - (make-primcall src '@apply + (make-primcall src 'apply (cons (for-value proc) args)))))))) (($ <primcall> src (? constructor-primitive? name) args) @@ -1461,7 +1461,7 @@ top-level bindings from ENV and return the resulting expression." (define (lift-applied-lambda body gensyms) (and (not opt) rest (not kw) (match body - (($ <primcall> _ '@apply + (($ <primcall> _ 'apply (($ <lambda> _ _ (and lcase ($ <lambda-case>))) ($ <lexical-ref> _ _ sym) ...)) |