msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

AppPredefined.hs: more readable notation for the types of primitives

Browse Source
This commit is contained in:
hallgren
2011-10-20 14:17:37 +00:00
parent 3dbdc56669
commit d8d60adb15
1 changed files with 19 additions and 16 deletions
Download Patch File Download Diff File Expand all files Collapse all files

35
src/compiler/GF/Compile/Compute/AppPredefined.hs
View File

@@ -52,26 +52,26 @@ primitives = Map.fromList
[ (cErrorType, ResOper (Just (noLoc typeType)) Nothing) [ (cErrorType, ResOper (Just (noLoc typeType)) Nothing)
, (cInt , ResOper (Just (noLoc typePType)) Nothing) , (cInt , ResOper (Just (noLoc typePType)) Nothing)
, (cFloat , ResOper (Just (noLoc typePType)) Nothing) , (cFloat , ResOper (Just (noLoc typePType)) Nothing)
, (cInts , ResOper (Just (noLoc (mkFunType [typeInt] typePType))) Nothing) , (cInts , fun [typeInt] typePType)
, (cPBool , ResParam (Just [noLoc (cPTrue,[]),noLoc (cPFalse,[])]) (Just [QC (cPredef,cPTrue), QC (cPredef,cPFalse)])) , (cPBool , ResParam (Just [noLoc (cPTrue,[]),noLoc (cPFalse,[])]) (Just [QC (cPredef,cPTrue), QC (cPredef,cPFalse)]))
, (cPTrue , ResValue (noLoc typePBool)) , (cPTrue , ResValue (noLoc typePBool))
, (cPFalse , ResValue (noLoc typePBool)) , (cPFalse , ResValue (noLoc typePBool))
, (cError , ResOper (Just (noLoc (mkFunType [typeStr] typeError))) Nothing) -- non-can. of empty set , (cError , fun [typeStr] typeError) -- non-can. of empty set
, (cLength , ResOper (Just (noLoc (mkFunType [typeTok] typeInt))) Nothing) , (cLength , fun [typeTok] typeInt)
, (cDrop , ResOper (Just (noLoc (mkFunType [typeInt,typeTok] typeTok))) Nothing) , (cDrop , fun [typeInt,typeTok] typeTok)
, (cTake , ResOper (Just (noLoc (mkFunType [typeInt,typeTok] typeTok))) Nothing) , (cTake , fun [typeInt,typeTok] typeTok)
, (cTk , ResOper (Just (noLoc (mkFunType [typeInt,typeTok] typeTok))) Nothing) , (cTk , fun [typeInt,typeTok] typeTok)
, (cDp , ResOper (Just (noLoc (mkFunType [typeInt,typeTok] typeTok))) Nothing) , (cDp , fun [typeInt,typeTok] typeTok)
, (cEqInt , ResOper (Just (noLoc (mkFunType [typeInt,typeInt] typePBool))) Nothing) , (cEqInt , fun [typeInt,typeInt] typePBool)
, (cLessInt , ResOper (Just (noLoc (mkFunType [typeInt,typeInt] typePBool))) Nothing) , (cLessInt , fun [typeInt,typeInt] typePBool)
, (cPlus , ResOper (Just (noLoc (mkFunType [typeInt,typeInt] typeInt))) Nothing) , (cPlus , fun [typeInt,typeInt] typeInt)
, (cEqStr , ResOper (Just (noLoc (mkFunType [typeTok,typeTok] typePBool))) Nothing) , (cEqStr , fun [typeTok,typeTok] typePBool)
, (cOccur , ResOper (Just (noLoc (mkFunType [typeTok,typeTok] typePBool))) Nothing) , (cOccur , fun [typeTok,typeTok] typePBool)
, (cOccurs , ResOper (Just (noLoc (mkFunType [typeTok,typeTok] typePBool))) Nothing) , (cOccurs , fun [typeTok,typeTok] typePBool)
, (cToUpper , ResOper (Just (noLoc (mkFunType [typeTok] typeTok))) Nothing) , (cToUpper , fun [typeTok] typeTok)
, (cToLower , ResOper (Just (noLoc (mkFunType [typeTok] typeTok))) Nothing) , (cToLower , fun [typeTok] typeTok)
, (cIsUpper , ResOper (Just (noLoc (mkFunType [typeTok] typePBool))) Nothing) , (cIsUpper , fun [typeTok] typePBool)
---- "read" -> ---- "read" ->
, (cRead , ResOper (Just (noLoc (mkProd -- (P : Type) -> Tok -> P , (cRead , ResOper (Just (noLoc (mkProd -- (P : Type) -> Tok -> P
@@ -84,6 +84,9 @@ primitives = Map.fromList
[(Explicit,varL,typeType),(Explicit,identW,mkFunType [typeStr] typeStr),(Explicit,identW,Vr varL)] (Vr varL) []))) Nothing) [(Explicit,varL,typeType),(Explicit,identW,mkFunType [typeStr] typeStr),(Explicit,identW,Vr varL)] (Vr varL) []))) Nothing)
] ]
where where
fun from to = oper (mkFunType from to)
oper ty = ResOper (Just (noLoc ty)) Nothing
noLoc = L (0,0) noLoc = L (0,0)
varL :: Ident varL :: Ident