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

@@ -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

src/compiler/GF/Compile/TypeCheck/Concrete.hs

@@ -9,7 +9,7 @@ import GF.Grammar.Lookup
 import GF.Grammar.Predef
 import GF.Grammar.PatternMatch
 import GF.Grammar.Lockfield (isLockLabel, lockRecType, unlockRecord)
-import GF.Compile.Compute.AppPredefined
+import GF.Compile.TypeCheck.Primitives
 
 import Data.List
 import Control.Monad

src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs

@@ -5,7 +5,7 @@ import GF.Grammar.Lookup
 import GF.Grammar.Predef
 import GF.Grammar.Lockfield
 import GF.Compile.Compute.ConcreteNew1
-import GF.Compile.Compute.AppPredefined
+import GF.Compile.TypeCheck.Primitives
 import GF.Infra.CheckM
 --import GF.Infra.UseIO
 import GF.Data.Operations

src/compiler/GF/Compile/TypeCheck/Primitives.hs

@@ -0,0 +1,62 @@
+module GF.Compile.TypeCheck.Primitives where
+
+import GF.Grammar
+import GF.Grammar.Predef
+import qualified Data.Map as Map
+
+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
+
+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"