----------------------------------------------------------------------
-- |
-- Module      : GF.Grammar.Predef
-- Maintainer  : kr.angelov
-- Stability   : (stable)
-- Portability : (portable)
--
-- Predefined identifiers and labels which the compiler knows
----------------------------------------------------------------------

module GF.Grammar.Predef where

import GF.Infra.Ident(Ident,identS,moduleNameS)

cType :: Ident
cType = String -> Ident
identS String
"Type"
cPType :: Ident
cPType = String -> Ident
identS String
"PType"
cTok :: Ident
cTok = String -> Ident
identS String
"Tok"
cStr :: Ident
cStr = String -> Ident
identS String
"Str"
cStrs :: Ident
cStrs = String -> Ident
identS String
"Strs"
cPredefAbs :: ModuleName
cPredefAbs = String -> ModuleName
moduleNameS String
"PredefAbs"
cPredefCnc :: ModuleName
cPredefCnc = String -> ModuleName
moduleNameS String
"PredefCnc"
cPredef :: ModuleName
cPredef = String -> ModuleName
moduleNameS String
"Predef"
cInt :: Ident
cInt = String -> Ident
identS String
"Int"
cFloat :: Ident
cFloat = String -> Ident
identS String
"Float"
cString :: Ident
cString = String -> Ident
identS String
"String"
cVar :: Ident
cVar = String -> Ident
identS String
"__gfVar"
cInts :: Ident
cInts = String -> Ident
identS String
"Ints"
cPBool :: Ident
cPBool = String -> Ident
identS String
"PBool"
cErrorType :: Ident
cErrorType = String -> Ident
identS String
"Error"
cOverload :: Ident
cOverload = String -> Ident
identS String
"overload"
cUndefinedType :: Ident
cUndefinedType = String -> Ident
identS String
"UndefinedType"
cNonExist :: Ident
cNonExist = String -> Ident
identS String
"nonExist"
cBIND :: Ident
cBIND = String -> Ident
identS String
"BIND"
cSOFT_BIND :: Ident
cSOFT_BIND = String -> Ident
identS String
"SOFT_BIND"
cSOFT_SPACE :: Ident
cSOFT_SPACE = String -> Ident
identS String
"SOFT_SPACE"
cCAPIT :: Ident
cCAPIT = String -> Ident
identS String
"CAPIT"
cALL_CAPIT :: Ident
cALL_CAPIT = String -> Ident
identS String
"ALL_CAPIT"

isPredefCat :: Ident -> Bool
isPredefCat :: Ident -> Bool
isPredefCat Ident
c = Ident -> [Ident] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Ident
c [Ident
cInt,Ident
cString,Ident
cFloat]

cPTrue :: Ident
cPTrue  = String -> Ident
identS String
"PTrue"
cPFalse :: Ident
cPFalse = String -> Ident
identS String
"PFalse"
cLength :: Ident
cLength = String -> Ident
identS String
"length"
cDrop :: Ident
cDrop = String -> Ident
identS String
"drop"
cTake :: Ident
cTake = String -> Ident
identS String
"take"
cTk :: Ident
cTk = String -> Ident
identS String
"tk"
cDp :: Ident
cDp = String -> Ident
identS String
"dp"
cToUpper :: Ident
cToUpper = String -> Ident
identS String
"toUpper"
cToLower :: Ident
cToLower = String -> Ident
identS String
"toLower"
cIsUpper :: Ident
cIsUpper = String -> Ident
identS String
"isUpper"
cEqStr :: Ident
cEqStr = String -> Ident
identS String
"eqStr"
cEqVal :: Ident
cEqVal = String -> Ident
identS String
"eqVal"
cOccur :: Ident
cOccur = String -> Ident
identS String
"occur"
cOccurs :: Ident
cOccurs = String -> Ident
identS String
"occurs"
cEqInt :: Ident
cEqInt = String -> Ident
identS String
"eqInt"
cLessInt :: Ident
cLessInt = String -> Ident
identS String
"lessInt"
cPlus :: Ident
cPlus = String -> Ident
identS String
"plus"
cShow :: Ident
cShow = String -> Ident
identS String
"show"
cRead :: Ident
cRead = String -> Ident
identS String
"read"
cToStr :: Ident
cToStr = String -> Ident
identS String
"toStr"
cMapStr :: Ident
cMapStr = String -> Ident
identS String
"mapStr"
cError :: Ident
cError = String -> Ident
identS String
"error"
cTrace :: Ident
cTrace = String -> Ident
identS String
"trace"

-- * Hacks: dummy identifiers used in various places.
-- Not very nice!

cMeta :: Ident
cMeta = String -> Ident
identS String
"?"
cAs :: Ident
cAs = String -> Ident
identS String
"@"
cChar :: Ident
cChar = String -> Ident
identS String
"?"
cChars :: Ident
cChars = String -> Ident
identS String
"[]"
cSeq :: Ident
cSeq = String -> Ident
identS String
"+"
cAlt :: Ident
cAlt = String -> Ident
identS String
"|"
cRep :: Ident
cRep = String -> Ident
identS String
"*"
cNeg :: Ident
cNeg = String -> Ident
identS String
"-"
cCNC :: Ident
cCNC = String -> Ident
identS String
"CNC"
cConflict :: Ident
cConflict = String -> Ident
identS String
"#conflict"