1
0
forked from GitHub/gf-core

a bit more refactoring

This commit is contained in:
krangelov
2021-12-16 10:58:40 +01:00
parent 60c9d46141
commit 8466692584
6 changed files with 19 additions and 27 deletions

View File

@@ -15,8 +15,7 @@ import GF.Grammar.Lookup(lookupOrigInfo,allOrigInfos,allParamValues)
import GF.Grammar.Macros(typeForm,collectOp,collectPattOp,composSafeOp,mkAbs,mkApp,term2patt,sortRec)
import GF.Grammar.Lockfield(isLockLabel)
import GF.Grammar.Predef(cPredef,cInts)
-- import GF.Compile.Compute.Value(Predefined(..))
import GF.Infra.Ident(ModuleName(..),Ident,ident2raw,rawIdentS,showIdent,isWildIdent)
import GF.Infra.Ident(ModuleName(..),Ident,identW,ident2raw,rawIdentS,showIdent)
import GF.Infra.Option(Options,optionsPGF)
import GF.Infra.CheckM
import PGF2(Literal(..))
@@ -399,7 +398,7 @@ class FromIdent i where
gId :: Ident -> i
instance FromIdent VarId where
gId i = if isWildIdent i then Anonymous else VarId (ident2raw i)
gId i = if i == identW then Anonymous else VarId (ident2raw i)
instance FromIdent C.FunId where gId = C.FunId . ident2raw
instance FromIdent CatId where gId = CatId . ident2raw

View File

@@ -332,7 +332,7 @@ renameContext :: Status -> Context -> Check Context
renameContext b = renc [] where
renc vs cont = case cont of
(bt,x,t) : xts
| isWildIdent x -> do
| x == identW -> do
t' <- ren vs t
xts' <- renc vs xts
return $ (bt,x,t') : xts'

View File

@@ -125,7 +125,7 @@ inferLType gr g trm = case trm of
case fty' of
Prod bt z arg val -> do
a' <- justCheck g a arg
ty <- if isWildIdent z
ty <- if z == identW
then return val
else substituteLType [(bt,z,a')] val
return (App f' a',ty)
@@ -472,7 +472,7 @@ checkLType gr g trm typ0 = do
Abs bt x c -> do
case typ of
Prod bt' z a b -> do
(c',b') <- if isWildIdent z
(c',b') <- if z == identW
then checkLType gr ((bt,x,a):g) c b
else do b' <- checkIn (pp "abs") $ substituteLType [(bt',z,Vr x)] b
checkLType gr ((bt,x,a):g) c b'

View File

@@ -28,17 +28,6 @@ import PGF2.Transactions(Symbol(..))
-- Please change this every time when the GFO format is changed
gfoVersion = "GF05"
instance Binary Ident where
put id = put (ident2utf8 id)
get = do bs <- get
if bs == BS.pack "_"
then return identW
else return (identC (rawIdentC bs))
instance Binary ModuleName where
put (MN id) = put id
get = fmap MN get
instance Binary Grammar where
put = put . modules
get = fmap mGrammar get

View File

@@ -727,7 +727,7 @@ listCatDef (L loc (id,cont,size)) = [catd,nilfund,consfund]
niltyp = mkProdSimple (cont' ++ replicate size cd) lc
constyp = mkProdSimple (cont' ++ [cd, mkHypo lc]) lc
mkId x i = if isWildIdent x then (varX i) else x
mkId x i = if x == identW then (varX i) else x
tryLoc (c,mty,Just e) = return (c,(mty,e))
tryLoc (c,_ ,_ ) = fail ("local definition of" +++ showIdent c +++ "without value")

View File

@@ -19,7 +19,7 @@ module GF.Infra.Ident (-- ** Identifiers
identS, identC, identW,
-- *** Special identifiers for internal use
identV,
varStr, varX, isWildIdent, varIndex,
varStr, varX, varIndex,
-- *** Raw identifiers
RawIdent, rawIdentS, rawIdentC, ident2raw, prefixRawIdent,
isPrefixOf, showRawIdent
@@ -42,6 +42,9 @@ moduleNameS = MN . identS
instance Show ModuleName where showsPrec d (MN m) = showsPrec d m
instance Pretty ModuleName where pp (MN m) = pp m
instance Binary ModuleName where
put (MN id) = put id
get = fmap MN get
-- | the constructors labelled /INTERNAL/ are
-- internal representation never returned by the parser
@@ -69,6 +72,13 @@ showRawIdent = unpack . rawId2utf8
prefixRawIdent (Id x) (Id y) = Id (BS.append x y)
isPrefixOf (Id x) (Id y) = BS.isPrefixOf x y
instance Binary Ident where
put id = put (ident2utf8 id)
get = do bs <- get
if bs == wild
then return identW
else return (identC (rawIdentC bs))
instance Binary RawIdent where
put = put . rawId2utf8
get = fmap rawIdentC get
@@ -79,7 +89,7 @@ ident2utf8 :: Ident -> UTF8.ByteString
ident2utf8 i = case i of
IC (Id s) -> s
IV (Id s) n -> BS.append s (pack ('_':show n))
IW -> pack "_"
IW -> wild
ident2raw :: Ident -> RawIdent
ident2raw = Id . ident2utf8
@@ -113,13 +123,7 @@ varStr = identS "str"
varX :: Int -> Ident
varX = identV (rawIdentS "x")
isWildIdent :: Ident -> Bool
isWildIdent x = case x of
IW -> True
IC s | s == wild -> True
_ -> False
wild = Id (pack "_")
wild = pack "_"
varIndex :: Ident -> Int
varIndex (IV _ n) = n