summaryrefslogtreecommitdiff
path: root/src-3.0/GF/Compile
diff options
context:
space:
mode:
Diffstat (limited to 'src-3.0/GF/Compile')
-rw-r--r--src-3.0/GF/Compile/CheckGrammar.hs17
-rw-r--r--src-3.0/GF/Compile/Rename.hs2
2 files changed, 12 insertions, 7 deletions
diff --git a/src-3.0/GF/Compile/CheckGrammar.hs b/src-3.0/GF/Compile/CheckGrammar.hs
index e47496e97..f8383ea9f 100644
--- a/src-3.0/GF/Compile/CheckGrammar.hs
+++ b/src-3.0/GF/Compile/CheckGrammar.hs
@@ -56,6 +56,11 @@ showCheckModule mos m = do
(st,(_,msg)) <- checkStart $ checkModule mos m
return (st, unlines $ reverse msg)
+mapsCheckTree ::
+ (Ord a) => ((a,b) -> Check (a,c)) -> BinTree a b -> Check (BinTree a c)
+mapsCheckTree f = checkErr . mapsErrTree (\t -> checkStart (f t) >>= return . fst)
+
+
-- | checking is performed in the dependency order of modules
checkModule :: [SourceModule] -> SourceModule -> Check [SourceModule]
checkModule ms (name,mod) = checkIn ("checking module" +++ prt name) $ case mod of
@@ -63,24 +68,24 @@ checkModule ms (name,mod) = checkIn ("checking module" +++ prt name) $ case mod
ModMod mo@(Module mt st fs me ops js) -> do
checkRestrictedInheritance ms (name, mo)
js' <- case mt of
- MTAbstract -> mapMTree (checkAbsInfo gr name) js
+ MTAbstract -> mapsCheckTree (checkAbsInfo gr name) js
- MTTransfer a b -> mapMTree (checkAbsInfo gr name) js
+ MTTransfer a b -> mapsCheckTree (checkAbsInfo gr name) js
- MTResource -> mapMTree (checkResInfo gr name) js
+ MTResource -> mapsCheckTree (checkResInfo gr name) js
MTConcrete a -> do
checkErr $ topoSortOpers $ allOperDependencies name js
ModMod abs <- checkErr $ lookupModule gr a
js1 <- checkCompleteGrammar abs mo
- mapMTree (checkCncInfo gr name (a,abs)) js1
+ mapsCheckTree (checkCncInfo gr name (a,abs)) js1
- MTInterface -> mapMTree (checkResInfo gr name) js
+ MTInterface -> mapsCheckTree (checkResInfo gr name) js
MTInstance a -> do
ModMod abs <- checkErr $ lookupModule gr a
-- checkCompleteInstance abs mo -- this is done in Rebuild
- mapMTree (checkResInfo gr name) js
+ mapsCheckTree (checkResInfo gr name) js
return $ (name, ModMod (Module mt st fs me ops js')) : ms
diff --git a/src-3.0/GF/Compile/Rename.hs b/src-3.0/GF/Compile/Rename.hs
index 68f4d754f..312dcb2dd 100644
--- a/src-3.0/GF/Compile/Rename.hs
+++ b/src-3.0/GF/Compile/Rename.hs
@@ -58,7 +58,7 @@ renameModule ms (name,mod) = errIn ("renaming module" +++ prt name) $ case mod o
ModMod m@(Module mt st fs me ops js) -> do
let js1 = jments m
status <- buildStatus (MGrammar ms) name mod
- js2 <- mapMTree (renameInfo status) js1
+ js2 <- mapsErrTree (renameInfo status) js1
let mod2 = ModMod $ Module mt st fs me (map forceQualif ops) js2
return $ (name,mod2) : ms