module GF.Compile.TypeCheck.Primitives where

import GF.Grammar
import GF.Grammar.Predef
import qualified Data.Map as Map

typPredefined :: Ident -> Maybe Type
typPredefined :: Ident -> Maybe Type
typPredefined Ident
f = case Ident -> Map Ident Info -> Maybe Info
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Ident
f Map Ident Info
primitives of
                    Just (ResOper (Just (L Location
_ Type
ty)) Maybe (L Type)
_) -> Type -> Maybe Type
forall a. a -> Maybe a
Just Type
ty
                    Just (ResParam Maybe (L [Param])
_ Maybe [Type]
_)              -> Type -> Maybe Type
forall a. a -> Maybe a
Just Type
typePType
                    Just (ResValue (L Location
_ Type
ty))         -> Type -> Maybe Type
forall a. a -> Maybe a
Just Type
ty
                    Maybe Info
_                                -> Maybe Type
forall a. Maybe a
Nothing

primitives :: Map Ident Info
primitives = [(Ident, Info)] -> Map Ident Info
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
  [ (Ident
cErrorType, Maybe (L Type) -> Maybe (L Type) -> Info
ResOper (L Type -> Maybe (L Type)
forall a. a -> Maybe a
Just (Type -> L Type
forall a. a -> L a
noLoc Type
typeType)) Maybe (L Type)
forall a. Maybe a
Nothing)
  , (Ident
cInt      , Maybe (L Type) -> Maybe (L Type) -> Info
ResOper (L Type -> Maybe (L Type)
forall a. a -> Maybe a
Just (Type -> L Type
forall a. a -> L a
noLoc Type
typePType)) Maybe (L Type)
forall a. Maybe a
Nothing)
  , (Ident
cFloat    , Maybe (L Type) -> Maybe (L Type) -> Info
ResOper (L Type -> Maybe (L Type)
forall a. a -> Maybe a
Just (Type -> L Type
forall a. a -> L a
noLoc Type
typePType)) Maybe (L Type)
forall a. Maybe a
Nothing)
  , (Ident
cInts     , [Type] -> Type -> Info
fun [Type
typeInt] Type
typePType)
  , (Ident
cPBool    , Maybe (L [Param]) -> Maybe [Type] -> Info
ResParam (L [Param] -> Maybe (L [Param])
forall a. a -> Maybe a
Just ([Param] -> L [Param]
forall a. a -> L a
noLoc [(Ident
cPTrue,[]),(Ident
cPFalse,[])])) ([Type] -> Maybe [Type]
forall a. a -> Maybe a
Just [QIdent -> Type
QC (ModuleName
cPredef,Ident
cPTrue), QIdent -> Type
QC (ModuleName
cPredef,Ident
cPFalse)]))
  , (Ident
cPTrue    , L Type -> Info
ResValue (Type -> L Type
forall a. a -> L a
noLoc Type
typePBool))
  , (Ident
cPFalse   , L Type -> Info
ResValue (Type -> L Type
forall a. a -> L a
noLoc Type
typePBool))
  , (Ident
cError    , [Type] -> Type -> Info
fun [Type
typeStr] Type
typeError)  -- non-can. of empty set
  , (Ident
cLength   , [Type] -> Type -> Info
fun [Type
typeTok] Type
typeInt)
  , (Ident
cDrop     , [Type] -> Type -> Info
fun [Type
typeInt,Type
typeTok] Type
typeTok)
  , (Ident
cTake     , [Type] -> Type -> Info
fun [Type
typeInt,Type
typeTok] Type
typeTok)
  , (Ident
cTk       , [Type] -> Type -> Info
fun [Type
typeInt,Type
typeTok] Type
typeTok)
  , (Ident
cDp       , [Type] -> Type -> Info
fun [Type
typeInt,Type
typeTok] Type
typeTok)
  , (Ident
cEqInt    , [Type] -> Type -> Info
fun [Type
typeInt,Type
typeInt] Type
typePBool)
  , (Ident
cLessInt  , [Type] -> Type -> Info
fun [Type
typeInt,Type
typeInt] Type
typePBool)
  , (Ident
cPlus     , [Type] -> Type -> Info
fun [Type
typeInt,Type
typeInt] Type
typeInt)
  , (Ident
cEqStr    , [Type] -> Type -> Info
fun [Type
typeTok,Type
typeTok] Type
typePBool)
  , (Ident
cOccur    , [Type] -> Type -> Info
fun [Type
typeTok,Type
typeTok] Type
typePBool)
  , (Ident
cOccurs   , [Type] -> Type -> Info
fun [Type
typeTok,Type
typeTok] Type
typePBool)

  , (Ident
cToUpper  , [Type] -> Type -> Info
fun [Type
typeTok] Type
typeTok)
  , (Ident
cToLower  , [Type] -> Type -> Info
fun [Type
typeTok] Type
typeTok)
  , (Ident
cIsUpper  , [Type] -> Type -> Info
fun [Type
typeTok] Type
typePBool)

----  "read"   -> 
  , (Ident
cRead     , Maybe (L Type) -> Maybe (L Type) -> Info
ResOper (L Type -> Maybe (L Type)
forall a. a -> Maybe a
Just (Type -> L Type
forall a. a -> L a
noLoc ([Hypo] -> Type -> [Type] -> Type
mkProd -- (P : Type) -> Tok -> P
                                         [(BindType
Explicit,Ident
varP,Type
typePType),(BindType
Explicit,Ident
identW,Type
typeStr)] (Ident -> Type
Vr Ident
varP) []))) Maybe (L Type)
forall a. Maybe a
Nothing)
  , (Ident
cShow     , Maybe (L Type) -> Maybe (L Type) -> Info
ResOper (L Type -> Maybe (L Type)
forall a. a -> Maybe a
Just (Type -> L Type
forall a. a -> L a
noLoc ([Hypo] -> Type -> [Type] -> Type
mkProd -- (P : PType) -> P -> Tok
                                         [(BindType
Explicit,Ident
varP,Type
typePType),(BindType
Explicit,Ident
identW,Ident -> Type
Vr Ident
varP)] Type
typeStr []))) Maybe (L Type)
forall a. Maybe a
Nothing)
  , (Ident
cEqVal    , Maybe (L Type) -> Maybe (L Type) -> Info
ResOper (L Type -> Maybe (L Type)
forall a. a -> Maybe a
Just (Type -> L Type
forall a. a -> L a
noLoc ([Hypo] -> Type -> [Type] -> Type
mkProd -- (P : PType) -> P -> P -> PBool
                                         [(BindType
Explicit,Ident
varP,Type
typePType),(BindType
Explicit,Ident
identW,Ident -> Type
Vr Ident
varP),(BindType
Explicit,Ident
identW,Ident -> Type
Vr Ident
varP)] Type
typePBool []))) Maybe (L Type)
forall a. Maybe a
Nothing)
  , (Ident
cToStr    , Maybe (L Type) -> Maybe (L Type) -> Info
ResOper (L Type -> Maybe (L Type)
forall a. a -> Maybe a
Just (Type -> L Type
forall a. a -> L a
noLoc ([Hypo] -> Type -> [Type] -> Type
mkProd -- (L : Type)  -> L -> Str
                                         [(BindType
Explicit,Ident
varL,Type
typeType),(BindType
Explicit,Ident
identW,Ident -> Type
Vr Ident
varL)] Type
typeStr []))) Maybe (L Type)
forall a. Maybe a
Nothing)
  , (Ident
cMapStr   , Maybe (L Type) -> Maybe (L Type) -> Info
ResOper (L Type -> Maybe (L Type)
forall a. a -> Maybe a
Just (Type -> L Type
forall a. a -> L a
noLoc ([Hypo] -> Type -> [Type] -> Type
mkProd -- (L : Type)  -> (Str -> Str) -> L -> L
                                         [(BindType
Explicit,Ident
varL,Type
typeType),(BindType
Explicit,Ident
identW,[Type] -> Type -> Type
mkFunType [Type
typeStr] Type
typeStr),(BindType
Explicit,Ident
identW,Ident -> Type
Vr Ident
varL)] (Ident -> Type
Vr Ident
varL) []))) Maybe (L Type)
forall a. Maybe a
Nothing)
  , (Ident
cNonExist , Maybe (L Type) -> Maybe (L Type) -> Info
ResOper (L Type -> Maybe (L Type)
forall a. a -> Maybe a
Just (Type -> L Type
forall a. a -> L a
noLoc ([Hypo] -> Type -> [Type] -> Type
mkProd -- Str
                                         [] Type
typeStr []))) Maybe (L Type)
forall a. Maybe a
Nothing)
  , (Ident
cBIND     , Maybe (L Type) -> Maybe (L Type) -> Info
ResOper (L Type -> Maybe (L Type)
forall a. a -> Maybe a
Just (Type -> L Type
forall a. a -> L a
noLoc ([Hypo] -> Type -> [Type] -> Type
mkProd -- Str
                                         [] Type
typeStr []))) Maybe (L Type)
forall a. Maybe a
Nothing)
  , (Ident
cSOFT_BIND, Maybe (L Type) -> Maybe (L Type) -> Info
ResOper (L Type -> Maybe (L Type)
forall a. a -> Maybe a
Just (Type -> L Type
forall a. a -> L a
noLoc ([Hypo] -> Type -> [Type] -> Type
mkProd -- Str
                                         [] Type
typeStr []))) Maybe (L Type)
forall a. Maybe a
Nothing)
  , (Ident
cSOFT_SPACE,Maybe (L Type) -> Maybe (L Type) -> Info
ResOper (L Type -> Maybe (L Type)
forall a. a -> Maybe a
Just (Type -> L Type
forall a. a -> L a
noLoc ([Hypo] -> Type -> [Type] -> Type
mkProd -- Str
                                         [] Type
typeStr []))) Maybe (L Type)
forall a. Maybe a
Nothing)
  , (Ident
cCAPIT    , Maybe (L Type) -> Maybe (L Type) -> Info
ResOper (L Type -> Maybe (L Type)
forall a. a -> Maybe a
Just (Type -> L Type
forall a. a -> L a
noLoc ([Hypo] -> Type -> [Type] -> Type
mkProd -- Str
                                         [] Type
typeStr []))) Maybe (L Type)
forall a. Maybe a
Nothing)
  , (Ident
cALL_CAPIT, Maybe (L Type) -> Maybe (L Type) -> Info
ResOper (L Type -> Maybe (L Type)
forall a. a -> Maybe a
Just (Type -> L Type
forall a. a -> L a
noLoc ([Hypo] -> Type -> [Type] -> Type
mkProd -- Str
                                         [] Type
typeStr []))) Maybe (L Type)
forall a. Maybe a
Nothing)
  ]
  where
    fun :: [Type] -> Type -> Info
fun [Type]
from Type
to = Type -> Info
oper ([Type] -> Type -> Type
mkFunType [Type]
from Type
to)
    oper :: Type -> Info
oper Type
ty     = Maybe (L Type) -> Maybe (L Type) -> Info
ResOper (L Type -> Maybe (L Type)
forall a. a -> Maybe a
Just (Type -> L Type
forall a. a -> L a
noLoc Type
ty)) Maybe (L Type)
forall a. Maybe a
Nothing

    varL :: Ident
varL = String -> Ident
identS String
"L"
    varP :: Ident
varP = String -> Ident
identS String
"P"