optimize (call/cc (lambda (k) body)) with unused k

mats/cp0.ms

@@ -3534,6 +3534,18 @@
   )
 
 (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/1cc (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)

release_notes/release_notes.stex

@@ -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,

s/cp0.ss

@@ -2614,6 +2614,15 @@
                                        e]))
                                  c-val)))))])))))])
 
+      (define-inline 2 (call/cc call/1cc 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)

s/primdata.ss

@@ -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
@@ -1205,7 +1205,7 @@
   (bytevector-u56-set! [sig [(bytevector sub-index u56 symbol) -> (void)]] [flags true])
   (bytevector-compress [sig [(ptr) -> (ptr)]] [flags])
   (bytevector-uncompress [sig [(ptr) -> (ptr)]] [flags])
-  (call/1cc [sig [(procedure) -> (ptr ...)]] [flags])
+  (call/1cc [sig [(procedure) -> (ptr ...)]] [flags cp02])
   (call-in-continuation [sig [(ptr procedure) -> (ptr ...)] [(ptr continuation-marks procedure) -> (ptr ...)]] [flags])
   (call-with-input-file [sig [(pathname procedure) (pathname procedure sub-ptr) -> (ptr ...)]] [flags ieee r5rs])      ; has options argument
   (call-with-output-file [sig [(pathname procedure) (pathname procedure sub-ptr) -> (ptr ...)]] [flags ieee r5rs])     ; has options argument