[ perf ] Make Inf be treated like Lazy too

src/Compiler/Scheme/Common.idr

@@ -557,11 +557,7 @@ parameters (schExtPrim : Int -> ExtPrim -> List NamedCExp -> Core String,
     schExp i (NmExtPrim fc p args)
         = schExtPrim i (toPrim p) args
     schExp i (NmForce fc lr t) = pure $ "(blodwen-force " ++ !(schExp i t) ++ ")"
-    schExp i (NmDelay fc lr t)
-        = do let delayed = "(lambda () " ++ !(schExp i t) ++ ")"
-             pure $ case lr of
-                      LInf => delayed
-                      _    => "(blodwen-delay-lazy \{delayed})"
+    schExp i (NmDelay fc lr t) = pure $ "(blodwen-delay-lazy (lambda () " ++ !(schExp i t) ++ "))"
     schExp i (NmConCase fc sc alts def)
         = cond [(recordCase alts, schRecordCase i sc alts def),
                 (maybeCase alts, schMaybeCase i sc alts def),

support/chez/support.ss

@@ -28,13 +28,11 @@
   (weak-cons bwp f))
 
 (define (blodwen-force e)
-  (if (weak-pair? e)
-    (let ((exval (car e)))
-      (if (bwp-object? exval)
-        (let ((val ((cdr e))))
-          (begin (set-car! e val) val))
-        exval))
-    (e)))
+  (let ((exval (car e)))
+    (if (bwp-object? exval)
+      (let ((val ((cdr e))))
+        (begin (set-car! e val) val))
+      exval)))
 
 (define (blodwen-toSignedInt x bits)
   (if (logbit? bits x)

support/racket/support.rkt

@@ -22,13 +22,11 @@
   (mcons (make-weak-box bwp) f))
 
 (define (blodwen-force e)
-  (if (mpair? e)
-    (let ((exval (weak-box-value (mcar e) bwp)))
-      (if (eq? exval bwp)
-        (let ((val ((mcdr e))))
-          (begin (set-mcar! e (make-weak-box val)) val))
-        exval))
-    (e)))
+  (let ((exval (weak-box-value (mcar e) bwp)))
+    (if (eq? exval bwp)
+      (let ((val ((mcdr e))))
+        (begin (set-mcar! e (make-weak-box val)) val))
+      exval)))
 
 (define (blodwen-toSignedInt x bits)
   (if (bitwise-bit-set? x bits)

tests/allschemes/memo003/Memo.idr

@@ -23,7 +23,7 @@ main = do
   printLn $ take 10 natsS
 
   putStrLn "\n-----------------------"
-  putStrLn "second take of stream (should be `s 0..9`)"
+  putStrLn "second take of stream (should be no `s *`)"
   printLn $ take 10 natsS
 
   natsL <- natsL'

tests/allschemes/memo003/expected

@@ -14,17 +14,7 @@ first take of stream (should be `s 0..9`)
 [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]
 
 -----------------------
-second take of stream (should be `s 0..9`)
-> s 0
-> s 1
-> s 2
-> s 3
-> s 4
-> s 5
-> s 6
-> s 7
-> s 8
-> s 9
+second take of stream (should be no `s *`)
 [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]
 
 -----------------------