summaryrefslogtreecommitdiff
path: root/src/compiler/GF/Compile
diff options
context:
space:
mode:
authorhallgren <hallgren@chalmers.se>2011-10-20 14:17:37 +0000
committerhallgren <hallgren@chalmers.se>2011-10-20 14:17:37 +0000
commitd8d60adb15f6dc4f107e006c3bb6338f32eb7fa9 (patch)
tree3a403a3e7113d6bf63266d91160a81dcd655a9d3 /src/compiler/GF/Compile
parent3dbdc566695bb4a00bc2ad264d1473e03d2ee64d (diff)
AppPredefined.hs: more readable notation for the types of primitives
Diffstat (limited to 'src/compiler/GF/Compile')
-rw-r--r--src/compiler/GF/Compile/Compute/AppPredefined.hs37
1 files changed, 20 insertions, 17 deletions
diff --git a/src/compiler/GF/Compile/Compute/AppPredefined.hs b/src/compiler/GF/Compile/Compute/AppPredefined.hs
index 8cde4e39e..42d53c3c2 100644
--- a/src/compiler/GF/Compile/Compute/AppPredefined.hs
+++ b/src/compiler/GF/Compile/Compute/AppPredefined.hs
@@ -52,26 +52,26 @@ primitives = Map.fromList
[ (cErrorType, ResOper (Just (noLoc typeType)) Nothing)
, (cInt , 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)]))
, (cPTrue , ResValue (noLoc typePBool))
, (cPFalse , ResValue (noLoc typePBool))
- , (cError , ResOper (Just (noLoc (mkFunType [typeStr] typeError))) Nothing) -- non-can. of empty set
- , (cLength , ResOper (Just (noLoc (mkFunType [typeTok] typeInt))) Nothing)
- , (cDrop , ResOper (Just (noLoc (mkFunType [typeInt,typeTok] typeTok))) Nothing)
- , (cTake , ResOper (Just (noLoc (mkFunType [typeInt,typeTok] typeTok))) Nothing)
- , (cTk , ResOper (Just (noLoc (mkFunType [typeInt,typeTok] typeTok))) Nothing)
- , (cDp , ResOper (Just (noLoc (mkFunType [typeInt,typeTok] typeTok))) Nothing)
- , (cEqInt , ResOper (Just (noLoc (mkFunType [typeInt,typeInt] typePBool))) Nothing)
- , (cLessInt , ResOper (Just (noLoc (mkFunType [typeInt,typeInt] typePBool))) Nothing)
- , (cPlus , ResOper (Just (noLoc (mkFunType [typeInt,typeInt] typeInt))) Nothing)
- , (cEqStr , ResOper (Just (noLoc (mkFunType [typeTok,typeTok] typePBool))) Nothing)
- , (cOccur , ResOper (Just (noLoc (mkFunType [typeTok,typeTok] typePBool))) Nothing)
- , (cOccurs , ResOper (Just (noLoc (mkFunType [typeTok,typeTok] typePBool))) Nothing)
-
- , (cToUpper , ResOper (Just (noLoc (mkFunType [typeTok] typeTok))) Nothing)
- , (cToLower , ResOper (Just (noLoc (mkFunType [typeTok] typeTok))) Nothing)
- , (cIsUpper , ResOper (Just (noLoc (mkFunType [typeTok] typePBool))) Nothing)
+ , (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
@@ -84,6 +84,9 @@ primitives = Map.fromList
[(Explicit,varL,typeType),(Explicit,identW,mkFunType [typeStr] typeStr),(Explicit,identW,Vr varL)] (Vr varL) []))) Nothing)
]
where
+ fun from to = oper (mkFunType from to)
+ oper ty = ResOper (Just (noLoc ty)) Nothing
+
noLoc = L (0,0)
varL :: Ident