summaryrefslogtreecommitdiff
path: root/src/compiler
diff options
context:
space:
mode:
Diffstat (limited to 'src/compiler')
-rw-r--r--src/compiler/GF/Compile.hs11
-rw-r--r--src/compiler/GF/Compile/CheckGrammar.hs21
-rw-r--r--src/compiler/GF/Compile/GeneratePMCFG.hs6
-rw-r--r--src/compiler/GF/Compile/Optimize.hs12
-rw-r--r--src/compiler/GF/Compile/Refresh.hs12
-rw-r--r--src/compiler/GF/Compile/Rename.hs6
6 files changed, 34 insertions, 34 deletions
diff --git a/src/compiler/GF/Compile.hs b/src/compiler/GF/Compile.hs
index f5cbde7b7..9693150ff 100644
--- a/src/compiler/GF/Compile.hs
+++ b/src/compiler/GF/Compile.hs
@@ -203,25 +203,24 @@ compileSourceModule opts env@(k,gr,_) mb_gfFile mo@(i,mi) = do
Nothing -> return ()
extendCompileEnvInt env k Nothing mo1b
_ -> do
- let mos = modules gr
- (mo2,warnings) <- putpp " renaming " $ ioeErr $ runCheck (renameModule mos mo1b)
+ (mo2,warnings) <- putpp " renaming " $ ioeErr $ runCheck (renameModule gr mo1b)
warnOut opts warnings
intermOut opts DumpRename (ppModule Internal mo2)
- (mo3,warnings) <- putpp " type checking" $ ioeErr $ runCheck (checkModule opts mos mo2)
+ (mo3,warnings) <- putpp " type checking" $ ioeErr $ runCheck (checkModule opts gr mo2)
warnOut opts warnings
intermOut opts DumpTypeCheck (ppModule Internal mo3)
if not (flag optTagsOnly opts)
- then do (k',mo3r:_) <- putpp " refreshing " $ ioeErr $ refreshModule (k,mos) mo3
+ then do (k',mo3r:_) <- putpp " refreshing " $ ioeErr $ refreshModule (k,gr) mo3
intermOut opts DumpRefresh (ppModule Internal mo3r)
- mo4 <- putpp " optimizing " $ ioeErr $ optimizeModule opts mos mo3r
+ mo4 <- putpp " optimizing " $ ioeErr $ optimizeModule opts gr mo3r
intermOut opts DumpOptimize (ppModule Internal mo4)
mo5 <- if isModCnc (snd mo4) && flag optPMCFG opts
- then putpp " generating PMCFG " $ ioeIO $ generatePMCFG opts mos mo4
+ then putpp " generating PMCFG " $ ioeIO $ generatePMCFG opts gr mo4
else return mo4
intermOut opts DumpCanon (ppModule Internal mo5)
diff --git a/src/compiler/GF/Compile/CheckGrammar.hs b/src/compiler/GF/Compile/CheckGrammar.hs
index 5988a20c8..0c72c67fe 100644
--- a/src/compiler/GF/Compile/CheckGrammar.hs
+++ b/src/compiler/GF/Compile/CheckGrammar.hs
@@ -45,11 +45,11 @@ import Control.Monad
import Text.PrettyPrint
-- | checking is performed in the dependency order of modules
-checkModule :: Options -> [SourceModule] -> SourceModule -> Check SourceModule
-checkModule opts mos mo@(m,mi) = do
- checkRestrictedInheritance mos mo
+checkModule :: Options -> SourceGrammar -> SourceModule -> Check SourceModule
+checkModule opts sgr mo@(m,mi) = do
+ checkRestrictedInheritance sgr mo
mo <- case mtype mi of
- MTConcrete a -> do let gr = mGrammar (mo:mos)
+ MTConcrete a -> do let gr = prependModule sgr mo
abs <- checkErr $ lookupModule gr a
checkCompleteGrammar gr (a,abs) mo
_ -> return mo
@@ -57,18 +57,19 @@ checkModule opts mos mo@(m,mi) = do
foldM updateCheckInfos mo infoss
where
updateCheckInfos mo = fmap (foldl update mo) . parallelCheck . map check
- where check (i,info) = fmap ((,) i) (checkInfo opts mos mo i info)
+ where check (i,info) = fmap ((,) i) (checkInfo opts sgr mo i info)
update mo@(m,mi) (i,info) = (m,mi{jments=updateTree (i,info) (jments mi)})
-- check if restricted inheritance modules are still coherent
-- i.e. that the defs of remaining names don't depend on omitted names
-checkRestrictedInheritance :: [SourceModule] -> SourceModule -> Check ()
-checkRestrictedInheritance mos (name,mo) = checkIn (ppLocation (msrc mo) NoLoc <> colon) $ do
+checkRestrictedInheritance :: SourceGrammar -> SourceModule -> Check ()
+checkRestrictedInheritance sgr (name,mo) = checkIn (ppLocation (msrc mo) NoLoc <> colon) $ do
let irs = [ii | ii@(_,mi) <- mextend mo, mi /= MIAll] -- names with restr. inh.
let mrs = [((i,m),mi) | (i,m) <- mos, Just mi <- [lookup i irs]]
-- the restr. modules themself, with restr. infos
mapM_ checkRem mrs
where
+ mos = modules sgr
checkRem ((i,m),mi) = do
let (incl,excl) = partition (isInherited mi) (map fst (tree2list (jments m)))
let incld c = Set.member c (Set.fromList incl)
@@ -153,8 +154,8 @@ checkCompleteGrammar gr (am,abs) (cm,cnc) = checkIn (ppLocation (msrc cnc) NoLoc
-- | General Principle: only Just-values are checked.
-- A May-value has always been checked in its origin module.
-checkInfo :: Options -> [SourceModule] -> SourceModule -> Ident -> Info -> Check Info
-checkInfo opts ms (m,mo) c info = do
+checkInfo :: Options -> SourceGrammar -> SourceModule -> Ident -> Info -> Check Info
+checkInfo opts sgr (m,mo) c info = do
checkIn (ppLocation (msrc mo) NoLoc <> colon) $
checkReservedId c
case info of
@@ -253,7 +254,7 @@ checkInfo opts ms (m,mo) c info = do
_ -> return info
where
- gr = mGrammar ((m,mo) : ms)
+ gr = prependModule sgr (m,mo)
chIn loc cat = checkIn (ppLocation (msrc mo) loc <> colon $$
nest 2 (text "Happened in" <+> text cat <+> ppIdent c))
diff --git a/src/compiler/GF/Compile/GeneratePMCFG.hs b/src/compiler/GF/Compile/GeneratePMCFG.hs
index bb4c5b549..13ac8d26f 100644
--- a/src/compiler/GF/Compile/GeneratePMCFG.hs
+++ b/src/compiler/GF/Compile/GeneratePMCFG.hs
@@ -43,13 +43,13 @@ import Control.Exception
----------------------------------------------------------------------
-- main conversion function
-generatePMCFG :: Options -> [SourceModule] -> SourceModule -> IO SourceModule
-generatePMCFG opts mos cmo@(cm,cmi) = do
+generatePMCFG :: Options -> SourceGrammar -> SourceModule -> IO SourceModule
+generatePMCFG opts sgr cmo@(cm,cmi) = do
(seqs,js) <- mapAccumWithKeyM (addPMCFG opts gr am cm) Map.empty (jments cmi)
when (verbAtLeast opts Verbose) $ hPutStrLn stderr ""
return (cm,cmi{mseqs = Just (mkSetArray seqs), jments = js})
where
- gr = mGrammar (cmo:mos)
+ gr = prependModule sgr cmo
MTConcrete am = mtype cmi
mapAccumWithKeyM :: (Monad m, Ord k) => (a -> k -> b -> m (a,c)) -> a
diff --git a/src/compiler/GF/Compile/Optimize.hs b/src/compiler/GF/Compile/Optimize.hs
index 33632f5bf..635a1732c 100644
--- a/src/compiler/GF/Compile/Optimize.hs
+++ b/src/compiler/GF/Compile/Optimize.hs
@@ -40,8 +40,8 @@ import qualified Data.ByteString.Char8 as BS
-- | partial evaluation of concrete syntax. AR 6\/2001 -- 16\/5\/2003 -- 5\/2\/2005.
-optimizeModule :: Options -> [SourceModule] -> SourceModule -> Err SourceModule
-optimizeModule opts ms m@(name,mi)
+optimizeModule :: Options -> SourceGrammar -> SourceModule -> Err SourceModule
+optimizeModule opts sgr m@(name,mi)
| mstatus mi == MSComplete = do
ids <- topoSortJments m
mi <- foldM updateEvalInfo mi ids
@@ -51,11 +51,11 @@ optimizeModule opts ms m@(name,mi)
oopts = opts `addOptions` mflags mi
updateEvalInfo mi (i,info) = do
- info <- evalInfo oopts ms (name,mi) i info
+ info <- evalInfo oopts sgr (name,mi) i info
return (mi{jments=updateTree (i,info) (jments mi)})
-evalInfo :: Options -> [SourceModule] -> SourceModule -> Ident -> Info -> Err Info
-evalInfo opts ms m c info = do
+evalInfo :: Options -> SourceGrammar -> SourceModule -> Ident -> Info -> Err Info
+evalInfo opts sgr m c info = do
(if verbAtLeast opts Verbose then trace (" " ++ showIdent c) else id) return ()
@@ -95,7 +95,7 @@ evalInfo opts ms m c info = do
_ -> return info
where
- gr = mGrammar (m : ms)
+ gr = prependModule sgr m
optim = flag optOptimizations opts
param = OptParametrize `Set.member` optim
eIn cat = errIn (render (text "Error optimizing" <+> cat <+> ppIdent c <+> colon))
diff --git a/src/compiler/GF/Compile/Refresh.hs b/src/compiler/GF/Compile/Refresh.hs
index b66e88aa3..edff8a479 100644
--- a/src/compiler/GF/Compile/Refresh.hs
+++ b/src/compiler/GF/Compile/Refresh.hs
@@ -106,15 +106,15 @@ refreshEquation pst = err Bad (return . fst) (appSTM (refr pst) initIdState) whe
-- for concrete and resource in grammar, before optimizing
-refreshGrammar :: SourceGrammar -> Err SourceGrammar
-refreshGrammar = liftM (mGrammar . snd) . foldM refreshModule (0,[]) . modules
+--refreshGrammar :: SourceGrammar -> Err SourceGrammar
+--refreshGrammar = liftM (mGrammar . snd) . foldM refreshModule (0,[]) . modules
-refreshModule :: (Int,[SourceModule]) -> SourceModule -> Err (Int,[SourceModule])
-refreshModule (k,ms) mi@(i,mo)
+refreshModule :: (Int,SourceGrammar) -> SourceModule -> Err (Int,[SourceModule])
+refreshModule (k,sgr) mi@(i,mo)
| isModCnc mo || isModRes mo = do
(k',js') <- foldM refreshRes (k,[]) $ tree2list $ jments mo
- return (k', (i,mo{jments=buildTree js'}) : ms)
- | otherwise = return (k, mi:ms)
+ return (k', (i,mo{jments=buildTree js'}) : modules sgr)
+ | otherwise = return (k, mi:modules sgr)
where
refreshRes (k,cs) ci@(c,info) = case info of
ResOper ptyp (Just (L loc trm)) -> do ---- refresh ptyp
diff --git a/src/compiler/GF/Compile/Rename.hs b/src/compiler/GF/Compile/Rename.hs
index f2dbf7d69..9e959c353 100644
--- a/src/compiler/GF/Compile/Rename.hs
+++ b/src/compiler/GF/Compile/Rename.hs
@@ -49,9 +49,9 @@ renameSourceTerm g m t = do
status <- buildStatus g (m,mi)
renameTerm status [] t
-renameModule :: [SourceModule] -> SourceModule -> Check SourceModule
-renameModule ms mo@(m,mi) = do
- status <- buildStatus (mGrammar ms) mo
+renameModule :: SourceGrammar -> SourceModule -> Check SourceModule
+renameModule gr mo@(m,mi) = do
+ status <- buildStatus gr mo
js <- checkMapRecover (renameInfo status mo) (jments mi)
return (m, mi{jments = js})
generated by cgit v1.2.3 (git 2.39.1) at 2026-05-20 14:58:29 +0000