Skip to content

Commit

Permalink
optimize (call/cc (lambda (k) body)) with unused k
Browse files Browse the repository at this point in the history
In cp0, replace `(call/cc (lambda (k) body))` with just `body` when
`k` is not referenced in `body`.
  • Loading branch information
mflatt committed Sep 29, 2024
1 parent eebce9b commit 3571ed1
Show file tree
Hide file tree
Showing 4 changed files with 27 additions and 2 deletions.
9 changes: 9 additions & 0 deletions mats/cp0.ms
Original file line number Diff line number Diff line change
Expand Up @@ -3534,6 +3534,15 @@
)

(cp0-mat cp0-continuation-marks
(equivalent-expansion?
(expand/optimize '(lambda () (call/cc (lambda (k) 10))))
'(lambda () 10))
(equivalent-expansion?
(expand/optimize '(call/cc (lambda (k) 10)))
'10)
(equivalent-expansion?
(expand/optimize '(call-with-current-continuation (lambda (k) 10)))
'10)
(equivalent-expansion?
(expand/optimize '(with-continuation-mark 'x 'y 10))
'10)
Expand Down
7 changes: 7 additions & 0 deletions release_notes/release_notes.stex
Original file line number Diff line number Diff line change
Expand Up @@ -129,6 +129,13 @@ executable code to be loaded at runtime.
The \scheme{stdbool} foreign type corresponds to \scheme{bool} as
defined by the host machine's \scheme{stdbool.h} include file.

\subsection{Optimization for \scheme{call/cc} (10.1.0)}

When \scheme{call/cc} is applied to an immediate function that does
not use its argument, then the application is replaced with the body
of that function, which avoids the potential work of capturing a
continuation at run time.

\subsection{Unicode 15.1 support (10.0.0)}

The character sets, character classes, and word-breaking algorithms for character, string,
Expand Down
9 changes: 9 additions & 0 deletions s/cp0.ss
Original file line number Diff line number Diff line change
Expand Up @@ -2614,6 +2614,15 @@
e]))
c-val)))))])))))])

(define-inline 2 (call/cc call-with-current-continuation)
[(body)
(nanopass-case (Lsrc Expr) (value-visit-operand! body)
[(case-lambda ,preinfo (clause (,x) ,interface ,e))
(guard (not (prelex-was-referenced x)))
(residualize-seq (list) (list body) ctxt)
e]
[else #f])])

(define-inline 2 $call-setting-continuation-attachment
[(val body)
(nanopass-case (Lsrc Expr) (value-visit-operand! body)
Expand Down
4 changes: 2 additions & 2 deletions s/primdata.ss
Original file line number Diff line number Diff line change
Expand Up @@ -338,8 +338,8 @@
(error [sig [(maybe-who string ptr ...) -> (bottom)]] [flags abort-op])
(assertion-violation [sig [(maybe-who string ptr ...) -> (bottom)]] [flags abort-op])
(apply [sig [(procedure ptr ... list) -> (ptr ...)]] [flags cp02 cptypes2x ieee r5rs])
(call-with-current-continuation [sig [(procedure) -> (ptr ...)]] [flags ieee r5rs])
(call/cc [sig [(procedure) -> (ptr ...)]] [flags])
(call-with-current-continuation [sig [(procedure) -> (ptr ...)]] [flags ieee r5rs cp02])
(call/cc [sig [(procedure) -> (ptr ...)]] [flags cp02])
(values [sig [(ptr ...) -> (ptr ...)]] [flags unrestricted discard cp02 ieee r5rs])
(call-with-values [sig [(procedure procedure) -> (ptr ...)]] [flags cp02 cptypes2x ieee r5rs])
((r6rs: dynamic-wind) [sig [(procedure procedure procedure) -> (ptr ...)]] [flags cptypes2x ieee r5rs]) ; restricted to 3 arguments
Expand Down

0 comments on commit 3571ed1

Please sign in to comment.