From 53f7d4ecfb7b101c29115d3ba7285757808bbb9c Mon Sep 17 00:00:00 2001
From: aarne <unknown>
Date: Tue, 22 Jun 2004 12:33:31 +0000
Subject: fixes in parsing

---
 src/GF/UseGrammar/Linear.hs  | 9 +++++----
 src/GF/UseGrammar/Parsing.hs | 9 ++++++++-
 2 files changed, 13 insertions(+), 5 deletions(-)

(limited to 'src/GF/UseGrammar')

diff --git a/src/GF/UseGrammar/Linear.hs b/src/GF/UseGrammar/Linear.hs
index 954500822..da1eefe09 100644
--- a/src/GF/UseGrammar/Linear.hs
+++ b/src/GF/UseGrammar/Linear.hs
@@ -161,10 +161,11 @@ allLinTables gr c t = do
    gets (ps,t) = liftM (curry id ps . cc . map str2strings) $ strsFromTerm t
    cc = concat . intersperse ["/"]
 
-prLinTable :: [[(Label,[([Patt],[String])])]] -> [String]
-prLinTable = concatMap prOne . concat where
-  prOne (lab,pss) = prt lab : map pr pss ----
-  pr (ps,ss) = unwords (map prt_ ps) +++ ":" +++ unwords ss
+prLinTable :: Bool -> [[(Label,[([Patt],[String])])]] -> [String]
+prLinTable pars = concatMap prOne . concat where
+  prOne (lab,pss) = (if pars then ((prt lab) :) else id) (map pr pss) ----
+  pr (ps,ss) = (if pars then ((unwords (map prt_ ps) +++ ":") +++)
+                             else id) (unwords ss)
 
 {-
 -- the value is a list of strs
diff --git a/src/GF/UseGrammar/Parsing.hs b/src/GF/UseGrammar/Parsing.hs
index 380b58ae7..1e736d24e 100644
--- a/src/GF/UseGrammar/Parsing.hs
+++ b/src/GF/UseGrammar/Parsing.hs
@@ -71,7 +71,14 @@ trees2trms opts sg cn as ts0 info = do
       ts1 <- return (map cf2trm0 ts0) ----- should not need annot
       mapM (checkErr . (annotate gr) . trExp) ts1 ---- complicated; often fails
     _ -> do
-      (ts1,ss) <- checkErr $ mapErrN 10 postParse ts0
+      let num = optIntOrN opts flagRawtrees 99999
+      let (ts01,rest) = splitAt num ts0
+      if null rest then return () 
+         else checkWarn ("Warning: only" +++ show num +++ "raw parses out of" +++ 
+                          show (length ts0) +++ 
+                          "considered; use -rawtrees=<Int> to see more"
+                     )
+      (ts1,ss) <- checkErr $ mapErrN 10 postParse ts01
       if null ts1 then raise ss else return ()
       ts2 <- mapM (checkErr . annotate gr . refreshMetas [] . trExp) ts1 ---- 
       if forgive then return ts2 else do
-- 
cgit v1.2.3