GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-23 19:42:50 -06:00
Code Issues Packages Projects Releases Wiki Activity

checkMapRecover: find undefined idents in all jments in Rename

Browse Source
This commit is contained in:
aarne
2012-06-25 11:14:52 +00:00
parent 3dc2e55949
commit d15e0f775d
2 changed files with 9 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -52,7 +52,7 @@ renameSourceTerm g m t = do
renameModule :: [SourceModule] -> SourceModule -> Check SourceModule renameModule :: [SourceModule] -> SourceModule -> Check SourceModule
renameModule ms mo@(m,mi) = do renameModule ms mo@(m,mi) = do
status <- buildStatus (mGrammar ms) mo status <- buildStatus (mGrammar ms) mo
js <- checkMap (renameInfo status mo) (jments mi) js <- checkMapRecover (renameInfo status mo) (jments mi)
return (m, mi{jments = js}) return (m, mi{jments = js})
type Status = (StatusTree, [(OpenSpec, StatusTree)]) type Status = (StatusTree, [(OpenSpec, StatusTree)])

9
src/compiler/GF/Infra/CheckM.hs
View File

@@ -15,7 +15,7 @@
module GF.Infra.CheckM module GF.Infra.CheckM
(Check(..), CheckResult(..), Message, runCheck, (Check(..), CheckResult(..), Message, runCheck,
checkError, checkCond, checkWarn, checkError, checkCond, checkWarn,
checkErr, checkIn, checkMap checkErr, checkIn, checkMap, checkMapRecover
) where ) where
import GF.Data.Operations import GF.Data.Operations
@@ -65,6 +65,13 @@ checkMap f map = do xs <- mapM (\(k,v) -> do v <- f k v
return (k,v)) (Map.toList map) return (k,v)) (Map.toList map)
return (Map.fromAscList xs) return (Map.fromAscList xs)
checkMapRecover :: (Ord a) => (a -> b -> Check b) -> Map.Map a b -> Check (Map.Map a b)
checkMapRecover f mp = do
let xs = map (\ (k,v) -> (k,runCheck (f k v))) (Map.toList mp)
case [s | (_,Bad s) <- xs] of
ss@(_:_) -> checkError (text (unlines ss))
_ -> return (Map.fromAscList [(k,x) | (k, Ok (x,_)) <- xs])
checkErr :: Err a -> Check a checkErr :: Err a -> Check a
checkErr (Ok x) = return x checkErr (Ok x) = return x
checkErr (Bad err) = checkError (text err) checkErr (Bad err) = checkError (text err)