module GF.Compile.TypeCheck.Primitives where
import GF.Grammar
import GF.Grammar.Predef
import qualified Data.Map as Map
typPredefined :: Ident -> Maybe Type
typPredefined f = case Map.lookup f primitives of
Just (ResOper (Just (L _ ty)) _) -> Just ty
Just (ResParam _ _) -> Just typePType
Just (ResValue (L _ ty)) -> Just ty
_ -> Nothing
primitives = Map.fromList
[ (cErrorType, ResOper (Just (noLoc typeType)) Nothing)
, (cInt , ResOper (Just (noLoc typePType)) Nothing)
, (cFloat , ResOper (Just (noLoc typePType)) Nothing)
, (cInts , fun [typeInt] typePType)
, (cPBool , ResParam (Just (noLoc [(cPTrue,[]),(cPFalse,[])])) (Just [QC (cPredef,cPTrue), QC (cPredef,cPFalse)]))
, (cPTrue , ResValue (noLoc typePBool))
, (cPFalse , ResValue (noLoc typePBool))
, (cError , fun [typeStr] typeError) -- non-can. of empty set
, (cLength , fun [typeTok] typeInt)
, (cDrop , fun [typeInt,typeTok] typeTok)
, (cTake , fun [typeInt,typeTok] typeTok)
, (cTk , fun [typeInt,typeTok] typeTok)
, (cDp , fun [typeInt,typeTok] typeTok)
, (cEqInt , fun [typeInt,typeInt] typePBool)
, (cLessInt , fun [typeInt,typeInt] typePBool)
, (cPlus , fun [typeInt,typeInt] typeInt)
, (cEqStr , fun [typeTok,typeTok] typePBool)
, (cOccur , fun [typeTok,typeTok] typePBool)
, (cOccurs , fun [typeTok,typeTok] typePBool)
, (cToUpper , fun [typeTok] typeTok)
, (cToLower , fun [typeTok] typeTok)
, (cIsUpper , fun [typeTok] typePBool)
---- "read" ->
, (cRead , ResOper (Just (noLoc (mkProd -- (P : Type) -> Tok -> P
[(Explicit,varP,typePType),(Explicit,identW,typeStr)] (Vr varP) []))) Nothing)
, (cShow , ResOper (Just (noLoc (mkProd -- (P : PType) -> P -> Tok
[(Explicit,varP,typePType),(Explicit,identW,Vr varP)] typeStr []))) Nothing)
, (cEqVal , ResOper (Just (noLoc (mkProd -- (P : PType) -> P -> P -> PBool
[(Explicit,varP,typePType),(Explicit,identW,Vr varP),(Explicit,identW,Vr varP)] typePBool []))) Nothing)
, (cToStr , ResOper (Just (noLoc (mkProd -- (L : Type) -> L -> Str
[(Explicit,varL,typeType),(Explicit,identW,Vr varL)] typeStr []))) Nothing)
, (cMapStr , ResOper (Just (noLoc (mkProd -- (L : Type) -> (Str -> Str) -> L -> L
[(Explicit,varL,typeType),(Explicit,identW,mkFunType [typeStr] typeStr),(Explicit,identW,Vr varL)] (Vr varL) []))) Nothing)
, (cNonExist , ResOper (Just (noLoc (mkProd -- Str
[] typeStr []))) Nothing)
, (cBIND , ResOper (Just (noLoc (mkProd -- Str
[] typeStr []))) Nothing)
, (cSOFT_BIND, ResOper (Just (noLoc (mkProd -- Str
[] typeStr []))) Nothing)
, (cSOFT_SPACE,ResOper (Just (noLoc (mkProd -- Str
[] typeStr []))) Nothing)
, (cCAPIT , ResOper (Just (noLoc (mkProd -- Str
[] typeStr []))) Nothing)
, (cALL_CAPIT, ResOper (Just (noLoc (mkProd -- Str
[] typeStr []))) Nothing)
]
where
fun from to = oper (mkFunType from to)
oper ty = ResOper (Just (noLoc ty)) Nothing
varL = identS "L"
varP = identS "P"