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

The type signatures in Predef are no longer hard coded

Browse Source
This commit is contained in:
Krasimir Angelov
2024-02-06 08:36:43 +01:00
parent 9a6fc7fc9e
commit 9fd1c5da80
6 changed files with 20 additions and 114 deletions
Download Patch File Download Diff File Expand all files Collapse all files

9
src/compiler/api/GF/Compile/TypeCheck/Concrete.hs
View File

@@ -11,7 +11,6 @@ import GF.Grammar.Predef
import GF.Grammar.PatternMatch
import GF.Grammar.Lockfield (isLockLabel, lockRecType, unlockRecord)
import GF.Compile.Compute.Concrete(normalForm,Globals(..),stdPredef)
import GF.Compile.TypeCheck.Primitives
import Data.List
import Data.Maybe(fromMaybe,isJust,isNothing)
@@ -79,10 +78,6 @@ computeLType gr g0 t = comp (reverse [(b,x, Vr x) | (b,x,_) <- g0] ++ g0) t
inferLType :: SourceGrammar -> Context -> Term -> Check (Term, Type)
inferLType gr g trm = case trm of
Q (m,ident) | isPredef m -> termWith trm $ case typPredefined ident of
Just ty -> return ty
Nothing -> checkError ("unknown in Predef:" <+> ident)
Q ident -> checks [
termWith trm $ lookupResType gr ident >>= computeLType gr g
,
@@ -91,10 +86,6 @@ inferLType gr g trm = case trm of
checkError ("cannot infer type of constant" <+> ppTerm Unqualified 0 trm)
]
QC (m,ident) | isPredef m -> termWith trm $ case typPredefined ident of
Just ty -> return ty
Nothing -> checkError ("unknown in Predef:" <+> ident)
QC ident -> checks [
termWith trm $ lookupResType gr ident >>= computeLType gr g
,

84
src/compiler/api/GF/Compile/TypeCheck/Primitives.hs
View File

@@ -1,84 +0,0 @@
module GF.Compile.TypeCheck.Primitives(typPredefined,predefMod) where
import GF.Infra.Option
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
predefMod = (cPredef, modInfo)
where
modInfo = ModInfo {
mtype = MTResource,
mstatus = MSComplete,
mflags = noOptions,
mextend = [],
mwith = Nothing,
mopens = [],
mexdeps = [],
msrc = "Predef.gfo",
mseqs = Nothing,
jments = 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)],2)))
, (cPTrue , ResValue (noLoc typePBool) 0)
, (cPFalse , ResValue (noLoc typePBool) 1)
, (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)
, (cSOFT_SPACE,ResOper (Just (noLoc (mkProd -- Str
[] typeStr []))) Nothing)
, (cCAPIT , ResOper (Just (noLoc (mkProd -- Str
[] typeStr []))) Nothing)
, (cALL_CAPIT, 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"