diff options
| author | Daniel Llorens <lloda@sarc.name> | 2023-02-23 17:38:10 +0100 |
|---|---|---|
| committer | Daniel Llorens <lloda@sarc.name> | 2023-02-27 11:53:48 +0100 |
| commit | 3b47f87618047ebb8812788c64a44877a4f2e0dd (patch) | |
| tree | 67b13b97da2ec938eb9778237b6179649ccd8272 /module/language/tree-il/peval.scm | |
| parent | e2ed33ef0445c867fe56c247054aa67e834861f2 (diff) | |
| download | guile-3b47f87618047ebb8812788c64a44877a4f2e0dd.tar.gz | |
peval reduces some inlined case-lambda calls
* 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.
Diffstat (limited to 'module/language/tree-il/peval.scm')
| -rw-r--r-- | module/language/tree-il/peval.scm | 23 |
1 files changed, 23 insertions, 0 deletions
diff --git a/module/language/tree-il/peval.scm b/module/language/tree-il/peval.scm index 7945fd9b9..7c05e9a2e 100644 --- a/module/language/tree-il/peval.scm +++ b/module/language/tree-il/peval.scm @@ -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. ;; |