{-# LANGUAGE NoRebindableSyntax #-}
module Indigo.Compilation.Hooks
( CommentsVerbosity (..)
, CommentSettings (..)
, defaultCommentSettings
, CommentHooks (..)
, settingsToHooks
) where
import Lens.Micro.TH (makeLensesFor)
import Prelude
import GHC.Stack.Types (SrcLoc(..))
import Indigo.Common.State
import Indigo.Compilation.Sequential
(InstrCollector(..), Instruction(..), SequentialHooks(..), stmtHookL)
import Indigo.Lorentz
import Lorentz.Ext qualified as L
import Morley.Michelson.Typed.Convert qualified as M
import Morley.Michelson.Typed.Instr qualified as M
data =
{ CommentSettings -> CommentsVerbosity
csVerbosity :: CommentsVerbosity
, CommentSettings -> Bool
csPrintFullStackTrace :: Bool
, CommentSettings -> Bool
csPrintFileName :: Bool
} deriving stock (CommentSettings -> CommentSettings -> Bool
(CommentSettings -> CommentSettings -> Bool)
-> (CommentSettings -> CommentSettings -> Bool)
-> Eq CommentSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommentSettings -> CommentSettings -> Bool
$c/= :: CommentSettings -> CommentSettings -> Bool
== :: CommentSettings -> CommentSettings -> Bool
$c== :: CommentSettings -> CommentSettings -> Bool
Eq, Int -> CommentSettings -> ShowS
[CommentSettings] -> ShowS
CommentSettings -> [Char]
(Int -> CommentSettings -> ShowS)
-> (CommentSettings -> [Char])
-> ([CommentSettings] -> ShowS)
-> Show CommentSettings
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [CommentSettings] -> ShowS
$cshowList :: [CommentSettings] -> ShowS
show :: CommentSettings -> [Char]
$cshow :: CommentSettings -> [Char]
showsPrec :: Int -> CommentSettings -> ShowS
$cshowsPrec :: Int -> CommentSettings -> ShowS
Show)
defaultCommentSettings :: CommentsVerbosity -> CommentSettings
CommentsVerbosity
verb = CommentsVerbosity -> Bool -> Bool -> CommentSettings
CommentSettings CommentsVerbosity
verb Bool
False Bool
False
data
=
| LogTopLevelFrontendStatements
| LogBackendStatements
| LogAuxCode
| LogExpressionsComputations
deriving stock (Int -> CommentsVerbosity -> ShowS
[CommentsVerbosity] -> ShowS
CommentsVerbosity -> [Char]
(Int -> CommentsVerbosity -> ShowS)
-> (CommentsVerbosity -> [Char])
-> ([CommentsVerbosity] -> ShowS)
-> Show CommentsVerbosity
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [CommentsVerbosity] -> ShowS
$cshowList :: [CommentsVerbosity] -> ShowS
show :: CommentsVerbosity -> [Char]
$cshow :: CommentsVerbosity -> [Char]
showsPrec :: Int -> CommentsVerbosity -> ShowS
$cshowsPrec :: Int -> CommentsVerbosity -> ShowS
Show, CommentsVerbosity -> CommentsVerbosity -> Bool
(CommentsVerbosity -> CommentsVerbosity -> Bool)
-> (CommentsVerbosity -> CommentsVerbosity -> Bool)
-> Eq CommentsVerbosity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommentsVerbosity -> CommentsVerbosity -> Bool
$c/= :: CommentsVerbosity -> CommentsVerbosity -> Bool
== :: CommentsVerbosity -> CommentsVerbosity -> Bool
$c== :: CommentsVerbosity -> CommentsVerbosity -> Bool
Eq, Eq CommentsVerbosity
Eq CommentsVerbosity
-> (CommentsVerbosity -> CommentsVerbosity -> Ordering)
-> (CommentsVerbosity -> CommentsVerbosity -> Bool)
-> (CommentsVerbosity -> CommentsVerbosity -> Bool)
-> (CommentsVerbosity -> CommentsVerbosity -> Bool)
-> (CommentsVerbosity -> CommentsVerbosity -> Bool)
-> (CommentsVerbosity -> CommentsVerbosity -> CommentsVerbosity)
-> (CommentsVerbosity -> CommentsVerbosity -> CommentsVerbosity)
-> Ord CommentsVerbosity
CommentsVerbosity -> CommentsVerbosity -> Bool
CommentsVerbosity -> CommentsVerbosity -> Ordering
CommentsVerbosity -> CommentsVerbosity -> CommentsVerbosity
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CommentsVerbosity -> CommentsVerbosity -> CommentsVerbosity
$cmin :: CommentsVerbosity -> CommentsVerbosity -> CommentsVerbosity
max :: CommentsVerbosity -> CommentsVerbosity -> CommentsVerbosity
$cmax :: CommentsVerbosity -> CommentsVerbosity -> CommentsVerbosity
>= :: CommentsVerbosity -> CommentsVerbosity -> Bool
$c>= :: CommentsVerbosity -> CommentsVerbosity -> Bool
> :: CommentsVerbosity -> CommentsVerbosity -> Bool
$c> :: CommentsVerbosity -> CommentsVerbosity -> Bool
<= :: CommentsVerbosity -> CommentsVerbosity -> Bool
$c<= :: CommentsVerbosity -> CommentsVerbosity -> Bool
< :: CommentsVerbosity -> CommentsVerbosity -> Bool
$c< :: CommentsVerbosity -> CommentsVerbosity -> Bool
compare :: CommentsVerbosity -> CommentsVerbosity -> Ordering
$ccompare :: CommentsVerbosity -> CommentsVerbosity -> Ordering
Ord, CommentsVerbosity
CommentsVerbosity -> CommentsVerbosity -> Bounded CommentsVerbosity
forall a. a -> a -> Bounded a
maxBound :: CommentsVerbosity
$cmaxBound :: CommentsVerbosity
minBound :: CommentsVerbosity
$cminBound :: CommentsVerbosity
Bounded, Int -> CommentsVerbosity
CommentsVerbosity -> Int
CommentsVerbosity -> [CommentsVerbosity]
CommentsVerbosity -> CommentsVerbosity
CommentsVerbosity -> CommentsVerbosity -> [CommentsVerbosity]
CommentsVerbosity
-> CommentsVerbosity -> CommentsVerbosity -> [CommentsVerbosity]
(CommentsVerbosity -> CommentsVerbosity)
-> (CommentsVerbosity -> CommentsVerbosity)
-> (Int -> CommentsVerbosity)
-> (CommentsVerbosity -> Int)
-> (CommentsVerbosity -> [CommentsVerbosity])
-> (CommentsVerbosity -> CommentsVerbosity -> [CommentsVerbosity])
-> (CommentsVerbosity -> CommentsVerbosity -> [CommentsVerbosity])
-> (CommentsVerbosity
-> CommentsVerbosity -> CommentsVerbosity -> [CommentsVerbosity])
-> Enum CommentsVerbosity
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: CommentsVerbosity
-> CommentsVerbosity -> CommentsVerbosity -> [CommentsVerbosity]
$cenumFromThenTo :: CommentsVerbosity
-> CommentsVerbosity -> CommentsVerbosity -> [CommentsVerbosity]
enumFromTo :: CommentsVerbosity -> CommentsVerbosity -> [CommentsVerbosity]
$cenumFromTo :: CommentsVerbosity -> CommentsVerbosity -> [CommentsVerbosity]
enumFromThen :: CommentsVerbosity -> CommentsVerbosity -> [CommentsVerbosity]
$cenumFromThen :: CommentsVerbosity -> CommentsVerbosity -> [CommentsVerbosity]
enumFrom :: CommentsVerbosity -> [CommentsVerbosity]
$cenumFrom :: CommentsVerbosity -> [CommentsVerbosity]
fromEnum :: CommentsVerbosity -> Int
$cfromEnum :: CommentsVerbosity -> Int
toEnum :: Int -> CommentsVerbosity
$ctoEnum :: Int -> CommentsVerbosity
pred :: CommentsVerbosity -> CommentsVerbosity
$cpred :: CommentsVerbosity -> CommentsVerbosity
succ :: CommentsVerbosity -> CommentsVerbosity
$csucc :: CommentsVerbosity -> CommentsVerbosity
Enum)
instance Default CommentSettings where
def :: CommentSettings
def = CommentsVerbosity -> Bool -> Bool -> CommentSettings
CommentSettings CommentsVerbosity
NoComments Bool
False Bool
False
makeLensesFor [ ("csVerbosity", "verbosityL")] ''CommentSettings
data =
{ CommentHooks -> SequentialHooks
chFrontendHooks :: SequentialHooks
, CommentHooks -> GenCodeHooks
chBackendHooks :: GenCodeHooks
}
instance Semigroup CommentHooks where
CommentHooks SequentialHooks
f GenCodeHooks
b <> :: CommentHooks -> CommentHooks -> CommentHooks
<> CommentHooks SequentialHooks
f1 GenCodeHooks
b1 = SequentialHooks -> GenCodeHooks -> CommentHooks
CommentHooks (SequentialHooks
f SequentialHooks -> SequentialHooks -> SequentialHooks
forall a. Semigroup a => a -> a -> a
<> SequentialHooks
f1) (GenCodeHooks
b GenCodeHooks -> GenCodeHooks -> GenCodeHooks
forall a. Semigroup a => a -> a -> a
<> GenCodeHooks
b1)
instance Monoid CommentHooks where
mempty :: CommentHooks
mempty = SequentialHooks -> GenCodeHooks -> CommentHooks
CommentHooks SequentialHooks
forall a. Monoid a => a
mempty GenCodeHooks
forall a. Monoid a => a
mempty
makeLensesFor [ ("chFrontendHooks", "frontendHooksL")
, ("chBackendHooks", "backendHooksL")]
''CommentHooks
prettyFrontendCallStack :: Bool -> Bool -> (String, String) -> CallStack -> ([Text], Text)
prettyFrontendCallStack :: Bool -> Bool -> ([Char], [Char]) -> CallStack -> ([Text], Text)
prettyFrontendCallStack Bool
printFullStk Bool
fileName ([Char]
strt, [Char]
ends) CallStack
cs = case CallStack -> [([Char], SrcLoc)]
getCallStack CallStack
cs of
([Char]
fn, SrcLoc
loc) : [([Char], SrcLoc)]
rest ->
( ([Char], SrcLoc) -> Text
forall {a}. IsString a => ([Char], SrcLoc) -> a
prettyTop ([Char]
fn [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
strt, SrcLoc
loc) Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:
if Bool
printFullStk Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
&& Bool -> Bool
forall a. Boolean a => a -> a
not ([([Char], SrcLoc)] -> Bool
forall t. Container t => t -> Bool
null [([Char], SrcLoc)]
rest) then
(Text
"Full stacktrace for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
forall a. IsString a => [Char] -> a
fromString [Char]
fn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": ") Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:
(Int -> ([Char], SrcLoc) -> Text)
-> [Int] -> [([Char], SrcLoc)] -> [Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
i ([Char], SrcLoc)
c -> [Char] -> Text
forall a. IsString a => [Char] -> a
fromString ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
indentSpaces) Char
' ' [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ([Char], SrcLoc) -> [Char]
prettyCallSite ([Char], SrcLoc)
c)
[Int
1..] [([Char], SrcLoc)]
rest
else []
, ([Char], SrcLoc) -> Text
forall {a}. IsString a => ([Char], SrcLoc) -> a
prettyTop ([Char]
fn [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
ends, SrcLoc
loc)
)
[] -> Text -> ([Text], Text)
forall a. HasCallStack => Text -> a
error Text
"empty call stack in prettyFrontendCallStack"
where
prettyTop :: ([Char], SrcLoc) -> a
prettyTop ([Char]
fn, SrcLoc
loc) = [Char] -> a
forall a. IsString a => [Char] -> a
fromString ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ ([Char], SrcLoc) -> [Char]
prettyCallSite ([Char]
fn, SrcLoc
loc)
indentSpaces :: Int
indentSpaces = Int
2
prettyCallSite :: ([Char], SrcLoc) -> [Char]
prettyCallSite ([Char]
f, SrcLoc
loc) = [Char]
f [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" (called at " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ SrcLoc -> [Char]
prettySrcLoc' SrcLoc
loc [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"
prettySrcLoc' :: SrcLoc -> String
prettySrcLoc' :: SrcLoc -> [Char]
prettySrcLoc' SrcLoc {Int
[Char]
srcLocEndCol :: SrcLoc -> Int
srcLocEndLine :: SrcLoc -> Int
srcLocFile :: SrcLoc -> [Char]
srcLocModule :: SrcLoc -> [Char]
srcLocPackage :: SrcLoc -> [Char]
srcLocStartCol :: SrcLoc -> Int
srcLocStartLine :: SrcLoc -> Int
srcLocEndCol :: Int
srcLocEndLine :: Int
srcLocStartCol :: Int
srcLocStartLine :: Int
srcLocFile :: [Char]
srcLocModule :: [Char]
srcLocPackage :: [Char]
..} = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$
[ [Char]
srcLocModule, [Char]
":", Int -> [Char]
forall b a. (PrettyShow a, Show a, IsString b) => a -> b
show Int
srcLocStartLine, [Char]
":", Int -> [Char]
forall b a. (PrettyShow a, Show a, IsString b) => a -> b
show Int
srcLocStartCol]
[[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ if Bool
fileName then [[Char]
" in ", [Char]
srcLocFile] else []
settingsToHooks :: CommentSettings -> CommentHooks
settingsToHooks :: CommentSettings -> CommentHooks
settingsToHooks (CommentSettings CommentsVerbosity
NoComments Bool
_ Bool
_) = CommentHooks
forall a. Monoid a => a
mempty
settingsToHooks c :: CommentSettings
c@(CommentSettings CommentsVerbosity
LogTopLevelFrontendStatements Bool
p Bool
f) = CommentSettings -> CommentHooks
settingsToHooks (CommentSettings
c CommentSettings
-> (CommentSettings -> CommentSettings) -> CommentSettings
forall a b. a -> (a -> b) -> b
& (CommentsVerbosity -> Identity CommentsVerbosity)
-> CommentSettings -> Identity CommentSettings
Lens' CommentSettings CommentsVerbosity
verbosityL ((CommentsVerbosity -> Identity CommentsVerbosity)
-> CommentSettings -> Identity CommentSettings)
-> CommentsVerbosity -> CommentSettings -> CommentSettings
forall s t a b. ASetter s t a b -> b -> s -> t
.~ CommentsVerbosity
NoComments)
CommentHooks -> (CommentHooks -> CommentHooks) -> CommentHooks
forall a b. a -> (a -> b) -> b
& (SequentialHooks -> Identity SequentialHooks)
-> CommentHooks -> Identity CommentHooks
Lens' CommentHooks SequentialHooks
frontendHooksL ((SequentialHooks -> Identity SequentialHooks)
-> CommentHooks -> Identity CommentHooks)
-> (((CallStack -> Block -> State InstrCollector ())
-> Identity (CallStack -> Block -> State InstrCollector ()))
-> SequentialHooks -> Identity SequentialHooks)
-> ((CallStack -> Block -> State InstrCollector ())
-> Identity (CallStack -> Block -> State InstrCollector ()))
-> CommentHooks
-> Identity CommentHooks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CallStack -> Block -> State InstrCollector ())
-> Identity (CallStack -> Block -> State InstrCollector ()))
-> SequentialHooks -> Identity SequentialHooks
Lens'
SequentialHooks (CallStack -> Block -> State InstrCollector ())
stmtHookL (((CallStack -> Block -> State InstrCollector ())
-> Identity (CallStack -> Block -> State InstrCollector ()))
-> CommentHooks -> Identity CommentHooks)
-> (CallStack -> Block -> State InstrCollector ())
-> CommentHooks
-> CommentHooks
forall s t a b. ASetter s t a b -> b -> s -> t
.~ \CallStack
cs Block
blk -> do
let ([Text]
stCallStk, Text
en) = Bool -> Bool -> ([Char], [Char]) -> CallStack -> ([Text], Text)
prettyFrontendCallStack Bool
p Bool
f ([Char]
"[fr-stmt starts]", [Char]
"[fr-stmt ends]") CallStack
cs
(InstrCollector -> InstrCollector) -> State InstrCollector ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((InstrCollector -> InstrCollector) -> State InstrCollector ())
-> (InstrCollector -> InstrCollector) -> State InstrCollector ()
forall a b. (a -> b) -> a -> b
$ \InstrCollector
iColl -> InstrCollector
iColl {instrList :: Block
instrList = Text -> Instruction
Comment Text
en Instruction -> Block -> Block
forall a. a -> [a] -> [a]
: Block -> Block
forall a. [a] -> [a]
reverse Block
blk Block -> Block -> Block
forall a. [a] -> [a] -> [a]
++ (Text -> Instruction) -> [Text] -> Block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Text -> Instruction
Comment ([Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
stCallStk) Block -> Block -> Block
forall a. [a] -> [a] -> [a]
++ InstrCollector -> Block
instrList InstrCollector
iColl}
settingsToHooks c :: CommentSettings
c@(CommentSettings CommentsVerbosity
LogBackendStatements Bool
_ Bool
_) = CommentSettings -> CommentHooks
settingsToHooks (CommentSettings
c CommentSettings
-> (CommentSettings -> CommentSettings) -> CommentSettings
forall a b. a -> (a -> b) -> b
& (CommentsVerbosity -> Identity CommentsVerbosity)
-> CommentSettings -> Identity CommentSettings
Lens' CommentSettings CommentsVerbosity
verbosityL ((CommentsVerbosity -> Identity CommentsVerbosity)
-> CommentSettings -> Identity CommentSettings)
-> CommentsVerbosity -> CommentSettings -> CommentSettings
forall s t a b. ASetter s t a b -> b -> s -> t
.~ CommentsVerbosity
LogTopLevelFrontendStatements) CommentHooks -> (CommentHooks -> CommentHooks) -> CommentHooks
forall a b. a -> (a -> b) -> b
&
(GenCodeHooks -> Identity GenCodeHooks)
-> CommentHooks -> Identity CommentHooks
Lens' CommentHooks GenCodeHooks
backendHooksL ((GenCodeHooks -> Identity GenCodeHooks)
-> CommentHooks -> Identity CommentHooks)
-> (GenCodeHooks -> GenCodeHooks) -> CommentHooks -> CommentHooks
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ \GenCodeHooks
bh -> GenCodeHooks
bh
{gchStmtHook :: forall (inp :: [*]) (out :: [*]).
Text -> (inp :-> out) -> inp :-> out
gchStmtHook = \Text
t inp :-> out
cd ->
CommentType -> inp :-> inp
forall (s :: [*]). CommentType -> s :-> s
L.comment (Text -> CommentType
M.JustComment (Text -> CommentType) -> Text -> CommentType
forall a b. (a -> b) -> a -> b
$ Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" [bk-stmt starts]") (inp :-> inp) -> (inp :-> out) -> inp :-> out
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
inp :-> out
cd (inp :-> out) -> (out :-> out) -> inp :-> out
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
CommentType -> out :-> out
forall (s :: [*]). CommentType -> s :-> s
L.comment (Text -> CommentType
M.JustComment (Text -> CommentType) -> Text -> CommentType
forall a b. (a -> b) -> a -> b
$ Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" [bk-stmt ends]")
}
settingsToHooks c :: CommentSettings
c@(CommentSettings CommentsVerbosity
LogAuxCode Bool
_ Bool
_) = CommentSettings -> CommentHooks
settingsToHooks (CommentSettings
c CommentSettings
-> (CommentSettings -> CommentSettings) -> CommentSettings
forall a b. a -> (a -> b) -> b
& (CommentsVerbosity -> Identity CommentsVerbosity)
-> CommentSettings -> Identity CommentSettings
Lens' CommentSettings CommentsVerbosity
verbosityL ((CommentsVerbosity -> Identity CommentsVerbosity)
-> CommentSettings -> Identity CommentSettings)
-> CommentsVerbosity -> CommentSettings -> CommentSettings
forall s t a b. ASetter s t a b -> b -> s -> t
.~ CommentsVerbosity
LogBackendStatements) CommentHooks -> (CommentHooks -> CommentHooks) -> CommentHooks
forall a b. a -> (a -> b) -> b
&
(GenCodeHooks -> Identity GenCodeHooks)
-> CommentHooks -> Identity CommentHooks
Lens' CommentHooks GenCodeHooks
backendHooksL ((GenCodeHooks -> Identity GenCodeHooks)
-> CommentHooks -> Identity CommentHooks)
-> (GenCodeHooks -> GenCodeHooks) -> CommentHooks -> CommentHooks
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ \GenCodeHooks
bh -> GenCodeHooks
bh
{ gchAuxiliaryHook :: forall (inp :: [*]) (out :: [*]).
Text -> (inp :-> out) -> inp :-> out
gchAuxiliaryHook = \Text
t inp :-> out
cd ->
let commInstr :: inp :-> inp
commInstr = CommentType -> inp :-> inp
forall (s :: [*]). CommentType -> s :-> s
L.comment (Text -> CommentType
M.JustComment (Text -> CommentType) -> Text -> CommentType
forall a b. (a -> b) -> a -> b
$ Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" [bk-aux starts]") in
let resLorBlock :: Instr (ToTs inp) (ToTs out)
resLorBlock = (inp :-> out) -> Instr (ToTs inp) (ToTs out)
forall (inp :: [*]) (out :: [*]).
(inp :-> out) -> Instr (ToTs inp) (ToTs out)
compileLorentz inp :-> out
cd in
if (Instr (ToTs inp) (ToTs out) -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
Instr inp out -> [ExpandedOp]
M.instrToOps Instr (ToTs inp) (ToTs out)
resLorBlock [ExpandedOp] -> [ExpandedOp] -> Bool
forall a. Eq a => a -> a -> Bool
== Instr Any Any -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
Instr inp out -> [ExpandedOp]
M.instrToOps Instr Any Any
forall (inp :: [T]). Instr inp inp
M.Nop)
then inp :-> out
cd
else inp :-> inp
commInstr (inp :-> inp) -> (inp :-> out) -> inp :-> out
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# inp :-> out
cd
}
settingsToHooks c :: CommentSettings
c@(CommentSettings CommentsVerbosity
LogExpressionsComputations Bool
_ Bool
_) = CommentSettings -> CommentHooks
settingsToHooks (CommentSettings
c CommentSettings
-> (CommentSettings -> CommentSettings) -> CommentSettings
forall a b. a -> (a -> b) -> b
& (CommentsVerbosity -> Identity CommentsVerbosity)
-> CommentSettings -> Identity CommentSettings
Lens' CommentSettings CommentsVerbosity
verbosityL ((CommentsVerbosity -> Identity CommentsVerbosity)
-> CommentSettings -> Identity CommentSettings)
-> CommentsVerbosity -> CommentSettings -> CommentSettings
forall s t a b. ASetter s t a b -> b -> s -> t
.~ CommentsVerbosity
LogAuxCode) CommentHooks -> (CommentHooks -> CommentHooks) -> CommentHooks
forall a b. a -> (a -> b) -> b
&
(GenCodeHooks -> Identity GenCodeHooks)
-> CommentHooks -> Identity CommentHooks
Lens' CommentHooks GenCodeHooks
backendHooksL ((GenCodeHooks -> Identity GenCodeHooks)
-> CommentHooks -> Identity CommentHooks)
-> (GenCodeHooks -> GenCodeHooks) -> CommentHooks -> CommentHooks
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ \GenCodeHooks
bh -> GenCodeHooks
bh
{ gchExprHook :: forall (inp :: [*]) (out :: [*]).
Text -> (inp :-> out) -> inp :-> out
gchExprHook = \Text
expr inp :-> out
cd ->
CommentType -> inp :-> inp
forall (s :: [*]). CommentType -> s :-> s
L.comment (Text -> CommentType
M.JustComment (Text -> CommentType) -> Text -> CommentType
forall a b. (a -> b) -> a -> b
$ Text
expr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" [bk-expr starts]") (inp :-> inp) -> (inp :-> out) -> inp :-> out
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
inp :-> out
cd (inp :-> out) -> (out :-> out) -> inp :-> out
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
CommentType -> out :-> out
forall (s :: [*]). CommentType -> s :-> s
L.comment (Text -> CommentType
M.JustComment (Text -> CommentType) -> Text -> CommentType
forall a b. (a -> b) -> a -> b
$ Text
expr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" [bk-expr ends]")
}