{-|
  Copyright  :  (C) 2026, QBayLogic B.V.
  License    :  BSD2 (see the file LICENSE)
  Maintainer :  QBayLogic B.V. <devops@qbaylogic.com>

  A pure description language for rewrite strategies. A strategy written in
  this DSL is compiled by "Clash.Rewrite.StrategyDSL.TH" into a fused
  traversal that matches each node's constructor once and runs only the
  transformations registered for that constructor.

  The DSL has two layers:

  * 'Step': what runs at a single node inside a fused traversal. An ordered
    'chain' of transformations, sequencing and success/failure conditionals
    between chain segments, or a whole 'nested' strategy embedded as one node
    action.

  * 'Strat': a complete strategy. Fused traversals over a 'Step', whole-term
    passes, and the usual combinators ('>->', '!->', '>-!', '>-!->',
    'repeatR') between them.
-}

{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NoFieldSelectors #-}
{-# LANGUAGE OverloadedRecordDot #-}

module Clash.Rewrite.StrategyDSL
  ( -- * Transformation metadata
    Constructor (..)
  , TransformationWorker (..)
  , Transformation (..)
  , toTransformation
  , anyConstructor
  , named
    -- ** Worker builders: workers receiving the constructor's fields
  , onVar
  , onData
  , onLiteral
  , onPrim
  , onLam
  , onTyLam
  , onApp
  , onTyApp
  , onLet
  , onCase
  , onCast
  , onTick
    -- ** Worker builders: workers receiving the node itself
  , onVarNode
  , onPrimNode
  , onAppNode
  , onTyAppNode
  , onLetNode
  , onTickNode
    -- * Node layer
  , Step (..)
  , chain
  , one
  , nested
    -- * Strategy layer
  , Strat (..)
  , topdown
  , bottomup
  , topdownFix
  , topdownSuc
  , innerMost
  , pass
  , callStrategy
  , repeatR
    -- * Combinators
  , Strategic (..)
  , (>-!->)
  , ToStep (..)
  ) where

import Language.Haskell.TH.Syntax (Name)

-- | One 'Clash.Core.Term.Term' constructor.
data Constructor
  = CVar | CData | CLiteral | CPrim | CLam | CTyLam
  | CApp | CTyApp | CLet | CCase | CCast | CTick
  deriving (Constructor -> Constructor -> Bool
(Constructor -> Constructor -> Bool)
-> (Constructor -> Constructor -> Bool) -> Eq Constructor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Constructor -> Constructor -> Bool
== :: Constructor -> Constructor -> Bool
$c/= :: Constructor -> Constructor -> Bool
/= :: Constructor -> Constructor -> Bool
Eq, Eq Constructor
Eq Constructor =>
(Constructor -> Constructor -> Ordering)
-> (Constructor -> Constructor -> Bool)
-> (Constructor -> Constructor -> Bool)
-> (Constructor -> Constructor -> Bool)
-> (Constructor -> Constructor -> Bool)
-> (Constructor -> Constructor -> Constructor)
-> (Constructor -> Constructor -> Constructor)
-> Ord Constructor
Constructor -> Constructor -> Bool
Constructor -> Constructor -> Ordering
Constructor -> Constructor -> Constructor
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
$ccompare :: Constructor -> Constructor -> Ordering
compare :: Constructor -> Constructor -> Ordering
$c< :: Constructor -> Constructor -> Bool
< :: Constructor -> Constructor -> Bool
$c<= :: Constructor -> Constructor -> Bool
<= :: Constructor -> Constructor -> Bool
$c> :: Constructor -> Constructor -> Bool
> :: Constructor -> Constructor -> Bool
$c>= :: Constructor -> Constructor -> Bool
>= :: Constructor -> Constructor -> Bool
$cmax :: Constructor -> Constructor -> Constructor
max :: Constructor -> Constructor -> Constructor
$cmin :: Constructor -> Constructor -> Constructor
min :: Constructor -> Constructor -> Constructor
Ord, Int -> Constructor -> ShowS
[Constructor] -> ShowS
Constructor -> String
(Int -> Constructor -> ShowS)
-> (Constructor -> String)
-> ([Constructor] -> ShowS)
-> Show Constructor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Constructor -> ShowS
showsPrec :: Int -> Constructor -> ShowS
$cshow :: Constructor -> String
show :: Constructor -> String
$cshowList :: [Constructor] -> ShowS
showList :: [Constructor] -> ShowS
Show, Int -> Constructor
Constructor -> Int
Constructor -> [Constructor]
Constructor -> Constructor
Constructor -> Constructor -> [Constructor]
Constructor -> Constructor -> Constructor -> [Constructor]
(Constructor -> Constructor)
-> (Constructor -> Constructor)
-> (Int -> Constructor)
-> (Constructor -> Int)
-> (Constructor -> [Constructor])
-> (Constructor -> Constructor -> [Constructor])
-> (Constructor -> Constructor -> [Constructor])
-> (Constructor -> Constructor -> Constructor -> [Constructor])
-> Enum Constructor
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Constructor -> Constructor
succ :: Constructor -> Constructor
$cpred :: Constructor -> Constructor
pred :: Constructor -> Constructor
$ctoEnum :: Int -> Constructor
toEnum :: Int -> Constructor
$cfromEnum :: Constructor -> Int
fromEnum :: Constructor -> Int
$cenumFrom :: Constructor -> [Constructor]
enumFrom :: Constructor -> [Constructor]
$cenumFromThen :: Constructor -> Constructor -> [Constructor]
enumFromThen :: Constructor -> Constructor -> [Constructor]
$cenumFromTo :: Constructor -> Constructor -> [Constructor]
enumFromTo :: Constructor -> Constructor -> [Constructor]
$cenumFromThenTo :: Constructor -> Constructor -> Constructor -> [Constructor]
enumFromThenTo :: Constructor -> Constructor -> Constructor -> [Constructor]
Enum, Constructor
Constructor -> Constructor -> Bounded Constructor
forall a. a -> a -> Bounded a
$cminBound :: Constructor
minBound :: Constructor
$cmaxBound :: Constructor
maxBound :: Constructor
Bounded)

-- | A single function separated by the constructor it fires on. Note that this
-- isn't a single transformation per se, as one transformation might fire on
-- multiple constructors. 'Transformation' ties together multiple workers into
-- a single transformation.
--
-- The 'Name' must refer to an exported top-level worker so the generated
-- dispatch code can reference it from the splice site.
--
-- A worker that returns a term other than the one it was given must say so
-- with 'Clash.Rewrite.Util.changed': a 'chain' hands the fields it matched to
-- the next member as long as no change was signaled.
data TransformationWorker
  = FieldWorker !Constructor !Name
  -- ^ @worker :: TransformContext -> Term -> \<fields of the constructor\>
  -- -> RewriteMonad extra Term@. The worker receives the matched node (to
  -- return on the unchanged path with sharing intact) followed by the
  -- constructor's fields.
  | Worker !Constructor !Name
  -- ^ @worker :: Rewrite extra@. A worker that fires only at the given
  -- constructor, like the per-constructor worker above, but receives the
  -- whole node instead of its deconstructed fields. For transformations that
  -- decompose the node themselves, e.g. by collecting the entire application
  -- spine rather than one @App@ layer.
  | AnyWorker !Name
  -- ^ @worker :: Rewrite extra@, applied at all constructors. For a
  -- transformation whose firing condition lives in the
  -- 'Clash.Rewrite.Types.TransformContext' rather than the constructor
  -- (@topLet@).
  deriving (TransformationWorker -> TransformationWorker -> Bool
(TransformationWorker -> TransformationWorker -> Bool)
-> (TransformationWorker -> TransformationWorker -> Bool)
-> Eq TransformationWorker
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TransformationWorker -> TransformationWorker -> Bool
== :: TransformationWorker -> TransformationWorker -> Bool
$c/= :: TransformationWorker -> TransformationWorker -> Bool
/= :: TransformationWorker -> TransformationWorker -> Bool
Eq, Int -> TransformationWorker -> ShowS
[TransformationWorker] -> ShowS
TransformationWorker -> String
(Int -> TransformationWorker -> ShowS)
-> (TransformationWorker -> String)
-> ([TransformationWorker] -> ShowS)
-> Show TransformationWorker
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TransformationWorker -> ShowS
showsPrec :: Int -> TransformationWorker -> ShowS
$cshow :: TransformationWorker -> String
show :: TransformationWorker -> String
$cshowList :: [TransformationWorker] -> ShowS
showList :: [TransformationWorker] -> ShowS
Show)

-- | Single, named transformation. Can consist of multiple workers (see
-- 'TransformationWorker').
data Transformation = Transformation
  { Transformation -> String
name :: !String
  -- ^ Canonical name, used for debug tracing, transformation counters, and
  -- the rewrite history.
  , Transformation -> [TransformationWorker]
workers :: ![TransformationWorker]
  } deriving (Transformation -> Transformation -> Bool
(Transformation -> Transformation -> Bool)
-> (Transformation -> Transformation -> Bool) -> Eq Transformation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Transformation -> Transformation -> Bool
== :: Transformation -> Transformation -> Bool
$c/= :: Transformation -> Transformation -> Bool
/= :: Transformation -> Transformation -> Bool
Eq, Int -> Transformation -> ShowS
[Transformation] -> ShowS
Transformation -> String
(Int -> Transformation -> ShowS)
-> (Transformation -> String)
-> ([Transformation] -> ShowS)
-> Show Transformation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Transformation -> ShowS
showsPrec :: Int -> Transformation -> ShowS
$cshow :: Transformation -> String
show :: Transformation -> String
$cshowList :: [Transformation] -> ShowS
showList :: [Transformation] -> ShowS
Show)

-- | Declare a transformation's workers: at most one per constructor, and
-- either an 'AnyWorker' or per-constructor workers, never both. Checked when
-- the transformation is compiled.
toTransformation :: String -> [TransformationWorker] -> Transformation
toTransformation :: String -> [TransformationWorker] -> Transformation
toTransformation = String -> [TransformationWorker] -> Transformation
Transformation

-- | Declare a transformation that fires at any constructor. See 'AnyWorker'.
anyConstructor :: String -> Name -> Transformation
anyConstructor :: String -> Name -> Transformation
anyConstructor String
name Name
worker = String -> [TransformationWorker] -> Transformation
Transformation String
name [Name -> TransformationWorker
AnyWorker Name
worker]

-- | Give a transformation a different name; used for deliberate debug
-- aliases of a transformation that runs at several strategy positions (the
-- transformation counters and rewrite history key on the name).
named :: String -> Transformation -> Transformation
named :: String -> Transformation -> Transformation
named String
alias Transformation
transformation = Transformation
transformation { name = alias }

onVar, onData, onLiteral, onPrim, onLam, onTyLam, onApp, onTyApp, onLet,
  onCase, onCast, onTick :: Name -> [TransformationWorker]
onVar :: Name -> [TransformationWorker]
onVar     = TransformationWorker -> [TransformationWorker]
forall a. a -> [a]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TransformationWorker -> [TransformationWorker])
-> (Name -> TransformationWorker) -> Name -> [TransformationWorker]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Constructor -> Name -> TransformationWorker
FieldWorker Constructor
CVar
onData :: Name -> [TransformationWorker]
onData    = TransformationWorker -> [TransformationWorker]
forall a. a -> [a]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TransformationWorker -> [TransformationWorker])
-> (Name -> TransformationWorker) -> Name -> [TransformationWorker]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Constructor -> Name -> TransformationWorker
FieldWorker Constructor
CData
onLiteral :: Name -> [TransformationWorker]
onLiteral = TransformationWorker -> [TransformationWorker]
forall a. a -> [a]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TransformationWorker -> [TransformationWorker])
-> (Name -> TransformationWorker) -> Name -> [TransformationWorker]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Constructor -> Name -> TransformationWorker
FieldWorker Constructor
CLiteral
onPrim :: Name -> [TransformationWorker]
onPrim    = TransformationWorker -> [TransformationWorker]
forall a. a -> [a]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TransformationWorker -> [TransformationWorker])
-> (Name -> TransformationWorker) -> Name -> [TransformationWorker]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Constructor -> Name -> TransformationWorker
FieldWorker Constructor
CPrim
onLam :: Name -> [TransformationWorker]
onLam     = TransformationWorker -> [TransformationWorker]
forall a. a -> [a]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TransformationWorker -> [TransformationWorker])
-> (Name -> TransformationWorker) -> Name -> [TransformationWorker]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Constructor -> Name -> TransformationWorker
FieldWorker Constructor
CLam
onTyLam :: Name -> [TransformationWorker]
onTyLam   = TransformationWorker -> [TransformationWorker]
forall a. a -> [a]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TransformationWorker -> [TransformationWorker])
-> (Name -> TransformationWorker) -> Name -> [TransformationWorker]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Constructor -> Name -> TransformationWorker
FieldWorker Constructor
CTyLam
onApp :: Name -> [TransformationWorker]
onApp     = TransformationWorker -> [TransformationWorker]
forall a. a -> [a]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TransformationWorker -> [TransformationWorker])
-> (Name -> TransformationWorker) -> Name -> [TransformationWorker]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Constructor -> Name -> TransformationWorker
FieldWorker Constructor
CApp
onTyApp :: Name -> [TransformationWorker]
onTyApp   = TransformationWorker -> [TransformationWorker]
forall a. a -> [a]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TransformationWorker -> [TransformationWorker])
-> (Name -> TransformationWorker) -> Name -> [TransformationWorker]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Constructor -> Name -> TransformationWorker
FieldWorker Constructor
CTyApp
onLet :: Name -> [TransformationWorker]
onLet     = TransformationWorker -> [TransformationWorker]
forall a. a -> [a]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TransformationWorker -> [TransformationWorker])
-> (Name -> TransformationWorker) -> Name -> [TransformationWorker]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Constructor -> Name -> TransformationWorker
FieldWorker Constructor
CLet
onCase :: Name -> [TransformationWorker]
onCase    = TransformationWorker -> [TransformationWorker]
forall a. a -> [a]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TransformationWorker -> [TransformationWorker])
-> (Name -> TransformationWorker) -> Name -> [TransformationWorker]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Constructor -> Name -> TransformationWorker
FieldWorker Constructor
CCase
onCast :: Name -> [TransformationWorker]
onCast    = TransformationWorker -> [TransformationWorker]
forall a. a -> [a]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TransformationWorker -> [TransformationWorker])
-> (Name -> TransformationWorker) -> Name -> [TransformationWorker]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Constructor -> Name -> TransformationWorker
FieldWorker Constructor
CCast
onTick :: Name -> [TransformationWorker]
onTick    = TransformationWorker -> [TransformationWorker]
forall a. a -> [a]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TransformationWorker -> [TransformationWorker])
-> (Name -> TransformationWorker) -> Name -> [TransformationWorker]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Constructor -> Name -> TransformationWorker
FieldWorker Constructor
CTick

onVarNode, onPrimNode, onAppNode, onTyAppNode, onLetNode,
  onTickNode :: Name -> [TransformationWorker]
onVarNode :: Name -> [TransformationWorker]
onVarNode   = TransformationWorker -> [TransformationWorker]
forall a. a -> [a]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TransformationWorker -> [TransformationWorker])
-> (Name -> TransformationWorker) -> Name -> [TransformationWorker]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Constructor -> Name -> TransformationWorker
Worker Constructor
CVar
onPrimNode :: Name -> [TransformationWorker]
onPrimNode  = TransformationWorker -> [TransformationWorker]
forall a. a -> [a]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TransformationWorker -> [TransformationWorker])
-> (Name -> TransformationWorker) -> Name -> [TransformationWorker]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Constructor -> Name -> TransformationWorker
Worker Constructor
CPrim
onAppNode :: Name -> [TransformationWorker]
onAppNode   = TransformationWorker -> [TransformationWorker]
forall a. a -> [a]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TransformationWorker -> [TransformationWorker])
-> (Name -> TransformationWorker) -> Name -> [TransformationWorker]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Constructor -> Name -> TransformationWorker
Worker Constructor
CApp
onTyAppNode :: Name -> [TransformationWorker]
onTyAppNode = TransformationWorker -> [TransformationWorker]
forall a. a -> [a]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TransformationWorker -> [TransformationWorker])
-> (Name -> TransformationWorker) -> Name -> [TransformationWorker]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Constructor -> Name -> TransformationWorker
Worker Constructor
CTyApp
onLetNode :: Name -> [TransformationWorker]
onLetNode   = TransformationWorker -> [TransformationWorker]
forall a. a -> [a]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TransformationWorker -> [TransformationWorker])
-> (Name -> TransformationWorker) -> Name -> [TransformationWorker]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Constructor -> Name -> TransformationWorker
Worker Constructor
CLet
onTickNode :: Name -> [TransformationWorker]
onTickNode  = TransformationWorker -> [TransformationWorker]
forall a. a -> [a]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TransformationWorker -> [TransformationWorker])
-> (Name -> TransformationWorker) -> Name -> [TransformationWorker]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Constructor -> Name -> TransformationWorker
Worker Constructor
CTick

-- | What runs at a single node inside a fused traversal.
data Step
  = Chain [Transformation]
  -- ^ One constructor match dispatches the members registered for that
  -- constructor, in list order. Equivalent to the sequential
  -- @apply n1 t1 '>->' apply n2 t2 …@ chain over all members.
  | SeqS Step Step
  -- ^ '>->' at the node: the right side re-dispatches on the left side's
  -- result.
  | OnChangeS Step Step
  -- ^ '!->' at the node: the right side runs only when the left side
  -- signaled change.
  | OnNoChangeS Step Step
  -- ^ '>-!' at the node: the right side runs only when the left side did
  -- not signal change.
  | EmbedS Strat
  -- ^ A whole strategy as one node action.
  deriving (Step -> Step -> Bool
(Step -> Step -> Bool) -> (Step -> Step -> Bool) -> Eq Step
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Step -> Step -> Bool
== :: Step -> Step -> Bool
$c/= :: Step -> Step -> Bool
/= :: Step -> Step -> Bool
Eq, Int -> Step -> ShowS
[Step] -> ShowS
Step -> String
(Int -> Step -> ShowS)
-> (Step -> String) -> ([Step] -> ShowS) -> Show Step
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Step -> ShowS
showsPrec :: Int -> Step -> ShowS
$cshow :: Step -> String
show :: Step -> String
$cshowList :: [Step] -> ShowS
showList :: [Step] -> ShowS
Show)

-- | A complete rewriting strategy.
data Strat
  = TopDown Step
  -- ^ Fused 'Clash.Rewrite.Combinators.topdownR': repeat the step at each
  -- node until it no longer fires, then descend.
  | BottomUp Step
  -- ^ Fused 'Clash.Rewrite.Combinators.bottomupR': descend first, run the
  -- step once on the rebuilt node.
  | TopDownFix Step
  -- ^ Fused 'Clash.Rewrite.Combinators.topdownFixR'. Mind its soundness
  -- precondition (Note [topdownFixR] in "Clash.Rewrite.Combinators").
  | TopDownSuc Step
  -- ^ Fused 'Clash.Rewrite.Combinators.topdownSucR': stop at the first
  -- success, neither repeating nor descending below it.
  | InnerMost Step
  -- ^ Fused 'Clash.Rewrite.Combinators.innerMost': bottom-up; when the step
  -- fires, re-traverse the result until the innermost fixpoint is reached.
  | Pass String Name
  -- ^ A whole-term pass: @apply \<name\> \<rewrite\>@, for transformations
  -- that traverse the term themselves (@makeANF@, @etaExpansionTL@, …).
  | CallStrategy Name
  -- ^ Reference to another compiled strategy binding.
  | Seq Strat Strat            -- ^ '>->'
  | DeepSeqS Strat Strat       -- ^ '>-!->'
  | OnChange Strat Strat       -- ^ '!->'
  | OnNoChange Strat Strat     -- ^ '>-!'
  | Repeat Strat               -- ^ 'repeatR'
  deriving (Strat -> Strat -> Bool
(Strat -> Strat -> Bool) -> (Strat -> Strat -> Bool) -> Eq Strat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Strat -> Strat -> Bool
== :: Strat -> Strat -> Bool
$c/= :: Strat -> Strat -> Bool
/= :: Strat -> Strat -> Bool
Eq, Int -> Strat -> ShowS
[Strat] -> ShowS
Strat -> String
(Int -> Strat -> ShowS)
-> (Strat -> String) -> ([Strat] -> ShowS) -> Show Strat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Strat -> ShowS
showsPrec :: Int -> Strat -> ShowS
$cshow :: Strat -> String
show :: Strat -> String
$cshowList :: [Strat] -> ShowS
showList :: [Strat] -> ShowS
Show)

-- | Things that can be used where a 'Step' is expected; a bare
-- 'Transformation' lifts to a singleton 'chain'.
class ToStep s where
  toStep :: s -> Step

instance ToStep Step where
  toStep :: Step -> Step
toStep = Step -> Step
forall a. a -> a
id

instance ToStep Transformation where
  toStep :: Transformation -> Step
toStep = Transformation -> Step
one

-- | An ordered chain of transformations, dispatched per constructor. See
-- 'Chain'.
chain :: [Transformation] -> Step
chain :: [Transformation] -> Step
chain = [Transformation] -> Step
Chain

-- | A singleton 'chain', for use as an operand of the node-level operators.
one :: Transformation -> Step
one :: Transformation -> Step
one = [Transformation] -> Step
Chain ([Transformation] -> Step)
-> (Transformation -> [Transformation]) -> Transformation -> Step
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transformation -> [Transformation]
forall a. a -> [a]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure

-- | Embed a whole strategy as a single node action.
nested :: Strat -> Step
nested :: Strat -> Step
nested = Strat -> Step
EmbedS

topdown, bottomup, topdownFix, topdownSuc, innerMost :: ToStep s => s -> Strat
topdown :: forall s. ToStep s => s -> Strat
topdown    = Step -> Strat
TopDown (Step -> Strat) -> (s -> Step) -> s -> Strat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Step
forall s. ToStep s => s -> Step
toStep
bottomup :: forall s. ToStep s => s -> Strat
bottomup   = Step -> Strat
BottomUp (Step -> Strat) -> (s -> Step) -> s -> Strat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Step
forall s. ToStep s => s -> Step
toStep
topdownFix :: forall s. ToStep s => s -> Strat
topdownFix = Step -> Strat
TopDownFix (Step -> Strat) -> (s -> Step) -> s -> Strat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Step
forall s. ToStep s => s -> Step
toStep
topdownSuc :: forall s. ToStep s => s -> Strat
topdownSuc = Step -> Strat
TopDownSuc (Step -> Strat) -> (s -> Step) -> s -> Strat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Step
forall s. ToStep s => s -> Step
toStep
innerMost :: forall s. ToStep s => s -> Strat
innerMost  = Step -> Strat
InnerMost (Step -> Strat) -> (s -> Step) -> s -> Strat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Step
forall s. ToStep s => s -> Step
toStep

-- | A whole-term pass, run as @apply \<name\> \<rewrite\>@.
pass :: String -> Name -> Strat
pass :: String -> Name -> Strat
pass = String -> Name -> Strat
Pass

-- | Reference another compiled strategy by the name of its binding.
callStrategy :: Name -> Strat
callStrategy :: Name -> Strat
callStrategy = Name -> Strat
CallStrategy

-- | Keep applying a strategy until it no longer fires.
repeatR :: Strat -> Strat
repeatR :: Strat -> Strat
repeatR = Strat -> Strat
Repeat

infixr 6 >->
infixr 5 !->
infixr 5 >-!

-- | The combinators shared by both DSL layers. Fixities match
-- "Clash.Rewrite.Combinators"; a strategy spec module should import only
-- this module, so the names are unambiguous there.
class Strategic a where
  -- | Apply two strategies in succession.
  (>->) :: a -> a -> a
  -- | Only apply the second strategy if the first one succeeds.
  (!->) :: a -> a -> a
  -- | Only apply the second strategy if the first one fails.
  (>-!) :: a -> a -> a

instance Strategic Strat where
  >-> :: Strat -> Strat -> Strat
(>->) = Strat -> Strat -> Strat
Seq
  !-> :: Strat -> Strat -> Strat
(!->) = Strat -> Strat -> Strat
OnChange
  >-! :: Strat -> Strat -> Strat
(>-!) = Strat -> Strat -> Strat
OnNoChange

instance Strategic Step where
  >-> :: Step -> Step -> Step
(>->) = Step -> Step -> Step
SeqS
  !-> :: Step -> Step -> Step
(!->) = Step -> Step -> Step
OnChangeS
  >-! :: Step -> Step -> Step
(>-!) = Step -> Step -> Step
OnNoChangeS

infixr 6 >-!->

-- | Apply two strategies in succession, with a @deepseq@ of the term in
-- between. Strategy layer only.
(>-!->) :: Strat -> Strat -> Strat
>-!-> :: Strat -> Strat -> Strat
(>-!->) = Strat -> Strat -> Strat
DeepSeqS