msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

improved error message in pgf compilation to help debugging

Browse Source
This commit is contained in:
aarne
2008-08-16 12:27:59 +00:00
parent e2f5add011
commit 20fe8a8c20
1 changed files with 6 additions and 5 deletions
Download Patch File Download Diff File Expand all files Collapse all files

11
src/GF/Compile/GrammarToGFCC.hs
View File

@@ -289,7 +289,7 @@ canon2canon abs =
CncCat (Yes ty) (Yes x) y -> (f,CncCat (Yes (ty2ty ty)) (Yes (t2t x)) y) CncCat (Yes ty) (Yes x) y -> (f,CncCat (Yes (ty2ty ty)) (Yes (t2t x)) y)
_ -> (f,j) _ -> (f,j)
where where
t2t = term2term cg pv t2t = term2term f cg pv
ty2ty = type2type cg pv ty2ty = type2type cg pv
pv@(labels,untyps,typs) = trs $ paramValues cg pv@(labels,untyps,typs) = trs $ paramValues cg
@@ -408,8 +408,8 @@ type2type cgr env@(labels,untyps,typs) ty = case ty of
Just vs -> length $ Map.assocs vs Just vs -> length $ Map.assocs vs
_ -> trace ("unknown partype " ++ show ty) 66669 _ -> trace ("unknown partype " ++ show ty) 66669
term2term :: SourceGrammar -> ParamEnv -> Term -> Term term2term :: Ident -> SourceGrammar -> ParamEnv -> Term -> Term
term2term cgr env@(labels,untyps,typs) tr = case tr of term2term fun cgr env@(labels,untyps,typs) tr = case tr of
App _ _ -> mkValCase (unrec tr) App _ _ -> mkValCase (unrec tr)
QC _ _ -> mkValCase tr QC _ _ -> mkValCase tr
R rs -> R [(mkLab i, (Nothing, t2t t)) | R rs -> R [(mkLab i, (Nothing, t2t t)) |
@@ -425,7 +425,7 @@ term2term cgr env@(labels,untyps,typs) tr = case tr of
_ -> GM.composSafeOp t2t tr _ -> GM.composSafeOp t2t tr
where where
t2t = term2term cgr env t2t = term2term fun cgr env
unrec t = case t of unrec t = case t of
App f (R fs) -> GM.mkApp (unrec f) [unrec u | (_,(_,u)) <- fs] App f (R fs) -> GM.mkApp (unrec f) [unrec u | (_,(_,u)) <- fs]
@@ -507,7 +507,8 @@ term2term cgr env@(labels,untyps,typs) tr = case tr of
(FV ts,_) -> ts (FV ts,_) -> ts
_ -> [tr] _ -> [tr]
valNumFV ts = case ts of valNumFV ts = case ts of
[tr] -> error ("valNum" +++ prt tr) ----- prtTrace tr $ K "66667" [tr] -> let msg = ("DEBUG" +++ prt fun ++ ": error in valNum" +++ prt tr) in
trace msg $ error (prt fun)
_ -> FV $ map valNum ts _ -> FV $ map valNum ts
mkCurry trm = case trm of mkCurry trm = case trm of