rrrg

golden/exec/begin-1/source.scm

@@ -0,0 +1 @@
+(begin 123 456) ; => 456

golden/exec/callcc-early-exit-2/exec

@@ -0,0 +1,2 @@
+ret > ExitSuccess
+out > #t

golden/exec/callcc-early-exit-2/source.scm

@@ -0,0 +1,4 @@
+(call/cc
+ (λ (k)
+   (begin (k #t)
+          #f)))

golden/exec/callcc-early-exit-3/exec

@@ -0,0 +1,2 @@
+ret > ExitSuccess
+out > #t

golden/exec/callcc-early-exit-3/source.scm

@@ -0,0 +1,5 @@
+;; confer ../callcc-early-exit-4
+(letrec ((app (λ (f x)
+                (begin (f x)
+                       #f))))
+  (call/cc (λ (k) (app k #t))))

golden/exec/callcc-early-exit-4/exec

@@ -0,0 +1,2 @@
+ret > ExitSuccess
+out > #t

golden/exec/callcc-early-exit-4/source.scm

@@ -0,0 +1,5 @@
+;; confer ../callcc-early-exit-3
+(letrec ((app (λ (f x)
+                (begin (f x)
+                       #f))))
+  (call/cc (λ (k) (app (λ (x) (k x)) #t))))

golden/exec/callcc-early-exit-5/exec

@@ -0,0 +1,2 @@
+ret > ExitSuccess
+out > #t

golden/exec/callcc-early-exit-5/source.scm

@@ -0,0 +1,5 @@
+(call/cc
+ (λ (k)
+   (begin ((λ (x) (k x))
+           #t)
+          #f)))

src/Gyehoek/Stack/VM.hs

@@ -13,6 +13,7 @@ import Control.Lens
 import qualified Data.HashMap.Strict as H
 import Data.List (unfoldr)
 import Gyehoek.Prelude
+import qualified Data.List.NonEmpty as NE
 
 
 data VM = MkVM
@@ -133,11 +134,11 @@ eval p = initialVM & loop \vm -> case vm ^. #result of
   Nothing -> Right $ step (initialEnv p) vm
   Just rs -> Left rs
 
-trace :: Program -> List VM
-trace p = initialVM & unfoldr \vm ->
+trace :: Program -> NonEmpty VM
+trace p = initialVM & NE.unfoldr \vm ->
     case vm.result of
-      Just _ -> Nothing
-      Nothing -> Just (vm, step e vm)
+      Just _ -> (vm, Nothing)
+      Nothing -> (vm, Just $ step e vm)
   where e = initialEnv p
 
 writeObj :: Obj -> Text
@@ -150,21 +151,75 @@ writeObj (ObjHob h) = case h of
   HobClosure code env -> "#<procedure>"
 
 blah = [stkP|
-(define ($lambda-body0-code7 %lambda-tail1 %lambda-body0 %x)
-  (prim %r2 (* %x %x))
-  (tail-call %lambda-tail1 %r2))
-
 (define ($r3 %x4)
-  (pop! %main-ktail)
-  (tail-call %main-ktail %x4))
+  (pop! %f)
+  (pop! %iter)
+  (pop! %lambda-tail1)
+  (pop! %n)
+  (prim %r5 (- %n 1))
+  (prim %code22 (env-code %iter))
+  (push! %lambda-tail1)
+  (tail-call %code22 $r6 %iter %r5 %f))
 
-(define ($main %main-ktail)
-  (prim %lambda-body0 (make-closure $lambda-body0-code7))
-  (tail-call $let-body5 %lambda-body0))
+(define ($cc18 %r19)
+  (pop! %start-ktail0)
+  (tail-call %start-ktail0 %r19))
 
-(define ($let-body5 %square)
-  (pop! %main-ktail)
-  (prim %code6 (env-code %square))
-  (push! %main-ktail)
-  (tail-call %code6 $r3 %square 4))
+(define ($lambda-body10-code26 %lambda-tail11 %lambda-body10 %n)
+  (prim %k (env-ref %lambda-body10 0))
+  (prim %k (env-ref %lambda-body10 1))
+  (prim %r12 (- %n 5))
+  (prim %r13 (zero? %r12))
+  (if %r13
+    (then
+      (prim %code24 (env-code %k))
+      (push! %lambda-tail11)
+      (tail-call %code24 $r14 %k #t))
+    (else
+      (tail-call %lambda-tail11 #f))))
+
+(define ($r6 %x7)
+  (pop! %lambda-tail1)
+  (tail-call %lambda-tail1 %x7))
+
+(define ($r14 %x15)
+  (pop! %lambda-tail11)
+  (tail-call %lambda-tail11 %x15))
+
+(define ($cc-ish20-code28 %_ %cc-ish20 %x21)
+  (prim %cc18 (env-ref %cc-ish20 0))
+  (tail-call %cc18 %x21))
+
+(define ($r16 %x17)
+  (pop! %lambda-tail9)
+  (tail-call %lambda-tail9 %x17))
+
+(define ($iter-code30 %lambda-tail1 %iter %n %f)
+  (prim %r2 (zero? %n))
+  (if %r2
+    (then
+      (tail-call %lambda-tail1 #f))
+    (else
+      (prim %code23 (env-code %f))
+      (push! %n)
+      (push! %lambda-tail1)
+      (push! %iter)
+      (push! %f)
+      (tail-call %code23 $r3 %f %n))))
+
+(define ($lambda-body8-code29 %lambda-tail9 %lambda-body8 %k)
+  (prim %iter (env-ref %lambda-body8 0))
+  (prim %iter (env-ref %lambda-body8 1))
+  (prim %lambda-body10 (make-closure $lambda-body10-code26 %k %k))
+  (prim %code25 (env-code %iter))
+  (push! %lambda-tail9)
+  (tail-call %code25 $r16 %iter 5 %lambda-body10))
+
+(define ($start %start-ktail0)
+  (prim %iter (make-closure $iter-code30))
+  (prim %lambda-body8 (make-closure $lambda-body8-code29 %iter %iter))
+  (prim %cc-ish20 (make-closure $cc-ish20-code28 $cc18))
+  (prim %code27 (env-code %lambda-body8))
+  (push! %start-ktail0)
+  (tail-call %code27 $cc18 %lambda-body8 %cc-ish20))
 |]