mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-09 13:09:33 -06:00
a bit more refactoring
This commit is contained in:
@@ -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
|
||||
|
||||
@@ -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'
|
||||
|
||||
@@ -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'
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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")
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user