{-# LANGUAGE LambdaCase #-}
{-|
A trivial simplification that merges adjacent non-recursive let terms.
-}
module PlutusIR.Transform.LetMerge (
  letMerge
  ) where

import PlutusIR

import Control.Lens (transformOf)

{-|
A single non-recursive application of let-merging cancellation.
-}
letMergeStep
    :: Term tyname name uni fun a
    -> Term tyname name uni fun a
letMergeStep :: Term tyname name uni fun a -> Term tyname name uni fun a
letMergeStep = \case
    Let a
a Recursivity
NonRec NonEmpty (Binding tyname name uni fun a)
bs (Let a
_ Recursivity
NonRec NonEmpty (Binding tyname name uni fun a)
bs' Term tyname name uni fun a
t) -> a
-> Recursivity
-> NonEmpty (Binding tyname name uni fun a)
-> Term tyname name uni fun a
-> Term tyname name uni fun a
forall tyname name (uni :: * -> *) fun a.
a
-> Recursivity
-> NonEmpty (Binding tyname name uni fun a)
-> Term tyname name uni fun a
-> Term tyname name uni fun a
Let a
a Recursivity
NonRec (NonEmpty (Binding tyname name uni fun a)
bs NonEmpty (Binding tyname name uni fun a)
-> NonEmpty (Binding tyname name uni fun a)
-> NonEmpty (Binding tyname name uni fun a)
forall a. Semigroup a => a -> a -> a
<> NonEmpty (Binding tyname name uni fun a)
bs') Term tyname name uni fun a
t
    Term tyname name uni fun a
t                                    -> Term tyname name uni fun a
t

{-|
Recursively apply let merging cancellation.
-}
letMerge
    :: Term tyname name uni fun a
    -> Term tyname name uni fun a
letMerge :: Term tyname name uni fun a -> Term tyname name uni fun a
letMerge = ASetter
  (Term tyname name uni fun a)
  (Term tyname name uni fun a)
  (Term tyname name uni fun a)
  (Term tyname name uni fun a)
-> (Term tyname name uni fun a -> Term tyname name uni fun a)
-> Term tyname name uni fun a
-> Term tyname name uni fun a
forall a b. ASetter a b a b -> (b -> b) -> a -> b
transformOf ASetter
  (Term tyname name uni fun a)
  (Term tyname name uni fun a)
  (Term tyname name uni fun a)
  (Term tyname name uni fun a)
forall tyname name (uni :: * -> *) fun a.
Traversal'
  (Term tyname name uni fun a) (Term tyname name uni fun a)
termSubterms Term tyname name uni fun a -> Term tyname name uni fun a
forall tyname name (uni :: * -> *) fun a.
Term tyname name uni fun a -> Term tyname name uni fun a
letMergeStep