{-# OPTIONS_HADDOCK not-home #-}
module Morley.Michelson.Typed.ClassifiedInstr.Internal.Classifiers.NumChildren
( module Morley.Michelson.Typed.ClassifiedInstr.Internal.Classifiers.NumChildren
) where
import Prelude hiding (Type)
import Language.Haskell.TH (Type(..))
import Morley.Michelson.Typed.ClassifiedInstr.Internal.Types
import Morley.Michelson.Typed.Instr (ExtInstr, Instr)
numChildren :: [Type] -> NumChildren
numChildren :: [Type] -> NumChildren
numChildren [Type]
args
| (Element [Type] -> Bool) -> [Type] -> Bool
forall t. Container t => (Element t -> Bool) -> t -> Bool
any Type -> Bool
Element [Type] -> Bool
isExtInstr [Type]
args = NumChildren
MayHaveChildren
| (Element [Type] -> Bool) -> [Type] -> Bool
forall t. Container t => (Element t -> Bool) -> t -> Bool
any (Type -> Bool
isAppToInstr (Type -> Bool) -> (Type -> Bool) -> Type -> Bool
forall a. Boolean a => a -> a -> a
&& Bool -> Bool
not (Bool -> Bool) -> (Type -> Bool) -> Type -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Bool
isInstr) [Type]
args = NumChildren
HasIndirectChildren
| Bool
otherwise = case [Type] -> Int
countInstrArgs [Type]
args of
Int
0 -> NumChildren
NoChildren
Int
1 -> NumChildren
OneChild
Int
2 -> NumChildren
TwoChildren
Int
x -> Text -> NumChildren
forall a. HasCallStack => Text -> a
error (Text -> NumChildren) -> Text -> NumChildren
forall a b. (a -> b) -> a -> b
$ Text
"Instruction has too many children: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (PrettyShow a, Show a, IsString b) => a -> b
show Int
x
countInstrArgs :: [Type] -> Int
countInstrArgs :: [Type] -> Int
countInstrArgs = Int -> [Type] -> Int
forall {t}. Num t => t -> [Type] -> t
go Int
0
where
go :: t -> [Type] -> t
go !t
n = \case
[] -> t
n
(Type
x:[Type]
xs)
| Type -> Bool
isInstr Type
x -> t -> [Type] -> t
go (t
nt -> t -> t
forall a. Num a => a -> a -> a
+t
1) [Type]
xs
| Bool
otherwise -> t -> [Type] -> t
go t
n [Type]
xs
isExtInstr :: Type -> Bool
isExtInstr :: Type -> Bool
isExtInstr = \case
AppT Type
x Type
_ -> Type -> Bool
isExtInstr Type
x
ConT Name
n | Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== ''ExtInstr -> Bool
True
Type
_ -> Bool
False
isInstr :: Type -> Bool
isInstr :: Type -> Bool
isInstr = \case
AppT Type
x Type
_ -> Type -> Bool
isInstr Type
x
ConT Name
n | Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== ''Instr -> Bool
True
Type
_ -> Bool
False
isAppToInstr :: Type -> Bool
isAppToInstr :: Type -> Bool
isAppToInstr = \case
AppT Type
x Type
y -> Type -> Bool
isAppToInstr Type
x Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
|| Type -> Bool
isAppToInstr Type
y
ConT Name
n | Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== ''Instr -> Bool
True
Type
_ -> Bool
False