-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

{-# 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.Compilation.Sequential
  (InstrCollector(..), Instruction(..), SequentialHooks(..), stmtHookL)
import Indigo.Internal.State
import Indigo.Lorentz
import qualified Lorentz.Instr as L
import qualified Michelson.Typed.Convert as M
import qualified Michelson.Typed.Instr as M

---------------------------------------------
--- Comments settings
---------------------------------------------

data CommentSettings = CommentSettings
  { 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 -> String
(Int -> CommentSettings -> ShowS)
-> (CommentSettings -> String)
-> ([CommentSettings] -> ShowS)
-> Show CommentSettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CommentSettings] -> ShowS
$cshowList :: [CommentSettings] -> ShowS
show :: CommentSettings -> String
$cshow :: CommentSettings -> String
showsPrec :: Int -> CommentSettings -> ShowS
$cshowsPrec :: Int -> CommentSettings -> ShowS
Show)

defaultCommentSettings :: CommentsVerbosity -> CommentSettings
defaultCommentSettings :: CommentsVerbosity -> CommentSettings
defaultCommentSettings verb :: CommentsVerbosity
verb = CommentsVerbosity -> Bool -> Bool -> CommentSettings
CommentSettings CommentsVerbosity
verb Bool
False Bool
False

data CommentsVerbosity
  = NoComments
  | LogTopLevelFrontendStatements
  | LogBackendStatements
  | LogAuxCode
  | LogExpressionsComputations
  deriving stock (Int -> CommentsVerbosity -> ShowS
[CommentsVerbosity] -> ShowS
CommentsVerbosity -> String
(Int -> CommentsVerbosity -> ShowS)
-> (CommentsVerbosity -> String)
-> ([CommentsVerbosity] -> ShowS)
-> Show CommentsVerbosity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CommentsVerbosity] -> ShowS
$cshowList :: [CommentsVerbosity] -> ShowS
show :: CommentsVerbosity -> String
$cshow :: CommentsVerbosity -> String
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
$cp1Ord :: Eq CommentsVerbosity
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

---------------------------------------------
--- Comments actions
---------------------------------------------

data CommentHooks = CommentHooks
  { CommentHooks -> SequentialHooks
chFrontendHooks :: SequentialHooks
  , CommentHooks -> GenCodeHooks
chBackendHooks  :: GenCodeHooks
  }

instance Semigroup CommentHooks where
  CommentHooks f :: SequentialHooks
f b :: GenCodeHooks
b <> :: CommentHooks -> CommentHooks -> CommentHooks
<> CommentHooks f1 :: SequentialHooks
f1 b1 :: 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

-- | Basically copy-pasted version of 'prettyCallStack' with fixed 'prettySrcLoc'.
prettyFrontendCallStack :: Bool -> Bool -> (String, String) -> CallStack -> ([Text], Text)
prettyFrontendCallStack :: Bool -> Bool -> (String, String) -> CallStack -> ([Text], Text)
prettyFrontendCallStack printFullStk :: Bool
printFullStk fileName :: Bool
fileName (strt :: String
strt, ends :: String
ends) cs :: CallStack
cs = case CallStack -> [(String, SrcLoc)]
getCallStack CallStack
cs of
    (fn :: String
fn, loc :: SrcLoc
loc) : rest :: [(String, SrcLoc)]
rest ->
      ( (String, SrcLoc) -> Text
forall a. IsString a => (String, SrcLoc) -> a
prettyTop (String
fn String -> ShowS
forall a. [a] -> [a] -> [a]
++ " " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
strt, SrcLoc
loc) Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:
        if Bool
printFullStk Bool -> Bool -> Bool
&& Bool -> Bool
not ([(String, SrcLoc)] -> Bool
forall t. Container t => t -> Bool
null [(String, SrcLoc)]
rest) then
          ("Full stacktrace for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. IsString a => String -> a
fromString String
fn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ": ") Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:
          (Int -> (String, SrcLoc) -> Text)
-> [Int] -> [(String, SrcLoc)] -> [Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\i :: Int
i c :: (String, SrcLoc)
c -> String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
indentSpaces) ' ' String -> ShowS
forall a. [a] -> [a] -> [a]
++ (String, SrcLoc) -> String
prettyCallSite (String, SrcLoc)
c)
                  [1..] [(String, SrcLoc)]
rest
        else []
      , (String, SrcLoc) -> Text
forall a. IsString a => (String, SrcLoc) -> a
prettyTop (String
fn String -> ShowS
forall a. [a] -> [a] -> [a]
++ " " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ends, SrcLoc
loc)
      )
    [] -> Text -> ([Text], Text)
forall a. HasCallStack => Text -> a
error "empty call stack in prettyFrontendCallStack"
  where
    prettyTop :: (String, SrcLoc) -> a
prettyTop (fn :: String
fn, loc :: SrcLoc
loc) = String -> a
forall a. IsString a => String -> a
fromString (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ (String, SrcLoc) -> String
prettyCallSite (String
fn, SrcLoc
loc)

    indentSpaces :: Int
indentSpaces = 2
    prettyCallSite :: (String, SrcLoc) -> String
prettyCallSite (f :: String
f, loc :: SrcLoc
loc) = String
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ " (called at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SrcLoc -> String
prettySrcLoc' SrcLoc
loc String -> ShowS
forall a. [a] -> [a] -> [a]
++ ")"

    prettySrcLoc' :: SrcLoc -> String
    prettySrcLoc' :: SrcLoc -> String
prettySrcLoc' SrcLoc {..} = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
      [ String
srcLocModule, ":", Int -> String
forall b a. (Show a, IsString b) => a -> b
show Int
srcLocStartLine, ":", Int -> String
forall b a. (Show a, IsString b) => a -> b
show Int
srcLocStartCol]
      [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ if Bool
fileName then [" in ", String
srcLocFile] else []

-- | Convert from enum-based verbosity description to specific actions.
settingsToHooks :: CommentSettings -> CommentHooks
settingsToHooks :: CommentSettings -> CommentHooks
settingsToHooks (CommentSettings NoComments _ _) = CommentHooks
forall a. Monoid a => a
mempty
settingsToHooks c :: CommentSettings
c@(CommentSettings LogTopLevelFrontendStatements p :: Bool
p f :: 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
.~ \cs :: CallStack
cs blk :: Block
blk -> do
      let (stCallStk :: [Text]
stCallStk, en :: Text
en) = Bool -> Bool -> (String, String) -> CallStack -> ([Text], Text)
prettyFrontendCallStack Bool
p Bool
f ("[fr-stmt starts]", "[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
$ \iColl :: 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 LogBackendStatements _ _) = 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
&
  -- There was needed some extra hussle to define lenses for GenCodeHooks so I forwent this idea.
  (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
%~ \bh :: GenCodeHooks
bh -> GenCodeHooks
bh
    {gchStmtHook :: forall (inp :: [*]) (out :: [*]).
Text -> (inp :-> out) -> inp :-> out
gchStmtHook = \t :: Text
t cd :: 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
<> " [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
<> " [bk-stmt ends]")
    }
settingsToHooks c :: CommentSettings
c@(CommentSettings LogAuxCode _ _) = 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
%~ \bh :: GenCodeHooks
bh -> GenCodeHooks
bh
    { gchAuxiliaryHook :: forall (inp :: [*]) (out :: [*]).
Text -> (inp :-> out) -> inp :-> out
gchAuxiliaryHook = \t :: Text
t cd :: 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
<> " [bk-aux starts]") in
     -- Compile the passed code with default optimisation settings
     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
     -- Check if after an optimisation we get empty code block
     -- then omit comment instruction to make it less noisy
     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 LogExpressionsComputations _ _) = 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
%~ \bh :: GenCodeHooks
bh -> GenCodeHooks
bh
    { gchExprHook :: forall (inp :: [*]) (out :: [*]).
Text -> (inp :-> out) -> inp :-> out
gchExprHook = \expr :: Text
expr cd :: 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
<> " [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
<> " [bk-expr ends]")
    }