summaryrefslogtreecommitdiff
path: root/src/compiler/GF/Compile
diff options
context:
space:
mode:
Diffstat (limited to 'src/compiler/GF/Compile')
-rw-r--r--src/compiler/GF/Compile/CheckGrammar.hs4
-rw-r--r--src/compiler/GF/Compile/Compute/ConcreteNew.hs10
-rw-r--r--src/compiler/GF/Compile/GeneratePMCFG.hs2
-rw-r--r--src/compiler/GF/Compile/GrammarToPGF.hs15
-rw-r--r--src/compiler/GF/Compile/ReadFiles.hs2
-rw-r--r--src/compiler/GF/Compile/Rename.hs16
-rw-r--r--src/compiler/GF/Compile/SubExOpt.hs6
-rw-r--r--src/compiler/GF/Compile/Tags.hs4
-rw-r--r--src/compiler/GF/Compile/Update.hs10
9 files changed, 36 insertions, 33 deletions
diff --git a/src/compiler/GF/Compile/CheckGrammar.hs b/src/compiler/GF/Compile/CheckGrammar.hs
index be6f625a5..0e8f2b775 100644
--- a/src/compiler/GF/Compile/CheckGrammar.hs
+++ b/src/compiler/GF/Compile/CheckGrammar.hs
@@ -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
diff --git a/src/compiler/GF/Compile/Compute/ConcreteNew.hs b/src/compiler/GF/Compile/Compute/ConcreteNew.hs
index 6bc653983..06d9b0000 100644
--- a/src/compiler/GF/Compile/Compute/ConcreteNew.hs
+++ b/src/compiler/GF/Compile/Compute/ConcreteNew.hs
@@ -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
diff --git a/src/compiler/GF/Compile/GeneratePMCFG.hs b/src/compiler/GF/Compile/GeneratePMCFG.hs
index 40872170c..bd7d4af6b 100644
--- a/src/compiler/GF/Compile/GeneratePMCFG.hs
+++ b/src/compiler/GF/Compile/GeneratePMCFG.hs
@@ -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
diff --git a/src/compiler/GF/Compile/GrammarToPGF.hs b/src/compiler/GF/Compile/GrammarToPGF.hs
index d0b588d81..ba400bc82 100644
--- a/src/compiler/GF/Compile/GrammarToPGF.hs
+++ b/src/compiler/GF/Compile/GrammarToPGF.hs
@@ -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)]
diff --git a/src/compiler/GF/Compile/ReadFiles.hs b/src/compiler/GF/Compile/ReadFiles.hs
index 1523e91f1..3182e192c 100644
--- a/src/compiler/GF/Compile/ReadFiles.hs
+++ b/src/compiler/GF/Compile/ReadFiles.hs
@@ -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 =
diff --git a/src/compiler/GF/Compile/Rename.hs b/src/compiler/GF/Compile/Rename.hs
index 6ade83a8c..36f90ef46 100644
--- a/src/compiler/GF/Compile/Rename.hs
+++ b/src/compiler/GF/Compile/Rename.hs
@@ -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)
]
diff --git a/src/compiler/GF/Compile/SubExOpt.hs b/src/compiler/GF/Compile/SubExOpt.hs
index 56e41d55c..d1c7842ad 100644
--- a/src/compiler/GF/Compile/SubExOpt.hs
+++ b/src/compiler/GF/Compile/SubExOpt.hs
@@ -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
diff --git a/src/compiler/GF/Compile/Tags.hs b/src/compiler/GF/Compile/Tags.hs
index dab4ee343..6452e066f 100644
--- a/src/compiler/GF/Compile/Tags.hs
+++ b/src/compiler/GF/Compile/Tags.hs
@@ -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
diff --git a/src/compiler/GF/Compile/Update.hs b/src/compiler/GF/Compile/Update.hs
index 6a7b0e8d1..9556b6554 100644
--- a/src/compiler/GF/Compile/Update.hs
+++ b/src/compiler/GF/Compile/Update.hs
@@ -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)
generated by cgit v1.2.3 (git 2.39.1) at 2026-05-20 05:54:50 +0000