machine: fix recursion ending

diff --git a/src/Symantic/Parser/Grammar/ObserveSharing.hs b/src/Symantic/Parser/Grammar/ObserveSharing.hs
index 598989d871240880b038855583aaa93c02fd583a..7a9329b63ea5fccf58f3814b781c4457230c2e7f 100644 (file)
--- a/src/Symantic/Parser/Grammar/ObserveSharing.hs
+++ b/src/Symantic/Parser/Grammar/ObserveSharing.hs
@@ -143,12 +143,6 @@ instance
   ( CombRegisterableUnscoped repr
   ) => CombRegisterableUnscoped (FinalizeSharing TH.Name repr)
 
--- | Ties the knot between mutually recursive 'TH.Name's
--- introduced by 'defLet' and 'defJoin'.
--- and provide the empty initial 'CallTrace' stack
-runOpenRecs :: OpenRecs letName (CallTrace -> a) -> LetRecs letName a
-runOpenRecs ga = (($ []) F.<$>) (mutualFix ga)
-
 -- | Call trace stack updated by 'call' and 'refJoin'.
 -- Used to avoid infinite loops when tying the knot with 'polyfix'.
 type CallTrace = [TH.Name]

diff --git a/src/Symantic/Parser/Machine/Generate.hs b/src/Symantic/Parser/Machine/Generate.hs
index c4b769ac10d880da36663398b7b2d6c51e7e6361..0ca146d585fbe6e3262f4e130ee1323c62cd1905 100644 (file)
--- a/src/Symantic/Parser/Machine/Generate.hs
+++ b/src/Symantic/Parser/Machine/Generate.hs
@@ -14,12 +14,12 @@ module Symantic.Parser.Machine.Generate where
 import Control.DeepSeq (NFData(..))
 import Control.Monad (Monad(..))
 import Control.Monad.ST (ST, runST)
-import Data.Bool (Bool)
+import Data.Bool (Bool(..))
 import Data.Char (Char)
 import Data.Either (Either(..), either)
 import Data.Foldable (toList, null)
 import Data.Function (($), (.), id, on)
-import Data.Functor (Functor, (<$>), (<$))
+import Data.Functor ((<$>), (<$))
 import Data.Int (Int)
 import Data.List.NonEmpty (NonEmpty(..))
 import Data.Map (Map)
@@ -51,7 +51,6 @@ import qualified Language.Haskell.TH.Syntax as TH
 
 import Symantic.Derive
 import Symantic.ObserveSharing
-import Symantic.Parser.Grammar.ObserveSharing
 import Symantic.Parser.Grammar.Combinators
   ( UnscopedRegister(..)
   , Exception(..)
@@ -74,9 +73,9 @@ genCode = derive . Prod.normalOrderReduction
 -- * Type 'Gen'
 -- | Generate the 'CodeQ' parsing the input.
 data Gen inp vs a = Gen
-  { genAnalysisByLet :: OpenRecs TH.Name (CallTrace -> GenAnalysis)
+  { genAnalysisByLet :: OpenRecs TH.Name GenAnalysis
     -- ^ 'genAnalysis' for each 'defLet' and 'defJoin' of the 'Machine'.
-  , genAnalysis :: OpenRec TH.Name (CallTrace -> GenAnalysis)
+  , genAnalysis :: OpenRec TH.Name GenAnalysis
     -- ^ Synthetized (bottom-up) static genAnalysis of the 'Machine'.
   , unGen :: forall st.
       GenCtx st inp vs a ->
@@ -135,7 +134,6 @@ generateCode Gen{unGen=k, ..} = [|| \(input :: inp) ->
         { valueStack = ValueStackEmpty
         , catchStackByLabel = Map.empty :: Map Exception (NonEmpty (TH.CodeQ (Catcher s inp a)))
         , defaultCatch = [||finalRaise||]
-        , analysisCallStack = []
         , returnCall = [||finalRet||] :: CodeQ (Return s inp a a)
         , input = [||init||]
         , nextInput = [||readNext||]
@@ -145,7 +143,7 @@ generateCode Gen{unGen=k, ..} = [|| \(input :: inp) ->
         , farthestExpecting = [||Set.empty||]
         , checkedHorizon = 0
         , horizonStack = []
-        , finalGenAnalysisByLet = runOpenRecs genAnalysisByLet
+        , finalGenAnalysisByLet = mutualFix genAnalysisByLet
         }
       )
     ||]
@@ -258,8 +256,6 @@ data GenCtx st inp vs a =
     -- | Default 'Catcher' defined at the begining of the generated 'CodeQ',
     -- hence a constant within the 'Gen'eration.
   , defaultCatch :: forall b. CodeQ (Catcher st inp b)
-    -- | Used by 'checkToken' to get 'GenAnalysis' from 'genAnalysis'.
-  , analysisCallStack :: [TH.Name]
   , returnCall :: CodeQ (Return st inp a a)
   , input :: CodeQ (Cursor inp)
   , moreInput :: CodeQ (Cursor inp -> Bool)
@@ -276,7 +272,7 @@ data GenCtx st inp vs a =
   -- | Used by 'pushInput' and 'loadInput'
   -- to restore the 'Horizon' at the restored 'input'.
   , horizonStack :: [Horizon]
-  -- | Output of 'runOpenRecs'.
+  -- | Output of 'mutualFix'.
   , finalGenAnalysisByLet :: LetRecs TH.Name GenAnalysis
   }
 
@@ -314,7 +310,7 @@ instance InstrValuable Gen where
 instance InstrBranchable Gen where
   caseBranch kx ky = Gen
     { genAnalysisByLet = genAnalysisByLet kx <> genAnalysisByLet ky
-    , genAnalysis = \final ct -> altGenAnalysis $ genAnalysis kx final ct :| [genAnalysis ky final ct]
+    , genAnalysis = \final -> altGenAnalysis $ genAnalysis kx final :| [genAnalysis ky final]
     , unGen = \ctx -> {-trace "unGen.caseBranch" $-}
       let ValueStackCons v vs = valueStack ctx in
       [||
@@ -325,8 +321,8 @@ instance InstrBranchable Gen where
     }
   choicesBranch bs default_ = Gen
     { genAnalysisByLet = sconcat $ genAnalysisByLet default_ :| (genAnalysisByLet . snd <$> bs)
-    , genAnalysis = \final ct -> altGenAnalysis $
-        (\k -> genAnalysis k final ct)
+    , genAnalysis = \final -> altGenAnalysis $
+        (\k -> genAnalysis k final)
         <$> (default_:|(snd <$> bs))
     , unGen = \ctx0 -> {-trace "unGen.choicesBranch" $-}
       let ValueStackCons v vs = valueStack ctx0 in
@@ -347,7 +343,7 @@ instance InstrBranchable Gen where
 instance InstrExceptionable Gen where
   raise exn = Gen
     { genAnalysisByLet = HM.empty
-    , genAnalysis = \_final _ct -> GenAnalysis
+    , genAnalysis = \_final -> GenAnalysis
         { minReads = Left (ExceptionLabel exn)
         , mayRaise = Map.singleton (ExceptionLabel exn) ()
         }
@@ -361,7 +357,7 @@ instance InstrExceptionable Gen where
     }
   fail fs = Gen
     { genAnalysisByLet = HM.empty
-    , genAnalysis = \_final _ct -> GenAnalysis
+    , genAnalysis = \_final -> GenAnalysis
         { minReads = Left ExceptionFailure
         , mayRaise = Map.singleton ExceptionFailure ()
         }
@@ -388,11 +384,11 @@ instance InstrExceptionable Gen where
     }
   catch exn ok ko = Gen
     { genAnalysisByLet = genAnalysisByLet ok <> genAnalysisByLet ko
-    , genAnalysis = \final ct ->
-        let okGA = genAnalysis ok final ct in
+    , genAnalysis = \final ->
+        let okGA = genAnalysis ok final in
         altGenAnalysis $
           okGA{ mayRaise = Map.delete exn (mayRaise okGA) } :|
-          [ genAnalysis ko final ct ]
+          [ genAnalysis ko final ]
     , unGen = \ctx@GenCtx{} -> {-trace ("unGen.catch: "<>show exn) $-} [||
         let _ = $$(liftTypedString ("catch "<>show exn)) in
         let catchHandler !_exn !failInp !farInp !farExp =
@@ -449,9 +445,9 @@ instance InstrInputable Gen where
           , input = genCode input
           , checkedHorizon = h
           }
-    , genAnalysis = \final ct -> GenAnalysis
-        { minReads = 0 <$ minReads (genAnalysis k final ct)
-        , mayRaise = mayRaise (genAnalysis k final ct)
+    , genAnalysis = \final -> GenAnalysis
+        { minReads = 0 <$ minReads (genAnalysis k final)
+        , mayRaise = mayRaise (genAnalysis k final)
         }
     }
 instance InstrCallable Gen where
@@ -512,15 +508,15 @@ instance InstrCallable Gen where
         ||]
       let decl = TH.FunD subName [TH.Clause [] (TH.NormalB body) []]
       return decl
-  jump (LetName n) = Gen
+  jump isRec (LetName n) = Gen
     { genAnalysisByLet = HM.empty
-    , genAnalysis = \final ct ->
-        if n`List.elem`ct
+    , genAnalysis = \final ->
+        if isRec
         then GenAnalysis
           { minReads = Right 0
           , mayRaise = Map.empty
           }
-        else (final HM.! n) (n:ct)
+        else final HM.! n
     , unGen = \ctx -> {-trace ("unGen.jump: "<>show n) $-} [||
       let _ = "jump" in
       $$(TH.unsafeCodeCoerce (return (TH.VarE n)))
@@ -534,22 +530,22 @@ instance InstrCallable Gen where
         )
       ||]
     }
-  call (LetName n) k = k
-    { genAnalysis = \final ct ->
-        if n`List.elem`ct
+  call isRec (LetName n) k = k
+    { genAnalysis = \final ->
+        if isRec
         then GenAnalysis
           { minReads = Right 0
           , mayRaise = Map.empty
           }
         else seqGenAnalysis $
-          (final HM.! n) (n:ct) :|
-          [ genAnalysis k final ct ]
+          (final HM.! n) :|
+          [ genAnalysis k final ]
     , unGen = {-trace ("unGen.call: "<>show n) $-} \ctx ->
       -- let ks = (Map.keys (catchStackByLabel ctx)) in
       [||
       -- let _ = $$(liftTypedString $ "call exceptByLet("<>show n<>")="<>show (Map.keys (Map.findWithDefault Map.empty n (exceptByLet ctx))) <> " catchStackByLabel(ctx)="<> show ks) in
       $$(TH.unsafeCodeCoerce (return (TH.VarE n)))
-        {-ok-}$$(generateSuspend k ctx{analysisCallStack = n : analysisCallStack ctx})
+        {-ok-}$$(generateSuspend k ctx)
         $$(input ctx)
         $$(liftTypedRaiseByLabel $
           -- FIXME: maybe it should rather pass all the 'mayRaise' of 'n'
@@ -563,7 +559,7 @@ instance InstrCallable Gen where
     }
   ret = Gen
     { genAnalysisByLet = HM.empty
-    , genAnalysis = \_final _ct -> GenAnalysis
+    , genAnalysis = \_final -> GenAnalysis
         { minReads = Right 0
         , mayRaise = Map.empty
         }
@@ -680,15 +676,10 @@ instance InstrJoinable Gen where
         generateResume
           (TH.unsafeCodeCoerce (return (TH.VarE n))) ctx
     , genAnalysisByLet = HM.empty
-    , genAnalysis = \final ct ->
-        if n`List.elem`ct -- FIXME: useless
-        then GenAnalysis
-          { minReads = Right 0
-          , mayRaise = Map.empty
-          }
-        else HM.findWithDefault
-          (error (show (n,ct,HM.keys final)))
-          n final (n:ct)
+    , genAnalysis = \final ->
+        HM.findWithDefault
+          (error (show (n,HM.keys final)))
+          n final
     }
 instance InstrReadable Char Gen where
   read fs p = checkHorizon . checkToken fs p
@@ -696,17 +687,17 @@ instance InstrReadable Word8 Gen where
   read fs p = checkHorizon . checkToken fs p
 instance InstrIterable Gen where
   iter (LetName jumpName) loop done = Gen
-    { genAnalysisByLet =
-      HM.insert jumpName (genAnalysis loop) $
-      genAnalysisByLet loop <>
-      genAnalysisByLet done
-    , genAnalysis = \final ct ->
-      GenAnalysis
-        { minReads = minReads (genAnalysis done final ct)
+    { genAnalysisByLet = HM.unions
+        [ HM.singleton jumpName (genAnalysis loop)
+        , genAnalysisByLet loop
+        , genAnalysisByLet done
+        ]
+    , genAnalysis = \final -> GenAnalysis
+        { minReads = minReads (genAnalysis done final)
         , mayRaise =
             Map.delete ExceptionFailure
-              (mayRaise (genAnalysis loop final ct)) <>
-            mayRaise (genAnalysis done final ct)
+              (mayRaise (genAnalysis loop final)) <>
+            mayRaise (genAnalysis done final)
         }
     , unGen = \ctx -> TH.unsafeCodeCoerce [|
         let _ = "iter" in
@@ -755,7 +746,7 @@ instance InstrIterable Gen where
               , returnCall = TH.unsafeCodeCoerce [|error "invalid return"|]
               , checkedHorizon = 0
               })
-        in $(TH.unTypeCode $ unGen (jump (LetName jumpName)) ctx{valueStack=ValueStackEmpty})
+        in $(TH.unTypeCode $ unGen (jump True (LetName jumpName)) ctx{valueStack=ValueStackEmpty})
        |]
     }
 instance InstrRegisterable Gen where
@@ -797,11 +788,11 @@ checkHorizon ::
   {-ok-}Gen inp vs a ->
   Gen inp vs a
 checkHorizon ok = ok
-  { genAnalysis = \final ct -> seqGenAnalysis $
+  { genAnalysis = \final -> seqGenAnalysis $
       GenAnalysis { minReads = Right 1
                   , mayRaise = Map.singleton ExceptionFailure ()
                   } :|
-      [ genAnalysis ok final ct ]
+      [ genAnalysis ok final ]
   , unGen = \ctx0@GenCtx{} ->
     {-trace "unGen.checkHorizon" $-}
     let raiseFail = raiseException ctx0 ExceptionFailure in
@@ -861,12 +852,7 @@ raiseException ctx exn =
     exn (catchStackByLabel ctx)
 
 finalGenAnalysis :: GenCtx st inp vs a -> Gen inp cs a -> GenAnalysis
-finalGenAnalysis ctx k =
-  --(\f -> f (error "callTrace")) $
-  (\f -> f (analysisCallStack ctx)) $
-  genAnalysis k $
-  ((\f _ct -> f) <$>) $
-  finalGenAnalysisByLet ctx
+finalGenAnalysis ctx k = genAnalysis k $ finalGenAnalysisByLet ctx
 
 checkToken ::
   Set SomeFailure ->

diff --git a/src/Symantic/Parser/Machine/Instructions.hs b/src/Symantic/Parser/Machine/Instructions.hs
index 1b02ae9418fdc1461bf9cd7ae21edd789d8819f9..514eecd5cb5392ae0403b7a0d245d165d60d513b 100644 (file)
--- a/src/Symantic/Parser/Machine/Instructions.hs
+++ b/src/Symantic/Parser/Machine/Instructions.hs
@@ -129,16 +129,18 @@ class InstrCallable (repr::ReprInstr) where
     LetBindings TH.Name (repr inp '[]) ->
     repr inp vs a ->
     repr inp vs a
-  -- | @('call' n k)@ pass the control-flow to the 'DefLet' named @(n)@,
+  -- | @('call' isRec n k)@ pass the control-flow to the 'DefLet' named @(n)@,
   -- and when it 'Ret'urns, continues with the next 'Instr'uction @(k)@.
   call ::
+    Bool ->
     LetName v -> repr inp (v ': vs) a ->
     repr inp vs a
   -- | @('ret')@ returns the value stored in a singleton 'valueStack'.
   ret ::
     repr inp '[a] a
-  -- | @('jump' n k)@ pass the control-flow to the 'DefLet' named @(n)@.
+  -- | @('jump' isRec n k)@ pass the control-flow to the 'DefLet' named @(n)@.
   jump ::
+    Bool ->
     LetName a ->
     repr inp '[] a
 

diff --git a/src/Symantic/Parser/Machine/Optimize.hs b/src/Symantic/Parser/Machine/Optimize.hs
index 2261a4432c1ade278adb69d8c9571f9e4ca0f878..e4f502ec7eaef798f4d3c337b1798e46813e1a99 100644 (file)
--- a/src/Symantic/Parser/Machine/Optimize.hs
+++ b/src/Symantic/Parser/Machine/Optimize.hs
@@ -156,24 +156,26 @@ data instance Instr InstrCallable repr inp vs a where
     SomeInstr repr inp vs a ->
     Instr InstrCallable repr inp vs a
   Call ::
+    Bool ->
     LetName v ->
     SomeInstr repr inp (v ': vs) a ->
     Instr InstrCallable repr inp vs a
   Ret ::
     Instr InstrCallable repr inp '[a] a
   Jump ::
+    Bool ->
     LetName a ->
     Instr InstrCallable repr inp '[] a
 instance InstrCallable repr => Derivable (Instr InstrCallable repr inp vs) where
   derive = \case
     DefLet subs k -> defLet ((\(SomeLet sub) -> SomeLet (derive sub)) Functor.<$> subs) (derive k)
-    Jump n -> jump n
-    Call n k -> call n (derive k)
+    Jump isRec n -> jump isRec n
+    Call isRec n k -> call isRec n (derive k)
     Ret -> ret
 instance InstrCallable repr => InstrCallable (SomeInstr repr) where
   defLet subs = SomeInstr . DefLet subs
-  jump = SomeInstr . Jump
-  call n = SomeInstr . Call n
+  jump isRec = SomeInstr . Jump isRec
+  call isRec n = SomeInstr . Call isRec n
   ret = SomeInstr Ret
 
 -- InstrJoinable

diff --git a/src/Symantic/Parser/Machine/Program.hs b/src/Symantic/Parser/Machine/Program.hs
index 8053b371c5ad93ced6c1cf155f9ae79ffde0e296..443a2cc43cd08b41624184a862f1ddaa3a567669 100644 (file)
--- a/src/Symantic/Parser/Machine/Program.hs
+++ b/src/Symantic/Parser/Machine/Program.hs
@@ -178,7 +178,7 @@ instance
         (op $
           mapValue (Prod.flip Prod..@ (Prod..)) $
           modifyRegister r $
-          jump (LetName loopName) )
+          jump True (LetName loopName) )
         (raiseAgainIfConsumed ExceptionFailure .
           readRegister r Functor.<$>
           (done (applyValue next)))
@@ -188,7 +188,7 @@ instance
       liftM2 (iter (LetName loopName))
         (op $
           modifyRegister (UnscopedRegister (unUnscopedRegister r)) $
-          jump (LetName loopName) )
+          jump True (LetName loopName) )
         (raiseAgainIfConsumed ExceptionFailure .
           readRegister r Functor.<$>
           (done (applyValue next)))
@@ -202,8 +202,8 @@ instance
     -- returning just after a 'call' is useless:
     -- using 'jump' lets the 'ret' of the 'defLet'
     -- directly return where it would in two 'ret's.
-    Instr Ret{} -> return $ jump (LetName name)
-    next -> return $ call (LetName name) next
+    Instr Ret{} -> return $ jump isRec (LetName name)
+    next -> return $ call isRec (LetName name) next
   {-
   refable n (Program sub) = Program $ \next -> do
     sub' <- sub ret

diff --git a/src/Symantic/Parser/Machine/View.hs b/src/Symantic/Parser/Machine/View.hs
index 437415027cc65845baeb5465dbfd90d25f2f3bc0..0a77a56dc0513a6ac3999d1aef89e8c439c05061 100644 (file)
--- a/src/Symantic/Parser/Machine/View.hs
+++ b/src/Symantic/Parser/Machine/View.hs
@@ -23,7 +23,6 @@ import Prelude (error)
 import Symantic.Parser.Grammar.Combinators (UnscopedRegister(..))
 import Symantic.Parser.Grammar.ObserveSharing
 import Symantic.Parser.Machine.Instructions
-import Symantic.ObserveSharing (SomeLet(..))
 import Symantic.Parser.Machine.Generate
 
 -- * Type 'ViewMachine'
@@ -33,7 +32,6 @@ data ViewMachine (showName::Bool) inp (vs:: [Type]) a
     -- ^ Provide 'GenAnalysis', which is important for debugging
     -- and improving golden tests, see 'viewInstrCmd'.
   , unViewMachine ::
-      CallTrace ->
       LetRecs TH.Name GenAnalysis -> -- Output of 'runOpenRecs'.
       Tree.Forest (String, String) ->
       Tree.Forest (String, String)
@@ -47,16 +45,15 @@ viewMachine = id
 -- | Helper to view a command.
 viewInstrCmd ::
   Either TH.Name (Gen inp vs a) ->
-  CallTrace ->
   LetRecs TH.Name GenAnalysis ->
   (String, String) -> Tree.Forest (String, String) -> Tree.Tree (String, String)
-viewInstrCmd gen ct lm (n, no) = Tree.Node $ (n
+viewInstrCmd gen lm (n, no) = Tree.Node $ (n
   <> "\nminReads="<>showsPrec 11 (minReads ga) ""
   <> "\nmayRaise="<>showsPrec 11 (Map.keys (mayRaise ga)) ""
   , no)
   where
   ga = case gen of
-         Right r -> (\f -> f ct) $ genAnalysis r $ (\f _ct -> f) <$> lm
+         Right r -> genAnalysis r lm
          Left l -> HM.findWithDefault (error (show (l, HM.keys lm))) l lm
 
 -- | Helper to view an argument.
@@ -65,7 +62,7 @@ viewInstrArg n = Tree.Node $ ("<"<>n<>">", "")
 
 instance Show (ViewMachine sN inp vs a) where
   show vm = List.unlines $ drawTrees $
-      unViewMachine vm [] (runOpenRecs (genAnalysisByLet (viewGen vm))) []
+      unViewMachine vm (mutualFix (genAnalysisByLet (viewGen vm))) []
     where
     draw :: Tree.Tree (String, String) -> [String]
     draw (Tree.Node (x, n) ts0) =
@@ -78,69 +75,69 @@ instance Show (ViewMachine sN inp vs a) where
 
 instance InstrValuable (ViewMachine sN) where
   pushValue a k = ViewMachine
-    { unViewMachine = \ct lm next ->
-        viewInstrCmd (Right gen) ct lm ("pushValue "<>showsPrec 10 a "", "") [] :
-        unViewMachine k ct lm next
+    { unViewMachine = \lm next ->
+        viewInstrCmd (Right gen) lm ("pushValue "<>showsPrec 10 a "", "") [] :
+        unViewMachine k lm next
     , viewGen = gen
     } where gen = pushValue a (viewGen k)
   popValue k = ViewMachine
-    { unViewMachine = \ct lm next ->
-        viewInstrCmd (Right gen) ct lm ("popValue", "") [] :
-        unViewMachine k ct lm next
+    { unViewMachine = \lm next ->
+        viewInstrCmd (Right gen) lm ("popValue", "") [] :
+        unViewMachine k lm next
     , viewGen = gen
     } where gen = popValue (viewGen k)
   lift2Value f k = ViewMachine
-    { unViewMachine = \ct lm next ->
-        viewInstrCmd (Right gen) ct lm ("lift2Value "<>showsPrec 10 f "", "") [] :
-        unViewMachine k ct lm next
+    { unViewMachine = \lm next ->
+        viewInstrCmd (Right gen) lm ("lift2Value "<>showsPrec 10 f "", "") [] :
+        unViewMachine k lm next
     , viewGen = gen
     } where gen = lift2Value f (viewGen k)
   swapValue k = ViewMachine
-    { unViewMachine = \ct lm next ->
-        viewInstrCmd (Right gen) ct lm ("swapValue", "") [] :
-        unViewMachine k ct lm next
+    { unViewMachine = \lm next ->
+        viewInstrCmd (Right gen) lm ("swapValue", "") [] :
+        unViewMachine k lm next
     , viewGen = gen
     } where gen = swapValue (viewGen k)
 instance InstrExceptionable (ViewMachine sN) where
   raise exn = ViewMachine
-    { unViewMachine = \ct lm next ->
-        viewInstrCmd (Right gen) ct lm ("raise "<>show exn, "") [] : next
+    { unViewMachine = \lm next ->
+        viewInstrCmd (Right gen) lm ("raise "<>show exn, "") [] : next
     , viewGen = gen
     } where gen = raise exn
   fail flr = ViewMachine
-    { unViewMachine = \ct lm next ->
-        viewInstrCmd (Right gen) ct lm ("fail "<>show (Set.toList flr), "") [] : next
+    { unViewMachine = \lm next ->
+        viewInstrCmd (Right gen) lm ("fail "<>show (Set.toList flr), "") [] : next
     , viewGen = gen
     } where gen = fail flr
   commit exn k = ViewMachine
-    { unViewMachine = \ct lm next ->
-        viewInstrCmd (Right gen) ct lm ("commit "<>show exn, "") [] :
-        unViewMachine k ct lm next
+    { unViewMachine = \lm next ->
+        viewInstrCmd (Right gen) lm ("commit "<>show exn, "") [] :
+        unViewMachine k lm next
     , viewGen = gen
     } where gen = commit exn (viewGen k)
   catch exn ok ko = ViewMachine
-    { unViewMachine = \ct lm next ->
-        viewInstrCmd (Right gen) ct lm ("catch "<>show exn, "")
-          [ viewInstrArg "ok" (unViewMachine ok ct lm [])
-          , viewInstrArg "ko" (unViewMachine ko ct lm [])
+    { unViewMachine = \lm next ->
+        viewInstrCmd (Right gen) lm ("catch "<>show exn, "")
+          [ viewInstrArg "ok" (unViewMachine ok lm [])
+          , viewInstrArg "ko" (unViewMachine ko lm [])
           ] : next
     , viewGen = gen
     } where gen = catch exn (viewGen ok) (viewGen ko)
 instance InstrBranchable (ViewMachine sN) where
   caseBranch l r = ViewMachine
-    { unViewMachine = \ct lm next ->
-        viewInstrCmd (Right gen) ct lm ("case", "")
-          [ viewInstrArg "left" (unViewMachine l ct lm [])
-          , viewInstrArg "right" (unViewMachine r ct lm [])
+    { unViewMachine = \lm next ->
+        viewInstrCmd (Right gen) lm ("case", "")
+          [ viewInstrArg "left" (unViewMachine l lm [])
+          , viewInstrArg "right" (unViewMachine r lm [])
           ] : next
     , viewGen = gen
     } where gen = caseBranch (viewGen l) (viewGen r)
   choicesBranch bs d = ViewMachine
-    { unViewMachine = \ct lm next ->
-        viewInstrCmd (Right gen) ct lm ("choicesBranch", "") (
+    { unViewMachine = \lm next ->
+        viewInstrCmd (Right gen) lm ("choicesBranch", "") (
           ((\(p, b) -> viewInstrArg ("branch "<>showsPrec 10 p "") $
-            unViewMachine b ct lm []) <$> bs) <>
-          [ viewInstrArg "default" (unViewMachine d ct lm []) ]
+            unViewMachine b lm []) <$> bs) <>
+          [ viewInstrArg "default" (unViewMachine d lm []) ]
         ) : next
     , viewGen = gen
     } where gen = choicesBranch ((viewGen <$>) <$> bs) (viewGen d)
@@ -148,78 +145,78 @@ instance
   ShowLetName sN TH.Name =>
   InstrCallable (ViewMachine sN) where
   defLet defs k = ViewMachine
-    { unViewMachine = \ct lm next ->
-        (<> unViewMachine k ct lm next) $
+    { unViewMachine = \lm next ->
+        (<> unViewMachine k lm next) $
         List.sortBy (compare `on` (((fst <$>) <$>) . Tree.levels)) $
         ((\(n, SomeLet sub) ->
-          viewInstrCmd (Left n) ct lm
+          viewInstrCmd (Left n) lm
             ("let", " "<>showLetName @sN n)
-            (unViewMachine sub ct lm []))
+            (unViewMachine sub lm []))
           <$> HM.toList defs)
     , viewGen = gen
     } where gen = defLet ((\(SomeLet x) -> SomeLet (viewGen x)) <$> defs) (viewGen k)
-  jump ln@(LetName n) = ViewMachine
-    { unViewMachine = \ct lm next ->
-        viewInstrCmd (Right gen) ct lm ("jump", " "<>showLetName @sN n) [] : next
+  jump isRec ln@(LetName n) = ViewMachine
+    { unViewMachine = \lm next ->
+        viewInstrCmd (Right gen) lm ("jump", " "<>showLetName @sN n) [] : next
     , viewGen = gen
-    } where gen = jump ln
-  call ln@(LetName n) k = ViewMachine
-    { unViewMachine = \ct lm next ->
-        viewInstrCmd (Right gen) ct lm ("call", " "<>showLetName @sN n) [] :
-        unViewMachine k (n:ct) lm next
+    } where gen = jump isRec ln
+  call isRec ln@(LetName n) k = ViewMachine
+    { unViewMachine = \lm next ->
+        viewInstrCmd (Right gen) lm ("call", " "<>showLetName @sN n) [] :
+        unViewMachine k lm next
     , viewGen = gen
-    } where gen = call ln (viewGen k)
+    } where gen = call isRec ln (viewGen k)
   ret = ViewMachine
-    { unViewMachine = \ct lm next ->
-        viewInstrCmd (Right gen) ct lm ("ret", "") [] : next
+    { unViewMachine = \lm next ->
+        viewInstrCmd (Right gen) lm ("ret", "") [] : next
     , viewGen = gen
     } where gen = ret
 instance
   ShowLetName sN TH.Name =>
   InstrJoinable (ViewMachine sN) where
   defJoin ln@(LetName n) j k = ViewMachine
-    { unViewMachine = \ct lm next ->
-        viewInstrCmd (Left n) ct lm
+    { unViewMachine = \lm next ->
+        viewInstrCmd (Left n) lm
           ("join", " "<>showLetName @sN n)
-          (unViewMachine j ct lm []) :
-        unViewMachine k (n:ct) lm next
+          (unViewMachine j lm []) :
+        unViewMachine k lm next
     , viewGen = gen
     } where gen = defJoin ln (viewGen j) (viewGen k)
   refJoin ln@(LetName n) = ViewMachine
-    { unViewMachine = \ct lm next ->
-        viewInstrCmd (Right gen) ct lm ("refJoin", " "<>showLetName @sN n) [] : next
+    { unViewMachine = \lm next ->
+        viewInstrCmd (Right gen) lm ("refJoin", " "<>showLetName @sN n) [] : next
     , viewGen = gen
     } where gen = refJoin ln
 instance InstrInputable (ViewMachine sN) where
   pushInput k = ViewMachine
-    { unViewMachine = \ct lm next ->
-        viewInstrCmd (Right gen) ct lm ("pushInput", "") [] :
-        unViewMachine k ct lm next
+    { unViewMachine = \lm next ->
+        viewInstrCmd (Right gen) lm ("pushInput", "") [] :
+        unViewMachine k lm next
     , viewGen = gen
     } where gen = pushInput (viewGen k)
   loadInput k = ViewMachine
-    { unViewMachine = \ct lm next ->
-        viewInstrCmd (Right gen) ct lm ("loadInput", "") [] :
-        unViewMachine k ct lm next
+    { unViewMachine = \lm next ->
+        viewInstrCmd (Right gen) lm ("loadInput", "") [] :
+        unViewMachine k lm next
     , viewGen = gen
     } where gen = loadInput (viewGen k)
 instance
   InstrReadable tok Gen =>
   InstrReadable tok (ViewMachine sN) where
   read es p k = ViewMachine
-    { unViewMachine = \ct lm next ->
-        viewInstrCmd (Right gen) ct lm ("read "<>showsPrec 10 p "", "") [] :
-        unViewMachine k ct lm next
+    { unViewMachine = \lm next ->
+        viewInstrCmd (Right gen) lm ("read "<>showsPrec 10 p "", "") [] :
+        unViewMachine k lm next
     , viewGen = gen
     } where gen = read es p (viewGen k)
 instance
   ShowLetName sN TH.Name =>
   InstrIterable (ViewMachine sN) where
   iter jumpName@(LetName n) ok ko = ViewMachine
-    { unViewMachine = \ct lm next ->
-        viewInstrCmd (Right gen) ct lm ("iter", " "<>showLetName @sN n)
-          [ viewInstrArg "ok" (unViewMachine ok ct lm [])
-          , viewInstrArg "ko" (unViewMachine ko ct lm [])
+    { unViewMachine = \lm next ->
+        viewInstrCmd (Right gen) lm ("iter", " "<>showLetName @sN n)
+          [ viewInstrArg "ok" (unViewMachine ok lm [])
+          , viewInstrArg "ko" (unViewMachine ko lm [])
           ] : next
     , viewGen = gen
     } where gen = iter jumpName (viewGen ok) (viewGen ko)
@@ -227,20 +224,20 @@ instance
   ShowLetName sN TH.Name =>
   InstrRegisterable (ViewMachine sN) where
   newRegister reg@(UnscopedRegister r) k = ViewMachine
-    { unViewMachine = \ct lm next ->
-        viewInstrCmd (Right gen) ct lm ("newRegister", " "<>showLetName @sN r) [] :
-        unViewMachine k ct lm next
+    { unViewMachine = \lm next ->
+        viewInstrCmd (Right gen) lm ("newRegister", " "<>showLetName @sN r) [] :
+        unViewMachine k lm next
     , viewGen = gen
     } where gen = newRegister reg (viewGen k)
   readRegister reg@(UnscopedRegister r) k = ViewMachine
-    { unViewMachine = \ct lm next ->
-        viewInstrCmd (Right gen) ct lm ("readRegister", " "<>showLetName @sN r) [] :
-        unViewMachine k ct lm next
+    { unViewMachine = \lm next ->
+        viewInstrCmd (Right gen) lm ("readRegister", " "<>showLetName @sN r) [] :
+        unViewMachine k lm next
     , viewGen = gen
     } where gen = readRegister reg (viewGen k)
   writeRegister reg@(UnscopedRegister r) k = ViewMachine
-    { unViewMachine = \ct lm next ->
-        viewInstrCmd (Right gen) ct lm ("writeRegister", " "<>showLetName @sN r) [] :
-        unViewMachine k ct lm next
+    { unViewMachine = \lm next ->
+        viewInstrCmd (Right gen) lm ("writeRegister", " "<>showLetName @sN r) [] :
+        unViewMachine k lm next
     , viewGen = gen
     } where gen = writeRegister reg (viewGen k)