diff options
| author | hallgren <hallgren@chalmers.se> | 2013-11-29 15:47:26 +0000 |
|---|---|---|
| committer | hallgren <hallgren@chalmers.se> | 2013-11-29 15:47:26 +0000 |
| commit | 7ffdfe9b3a807686afd2d654b1198e6e6035ef84 (patch) | |
| tree | 3831d97b3aa25b740492991dd17940a635a7bd78 /src/compiler/GF/Compile/Compute | |
| parent | 0a59f95d92223bae842323d582ec5d2eb3156a8d (diff) | |
Move typePredefined from GF.Compile.Compute.AppPredefined to GF.Compile.TypeCheck.Primitives
Also move the list of primitives
Diffstat (limited to 'src/compiler/GF/Compile/Compute')
| -rw-r--r-- | src/compiler/GF/Compile/Compute/AppPredefined.hs | 59 |
1 files changed, 1 insertions, 58 deletions
diff --git a/src/compiler/GF/Compile/Compute/AppPredefined.hs b/src/compiler/GF/Compile/Compute/AppPredefined.hs index 0d23f8cb6..6b125e001 100644 --- a/src/compiler/GF/Compile/Compute/AppPredefined.hs +++ b/src/compiler/GF/Compile/Compute/AppPredefined.hs @@ -16,7 +16,7 @@ module GF.Compile.Compute.AppPredefined ( isInPredefined, typPredefined, arrityPredefined, predefModInfo, appPredefined ) where ---import GF.Infra.Ident(identS) +import GF.Compile.TypeCheck.Primitives import GF.Infra.Option import GF.Data.Operations import GF.Grammar @@ -31,13 +31,6 @@ import Data.Char (isUpper,toUpper,toLower) isInPredefined :: Ident -> Bool isInPredefined f = Map.member f primitives -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 - arrityPredefined :: Ident -> Maybe Int arrityPredefined f = do ty <- typPredefined f let (ctxt,_) = typeFormCnc ty @@ -46,56 +39,6 @@ arrityPredefined f = do ty <- typPredefined f predefModInfo :: SourceModInfo predefModInfo = ModInfo MTResource MSComplete noOptions [] Nothing [] [] "Predef.gf" Nothing primitives -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) - ] - where - fun from to = oper (mkFunType from to) - oper ty = ResOper (Just (noLoc ty)) Nothing - - varL = identS "L" - varP = identS "P" - appPredefined :: Term -> Err (Term,Bool) appPredefined t = case t of App f x0 -> do |