mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-21 03:00:19 +02:00
Code Activity

peval reduces some inlined case-lambda calls

Browse source 
* module/language/tree-il/peval.scm (peval): Reduce multiple case lambda
  in <call> trees according to the number of arguments. Do not try to
  reduce case-lambda using keyword arguments.
* test-suite/tests/peval.test: Tests.
This commit is contained in:
Daniel Llorens 2023-02-23 17:38:10 +01:00
parent e2ed33ef04
commit 3b47f87618
2 changed files with 95 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

23
module/language/tree-il/peval.scm
View file

@ -1668,6 +1668,29 @@ top-level bindings from ENV and return the resulting expression."
(log 'inline-end result exp)
result)))))
(($ <lambda> src-proc meta orig-body)
;; If there are multiple cases and one matches nargs, omit all the others.
(or (and
(lambda-case-alternate orig-body)
(let ((nargs (length orig-args)))
(let loop ((body orig-body))
(match body
(#f #f) ;; No matching case; an error.
(($ <lambda-case> src-case req opt rest kw inits gensyms case-body alt)
(cond (kw
;; FIXME: Not handling keyword cases.
#f)
((let ((nreq (length req)))
(if rest
(<= nreq nargs)
(<= nreq nargs (+ nreq (if opt (length opt) 0)))))
;; Keep only this case.
(revisit-proc
(make-lambda
src-proc meta
(make-lambda-case src-case req opt rest kw inits gensyms case-body #f))))
(else (loop alt))))))))
(make-call src (for-call orig-proc) (map for-value orig-args))))
(($ <let> _ _ _ vals _)
;; Attempt to inline `let' in the operator position.
;;