From 17962eef1a5620e0762157d71fac20d9bb6547f7 Mon Sep 17 00:00:00 2001
From: aarne <aarne@cs.chalmers.se>
Date: Wed, 3 Oct 2007 16:04:30 +0000
Subject: added optimization to GrammarToGFCC

---
 src/GF/Canon/GFCC/CheckGFCC.hs | 8 ++++++--
 1 file changed, 6 insertions(+), 2 deletions(-)

(limited to 'src/GF/Canon/GFCC/CheckGFCC.hs')

diff --git a/src/GF/Canon/GFCC/CheckGFCC.hs b/src/GF/Canon/GFCC/CheckGFCC.hs
index a94e0e1fb..05f591627 100644
--- a/src/GF/Canon/GFCC/CheckGFCC.hs
+++ b/src/GF/Canon/GFCC/CheckGFCC.hs
@@ -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)
-- 
cgit v1.2.3