{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
{-# LANGUAGE PatternSynonyms #-}
{-|
Module      : Parsley.Internal.Backend.CodeGenerator
Description : Translation of Combinator AST into Machine
License     : BSD-3-Clause
Maintainer  : Jamie Willis
Stability   : experimental

This module exports `codeGen` used to translation from the high-level representation
to the low-level representation.

@since 1.0.0.0
-}
module Parsley.Internal.Backend.CodeGenerator (codeGen) where

import Data.Set                            (Set, elems)
import Control.Monad.Trans                 (lift)
import Parsley.Internal.Backend.Machine    (user, LetBinding, makeLetBinding, newMeta, Instr(..), Handler(..),
                                            _Fmap, _App, _Get, _Put, _Make,
                                            addCoins, refundCoins, drainCoins, giveBursary, blockCoins,
                                            minus, minCoins, maxCoins, zero,
                                            IMVar, IΦVar, MVar(..), ΦVar(..), SomeΣVar)
import Parsley.Internal.Backend.Analysis   (coinsNeeded, shouldInline, reclaimable)
import Parsley.Internal.Common.Fresh       (VFreshT, VFresh, evalFreshT, evalFresh, construct, MonadFresh(..), mapVFreshT)
import Parsley.Internal.Common.Indexed     (Fix, Fix4(In4), Cofree(..), Nat(..), imap, histo, extract, (|>))
import Parsley.Internal.Core.CombinatorAST (Combinator(..), MetaCombinator(..))
import Parsley.Internal.Core.Defunc        (pattern UNIT)
import Parsley.Internal.Trace              (Trace(trace))

import Parsley.Internal.Core.Defunc as Core (Defunc)

type CodeGenStack a = VFreshT IΦVar (VFresh IMVar) a
runCodeGenStack :: CodeGenStack a -> IMVar -> IΦVar -> a
runCodeGenStack :: CodeGenStack a -> IMVar -> IΦVar -> a
runCodeGenStack CodeGenStack a
m IMVar
μ0 IΦVar
φ0 = VFreshT IMVar Identity a -> IMVar -> a
forall x (m :: Type -> Type) a.
RunFreshT x Identity m =>
m a -> x -> a
evalFresh (CodeGenStack a -> IΦVar -> VFreshT IMVar Identity a
forall x (n :: Type -> Type) (m :: Type -> Type) a.
RunFreshT x n m =>
m a -> x -> n a
evalFreshT CodeGenStack a
m IΦVar
φ0) IMVar
μ0

newtype CodeGen o a x =
  CodeGen {CodeGen o a x
-> forall (xs :: [Type]) (n :: Nat) r.
   Fix4 (Instr o) (x : xs) ('Succ n) r a
   -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
runCodeGen :: forall xs n r. Fix4 (Instr o) (x : xs) (Succ n) r a -> CodeGenStack (Fix4 (Instr o) xs (Succ n) r a)}

{-|
Translates a parser represented with combinators into its machine representation.

@since 1.0.0.0
-}
{-# INLINEABLE codeGen #-}
codeGen :: Trace
        => Maybe (MVar x)   -- ^ The name of the parser, if it exists.
        -> Fix Combinator x -- ^ The definition of the parser.
        -> Set SomeΣVar     -- ^ The free registers it requires to run.
        -> IMVar            -- ^ The binding identifier to start name generation from.
        -> LetBinding o a x
codeGen :: Maybe (MVar x)
-> Fix Combinator x -> Set SomeΣVar -> IMVar -> LetBinding o a x
codeGen Maybe (MVar x)
letBound Fix Combinator x
p Set SomeΣVar
rs IMVar
μ0 = String -> LetBinding o a x -> LetBinding o a x
forall a. Trace => String -> a -> a
trace (String
"GENERATING " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Fix Combinator x -> String
forall a. Show a => a -> String
show Fix Combinator x
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\nMACHINE: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [SomeΣVar] -> String
forall a. Show a => a -> String
show (Set SomeΣVar -> [SomeΣVar]
forall a. Set a -> [a]
elems Set SomeΣVar
rs) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" => " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Fix4 (Instr o) '[] ('Succ 'Zero) x a -> String
forall a. Show a => a -> String
show Fix4 (Instr o) '[] ('Succ 'Zero) x a
m) (LetBinding o a x -> LetBinding o a x)
-> LetBinding o a x -> LetBinding o a x
forall a b. (a -> b) -> a -> b
$ Fix4 (Instr o) '[] ('Succ 'Zero) x a
-> Set SomeΣVar -> Metadata -> LetBinding o a x
forall o a x.
Binding o a x -> Set SomeΣVar -> Metadata -> LetBinding o a x
makeLetBinding Fix4 (Instr o) '[] ('Succ 'Zero) x a
m Set SomeΣVar
rs Metadata
newMeta
  where
    name :: String
name = String -> (MVar x -> String) -> Maybe (MVar x) -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"TOP LEVEL" MVar x -> String
forall a. Show a => a -> String
show Maybe (MVar x)
letBound
    m :: Fix4 (Instr o) '[] ('Succ 'Zero) x a
m = CodeGen o a x -> Fix4 (Instr o) '[] ('Succ 'Zero) x a
finalise ((forall j.
 Combinator (Cofree Combinator (CodeGen o a)) j -> CodeGen o a j)
-> Fix Combinator x -> CodeGen o a x
forall (f :: (Type -> Type) -> Type -> Type) (a :: Type -> Type) i.
IFunctor f =>
(forall j. f (Cofree f a) j -> a j) -> Fix f i -> a i
histo forall j.
Combinator (Cofree Combinator (CodeGen o a)) j -> CodeGen o a j
forall o a x.
Combinator (Cofree Combinator (CodeGen o a)) x -> CodeGen o a x
alg Fix Combinator x
p)
    alg :: Combinator (Cofree Combinator (CodeGen o a)) x -> CodeGen o a x
    alg :: Combinator (Cofree Combinator (CodeGen o a)) x -> CodeGen o a x
alg = Combinator (Cofree Combinator (CodeGen o a)) x
-> Maybe (CodeGen o a x)
forall o a x.
Trace =>
Combinator (Cofree Combinator (CodeGen o a)) x
-> Maybe (CodeGen o a x)
deep (Combinator (Cofree Combinator (CodeGen o a)) x
 -> Maybe (CodeGen o a x))
-> (Combinator (Cofree Combinator (CodeGen o a)) x
    -> CodeGen o a x)
-> Combinator (Cofree Combinator (CodeGen o a)) x
-> CodeGen o a x
forall r k a. Chain r k => (a -> Maybe r) -> (a -> k) -> a -> k
|> (\Combinator (Cofree Combinator (CodeGen o a)) x
x -> (forall (xs :: [Type]) (n :: Nat) r.
 Fix4 (Instr o) (x : xs) ('Succ n) r a
 -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a))
-> CodeGen o a x
forall o a x.
(forall (xs :: [Type]) (n :: Nat) r.
 Fix4 (Instr o) (x : xs) ('Succ n) r a
 -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a))
-> CodeGen o a x
CodeGen (Combinator (CodeGen o a) x
-> Fix4 (Instr o) (x : xs) ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall o a x (xs :: [Type]) (n :: Nat) r.
Trace =>
Combinator (CodeGen o a) x
-> Fix4 (Instr o) (x : xs) ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
shallow ((forall j. Cofree Combinator (CodeGen o a) j -> CodeGen o a j)
-> Combinator (Cofree Combinator (CodeGen o a)) x
-> Combinator (CodeGen o a) x
forall (f :: (Type -> Type) -> Type -> Type) (a :: Type -> Type)
       (b :: Type -> Type) i.
IFunctor f =>
(forall j. a j -> b j) -> f a i -> f b i
imap forall j. Cofree Combinator (CodeGen o a) j -> CodeGen o a j
forall k (f :: (k -> Type) -> k -> Type) (a :: k -> Type) (i :: k).
Cofree f a i -> a i
extract Combinator (Cofree Combinator (CodeGen o a)) x
x)))
    -- It is never safe to add coins to the top of a binding
    -- This is because we don't know the characteristics of the caller (even the top-level!)
    finalise :: CodeGen o a x -> Fix4 (Instr o) '[] ('Succ 'Zero) x a
finalise CodeGen o a x
cg = CodeGenStack (Fix4 (Instr o) '[] ('Succ 'Zero) x a)
-> IMVar -> IΦVar -> Fix4 (Instr o) '[] ('Succ 'Zero) x a
forall a. CodeGenStack a -> IMVar -> IΦVar -> a
runCodeGenStack (CodeGen o a x
-> Fix4 (Instr o) '[x] ('Succ 'Zero) x a
-> CodeGenStack (Fix4 (Instr o) '[] ('Succ 'Zero) x a)
forall o a x.
CodeGen o a x
-> forall (xs :: [Type]) (n :: Nat) r.
   Fix4 (Instr o) (x : xs) ('Succ n) r a
   -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
runCodeGen CodeGen o a x
cg (Instr o (Fix4 (Instr o)) '[x] ('Succ 'Zero) x a
-> Fix4 (Instr o) '[x] ('Succ 'Zero) x a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 Instr o (Fix4 (Instr o)) '[x] ('Succ 'Zero) x a
forall o (k :: [Type] -> Nat -> Type -> Type -> Type) x (n :: Nat)
       a.
Instr o k '[x] n x a
Ret)) IMVar
μ0 IΦVar
0

pattern (:<$>:) :: Core.Defunc (a -> b) -> Cofree Combinator k a -> Combinator (Cofree Combinator k) b
pattern f $m:<$>: :: forall r b (k :: Type -> Type).
Combinator (Cofree Combinator k) b
-> (forall a. Defunc (a -> b) -> Cofree Combinator k a -> r)
-> (Void# -> r)
-> r
:<$>: p <- (_ :< Pure f) :<*>: p
pattern (:$>:) :: Combinator (Cofree Combinator k) a -> Core.Defunc b -> Combinator (Cofree Combinator k) b
pattern p $m:$>: :: forall r (k :: Type -> Type) b.
Combinator (Cofree Combinator k) b
-> (forall a. Combinator (Cofree Combinator k) a -> Defunc b -> r)
-> (Void# -> r)
-> r
:$>: x <- (_ :< p) :*>: (_ :< Pure x)
pattern TryOrElse ::  k a -> k a -> Combinator (Cofree Combinator k) a
pattern $mTryOrElse :: forall r (k :: Type -> Type) a.
Combinator (Cofree Combinator k) a
-> (k a -> k a -> r) -> (Void# -> r) -> r
TryOrElse p q <- (_ :< Try (p :< _)) :<|>: (q :< _)

-- it would be nice to generate `yesSame` handler bindings for Try, perhaps a special flag?
-- relevancy analysis might help too I guess, for a more general one?
rollbackHandler :: Handler o (Fix4 (Instr o)) (o : xs) (Succ n) r a
rollbackHandler :: Handler o (Fix4 (Instr o)) (o : xs) ('Succ n) r a
rollbackHandler = Bool
-> Fix4 (Instr o) (o : xs) ('Succ n) r a
-> Handler o (Fix4 (Instr o)) (o : xs) ('Succ n) r a
forall (k :: [Type] -> Nat -> Type -> Type -> Type) o
       (xs :: [Type]) (n :: Nat) r a.
Bool -> k (o : xs) n r a -> Handler o k (o : xs) n r a
Always Bool
False (Instr o (Fix4 (Instr o)) (o : xs) ('Succ n) r a
-> Fix4 (Instr o) (o : xs) ('Succ n) r a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 (Fix4 (Instr o) xs ('Succ n) r a
-> Instr o (Fix4 (Instr o)) (o : xs) ('Succ n) r a
forall (k :: [Type] -> Nat -> Type -> Type -> Type) (xs :: [Type])
       (n :: Nat) r a o.
k xs n r a -> Instr o k (o : xs) n r a
Seek (Instr o (Fix4 (Instr o)) xs ('Succ n) r a
-> Fix4 (Instr o) xs ('Succ n) r a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 Instr o (Fix4 (Instr o)) xs ('Succ n) r a
forall o (k :: [Type] -> Nat -> Type -> Type -> Type)
       (xs :: [Type]) (n :: Nat) r a.
Instr o k xs ('Succ n) r a
Empt)))

parsecHandler :: Fix4 (Instr o) xs (Succ n) r a -> Handler o (Fix4 (Instr o)) (o : xs) (Succ n) r a
parsecHandler :: Fix4 (Instr o) xs ('Succ n) r a
-> Handler o (Fix4 (Instr o)) (o : xs) ('Succ n) r a
parsecHandler Fix4 (Instr o) xs ('Succ n) r a
k = Bool
-> Fix4 (Instr o) xs ('Succ n) r a
-> Bool
-> Fix4 (Instr o) (o : xs) ('Succ n) r a
-> Handler o (Fix4 (Instr o)) (o : xs) ('Succ n) r a
forall (k :: [Type] -> Nat -> Type -> Type -> Type) (xs :: [Type])
       (n :: Nat) r a o.
Bool
-> k xs n r a
-> Bool
-> k (o : xs) n r a
-> Handler o k (o : xs) n r a
Same (Bool -> Bool
not (Fix4 (Instr o) xs ('Succ n) r a -> Bool
forall o (xs :: [Type]) (n :: Nat) r a.
Fix4 (Instr o) xs n r a -> Bool
shouldInline Fix4 (Instr o) xs ('Succ n) r a
k)) Fix4 (Instr o) xs ('Succ n) r a
k Bool
False (Instr o (Fix4 (Instr o)) (o : xs) ('Succ n) r a
-> Fix4 (Instr o) (o : xs) ('Succ n) r a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 Instr o (Fix4 (Instr o)) (o : xs) ('Succ n) r a
forall o (k :: [Type] -> Nat -> Type -> Type -> Type)
       (xs :: [Type]) (n :: Nat) r a.
Instr o k xs ('Succ n) r a
Empt)

recoverHandler :: Fix4 (Instr o) xs n r a -> Handler o (Fix4 (Instr o)) (o : xs) n r a
recoverHandler :: Fix4 (Instr o) xs n r a
-> Handler o (Fix4 (Instr o)) (o : xs) n r a
recoverHandler = Bool
-> Fix4 (Instr o) (o : xs) n r a
-> Handler o (Fix4 (Instr o)) (o : xs) n r a
forall (k :: [Type] -> Nat -> Type -> Type -> Type) o
       (xs :: [Type]) (n :: Nat) r a.
Bool -> k (o : xs) n r a -> Handler o k (o : xs) n r a
Always (Bool
 -> Fix4 (Instr o) (o : xs) n r a
 -> Handler o (Fix4 (Instr o)) (o : xs) n r a)
-> (Fix4 (Instr o) xs n r a -> Bool)
-> Fix4 (Instr o) xs n r a
-> Fix4 (Instr o) (o : xs) n r a
-> Handler o (Fix4 (Instr o)) (o : xs) n r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not (Bool -> Bool)
-> (Fix4 (Instr o) xs n r a -> Bool)
-> Fix4 (Instr o) xs n r a
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fix4 (Instr o) xs n r a -> Bool
forall o (xs :: [Type]) (n :: Nat) r a.
Fix4 (Instr o) xs n r a -> Bool
shouldInline (Fix4 (Instr o) xs n r a
 -> Fix4 (Instr o) (o : xs) n r a
 -> Handler o (Fix4 (Instr o)) (o : xs) n r a)
-> (Fix4 (Instr o) xs n r a -> Fix4 (Instr o) (o : xs) n r a)
-> Fix4 (Instr o) xs n r a
-> Handler o (Fix4 (Instr o)) (o : xs) n r a
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Instr o (Fix4 (Instr o)) (o : xs) n r a
-> Fix4 (Instr o) (o : xs) n r a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 (Instr o (Fix4 (Instr o)) (o : xs) n r a
 -> Fix4 (Instr o) (o : xs) n r a)
-> (Fix4 (Instr o) xs n r a
    -> Instr o (Fix4 (Instr o)) (o : xs) n r a)
-> Fix4 (Instr o) xs n r a
-> Fix4 (Instr o) (o : xs) n r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fix4 (Instr o) xs n r a -> Instr o (Fix4 (Instr o)) (o : xs) n r a
forall (k :: [Type] -> Nat -> Type -> Type -> Type) (xs :: [Type])
       (n :: Nat) r a o.
k xs n r a -> Instr o k (o : xs) n r a
Seek

altNoCutCompile :: Trace => CodeGen o a y -> CodeGen o a x
                -> (forall n xs r. Fix4 (Instr o) xs (Succ n) r a -> Handler o (Fix4 (Instr o)) (o : xs) (Succ n) r a)
                -> (forall n xs r. Fix4 (Instr o) (x : xs) n r a  -> Fix4 (Instr o) (y : xs) n r a)
                -> Fix4 (Instr o) (x : xs) (Succ n) r a -> CodeGenStack (Fix4 (Instr o) xs (Succ n) r a)
altNoCutCompile :: CodeGen o a y
-> CodeGen o a x
-> (forall (n :: Nat) (xs :: [Type]) r.
    Fix4 (Instr o) xs ('Succ n) r a
    -> Handler o (Fix4 (Instr o)) (o : xs) ('Succ n) r a)
-> (forall (n :: Nat) (xs :: [Type]) r.
    Fix4 (Instr o) (x : xs) n r a -> Fix4 (Instr o) (y : xs) n r a)
-> Fix4 (Instr o) (x : xs) ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
altNoCutCompile CodeGen o a y
p CodeGen o a x
q forall (n :: Nat) (xs :: [Type]) r.
Fix4 (Instr o) xs ('Succ n) r a
-> Handler o (Fix4 (Instr o)) (o : xs) ('Succ n) r a
handler forall (n :: Nat) (xs :: [Type]) r.
Fix4 (Instr o) (x : xs) n r a -> Fix4 (Instr o) (y : xs) n r a
post Fix4 (Instr o) (x : xs) ('Succ n) r a
m =
  do (Fix4 (Instr o) xs ('Succ n) r a -> Fix4 (Instr o) xs ('Succ n) r a
binder, Fix4 (Instr o) (x : xs) ('Succ n) r a
φ) <- Fix4 (Instr o) (x : xs) ('Succ n) r a
-> CodeGenStack
     (Fix4 (Instr o) xs ('Succ n) r a
      -> Fix4 (Instr o) xs ('Succ n) r a,
      Fix4 (Instr o) (x : xs) ('Succ n) r a)
forall o x (xs :: [Type]) (n :: Nat) r a.
Trace =>
Fix4 (Instr o) (x : xs) ('Succ n) r a
-> CodeGenStack
     (Fix4 (Instr o) xs ('Succ n) r a
      -> Fix4 (Instr o) xs ('Succ n) r a,
      Fix4 (Instr o) (x : xs) ('Succ n) r a)
makeΦ Fix4 (Instr o) (x : xs) ('Succ n) r a
m
     Fix4 (Instr o) xs ('Succ ('Succ n)) r a
pc <- CodeGenStack (Fix4 (Instr o) xs ('Succ ('Succ n)) r a)
-> CodeGenStack (Fix4 (Instr o) xs ('Succ ('Succ n)) r a)
forall a. CodeGenStack a -> CodeGenStack a
freshΦ (CodeGen o a y
-> Fix4 (Instr o) (y : xs) ('Succ ('Succ n)) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ ('Succ n)) r a)
forall o a x.
CodeGen o a x
-> forall (xs :: [Type]) (n :: Nat) r.
   Fix4 (Instr o) (x : xs) ('Succ n) r a
   -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
runCodeGen CodeGen o a y
p (Fix4 (Instr o) (y : xs) ('Succ n) r a
-> Fix4 (Instr o) (y : xs) ('Succ ('Succ n)) r a
forall o (xs :: [Type]) (n :: Nat) r a.
Fix4 (Instr o) xs n r a -> Fix4 (Instr o) xs ('Succ n) r a
deadCommitOptimisation (Fix4 (Instr o) (x : xs) ('Succ n) r a
-> Fix4 (Instr o) (y : xs) ('Succ n) r a
forall (n :: Nat) (xs :: [Type]) r.
Fix4 (Instr o) (x : xs) n r a -> Fix4 (Instr o) (y : xs) n r a
post Fix4 (Instr o) (x : xs) ('Succ n) r a
φ)))
     Fix4 (Instr o) xs ('Succ n) r a
qc <- CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall a. CodeGenStack a -> CodeGenStack a
freshΦ (CodeGen o a x
-> Fix4 (Instr o) (x : xs) ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall o a x.
CodeGen o a x
-> forall (xs :: [Type]) (n :: Nat) r.
   Fix4 (Instr o) (x : xs) ('Succ n) r a
   -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
runCodeGen CodeGen o a x
q Fix4 (Instr o) (x : xs) ('Succ n) r a
φ)
     let np :: Coins
np = Fix4 (Instr o) xs ('Succ ('Succ n)) r a -> Coins
forall o (xs :: [Type]) (n :: Nat) r a.
Fix4 (Instr o) xs n r a -> Coins
coinsNeeded Fix4 (Instr o) xs ('Succ ('Succ n)) r a
pc
     let nq :: Coins
nq = Fix4 (Instr o) xs ('Succ n) r a -> Coins
forall o (xs :: [Type]) (n :: Nat) r a.
Fix4 (Instr o) xs n r a -> Coins
coinsNeeded Fix4 (Instr o) xs ('Succ n) r a
qc
     let dp :: Coins
dp = Coins
np Coins -> Coins -> Coins
`minus` Coins -> Coins -> Coins
minCoins Coins
np Coins
nq
     let dq :: Coins
dq = Coins
nq Coins -> Coins -> Coins
`minus` Coins -> Coins -> Coins
minCoins Coins
np Coins
nq
     Fix4 (Instr o) xs ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Fix4 (Instr o) xs ('Succ n) r a
 -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a))
-> Fix4 (Instr o) xs ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall a b. (a -> b) -> a -> b
$! Fix4 (Instr o) xs ('Succ n) r a -> Fix4 (Instr o) xs ('Succ n) r a
binder (Instr o (Fix4 (Instr o)) xs ('Succ n) r a
-> Fix4 (Instr o) xs ('Succ n) r a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 (Fix4 (Instr o) xs ('Succ ('Succ n)) r a
-> Handler o (Fix4 (Instr o)) (o : xs) ('Succ n) r a
-> Instr o (Fix4 (Instr o)) xs ('Succ n) r a
forall (k :: [Type] -> Nat -> Type -> Type -> Type) (xs :: [Type])
       (n :: Nat) r a o.
k xs ('Succ n) r a
-> Handler o k (o : xs) n r a -> Instr o k xs n r a
Catch (Coins
-> Fix4 (Instr o) xs ('Succ ('Succ n)) r a
-> Fix4 (Instr o) xs ('Succ ('Succ n)) r a
forall o (xs :: [Type]) (n :: Nat) r a.
Coins
-> Fix4 (Instr o) xs ('Succ n) r a
-> Fix4 (Instr o) xs ('Succ n) r a
addCoins Coins
dp Fix4 (Instr o) xs ('Succ ('Succ n)) r a
pc) (Fix4 (Instr o) xs ('Succ n) r a
-> Handler o (Fix4 (Instr o)) (o : xs) ('Succ n) r a
forall (n :: Nat) (xs :: [Type]) r.
Fix4 (Instr o) xs ('Succ n) r a
-> Handler o (Fix4 (Instr o)) (o : xs) ('Succ n) r a
handler (Coins
-> Fix4 (Instr o) xs ('Succ n) r a
-> Fix4 (Instr o) xs ('Succ n) r a
forall o (xs :: [Type]) (n :: Nat) r a.
Coins
-> Fix4 (Instr o) xs ('Succ n) r a
-> Fix4 (Instr o) xs ('Succ n) r a
addCoins Coins
dq Fix4 (Instr o) xs ('Succ n) r a
qc))))

loopCompile :: CodeGen o a () -> CodeGen o a x
            -> (forall n xs r. Fix4 (Instr o) xs (Succ n) r a -> Fix4 (Instr o) xs (Succ n) r a)
            -> (forall n xs r. Fix4 (Instr o) xs (Succ n) r a -> Fix4 (Instr o) xs (Succ n) r a)
            -> Fix4 (Instr o) (x : xs) (Succ n) r a -> CodeGenStack (Fix4 (Instr o) xs (Succ n) r a)
loopCompile :: CodeGen o a ()
-> CodeGen o a x
-> (forall (n :: Nat) (xs :: [Type]) r.
    Fix4 (Instr o) xs ('Succ n) r a -> Fix4 (Instr o) xs ('Succ n) r a)
-> (forall (n :: Nat) (xs :: [Type]) r.
    Fix4 (Instr o) xs ('Succ n) r a -> Fix4 (Instr o) xs ('Succ n) r a)
-> Fix4 (Instr o) (x : xs) ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
loopCompile CodeGen o a ()
body CodeGen o a x
exit forall (n :: Nat) (xs :: [Type]) r.
Fix4 (Instr o) xs ('Succ n) r a -> Fix4 (Instr o) xs ('Succ n) r a
prebody forall (n :: Nat) (xs :: [Type]) r.
Fix4 (Instr o) xs ('Succ n) r a -> Fix4 (Instr o) xs ('Succ n) r a
preExit Fix4 (Instr o) (x : xs) ('Succ n) r a
m =
  do MVar Void
μ <- CodeGenStack (MVar Void)
forall a. CodeGenStack (MVar a)
askM
     Fix4 (Instr o) '[] ('Succ 'Zero) Void a
bodyc <- CodeGenStack (Fix4 (Instr o) '[] ('Succ 'Zero) Void a)
-> CodeGenStack (Fix4 (Instr o) '[] ('Succ 'Zero) Void a)
forall a. CodeGenStack a -> CodeGenStack a
freshM (CodeGen o a ()
-> Fix4 (Instr o) '[()] ('Succ 'Zero) Void a
-> CodeGenStack (Fix4 (Instr o) '[] ('Succ 'Zero) Void a)
forall o a x.
CodeGen o a x
-> forall (xs :: [Type]) (n :: Nat) r.
   Fix4 (Instr o) (x : xs) ('Succ n) r a
   -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
runCodeGen CodeGen o a ()
body (Instr o (Fix4 (Instr o)) '[()] ('Succ 'Zero) Void a
-> Fix4 (Instr o) '[()] ('Succ 'Zero) Void a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 (Fix4 (Instr o) '[] ('Succ 'Zero) Void a
-> Instr o (Fix4 (Instr o)) '[()] ('Succ 'Zero) Void a
forall (k :: [Type] -> Nat -> Type -> Type -> Type) (xs :: [Type])
       (n :: Nat) r a o x.
k xs n r a -> Instr o k (x : xs) n r a
Pop (Instr o (Fix4 (Instr o)) '[] ('Succ 'Zero) Void a
-> Fix4 (Instr o) '[] ('Succ 'Zero) Void a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 (MVar Void -> Instr o (Fix4 (Instr o)) '[] ('Succ 'Zero) Void a
forall x o (k :: [Type] -> Nat -> Type -> Type -> Type) (n :: Nat)
       a.
MVar x -> Instr o k '[] ('Succ n) x a
Jump MVar Void
μ)))))
     Fix4 (Instr o) xs ('Succ n) r a
exitc <- CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall a. CodeGenStack a -> CodeGenStack a
freshM (CodeGen o a x
-> Fix4 (Instr o) (x : xs) ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall o a x.
CodeGen o a x
-> forall (xs :: [Type]) (n :: Nat) r.
   Fix4 (Instr o) (x : xs) ('Succ n) r a
   -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
runCodeGen CodeGen o a x
exit Fix4 (Instr o) (x : xs) ('Succ n) r a
m)
     Fix4 (Instr o) xs ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Fix4 (Instr o) xs ('Succ n) r a
 -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a))
-> Fix4 (Instr o) xs ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall a b. (a -> b) -> a -> b
$! Instr o (Fix4 (Instr o)) xs ('Succ n) r a
-> Fix4 (Instr o) xs ('Succ n) r a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 (MVar Void
-> Fix4 (Instr o) '[] ('Succ 'Zero) Void a
-> Handler o (Fix4 (Instr o)) (o : xs) ('Succ n) r a
-> Instr o (Fix4 (Instr o)) xs ('Succ n) r a
forall (k :: [Type] -> Nat -> Type -> Type -> Type) a o
       (xs :: [Type]) (n :: Nat) r.
MVar Void
-> k '[] ('Succ 'Zero) Void a
-> Handler o k (o : xs) n r a
-> Instr o k xs n r a
Iter MVar Void
μ (Fix4 (Instr o) '[] ('Succ 'Zero) Void a
-> Fix4 (Instr o) '[] ('Succ 'Zero) Void a
forall (n :: Nat) (xs :: [Type]) r.
Fix4 (Instr o) xs ('Succ n) r a -> Fix4 (Instr o) xs ('Succ n) r a
prebody Fix4 (Instr o) '[] ('Succ 'Zero) Void a
bodyc) (Fix4 (Instr o) xs ('Succ n) r a
-> Handler o (Fix4 (Instr o)) (o : xs) ('Succ n) r a
forall o (xs :: [Type]) (n :: Nat) r a.
Fix4 (Instr o) xs ('Succ n) r a
-> Handler o (Fix4 (Instr o)) (o : xs) ('Succ n) r a
parsecHandler (Fix4 (Instr o) xs ('Succ n) r a -> Fix4 (Instr o) xs ('Succ n) r a
forall (n :: Nat) (xs :: [Type]) r.
Fix4 (Instr o) xs ('Succ n) r a -> Fix4 (Instr o) xs ('Succ n) r a
preExit Fix4 (Instr o) xs ('Succ n) r a
exitc)))

deep :: Trace => Combinator (Cofree Combinator (CodeGen o a)) x -> Maybe (CodeGen o a x)
deep :: Combinator (Cofree Combinator (CodeGen o a)) x
-> Maybe (CodeGen o a x)
deep (Defunc (a -> x)
f :<$>: (CodeGen o a a
p :< Combinator (Cofree Combinator (CodeGen o a)) a
_)) = CodeGen o a x -> Maybe (CodeGen o a x)
forall a. a -> Maybe a
Just (CodeGen o a x -> Maybe (CodeGen o a x))
-> CodeGen o a x -> Maybe (CodeGen o a x)
forall a b. (a -> b) -> a -> b
$ (forall (xs :: [Type]) (n :: Nat) r.
 Fix4 (Instr o) (x : xs) ('Succ n) r a
 -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a))
-> CodeGen o a x
forall o a x.
(forall (xs :: [Type]) (n :: Nat) r.
 Fix4 (Instr o) (x : xs) ('Succ n) r a
 -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a))
-> CodeGen o a x
CodeGen ((forall (xs :: [Type]) (n :: Nat) r.
  Fix4 (Instr o) (x : xs) ('Succ n) r a
  -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a))
 -> CodeGen o a x)
-> (forall (xs :: [Type]) (n :: Nat) r.
    Fix4 (Instr o) (x : xs) ('Succ n) r a
    -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a))
-> CodeGen o a x
forall a b. (a -> b) -> a -> b
$ \Fix4 (Instr o) (x : xs) ('Succ n) r a
m -> CodeGen o a a
-> Fix4 (Instr o) (a : xs) ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall o a x.
CodeGen o a x
-> forall (xs :: [Type]) (n :: Nat) r.
   Fix4 (Instr o) (x : xs) ('Succ n) r a
   -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
runCodeGen CodeGen o a a
p (Instr o (Fix4 (Instr o)) (a : xs) ('Succ n) r a
-> Fix4 (Instr o) (a : xs) ('Succ n) r a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 (Defunc (a -> x)
-> Fix4 (Instr o) (x : xs) ('Succ n) r a
-> Instr o (Fix4 (Instr o)) (a : xs) ('Succ n) r a
forall x y o (xs :: [Type]) (n :: Nat) r a.
Defunc (x -> y)
-> Fix4 (Instr o) (y : xs) n r a
-> Instr o (Fix4 (Instr o)) (x : xs) n r a
_Fmap (Defunc (a -> x) -> Defunc (a -> x)
forall a. Defunc a -> Defunc a
user Defunc (a -> x)
f) Fix4 (Instr o) (x : xs) ('Succ n) r a
m))
deep (TryOrElse CodeGen o a x
p CodeGen o a x
q) = CodeGen o a x -> Maybe (CodeGen o a x)
forall a. a -> Maybe a
Just (CodeGen o a x -> Maybe (CodeGen o a x))
-> CodeGen o a x -> Maybe (CodeGen o a x)
forall a b. (a -> b) -> a -> b
$ (forall (xs :: [Type]) (n :: Nat) r.
 Fix4 (Instr o) (x : xs) ('Succ n) r a
 -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a))
-> CodeGen o a x
forall o a x.
(forall (xs :: [Type]) (n :: Nat) r.
 Fix4 (Instr o) (x : xs) ('Succ n) r a
 -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a))
-> CodeGen o a x
CodeGen ((forall (xs :: [Type]) (n :: Nat) r.
  Fix4 (Instr o) (x : xs) ('Succ n) r a
  -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a))
 -> CodeGen o a x)
-> (forall (xs :: [Type]) (n :: Nat) r.
    Fix4 (Instr o) (x : xs) ('Succ n) r a
    -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a))
-> CodeGen o a x
forall a b. (a -> b) -> a -> b
$ CodeGen o a x
-> CodeGen o a x
-> (forall (n :: Nat) (xs :: [Type]) r.
    Fix4 (Instr o) xs ('Succ n) r a
    -> Handler o (Fix4 (Instr o)) (o : xs) ('Succ n) r a)
-> (forall (n :: Nat) (xs :: [Type]) r.
    Fix4 (Instr o) (x : xs) n r a -> Fix4 (Instr o) (x : xs) n r a)
-> Fix4 (Instr o) (x : xs) ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall o a y x (xs :: [Type]) (n :: Nat) r.
Trace =>
CodeGen o a y
-> CodeGen o a x
-> (forall (n :: Nat) (xs :: [Type]) r.
    Fix4 (Instr o) xs ('Succ n) r a
    -> Handler o (Fix4 (Instr o)) (o : xs) ('Succ n) r a)
-> (forall (n :: Nat) (xs :: [Type]) r.
    Fix4 (Instr o) (x : xs) n r a -> Fix4 (Instr o) (y : xs) n r a)
-> Fix4 (Instr o) (x : xs) ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
altNoCutCompile CodeGen o a x
p CodeGen o a x
q forall o (xs :: [Type]) (n :: Nat) r a.
Fix4 (Instr o) xs n r a
-> Handler o (Fix4 (Instr o)) (o : xs) n r a
forall (n :: Nat) (xs :: [Type]) r.
Fix4 (Instr o) xs ('Succ n) r a
-> Handler o (Fix4 (Instr o)) (o : xs) ('Succ n) r a
recoverHandler forall a. a -> a
forall (n :: Nat) (xs :: [Type]) r.
Fix4 (Instr o) (x : xs) n r a -> Fix4 (Instr o) (x : xs) n r a
id
deep ((CodeGen o a x
_ :< (Try (CodeGen o a a
p :< Combinator (Cofree Combinator (CodeGen o a)) a
_) :$>: Defunc x
x)) :<|>: (CodeGen o a x
q :< Combinator (Cofree Combinator (CodeGen o a)) x
_)) = CodeGen o a x -> Maybe (CodeGen o a x)
forall a. a -> Maybe a
Just (CodeGen o a x -> Maybe (CodeGen o a x))
-> CodeGen o a x -> Maybe (CodeGen o a x)
forall a b. (a -> b) -> a -> b
$ (forall (xs :: [Type]) (n :: Nat) r.
 Fix4 (Instr o) (x : xs) ('Succ n) r a
 -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a))
-> CodeGen o a x
forall o a x.
(forall (xs :: [Type]) (n :: Nat) r.
 Fix4 (Instr o) (x : xs) ('Succ n) r a
 -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a))
-> CodeGen o a x
CodeGen ((forall (xs :: [Type]) (n :: Nat) r.
  Fix4 (Instr o) (x : xs) ('Succ n) r a
  -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a))
 -> CodeGen o a x)
-> (forall (xs :: [Type]) (n :: Nat) r.
    Fix4 (Instr o) (x : xs) ('Succ n) r a
    -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a))
-> CodeGen o a x
forall a b. (a -> b) -> a -> b
$ CodeGen o a a
-> CodeGen o a x
-> (forall (n :: Nat) (xs :: [Type]) r.
    Fix4 (Instr o) xs ('Succ n) r a
    -> Handler o (Fix4 (Instr o)) (o : xs) ('Succ n) r a)
-> (forall (n :: Nat) (xs :: [Type]) r.
    Fix4 (Instr o) (x : xs) n r a -> Fix4 (Instr o) (a : xs) n r a)
-> Fix4 (Instr o) (x : xs) ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall o a y x (xs :: [Type]) (n :: Nat) r.
Trace =>
CodeGen o a y
-> CodeGen o a x
-> (forall (n :: Nat) (xs :: [Type]) r.
    Fix4 (Instr o) xs ('Succ n) r a
    -> Handler o (Fix4 (Instr o)) (o : xs) ('Succ n) r a)
-> (forall (n :: Nat) (xs :: [Type]) r.
    Fix4 (Instr o) (x : xs) n r a -> Fix4 (Instr o) (y : xs) n r a)
-> Fix4 (Instr o) (x : xs) ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
altNoCutCompile CodeGen o a a
p CodeGen o a x
q forall o (xs :: [Type]) (n :: Nat) r a.
Fix4 (Instr o) xs n r a
-> Handler o (Fix4 (Instr o)) (o : xs) n r a
forall (n :: Nat) (xs :: [Type]) r.
Fix4 (Instr o) xs ('Succ n) r a
-> Handler o (Fix4 (Instr o)) (o : xs) ('Succ n) r a
recoverHandler (Instr o (Fix4 (Instr o)) (a : xs) n r a
-> Fix4 (Instr o) (a : xs) n r a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 (Instr o (Fix4 (Instr o)) (a : xs) n r a
 -> Fix4 (Instr o) (a : xs) n r a)
-> (Fix4 (Instr o) (x : xs) n r a
    -> Instr o (Fix4 (Instr o)) (a : xs) n r a)
-> Fix4 (Instr o) (x : xs) n r a
-> Fix4 (Instr o) (a : xs) n r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fix4 (Instr o) xs n r a -> Instr o (Fix4 (Instr o)) (a : xs) n r a
forall (k :: [Type] -> Nat -> Type -> Type -> Type) (xs :: [Type])
       (n :: Nat) r a o x.
k xs n r a -> Instr o k (x : xs) n r a
Pop (Fix4 (Instr o) xs n r a
 -> Instr o (Fix4 (Instr o)) (a : xs) n r a)
-> (Fix4 (Instr o) (x : xs) n r a -> Fix4 (Instr o) xs n r a)
-> Fix4 (Instr o) (x : xs) n r a
-> Instr o (Fix4 (Instr o)) (a : xs) n r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Instr o (Fix4 (Instr o)) xs n r a -> Fix4 (Instr o) xs n r a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 (Instr o (Fix4 (Instr o)) xs n r a -> Fix4 (Instr o) xs n r a)
-> (Fix4 (Instr o) (x : xs) n r a
    -> Instr o (Fix4 (Instr o)) xs n r a)
-> Fix4 (Instr o) (x : xs) n r a
-> Fix4 (Instr o) xs n r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Defunc x
-> Fix4 (Instr o) (x : xs) n r a
-> Instr o (Fix4 (Instr o)) xs n r a
forall x (k :: [Type] -> Nat -> Type -> Type -> Type)
       (xs :: [Type]) (n :: Nat) r a o.
Defunc x -> k (x : xs) n r a -> Instr o k xs n r a
Push (Defunc x -> Defunc x
forall a. Defunc a -> Defunc a
user Defunc x
x))
deep ((CodeGen o a x
_ :< (Defunc (a -> x)
f :<$>: (CodeGen o a a
_ :< Try (CodeGen o a a
p :< Combinator (Cofree Combinator (CodeGen o a)) a
_)))) :<|>: (CodeGen o a x
q :< Combinator (Cofree Combinator (CodeGen o a)) x
_)) = CodeGen o a x -> Maybe (CodeGen o a x)
forall a. a -> Maybe a
Just (CodeGen o a x -> Maybe (CodeGen o a x))
-> CodeGen o a x -> Maybe (CodeGen o a x)
forall a b. (a -> b) -> a -> b
$ (forall (xs :: [Type]) (n :: Nat) r.
 Fix4 (Instr o) (x : xs) ('Succ n) r a
 -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a))
-> CodeGen o a x
forall o a x.
(forall (xs :: [Type]) (n :: Nat) r.
 Fix4 (Instr o) (x : xs) ('Succ n) r a
 -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a))
-> CodeGen o a x
CodeGen ((forall (xs :: [Type]) (n :: Nat) r.
  Fix4 (Instr o) (x : xs) ('Succ n) r a
  -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a))
 -> CodeGen o a x)
-> (forall (xs :: [Type]) (n :: Nat) r.
    Fix4 (Instr o) (x : xs) ('Succ n) r a
    -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a))
-> CodeGen o a x
forall a b. (a -> b) -> a -> b
$ CodeGen o a a
-> CodeGen o a x
-> (forall (n :: Nat) (xs :: [Type]) r.
    Fix4 (Instr o) xs ('Succ n) r a
    -> Handler o (Fix4 (Instr o)) (o : xs) ('Succ n) r a)
-> (forall (n :: Nat) (xs :: [Type]) r.
    Fix4 (Instr o) (x : xs) n r a -> Fix4 (Instr o) (a : xs) n r a)
-> Fix4 (Instr o) (x : xs) ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall o a y x (xs :: [Type]) (n :: Nat) r.
Trace =>
CodeGen o a y
-> CodeGen o a x
-> (forall (n :: Nat) (xs :: [Type]) r.
    Fix4 (Instr o) xs ('Succ n) r a
    -> Handler o (Fix4 (Instr o)) (o : xs) ('Succ n) r a)
-> (forall (n :: Nat) (xs :: [Type]) r.
    Fix4 (Instr o) (x : xs) n r a -> Fix4 (Instr o) (y : xs) n r a)
-> Fix4 (Instr o) (x : xs) ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
altNoCutCompile CodeGen o a a
p CodeGen o a x
q forall o (xs :: [Type]) (n :: Nat) r a.
Fix4 (Instr o) xs n r a
-> Handler o (Fix4 (Instr o)) (o : xs) n r a
forall (n :: Nat) (xs :: [Type]) r.
Fix4 (Instr o) xs ('Succ n) r a
-> Handler o (Fix4 (Instr o)) (o : xs) ('Succ n) r a
recoverHandler (Instr o (Fix4 (Instr o)) (a : xs) n r a
-> Fix4 (Instr o) (a : xs) n r a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 (Instr o (Fix4 (Instr o)) (a : xs) n r a
 -> Fix4 (Instr o) (a : xs) n r a)
-> (Fix4 (Instr o) (x : xs) n r a
    -> Instr o (Fix4 (Instr o)) (a : xs) n r a)
-> Fix4 (Instr o) (x : xs) n r a
-> Fix4 (Instr o) (a : xs) n r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Defunc (a -> x)
-> Fix4 (Instr o) (x : xs) n r a
-> Instr o (Fix4 (Instr o)) (a : xs) n r a
forall x y o (xs :: [Type]) (n :: Nat) r a.
Defunc (x -> y)
-> Fix4 (Instr o) (y : xs) n r a
-> Instr o (Fix4 (Instr o)) (x : xs) n r a
_Fmap (Defunc (a -> x) -> Defunc (a -> x)
forall a. Defunc a -> Defunc a
user Defunc (a -> x)
f))
deep (MetaCombinator MetaCombinator
RequiresCut (CodeGen o a x
_ :< ((CodeGen o a x
p :< Combinator (Cofree Combinator (CodeGen o a)) x
_) :<|>: (CodeGen o a x
q :< Combinator (Cofree Combinator (CodeGen o a)) x
_)))) = CodeGen o a x -> Maybe (CodeGen o a x)
forall a. a -> Maybe a
Just (CodeGen o a x -> Maybe (CodeGen o a x))
-> CodeGen o a x -> Maybe (CodeGen o a x)
forall a b. (a -> b) -> a -> b
$ (forall (xs :: [Type]) (n :: Nat) r.
 Fix4 (Instr o) (x : xs) ('Succ n) r a
 -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a))
-> CodeGen o a x
forall o a x.
(forall (xs :: [Type]) (n :: Nat) r.
 Fix4 (Instr o) (x : xs) ('Succ n) r a
 -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a))
-> CodeGen o a x
CodeGen ((forall (xs :: [Type]) (n :: Nat) r.
  Fix4 (Instr o) (x : xs) ('Succ n) r a
  -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a))
 -> CodeGen o a x)
-> (forall (xs :: [Type]) (n :: Nat) r.
    Fix4 (Instr o) (x : xs) ('Succ n) r a
    -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a))
-> CodeGen o a x
forall a b. (a -> b) -> a -> b
$ \Fix4 (Instr o) (x : xs) ('Succ n) r a
m ->
  do (Fix4 (Instr o) xs ('Succ n) r a -> Fix4 (Instr o) xs ('Succ n) r a
binder, Fix4 (Instr o) (x : xs) ('Succ n) r a
φ) <- Fix4 (Instr o) (x : xs) ('Succ n) r a
-> CodeGenStack
     (Fix4 (Instr o) xs ('Succ n) r a
      -> Fix4 (Instr o) xs ('Succ n) r a,
      Fix4 (Instr o) (x : xs) ('Succ n) r a)
forall o x (xs :: [Type]) (n :: Nat) r a.
Trace =>
Fix4 (Instr o) (x : xs) ('Succ n) r a
-> CodeGenStack
     (Fix4 (Instr o) xs ('Succ n) r a
      -> Fix4 (Instr o) xs ('Succ n) r a,
      Fix4 (Instr o) (x : xs) ('Succ n) r a)
makeΦ Fix4 (Instr o) (x : xs) ('Succ n) r a
m
     Fix4 (Instr o) xs ('Succ ('Succ n)) r a
pc <- CodeGenStack (Fix4 (Instr o) xs ('Succ ('Succ n)) r a)
-> CodeGenStack (Fix4 (Instr o) xs ('Succ ('Succ n)) r a)
forall a. CodeGenStack a -> CodeGenStack a
freshΦ (CodeGen o a x
-> Fix4 (Instr o) (x : xs) ('Succ ('Succ n)) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ ('Succ n)) r a)
forall o a x.
CodeGen o a x
-> forall (xs :: [Type]) (n :: Nat) r.
   Fix4 (Instr o) (x : xs) ('Succ n) r a
   -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
runCodeGen CodeGen o a x
p (Fix4 (Instr o) (x : xs) ('Succ n) r a
-> Fix4 (Instr o) (x : xs) ('Succ ('Succ n)) r a
forall o (xs :: [Type]) (n :: Nat) r a.
Fix4 (Instr o) xs n r a -> Fix4 (Instr o) xs ('Succ n) r a
deadCommitOptimisation Fix4 (Instr o) (x : xs) ('Succ n) r a
φ))
     Fix4 (Instr o) xs ('Succ n) r a
qc <- CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall a. CodeGenStack a -> CodeGenStack a
freshΦ (CodeGen o a x
-> Fix4 (Instr o) (x : xs) ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall o a x.
CodeGen o a x
-> forall (xs :: [Type]) (n :: Nat) r.
   Fix4 (Instr o) (x : xs) ('Succ n) r a
   -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
runCodeGen CodeGen o a x
q Fix4 (Instr o) (x : xs) ('Succ n) r a
φ)
     Fix4 (Instr o) xs ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Fix4 (Instr o) xs ('Succ n) r a
 -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a))
-> Fix4 (Instr o) xs ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall a b. (a -> b) -> a -> b
$! Fix4 (Instr o) xs ('Succ n) r a -> Fix4 (Instr o) xs ('Succ n) r a
binder (Instr o (Fix4 (Instr o)) xs ('Succ n) r a
-> Fix4 (Instr o) xs ('Succ n) r a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 (Fix4 (Instr o) xs ('Succ ('Succ n)) r a
-> Handler o (Fix4 (Instr o)) (o : xs) ('Succ n) r a
-> Instr o (Fix4 (Instr o)) xs ('Succ n) r a
forall (k :: [Type] -> Nat -> Type -> Type -> Type) (xs :: [Type])
       (n :: Nat) r a o.
k xs ('Succ n) r a
-> Handler o k (o : xs) n r a -> Instr o k xs n r a
Catch Fix4 (Instr o) xs ('Succ ('Succ n)) r a
pc (Fix4 (Instr o) xs ('Succ n) r a
-> Handler o (Fix4 (Instr o)) (o : xs) ('Succ n) r a
forall o (xs :: [Type]) (n :: Nat) r a.
Fix4 (Instr o) xs ('Succ n) r a
-> Handler o (Fix4 (Instr o)) (o : xs) ('Succ n) r a
parsecHandler Fix4 (Instr o) xs ('Succ n) r a
qc)))
deep (MetaCombinator MetaCombinator
RequiresCut (CodeGen o a x
_ :< Loop (CodeGen o a ()
body :< Combinator (Cofree Combinator (CodeGen o a)) ()
_) (CodeGen o a x
exit :< Combinator (Cofree Combinator (CodeGen o a)) x
_))) = CodeGen o a x -> Maybe (CodeGen o a x)
forall a. a -> Maybe a
Just (CodeGen o a x -> Maybe (CodeGen o a x))
-> CodeGen o a x -> Maybe (CodeGen o a x)
forall a b. (a -> b) -> a -> b
$ (forall (xs :: [Type]) (n :: Nat) r.
 Fix4 (Instr o) (x : xs) ('Succ n) r a
 -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a))
-> CodeGen o a x
forall o a x.
(forall (xs :: [Type]) (n :: Nat) r.
 Fix4 (Instr o) (x : xs) ('Succ n) r a
 -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a))
-> CodeGen o a x
CodeGen ((forall (xs :: [Type]) (n :: Nat) r.
  Fix4 (Instr o) (x : xs) ('Succ n) r a
  -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a))
 -> CodeGen o a x)
-> (forall (xs :: [Type]) (n :: Nat) r.
    Fix4 (Instr o) (x : xs) ('Succ n) r a
    -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a))
-> CodeGen o a x
forall a b. (a -> b) -> a -> b
$ CodeGen o a ()
-> CodeGen o a x
-> (forall (n :: Nat) (xs :: [Type]) r.
    Fix4 (Instr o) xs ('Succ n) r a -> Fix4 (Instr o) xs ('Succ n) r a)
-> (forall (n :: Nat) (xs :: [Type]) r.
    Fix4 (Instr o) xs ('Succ n) r a -> Fix4 (Instr o) xs ('Succ n) r a)
-> Fix4 (Instr o) (x : xs) ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall o a x (xs :: [Type]) (n :: Nat) r.
CodeGen o a ()
-> CodeGen o a x
-> (forall (n :: Nat) (xs :: [Type]) r.
    Fix4 (Instr o) xs ('Succ n) r a -> Fix4 (Instr o) xs ('Succ n) r a)
-> (forall (n :: Nat) (xs :: [Type]) r.
    Fix4 (Instr o) xs ('Succ n) r a -> Fix4 (Instr o) xs ('Succ n) r a)
-> Fix4 (Instr o) (x : xs) ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
loopCompile CodeGen o a ()
body CodeGen o a x
exit forall a. a -> a
forall (n :: Nat) (xs :: [Type]) r.
Fix4 (Instr o) xs ('Succ n) r a -> Fix4 (Instr o) xs ('Succ n) r a
id forall o (xs :: [Type]) (n :: Nat) r a.
Fix4 (Instr o) xs ('Succ n) r a -> Fix4 (Instr o) xs ('Succ n) r a
forall (n :: Nat) (xs :: [Type]) r.
Fix4 (Instr o) xs ('Succ n) r a -> Fix4 (Instr o) xs ('Succ n) r a
addCoinsNeeded
deep (MetaCombinator MetaCombinator
Cut (CodeGen o a x
_ :< Loop (CodeGen o a ()
body :< Combinator (Cofree Combinator (CodeGen o a)) ()
_) (CodeGen o a x
exit :< Combinator (Cofree Combinator (CodeGen o a)) x
_))) = CodeGen o a x -> Maybe (CodeGen o a x)
forall a. a -> Maybe a
Just (CodeGen o a x -> Maybe (CodeGen o a x))
-> CodeGen o a x -> Maybe (CodeGen o a x)
forall a b. (a -> b) -> a -> b
$ (forall (xs :: [Type]) (n :: Nat) r.
 Fix4 (Instr o) (x : xs) ('Succ n) r a
 -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a))
-> CodeGen o a x
forall o a x.
(forall (xs :: [Type]) (n :: Nat) r.
 Fix4 (Instr o) (x : xs) ('Succ n) r a
 -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a))
-> CodeGen o a x
CodeGen ((forall (xs :: [Type]) (n :: Nat) r.
  Fix4 (Instr o) (x : xs) ('Succ n) r a
  -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a))
 -> CodeGen o a x)
-> (forall (xs :: [Type]) (n :: Nat) r.
    Fix4 (Instr o) (x : xs) ('Succ n) r a
    -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a))
-> CodeGen o a x
forall a b. (a -> b) -> a -> b
$ CodeGen o a ()
-> CodeGen o a x
-> (forall (n :: Nat) (xs :: [Type]) r.
    Fix4 (Instr o) xs ('Succ n) r a -> Fix4 (Instr o) xs ('Succ n) r a)
-> (forall (n :: Nat) (xs :: [Type]) r.
    Fix4 (Instr o) xs ('Succ n) r a -> Fix4 (Instr o) xs ('Succ n) r a)
-> Fix4 (Instr o) (x : xs) ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall o a x (xs :: [Type]) (n :: Nat) r.
CodeGen o a ()
-> CodeGen o a x
-> (forall (n :: Nat) (xs :: [Type]) r.
    Fix4 (Instr o) xs ('Succ n) r a -> Fix4 (Instr o) xs ('Succ n) r a)
-> (forall (n :: Nat) (xs :: [Type]) r.
    Fix4 (Instr o) xs ('Succ n) r a -> Fix4 (Instr o) xs ('Succ n) r a)
-> Fix4 (Instr o) (x : xs) ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
loopCompile CodeGen o a ()
body CodeGen o a x
exit forall o (xs :: [Type]) (n :: Nat) r a.
Fix4 (Instr o) xs ('Succ n) r a -> Fix4 (Instr o) xs ('Succ n) r a
forall (n :: Nat) (xs :: [Type]) r.
Fix4 (Instr o) xs ('Succ n) r a -> Fix4 (Instr o) xs ('Succ n) r a
addCoinsNeeded forall o (xs :: [Type]) (n :: Nat) r a.
Fix4 (Instr o) xs ('Succ n) r a -> Fix4 (Instr o) xs ('Succ n) r a
forall (n :: Nat) (xs :: [Type]) r.
Fix4 (Instr o) xs ('Succ n) r a -> Fix4 (Instr o) xs ('Succ n) r a
addCoinsNeeded
deep Combinator (Cofree Combinator (CodeGen o a)) x
_ = Maybe (CodeGen o a x)
forall a. Maybe a
Nothing

addCoinsNeeded :: Fix4 (Instr o) xs (Succ n) r a -> Fix4 (Instr o) xs (Succ n) r a
addCoinsNeeded :: Fix4 (Instr o) xs ('Succ n) r a -> Fix4 (Instr o) xs ('Succ n) r a
addCoinsNeeded = Fix4 (Instr o) xs ('Succ n) r a -> Coins
forall o (xs :: [Type]) (n :: Nat) r a.
Fix4 (Instr o) xs n r a -> Coins
coinsNeeded (Fix4 (Instr o) xs ('Succ n) r a -> Coins)
-> (Coins
    -> Fix4 (Instr o) xs ('Succ n) r a
    -> Fix4 (Instr o) xs ('Succ n) r a)
-> Fix4 (Instr o) xs ('Succ n) r a
-> Fix4 (Instr o) xs ('Succ n) r a
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Coins
-> Fix4 (Instr o) xs ('Succ n) r a
-> Fix4 (Instr o) xs ('Succ n) r a
forall o (xs :: [Type]) (n :: Nat) r a.
Coins
-> Fix4 (Instr o) xs ('Succ n) r a
-> Fix4 (Instr o) xs ('Succ n) r a
addCoins

shallow :: Trace => Combinator (CodeGen o a) x -> Fix4 (Instr o) (x : xs) (Succ n) r a -> CodeGenStack (Fix4 (Instr o) xs (Succ n) r a)
shallow :: Combinator (CodeGen o a) x
-> Fix4 (Instr o) (x : xs) ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
shallow (Pure Defunc x
x)      Fix4 (Instr o) (x : xs) ('Succ n) r a
m = do Fix4 (Instr o) xs ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Fix4 (Instr o) xs ('Succ n) r a
 -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a))
-> Fix4 (Instr o) xs ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall a b. (a -> b) -> a -> b
$! Instr o (Fix4 (Instr o)) xs ('Succ n) r a
-> Fix4 (Instr o) xs ('Succ n) r a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 (Defunc x
-> Fix4 (Instr o) (x : xs) ('Succ n) r a
-> Instr o (Fix4 (Instr o)) xs ('Succ n) r a
forall x (k :: [Type] -> Nat -> Type -> Type -> Type)
       (xs :: [Type]) (n :: Nat) r a o.
Defunc x -> k (x : xs) n r a -> Instr o k xs n r a
Push (Defunc x -> Defunc x
forall a. Defunc a -> Defunc a
user Defunc x
x) Fix4 (Instr o) (x : xs) ('Succ n) r a
m)
shallow (Satisfy CharPred
p)   Fix4 (Instr o) (x : xs) ('Succ n) r a
m = do Fix4 (Instr o) xs ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Fix4 (Instr o) xs ('Succ n) r a
 -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a))
-> Fix4 (Instr o) xs ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall a b. (a -> b) -> a -> b
$! Instr o (Fix4 (Instr o)) xs ('Succ n) r a
-> Fix4 (Instr o) xs ('Succ n) r a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 (CharPred
-> Fix4 (Instr o) (Char : xs) ('Succ n) r a
-> Instr o (Fix4 (Instr o)) xs ('Succ n) r a
forall (k :: [Type] -> Nat -> Type -> Type -> Type) (xs :: [Type])
       (n :: Nat) r a o.
CharPred
-> k (Char : xs) ('Succ n) r a -> Instr o k xs ('Succ n) r a
Sat CharPred
p Fix4 (Instr o) (x : xs) ('Succ n) r a
Fix4 (Instr o) (Char : xs) ('Succ n) r a
m)
shallow (CodeGen o a (a -> x)
pf :<*>: CodeGen o a a
px) Fix4 (Instr o) (x : xs) ('Succ n) r a
m = do Fix4 (Instr o) ((a -> x) : xs) ('Succ n) r a
pxc <- CodeGen o a a
-> Fix4 (Instr o) (a : (a -> x) : xs) ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) ((a -> x) : xs) ('Succ n) r a)
forall o a x.
CodeGen o a x
-> forall (xs :: [Type]) (n :: Nat) r.
   Fix4 (Instr o) (x : xs) ('Succ n) r a
   -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
runCodeGen CodeGen o a a
px (Instr o (Fix4 (Instr o)) (a : (a -> x) : xs) ('Succ n) r a
-> Fix4 (Instr o) (a : (a -> x) : xs) ('Succ n) r a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 (Fix4 (Instr o) (x : xs) ('Succ n) r a
-> Instr o (Fix4 (Instr o)) (a : (a -> x) : xs) ('Succ n) r a
forall o y (xs :: [Type]) (n :: Nat) r a x.
Fix4 (Instr o) (y : xs) n r a
-> Instr o (Fix4 (Instr o)) (x : (x -> y) : xs) n r a
_App Fix4 (Instr o) (x : xs) ('Succ n) r a
m)); CodeGen o a (a -> x)
-> Fix4 (Instr o) ((a -> x) : xs) ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall o a x.
CodeGen o a x
-> forall (xs :: [Type]) (n :: Nat) r.
   Fix4 (Instr o) (x : xs) ('Succ n) r a
   -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
runCodeGen CodeGen o a (a -> x)
pf Fix4 (Instr o) ((a -> x) : xs) ('Succ n) r a
pxc
shallow (CodeGen o a a
p :*>: CodeGen o a x
q)    Fix4 (Instr o) (x : xs) ('Succ n) r a
m = do Fix4 (Instr o) xs ('Succ n) r a
qc <- CodeGen o a x
-> Fix4 (Instr o) (x : xs) ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall o a x.
CodeGen o a x
-> forall (xs :: [Type]) (n :: Nat) r.
   Fix4 (Instr o) (x : xs) ('Succ n) r a
   -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
runCodeGen CodeGen o a x
q Fix4 (Instr o) (x : xs) ('Succ n) r a
m; CodeGen o a a
-> Fix4 (Instr o) (a : xs) ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall o a x.
CodeGen o a x
-> forall (xs :: [Type]) (n :: Nat) r.
   Fix4 (Instr o) (x : xs) ('Succ n) r a
   -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
runCodeGen CodeGen o a a
p (Instr o (Fix4 (Instr o)) (a : xs) ('Succ n) r a
-> Fix4 (Instr o) (a : xs) ('Succ n) r a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 (Fix4 (Instr o) xs ('Succ n) r a
-> Instr o (Fix4 (Instr o)) (a : xs) ('Succ n) r a
forall (k :: [Type] -> Nat -> Type -> Type -> Type) (xs :: [Type])
       (n :: Nat) r a o x.
k xs n r a -> Instr o k (x : xs) n r a
Pop Fix4 (Instr o) xs ('Succ n) r a
qc))
shallow (CodeGen o a x
p :<*: CodeGen o a b
q)    Fix4 (Instr o) (x : xs) ('Succ n) r a
m = do Fix4 (Instr o) (x : xs) ('Succ n) r a
qc <- CodeGen o a b
-> Fix4 (Instr o) (b : x : xs) ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) (x : xs) ('Succ n) r a)
forall o a x.
CodeGen o a x
-> forall (xs :: [Type]) (n :: Nat) r.
   Fix4 (Instr o) (x : xs) ('Succ n) r a
   -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
runCodeGen CodeGen o a b
q (Instr o (Fix4 (Instr o)) (b : x : xs) ('Succ n) r a
-> Fix4 (Instr o) (b : x : xs) ('Succ n) r a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 (Fix4 (Instr o) (x : xs) ('Succ n) r a
-> Instr o (Fix4 (Instr o)) (b : x : xs) ('Succ n) r a
forall (k :: [Type] -> Nat -> Type -> Type -> Type) (xs :: [Type])
       (n :: Nat) r a o x.
k xs n r a -> Instr o k (x : xs) n r a
Pop Fix4 (Instr o) (x : xs) ('Succ n) r a
m)); CodeGen o a x
-> Fix4 (Instr o) (x : xs) ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall o a x.
CodeGen o a x
-> forall (xs :: [Type]) (n :: Nat) r.
   Fix4 (Instr o) (x : xs) ('Succ n) r a
   -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
runCodeGen CodeGen o a x
p Fix4 (Instr o) (x : xs) ('Succ n) r a
qc
shallow Combinator (CodeGen o a) x
Empty         Fix4 (Instr o) (x : xs) ('Succ n) r a
_ = do Fix4 (Instr o) xs ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Fix4 (Instr o) xs ('Succ n) r a
 -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a))
-> Fix4 (Instr o) xs ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall a b. (a -> b) -> a -> b
$! Instr o (Fix4 (Instr o)) xs ('Succ n) r a
-> Fix4 (Instr o) xs ('Succ n) r a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 Instr o (Fix4 (Instr o)) xs ('Succ n) r a
forall o (k :: [Type] -> Nat -> Type -> Type -> Type)
       (xs :: [Type]) (n :: Nat) r a.
Instr o k xs ('Succ n) r a
Empt
shallow (CodeGen o a x
p :<|>: CodeGen o a x
q)   Fix4 (Instr o) (x : xs) ('Succ n) r a
m = do CodeGen o a x
-> CodeGen o a x
-> (forall (n :: Nat) (xs :: [Type]) r.
    Fix4 (Instr o) xs ('Succ n) r a
    -> Handler o (Fix4 (Instr o)) (o : xs) ('Succ n) r a)
-> (forall (n :: Nat) (xs :: [Type]) r.
    Fix4 (Instr o) (x : xs) n r a -> Fix4 (Instr o) (x : xs) n r a)
-> Fix4 (Instr o) (x : xs) ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall o a y x (xs :: [Type]) (n :: Nat) r.
Trace =>
CodeGen o a y
-> CodeGen o a x
-> (forall (n :: Nat) (xs :: [Type]) r.
    Fix4 (Instr o) xs ('Succ n) r a
    -> Handler o (Fix4 (Instr o)) (o : xs) ('Succ n) r a)
-> (forall (n :: Nat) (xs :: [Type]) r.
    Fix4 (Instr o) (x : xs) n r a -> Fix4 (Instr o) (y : xs) n r a)
-> Fix4 (Instr o) (x : xs) ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
altNoCutCompile CodeGen o a x
p CodeGen o a x
q forall o (xs :: [Type]) (n :: Nat) r a.
Fix4 (Instr o) xs ('Succ n) r a
-> Handler o (Fix4 (Instr o)) (o : xs) ('Succ n) r a
forall (n :: Nat) (xs :: [Type]) r.
Fix4 (Instr o) xs ('Succ n) r a
-> Handler o (Fix4 (Instr o)) (o : xs) ('Succ n) r a
parsecHandler forall a. a -> a
forall (n :: Nat) (xs :: [Type]) r.
Fix4 (Instr o) (x : xs) n r a -> Fix4 (Instr o) (x : xs) n r a
id Fix4 (Instr o) (x : xs) ('Succ n) r a
m
shallow (Try CodeGen o a x
p)       Fix4 (Instr o) (x : xs) ('Succ n) r a
m = do (Fix4 (Instr o) xs ('Succ ('Succ n)) r a
 -> Fix4 (Instr o) xs ('Succ n) r a)
-> VFreshT
     IΦVar (VFresh IMVar) (Fix4 (Instr o) xs ('Succ ('Succ n)) r a)
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Instr o (Fix4 (Instr o)) xs ('Succ n) r a
-> Fix4 (Instr o) xs ('Succ n) r a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 (Instr o (Fix4 (Instr o)) xs ('Succ n) r a
 -> Fix4 (Instr o) xs ('Succ n) r a)
-> (Fix4 (Instr o) xs ('Succ ('Succ n)) r a
    -> Instr o (Fix4 (Instr o)) xs ('Succ n) r a)
-> Fix4 (Instr o) xs ('Succ ('Succ n)) r a
-> Fix4 (Instr o) xs ('Succ n) r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Fix4 (Instr o) xs ('Succ ('Succ n)) r a
 -> Handler o (Fix4 (Instr o)) (o : xs) ('Succ n) r a
 -> Instr o (Fix4 (Instr o)) xs ('Succ n) r a)
-> Handler o (Fix4 (Instr o)) (o : xs) ('Succ n) r a
-> Fix4 (Instr o) xs ('Succ ('Succ n)) r a
-> Instr o (Fix4 (Instr o)) xs ('Succ n) r a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Fix4 (Instr o) xs ('Succ ('Succ n)) r a
-> Handler o (Fix4 (Instr o)) (o : xs) ('Succ n) r a
-> Instr o (Fix4 (Instr o)) xs ('Succ n) r a
forall (k :: [Type] -> Nat -> Type -> Type -> Type) (xs :: [Type])
       (n :: Nat) r a o.
k xs ('Succ n) r a
-> Handler o k (o : xs) n r a -> Instr o k xs n r a
Catch Handler o (Fix4 (Instr o)) (o : xs) ('Succ n) r a
forall o (xs :: [Type]) (n :: Nat) r a.
Handler o (Fix4 (Instr o)) (o : xs) ('Succ n) r a
rollbackHandler) (CodeGen o a x
-> Fix4 (Instr o) (x : xs) ('Succ ('Succ n)) r a
-> VFreshT
     IΦVar (VFresh IMVar) (Fix4 (Instr o) xs ('Succ ('Succ n)) r a)
forall o a x.
CodeGen o a x
-> forall (xs :: [Type]) (n :: Nat) r.
   Fix4 (Instr o) (x : xs) ('Succ n) r a
   -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
runCodeGen CodeGen o a x
p (Fix4 (Instr o) (x : xs) ('Succ n) r a
-> Fix4 (Instr o) (x : xs) ('Succ ('Succ n)) r a
forall o (xs :: [Type]) (n :: Nat) r a.
Fix4 (Instr o) xs n r a -> Fix4 (Instr o) xs ('Succ n) r a
deadCommitOptimisation Fix4 (Instr o) (x : xs) ('Succ n) r a
m))
shallow (LookAhead CodeGen o a x
p) Fix4 (Instr o) (x : xs) ('Succ n) r a
m =
  do Coins
n <- (Fix4 (Instr o) '[] ('Succ Any) x a -> Coins)
-> VFreshT
     IΦVar (VFresh IMVar) (Fix4 (Instr o) '[] ('Succ Any) x a)
-> VFreshT IΦVar (VFresh IMVar) Coins
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Fix4 (Instr o) '[] ('Succ Any) x a -> Coins
forall o (xs :: [Type]) (n :: Nat) r a.
Fix4 (Instr o) xs n r a -> Coins
reclaimable (CodeGen o a x
-> Fix4 (Instr o) '[x] ('Succ Any) x a
-> VFreshT
     IΦVar (VFresh IMVar) (Fix4 (Instr o) '[] ('Succ Any) x a)
forall o a x.
CodeGen o a x
-> forall (xs :: [Type]) (n :: Nat) r.
   Fix4 (Instr o) (x : xs) ('Succ n) r a
   -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
runCodeGen CodeGen o a x
p (Instr o (Fix4 (Instr o)) '[x] ('Succ Any) x a
-> Fix4 (Instr o) '[x] ('Succ Any) x a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 Instr o (Fix4 (Instr o)) '[x] ('Succ Any) x a
forall o (k :: [Type] -> Nat -> Type -> Type -> Type) x (n :: Nat)
       a.
Instr o k '[x] n x a
Ret)) -- Dodgy hack, but oh well
     (Fix4 (Instr o) (o : xs) ('Succ n) r a
 -> Fix4 (Instr o) xs ('Succ n) r a)
-> VFreshT
     IΦVar (VFresh IMVar) (Fix4 (Instr o) (o : xs) ('Succ n) r a)
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Instr o (Fix4 (Instr o)) xs ('Succ n) r a
-> Fix4 (Instr o) xs ('Succ n) r a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 (Instr o (Fix4 (Instr o)) xs ('Succ n) r a
 -> Fix4 (Instr o) xs ('Succ n) r a)
-> (Fix4 (Instr o) (o : xs) ('Succ n) r a
    -> Instr o (Fix4 (Instr o)) xs ('Succ n) r a)
-> Fix4 (Instr o) (o : xs) ('Succ n) r a
-> Fix4 (Instr o) xs ('Succ n) r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fix4 (Instr o) (o : xs) ('Succ n) r a
-> Instr o (Fix4 (Instr o)) xs ('Succ n) r a
forall (k :: [Type] -> Nat -> Type -> Type -> Type) o
       (xs :: [Type]) (n :: Nat) r a.
k (o : xs) n r a -> Instr o k xs n r a
Tell) (CodeGen o a x
-> Fix4 (Instr o) (x : o : xs) ('Succ n) r a
-> VFreshT
     IΦVar (VFresh IMVar) (Fix4 (Instr o) (o : xs) ('Succ n) r a)
forall o a x.
CodeGen o a x
-> forall (xs :: [Type]) (n :: Nat) r.
   Fix4 (Instr o) (x : xs) ('Succ n) r a
   -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
runCodeGen CodeGen o a x
p (Instr o (Fix4 (Instr o)) (x : o : xs) ('Succ n) r a
-> Fix4 (Instr o) (x : o : xs) ('Succ n) r a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 (Fix4 (Instr o) (o : x : xs) ('Succ n) r a
-> Instr o (Fix4 (Instr o)) (x : o : xs) ('Succ n) r a
forall (k :: [Type] -> Nat -> Type -> Type -> Type) x y
       (xs :: [Type]) (n :: Nat) r a o.
k (x : y : xs) n r a -> Instr o k (y : x : xs) n r a
Swap (Instr o (Fix4 (Instr o)) (o : x : xs) ('Succ n) r a
-> Fix4 (Instr o) (o : x : xs) ('Succ n) r a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 (Fix4 (Instr o) (x : xs) ('Succ n) r a
-> Instr o (Fix4 (Instr o)) (o : x : xs) ('Succ n) r a
forall (k :: [Type] -> Nat -> Type -> Type -> Type) (xs :: [Type])
       (n :: Nat) r a o.
k xs n r a -> Instr o k (o : xs) n r a
Seek (Coins
-> Fix4 (Instr o) (x : xs) ('Succ n) r a
-> Fix4 (Instr o) (x : xs) ('Succ n) r a
forall o (xs :: [Type]) (n :: Nat) r a.
Coins -> Fix4 (Instr o) xs n r a -> Fix4 (Instr o) xs n r a
refundCoins Coins
n Fix4 (Instr o) (x : xs) ('Succ n) r a
m))))))
shallow (NotFollowedBy CodeGen o a a
p) Fix4 (Instr o) (x : xs) ('Succ n) r a
m =
  do Fix4 (Instr o) (o : xs) ('Succ ('Succ n)) r a
pc <- CodeGen o a a
-> Fix4 (Instr o) (a : o : xs) ('Succ ('Succ n)) r a
-> CodeGenStack (Fix4 (Instr o) (o : xs) ('Succ ('Succ n)) r a)
forall o a x.
CodeGen o a x
-> forall (xs :: [Type]) (n :: Nat) r.
   Fix4 (Instr o) (x : xs) ('Succ n) r a
   -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
runCodeGen CodeGen o a a
p (Instr o (Fix4 (Instr o)) (a : o : xs) ('Succ ('Succ n)) r a
-> Fix4 (Instr o) (a : o : xs) ('Succ ('Succ n)) r a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 (Fix4 (Instr o) (o : xs) ('Succ ('Succ n)) r a
-> Instr o (Fix4 (Instr o)) (a : o : xs) ('Succ ('Succ n)) r a
forall (k :: [Type] -> Nat -> Type -> Type -> Type) (xs :: [Type])
       (n :: Nat) r a o x.
k xs n r a -> Instr o k (x : xs) n r a
Pop (Instr o (Fix4 (Instr o)) (o : xs) ('Succ ('Succ n)) r a
-> Fix4 (Instr o) (o : xs) ('Succ ('Succ n)) r a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 (Fix4 (Instr o) xs ('Succ ('Succ n)) r a
-> Instr o (Fix4 (Instr o)) (o : xs) ('Succ ('Succ n)) r a
forall (k :: [Type] -> Nat -> Type -> Type -> Type) (xs :: [Type])
       (n :: Nat) r a o.
k xs n r a -> Instr o k (o : xs) n r a
Seek (Instr o (Fix4 (Instr o)) xs ('Succ ('Succ n)) r a
-> Fix4 (Instr o) xs ('Succ ('Succ n)) r a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 (Fix4 (Instr o) xs ('Succ n) r a
-> Instr o (Fix4 (Instr o)) xs ('Succ ('Succ n)) r a
forall (k :: [Type] -> Nat -> Type -> Type -> Type) (xs :: [Type])
       (n :: Nat) r a o.
k xs n r a -> Instr o k xs ('Succ n) r a
Commit (Instr o (Fix4 (Instr o)) xs ('Succ n) r a
-> Fix4 (Instr o) xs ('Succ n) r a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 Instr o (Fix4 (Instr o)) xs ('Succ n) r a
forall o (k :: [Type] -> Nat -> Type -> Type -> Type)
       (xs :: [Type]) (n :: Nat) r a.
Instr o k xs ('Succ n) r a
Empt)))))))
     let np :: Coins
np = Fix4 (Instr o) (o : xs) ('Succ ('Succ n)) r a -> Coins
forall o (xs :: [Type]) (n :: Nat) r a.
Fix4 (Instr o) xs n r a -> Coins
coinsNeeded Fix4 (Instr o) (o : xs) ('Succ ('Succ n)) r a
pc
     let nm :: Coins
nm = Fix4 (Instr o) (x : xs) ('Succ n) r a -> Coins
forall o (xs :: [Type]) (n :: Nat) r a.
Fix4 (Instr o) xs n r a -> Coins
coinsNeeded Fix4 (Instr o) (x : xs) ('Succ n) r a
m
     -- The minus here is used because the shared coins are propagated out front, neat.
     Fix4 (Instr o) xs ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Fix4 (Instr o) xs ('Succ n) r a
 -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a))
-> Fix4 (Instr o) xs ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall a b. (a -> b) -> a -> b
$! Instr o (Fix4 (Instr o)) xs ('Succ n) r a
-> Fix4 (Instr o) xs ('Succ n) r a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 (Fix4 (Instr o) xs ('Succ ('Succ n)) r a
-> Handler o (Fix4 (Instr o)) (o : xs) ('Succ n) r a
-> Instr o (Fix4 (Instr o)) xs ('Succ n) r a
forall (k :: [Type] -> Nat -> Type -> Type -> Type) (xs :: [Type])
       (n :: Nat) r a o.
k xs ('Succ n) r a
-> Handler o k (o : xs) n r a -> Instr o k xs n r a
Catch (Coins
-> Fix4 (Instr o) xs ('Succ ('Succ n)) r a
-> Fix4 (Instr o) xs ('Succ ('Succ n)) r a
forall o (xs :: [Type]) (n :: Nat) r a.
Coins
-> Fix4 (Instr o) xs ('Succ n) r a
-> Fix4 (Instr o) xs ('Succ n) r a
addCoins (Coins -> Coins -> Coins
maxCoins (Coins
np Coins -> Coins -> Coins
`minus` Coins
nm) Coins
zero) (Instr o (Fix4 (Instr o)) xs ('Succ ('Succ n)) r a
-> Fix4 (Instr o) xs ('Succ ('Succ n)) r a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 (Fix4 (Instr o) (o : xs) ('Succ ('Succ n)) r a
-> Instr o (Fix4 (Instr o)) xs ('Succ ('Succ n)) r a
forall (k :: [Type] -> Nat -> Type -> Type -> Type) o
       (xs :: [Type]) (n :: Nat) r a.
k (o : xs) n r a -> Instr o k xs n r a
Tell Fix4 (Instr o) (o : xs) ('Succ ('Succ n)) r a
pc))) (Bool
-> Fix4 (Instr o) (o : xs) ('Succ n) r a
-> Handler o (Fix4 (Instr o)) (o : xs) ('Succ n) r a
forall (k :: [Type] -> Nat -> Type -> Type -> Type) o
       (xs :: [Type]) (n :: Nat) r a.
Bool -> k (o : xs) n r a -> Handler o k (o : xs) n r a
Always (Bool -> Bool
not (Fix4 (Instr o) (x : xs) ('Succ n) r a -> Bool
forall o (xs :: [Type]) (n :: Nat) r a.
Fix4 (Instr o) xs n r a -> Bool
shouldInline Fix4 (Instr o) (x : xs) ('Succ n) r a
m)) (Instr o (Fix4 (Instr o)) (o : xs) ('Succ n) r a
-> Fix4 (Instr o) (o : xs) ('Succ n) r a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 (Fix4 (Instr o) xs ('Succ n) r a
-> Instr o (Fix4 (Instr o)) (o : xs) ('Succ n) r a
forall (k :: [Type] -> Nat -> Type -> Type -> Type) (xs :: [Type])
       (n :: Nat) r a o.
k xs n r a -> Instr o k (o : xs) n r a
Seek (Instr o (Fix4 (Instr o)) xs ('Succ n) r a
-> Fix4 (Instr o) xs ('Succ n) r a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 (Defunc ()
-> Fix4 (Instr o) (() : xs) ('Succ n) r a
-> Instr o (Fix4 (Instr o)) xs ('Succ n) r a
forall x (k :: [Type] -> Nat -> Type -> Type -> Type)
       (xs :: [Type]) (n :: Nat) r a o.
Defunc x -> k (x : xs) n r a -> Instr o k xs n r a
Push (Defunc () -> Defunc ()
forall a. Defunc a -> Defunc a
user Defunc ()
UNIT) Fix4 (Instr o) (x : xs) ('Succ n) r a
Fix4 (Instr o) (() : xs) ('Succ n) r a
m))))))
shallow (Branch CodeGen o a (Either a b)
b CodeGen o a (a -> x)
p CodeGen o a (b -> x)
q) Fix4 (Instr o) (x : xs) ('Succ n) r a
m =
  do (Fix4 (Instr o) xs ('Succ n) r a -> Fix4 (Instr o) xs ('Succ n) r a
binder, Fix4 (Instr o) (x : xs) ('Succ n) r a
φ) <- Fix4 (Instr o) (x : xs) ('Succ n) r a
-> CodeGenStack
     (Fix4 (Instr o) xs ('Succ n) r a
      -> Fix4 (Instr o) xs ('Succ n) r a,
      Fix4 (Instr o) (x : xs) ('Succ n) r a)
forall o x (xs :: [Type]) (n :: Nat) r a.
Trace =>
Fix4 (Instr o) (x : xs) ('Succ n) r a
-> CodeGenStack
     (Fix4 (Instr o) xs ('Succ n) r a
      -> Fix4 (Instr o) xs ('Succ n) r a,
      Fix4 (Instr o) (x : xs) ('Succ n) r a)
makeΦ Fix4 (Instr o) (x : xs) ('Succ n) r a
m
     Fix4 (Instr o) (a : xs) ('Succ n) r a
pc <- CodeGenStack (Fix4 (Instr o) (a : xs) ('Succ n) r a)
-> CodeGenStack (Fix4 (Instr o) (a : xs) ('Succ n) r a)
forall a. CodeGenStack a -> CodeGenStack a
freshΦ (CodeGen o a (a -> x)
-> Fix4 (Instr o) ((a -> x) : a : xs) ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) (a : xs) ('Succ n) r a)
forall o a x.
CodeGen o a x
-> forall (xs :: [Type]) (n :: Nat) r.
   Fix4 (Instr o) (x : xs) ('Succ n) r a
   -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
runCodeGen CodeGen o a (a -> x)
p (Instr o (Fix4 (Instr o)) ((a -> x) : a : xs) ('Succ n) r a
-> Fix4 (Instr o) ((a -> x) : a : xs) ('Succ n) r a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 (Fix4 (Instr o) (a : (a -> x) : xs) ('Succ n) r a
-> Instr o (Fix4 (Instr o)) ((a -> x) : a : xs) ('Succ n) r a
forall (k :: [Type] -> Nat -> Type -> Type -> Type) x y
       (xs :: [Type]) (n :: Nat) r a o.
k (x : y : xs) n r a -> Instr o k (y : x : xs) n r a
Swap (Instr o (Fix4 (Instr o)) (a : (a -> x) : xs) ('Succ n) r a
-> Fix4 (Instr o) (a : (a -> x) : xs) ('Succ n) r a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 (Fix4 (Instr o) (x : xs) ('Succ n) r a
-> Instr o (Fix4 (Instr o)) (a : (a -> x) : xs) ('Succ n) r a
forall o y (xs :: [Type]) (n :: Nat) r a x.
Fix4 (Instr o) (y : xs) n r a
-> Instr o (Fix4 (Instr o)) (x : (x -> y) : xs) n r a
_App Fix4 (Instr o) (x : xs) ('Succ n) r a
φ)))))
     Fix4 (Instr o) (b : xs) ('Succ n) r a
qc <- CodeGenStack (Fix4 (Instr o) (b : xs) ('Succ n) r a)
-> CodeGenStack (Fix4 (Instr o) (b : xs) ('Succ n) r a)
forall a. CodeGenStack a -> CodeGenStack a
freshΦ (CodeGen o a (b -> x)
-> Fix4 (Instr o) ((b -> x) : b : xs) ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) (b : xs) ('Succ n) r a)
forall o a x.
CodeGen o a x
-> forall (xs :: [Type]) (n :: Nat) r.
   Fix4 (Instr o) (x : xs) ('Succ n) r a
   -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
runCodeGen CodeGen o a (b -> x)
q (Instr o (Fix4 (Instr o)) ((b -> x) : b : xs) ('Succ n) r a
-> Fix4 (Instr o) ((b -> x) : b : xs) ('Succ n) r a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 (Fix4 (Instr o) (b : (b -> x) : xs) ('Succ n) r a
-> Instr o (Fix4 (Instr o)) ((b -> x) : b : xs) ('Succ n) r a
forall (k :: [Type] -> Nat -> Type -> Type -> Type) x y
       (xs :: [Type]) (n :: Nat) r a o.
k (x : y : xs) n r a -> Instr o k (y : x : xs) n r a
Swap (Instr o (Fix4 (Instr o)) (b : (b -> x) : xs) ('Succ n) r a
-> Fix4 (Instr o) (b : (b -> x) : xs) ('Succ n) r a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 (Fix4 (Instr o) (x : xs) ('Succ n) r a
-> Instr o (Fix4 (Instr o)) (b : (b -> x) : xs) ('Succ n) r a
forall o y (xs :: [Type]) (n :: Nat) r a x.
Fix4 (Instr o) (y : xs) n r a
-> Instr o (Fix4 (Instr o)) (x : (x -> y) : xs) n r a
_App Fix4 (Instr o) (x : xs) ('Succ n) r a
φ)))))
     let minc :: Coins
minc = Fix4 (Instr o) (Either a b : xs) ('Succ n) r a -> Coins
forall o (xs :: [Type]) (n :: Nat) r a.
Fix4 (Instr o) xs n r a -> Coins
coinsNeeded (Instr o (Fix4 (Instr o)) (Either a b : xs) ('Succ n) r a
-> Fix4 (Instr o) (Either a b : xs) ('Succ n) r a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 (Fix4 (Instr o) (a : xs) ('Succ n) r a
-> Fix4 (Instr o) (b : xs) ('Succ n) r a
-> Instr o (Fix4 (Instr o)) (Either a b : xs) ('Succ n) r a
forall (k :: [Type] -> Nat -> Type -> Type -> Type) x
       (xs :: [Type]) (n :: Nat) r a x o.
k (x : xs) n r a
-> k (x : xs) n r a -> Instr o k (Either x x : xs) n r a
Case Fix4 (Instr o) (a : xs) ('Succ n) r a
pc Fix4 (Instr o) (b : xs) ('Succ n) r a
qc))
     let dp :: Coins
dp = Coins -> Coins -> Coins
maxCoins Coins
zero (Fix4 (Instr o) (a : xs) ('Succ n) r a -> Coins
forall o (xs :: [Type]) (n :: Nat) r a.
Fix4 (Instr o) xs n r a -> Coins
coinsNeeded Fix4 (Instr o) (a : xs) ('Succ n) r a
pc Coins -> Coins -> Coins
`minus` Coins
minc)
     let dq :: Coins
dq = Coins -> Coins -> Coins
maxCoins Coins
zero (Fix4 (Instr o) (b : xs) ('Succ n) r a -> Coins
forall o (xs :: [Type]) (n :: Nat) r a.
Fix4 (Instr o) xs n r a -> Coins
coinsNeeded Fix4 (Instr o) (b : xs) ('Succ n) r a
qc Coins -> Coins -> Coins
`minus` Coins
minc)
     (Fix4 (Instr o) xs ('Succ n) r a
 -> Fix4 (Instr o) xs ('Succ n) r a)
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Fix4 (Instr o) xs ('Succ n) r a -> Fix4 (Instr o) xs ('Succ n) r a
binder (CodeGen o a (Either a b)
-> Fix4 (Instr o) (Either a b : xs) ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall o a x.
CodeGen o a x
-> forall (xs :: [Type]) (n :: Nat) r.
   Fix4 (Instr o) (x : xs) ('Succ n) r a
   -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
runCodeGen CodeGen o a (Either a b)
b (Instr o (Fix4 (Instr o)) (Either a b : xs) ('Succ n) r a
-> Fix4 (Instr o) (Either a b : xs) ('Succ n) r a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 (Fix4 (Instr o) (a : xs) ('Succ n) r a
-> Fix4 (Instr o) (b : xs) ('Succ n) r a
-> Instr o (Fix4 (Instr o)) (Either a b : xs) ('Succ n) r a
forall (k :: [Type] -> Nat -> Type -> Type -> Type) x
       (xs :: [Type]) (n :: Nat) r a x o.
k (x : xs) n r a
-> k (x : xs) n r a -> Instr o k (Either x x : xs) n r a
Case (Coins
-> Fix4 (Instr o) (a : xs) ('Succ n) r a
-> Fix4 (Instr o) (a : xs) ('Succ n) r a
forall o (xs :: [Type]) (n :: Nat) r a.
Coins
-> Fix4 (Instr o) xs ('Succ n) r a
-> Fix4 (Instr o) xs ('Succ n) r a
addCoins Coins
dp Fix4 (Instr o) (a : xs) ('Succ n) r a
pc) (Coins
-> Fix4 (Instr o) (b : xs) ('Succ n) r a
-> Fix4 (Instr o) (b : xs) ('Succ n) r a
forall o (xs :: [Type]) (n :: Nat) r a.
Coins
-> Fix4 (Instr o) xs ('Succ n) r a
-> Fix4 (Instr o) xs ('Succ n) r a
addCoins Coins
dq Fix4 (Instr o) (b : xs) ('Succ n) r a
qc))))
shallow (Match CodeGen o a a
p [Defunc (a -> Bool)]
fs [CodeGen o a x]
qs CodeGen o a x
def) Fix4 (Instr o) (x : xs) ('Succ n) r a
m =
  do (Fix4 (Instr o) xs ('Succ n) r a -> Fix4 (Instr o) xs ('Succ n) r a
binder, Fix4 (Instr o) (x : xs) ('Succ n) r a
φ) <- Fix4 (Instr o) (x : xs) ('Succ n) r a
-> CodeGenStack
     (Fix4 (Instr o) xs ('Succ n) r a
      -> Fix4 (Instr o) xs ('Succ n) r a,
      Fix4 (Instr o) (x : xs) ('Succ n) r a)
forall o x (xs :: [Type]) (n :: Nat) r a.
Trace =>
Fix4 (Instr o) (x : xs) ('Succ n) r a
-> CodeGenStack
     (Fix4 (Instr o) xs ('Succ n) r a
      -> Fix4 (Instr o) xs ('Succ n) r a,
      Fix4 (Instr o) (x : xs) ('Succ n) r a)
makeΦ Fix4 (Instr o) (x : xs) ('Succ n) r a
m
     [Fix4 (Instr o) xs ('Succ n) r a]
qcs <- (CodeGen o a x -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a))
-> [CodeGen o a x]
-> VFreshT IΦVar (VFresh IMVar) [Fix4 (Instr o) xs ('Succ n) r a]
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\CodeGen o a x
q -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall a. CodeGenStack a -> CodeGenStack a
freshΦ (CodeGen o a x
-> Fix4 (Instr o) (x : xs) ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall o a x.
CodeGen o a x
-> forall (xs :: [Type]) (n :: Nat) r.
   Fix4 (Instr o) (x : xs) ('Succ n) r a
   -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
runCodeGen CodeGen o a x
q Fix4 (Instr o) (x : xs) ('Succ n) r a
φ)) [CodeGen o a x]
qs
     Fix4 (Instr o) xs ('Succ n) r a
defc <- CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall a. CodeGenStack a -> CodeGenStack a
freshΦ (CodeGen o a x
-> Fix4 (Instr o) (x : xs) ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall o a x.
CodeGen o a x
-> forall (xs :: [Type]) (n :: Nat) r.
   Fix4 (Instr o) (x : xs) ('Succ n) r a
   -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
runCodeGen CodeGen o a x
def Fix4 (Instr o) (x : xs) ('Succ n) r a
φ)
     let minc :: Coins
minc = Fix4 (Instr o) (a : xs) ('Succ n) r a -> Coins
forall o (xs :: [Type]) (n :: Nat) r a.
Fix4 (Instr o) xs n r a -> Coins
coinsNeeded (Instr o (Fix4 (Instr o)) (a : xs) ('Succ n) r a
-> Fix4 (Instr o) (a : xs) ('Succ n) r a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 ([Defunc (a -> Bool)]
-> [Fix4 (Instr o) xs ('Succ n) r a]
-> Fix4 (Instr o) xs ('Succ n) r a
-> Instr o (Fix4 (Instr o)) (a : xs) ('Succ n) r a
forall x (k :: [Type] -> Nat -> Type -> Type -> Type)
       (xs :: [Type]) (n :: Nat) r a o.
[Defunc (x -> Bool)]
-> [k xs n r a] -> k xs n r a -> Instr o k (x : xs) n r a
Choices ((Defunc (a -> Bool) -> Defunc (a -> Bool))
-> [Defunc (a -> Bool)] -> [Defunc (a -> Bool)]
forall a b. (a -> b) -> [a] -> [b]
map Defunc (a -> Bool) -> Defunc (a -> Bool)
forall a. Defunc a -> Defunc a
user [Defunc (a -> Bool)]
fs) [Fix4 (Instr o) xs ('Succ n) r a]
qcs Fix4 (Instr o) xs ('Succ n) r a
defc))
     let Fix4 (Instr o) xs ('Succ n) r a
defc':[Fix4 (Instr o) xs ('Succ n) r a]
qcs' = (Fix4 (Instr o) xs ('Succ n) r a
 -> Fix4 (Instr o) xs ('Succ n) r a)
-> [Fix4 (Instr o) xs ('Succ n) r a]
-> [Fix4 (Instr o) xs ('Succ n) r a]
forall a b. (a -> b) -> [a] -> [b]
map (Coins -> Coins -> Coins
maxCoins Coins
zero (Coins -> Coins)
-> (Fix4 (Instr o) xs ('Succ n) r a -> Coins)
-> Fix4 (Instr o) xs ('Succ n) r a
-> Coins
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coins -> Coins -> Coins
`minus` Coins
minc) (Coins -> Coins)
-> (Fix4 (Instr o) xs ('Succ n) r a -> Coins)
-> Fix4 (Instr o) xs ('Succ n) r a
-> Coins
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fix4 (Instr o) xs ('Succ n) r a -> Coins
forall o (xs :: [Type]) (n :: Nat) r a.
Fix4 (Instr o) xs n r a -> Coins
coinsNeeded (Fix4 (Instr o) xs ('Succ n) r a -> Coins)
-> (Coins
    -> Fix4 (Instr o) xs ('Succ n) r a
    -> Fix4 (Instr o) xs ('Succ n) r a)
-> Fix4 (Instr o) xs ('Succ n) r a
-> Fix4 (Instr o) xs ('Succ n) r a
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Coins
-> Fix4 (Instr o) xs ('Succ n) r a
-> Fix4 (Instr o) xs ('Succ n) r a
forall o (xs :: [Type]) (n :: Nat) r a.
Coins
-> Fix4 (Instr o) xs ('Succ n) r a
-> Fix4 (Instr o) xs ('Succ n) r a
addCoins) (Fix4 (Instr o) xs ('Succ n) r a
defcFix4 (Instr o) xs ('Succ n) r a
-> [Fix4 (Instr o) xs ('Succ n) r a]
-> [Fix4 (Instr o) xs ('Succ n) r a]
forall a. a -> [a] -> [a]
:[Fix4 (Instr o) xs ('Succ n) r a]
qcs)
     (Fix4 (Instr o) xs ('Succ n) r a
 -> Fix4 (Instr o) xs ('Succ n) r a)
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Fix4 (Instr o) xs ('Succ n) r a -> Fix4 (Instr o) xs ('Succ n) r a
binder (CodeGen o a a
-> Fix4 (Instr o) (a : xs) ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall o a x.
CodeGen o a x
-> forall (xs :: [Type]) (n :: Nat) r.
   Fix4 (Instr o) (x : xs) ('Succ n) r a
   -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
runCodeGen CodeGen o a a
p (Instr o (Fix4 (Instr o)) (a : xs) ('Succ n) r a
-> Fix4 (Instr o) (a : xs) ('Succ n) r a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 ([Defunc (a -> Bool)]
-> [Fix4 (Instr o) xs ('Succ n) r a]
-> Fix4 (Instr o) xs ('Succ n) r a
-> Instr o (Fix4 (Instr o)) (a : xs) ('Succ n) r a
forall x (k :: [Type] -> Nat -> Type -> Type -> Type)
       (xs :: [Type]) (n :: Nat) r a o.
[Defunc (x -> Bool)]
-> [k xs n r a] -> k xs n r a -> Instr o k (x : xs) n r a
Choices ((Defunc (a -> Bool) -> Defunc (a -> Bool))
-> [Defunc (a -> Bool)] -> [Defunc (a -> Bool)]
forall a b. (a -> b) -> [a] -> [b]
map Defunc (a -> Bool) -> Defunc (a -> Bool)
forall a. Defunc a -> Defunc a
user [Defunc (a -> Bool)]
fs) [Fix4 (Instr o) xs ('Succ n) r a]
qcs' Fix4 (Instr o) xs ('Succ n) r a
defc')))
shallow (Let Bool
_ MVar x
μ)                    Fix4 (Instr o) (x : xs) ('Succ n) r a
m = do Fix4 (Instr o) xs ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Fix4 (Instr o) xs ('Succ n) r a
 -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a))
-> Fix4 (Instr o) xs ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall a b. (a -> b) -> a -> b
$! MVar x
-> Fix4 (Instr o) (x : xs) ('Succ n) r a
-> Fix4 (Instr o) xs ('Succ n) r a
forall x o (xs :: [Type]) (n :: Nat) r a.
MVar x
-> Fix4 (Instr o) (x : xs) ('Succ n) r a
-> Fix4 (Instr o) xs ('Succ n) r a
tailCallOptimise MVar x
μ Fix4 (Instr o) (x : xs) ('Succ n) r a
m
shallow (Loop CodeGen o a ()
body CodeGen o a x
exit)             Fix4 (Instr o) (x : xs) ('Succ n) r a
m = do CodeGen o a ()
-> CodeGen o a x
-> (forall (n :: Nat) (xs :: [Type]) r.
    Fix4 (Instr o) xs ('Succ n) r a -> Fix4 (Instr o) xs ('Succ n) r a)
-> (forall (n :: Nat) (xs :: [Type]) r.
    Fix4 (Instr o) xs ('Succ n) r a -> Fix4 (Instr o) xs ('Succ n) r a)
-> Fix4 (Instr o) (x : xs) ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall o a x (xs :: [Type]) (n :: Nat) r.
CodeGen o a ()
-> CodeGen o a x
-> (forall (n :: Nat) (xs :: [Type]) r.
    Fix4 (Instr o) xs ('Succ n) r a -> Fix4 (Instr o) xs ('Succ n) r a)
-> (forall (n :: Nat) (xs :: [Type]) r.
    Fix4 (Instr o) xs ('Succ n) r a -> Fix4 (Instr o) xs ('Succ n) r a)
-> Fix4 (Instr o) (x : xs) ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
loopCompile CodeGen o a ()
body CodeGen o a x
exit forall o (xs :: [Type]) (n :: Nat) r a.
Fix4 (Instr o) xs ('Succ n) r a -> Fix4 (Instr o) xs ('Succ n) r a
forall (n :: Nat) (xs :: [Type]) r.
Fix4 (Instr o) xs ('Succ n) r a -> Fix4 (Instr o) xs ('Succ n) r a
addCoinsNeeded forall a. a -> a
forall (n :: Nat) (xs :: [Type]) r.
Fix4 (Instr o) xs ('Succ n) r a -> Fix4 (Instr o) xs ('Succ n) r a
id Fix4 (Instr o) (x : xs) ('Succ n) r a
m
shallow (MakeRegister ΣVar a
σ CodeGen o a a
p CodeGen o a x
q)         Fix4 (Instr o) (x : xs) ('Succ n) r a
m = do Fix4 (Instr o) xs ('Succ n) r a
qc <- CodeGen o a x
-> Fix4 (Instr o) (x : xs) ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall o a x.
CodeGen o a x
-> forall (xs :: [Type]) (n :: Nat) r.
   Fix4 (Instr o) (x : xs) ('Succ n) r a
   -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
runCodeGen CodeGen o a x
q Fix4 (Instr o) (x : xs) ('Succ n) r a
m; CodeGen o a a
-> Fix4 (Instr o) (a : xs) ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall o a x.
CodeGen o a x
-> forall (xs :: [Type]) (n :: Nat) r.
   Fix4 (Instr o) (x : xs) ('Succ n) r a
   -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
runCodeGen CodeGen o a a
p (Instr o (Fix4 (Instr o)) (a : xs) ('Succ n) r a
-> Fix4 (Instr o) (a : xs) ('Succ n) r a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 (ΣVar a
-> Fix4 (Instr o) xs ('Succ n) r a
-> Instr o (Fix4 (Instr o)) (a : xs) ('Succ n) r a
forall x (k :: [Type] -> Nat -> Type -> Type -> Type)
       (xs :: [Type]) (n :: Nat) r a o.
ΣVar x -> k xs n r a -> Instr o k (x : xs) n r a
_Make ΣVar a
σ Fix4 (Instr o) xs ('Succ n) r a
qc))
shallow (GetRegister ΣVar x
σ)              Fix4 (Instr o) (x : xs) ('Succ n) r a
m = do Fix4 (Instr o) xs ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Fix4 (Instr o) xs ('Succ n) r a
 -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a))
-> Fix4 (Instr o) xs ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall a b. (a -> b) -> a -> b
$! Instr o (Fix4 (Instr o)) xs ('Succ n) r a
-> Fix4 (Instr o) xs ('Succ n) r a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 (ΣVar x
-> Fix4 (Instr o) (x : xs) ('Succ n) r a
-> Instr o (Fix4 (Instr o)) xs ('Succ n) r a
forall x (k :: [Type] -> Nat -> Type -> Type -> Type)
       (xs :: [Type]) (n :: Nat) r a o.
ΣVar x -> k (x : xs) n r a -> Instr o k xs n r a
_Get ΣVar x
σ Fix4 (Instr o) (x : xs) ('Succ n) r a
m)
shallow (PutRegister ΣVar a
σ CodeGen o a a
p)            Fix4 (Instr o) (x : xs) ('Succ n) r a
m = do CodeGen o a a
-> Fix4 (Instr o) (a : xs) ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall o a x.
CodeGen o a x
-> forall (xs :: [Type]) (n :: Nat) r.
   Fix4 (Instr o) (x : xs) ('Succ n) r a
   -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
runCodeGen CodeGen o a a
p (Instr o (Fix4 (Instr o)) (a : xs) ('Succ n) r a
-> Fix4 (Instr o) (a : xs) ('Succ n) r a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 (ΣVar a
-> Fix4 (Instr o) xs ('Succ n) r a
-> Instr o (Fix4 (Instr o)) (a : xs) ('Succ n) r a
forall x (k :: [Type] -> Nat -> Type -> Type -> Type)
       (xs :: [Type]) (n :: Nat) r a o.
ΣVar x -> k xs n r a -> Instr o k (x : xs) n r a
_Put ΣVar a
σ (Instr o (Fix4 (Instr o)) xs ('Succ n) r a
-> Fix4 (Instr o) xs ('Succ n) r a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 (Defunc ()
-> Fix4 (Instr o) (() : xs) ('Succ n) r a
-> Instr o (Fix4 (Instr o)) xs ('Succ n) r a
forall x (k :: [Type] -> Nat -> Type -> Type -> Type)
       (xs :: [Type]) (n :: Nat) r a o.
Defunc x -> k (x : xs) n r a -> Instr o k xs n r a
Push (Defunc () -> Defunc ()
forall a. Defunc a -> Defunc a
user Defunc ()
UNIT) Fix4 (Instr o) (x : xs) ('Succ n) r a
Fix4 (Instr o) (() : xs) ('Succ n) r a
m))))
shallow (Position PosSelector
sel)               Fix4 (Instr o) (x : xs) ('Succ n) r a
m = do Fix4 (Instr o) xs ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Fix4 (Instr o) xs ('Succ n) r a
 -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a))
-> Fix4 (Instr o) xs ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall a b. (a -> b) -> a -> b
$! Instr o (Fix4 (Instr o)) xs ('Succ n) r a
-> Fix4 (Instr o) xs ('Succ n) r a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 (PosSelector
-> Fix4 (Instr o) (Int : xs) ('Succ n) r a
-> Instr o (Fix4 (Instr o)) xs ('Succ n) r a
forall (k :: [Type] -> Nat -> Type -> Type -> Type) (xs :: [Type])
       (n :: Nat) r a o.
PosSelector -> k (Int : xs) n r a -> Instr o k xs n r a
SelectPos PosSelector
sel Fix4 (Instr o) (x : xs) ('Succ n) r a
Fix4 (Instr o) (Int : xs) ('Succ n) r a
m)
shallow (Debug String
name CodeGen o a x
p)               Fix4 (Instr o) (x : xs) ('Succ n) r a
m = do (Fix4 (Instr o) xs ('Succ ('Succ n)) r a
 -> Fix4 (Instr o) xs ('Succ n) r a)
-> VFreshT
     IΦVar (VFresh IMVar) (Fix4 (Instr o) xs ('Succ ('Succ n)) r a)
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Instr o (Fix4 (Instr o)) xs ('Succ n) r a
-> Fix4 (Instr o) xs ('Succ n) r a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 (Instr o (Fix4 (Instr o)) xs ('Succ n) r a
 -> Fix4 (Instr o) xs ('Succ n) r a)
-> (Fix4 (Instr o) xs ('Succ ('Succ n)) r a
    -> Instr o (Fix4 (Instr o)) xs ('Succ n) r a)
-> Fix4 (Instr o) xs ('Succ ('Succ n)) r a
-> Fix4 (Instr o) xs ('Succ n) r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> Fix4 (Instr o) xs ('Succ ('Succ n)) r a
-> Instr o (Fix4 (Instr o)) xs ('Succ n) r a
forall (k :: [Type] -> Nat -> Type -> Type -> Type) (xs :: [Type])
       (n :: Nat) r a o.
String -> k xs ('Succ ('Succ n)) r a -> Instr o k xs ('Succ n) r a
LogEnter String
name) (CodeGen o a x
-> Fix4 (Instr o) (x : xs) ('Succ ('Succ n)) r a
-> VFreshT
     IΦVar (VFresh IMVar) (Fix4 (Instr o) xs ('Succ ('Succ n)) r a)
forall o a x.
CodeGen o a x
-> forall (xs :: [Type]) (n :: Nat) r.
   Fix4 (Instr o) (x : xs) ('Succ n) r a
   -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
runCodeGen CodeGen o a x
p (Instr o (Fix4 (Instr o)) (x : xs) ('Succ ('Succ n)) r a
-> Fix4 (Instr o) (x : xs) ('Succ ('Succ n)) r a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 (Fix4 (Instr o) (x : xs) ('Succ n) r a
-> Instr o (Fix4 (Instr o)) (x : xs) ('Succ ('Succ n)) r a
forall (k :: [Type] -> Nat -> Type -> Type -> Type) (xs :: [Type])
       (n :: Nat) r a o.
k xs n r a -> Instr o k xs ('Succ n) r a
Commit (Instr o (Fix4 (Instr o)) (x : xs) ('Succ n) r a
-> Fix4 (Instr o) (x : xs) ('Succ n) r a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 (String
-> Fix4 (Instr o) (x : xs) ('Succ n) r a
-> Instr o (Fix4 (Instr o)) (x : xs) ('Succ n) r a
forall (k :: [Type] -> Nat -> Type -> Type -> Type) (xs :: [Type])
       (n :: Nat) r a o.
String -> k xs n r a -> Instr o k xs n r a
LogExit String
name Fix4 (Instr o) (x : xs) ('Succ n) r a
m)))))
shallow (MetaCombinator MetaCombinator
Cut CodeGen o a x
p)       Fix4 (Instr o) (x : xs) ('Succ n) r a
m = do Fix4 (Instr o) xs ('Succ n) r a -> Fix4 (Instr o) xs ('Succ n) r a
forall o (xs :: [Type]) (n :: Nat) r a.
Fix4 (Instr o) xs ('Succ n) r a -> Fix4 (Instr o) xs ('Succ n) r a
blockCoins (Fix4 (Instr o) xs ('Succ n) r a
 -> Fix4 (Instr o) xs ('Succ n) r a)
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> CodeGen o a x
-> Fix4 (Instr o) (x : xs) ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall o a x.
CodeGen o a x
-> forall (xs :: [Type]) (n :: Nat) r.
   Fix4 (Instr o) (x : xs) ('Succ n) r a
   -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
runCodeGen CodeGen o a x
p (Coins
-> Fix4 (Instr o) (x : xs) ('Succ n) r a
-> Fix4 (Instr o) (x : xs) ('Succ n) r a
forall o (xs :: [Type]) (n :: Nat) r a.
Coins
-> Fix4 (Instr o) xs ('Succ n) r a
-> Fix4 (Instr o) xs ('Succ n) r a
addCoins (Fix4 (Instr o) (x : xs) ('Succ n) r a -> Coins
forall o (xs :: [Type]) (n :: Nat) r a.
Fix4 (Instr o) xs n r a -> Coins
coinsNeeded Fix4 (Instr o) (x : xs) ('Succ n) r a
m) Fix4 (Instr o) (x : xs) ('Succ n) r a
m)
shallow (MetaCombinator MetaCombinator
CutImmune CodeGen o a x
p) Fix4 (Instr o) (x : xs) ('Succ n) r a
m = do Coins
-> Fix4 (Instr o) xs ('Succ n) r a
-> Fix4 (Instr o) xs ('Succ n) r a
forall o (xs :: [Type]) (n :: Nat) r a.
Coins
-> Fix4 (Instr o) xs ('Succ n) r a
-> Fix4 (Instr o) xs ('Succ n) r a
addCoins (Coins
 -> Fix4 (Instr o) xs ('Succ n) r a
 -> Fix4 (Instr o) xs ('Succ n) r a)
-> (Fix4 (Instr o) '[] ('Succ Any) x a -> Coins)
-> Fix4 (Instr o) '[] ('Succ Any) x a
-> Fix4 (Instr o) xs ('Succ n) r a
-> Fix4 (Instr o) xs ('Succ n) r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fix4 (Instr o) '[] ('Succ Any) x a -> Coins
forall o (xs :: [Type]) (n :: Nat) r a.
Fix4 (Instr o) xs n r a -> Coins
coinsNeeded (Fix4 (Instr o) '[] ('Succ Any) x a
 -> Fix4 (Instr o) xs ('Succ n) r a
 -> Fix4 (Instr o) xs ('Succ n) r a)
-> VFreshT
     IΦVar (VFresh IMVar) (Fix4 (Instr o) '[] ('Succ Any) x a)
-> VFreshT
     IΦVar
     (VFresh IMVar)
     (Fix4 (Instr o) xs ('Succ n) r a
      -> Fix4 (Instr o) xs ('Succ n) r a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> CodeGen o a x
-> Fix4 (Instr o) '[x] ('Succ Any) x a
-> VFreshT
     IΦVar (VFresh IMVar) (Fix4 (Instr o) '[] ('Succ Any) x a)
forall o a x.
CodeGen o a x
-> forall (xs :: [Type]) (n :: Nat) r.
   Fix4 (Instr o) (x : xs) ('Succ n) r a
   -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
runCodeGen CodeGen o a x
p (Instr o (Fix4 (Instr o)) '[x] ('Succ Any) x a
-> Fix4 (Instr o) '[x] ('Succ Any) x a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 Instr o (Fix4 (Instr o)) '[x] ('Succ Any) x a
forall o (k :: [Type] -> Nat -> Type -> Type -> Type) x (n :: Nat)
       a.
Instr o k '[x] n x a
Ret) VFreshT
  IΦVar
  (VFresh IMVar)
  (Fix4 (Instr o) xs ('Succ n) r a
   -> Fix4 (Instr o) xs ('Succ n) r a)
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> CodeGen o a x
-> Fix4 (Instr o) (x : xs) ('Succ n) r a
-> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
forall o a x.
CodeGen o a x
-> forall (xs :: [Type]) (n :: Nat) r.
   Fix4 (Instr o) (x : xs) ('Succ n) r a
   -> CodeGenStack (Fix4 (Instr o) xs ('Succ n) r a)
runCodeGen CodeGen o a x
p Fix4 (Instr o) (x : xs) ('Succ n) r a
m

tailCallOptimise :: MVar x -> Fix4 (Instr o) (x : xs) (Succ n) r a -> Fix4 (Instr o) xs (Succ n) r a
tailCallOptimise :: MVar x
-> Fix4 (Instr o) (x : xs) ('Succ n) r a
-> Fix4 (Instr o) xs ('Succ n) r a
tailCallOptimise MVar x
μ (In4 Instr o (Fix4 (Instr o)) (x : xs) ('Succ n) r a
Ret) = Instr o (Fix4 (Instr o)) '[] ('Succ n) x a
-> Fix4 (Instr o) '[] ('Succ n) x a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 (MVar x -> Instr o (Fix4 (Instr o)) '[] ('Succ n) x a
forall x o (k :: [Type] -> Nat -> Type -> Type -> Type) (n :: Nat)
       a.
MVar x -> Instr o k '[] ('Succ n) x a
Jump MVar x
μ)
tailCallOptimise MVar x
μ Fix4 (Instr o) (x : xs) ('Succ n) r a
k         = Instr o (Fix4 (Instr o)) xs ('Succ n) r a
-> Fix4 (Instr o) xs ('Succ n) r a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 (MVar x
-> Fix4 (Instr o) (x : xs) ('Succ n) r a
-> Instr o (Fix4 (Instr o)) xs ('Succ n) r a
forall x (k :: [Type] -> Nat -> Type -> Type -> Type)
       (xs :: [Type]) (n :: Nat) r a o.
MVar x -> k (x : xs) ('Succ n) r a -> Instr o k xs ('Succ n) r a
Call MVar x
μ Fix4 (Instr o) (x : xs) ('Succ n) r a
k)

-- Thanks to the optimisation applied to the K stack, commit is deadcode before Ret
-- However, I'm not yet sure about the interactions with try yet...
deadCommitOptimisation :: Fix4 (Instr o) xs n r a -> Fix4 (Instr o) xs (Succ n) r a
deadCommitOptimisation :: Fix4 (Instr o) xs n r a -> Fix4 (Instr o) xs ('Succ n) r a
deadCommitOptimisation (In4 Instr o (Fix4 (Instr o)) xs n r a
Ret) = Instr o (Fix4 (Instr o)) '[r] ('Succ n) r a
-> Fix4 (Instr o) '[r] ('Succ n) r a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 Instr o (Fix4 (Instr o)) '[r] ('Succ n) r a
forall o (k :: [Type] -> Nat -> Type -> Type -> Type) x (n :: Nat)
       a.
Instr o k '[x] n x a
Ret
deadCommitOptimisation Fix4 (Instr o) xs n r a
m         = Instr o (Fix4 (Instr o)) xs ('Succ n) r a
-> Fix4 (Instr o) xs ('Succ n) r a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 (Fix4 (Instr o) xs n r a
-> Instr o (Fix4 (Instr o)) xs ('Succ n) r a
forall (k :: [Type] -> Nat -> Type -> Type -> Type) (xs :: [Type])
       (n :: Nat) r a o.
k xs n r a -> Instr o k xs ('Succ n) r a
Commit Fix4 (Instr o) xs n r a
m)

-- Refactor with asks
askM :: CodeGenStack (MVar a)
askM :: CodeGenStack (MVar a)
askM = VFresh IMVar (MVar a) -> CodeGenStack (MVar a)
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((IMVar -> MVar a) -> VFresh IMVar (MVar a)
forall x (m :: Type -> Type) a. MonadFresh x m => (x -> a) -> m a
construct IMVar -> MVar a
forall a. IMVar -> MVar a
MVar)

askΦ :: CodeGenStack (ΦVar a)
askΦ :: CodeGenStack (ΦVar a)
askΦ = (IΦVar -> ΦVar a) -> CodeGenStack (ΦVar a)
forall x (m :: Type -> Type) a. MonadFresh x m => (x -> a) -> m a
construct IΦVar -> ΦVar a
forall a. IΦVar -> ΦVar a
ΦVar

freshM :: CodeGenStack a -> CodeGenStack a
freshM :: CodeGenStack a -> CodeGenStack a
freshM = (VFresh IMVar (a, IΦVar, IΦVar) -> VFresh IMVar (a, IΦVar, IΦVar))
-> CodeGenStack a -> CodeGenStack a
forall (m :: Type -> Type) a x (n :: Type -> Type) b.
(m (a, x, x) -> n (b, x, x)) -> VFreshT x m a -> VFreshT x n b
mapVFreshT VFresh IMVar (a, IΦVar, IΦVar) -> VFresh IMVar (a, IΦVar, IΦVar)
forall x (m :: Type -> Type) a. MonadFresh x m => m a -> m a
newScope

freshΦ :: CodeGenStack a -> CodeGenStack a
freshΦ :: CodeGenStack a -> CodeGenStack a
freshΦ = CodeGenStack a -> CodeGenStack a
forall x (m :: Type -> Type) a. MonadFresh x m => m a -> m a
newScope

makeΦ :: Trace => Fix4 (Instr o) (x ': xs) (Succ n) r a -> CodeGenStack (Fix4 (Instr o) xs (Succ n) r a -> Fix4 (Instr o) xs (Succ n) r a, Fix4 (Instr o) (x : xs) (Succ n) r a)
makeΦ :: Fix4 (Instr o) (x : xs) ('Succ n) r a
-> CodeGenStack
     (Fix4 (Instr o) xs ('Succ n) r a
      -> Fix4 (Instr o) xs ('Succ n) r a,
      Fix4 (Instr o) (x : xs) ('Succ n) r a)
makeΦ Fix4 (Instr o) (x : xs) ('Succ n) r a
m | Fix4 (Instr o) (x : xs) ('Succ n) r a -> Bool
forall o (xs :: [Type]) (n :: Nat) r a.
Fix4 (Instr o) xs n r a -> Bool
shouldInline Fix4 (Instr o) (x : xs) ('Succ n) r a
m = String
-> CodeGenStack
     (Fix4 (Instr o) xs ('Succ n) r a
      -> Fix4 (Instr o) xs ('Succ n) r a,
      Fix4 (Instr o) (x : xs) ('Succ n) r a)
-> CodeGenStack
     (Fix4 (Instr o) xs ('Succ n) r a
      -> Fix4 (Instr o) xs ('Succ n) r a,
      Fix4 (Instr o) (x : xs) ('Succ n) r a)
forall a. Trace => String -> a -> a
trace (String
"eliding " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Fix4 (Instr o) (x : xs) ('Succ n) r a -> String
forall a. Show a => a -> String
show Fix4 (Instr o) (x : xs) ('Succ n) r a
m) (CodeGenStack
   (Fix4 (Instr o) xs ('Succ n) r a
    -> Fix4 (Instr o) xs ('Succ n) r a,
    Fix4 (Instr o) (x : xs) ('Succ n) r a)
 -> CodeGenStack
      (Fix4 (Instr o) xs ('Succ n) r a
       -> Fix4 (Instr o) xs ('Succ n) r a,
       Fix4 (Instr o) (x : xs) ('Succ n) r a))
-> CodeGenStack
     (Fix4 (Instr o) xs ('Succ n) r a
      -> Fix4 (Instr o) xs ('Succ n) r a,
      Fix4 (Instr o) (x : xs) ('Succ n) r a)
-> CodeGenStack
     (Fix4 (Instr o) xs ('Succ n) r a
      -> Fix4 (Instr o) xs ('Succ n) r a,
      Fix4 (Instr o) (x : xs) ('Succ n) r a)
forall a b. (a -> b) -> a -> b
$ (Fix4 (Instr o) xs ('Succ n) r a
 -> Fix4 (Instr o) xs ('Succ n) r a,
 Fix4 (Instr o) (x : xs) ('Succ n) r a)
-> CodeGenStack
     (Fix4 (Instr o) xs ('Succ n) r a
      -> Fix4 (Instr o) xs ('Succ n) r a,
      Fix4 (Instr o) (x : xs) ('Succ n) r a)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Fix4 (Instr o) xs ('Succ n) r a -> Fix4 (Instr o) xs ('Succ n) r a
forall a. a -> a
id, Fix4 (Instr o) (x : xs) ('Succ n) r a
m)
  {-where
    elidable :: Fix4 (Instr o) (x ': xs) (Succ n) r a -> Bool
    -- This is double-φ optimisation:   If a φ-node points shallowly to another φ-node, then it can be elided
    elidable (In4 (Join _))             = True
    elidable (In4 (Pop (In4 (Join _)))) = True
    -- This is terminal-φ optimisation: If a φ-node points shallowly to a terminal operation, then it can be elided
    elidable (In4 Ret)                  = True
    elidable (In4 (Pop (In4 Ret)))      = True
    -- This is a form of double-φ optimisation: If a φ-node points shallowly to a jump, then it can be elided and the jump used instead
    -- Note that this should NOT be done for non-tail calls, as they may generate a large continuation
    elidable (In4 (Pop (In4 (Jump _)))) = True
    elidable _                          = False-}
makeΦ Fix4 (Instr o) (x : xs) ('Succ n) r a
m = let n :: Coins
n = Fix4 (Instr o) (x : xs) ('Succ n) r a -> Coins
forall o (xs :: [Type]) (n :: Nat) r a.
Fix4 (Instr o) xs n r a -> Coins
coinsNeeded Fix4 (Instr o) (x : xs) ('Succ n) r a
m in (ΦVar x
 -> (Fix4 (Instr o) xs ('Succ n) r a
     -> Fix4 (Instr o) xs ('Succ n) r a,
     Fix4 (Instr o) (x : xs) ('Succ n) r a))
-> VFreshT IΦVar (VFresh IMVar) (ΦVar x)
-> CodeGenStack
     (Fix4 (Instr o) xs ('Succ n) r a
      -> Fix4 (Instr o) xs ('Succ n) r a,
      Fix4 (Instr o) (x : xs) ('Succ n) r a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ΦVar x
φ -> (Instr o (Fix4 (Instr o)) xs ('Succ n) r a
-> Fix4 (Instr o) xs ('Succ n) r a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 (Instr o (Fix4 (Instr o)) xs ('Succ n) r a
 -> Fix4 (Instr o) xs ('Succ n) r a)
-> (Fix4 (Instr o) xs ('Succ n) r a
    -> Instr o (Fix4 (Instr o)) xs ('Succ n) r a)
-> Fix4 (Instr o) xs ('Succ n) r a
-> Fix4 (Instr o) xs ('Succ n) r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ΦVar x
-> Fix4 (Instr o) (x : xs) ('Succ n) r a
-> Fix4 (Instr o) xs ('Succ n) r a
-> Instr o (Fix4 (Instr o)) xs ('Succ n) r a
forall x (k :: [Type] -> Nat -> Type -> Type -> Type)
       (xs :: [Type]) (n :: Nat) r a o.
ΦVar x -> k (x : xs) n r a -> k xs n r a -> Instr o k xs n r a
MkJoin ΦVar x
φ (Coins
-> Fix4 (Instr o) (x : xs) ('Succ n) r a
-> Fix4 (Instr o) (x : xs) ('Succ n) r a
forall o (xs :: [Type]) (n :: Nat) r a.
Coins -> Fix4 (Instr o) xs n r a -> Fix4 (Instr o) xs n r a
giveBursary Coins
n Fix4 (Instr o) (x : xs) ('Succ n) r a
m), Coins
-> Fix4 (Instr o) (x : xs) ('Succ n) r a
-> Fix4 (Instr o) (x : xs) ('Succ n) r a
forall o (xs :: [Type]) (n :: Nat) r a.
Coins
-> Fix4 (Instr o) xs ('Succ n) r a
-> Fix4 (Instr o) xs ('Succ n) r a
drainCoins Coins
n (Instr o (Fix4 (Instr o)) (x : xs) ('Succ n) r a
-> Fix4 (Instr o) (x : xs) ('Succ n) r a
forall k k k k
       (f :: (k -> k -> k -> k -> Type) -> k -> k -> k -> k -> Type)
       (i :: k) (j :: k) (k :: k) (l :: k).
f (Fix4 f) i j k l -> Fix4 f i j k l
In4 (ΦVar x -> Instr o (Fix4 (Instr o)) (x : xs) ('Succ n) r a
forall x o (k :: [Type] -> Nat -> Type -> Type -> Type)
       (xs :: [Type]) (n :: Nat) r a.
ΦVar x -> Instr o k (x : xs) n r a
Join ΦVar x
φ)))) VFreshT IΦVar (VFresh IMVar) (ΦVar x)
forall a. CodeGenStack (ΦVar a)
askΦ