From 7ffdfe9b3a807686afd2d654b1198e6e6035ef84 Mon Sep 17 00:00:00 2001 From: hallgren Date: Fri, 29 Nov 2013 15:47:26 +0000 Subject: Move typePredefined from GF.Compile.Compute.AppPredefined to GF.Compile.TypeCheck.Primitives Also move the list of primitives --- src/compiler/GF/Compile/Compute/AppPredefined.hs | 59 +----------------------- 1 file changed, 1 insertion(+), 58 deletions(-) (limited to 'src/compiler/GF/Compile/Compute') 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 -- cgit v1.2.3