{-# LANGUAGE LambdaCase #-}

-- | Strictness analysis.
module PlutusIR.Strictness (isStrictIn) where

import PlutusIR (Binding (TermBind), Strictness (Strict), Term (..))

-- | Whether the given name is strict in the given term.
isStrictIn
  :: forall tyname name uni fun a
   . (Eq name)
  => name
  -> Term tyname name uni fun a
  -> Bool
isStrictIn :: forall tyname name (uni :: * -> *) fun a.
Eq name =>
name -> Term tyname name uni fun a -> Bool
isStrictIn name
n = Term tyname name uni fun a -> Bool
forall {tyname} {uni :: * -> *} {fun} {a}.
Term tyname name uni fun a -> Bool
go
 where
  go :: Term tyname name uni fun a -> Bool
go = \case
    Var a
_ name
n' -> name
n name -> name -> Bool
forall a. Eq a => a -> a -> Bool
== name
n'
    Let a
_ Recursivity
_ NonEmpty (Binding tyname name uni fun a)
bs Term tyname name uni fun a
body -> (Binding tyname name uni fun a -> Bool)
-> NonEmpty (Binding tyname name uni fun a) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Binding tyname name uni fun a -> Bool
goBinding NonEmpty (Binding tyname name uni fun a)
bs Bool -> Bool -> Bool
|| Term tyname name uni fun a -> Bool
go Term tyname name uni fun a
body
    Apply a
_ Term tyname name uni fun a
fun Term tyname name uni fun a
arg -> Term tyname name uni fun a -> Bool
go Term tyname name uni fun a
fun Bool -> Bool -> Bool
|| Term tyname name uni fun a -> Bool
go Term tyname name uni fun a
arg
    TyInst a
_ Term tyname name uni fun a
body Type tyname uni a
_ -> Term tyname name uni fun a -> Bool
go Term tyname name uni fun a
body
    IWrap a
_ Type tyname uni a
_ Type tyname uni a
_ Term tyname name uni fun a
body -> Term tyname name uni fun a -> Bool
go Term tyname name uni fun a
body
    Unwrap a
_ Term tyname name uni fun a
body -> Term tyname name uni fun a -> Bool
go Term tyname name uni fun a
body
    Constr a
_ Type tyname uni a
_ Word64
_ [Term tyname name uni fun a]
args -> (Term tyname name uni fun a -> Bool)
-> [Term tyname name uni fun a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Term tyname name uni fun a -> Bool
go [Term tyname name uni fun a]
args
    Case a
_ Type tyname uni a
_ Term tyname name uni fun a
scrut [Term tyname name uni fun a]
_ -> Term tyname name uni fun a -> Bool
go Term tyname name uni fun a
scrut
    TyAbs{} -> Bool
False
    LamAbs{} -> Bool
False
    Constant{} -> Bool
False
    Builtin{} -> Bool
False
    Error{} -> Bool
False

  goBinding :: Binding tyname name uni fun a -> Bool
goBinding = \case
    TermBind a
_ Strictness
Strict VarDecl tyname name uni a
_ Term tyname name uni fun a
rhs -> Term tyname name uni fun a -> Bool
go Term tyname name uni fun a
rhs
    Binding tyname name uni fun a
_ -> Bool
False