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

GF.Compile.Rename: report many errors instead of stopping after the first one

Browse Source 
Using accumulated errors in the Check monad.

TODO: some errors are still not accumulated, but thanks to checkMapRecover
at least one error per judgement is reported.
This commit is contained in:
hallgren
2012-06-25 14:15:02 +00:00
parent ca4091599f
commit abb1aedd3d
1 changed files with 11 additions and 5 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -61,8 +61,12 @@ type StatusTree = BinTree Ident StatusInfo
type StatusInfo = Ident -> Term type StatusInfo = Ident -> Term
renameIdentTerm :: Status -> Term -> Check Term -- Delays errors, allowing many errors to be detected and reported
renameIdentTerm env@(act,imps) t0 = renameIdentTerm env = accumulateError (renameIdentTerm' env)
-- Fails immediately on error, makes it possible to try other possibilities
renameIdentTerm' :: Status -> Term -> Check Term
renameIdentTerm' env@(act,imps) t0 =
case t0 of case t0 of
Vr c -> ident predefAbs c Vr c -> ident predefAbs c
Cn c -> ident (\_ s -> checkError s) c Cn c -> ident (\_ s -> checkError s) c
@@ -210,8 +214,8 @@ renameTerm env vars = ren vars where
P t@(Vr r) l -- Here we have $r.l$ and this is ambiguous it could be either 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$ -- record projection from variable or constant $r$ or qualified expression with module $r$
| elem r vs -> return trm -- try var proj first .. | elem r vs -> return trm -- try var proj first ..
| otherwise -> checks [ renid (Q (r,label2ident l)) -- .. and qualified expression second. | otherwise -> checks [ renid' (Q (r,label2ident l)) -- .. and qualified expression second.
, renid t >>= \t -> return (P t l) -- try as a constant at the end , renid' t >>= \t -> return (P t l) -- try as a constant at the end
, checkError (text "unknown qualified constant" <+> ppTerm Unqualified 0 trm) , checkError (text "unknown qualified constant" <+> ppTerm Unqualified 0 trm)
] ]
@@ -222,6 +226,7 @@ renameTerm env vars = ren vars where
_ -> composOp (ren vs) trm _ -> composOp (ren vs) trm
renid = renameIdentTerm env renid = renameIdentTerm env
renid' = renameIdentTerm' env
renCase vs (p,t) = do renCase vs (p,t) = do
(p',vs') <- renpatt p (p',vs') <- renpatt p
t' <- ren (vs' ++ vs) t t' <- ren (vs' ++ vs) t
@@ -260,7 +265,7 @@ renamePattern env patt = case patt of
_ -> checkError (text "not a pattern macro" <+> ppPatt Qualified 0 patt) _ -> checkError (text "not a pattern macro" <+> ppPatt Qualified 0 patt)
return (PM c', []) return (PM c', [])
PV x -> checks [ renid (Vr x) >>= \t' -> case t' of PV x -> checks [ renid' (Vr x) >>= \t' -> case t' of
QC c -> return (PP c [],[]) QC c -> return (PP c [],[])
_ -> checkError (text "not a constructor") _ -> checkError (text "not a constructor")
, return (patt, [x]) , return (patt, [x])
@@ -299,6 +304,7 @@ renamePattern env patt = case patt of
where where
renp = renamePattern env renp = renamePattern env
renid = renameIdentTerm env renid = renameIdentTerm env
renid' = renameIdentTerm' env
renameContext :: Status -> Context -> Check Context renameContext :: Status -> Context -> Check Context
renameContext b = renc [] where renameContext b = renc [] where