{-# 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