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

ModuleName and Ident are now distinct types

Browse Source 
This makes the documentation clearer, and can potentially catch more
programming mistakes.
This commit is contained in:
hallgren
2014-10-21 19:20:31 +00:00
parent 491e8b2bb8
commit 1048a89ca7
24 changed files with 156 additions and 132 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
src/compiler/GF/Compile/CheckGrammar.hs
View File

@@ -82,7 +82,7 @@ checkRestrictedInheritance cwd sgr (name,mo) = checkInModule cwd mo NoLoc empty
nest 2 (vcat [f <+> "on" <+> fsep is | (f,is) <- cs]))
allDeps = concatMap (allDependencies (const True) . jments . snd) mos
checkCompleteGrammar :: Options -> FilePath -> SourceGrammar -> SourceModule -> SourceModule -> Check SourceModule
checkCompleteGrammar :: Options -> FilePath -> Grammar -> Module -> Module -> Check Module
checkCompleteGrammar opts cwd gr (am,abs) (cm,cnc) = checkInModule cwd cnc NoLoc empty $ do
let jsa = jments abs
let jsc = jments cnc
@@ -300,7 +300,7 @@ checkReservedId x =
-- auxiliaries
-- | linearization types and defaults
linTypeOfType :: SourceGrammar -> Ident -> Type -> Check (Context,Type)
linTypeOfType :: Grammar -> ModuleName -> Type -> Check (Context,Type)
linTypeOfType cnc m typ = do
let (cont,cat) = typeSkeleton typ
val <- lookLin cat

10
src/compiler/GF/Compile/Compute/ConcreteNew.hs
View File

@@ -7,7 +7,7 @@ module GF.Compile.Compute.ConcreteNew
import GF.Grammar hiding (Env, VGen, VApp, VRecType)
import GF.Grammar.Lookup(lookupResDefLoc,allParamValues)
import GF.Grammar.Predef(cPredef,cErrorType,cTok,cStr,isPredefCat)
import GF.Grammar.Predef(cPredef,cErrorType,cTok,cStr)
import GF.Grammar.PatternMatch(matchPattern,measurePatt)
import GF.Grammar.Lockfield(lockLabel,isLockLabel,lockRecType) --unlockRecord
import GF.Compile.Compute.Value hiding (Error)
@@ -38,10 +38,10 @@ apply env = apply' env
-- * Environments
type ResourceValues = Map.Map Ident (Map.Map Ident (Err Value))
type ResourceValues = Map.Map ModuleName (Map.Map Ident (Err Value))
data GlobalEnv = GE SourceGrammar ResourceValues (L Ident)
data CompleteEnv = CE {srcgr::SourceGrammar,rvs::ResourceValues,
data GlobalEnv = GE Grammar ResourceValues (L Ident)
data CompleteEnv = CE {srcgr::Grammar,rvs::ResourceValues,
gloc::L Ident,local::LocalScope}
type LocalScope = [Ident]
type Stack = [Value]
@@ -73,7 +73,7 @@ resource env (m,c) =
if isPredefCat c
then value0 env =<< lockRecType c defLinType -- hmm
else maybe e id $ Map.lookup c =<< Map.lookup m (rvs env)
where e = fail $ "Not found: "++showIdent m++"."++showIdent c
where e = fail $ "Not found: "++render m++"."++showIdent c
-- | Convert operators once, not every time they are looked up
resourceValues :: SourceGrammar -> GlobalEnv

2
src/compiler/GF/Compile/GeneratePMCFG.hs
View File

@@ -108,7 +108,7 @@ addPMCFG opts gr cenv opath am cm seqs id (GF.Grammar.CncCat mty@(Just (L _ linc
mprn
Nothing) = do
let pcat = protoFCat gr (am,id) lincat
pvar = protoFCat gr (identW,cVar) typeStr
pvar = protoFCat gr (MN identW,cVar) typeStr
pmcfgEnv0 = emptyPMCFGEnv

15
src/compiler/GF/Compile/GrammarToPGF.hs
View File

@@ -30,7 +30,7 @@ import qualified Data.Map as Map
import qualified Data.IntMap as IntMap
import Data.Array.IArray
mkCanon2pgf :: Options -> SourceGrammar -> Ident -> IOE D.PGF
mkCanon2pgf :: Options -> SourceGrammar -> ModuleName -> IOE D.PGF
mkCanon2pgf opts gr am = do
(an,abs) <- mkAbstr am
cncs <- mapM mkConcr (allConcretes gr am)
@@ -38,7 +38,7 @@ mkCanon2pgf opts gr am = do
where
cenv = resourceValues gr
mkAbstr am = return (i2i am, D.Abstr flags funs cats)
mkAbstr am = return (mi2i am, D.Abstr flags funs cats)
where
aflags = err (const noOptions) mflags (lookupModule gr am)
@@ -78,7 +78,7 @@ mkCanon2pgf opts gr am = do
= genCncFuns gr am cm ex_seqs_arr seqs cdefs fid_cnt1 cnccats
printnames = genPrintNames cdefs
return (i2i cm, D.Concr flags
return (mi2i cm, D.Concr flags
printnames
cncfuns
lindefs
@@ -102,6 +102,9 @@ mkCanon2pgf opts gr am = do
i2i :: Ident -> CId
i2i = utf8CId . ident2utf8
mi2i :: ModuleName -> CId
mi2i (MN i) = i2i i
mkType :: [Ident] -> A.Type -> C.Type
mkType scope t =
case GM.typeForm t of
@@ -179,9 +182,9 @@ genCncCats gr am cm cdefs =
in (index', (i2i id,cc) : cats)
mkCncCats index (_ :cdefs) = mkCncCats index cdefs
genCncFuns :: SourceGrammar
-> Ident
-> Ident
genCncFuns :: Grammar
-> ModuleName
-> ModuleName
-> Array SeqId Sequence
-> Array SeqId Sequence
-> [(QIdent, Info)]

2
src/compiler/GF/Compile/ReadFiles.hs
View File

@@ -211,7 +211,7 @@ importsOfModule (m,mi) = (modName m,depModInfo mi [])
depInst (m,n) xs = modName m:modName n:xs
modName = showIdent
modName (MN m) = showIdent m
parseModHeader opts file =

16
src/compiler/GF/Compile/Rename.hs
View File

@@ -43,13 +43,13 @@ import Data.List (nub,(\\))
import GF.Text.Pretty
-- | this gives top-level access to renaming term input in the cc command
renameSourceTerm :: SourceGrammar -> Ident -> Term -> Check Term
renameSourceTerm :: Grammar -> ModuleName -> Term -> Check Term
renameSourceTerm g m t = do
mi <- lookupModule g m
status <- buildStatus "" g (m,mi)
renameTerm status [] t
renameModule :: FilePath -> SourceGrammar -> SourceModule -> Check SourceModule
renameModule :: FilePath -> Grammar -> Module -> Check Module
renameModule cwd gr mo@(m,mi) = do
status <- buildStatus cwd gr mo
js <- checkMapRecover (renameInfo cwd status mo) (jments mi)
@@ -115,7 +115,7 @@ renameIdentTerm' env@(act,imps) t0 =
-- in next V:
-- Bad $ "conflicting imports:" +++ unwords (map prt ts)
info2status :: Maybe Ident -> (Ident,Info) -> StatusInfo
info2status :: Maybe ModuleName -> (Ident,Info) -> StatusInfo
info2status mq (c,i) = case i of
AbsFun _ _ Nothing _ -> maybe Con (curry QC) mq
ResValue _ -> maybe Con (curry QC) mq
@@ -129,7 +129,7 @@ tree2status o = case o of
OSimple i -> mapTree (info2status (Just i))
OQualif i j -> mapTree (info2status (Just j))
buildStatus :: FilePath -> SourceGrammar -> SourceModule -> Check Status
buildStatus :: FilePath -> Grammar -> Module -> Check Status
buildStatus cwd gr mo@(m,mi) = checkInModule cwd mi NoLoc empty $ do
let gr1 = prependModule gr mo
exts = [(OSimple m,mi) | (m,mi) <- allExtends gr1 m]
@@ -139,14 +139,14 @@ buildStatus cwd gr mo@(m,mi) = checkInModule cwd mi NoLoc empty $ do
then (emptyBinTree, reverse sts) -- the module itself does not define any names
else (self2status m mi,reverse sts)) -- so the empty ident is not needed
modInfo2status :: (OpenSpec,SourceModInfo) -> (OpenSpec, StatusTree)
modInfo2status :: (OpenSpec,ModuleInfo) -> (OpenSpec, StatusTree)
modInfo2status (o,mo) = (o,tree2status o (jments mo))
self2status :: Ident -> SourceModInfo -> StatusTree
self2status :: ModuleName -> ModuleInfo -> StatusTree
self2status c m = mapTree (info2status (Just c)) (jments m)
renameInfo :: FilePath -> Status -> SourceModule -> Ident -> Info -> Check Info
renameInfo :: FilePath -> Status -> Module -> Ident -> Info -> Check Info
renameInfo cwd status (m,mi) i info =
case info of
AbsCat pco -> liftM AbsCat (renPerh (renameContext status) pco)
@@ -220,7 +220,7 @@ renameTerm env vars = ren vars where
P t@(Vr r) l -- Here we have $r.l$ and this is ambiguous it could be either
-- record projection from variable or constant $r$ or qualified expression with module $r$
| elem r vs -> return trm -- try var proj first ..
| otherwise -> checks [ renid' (Q (r,label2ident l)) -- .. and qualified expression second.
| otherwise -> checks [ renid' (Q (MN r,label2ident l)) -- .. and qualified expression second.
, renid' t >>= \t -> return (P t l) -- try as a constant at the end
, checkError ("unknown qualified constant" <+> trm)
]

6
src/compiler/GF/Compile/SubExOpt.hs
View File

@@ -68,7 +68,7 @@ type TermList = Map Term (Int,Int) -- number of occs, id
type TermM a = State (TermList,Int) a
addSubexpConsts ::
Ident -> Map Term (Int,Int) -> [(Ident,Info)] -> [(Ident,Info)]
ModuleName -> Map Term (Int,Int) -> [(Ident,Info)] -> [(Ident,Info)]
addSubexpConsts mo tree lins = do
let opers = [oper id trm | (trm,(_,id)) <- list]
map mkOne $ opers ++ lins
@@ -90,7 +90,7 @@ addSubexpConsts mo tree lins = do
oper id trm = (operIdent id, ResOper (Just (L NoLoc (EInt 8))) (Just (L NoLoc trm)))
--- impossible type encoding generated opers
getSubtermsMod :: Ident -> [(Ident,Info)] -> TermM (Map Term (Int,Int))
getSubtermsMod :: ModuleName -> [(Ident,Info)] -> TermM (Map Term (Int,Int))
getSubtermsMod mo js = do
mapM (getInfo (collectSubterms mo)) js
(tree0,_) <- get
@@ -105,7 +105,7 @@ getSubtermsMod mo js = do
return $ fi
_ -> return fi
collectSubterms :: Ident -> Term -> TermM Term
collectSubterms :: ModuleName -> Term -> TermM Term
collectSubterms mo t = case t of
App f a -> do
collect f

4
src/compiler/GF/Compile/Tags.hs
View File

@@ -63,11 +63,11 @@ getImports opts gr mo@(m,mi) = concatMap toDep allOpens
toDep (OSimple m,incl) =
let Ok mi = lookupModule gr m
in [showIdent id ++ "\t" ++ "indir" ++ "\t" ++ showIdent m ++ "\t\t" ++ gf2gftags opts (orig mi info)
in [showIdent id ++ "\t" ++ "indir" ++ "\t" ++ render m ++ "\t\t" ++ gf2gftags opts (orig mi info)
| (id,info) <- Map.toList (jments mi), filter incl id]
toDep (OQualif m1 m2,incl) =
let Ok mi = lookupModule gr m2
in [showIdent id ++ "\t" ++ "indir" ++ "\t" ++ showIdent m2 ++ "\t" ++ showIdent m1 ++ "\t" ++ gf2gftags opts (orig mi info)
in [showIdent id ++ "\t" ++ "indir" ++ "\t" ++ render m2 ++ "\t" ++ render m1 ++ "\t" ++ gf2gftags opts (orig mi info)
| (id,info) <- Map.toList (jments mi), filter incl id]
filter MIAll id = True

10
src/compiler/GF/Compile/Update.hs
View File

@@ -29,7 +29,7 @@ import Control.Monad
import GF.Text.Pretty
-- | combine a list of definitions into a balanced binary search tree
buildAnyTree :: Monad m => Ident -> [(Ident,Info)] -> m (BinTree Ident Info)
buildAnyTree :: Monad m => ModuleName -> [(Ident,Info)] -> m (BinTree Ident Info)
buildAnyTree m = go Map.empty
where
go map [] = return map
@@ -133,8 +133,8 @@ rebuildModule cwd gr mo@(i,mi@(ModInfo mt stat fs_ me mw ops_ med_ msrc_ env_ js
-- | When extending a complete module: new information is inserted,
-- and the process is interrupted if unification fails.
-- If the extended module is incomplete, its judgements are just copied.
extendMod :: SourceGrammar ->
Bool -> (SourceModule,Ident -> Bool) -> Ident ->
extendMod :: Grammar ->
Bool -> (Module,Ident -> Bool) -> ModuleName ->
BinTree Ident Info -> Check (BinTree Ident Info)
extendMod gr isCompl ((name,mi),cond) base new = foldM try new $ Map.toList (jments mi)
where
@@ -160,7 +160,7 @@ extendMod gr isCompl ((name,mi),cond) base new = foldM try new $ Map.toList (jme
where
i = globalizeLoc (msrc mi) i0
indirInfo :: Ident -> Info -> Info
indirInfo :: ModuleName -> Info -> Info
indirInfo n info = AnyInd b n' where
(b,n') = case info of
ResValue _ -> (True,n)
@@ -187,7 +187,7 @@ globalizeLoc fpath i =
External _ loc -> loc
loc -> loc
unifyAnyInfo :: Ident -> Info -> Info -> Err Info
unifyAnyInfo :: ModuleName -> Info -> Info -> Err Info
unifyAnyInfo m i j = case (i,j) of
(AbsCat mc1, AbsCat mc2) ->
liftM AbsCat (unifyMaybeL mc1 mc2)