module Htcc.Parser.AST.DeduceKind (
addKind,
subKind
) where
import Data.Maybe (isJust)
import qualified Htcc.CRules.Types as CT
import Htcc.Parser.AST.Core (ATKind (..), ATree (..))
{-# INLINE addKind #-}
addKind :: (Eq i, Ord i, Show i) => ATree i -> ATree i -> Maybe (ATree i)
addKind :: ATree i -> ATree i -> Maybe (ATree i)
addKind lhs :: ATree i
lhs rhs :: ATree i
rhs
| (ATree i -> Bool) -> [ATree i] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (StorageClass i -> Bool
forall a. CType a => a -> Bool
CT.isFundamental (StorageClass i -> Bool)
-> (ATree i -> StorageClass i) -> ATree i -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ATree i -> StorageClass i
forall a. ATree a -> StorageClass a
atype) [ATree i
lhs, ATree i
rhs] = ATree i -> Maybe (ATree i)
forall a. a -> Maybe a
Just (ATree i -> Maybe (ATree i)) -> ATree i -> Maybe (ATree i)
forall a b. (a -> b) -> a -> b
$ ATKind i -> StorageClass i -> ATree i -> ATree i -> ATree i
forall a.
ATKind a -> StorageClass a -> ATree a -> ATree a -> ATree a
ATNode ATKind i
forall a. ATKind a
ATAdd (StorageClass i -> StorageClass i -> StorageClass i
forall a. CType a => a -> a -> a
CT.conversion (ATree i -> StorageClass i
forall a. ATree a -> StorageClass a
atype ATree i
lhs) (ATree i -> StorageClass i
forall a. ATree a -> StorageClass a
atype ATree i
rhs)) ATree i
lhs ATree i
rhs
| Maybe (StorageClass i) -> Bool
forall a. Maybe a -> Bool
isJust (StorageClass i -> Maybe (StorageClass i)
forall a. CType a => a -> Maybe a
CT.deref (StorageClass i -> Maybe (StorageClass i))
-> StorageClass i -> Maybe (StorageClass i)
forall a b. (a -> b) -> a -> b
$ ATree i -> StorageClass i
forall a. ATree a -> StorageClass a
atype ATree i
lhs) Bool -> Bool -> Bool
&& StorageClass i -> Bool
forall a. CType a => a -> Bool
CT.isFundamental (ATree i -> StorageClass i
forall a. ATree a -> StorageClass a
atype ATree i
rhs) = ATree i -> Maybe (ATree i)
forall a. a -> Maybe a
Just (ATree i -> Maybe (ATree i)) -> ATree i -> Maybe (ATree i)
forall a b. (a -> b) -> a -> b
$ ATKind i -> StorageClass i -> ATree i -> ATree i -> ATree i
forall a.
ATKind a -> StorageClass a -> ATree a -> ATree a -> ATree a
ATNode ATKind i
forall a. ATKind a
ATAddPtr (ATree i -> StorageClass i
forall a. ATree a -> StorageClass a
atype ATree i
lhs) ATree i
lhs ATree i
rhs
| StorageClass i -> Bool
forall a. CType a => a -> Bool
CT.isFundamental (ATree i -> StorageClass i
forall a. ATree a -> StorageClass a
atype ATree i
lhs) Bool -> Bool -> Bool
&& Maybe (StorageClass i) -> Bool
forall a. Maybe a -> Bool
isJust (StorageClass i -> Maybe (StorageClass i)
forall a. CType a => a -> Maybe a
CT.deref (StorageClass i -> Maybe (StorageClass i))
-> StorageClass i -> Maybe (StorageClass i)
forall a b. (a -> b) -> a -> b
$ ATree i -> StorageClass i
forall a. ATree a -> StorageClass a
atype ATree i
rhs) = ATree i -> Maybe (ATree i)
forall a. a -> Maybe a
Just (ATree i -> Maybe (ATree i)) -> ATree i -> Maybe (ATree i)
forall a b. (a -> b) -> a -> b
$ ATKind i -> StorageClass i -> ATree i -> ATree i -> ATree i
forall a.
ATKind a -> StorageClass a -> ATree a -> ATree a -> ATree a
ATNode ATKind i
forall a. ATKind a
ATAddPtr (ATree i -> StorageClass i
forall a. ATree a -> StorageClass a
atype ATree i
rhs) ATree i
rhs ATree i
lhs
| Bool
otherwise = Maybe (ATree i)
forall a. Maybe a
Nothing
{-# INLINE subKind #-}
subKind :: (Eq i, Ord i) => ATree i -> ATree i -> Maybe (ATree i)
subKind :: ATree i -> ATree i -> Maybe (ATree i)
subKind lhs :: ATree i
lhs rhs :: ATree i
rhs
| (ATree i -> Bool) -> [ATree i] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (StorageClass i -> Bool
forall a. CType a => a -> Bool
CT.isFundamental (StorageClass i -> Bool)
-> (ATree i -> StorageClass i) -> ATree i -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ATree i -> StorageClass i
forall a. ATree a -> StorageClass a
atype) [ATree i
lhs, ATree i
rhs] = ATree i -> Maybe (ATree i)
forall a. a -> Maybe a
Just (ATree i -> Maybe (ATree i)) -> ATree i -> Maybe (ATree i)
forall a b. (a -> b) -> a -> b
$ ATKind i -> StorageClass i -> ATree i -> ATree i -> ATree i
forall a.
ATKind a -> StorageClass a -> ATree a -> ATree a -> ATree a
ATNode ATKind i
forall a. ATKind a
ATSub (StorageClass i -> StorageClass i -> StorageClass i
forall a. CType a => a -> a -> a
CT.conversion (ATree i -> StorageClass i
forall a. ATree a -> StorageClass a
atype ATree i
lhs) (ATree i -> StorageClass i
forall a. ATree a -> StorageClass a
atype ATree i
rhs)) ATree i
lhs ATree i
rhs
| Maybe (StorageClass i) -> Bool
forall a. Maybe a -> Bool
isJust (StorageClass i -> Maybe (StorageClass i)
forall a. CType a => a -> Maybe a
CT.deref (StorageClass i -> Maybe (StorageClass i))
-> StorageClass i -> Maybe (StorageClass i)
forall a b. (a -> b) -> a -> b
$ ATree i -> StorageClass i
forall a. ATree a -> StorageClass a
atype ATree i
lhs) Bool -> Bool -> Bool
&& StorageClass i -> Bool
forall a. CType a => a -> Bool
CT.isFundamental (ATree i -> StorageClass i
forall a. ATree a -> StorageClass a
atype ATree i
rhs) = ATree i -> Maybe (ATree i)
forall a. a -> Maybe a
Just (ATree i -> Maybe (ATree i)) -> ATree i -> Maybe (ATree i)
forall a b. (a -> b) -> a -> b
$ ATKind i -> StorageClass i -> ATree i -> ATree i -> ATree i
forall a.
ATKind a -> StorageClass a -> ATree a -> ATree a -> ATree a
ATNode ATKind i
forall a. ATKind a
ATSubPtr (ATree i -> StorageClass i
forall a. ATree a -> StorageClass a
atype ATree i
lhs) ATree i
lhs ATree i
rhs
| (ATree i -> Bool) -> [ATree i] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Maybe (StorageClass i) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (StorageClass i) -> Bool)
-> (ATree i -> Maybe (StorageClass i)) -> ATree i -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageClass i -> Maybe (StorageClass i)
forall a. CType a => a -> Maybe a
CT.deref (StorageClass i -> Maybe (StorageClass i))
-> (ATree i -> StorageClass i) -> ATree i -> Maybe (StorageClass i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ATree i -> StorageClass i
forall a. ATree a -> StorageClass a
atype) [ATree i
lhs, ATree i
rhs] = ATree i -> Maybe (ATree i)
forall a. a -> Maybe a
Just (ATree i -> Maybe (ATree i)) -> ATree i -> Maybe (ATree i)
forall a b. (a -> b) -> a -> b
$ ATKind i -> StorageClass i -> ATree i -> ATree i -> ATree i
forall a.
ATKind a -> StorageClass a -> ATree a -> ATree a -> ATree a
ATNode ATKind i
forall a. ATKind a
ATPtrDis (ATree i -> StorageClass i
forall a. ATree a -> StorageClass a
atype ATree i
lhs) ATree i
lhs ATree i
rhs
| Bool
otherwise = Maybe (ATree i)
forall a. Maybe a
Nothing