module IR.Pattern.Common where

import Common.Identifiers (
  DConId (..),
  Identifier (..),
  TConId (..),
 )

import qualified Data.Map as M
import qualified Data.Set as S
import qualified IR.IR as I


data CInfo = CInfo
  { CInfo -> Identifier
cName :: Identifier
  , CInfo -> Identifier
cType :: Identifier
  , CInfo -> Int
cArity :: Int
  }
  deriving (CInfo -> CInfo -> Bool
(CInfo -> CInfo -> Bool) -> (CInfo -> CInfo -> Bool) -> Eq CInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CInfo -> CInfo -> Bool
$c/= :: CInfo -> CInfo -> Bool
== :: CInfo -> CInfo -> Bool
$c== :: CInfo -> CInfo -> Bool
Eq, Int -> CInfo -> ShowS
[CInfo] -> ShowS
CInfo -> String
(Int -> CInfo -> ShowS)
-> (CInfo -> String) -> ([CInfo] -> ShowS) -> Show CInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CInfo] -> ShowS
$cshowList :: [CInfo] -> ShowS
show :: CInfo -> String
$cshow :: CInfo -> String
showsPrec :: Int -> CInfo -> ShowS
$cshowsPrec :: Int -> CInfo -> ShowS
Show)


data TInfo = TInfo
  { TInfo -> Identifier
tName :: Identifier
  , TInfo -> Set Identifier
tCSet :: S.Set Identifier
  }
  deriving (TInfo -> TInfo -> Bool
(TInfo -> TInfo -> Bool) -> (TInfo -> TInfo -> Bool) -> Eq TInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TInfo -> TInfo -> Bool
$c/= :: TInfo -> TInfo -> Bool
== :: TInfo -> TInfo -> Bool
$c== :: TInfo -> TInfo -> Bool
Eq, Int -> TInfo -> ShowS
[TInfo] -> ShowS
TInfo -> String
(Int -> TInfo -> ShowS)
-> (TInfo -> String) -> ([TInfo] -> ShowS) -> Show TInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TInfo] -> ShowS
$cshowList :: [TInfo] -> ShowS
show :: TInfo -> String
$cshow :: TInfo -> String
showsPrec :: Int -> TInfo -> ShowS
$cshowsPrec :: Int -> TInfo -> ShowS
Show)


buildTypeMap :: [(TConId, I.TypeDef)] -> M.Map Identifier TInfo
buildTypeMap :: [(TConId, TypeDef)] -> Map Identifier TInfo
buildTypeMap = ((TConId, TypeDef) -> Map Identifier TInfo -> Map Identifier TInfo)
-> Map Identifier TInfo
-> [(TConId, TypeDef)]
-> Map Identifier TInfo
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (TConId, TypeDef) -> Map Identifier TInfo -> Map Identifier TInfo
tAcc Map Identifier TInfo
forall k a. Map k a
M.empty
 where
  tAcc :: (TConId, TypeDef) -> Map Identifier TInfo -> Map Identifier TInfo
tAcc (TConId, TypeDef)
td' Map Identifier TInfo
tmap' =
    let (TConId Identifier
typ, TypeDef
td) = (TConId, TypeDef)
td'
        clist :: [Identifier]
clist = ((DConId, TypeVariant) -> Identifier)
-> [(DConId, TypeVariant)] -> [Identifier]
forall a b. (a -> b) -> [a] -> [b]
map (\(DConId Identifier
cid, TypeVariant
_) -> Identifier
cid) ([(DConId, TypeVariant)] -> [Identifier])
-> [(DConId, TypeVariant)] -> [Identifier]
forall a b. (a -> b) -> a -> b
$ TypeDef -> [(DConId, TypeVariant)]
I.variants TypeDef
td
        cset :: Set Identifier
cset = [Identifier] -> Set Identifier
forall a. Ord a => [a] -> Set a
S.fromList [Identifier]
clist
     in Identifier -> TInfo -> Map Identifier TInfo -> Map Identifier TInfo
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Identifier
typ (TInfo :: Identifier -> Set Identifier -> TInfo
TInfo{tName :: Identifier
tName = Identifier
typ, tCSet :: Set Identifier
tCSet = Set Identifier
cset}) Map Identifier TInfo
tmap'


buildConsMap :: [(TConId, I.TypeDef)] -> M.Map Identifier CInfo
buildConsMap :: [(TConId, TypeDef)] -> Map Identifier CInfo
buildConsMap = ((TConId, TypeDef) -> Map Identifier CInfo -> Map Identifier CInfo)
-> Map Identifier CInfo
-> [(TConId, TypeDef)]
-> Map Identifier CInfo
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (TConId, TypeDef) -> Map Identifier CInfo -> Map Identifier CInfo
cAcc Map Identifier CInfo
forall k a. Map k a
M.empty
 where
  cAcc :: (TConId, TypeDef) -> Map Identifier CInfo -> Map Identifier CInfo
cAcc (TConId, TypeDef)
td' Map Identifier CInfo
cmap' =
    let (TConId Identifier
typ, TypeDef
td) = (TConId, TypeDef)
td'
        clist :: [(DConId, TypeVariant)]
clist = TypeDef -> [(DConId, TypeVariant)]
I.variants TypeDef
td
        cAcc' :: (DConId, TypeVariant)
-> Map Identifier CInfo -> Map Identifier CInfo
cAcc' (DConId, TypeVariant)
tvp Map Identifier CInfo
cmap'' =
          let (DConId Identifier
cid, TypeVariant
tvars) = (DConId, TypeVariant)
tvp
              arity :: Int
arity = case TypeVariant
tvars of
                I.VariantUnnamed tl -> [Type] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
tl
                I.VariantNamed tl -> [(VarId, Type)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(VarId, Type)]
tl
              c :: CInfo
c = CInfo :: Identifier -> Identifier -> Int -> CInfo
CInfo{cName :: Identifier
cName = Identifier
cid, cType :: Identifier
cType = Identifier
typ, cArity :: Int
cArity = Int
arity}
           in Identifier -> CInfo -> Map Identifier CInfo -> Map Identifier CInfo
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Identifier
cid CInfo
c Map Identifier CInfo
cmap''
     in ((DConId, TypeVariant)
 -> Map Identifier CInfo -> Map Identifier CInfo)
-> Map Identifier CInfo
-> [(DConId, TypeVariant)]
-> Map Identifier CInfo
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (DConId, TypeVariant)
-> Map Identifier CInfo -> Map Identifier CInfo
cAcc' Map Identifier CInfo
cmap' [(DConId, TypeVariant)]
clist