{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
{-# LANGUAGE ImplicitParams, 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, _Jump,
                                            addCoins, refundCoins, drainCoins, giveBursary, blockCoins,
                                            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)

import qualified Parsley.Internal.Opt as Opt

type CodeGenStack a = VFreshT IΦVar (VFresh IMVar) a
runCodeGenStack :: CodeGenStack a -> IMVar -> IΦVar -> a
runCodeGenStack :: forall a. CodeGenStack a -> IMVar -> IΦVar -> a
runCodeGenStack CodeGenStack a
m IMVar
μ0 IΦVar
φ0 = forall x (m :: Type -> Type) a.
RunFreshT x Identity m =>
m a -> x -> a
evalFresh (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 {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 :: 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, ?flags :: Opt.Flags)
        => 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 :: forall x o a.
(Trace, ?flags::Flags) =>
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 = forall a. Trace => String -> a -> a
trace (String
"GENERATING " forall a. [a] -> [a] -> [a]
++ String
name forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Fix Combinator x
p forall a. [a] -> [a] -> [a]
++ String
"\nMACHINE: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. Set a -> [a]
elems Set SomeΣVar
rs) forall a. [a] -> [a] -> [a]
++ String
" => " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Fix4 (Instr o) '[] ('Succ 'Zero) x a
m) forall a b. (a -> b) -> a -> b
$ 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"TOP LEVEL" forall a. Show a => a -> String
show Maybe (MVar x)
letBound
    --addCoinsTop = maybe addCoinsNeeded (const id) letBound
    m :: Fix4 (Instr o) '[] ('Succ 'Zero) x a
m = CodeGen o a x -> Fix4 (Instr o) '[] ('Succ 'Zero) x a
finalise (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 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 :: forall o a x.
Combinator (Cofree Combinator (CodeGen o a)) x -> CodeGen o a x
alg = forall o a x.
(Trace, ?flags::Flags) =>
Combinator (Cofree Combinator (CodeGen o a)) x
-> Maybe (CodeGen o a x)
deep forall r k a. Chain r k => (a -> Maybe r) -> (a -> k) -> a -> k
|> (\Combinator (Cofree Combinator (CodeGen o a)) x
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 o a x (xs :: [Type]) (n :: Nat) r.
(Trace, ?flags::Flags) =>
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 (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 {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)))
    -- add coins is safe here because if a cut is present it will only factor 1 coin
    finalise :: CodeGen o a x -> Fix4 (Instr o) '[] ('Succ 'Zero) x a
finalise CodeGen o a x
cg = forall o (xs :: [Type]) (n :: Nat) r a.
Fix4 (Instr o) xs ('Succ n) r a -> Fix4 (Instr o) xs ('Succ n) r a
addCoinsNeeded (forall a. CodeGenStack a -> IMVar -> IΦVar -> a
runCodeGenStack (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 (forall {k} {k1} {k2} {k3}
       (f :: (k -> k1 -> k2 -> k3 -> Type) -> k -> k1 -> k2 -> k3 -> Type)
       (i :: k) (j :: k1) (k4 :: k2) (l :: k3).
f (Fix4 f) i j k4 l -> Fix4 f i j k4 l
In4 forall o (k :: [Type] -> Nat -> Type -> Type -> Type) r (n :: Nat)
       a.
Instr o k '[r] n r 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)
-> ((# #) -> 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)
-> ((# #) -> 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) -> ((# #) -> 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 :: forall o (xs :: [Type]) (n :: Nat) r a.
Handler o (Fix4 (Instr o)) (o : xs) ('Succ n) r a
rollbackHandler = forall (k :: [Type] -> Nat -> Type -> Type -> Type) o
       (xs1 :: [Type]) (n :: Nat) r a.
Bool -> k (o : xs1) n r a -> Handler o k (o : xs1) n r a
Always Bool
False (forall {k} {k1} {k2} {k3}
       (f :: (k -> k1 -> k2 -> k3 -> Type) -> k -> k1 -> k2 -> k3 -> Type)
       (i :: k) (j :: k1) (k4 :: k2) (l :: k3).
f (Fix4 f) i j k4 l -> Fix4 f i j k4 l
In4 (forall (k :: [Type] -> Nat -> Type -> Type -> Type) (xs1 :: [Type])
       (n :: Nat) r a o.
k xs1 n r a -> Instr o k (o : xs1) n r a
Seek (forall {k} {k1} {k2} {k3}
       (f :: (k -> k1 -> k2 -> k3 -> Type) -> k -> k1 -> k2 -> k3 -> Type)
       (i :: k) (j :: k1) (k4 :: k2) (l :: k3).
f (Fix4 f) i j k4 l -> Fix4 f i j k4 l
In4 forall o (k :: [Type] -> Nat -> Type -> Type -> Type)
       (xs :: [Type]) (n1 :: Nat) r a.
Instr o k xs ('Succ n1) r a
Empt)))

parsecHandler :: (?flags :: Opt.Flags) => Fix4 (Instr o) xs (Succ n) r a -> Handler o (Fix4 (Instr o)) (o : xs) (Succ n) r a
parsecHandler :: forall o (xs :: [Type]) (n :: Nat) r a.
(?flags::Flags) =>
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 = forall (k :: [Type] -> Nat -> Type -> Type -> Type) (xs1 :: [Type])
       (n :: Nat) r a o.
Bool
-> k xs1 n r a
-> Bool
-> k (o : xs1) n r a
-> Handler o k (o : xs1) n r a
Same (Bool -> Bool
not (forall o (xs :: [Type]) (n :: Nat) r a.
(?flags::Flags) =>
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 (forall {k} {k1} {k2} {k3}
       (f :: (k -> k1 -> k2 -> k3 -> Type) -> k -> k1 -> k2 -> k3 -> Type)
       (i :: k) (j :: k1) (k4 :: k2) (l :: k3).
f (Fix4 f) i j k4 l -> Fix4 f i j k4 l
In4 forall o (k :: [Type] -> Nat -> Type -> Type -> Type)
       (xs :: [Type]) (n1 :: Nat) r a.
Instr o k xs ('Succ n1) r a
Empt)

recoverHandler :: (?flags :: Opt.Flags) => Fix4 (Instr o) xs n r a -> Handler o (Fix4 (Instr o)) (o : xs) n r a
recoverHandler :: forall o (xs :: [Type]) (n :: Nat) r a.
(?flags::Flags) =>
Fix4 (Instr o) xs n r a
-> Handler o (Fix4 (Instr o)) (o : xs) n r a
recoverHandler = forall (k :: [Type] -> Nat -> Type -> Type -> Type) o
       (xs1 :: [Type]) (n :: Nat) r a.
Bool -> k (o : xs1) n r a -> Handler o k (o : xs1) n r a
Always forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall o (xs :: [Type]) (n :: Nat) r a.
(?flags::Flags) =>
Fix4 (Instr o) xs n r a -> Bool
shouldInline forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> forall {k} {k1} {k2} {k3}
       (f :: (k -> k1 -> k2 -> k3 -> Type) -> k -> k1 -> k2 -> k3 -> Type)
       (i :: k) (j :: k1) (k4 :: k2) (l :: k3).
f (Fix4 f) i j k4 l -> Fix4 f i j k4 l
In4 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (k :: [Type] -> Nat -> Type -> Type -> Type) (xs1 :: [Type])
       (n :: Nat) r a o.
k xs1 n r a -> Instr o k (o : xs1) n r a
Seek

altCompile :: (Trace, ?flags :: Opt.Flags) => 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)
altCompile :: forall o a y x (xs :: [Type]) (n :: Nat) r.
(Trace, ?flags::Flags) =>
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)
altCompile 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
φ) <- forall o x (xs :: [Type]) (n :: Nat) r a.
(Trace, ?flags::Flags) =>
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 <- forall a. CodeGenStack a -> CodeGenStack a
freshΦ (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 (forall o (xs :: [Type]) (n :: Nat) r a.
Fix4 (Instr o) xs n r a -> Fix4 (Instr o) xs ('Succ n) r a
deadCommitOptimisation (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 <- forall a. CodeGenStack a -> CodeGenStack a
freshΦ (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
φ)
     -- the shared coins are not factored out of the branches, because this is done by the AddCoins evaluation
     forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Fix4 (Instr o) xs ('Succ n) r a -> Fix4 (Instr o) xs ('Succ n) r a
binder (forall {k} {k1} {k2} {k3}
       (f :: (k -> k1 -> k2 -> k3 -> Type) -> k -> k1 -> k2 -> k3 -> Type)
       (i :: k) (j :: k1) (k4 :: k2) (l :: k3).
f (Fix4 f) i j k4 l -> Fix4 f i j k4 l
In4 (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 (forall o (xs :: [Type]) (n :: Nat) r a.
Fix4 (Instr o) xs ('Succ n) r a -> Fix4 (Instr o) xs ('Succ n) r a
addCoinsNeeded Fix4 (Instr o) xs ('Succ ('Succ n)) r a
pc) (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 o (xs :: [Type]) (n :: Nat) r a.
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
qc))))

deep :: (Trace, ?flags :: Opt.Flags) => Combinator (Cofree Combinator (CodeGen o a)) x -> Maybe (CodeGen o a x)
deep :: forall o a x.
(Trace, ?flags::Flags) =>
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
_)) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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 a b. (a -> b) -> a -> b
$ \Fix4 (Instr o) (x : xs) ('Succ n) r a
m -> 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 (forall {k} {k1} {k2} {k3}
       (f :: (k -> k1 -> k2 -> k3 -> Type) -> k -> k1 -> k2 -> k3 -> Type)
       (i :: k) (j :: k1) (k4 :: k2) (l :: k3).
f (Fix4 f) i j k4 l -> Fix4 f i j k4 l
In4 (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 (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) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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 a b. (a -> b) -> a -> b
$ forall o a y x (xs :: [Type]) (n :: Nat) r.
(Trace, ?flags::Flags) =>
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)
altCompile CodeGen o a x
p CodeGen o a x
q forall o (xs :: [Type]) (n :: Nat) r a.
(?flags::Flags) =>
Fix4 (Instr o) xs n r a
-> Handler o (Fix4 (Instr o)) (o : xs) n r a
recoverHandler forall a. a -> 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
_)) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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 a b. (a -> b) -> a -> b
$ forall o a y x (xs :: [Type]) (n :: Nat) r.
(Trace, ?flags::Flags) =>
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)
altCompile CodeGen o a a
p CodeGen o a x
q forall o (xs :: [Type]) (n :: Nat) r a.
(?flags::Flags) =>
Fix4 (Instr o) xs n r a
-> Handler o (Fix4 (Instr o)) (o : xs) n r a
recoverHandler (forall {k} {k1} {k2} {k3}
       (f :: (k -> k1 -> k2 -> k3 -> Type) -> k -> k1 -> k2 -> k3 -> Type)
       (i :: k) (j :: k1) (k4 :: k2) (l :: k3).
f (Fix4 f) i j k4 l -> Fix4 f i j k4 l
In4 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (k :: [Type] -> Nat -> Type -> Type -> Type) (xs1 :: [Type])
       (n :: Nat) r a o x.
k xs1 n r a -> Instr o k (x : xs1) n r a
Pop forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {k1} {k2} {k3}
       (f :: (k -> k1 -> k2 -> k3 -> Type) -> k -> k1 -> k2 -> k3 -> Type)
       (i :: k) (j :: k1) (k4 :: k2) (l :: k3).
f (Fix4 f) i j k4 l -> Fix4 f i j k4 l
In4 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (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
_)) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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 a b. (a -> b) -> a -> b
$ forall o a y x (xs :: [Type]) (n :: Nat) r.
(Trace, ?flags::Flags) =>
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)
altCompile CodeGen o a a
p CodeGen o a x
q forall o (xs :: [Type]) (n :: Nat) r a.
(?flags::Flags) =>
Fix4 (Instr o) xs n r a
-> Handler o (Fix4 (Instr o)) (o : xs) n r a
recoverHandler (forall {k} {k1} {k2} {k3}
       (f :: (k -> k1 -> k2 -> k3 -> Type) -> k -> k1 -> k2 -> k3 -> Type)
       (i :: k) (j :: k1) (k4 :: k2) (l :: k3).
f (Fix4 f) i j k4 l -> Fix4 f i j k4 l
In4 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (forall a. Defunc a -> Defunc a
user Defunc (a -> x)
f))
deep Combinator (Cofree Combinator (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 :: forall o (xs :: [Type]) (n :: Nat) r a.
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 n r a -> Coins
coinsNeeded forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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, ?flags :: Opt.Flags) => 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 o a x (xs :: [Type]) (n :: Nat) r.
(Trace, ?flags::Flags) =>
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 forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall {k} {k1} {k2} {k3}
       (f :: (k -> k1 -> k2 -> k3 -> Type) -> k -> k1 -> k2 -> k3 -> Type)
       (i :: k) (j :: k1) (k4 :: k2) (l :: k3).
f (Fix4 f) i j k4 l -> Fix4 f i j k4 l
In4 (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 (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 forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall {k} {k1} {k2} {k3}
       (f :: (k -> k1 -> k2 -> k3 -> Type) -> k -> k1 -> k2 -> k3 -> Type)
       (i :: k) (j :: k1) (k4 :: k2) (l :: k3).
f (Fix4 f) i j k4 l -> Fix4 f i j k4 l
In4 (forall (k :: [Type] -> Nat -> Type -> Type -> Type) (xs :: [Type])
       (n1 :: Nat) r a o.
CharPred
-> k (Char : xs) ('Succ n1) r a -> Instr o k xs ('Succ n1) r a
Sat CharPred
p Fix4 (Instr o) (x : xs) ('Succ n) r a
m)
shallow (CodeGen o a (a1 -> x)
pf :<*>: CodeGen o a a1
px) Fix4 (Instr o) (x : xs) ('Succ n) r a
m = do Fix4 (Instr o) ((a1 -> x) : xs) ('Succ n) r a
pxc <- 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 a1
px (forall {k} {k1} {k2} {k3}
       (f :: (k -> k1 -> k2 -> k3 -> Type) -> k -> k1 -> k2 -> k3 -> Type)
       (i :: k) (j :: k1) (k4 :: k2) (l :: k3).
f (Fix4 f) i j k4 l -> Fix4 f i j k4 l
In4 (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)); 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 (a1 -> x)
pf Fix4 (Instr o) ((a1 -> x) : xs) ('Succ n) r a
pxc
shallow (CodeGen o a a1
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 <- 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; 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 a1
p (forall {k} {k1} {k2} {k3}
       (f :: (k -> k1 -> k2 -> k3 -> Type) -> k -> k1 -> k2 -> k3 -> Type)
       (i :: k) (j :: k1) (k4 :: k2) (l :: k3).
f (Fix4 f) i j k4 l -> Fix4 f i j k4 l
In4 (forall (k :: [Type] -> Nat -> Type -> Type -> Type) (xs1 :: [Type])
       (n :: Nat) r a o x.
k xs1 n r a -> Instr o k (x : xs1) 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 <- 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 (forall {k} {k1} {k2} {k3}
       (f :: (k -> k1 -> k2 -> k3 -> Type) -> k -> k1 -> k2 -> k3 -> Type)
       (i :: k) (j :: k1) (k4 :: k2) (l :: k3).
f (Fix4 f) i j k4 l -> Fix4 f i j k4 l
In4 (forall (k :: [Type] -> Nat -> Type -> Type -> Type) (xs1 :: [Type])
       (n :: Nat) r a o x.
k xs1 n r a -> Instr o k (x : xs1) n r a
Pop Fix4 (Instr o) (x : xs) ('Succ n) r a
m)); 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 forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall {k} {k1} {k2} {k3}
       (f :: (k -> k1 -> k2 -> k3 -> Type) -> k -> k1 -> k2 -> k3 -> Type)
       (i :: k) (j :: k1) (k4 :: k2) (l :: k3).
f (Fix4 f) i j k4 l -> Fix4 f i j k4 l
In4 forall o (k :: [Type] -> Nat -> Type -> Type -> Type)
       (xs :: [Type]) (n1 :: Nat) r a.
Instr o k xs ('Succ n1) 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 forall o a y x (xs :: [Type]) (n :: Nat) r.
(Trace, ?flags::Flags) =>
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)
altCompile CodeGen o a x
p CodeGen o a x
q forall o (xs :: [Type]) (n :: Nat) r a.
(?flags::Flags) =>
Fix4 (Instr o) xs ('Succ n) r a
-> Handler o (Fix4 (Instr o)) (o : xs) ('Succ n) r a
parsecHandler forall a. a -> 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 forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall {k} {k1} {k2} {k3}
       (f :: (k -> k1 -> k2 -> k3 -> Type) -> k -> k1 -> k2 -> k3 -> Type)
       (i :: k) (j :: k1) (k4 :: k2) (l :: k3).
f (Fix4 f) i j k4 l -> Fix4 f i j k4 l
In4 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip 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 forall o (xs :: [Type]) (n :: Nat) r a.
Handler o (Fix4 (Instr o)) (o : xs) ('Succ n) r a
rollbackHandler) (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 (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 <- forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap forall o (xs :: [Type]) (n :: Nat) r a.
Fix4 (Instr o) xs n r a -> Coins
reclaimable (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 (forall {k} {k1} {k2} {k3}
       (f :: (k -> k1 -> k2 -> k3 -> Type) -> k -> k1 -> k2 -> k3 -> Type)
       (i :: k) (j :: k1) (k4 :: k2) (l :: k3).
f (Fix4 f) i j k4 l -> Fix4 f i j k4 l
In4 forall o (k :: [Type] -> Nat -> Type -> Type -> Type) r (n :: Nat)
       a.
Instr o k '[r] n r a
Ret)) -- dodgy hack, but oh well
     -- always refund the input consumed during a lookahead, so it can be reused (lookahead is handlerless)
     forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall {k} {k1} {k2} {k3}
       (f :: (k -> k1 -> k2 -> k3 -> Type) -> k -> k1 -> k2 -> k3 -> Type)
       (i :: k) (j :: k1) (k4 :: k2) (l :: k3).
f (Fix4 f) i j k4 l -> Fix4 f i j k4 l
In4 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) (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 (forall {k} {k1} {k2} {k3}
       (f :: (k -> k1 -> k2 -> k3 -> Type) -> k -> k1 -> k2 -> k3 -> Type)
       (i :: k) (j :: k1) (k4 :: k2) (l :: k3).
f (Fix4 f) i j k4 l -> Fix4 f i j k4 l
In4 (forall (k :: [Type] -> Nat -> Type -> Type -> Type) x y
       (xs1 :: [Type]) (n :: Nat) r a o.
k (x : y : xs1) n r a -> Instr o k (y : x : xs1) n r a
Swap (forall {k} {k1} {k2} {k3}
       (f :: (k -> k1 -> k2 -> k3 -> Type) -> k -> k1 -> k2 -> k3 -> Type)
       (i :: k) (j :: k1) (k4 :: k2) (l :: k3).
f (Fix4 f) i j k4 l -> Fix4 f i j k4 l
In4 (forall (k :: [Type] -> Nat -> Type -> Type -> Type) (xs1 :: [Type])
       (n :: Nat) r a o.
k xs1 n r a -> Instr o k (o : xs1) n r a
Seek (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 a1
p) Fix4 (Instr o) (x : xs) ('Succ n) r a
m =
  do Fix4 (Instr o) (o : xs) ('Succ ('Succ n)) r a
pc <- 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 a1
p (forall {k} {k1} {k2} {k3}
       (f :: (k -> k1 -> k2 -> k3 -> Type) -> k -> k1 -> k2 -> k3 -> Type)
       (i :: k) (j :: k1) (k4 :: k2) (l :: k3).
f (Fix4 f) i j k4 l -> Fix4 f i j k4 l
In4 (forall (k :: [Type] -> Nat -> Type -> Type -> Type) (xs1 :: [Type])
       (n :: Nat) r a o x.
k xs1 n r a -> Instr o k (x : xs1) n r a
Pop (forall {k} {k1} {k2} {k3}
       (f :: (k -> k1 -> k2 -> k3 -> Type) -> k -> k1 -> k2 -> k3 -> Type)
       (i :: k) (j :: k1) (k4 :: k2) (l :: k3).
f (Fix4 f) i j k4 l -> Fix4 f i j k4 l
In4 (forall (k :: [Type] -> Nat -> Type -> Type -> Type) (xs1 :: [Type])
       (n :: Nat) r a o.
k xs1 n r a -> Instr o k (o : xs1) n r a
Seek (forall {k} {k1} {k2} {k3}
       (f :: (k -> k1 -> k2 -> k3 -> Type) -> k -> k1 -> k2 -> k3 -> Type)
       (i :: k) (j :: k1) (k4 :: k2) (l :: k3).
f (Fix4 f) i j k4 l -> Fix4 f i j k4 l
In4 (forall (k :: [Type] -> Nat -> Type -> Type -> Type) (xs :: [Type])
       (n1 :: Nat) r a o.
k xs n1 r a -> Instr o k xs ('Succ n1) r a
Commit (forall {k} {k1} {k2} {k3}
       (f :: (k -> k1 -> k2 -> k3 -> Type) -> k -> k1 -> k2 -> k3 -> Type)
       (i :: k) (j :: k1) (k4 :: k2) (l :: k3).
f (Fix4 f) i j k4 l -> Fix4 f i j k4 l
In4 forall o (k :: [Type] -> Nat -> Type -> Type -> Type)
       (xs :: [Type]) (n1 :: Nat) r a.
Instr o k xs ('Succ n1) r a
Empt)))))))
     -- it should never be the case that factored input can commute out of the lookahead
     forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall {k} {k1} {k2} {k3}
       (f :: (k -> k1 -> k2 -> k3 -> Type) -> k -> k1 -> k2 -> k3 -> Type)
       (i :: k) (j :: k1) (k4 :: k2) (l :: k3).
f (Fix4 f) i j k4 l -> Fix4 f i j k4 l
In4 (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 (forall o (xs :: [Type]) (n :: Nat) r a.
Bool
-> Fix4 (Instr o) xs ('Succ n) r a
-> Fix4 (Instr o) xs ('Succ n) r a
blockCoins Bool
True (forall o (xs :: [Type]) (n :: Nat) r a.
Fix4 (Instr o) xs ('Succ n) r a -> Fix4 (Instr o) xs ('Succ n) r a
addCoinsNeeded (forall {k} {k1} {k2} {k3}
       (f :: (k -> k1 -> k2 -> k3 -> Type) -> k -> k1 -> k2 -> k3 -> Type)
       (i :: k) (j :: k1) (k4 :: k2) (l :: k3).
f (Fix4 f) i j k4 l -> Fix4 f i j k4 l
In4 (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)))) (forall (k :: [Type] -> Nat -> Type -> Type -> Type) o
       (xs1 :: [Type]) (n :: Nat) r a.
Bool -> k (o : xs1) n r a -> Handler o k (o : xs1) n r a
Always (Bool -> Bool
not (forall o (xs :: [Type]) (n :: Nat) r a.
(?flags::Flags) =>
Fix4 (Instr o) xs n r a -> Bool
shouldInline Fix4 (Instr o) (x : xs) ('Succ n) r a
m)) (forall {k} {k1} {k2} {k3}
       (f :: (k -> k1 -> k2 -> k3 -> Type) -> k -> k1 -> k2 -> k3 -> Type)
       (i :: k) (j :: k1) (k4 :: k2) (l :: k3).
f (Fix4 f) i j k4 l -> Fix4 f i j k4 l
In4 (forall (k :: [Type] -> Nat -> Type -> Type -> Type) (xs1 :: [Type])
       (n :: Nat) r a o.
k xs1 n r a -> Instr o k (o : xs1) n r a
Seek (forall {k} {k1} {k2} {k3}
       (f :: (k -> k1 -> k2 -> k3 -> Type) -> k -> k1 -> k2 -> k3 -> Type)
       (i :: k) (j :: k1) (k4 :: k2) (l :: k3).
f (Fix4 f) i j k4 l -> Fix4 f i j k4 l
In4 (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 (forall a. Defunc a -> Defunc a
user Defunc ()
UNIT) Fix4 (Instr o) (x : xs) ('Succ n) r a
m))))))
shallow (Branch CodeGen o a (Either a1 b)
b CodeGen o a (a1 -> 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
φ) <- forall o x (xs :: [Type]) (n :: Nat) r a.
(Trace, ?flags::Flags) =>
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) (a1 : xs) ('Succ n) r a
pc <- forall a. CodeGenStack a -> CodeGenStack a
freshΦ (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 (a1 -> x)
p (forall {k} {k1} {k2} {k3}
       (f :: (k -> k1 -> k2 -> k3 -> Type) -> k -> k1 -> k2 -> k3 -> Type)
       (i :: k) (j :: k1) (k4 :: k2) (l :: k3).
f (Fix4 f) i j k4 l -> Fix4 f i j k4 l
In4 (forall (k :: [Type] -> Nat -> Type -> Type -> Type) x y
       (xs1 :: [Type]) (n :: Nat) r a o.
k (x : y : xs1) n r a -> Instr o k (y : x : xs1) n r a
Swap (forall {k} {k1} {k2} {k3}
       (f :: (k -> k1 -> k2 -> k3 -> Type) -> k -> k1 -> k2 -> k3 -> Type)
       (i :: k) (j :: k1) (k4 :: k2) (l :: k3).
f (Fix4 f) i j k4 l -> Fix4 f i j k4 l
In4 (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 <- forall a. CodeGenStack a -> CodeGenStack a
freshΦ (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 (forall {k} {k1} {k2} {k3}
       (f :: (k -> k1 -> k2 -> k3 -> Type) -> k -> k1 -> k2 -> k3 -> Type)
       (i :: k) (j :: k1) (k4 :: k2) (l :: k3).
f (Fix4 f) i j k4 l -> Fix4 f i j k4 l
In4 (forall (k :: [Type] -> Nat -> Type -> Type -> Type) x y
       (xs1 :: [Type]) (n :: Nat) r a o.
k (x : y : xs1) n r a -> Instr o k (y : x : xs1) n r a
Swap (forall {k} {k1} {k2} {k3}
       (f :: (k -> k1 -> k2 -> k3 -> Type) -> k -> k1 -> k2 -> k3 -> Type)
       (i :: k) (j :: k1) (k4 :: k2) (l :: k3).
f (Fix4 f) i j k4 l -> Fix4 f i j k4 l
In4 (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
φ)))))
     -- the shared coins are not factored out of the branches, because this is done by the AddCoins evaluation
     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 (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 a1 b)
b (forall {k} {k1} {k2} {k3}
       (f :: (k -> k1 -> k2 -> k3 -> Type) -> k -> k1 -> k2 -> k3 -> Type)
       (i :: k) (j :: k1) (k4 :: k2) (l :: k3).
f (Fix4 f) i j k4 l -> Fix4 f i j k4 l
In4 (forall (k :: [Type] -> Nat -> Type -> Type -> Type) x
       (xs1 :: [Type]) (n :: Nat) r a y o.
k (x : xs1) n r a
-> k (y : xs1) n r a -> Instr o k (Either x y : xs1) n r a
Case (forall o (xs :: [Type]) (n :: Nat) r a.
Fix4 (Instr o) xs ('Succ n) r a -> Fix4 (Instr o) xs ('Succ n) r a
addCoinsNeeded Fix4 (Instr o) (a1 : xs) ('Succ n) r a
pc) (forall o (xs :: [Type]) (n :: Nat) r a.
Fix4 (Instr o) xs ('Succ n) r a -> Fix4 (Instr o) xs ('Succ n) r a
addCoinsNeeded Fix4 (Instr o) (b : xs) ('Succ n) r a
qc))))
shallow (Match CodeGen o a a1
p [Defunc (a1 -> 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
φ) <- forall o x (xs :: [Type]) (n :: Nat) r a.
(Trace, ?flags::Flags) =>
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 <- 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 -> forall a. CodeGenStack a -> CodeGenStack a
freshΦ (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 <- forall a. CodeGenStack a -> CodeGenStack a
freshΦ (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 Fix4 (Instr o) xs ('Succ n) r a
defc':[Fix4 (Instr o) xs ('Succ n) r a]
qcs' = forall a b. (a -> b) -> [a] -> [b]
map forall o (xs :: [Type]) (n :: Nat) r a.
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
defcforall a. a -> [a] -> [a]
:[Fix4 (Instr o) xs ('Succ n) r a]
qcs)
     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 (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 a1
p (forall {k} {k1} {k2} {k3}
       (f :: (k -> k1 -> k2 -> k3 -> Type) -> k -> k1 -> k2 -> k3 -> Type)
       (i :: k) (j :: k1) (k4 :: k2) (l :: k3).
f (Fix4 f) i j k4 l -> Fix4 f i j k4 l
In4 (forall x (k :: [Type] -> Nat -> Type -> Type -> Type)
       (xs1 :: [Type]) (n :: Nat) r a o.
[Defunc (x -> Bool)]
-> [k xs1 n r a] -> k xs1 n r a -> Instr o k (x : xs1) n r a
Choices (forall a b. (a -> b) -> [a] -> [b]
map forall a. Defunc a -> Defunc a
user [Defunc (a1 -> Bool)]
fs) [Fix4 (Instr o) xs ('Succ n) r a]
qcs' Fix4 (Instr o) xs ('Succ n) r a
defc')))
shallow (Let MVar x
μ)                      Fix4 (Instr o) (x : xs) ('Succ n) r a
m = do forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall {k} {k1} {k2} {k3}
       (f :: (k -> k1 -> k2 -> k3 -> Type) -> k -> k1 -> k2 -> k3 -> Type)
       (i :: k) (j :: k1) (k4 :: k2) (l :: k3).
f (Fix4 f) i j k4 l -> Fix4 f i j k4 l
In4 (forall x (k :: [Type] -> Nat -> Type -> Type -> Type)
       (xs :: [Type]) (n1 :: Nat) r a o.
MVar x -> k (x : xs) ('Succ n1) r a -> Instr o k xs ('Succ n1) r a
Call 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 MVar Void
μ <- forall a. CodeGenStack (MVar a)
askM
     Fix4 (Instr o) '[] ('Succ 'Zero) Void a
bodyc <- forall a. CodeGenStack a -> CodeGenStack a
freshM (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 (forall {k} {k1} {k2} {k3}
       (f :: (k -> k1 -> k2 -> k3 -> Type) -> k -> k1 -> k2 -> k3 -> Type)
       (i :: k) (j :: k1) (k4 :: k2) (l :: k3).
f (Fix4 f) i j k4 l -> Fix4 f i j k4 l
In4 (forall (k :: [Type] -> Nat -> Type -> Type -> Type) (xs1 :: [Type])
       (n :: Nat) r a o x.
k xs1 n r a -> Instr o k (x : xs1) n r a
Pop (forall {k} {k1} {k2} {k3}
       (f :: (k -> k1 -> k2 -> k3 -> Type) -> k -> k1 -> k2 -> k3 -> Type)
       (i :: k) (j :: k1) (k4 :: k2) (l :: k3).
f (Fix4 f) i j k4 l -> Fix4 f i j k4 l
In4 (forall x o (n :: Nat) a.
MVar x -> Instr o (Fix4 (Instr o)) '[] ('Succ n) x a
_Jump MVar Void
μ)))))
     Fix4 (Instr o) xs ('Succ n) r a
exitc <- forall a. CodeGenStack a -> CodeGenStack a
freshM (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)
     forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall {k} {k1} {k2} {k3}
       (f :: (k -> k1 -> k2 -> k3 -> Type) -> k -> k1 -> k2 -> k3 -> Type)
       (i :: k) (j :: k1) (k4 :: k2) (l :: k3).
f (Fix4 f) i j k4 l -> Fix4 f i j k4 l
In4 (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
μ (forall o (xs :: [Type]) (n :: Nat) r a.
Fix4 (Instr o) xs ('Succ n) r a -> Fix4 (Instr o) xs ('Succ n) r a
addCoinsNeeded Fix4 (Instr o) '[] ('Succ 'Zero) Void a
bodyc) (forall o (xs :: [Type]) (n :: Nat) r a.
(?flags::Flags) =>
Fix4 (Instr o) xs ('Succ n) r a
-> Handler o (Fix4 (Instr o)) (o : xs) ('Succ n) r a
parsecHandler (forall o (xs :: [Type]) (n :: Nat) r a.
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
exitc)))
shallow (MakeRegister ΣVar a1
σ CodeGen o a a1
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 <- 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; 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 a1
p (forall {k} {k1} {k2} {k3}
       (f :: (k -> k1 -> k2 -> k3 -> Type) -> k -> k1 -> k2 -> k3 -> Type)
       (i :: k) (j :: k1) (k4 :: k2) (l :: k3).
f (Fix4 f) i j k4 l -> Fix4 f i j k4 l
In4 (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 a1
σ Fix4 (Instr o) xs ('Succ n) r a
qc))
shallow (GetRegister ΣVar x
σ)              Fix4 (Instr o) (x : xs) ('Succ n) r a
m = do forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall {k} {k1} {k2} {k3}
       (f :: (k -> k1 -> k2 -> k3 -> Type) -> k -> k1 -> k2 -> k3 -> Type)
       (i :: k) (j :: k1) (k4 :: k2) (l :: k3).
f (Fix4 f) i j k4 l -> Fix4 f i j k4 l
In4 (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)
-- seems effective: blocks upstream coins from commuting down, but allows them to self factor
shallow (PutRegister ΣVar a1
σ CodeGen o a a1
p)            Fix4 (Instr o) (x : xs) ('Succ n) r a
m = do 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 a1
p (forall {k} {k1} {k2} {k3}
       (f :: (k -> k1 -> k2 -> k3 -> Type) -> k -> k1 -> k2 -> k3 -> Type)
       (i :: k) (j :: k1) (k4 :: k2) (l :: k3).
f (Fix4 f) i j k4 l -> Fix4 f i j k4 l
In4 (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 a1
σ (forall {k} {k1} {k2} {k3}
       (f :: (k -> k1 -> k2 -> k3 -> Type) -> k -> k1 -> k2 -> k3 -> Type)
       (i :: k) (j :: k1) (k4 :: k2) (l :: k3).
f (Fix4 f) i j k4 l -> Fix4 f i j k4 l
In4 (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 (forall a. Defunc a -> Defunc a
user Defunc ()
UNIT) (forall o (xs :: [Type]) (n :: Nat) r a.
Bool
-> Fix4 (Instr o) xs ('Succ n) r a
-> Fix4 (Instr o) xs ('Succ n) r a
blockCoins Bool
False Fix4 (Instr o) (x : xs) ('Succ n) r a
m)))))
shallow (Position PosSelector
sel)               Fix4 (Instr o) (x : xs) ('Succ n) r a
m = do forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall {k} {k1} {k2} {k3}
       (f :: (k -> k1 -> k2 -> k3 -> Type) -> k -> k1 -> k2 -> k3 -> Type)
       (i :: k) (j :: k1) (k4 :: k2) (l :: k3).
f (Fix4 f) i j k4 l -> Fix4 f i j k4 l
In4 (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
m)
shallow (Debug String
name CodeGen o a x
p)               Fix4 (Instr o) (x : xs) ('Succ n) r a
m = do forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall {k} {k1} {k2} {k3}
       (f :: (k -> k1 -> k2 -> k3 -> Type) -> k -> k1 -> k2 -> k3 -> Type)
       (i :: k) (j :: k1) (k4 :: k2) (l :: k3).
f (Fix4 f) i j k4 l -> Fix4 f i j k4 l
In4 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (k :: [Type] -> Nat -> Type -> Type -> Type) (xs :: [Type])
       (n1 :: Nat) r a o.
String
-> k xs ('Succ ('Succ n1)) r a -> Instr o k xs ('Succ n1) r a
LogEnter String
name) (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 (forall {k} {k1} {k2} {k3}
       (f :: (k -> k1 -> k2 -> k3 -> Type) -> k -> k1 -> k2 -> k3 -> Type)
       (i :: k) (j :: k1) (k4 :: k2) (l :: k3).
f (Fix4 f) i j k4 l -> Fix4 f i j k4 l
In4 (forall (k :: [Type] -> Nat -> Type -> Type -> Type) (xs :: [Type])
       (n1 :: Nat) r a o.
k xs n1 r a -> Instr o k xs ('Succ n1) r a
Commit (forall {k} {k1} {k2} {k3}
       (f :: (k -> k1 -> k2 -> k3 -> Type) -> k -> k1 -> k2 -> k3 -> Type)
       (i :: k) (j :: k1) (k4 :: k2) (l :: k3).
f (Fix4 f) i j k4 l -> Fix4 f i j k4 l
In4 (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)))))
-- make sure to issue the fence after `p` is generated, to allow for a (safe) single character factor
shallow (MetaCombinator MetaCombinator
Cut CodeGen o a x
p)       Fix4 (Instr o) (x : xs) ('Succ n) r a
m = do 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 (forall o (xs :: [Type]) (n :: Nat) r a.
Bool
-> Fix4 (Instr o) xs ('Succ n) r a
-> Fix4 (Instr o) xs ('Succ n) r a
blockCoins Bool
False (forall o (xs :: [Type]) (n :: Nat) r a.
Fix4 (Instr o) xs ('Succ n) r a -> Fix4 (Instr o) xs ('Succ n) r a
addCoinsNeeded Fix4 (Instr o) (x : xs) ('Succ n) r a
m))

-- 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 :: forall o (xs :: [Type]) (n :: Nat) r a.
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) = forall {k} {k1} {k2} {k3}
       (f :: (k -> k1 -> k2 -> k3 -> Type) -> k -> k1 -> k2 -> k3 -> Type)
       (i :: k) (j :: k1) (k4 :: k2) (l :: k3).
f (Fix4 f) i j k4 l -> Fix4 f i j k4 l
In4 forall o (k :: [Type] -> Nat -> Type -> Type -> Type) r (n :: Nat)
       a.
Instr o k '[r] n r a
Ret
deadCommitOptimisation Fix4 (Instr o) xs n r a
m         = forall {k} {k1} {k2} {k3}
       (f :: (k -> k1 -> k2 -> k3 -> Type) -> k -> k1 -> k2 -> k3 -> Type)
       (i :: k) (j :: k1) (k4 :: k2) (l :: k3).
f (Fix4 f) i j k4 l -> Fix4 f i j k4 l
In4 (forall (k :: [Type] -> Nat -> Type -> Type -> Type) (xs :: [Type])
       (n1 :: Nat) r a o.
k xs n1 r a -> Instr o k xs ('Succ n1) r a
Commit Fix4 (Instr o) xs n r a
m)

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

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

freshM :: CodeGenStack a -> CodeGenStack a
freshM :: forall a. CodeGenStack a -> CodeGenStack a
freshM = 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 forall x (m :: Type -> Type) a. MonadFresh x m => m a -> m a
newScope

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

makeΦ :: (Trace, ?flags :: Opt.Flags) => 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Φ :: forall o x (xs :: [Type]) (n :: Nat) r a.
(Trace, ?flags::Flags) =>
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
  | forall o (xs :: [Type]) (n :: Nat) r a.
(?flags::Flags) =>
Fix4 (Instr o) xs n r a -> Bool
shouldInline Fix4 (Instr o) (x : xs) ('Succ n) r a
m                = forall a. Trace => String -> a -> a
trace (String
"eliding " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Fix4 (Instr o) (x : xs) ('Succ n) r a
m) forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type) a. Monad m => a -> m a
return (forall a. a -> a
id, Fix4 (Instr o) (x : xs) ('Succ n) r a
m)
  | Flags -> Bool
Opt.factorAheadOfJoins ?flags::Flags
?flags = forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ΦVar x
φ -> (forall {k} {k1} {k2} {k3}
       (f :: (k -> k1 -> k2 -> k3 -> Type) -> k -> k1 -> k2 -> k3 -> Type)
       (i :: k) (j :: k1) (k4 :: k2) (l :: k3).
f (Fix4 f) i j k4 l -> Fix4 f i j k4 l
In4 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
φ (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), 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 (forall {k} {k1} {k2} {k3}
       (f :: (k -> k1 -> k2 -> k3 -> Type) -> k -> k1 -> k2 -> k3 -> Type)
       (i :: k) (j :: k1) (k4 :: k2) (l :: k3).
f (Fix4 f) i j k4 l -> Fix4 f i j k4 l
In4 (forall x o (k :: [Type] -> Nat -> Type -> Type -> Type)
       (xs1 :: [Type]) (n :: Nat) r a.
ΦVar x -> Instr o k (x : xs1) n r a
Join ΦVar x
φ)))) forall a. CodeGenStack (ΦVar a)
askΦ
  | Bool
otherwise                     = forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ΦVar x
φ -> (forall {k} {k1} {k2} {k3}
       (f :: (k -> k1 -> k2 -> k3 -> Type) -> k -> k1 -> k2 -> k3 -> Type)
       (i :: k) (j :: k1) (k4 :: k2) (l :: k3).
f (Fix4 f) i j k4 l -> Fix4 f i j k4 l
In4 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
φ (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
n Fix4 (Instr o) (x : xs) ('Succ n) r a
m), forall {k} {k1} {k2} {k3}
       (f :: (k -> k1 -> k2 -> k3 -> Type) -> k -> k1 -> k2 -> k3 -> Type)
       (i :: k) (j :: k1) (k4 :: k2) (l :: k3).
f (Fix4 f) i j k4 l -> Fix4 f i j k4 l
In4 (forall x o (k :: [Type] -> Nat -> Type -> Type -> Type)
       (xs1 :: [Type]) (n :: Nat) r a.
ΦVar x -> Instr o k (x : xs1) n r a
Join ΦVar x
φ))) forall a. CodeGenStack (ΦVar a)
askΦ
  where n :: Coins
n = 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