optimize call/1cc, too

cisco · Sep 29, 2024 · 81d2b24 · 81d2b24
1 parent 3571ed1
commit 81d2b24
Show file tree

Hide file tree

Showing 3 changed files with 5 additions and 2 deletions.
diff --git a/mats/cp0.ms b/mats/cp0.ms
@@ -3540,6 +3540,9 @@
     (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)

diff --git a/s/cp0.ss b/s/cp0.ss
@@ -2614,7 +2614,7 @@
                                        e]))
                                  c-val)))))])))))])
 
-      (define-inline 2 (call/cc call-with-current-continuation)
+      (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))

diff --git a/s/primdata.ss b/s/primdata.ss
@@ -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