fixes in parsing

grammars/prelude/Prelude.gf

@@ -1,6 +1,6 @@
 -- language-independent prelude facilities
 
-resource Prelude = {
+resource Prelude = open (Predef=Predef) in {
 
 oper
 -- to construct records and tables

lib/resource-0.6/abstract/Combinations.gf

@@ -210,7 +210,7 @@ fun
   PredV       : V  -> VG ;             -- "walk", "doesn't walk"
   PredPassV   : V  -> VG ;             -- "is seen", "is not seen"
   PredTV      : TV -> NP -> VG ;       -- "sees John", "doesn't see John"
-  PredVS      : VS -> S -> VG ;        -- "says that I run", "doesn't say..."
+  PredVS      : VS -> S  -> VG ;       -- "says that I run", "doesn't say..."
   PredVV      : VV -> VG -> VG ;       -- "can run", "can't run", "tries to run"
   PredV3      : V3 -> NP -> NP -> VG ; -- "prefers wine to beer"
 
@@ -222,6 +222,7 @@ fun
 
   PosVG,NegVG : VG -> VP ;             -- 
 
+
 --!
 --3 Adverbs
 --
@@ -239,7 +240,7 @@ fun
 --
 
   PredVP : NP -> VP -> S ;                     -- "John walks"
-  PosSlashTV,NegSlashTV : NP -> TV -> Slash ;  -- "John sees", "John doesn's see"
+  PosSlashTV,NegSlashTV : NP -> TV -> Slash ;  -- "John sees", "John doesn't see"
   OneVP : VP -> S ;                            -- "one walks"
   ThereNP : NP -> S ;                          -- "there is a bar","there are 86 bars"
 
@@ -259,7 +260,7 @@ fun
   FunIP : Fun -> IP -> IP ;                -- "the mother of whom"
   NounIPOne, NounIPMany : CN -> IP ;       -- "which car", "which cars"
 
-  QuestVP : NP -> VP -> Qu;                -- "does John walk"; "doesn't John walk"
+  QuestVP : NP -> VP -> Qu ;               -- "does John walk"; "doesn't John walk"
   IntVP : IP -> VP -> Qu ;                 -- "who walks"
   IntSlash : IP -> Slash -> Qu ;           -- "whom does John see"
   QuestAdv : IAdv -> NP -> VP -> Qu ;      -- "why do you walk"

lib/resource-0.6/swedish/CombinationsSwe.gf

@@ -114,6 +114,7 @@ lin
   CNthatS = nounThatSentence ;
 
   PredVP = predVerbPhrase ;
+
   PosVG  = predVerbGroup True ;
   NegVG  = predVerbGroup False ;
 

src/GF/API.hs

@@ -201,9 +201,10 @@ optLinearizeTree opts0 gr t = case getOptVal opts transferFun of
 
   lin mk
     | oElem showRecord opts = liftM prt . linearizeNoMark g c
-    | oElem tableLin opts   = liftM (unlines . map untok . prLinTable) . 
+    | oElem tableLin opts   = liftM (unlines . map untok . prLinTable True) . 
+                                allLinTables g c
+    | oElem showAll opts    = liftM (unlines . map untok . prLinTable False) . 
                                 allLinTables g c
-    | oElem showAll opts    = return . unlines . linTree2strings mk g c
     | otherwise             = return . unlines . optIntOrOne . linTree2strings mk g c
   g = grammar gr
   c = cncId gr

src/GF/CF/Profile.hs

@@ -56,20 +56,16 @@ tree2term (CFTree (cff@(CFFun (fun,pro)), (_,trees))) = case fun of
                    then Bad "arity error" 
                    else return xs'
            where xs' = [t | t@(ITerm _ _) <- xs]
-   unif [] = return $ IMeta
+   unif xs = case [t | t@(ITerm _ _) <- xs] of 
-   unif xs@(ITerm fp@(f,_) xx : ts) = do
+    [] -> return $ IMeta
-     let hs = [h | ITerm (h,_) _ <- ts]
+    (ITerm fp@(f,_) xx : ts) -> do
-     testErr (all (==f) hs)                 -- if fails, hs must be nonempty
+      let hs = [h | ITerm (h,_) _ <- ts, h /= f]
-        ("unification expects" +++ prt f +++ "but found" +++ prt (head hs))
+      testErr (null hs)                 -- if fails, hs must be nonempty
-     xx' <- mapM unifArg [0 .. length xx - 1]
+              ("unification expects" +++ prt f +++ "but found" +++ prt (head hs))
-     return $ ITerm fp xx'
+      xx' <- mapM unifArg [0 .. length xx - 1]
+      return $ ITerm fp xx'
     where
-      unifArg i = tryUnif [zz !! i | ITerm _ zz <- xs]
+      unifArg i = unif [zz !! i | ITerm _ zz <- xs]
-   tryUnif xx = case [t | t@(ITerm _ _) <- xx] of
-     [] -> return IMeta
-     x:xs -> if all (==x) xs 
-             then return x 
-             else Bad "failed to unify"
 
    mkBinds (xss,_) = mapM mkBind xss
    mkBind xs = do

src/GF/Infra/Option.hs

@@ -230,6 +230,7 @@ flagDepth  = aOpt "depth"
 flagAlts   = aOpt "alts"
 flagLength = aOpt "length"
 flagNumber = aOpt "number"
+flagRawtrees = aOpt "rawtrees"
 
 caseYesNo :: Options -> OptFun -> Maybe Bool
 caseYesNo opts f = do

src/GF/Shell/ShellCommands.hs

@@ -105,6 +105,7 @@ testValidFlag st f x = case f of
   "lexer"   -> testInc customTokenizer
   "unlexer" -> testInc customUntokenizer
   "depth"   -> testN
+  "rawtrees"-> testN
   "parser"  -> testInc customParser
   "alts"    -> testN
   "transform" -> testInc customTermCommand
@@ -129,14 +130,14 @@ testValidFlag st f x = case f of
 optionsOfCommand :: Command -> ([String],[String])
 optionsOfCommand co = case co of
   CImport _ -> both "old v s opt src retain nocf nocheckcirc cflexer"
-                    "abs cnc res"
+                    "abs cnc res path"
   CRemoveLanguage _ -> none
   CEmptyState -> none
   CStripState -> none
   CTransformGrammar _ -> flags "printer"
   CConvertLatex _ -> none
-  CLinearize _ -> both "table struct record" "lang number unlexer"
+  CLinearize _ -> both "table struct record all" "lang number unlexer"
-  CParse -> both "new n ign raw v" "cat lang lexer parser number"
+  CParse -> both "new n ign raw v" "cat lang lexer parser number rawtrees"
   CTranslate _ _ -> opts "cat lexer parser"
   CGenerateRandom -> flags "cat lang number depth"
   CGenerateTrees -> both "metas" "depth alts cat lang number"

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 :: Bool -> [[(Label,[([Patt],[String])])]] -> [String]
-prLinTable = concatMap prOne . concat where
+prLinTable pars = concatMap prOne . concat where
-  prOne (lab,pss) = prt lab : map pr pss ----
+  prOne (lab,pss) = (if pars then ((prt lab) :) else id) (map pr pss) ----
-  pr (ps,ss) = unwords (map prt_ ps) +++ ":" +++ unwords ss
+  pr (ps,ss) = (if pars then ((unwords (map prt_ ps) +++ ":") +++)
+                             else id) (unwords ss)
 
 {-
 -- the value is a list of strs

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