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

added optimization to GrammarToGFCC

Browse Source
This commit is contained in:
aarne
2007-10-03 16:04:30 +00:00
parent 65ea5360aa
commit 51fff6daed
4 changed files with 130 additions and 141 deletions
Download Patch File Download Diff File Expand all files Collapse all files

8
src/GF/Canon/GFCC/CheckGFCC.hs
View File

@@ -25,8 +25,12 @@ checkGFCC gfcc = do
checkConcrete :: GFCC -> (CId,Concr) -> IO ((CId,Concr),Bool)
checkConcrete gfcc (lang,cnc) =
labelBoolIO ("happened in language " ++ printTree lang) $ do
(rs,bs) <- mapM (checkLin gfcc lang) (linRules cnc) >>= return . unzip
(rs,bs) <- mapM checkl (Map.assocs cnc) >>= return . unzip
return ((lang,Map.fromAscList rs),and bs)
where
checkl r@(CId f,_) = case head f of
'_' -> return (r,True)
_ -> checkLin gfcc lang r
checkLin :: GFCC -> CId -> (CId,Term) -> IO ((CId,Term),Bool)
checkLin gfcc lang (f,t) =
@@ -89,7 +93,7 @@ checkTerm (args,val) trm = case inferTerm args trm of
putStrLn $ "term: " ++ printTree trm ++
"\nexpected type: " ++ printTree val ++
"\ninferred type: " ++ printTree ty
return (trm,False)
return (t,False)
Bad s -> do
putStrLn s
return (trm,False)