{-# OPTIONS_GHC -Wno-monomorphism-restriction #-}
{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE AllowAmbiguousTypes,
ConstrainedClassMethods,
ConstraintKinds,
ImplicitParams,
MagicHash,
NamedFieldPuns,
PatternSynonyms,
RecordWildCards,
TypeApplications #-}
module Parsley.Internal.Backend.Machine.Ops (
dup, returnST,
sat, emitLengthCheck,
newΣ, writeΣ, readΣ,
fatal, raise,
buildHandler, buildYesHandler,
bindAlwaysHandler, bindSameHandler,
halt, noreturn,
resume, callWithContinuation,
suspend,
setupJoinPoint,
buildIterAlways,
buildIterSame,
buildRec,
dynHandler, dynCont,
logHandler, preludeString,
Ops, LogHandler, StaHandlerBuilder,
HandlerOps, JoinBuilder, RecBuilder, PositionOps, MarshalOps, LogOps
) where
import Control.Monad (liftM2)
import Control.Monad.Reader (ask, local)
import Control.Monad.ST (ST)
import Data.STRef (writeSTRef, readSTRef, newSTRef)
import Data.Void (Void)
import Debug.Trace (trace)
import GHC.Exts (Int(..), (-#))
import Language.Haskell.TH.Syntax (liftTyped)
import Parsley.Internal.Backend.Machine.BindingOps
import Parsley.Internal.Backend.Machine.Defunc (Defunc(OFFSET), genDefunc, _if, pattern FREEVAR)
import Parsley.Internal.Backend.Machine.Identifiers (MVar, ΦVar, ΣVar)
import Parsley.Internal.Backend.Machine.InputOps (PositionOps(..), LogOps(..), InputOps, next, more)
import Parsley.Internal.Backend.Machine.InputRep (Rep)
import Parsley.Internal.Backend.Machine.Instructions (Access(..))
import Parsley.Internal.Backend.Machine.LetBindings (Regs(..))
import Parsley.Internal.Backend.Machine.Types (MachineMonad, Machine(..), run)
import Parsley.Internal.Backend.Machine.Types.Context
import Parsley.Internal.Backend.Machine.Types.Dynamics (DynFunc, DynCont, DynHandler)
import Parsley.Internal.Backend.Machine.Types.Offset (Offset(..), moveOne, mkOffset)
import Parsley.Internal.Backend.Machine.Types.State (Γ(..), OpStack(..))
import Parsley.Internal.Backend.Machine.Types.Statics
import Parsley.Internal.Common (One, Code, Vec(..), Nat(..))
import System.Console.Pretty (color, Color(Green, White, Red, Blue))
dup :: Defunc x -> (Defunc x -> Code r) -> Code r
dup :: Defunc x -> (Defunc x -> Code r) -> Code r
dup (FREEVAR Code x
x) Defunc x -> Code r
k = Defunc x -> Code r
k (Code x -> Defunc x
forall a. Code a -> Defunc a
FREEVAR Code x
x)
dup (OFFSET Offset x
o) Defunc x -> Code r
k = Defunc x -> Code r
k (Offset x -> Defunc x
forall o. Offset o -> Defunc o
OFFSET Offset x
o)
dup Defunc x
x Defunc x -> Code r
k = [|| let !dupx = $$(genDefunc x) in $$(k (FREEVAR [||dupx||])) ||]
{-# INLINE returnST #-}
returnST :: forall s a. a -> ST s a
returnST :: a -> ST s a
returnST = forall a. Monad (ST s) => a -> ST s a
forall (m :: Type -> Type) a. Monad m => a -> m a
return @(ST s)
sat :: (?ops :: InputOps (Rep o))
=> (Defunc Char -> Defunc Bool)
-> (Γ s o (Char : xs) n r a -> Code b)
-> Code b
-> Γ s o xs n r a
-> Code b
sat :: (Defunc Char -> Defunc Bool)
-> (Γ s o (Char : xs) n r a -> Code b)
-> Code b
-> Γ s o xs n r a
-> Code b
sat Defunc Char -> Defunc Bool
p Γ s o (Char : xs) n r a -> Code b
k Code b
bad γ :: Γ s o xs n r a
γ@Γ{Vec n (StaHandler s o a)
Offset o
StaCont s o a r
OpStack xs
handlers :: forall s o (xs :: [Type]) (n :: Nat) r a.
Γ s o xs n r a -> Vec n (StaHandler s o a)
input :: forall s o (xs :: [Type]) (n :: Nat) r a.
Γ s o xs n r a -> Offset o
retCont :: forall s o (xs :: [Type]) (n :: Nat) r a.
Γ s o xs n r a -> StaCont s o a r
operands :: forall s o (xs :: [Type]) (n :: Nat) r a.
Γ s o xs n r a -> OpStack xs
handlers :: Vec n (StaHandler s o a)
input :: Offset o
retCont :: StaCont s o a r
operands :: OpStack xs
..} = Code (Rep o) -> (Code Char -> Code (Rep o) -> Code b) -> Code b
forall rep a.
(?ops::InputOps rep) =>
Code rep -> (Code Char -> Code rep -> Code a) -> Code a
next (Offset o -> Code (Rep o)
forall o. Offset o -> Code (Rep o)
offset Offset o
input) ((Code Char -> Code (Rep o) -> Code b) -> Code b)
-> (Code Char -> Code (Rep o) -> Code b) -> Code b
forall a b. (a -> b) -> a -> b
$ \Code Char
c Code (Rep o)
offset' -> let v :: Defunc Char
v = Code Char -> Defunc Char
forall a. Code a -> Defunc a
FREEVAR Code Char
c in Defunc Bool -> Code b -> Code b -> Code b
forall a. Defunc Bool -> Code a -> Code a -> Code a
_if (Defunc Char -> Defunc Bool
p Defunc Char
v) (Γ s o (Char : xs) n r a -> Code b
k (Γ s o xs n r a
γ {operands :: OpStack (Char : xs)
operands = Defunc Char -> OpStack xs -> OpStack (Char : xs)
forall x (xs :: [Type]). Defunc x -> OpStack xs -> OpStack (x : xs)
Op Defunc Char
v OpStack xs
operands, input :: Offset o
input = Offset o -> Code (Rep o) -> Offset o
forall o. Offset o -> Code (Rep o) -> Offset o
moveOne Offset o
input Code (Rep o)
offset'})) Code b
bad
emitLengthCheck :: (?ops :: InputOps (Rep o), PositionOps (Rep o))
=> Int
-> Code a
-> Code a
-> Offset o
-> Code a
emitLengthCheck :: Int -> Code a -> Code a -> Offset o -> Code a
emitLengthCheck Int
0 Code a
good Code a
_ Offset o
_ = Code a
good
emitLengthCheck Int
1 Code a
good Code a
bad Offset o
input = [|| if $$(more (offset input)) then $$good else $$bad ||]
emitLengthCheck (I# Int#
n) Code a
good Code a
bad Offset o
input = [||
if $$(more (shiftRight (offset input) (liftTyped (n -# 1#)))) then $$good
else $$bad ||]
newΣ :: ΣVar x -> Access -> Defunc x -> (Ctx s o a -> Code (ST s r)) -> Ctx s o a -> Code (ST s r)
newΣ :: ΣVar x
-> Access
-> Defunc x
-> (Ctx s o a -> Code (ST s r))
-> Ctx s o a
-> Code (ST s r)
newΣ ΣVar x
σ Access
Soft Defunc x
x Ctx s o a -> Code (ST s r)
k Ctx s o a
ctx = Defunc x -> (Defunc x -> Code (ST s r)) -> Code (ST s r)
forall x r. Defunc x -> (Defunc x -> Code r) -> Code r
dup Defunc x
x ((Defunc x -> Code (ST s r)) -> Code (ST s r))
-> (Defunc x -> Code (ST s r)) -> Code (ST s r)
forall a b. (a -> b) -> a -> b
$ \Defunc x
dupx -> Ctx s o a -> Code (ST s r)
k (ΣVar x
-> Maybe (Code (STRef s x)) -> Defunc x -> Ctx s o a -> Ctx s o a
forall x s o a.
ΣVar x
-> Maybe (Code (STRef s x)) -> Defunc x -> Ctx s o a -> Ctx s o a
insertNewΣ ΣVar x
σ Maybe (Code (STRef s x))
forall a. Maybe a
Nothing Defunc x
dupx Ctx s o a
ctx)
newΣ ΣVar x
σ Access
Hard Defunc x
x Ctx s o a -> Code (ST s r)
k Ctx s o a
ctx = Defunc x -> (Defunc x -> Code (ST s r)) -> Code (ST s r)
forall x r. Defunc x -> (Defunc x -> Code r) -> Code r
dup Defunc x
x ((Defunc x -> Code (ST s r)) -> Code (ST s r))
-> (Defunc x -> Code (ST s r)) -> Code (ST s r)
forall a b. (a -> b) -> a -> b
$ \Defunc x
dupx -> [||
do ref <- newSTRef $$(genDefunc dupx)
$$(k (insertNewΣ σ (Just [||ref||]) dupx ctx))
||]
writeΣ :: ΣVar x -> Access -> Defunc x -> (Ctx s o a -> Code (ST s r)) -> Ctx s o a -> Code (ST s r)
writeΣ :: ΣVar x
-> Access
-> Defunc x
-> (Ctx s o a -> Code (ST s r))
-> Ctx s o a
-> Code (ST s r)
writeΣ ΣVar x
σ Access
Soft Defunc x
x Ctx s o a -> Code (ST s r)
k Ctx s o a
ctx = Defunc x -> (Defunc x -> Code (ST s r)) -> Code (ST s r)
forall x r. Defunc x -> (Defunc x -> Code r) -> Code r
dup Defunc x
x ((Defunc x -> Code (ST s r)) -> Code (ST s r))
-> (Defunc x -> Code (ST s r)) -> Code (ST s r)
forall a b. (a -> b) -> a -> b
$ \Defunc x
dupx -> Ctx s o a -> Code (ST s r)
k (ΣVar x -> Defunc x -> Ctx s o a -> Ctx s o a
forall x s o a. ΣVar x -> Defunc x -> Ctx s o a -> Ctx s o a
cacheΣ ΣVar x
σ Defunc x
dupx Ctx s o a
ctx)
writeΣ ΣVar x
σ Access
Hard Defunc x
x Ctx s o a -> Code (ST s r)
k Ctx s o a
ctx = let ref :: Code (STRef s x)
ref = ΣVar x -> Ctx s o a -> Code (STRef s x)
forall x s o a. ΣVar x -> Ctx s o a -> Code (STRef s x)
concreteΣ ΣVar x
σ Ctx s o a
ctx in Defunc x -> (Defunc x -> Code (ST s r)) -> Code (ST s r)
forall x r. Defunc x -> (Defunc x -> Code r) -> Code r
dup Defunc x
x ((Defunc x -> Code (ST s r)) -> Code (ST s r))
-> (Defunc x -> Code (ST s r)) -> Code (ST s r)
forall a b. (a -> b) -> a -> b
$ \Defunc x
dupx -> [||
do writeSTRef $$ref $$(genDefunc dupx)
$$(k (cacheΣ σ dupx ctx))
||]
readΣ :: ΣVar x -> Access -> (Defunc x -> Ctx s o a -> Code (ST s r)) -> Ctx s o a -> Code (ST s r)
readΣ :: ΣVar x
-> Access
-> (Defunc x -> Ctx s o a -> Code (ST s r))
-> Ctx s o a
-> Code (ST s r)
readΣ ΣVar x
σ Access
Soft Defunc x -> Ctx s o a -> Code (ST s r)
k Ctx s o a
ctx = Defunc x -> Ctx s o a -> Code (ST s r)
k (ΣVar x -> Ctx s o a -> Defunc x
forall x s o a. ΣVar x -> Ctx s o a -> Defunc x
cachedΣ ΣVar x
σ Ctx s o a
ctx) Ctx s o a
ctx
readΣ ΣVar x
σ Access
Hard Defunc x -> Ctx s o a -> Code (ST s r)
k Ctx s o a
ctx = let ref :: Code (STRef s x)
ref = ΣVar x -> Ctx s o a -> Code (STRef s x)
forall x s o a. ΣVar x -> Ctx s o a -> Code (STRef s x)
concreteΣ ΣVar x
σ Ctx s o a
ctx in [||
do x <- readSTRef $$ref
$$(let fv = FREEVAR [||x||] in k fv (cacheΣ σ fv ctx))
||]
fatal :: StaHandler s o a
fatal :: StaHandler s o a
fatal = StaHandler# s o a -> StaHandler s o a
forall s o a. StaHandler# s o a -> StaHandler s o a
mkStaHandlerNoOffset (Q (TExp (ST s (Maybe a))) -> StaHandler# s o a
forall a b. a -> b -> a
const [|| returnST Nothing ||])
raise :: Γ s o xs (Succ n) r a -> Code (ST s (Maybe a))
raise :: Γ s o xs ('Succ n) r a -> Code (ST s (Maybe a))
raise Γ s o xs ('Succ n) r a
γ = let VCons StaHandler s o a
h Vec n (StaHandler s o a)
_ = Γ s o xs ('Succ n) r a -> Vec ('Succ n) (StaHandler s o a)
forall s o (xs :: [Type]) (n :: Nat) r a.
Γ s o xs n r a -> Vec n (StaHandler s o a)
handlers Γ s o xs ('Succ n) r a
γ in StaHandler s o a -> Offset o -> Code (ST s (Maybe a))
forall s o a. StaHandler s o a -> Offset o -> Code (ST s (Maybe a))
staHandlerEval StaHandler s o a
h (Γ s o xs ('Succ n) r a -> Offset o
forall s o (xs :: [Type]) (n :: Nat) r a.
Γ s o xs n r a -> Offset o
input Γ s o xs ('Succ n) r a
γ)
buildHandler :: Γ s o xs n r a
-> (Γ s o (o : xs) n r a -> Code (ST s (Maybe a)))
-> Word
-> StaHandlerBuilder s o a
buildHandler :: Γ s o xs n r a
-> (Γ s o (o : xs) n r a -> Code (ST s (Maybe a)))
-> Word
-> StaHandlerBuilder s o a
buildHandler Γ s o xs n r a
γ Γ s o (o : xs) n r a -> Code (ST s (Maybe a))
h Word
u Offset o
c = Offset o -> StaHandler# s o a -> StaHandler s o a
forall o s a. Offset o -> StaHandler# s o a -> StaHandler s o a
mkStaHandler Offset o
c (StaHandler# s o a -> StaHandler s o a)
-> StaHandler# s o a -> StaHandler s o a
forall a b. (a -> b) -> a -> b
$ \Code (Rep o)
o# -> Γ s o (o : xs) n r a -> Code (ST s (Maybe a))
h (Γ s o xs n r a
γ {operands :: OpStack (o : xs)
operands = Defunc o -> OpStack xs -> OpStack (o : xs)
forall x (xs :: [Type]). Defunc x -> OpStack xs -> OpStack (x : xs)
Op (Offset o -> Defunc o
forall o. Offset o -> Defunc o
OFFSET Offset o
c) (Γ s o xs n r a -> OpStack xs
forall s o (xs :: [Type]) (n :: Nat) r a.
Γ s o xs n r a -> OpStack xs
operands Γ s o xs n r a
γ), input :: Offset o
input = Code (Rep o) -> Word -> Offset o
forall o. Code (Rep o) -> Word -> Offset o
mkOffset Code (Rep o)
o# Word
u})
buildYesHandler :: Γ s o xs n r a
-> (Γ s o xs n r a -> Code (ST s (Maybe a)))
-> Word
-> StaHandler s o a
buildYesHandler :: Γ s o xs n r a
-> (Γ s o xs n r a -> Code (ST s (Maybe a)))
-> Word
-> StaHandler s o a
buildYesHandler Γ s o xs n r a
γ Γ s o xs n r a -> Code (ST s (Maybe a))
h Word
u = StaHandler# s o a -> StaHandler s o a
forall s o a. StaHandler# s o a -> StaHandler s o a
mkStaHandlerNoOffset (StaHandler# s o a -> StaHandler s o a)
-> StaHandler# s o a -> StaHandler s o a
forall a b. (a -> b) -> a -> b
$ \Code (Rep o)
o# -> Γ s o xs n r a -> Code (ST s (Maybe a))
h (Γ s o xs n r a
γ {input :: Offset o
input = Code (Rep o) -> Word -> Offset o
forall o. Code (Rep o) -> Word -> Offset o
mkOffset Code (Rep o)
o# Word
u})
bindAlwaysHandler :: forall s o xs n r a b. HandlerOps o
=> Γ s o xs n r a
-> StaHandlerBuilder s o a
-> (Γ s o xs (Succ n) r a -> Code b)
-> Code b
bindAlwaysHandler :: Γ s o xs n r a
-> StaHandlerBuilder s o a
-> (Γ s o xs ('Succ n) r a -> Code b)
-> Code b
bindAlwaysHandler Γ s o xs n r a
γ StaHandlerBuilder s o a
h Γ s o xs ('Succ n) r a -> Code b
k = StaHandler# s o a -> (DynHandler s o a -> Code b) -> Code b
forall o s a b.
HandlerOps o =>
StaHandler# s o a -> (DynHandler s o a -> Code b) -> Code b
bindHandler# @o (StaHandler s o a -> StaHandler# s o a
forall s o a. StaHandler s o a -> StaHandler# s o a
staHandler# (StaHandlerBuilder s o a
h (Γ s o xs n r a -> Offset o
forall s o (xs :: [Type]) (n :: Nat) r a.
Γ s o xs n r a -> Offset o
input Γ s o xs n r a
γ))) ((DynHandler s o a -> Code b) -> Code b)
-> (DynHandler s o a -> Code b) -> Code b
forall a b. (a -> b) -> a -> b
$ \DynHandler s o a
qh ->
Γ s o xs ('Succ n) r a -> Code b
k (Γ s o xs n r a
γ {handlers :: Vec ('Succ n) (StaHandler s o a)
handlers = StaHandler s o a
-> Vec n (StaHandler s o a) -> Vec ('Succ n) (StaHandler s o a)
forall a (n :: Nat). a -> Vec n a -> Vec ('Succ n) a
VCons (Maybe (Offset o) -> DynHandler s o a -> StaHandler s o a
forall s o a.
Maybe (Offset o) -> DynHandler s o a -> StaHandler s o a
mkStaHandlerDyn (Offset o -> Maybe (Offset o)
forall a. a -> Maybe a
Just (Γ s o xs n r a -> Offset o
forall s o (xs :: [Type]) (n :: Nat) r a.
Γ s o xs n r a -> Offset o
input Γ s o xs n r a
γ)) DynHandler s o a
qh) (Γ s o xs n r a -> Vec n (StaHandler s o a)
forall s o (xs :: [Type]) (n :: Nat) r a.
Γ s o xs n r a -> Vec n (StaHandler s o a)
handlers Γ s o xs n r a
γ)})
bindSameHandler :: forall s o xs n r a b. (HandlerOps o, PositionOps (Rep o))
=> Γ s o xs n r a
-> StaHandler s o a
-> StaHandlerBuilder s o a
-> (Γ s o xs (Succ n) r a -> Code b)
-> Code b
bindSameHandler :: Γ s o xs n r a
-> StaHandler s o a
-> StaHandlerBuilder s o a
-> (Γ s o xs ('Succ n) r a -> Code b)
-> Code b
bindSameHandler Γ s o xs n r a
γ StaHandler s o a
yes StaHandlerBuilder s o a
no Γ s o xs ('Succ n) r a -> Code b
k = [||
let yesSame = $$(staHandler# yes (offset (input γ)))
in $$(bindHandler# @o (staHandler# (no (input γ))) $ \qno ->
let handler = mkStaHandler (input γ) $ \o ->
[||if $$(same (offset (input γ)) o) then yesSame else $$qno $$o||]
in bindHandler# @o (staHandler# handler) $ \qhandler ->
k (γ {handlers = VCons (mkStaHandlerFull (input γ) qhandler [||yesSame||] qno) (handlers γ)}))
||]
halt :: StaCont s o a a
halt :: StaCont s o a a
halt = StaCont# s o a a -> StaCont s o a a
forall s o a x. StaCont# s o a x -> StaCont s o a x
mkStaCont (StaCont# s o a a -> StaCont s o a a)
-> StaCont# s o a a -> StaCont s o a a
forall a b. (a -> b) -> a -> b
$ \Code a
x Code (Rep o)
_ -> [||returnST (Just $$x)||]
noreturn :: StaCont s o a Void
noreturn :: StaCont s o a Void
noreturn = StaCont# s o a Void -> StaCont s o a Void
forall s o a x. StaCont# s o a x -> StaCont s o a x
mkStaCont (StaCont# s o a Void -> StaCont s o a Void)
-> StaCont# s o a Void -> StaCont s o a Void
forall a b. (a -> b) -> a -> b
$ \Code Void
_ Code (Rep o)
_ -> [||error "Return is not permitted here"||]
resume :: StaCont s o a x -> Γ s o (x : xs) n r a -> Code (ST s (Maybe a))
resume :: StaCont s o a x -> Γ s o (x : xs) n r a -> Code (ST s (Maybe a))
resume StaCont s o a x
k Γ s o (x : xs) n r a
γ = let Op Defunc x
x OpStack xs
_ = Γ s o (x : xs) n r a -> OpStack (x : xs)
forall s o (xs :: [Type]) (n :: Nat) r a.
Γ s o xs n r a -> OpStack xs
operands Γ s o (x : xs) n r a
γ in StaCont s o a x -> StaCont# s o a x
forall s o a x. StaCont s o a x -> StaCont# s o a x
staCont# StaCont s o a x
k (Defunc x -> Code x
forall a. Defunc a -> Code a
genDefunc Defunc x
x) (Offset o -> Code (Rep o)
forall o. Offset o -> Code (Rep o)
offset (Γ s o (x : xs) n r a -> Offset o
forall s o (xs :: [Type]) (n :: Nat) r a.
Γ s o xs n r a -> Offset o
input Γ s o (x : xs) n r a
γ))
callWithContinuation :: MarshalOps o
=> StaSubroutine s o a x
-> StaCont s o a x
-> Code (Rep o)
-> Vec (Succ n) (StaHandler s o a)
-> Code (ST s (Maybe a))
callWithContinuation :: StaSubroutine s o a x
-> StaCont s o a x
-> Code (Rep o)
-> Vec ('Succ n) (StaHandler s o a)
-> Code (ST s (Maybe a))
callWithContinuation StaSubroutine s o a x
sub StaCont s o a x
ret Code (Rep o)
input (VCons StaHandler s o a
h Vec n (StaHandler s o a)
_) = StaSubroutine s o a x
sub (StaCont s o a x -> DynCont s o a x
forall s o a x. MarshalOps o => StaCont s o a x -> DynCont s o a x
dynCont StaCont s o a x
ret) Code (Rep o)
input (StaHandler s o a -> DynHandler s o a
forall s o a. MarshalOps o => StaHandler s o a -> DynHandler s o a
dynHandler StaHandler s o a
h)
suspend :: (Γ s o (x : xs) n r a -> Code (ST s (Maybe a)))
-> Γ s o xs n r a
-> Word
-> StaCont s o a x
suspend :: (Γ s o (x : xs) n r a -> Code (ST s (Maybe a)))
-> Γ s o xs n r a -> Word -> StaCont s o a x
suspend Γ s o (x : xs) n r a -> Code (ST s (Maybe a))
m Γ s o xs n r a
γ Word
u = StaCont# s o a x -> StaCont s o a x
forall s o a x. StaCont# s o a x -> StaCont s o a x
mkStaCont (StaCont# s o a x -> StaCont s o a x)
-> StaCont# s o a x -> StaCont s o a x
forall a b. (a -> b) -> a -> b
$ \Code x
x Code (Rep o)
o# -> Γ s o (x : xs) n r a -> Code (ST s (Maybe a))
m (Γ s o xs n r a
γ {operands :: OpStack (x : xs)
operands = Defunc x -> OpStack xs -> OpStack (x : xs)
forall x (xs :: [Type]). Defunc x -> OpStack xs -> OpStack (x : xs)
Op (Code x -> Defunc x
forall a. Code a -> Defunc a
FREEVAR Code x
x) (Γ s o xs n r a -> OpStack xs
forall s o (xs :: [Type]) (n :: Nat) r a.
Γ s o xs n r a -> OpStack xs
operands Γ s o xs n r a
γ), input :: Offset o
input = Code (Rep o) -> Word -> Offset o
forall o. Code (Rep o) -> Word -> Offset o
mkOffset Code (Rep o)
o# Word
u})
setupJoinPoint :: forall s o xs n r a x. JoinBuilder o
=> ΦVar x
-> Machine s o (x : xs) n r a
-> Machine s o xs n r a
-> MachineMonad s o xs n r a
setupJoinPoint :: ΦVar x
-> Machine s o (x : xs) n r a
-> Machine s o xs n r a
-> MachineMonad s o xs n r a
setupJoinPoint ΦVar x
φ (Machine MachineMonad s o (x : xs) n r a
k) Machine s o xs n r a
mx = (Word -> MachineMonad s o xs n r a) -> MachineMonad s o xs n r a
forall s o a (m :: Type -> Type) b.
MonadReader (Ctx s o a) m =>
(Word -> m b) -> m b
freshUnique ((Word -> MachineMonad s o xs n r a) -> MachineMonad s o xs n r a)
-> (Word -> MachineMonad s o xs n r a) -> MachineMonad s o xs n r a
forall a b. (a -> b) -> a -> b
$ \Word
u ->
((Γ s o (x : xs) n r a -> Code (ST s (Maybe a)))
-> Ctx s o a -> Γ s o xs n r a -> Code (ST s (Maybe a)))
-> MachineMonad s o (x : xs) n r a
-> ReaderT (Ctx s o a) Identity (Ctx s o a)
-> MachineMonad s o xs n r a
forall (m :: Type -> Type) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (\Γ s o (x : xs) n r a -> Code (ST s (Maybe a))
mk Ctx s o a
ctx Γ s o xs n r a
γ ->
StaCont# s o a x
-> (DynCont s o a x -> Code (ST s (Maybe a)))
-> Code (ST s (Maybe a))
forall o s a x b.
JoinBuilder o =>
StaCont# s o a x -> (DynCont s o a x -> Code b) -> Code b
setupJoinPoint# @o
(\Code x
qx Code (Rep o)
qo# -> Γ s o (x : xs) n r a -> Code (ST s (Maybe a))
mk (Γ s o xs n r a
γ {operands :: OpStack (x : xs)
operands = Defunc x -> OpStack xs -> OpStack (x : xs)
forall x (xs :: [Type]). Defunc x -> OpStack xs -> OpStack (x : xs)
Op (Code x -> Defunc x
forall a. Code a -> Defunc a
FREEVAR Code x
qx) (Γ s o xs n r a -> OpStack xs
forall s o (xs :: [Type]) (n :: Nat) r a.
Γ s o xs n r a -> OpStack xs
operands Γ s o xs n r a
γ), input :: Offset o
input = Code (Rep o) -> Word -> Offset o
forall o. Code (Rep o) -> Word -> Offset o
mkOffset Code (Rep o)
qo# Word
u}))
(\DynCont s o a x
qjoin -> Machine s o xs n r a
-> Γ s o xs n r a -> Ctx s o a -> Code (ST s (Maybe a))
forall s o (xs :: [Type]) (n :: Nat) r a.
Machine s o xs n r a
-> Γ s o xs n r a -> Ctx s o a -> Code (ST s (Maybe a))
run Machine s o xs n r a
mx Γ s o xs n r a
γ (ΦVar x -> StaCont s o a x -> Ctx s o a -> Ctx s o a
forall x s o a. ΦVar x -> StaCont s o a x -> Ctx s o a -> Ctx s o a
insertΦ ΦVar x
φ (DynCont s o a x -> StaCont s o a x
forall s o a x. DynCont s o a x -> StaCont s o a x
mkStaContDyn DynCont s o a x
qjoin) Ctx s o a
ctx)))
((Ctx s o a -> Ctx s o a)
-> MachineMonad s o (x : xs) n r a
-> MachineMonad s o (x : xs) n r a
forall r (m :: Type -> Type) a.
MonadReader r m =>
(r -> r) -> m a -> m a
local Ctx s o a -> Ctx s o a
forall s o a. Ctx s o a -> Ctx s o a
voidCoins MachineMonad s o (x : xs) n r a
k) ReaderT (Ctx s o a) Identity (Ctx s o a)
forall r (m :: Type -> Type). MonadReader r m => m r
ask
buildIterAlways :: forall s o a. RecBuilder o
=> Ctx s o a
-> MVar Void
-> Machine s o '[] One Void a
-> StaHandlerBuilder s o a
-> Offset o
-> Word
-> Code (ST s (Maybe a))
buildIterAlways :: Ctx s o a
-> MVar Void
-> Machine s o '[] One Void a
-> StaHandlerBuilder s o a
-> Offset o
-> Word
-> Code (ST s (Maybe a))
buildIterAlways Ctx s o a
ctx MVar Void
μ Machine s o '[] One Void a
l StaHandlerBuilder s o a
h Offset o
o Word
u =
(Code (Rep o) -> StaHandler# s o a)
-> (Code (Rep o -> Handler# s o a) -> Code (ST s (Maybe a)))
-> Code (ST s (Maybe a))
forall o s a b.
RecBuilder o =>
(Code (Rep o) -> StaHandler# s o a)
-> (Code (Rep o -> Handler# s o a) -> Code b) -> Code b
bindIterHandler# @o (\Code (Rep o)
qc# -> StaHandler s o a -> StaHandler# s o a
forall s o a. StaHandler s o a -> StaHandler# s o a
staHandler# (StaHandlerBuilder s o a
h (Code (Rep o) -> Word -> Offset o
forall o. Code (Rep o) -> Word -> Offset o
mkOffset Code (Rep o)
qc# Word
u))) ((Code (Rep o -> Handler# s o a) -> Code (ST s (Maybe a)))
-> Code (ST s (Maybe a)))
-> (Code (Rep o -> Handler# s o a) -> Code (ST s (Maybe a)))
-> Code (ST s (Maybe a))
forall a b. (a -> b) -> a -> b
$ \Code (Rep o -> Handler# s o a)
qhandler ->
Code (Rep o)
-> (DynHandler s o a -> StaHandler# s o a) -> Code (ST s (Maybe a))
forall o s a.
RecBuilder o =>
Code (Rep o)
-> (DynHandler s o a -> Code (Rep o) -> Code (ST s (Maybe a)))
-> Code (ST s (Maybe a))
bindIter# @o (Offset o -> Code (Rep o)
forall o. Offset o -> Code (Rep o)
offset Offset o
o) ((DynHandler s o a -> StaHandler# s o a) -> Code (ST s (Maybe a)))
-> (DynHandler s o a -> StaHandler# s o a) -> Code (ST s (Maybe a))
forall a b. (a -> b) -> a -> b
$ \DynHandler s o a
qloop Code (Rep o)
qo# ->
let off :: Offset o
off = Code (Rep o) -> Word -> Offset o
forall o. Code (Rep o) -> Word -> Offset o
mkOffset Code (Rep o)
qo# Word
u
in Machine s o '[] One Void a
-> Γ s o '[] One Void a -> Ctx s o a -> Code (ST s (Maybe a))
forall s o (xs :: [Type]) (n :: Nat) r a.
Machine s o xs n r a
-> Γ s o xs n r a -> Ctx s o a -> Code (ST s (Maybe a))
run Machine s o '[] One Void a
l (OpStack '[]
-> StaCont s o a Void
-> Offset o
-> Vec One (StaHandler s o a)
-> Γ s o '[] One Void a
forall s o (xs :: [Type]) (n :: Nat) r a.
OpStack xs
-> StaCont s o a r
-> Offset o
-> Vec n (StaHandler s o a)
-> Γ s o xs n r a
Γ OpStack '[]
Empty StaCont s o a Void
forall s o a. StaCont s o a Void
noreturn Offset o
off (StaHandler s o a
-> Vec 'Zero (StaHandler s o a) -> Vec One (StaHandler s o a)
forall a (n :: Nat). a -> Vec n a -> Vec ('Succ n) a
VCons (Maybe (Offset o) -> DynHandler s o a -> StaHandler s o a
forall s o a.
Maybe (Offset o) -> DynHandler s o a -> StaHandler s o a
mkStaHandlerDyn (Offset o -> Maybe (Offset o)
forall a. a -> Maybe a
Just Offset o
off) [||$$qhandler $$(qo#)||]) Vec 'Zero (StaHandler s o a)
forall a. Vec 'Zero a
VNil))
(Ctx s o a -> Ctx s o a
forall s o a. Ctx s o a -> Ctx s o a
voidCoins (MVar Void -> StaSubroutine s o a Void -> Ctx s o a -> Ctx s o a
forall x s o a.
MVar x -> StaSubroutine s o a x -> Ctx s o a -> Ctx s o a
insertSub MVar Void
μ (\DynCont s o a Void
_ Code (Rep o)
o# DynHandler s o a
_ -> [|| $$qloop $$(o#) ||]) Ctx s o a
ctx))
buildIterSame :: forall s o a. (RecBuilder o, HandlerOps o, PositionOps (Rep o))
=> Ctx s o a
-> MVar Void
-> Machine s o '[] One Void a
-> StaHandler s o a
-> StaHandlerBuilder s o a
-> Offset o
-> Word
-> Code (ST s (Maybe a))
buildIterSame :: Ctx s o a
-> MVar Void
-> Machine s o '[] One Void a
-> StaHandler s o a
-> StaHandlerBuilder s o a
-> Offset o
-> Word
-> Code (ST s (Maybe a))
buildIterSame Ctx s o a
ctx MVar Void
μ Machine s o '[] One Void a
l StaHandler s o a
yes StaHandlerBuilder s o a
no Offset o
o Word
u =
StaHandler# s o a
-> (DynHandler s o a -> Code (ST s (Maybe a)))
-> Code (ST s (Maybe a))
forall o s a b.
HandlerOps o =>
StaHandler# s o a -> (DynHandler s o a -> Code b) -> Code b
bindHandler# @o (StaHandler s o a -> StaHandler# s o a
forall s o a. StaHandler s o a -> StaHandler# s o a
staHandler# StaHandler s o a
yes) ((DynHandler s o a -> Code (ST s (Maybe a)))
-> Code (ST s (Maybe a)))
-> (DynHandler s o a -> Code (ST s (Maybe a)))
-> Code (ST s (Maybe a))
forall a b. (a -> b) -> a -> b
$ \DynHandler s o a
qyes ->
(Code (Rep o) -> StaHandler# s o a)
-> (Code (Rep o -> Handler# s o a) -> Code (ST s (Maybe a)))
-> Code (ST s (Maybe a))
forall o s a b.
RecBuilder o =>
(Code (Rep o) -> StaHandler# s o a)
-> (Code (Rep o -> Handler# s o a) -> Code b) -> Code b
bindIterHandler# @o (\Code (Rep o)
qc# -> StaHandler s o a -> StaHandler# s o a
forall s o a. StaHandler s o a -> StaHandler# s o a
staHandler# (StaHandlerBuilder s o a
no (Code (Rep o) -> Word -> Offset o
forall o. Code (Rep o) -> Word -> Offset o
mkOffset Code (Rep o)
qc# Word
u))) ((Code (Rep o -> Handler# s o a) -> Code (ST s (Maybe a)))
-> Code (ST s (Maybe a)))
-> (Code (Rep o -> Handler# s o a) -> Code (ST s (Maybe a)))
-> Code (ST s (Maybe a))
forall a b. (a -> b) -> a -> b
$ \Code (Rep o -> Handler# s o a)
qno ->
let handler :: Code (Rep o) -> StaHandler s o a
handler Code (Rep o)
qc# = Offset o -> StaHandler# s o a -> StaHandler s o a
forall o s a. Offset o -> StaHandler# s o a -> StaHandler s o a
mkStaHandler (Code (Rep o) -> Word -> Offset o
forall o. Code (Rep o) -> Word -> Offset o
mkOffset @o Code (Rep o)
qc# Word
u) (StaHandler# s o a -> StaHandler s o a)
-> StaHandler# s o a -> StaHandler s o a
forall a b. (a -> b) -> a -> b
$ \Code (Rep o)
o ->
[||if $$(same qc# o) then $$qyes $$(qc#) else $$qno $$(qc#) $$o||]
in (Code (Rep o) -> StaHandler# s o a)
-> (Code (Rep o -> Handler# s o a) -> Code (ST s (Maybe a)))
-> Code (ST s (Maybe a))
forall o s a b.
RecBuilder o =>
(Code (Rep o) -> StaHandler# s o a)
-> (Code (Rep o -> Handler# s o a) -> Code b) -> Code b
bindIterHandler# @o (StaHandler s o a -> StaHandler# s o a
forall s o a. StaHandler s o a -> StaHandler# s o a
staHandler# (StaHandler s o a -> StaHandler# s o a)
-> (Code (Rep o) -> StaHandler s o a)
-> Code (Rep o)
-> StaHandler# s o a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code (Rep o) -> StaHandler s o a
handler) ((Code (Rep o -> Handler# s o a) -> Code (ST s (Maybe a)))
-> Code (ST s (Maybe a)))
-> (Code (Rep o -> Handler# s o a) -> Code (ST s (Maybe a)))
-> Code (ST s (Maybe a))
forall a b. (a -> b) -> a -> b
$ \Code (Rep o -> Handler# s o a)
qhandler ->
Code (Rep o)
-> (DynHandler s o a -> StaHandler# s o a) -> Code (ST s (Maybe a))
forall o s a.
RecBuilder o =>
Code (Rep o)
-> (DynHandler s o a -> Code (Rep o) -> Code (ST s (Maybe a)))
-> Code (ST s (Maybe a))
bindIter# @o (Offset o -> Code (Rep o)
forall o. Offset o -> Code (Rep o)
offset Offset o
o) ((DynHandler s o a -> StaHandler# s o a) -> Code (ST s (Maybe a)))
-> (DynHandler s o a -> StaHandler# s o a) -> Code (ST s (Maybe a))
forall a b. (a -> b) -> a -> b
$ \DynHandler s o a
qloop Code (Rep o)
qo# ->
let off :: Offset o
off = Code (Rep o) -> Word -> Offset o
forall o. Code (Rep o) -> Word -> Offset o
mkOffset Code (Rep o)
qo# Word
u
in Machine s o '[] One Void a
-> Γ s o '[] One Void a -> Ctx s o a -> Code (ST s (Maybe a))
forall s o (xs :: [Type]) (n :: Nat) r a.
Machine s o xs n r a
-> Γ s o xs n r a -> Ctx s o a -> Code (ST s (Maybe a))
run Machine s o '[] One Void a
l (OpStack '[]
-> StaCont s o a Void
-> Offset o
-> Vec One (StaHandler s o a)
-> Γ s o '[] One Void a
forall s o (xs :: [Type]) (n :: Nat) r a.
OpStack xs
-> StaCont s o a r
-> Offset o
-> Vec n (StaHandler s o a)
-> Γ s o xs n r a
Γ OpStack '[]
Empty StaCont s o a Void
forall s o a. StaCont s o a Void
noreturn Offset o
off (StaHandler s o a
-> Vec 'Zero (StaHandler s o a) -> Vec One (StaHandler s o a)
forall a (n :: Nat). a -> Vec n a -> Vec ('Succ n) a
VCons (Offset o
-> DynHandler s o a
-> Code (ST s (Maybe a))
-> DynHandler s o a
-> StaHandler s o a
forall s o a.
Offset o
-> DynHandler s o a
-> Code (ST s (Maybe a))
-> DynHandler s o a
-> StaHandler s o a
mkStaHandlerFull Offset o
off [||$$qhandler $$(qo#)||] [||$$qyes $$(qo#)||] [||$$qno $$(qo#)||]) Vec 'Zero (StaHandler s o a)
forall a. Vec 'Zero a
VNil))
(Ctx s o a -> Ctx s o a
forall s o a. Ctx s o a -> Ctx s o a
voidCoins (MVar Void -> StaSubroutine s o a Void -> Ctx s o a -> Ctx s o a
forall x s o a.
MVar x -> StaSubroutine s o a x -> Ctx s o a -> Ctx s o a
insertSub MVar Void
μ (\DynCont s o a Void
_ Code (Rep o)
o# DynHandler s o a
_ -> [|| $$qloop $$(o#) ||]) Ctx s o a
ctx))
buildRec :: forall rs s o a r. RecBuilder o
=> MVar r
-> Regs rs
-> Ctx s o a
-> Machine s o '[] One r a
-> DynFunc rs s o a r
buildRec :: MVar r
-> Regs rs
-> Ctx s o a
-> Machine s o '[] One r a
-> DynFunc rs s o a r
buildRec MVar r
μ Regs rs
rs Ctx s o a
ctx Machine s o '[] One r a
k =
Regs rs
-> Ctx s o a
-> (Ctx s o a -> DynSubroutine s o a r)
-> DynFunc rs s o a r
forall (rs :: [Type]) s o a x.
Regs rs
-> Ctx s o a
-> (Ctx s o a -> DynSubroutine s o a x)
-> DynFunc rs s o a x
takeFreeRegisters Regs rs
rs Ctx s o a
ctx ((Ctx s o a -> DynSubroutine s o a r) -> DynFunc rs s o a r)
-> (Ctx s o a -> DynSubroutine s o a r) -> DynFunc rs s o a r
forall a b. (a -> b) -> a -> b
$ \Ctx s o a
ctx ->
forall s a x.
RecBuilder o =>
(DynSubroutine s o a x
-> DynCont s o a x
-> Code (Rep o)
-> DynHandler s o a
-> Code (ST s (Maybe a)))
-> DynSubroutine s o a x
forall o s a x.
RecBuilder o =>
(DynSubroutine s o a x
-> DynCont s o a x
-> Code (Rep o)
-> DynHandler s o a
-> Code (ST s (Maybe a)))
-> DynSubroutine s o a x
bindRec# @o ((DynSubroutine s o a r
-> DynCont s o a r
-> Code (Rep o)
-> DynHandler s o a
-> Code (ST s (Maybe a)))
-> DynSubroutine s o a r)
-> (DynSubroutine s o a r
-> DynCont s o a r
-> Code (Rep o)
-> DynHandler s o a
-> Code (ST s (Maybe a)))
-> DynSubroutine s o a r
forall a b. (a -> b) -> a -> b
$ \DynSubroutine s o a r
qself DynCont s o a r
qret Code (Rep o)
qo# DynHandler s o a
qh ->
Machine s o '[] One r a
-> Γ s o '[] One r a -> Ctx s o a -> Code (ST s (Maybe a))
forall s o (xs :: [Type]) (n :: Nat) r a.
Machine s o xs n r a
-> Γ s o xs n r a -> Ctx s o a -> Code (ST s (Maybe a))
run Machine s o '[] One r a
k (OpStack '[]
-> StaCont s o a r
-> Offset o
-> Vec One (StaHandler s o a)
-> Γ s o '[] One r a
forall s o (xs :: [Type]) (n :: Nat) r a.
OpStack xs
-> StaCont s o a r
-> Offset o
-> Vec n (StaHandler s o a)
-> Γ s o xs n r a
Γ OpStack '[]
Empty (DynCont s o a r -> StaCont s o a r
forall s o a x. DynCont s o a x -> StaCont s o a x
mkStaContDyn DynCont s o a r
qret) (Code (Rep o) -> Word -> Offset o
forall o. Code (Rep o) -> Word -> Offset o
mkOffset Code (Rep o)
qo# Word
0) (StaHandler s o a
-> Vec 'Zero (StaHandler s o a) -> Vec One (StaHandler s o a)
forall a (n :: Nat). a -> Vec n a -> Vec ('Succ n) a
VCons (Maybe (Offset o) -> DynHandler s o a -> StaHandler s o a
forall s o a.
Maybe (Offset o) -> DynHandler s o a -> StaHandler s o a
mkStaHandlerDyn Maybe (Offset o)
forall a. Maybe a
Nothing DynHandler s o a
qh) Vec 'Zero (StaHandler s o a)
forall a. Vec 'Zero a
VNil))
(MVar r
-> (DynCont s o a r
-> Code (Rep o) -> DynHandler s o a -> Code (ST s (Maybe a)))
-> Ctx s o a
-> Ctx s o a
forall x s o a.
MVar x -> StaSubroutine s o a x -> Ctx s o a -> Ctx s o a
insertSub MVar r
μ (\DynCont s o a r
k Code (Rep o)
o# DynHandler s o a
h -> [|| $$qself $$k $$(o#) $$h ||]) (Ctx s o a -> Ctx s o a
forall s o a. Ctx s o a -> Ctx s o a
nextUnique Ctx s o a
ctx))
dynHandler :: forall s o a. MarshalOps o => StaHandler s o a -> DynHandler s o a
dynHandler :: StaHandler s o a -> DynHandler s o a
dynHandler sh :: StaHandler s o a
sh@(StaHandler Maybe (Offset o)
_ StaHandlerCase s o a
_ Maybe (DynHandler s o a)
Nothing) = StaHandler# s o a -> DynHandler s o a
forall o s a. MarshalOps o => StaHandler# s o a -> DynHandler s o a
dynHandler# @o (StaHandler s o a -> StaHandler# s o a
forall s o a. StaHandler s o a -> StaHandler# s o a
staHandler# StaHandler s o a
sh)
dynHandler (StaHandler Maybe (Offset o)
_ StaHandlerCase s o a
_ (Just DynHandler s o a
dh)) = DynHandler s o a
dh
dynCont :: forall s o a x. MarshalOps o => StaCont s o a x -> DynCont s o a x
dynCont :: StaCont s o a x -> DynCont s o a x
dynCont (StaCont StaCont# s o a x
sk Maybe (DynCont s o a x)
Nothing) = StaCont# s o a x -> DynCont s o a x
forall o s a x. MarshalOps o => StaCont# s o a x -> DynCont s o a x
dynCont# @o StaCont# s o a x
sk
dynCont (StaCont StaCont# s o a x
_ (Just DynCont s o a x
dk)) = DynCont s o a x
dk
logHandler :: (?ops :: InputOps (Rep o), LogHandler o) => String -> Ctx s o a -> Γ s o xs (Succ n) ks a -> Word -> StaHandlerBuilder s o a
logHandler :: String
-> Ctx s o a
-> Γ s o xs ('Succ n) ks a
-> Word
-> StaHandlerBuilder s o a
logHandler String
name Ctx s o a
ctx Γ s o xs ('Succ n) ks a
γ Word
u Offset o
o = let VCons StaHandler s o a
h Vec n (StaHandler s o a)
_ = Γ s o xs ('Succ n) ks a -> Vec ('Succ n) (StaHandler s o a)
forall s o (xs :: [Type]) (n :: Nat) r a.
Γ s o xs n r a -> Vec n (StaHandler s o a)
handlers Γ s o xs ('Succ n) ks a
γ in Offset o -> StaHandler# s o a -> StaHandler s o a
forall o s a. Offset o -> StaHandler# s o a -> StaHandler s o a
mkStaHandler Offset o
o (StaHandler# s o a -> StaHandler s o a)
-> StaHandler# s o a -> StaHandler s o a
forall a b. (a -> b) -> a -> b
$ \Code (Rep o)
o# -> [||
trace $$(preludeString name '<' (γ {input = mkOffset o# u}) ctx (color Red " Fail")) $$(staHandler# h o#)
||]
preludeString :: forall s o xs n r a. (?ops :: InputOps (Rep o), LogHandler o)
=> String
-> Char
-> Γ s o xs n r a
-> Ctx s o a
-> String
-> Code String
preludeString :: String
-> Char -> Γ s o xs n r a -> Ctx s o a -> String -> Code String
preludeString String
name Char
dir Γ s o xs n r a
γ Ctx s o a
ctx String
ends = [|| concat [$$prelude, $$eof, ends, '\n' : $$caretSpace, color Blue "^"] ||]
where
Offset {Code (Rep o)
offset :: Code (Rep o)
offset :: forall o. Offset o -> Code (Rep o)
offset} = Γ s o xs n r a -> Offset o
forall s o (xs :: [Type]) (n :: Nat) r a.
Γ s o xs n r a -> Offset o
input Γ s o xs n r a
γ
indent :: String
indent = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Ctx s o a -> Int
forall s o a. Ctx s o a -> Int
debugLevel Ctx s o a
ctx Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2) Char
' '
start :: Code (Rep o)
start = Code (Rep o) -> Code Int# -> Code (Rep o)
forall rep. LogOps rep => Code rep -> Code Int# -> Code rep
shiftLeft Code (Rep o)
offset [||5#||]
end :: Code (Rep o)
end = Code (Rep o) -> Code Int# -> Code (Rep o)
forall rep. PositionOps rep => Code rep -> Code Int# -> Code rep
shiftRight Code (Rep o)
offset [||5#||]
inputTrace :: Code String
inputTrace = [|| let replace '\n' = color Green "↙"
replace ' ' = color White "·"
replace c = return c
go i#
| $$(same [||i#||] end) || not $$(more [||i#||]) = []
| otherwise = $$(next [||i#||] (\qc qi' -> [||replace $$qc ++ go $$qi'||]))
in go $$start ||]
eof :: Code String
eof = [|| if $$(more end) then $$inputTrace else $$inputTrace ++ color Red "•" ||]
prelude :: Code String
prelude = [|| concat [indent, dir : name, dir : " (", show $$(offToInt offset), "): "] ||]
caretSpace :: Code String
caretSpace = [|| replicate (length $$prelude + $$(offToInt offset) - $$(offToInt start)) ' ' ||]
type Ops o =
( HandlerOps o
, JoinBuilder o
, RecBuilder o
, PositionOps (Rep o)
, MarshalOps o
, LogOps (Rep o)
)
type LogHandler o = (PositionOps (Rep o), LogOps (Rep o))
type StaHandlerBuilder s o a = Offset o -> StaHandler s o a