added option -number to limit the number of parse results

src/compiler/GF/Command/CommandInfo.hs

@@ -37,13 +37,13 @@ class Monad m => TypeCheckArg m where typeCheckArg :: Expr -> m Expr
 
 --------------------------------------------------------------------------------
 
-data CommandArguments = Exprs [Expr] | Strings [String] | Term Term
+data CommandArguments = Exprs [(Expr,Float)] | Strings [String] | Term Term
 
 newtype CommandOutput = Piped (CommandArguments,String) ---- errors, etc
 
 -- ** Converting command output
 fromStrings ss         = Piped (Strings ss, unlines ss)
-fromExprs   es         = Piped (Exprs es,unlines (map (showExpr []) es))
+fromExprs   es         = Piped (Exprs es,unlines (map (showExpr [] . fst) es))
 fromString  s          = Piped (Strings [s], s)
 pipeWithMessage es msg = Piped (Exprs es,msg)
 pipeMessage msg        = Piped (Exprs [],msg)
@@ -58,15 +58,15 @@ toStrings args =
       Exprs es -> zipWith showAsString (True:repeat False) es
       Term t -> [render t]
   where
-    showAsString first t =
+    showAsString first (e,p) =
-      case unStr t of
+      case unStr e of
         Just s  -> s
         Nothing -> ['\n'|not first] ++
-                   showExpr [] t ---newline needed in other cases than the first
+                   showExpr [] e ---newline needed in other cases than the first
 
 toExprs args =
   case args of
-    Exprs es -> es
+    Exprs es -> map fst es
     Strings ss -> map mkStr ss
     Term t -> [mkStr (render t)]
 
@@ -74,7 +74,7 @@ toTerm args =
   case args of
     Term t -> t
     Strings ss -> string2term $ unwords ss -- hmm
-    Exprs es -> string2term $ unwords $ map (showExpr []) es -- hmm
+    Exprs es -> string2term $ unwords $ map (showExpr [] . fst) es -- hmm
 
 -- ** Creating documentation
 

src/compiler/GF/Command/Commands.hs

@@ -204,10 +204,10 @@ pgfCommands = Map.fromList [
        mkEx "gt (AdjCN ? (UseN ?))  -- trees of form (AdjCN ? (UseN ?))"
        ],
      exec = needPGF $ \opts arg pgf -> do
-       let ts = case mexp (toExprs arg) of
+       let es = case mexp (toExprs arg) of
                   Just ex -> generateAllFrom pgf ex
                   Nothing -> generateAll     pgf (optType pgf opts)
-       returnFromExprs $ take (optNumInf opts) (map fst ts)
+       returnFromExprs $ takeOptNum opts es
      }),
 
   ("i", emptyCommandInfo {
@@ -323,10 +323,16 @@ pgfCommands = Map.fromList [
        "See also the ps command for lexing and character encoding."
        ],
      exec = needPGF $ \opts ts pgf ->
-              return $ fromParse opts (concat [map ((,) s) (par pgf opts s) | s <- toStrings ts]),
+              return $
+                foldr (joinPiped . fromParse1 opts) void 
+                  (concat [
+                              [(s,parse concr (optType pgf opts) s) |
+                                            concr <- optLangs pgf opts] 
+                           | s <- toStrings ts]),
      flags = [
        ("cat","target category of parsing"),
-       ("lang","the languages of parsing (comma-separated, no spaces)")
+       ("lang","the languages of parsing (comma-separated, no spaces)"),
+       ("number","limit the results to the top N trees")
        ]
      }),
 
@@ -351,7 +357,6 @@ pgfCommands = Map.fromList [
        ]),
      exec  = needPGF $ \opts _ pgf -> prGrammar pgf opts,
      flags = [
-       --"cat",
        ("file",   "set the file name when printing with -pgf option"),
        ("lang",   "select languages for the some options (default all languages)"),
        ("printer","select the printing format (see flag values above)")
@@ -386,7 +391,7 @@ pgfCommands = Map.fromList [
        mkEx "pt -compute (plus one two)                               -- compute value"
        ],
      exec = needPGF $ \opts arg pgf ->
-            returnFromExprs . takeOptNum opts . treeOps pgf opts $ toExprs arg,
+            returnFromExprs .  takeOptNum opts . map (flip (,) 0) . treeOps pgf opts $ toExprs arg,
      options = treeOpOptions undefined{-pgf-},
      flags = [("number","take at most this many trees")] ++ treeOpFlags undefined{-pgf-}
      }),
@@ -419,7 +424,7 @@ pgfCommands = Map.fromList [
                                            in (es,"on line" <+> n <> ':' <+> "parse error" $$ err)
            returnFromLines ls = case exprs ls of
                                   (es, err) | null es   -> return $ pipeMessage $ render (err $$ "no trees found")
-                                            | otherwise -> return $ pipeWithMessage es (render err)
+                                            | otherwise -> return $ pipeWithMessage (map (flip (,) 0) es) (render err)
 
        s <- restricted $ readFile file
        case opts of
@@ -679,23 +684,17 @@ pgfCommands = Map.fromList [
        Just pgf -> liftSIO $ exec opts ts pgf
        _ -> fail "Import a grammar before using this command"
 
-   par pgf opts s = [parse concr (optType pgf opts) s | concr <- optLangs pgf opts]
-
-   fromParse opts = foldr (joinPiped . fromParse1 opts) void
-
    joinPiped (Piped (es1,ms1)) (Piped (es2,ms2)) = Piped (jA es1 es2,ms1+++-ms2)
      where
        jA (Exprs es1) (Exprs es2) = Exprs (es1++es2)
-       -- ^ fromParse1 always output Exprs
 
    fromParse1 opts (s,po) =
-         case po of
+     case po of
-           ParseOk ts      -> fromExprs (map fst ts)
+       ParseOk ts      -> fromExprs (takeOptNum opts ts)
-           ParseFailed i _ -> pipeMessage $ "The parser failed at token "
+       ParseFailed i t -> pipeMessage $ "The parser failed at token "
-                                             ++ show i ++": "
+                                        ++ show i ++": "
-                                             ++ show (words s !! max 0 (i-1))
+                                        ++ show t
-                                          -- ++ " in " ++ show s
+       ParseIncomplete -> pipeMessage "The sentence is not complete"
-           ParseIncomplete -> pipeMessage "The sentence is not complete"
 
    optLins pgf opts ts = concatMap (optLin pgf opts) ts
    optLin pgf opts t =
@@ -769,9 +768,11 @@ pgfCommands = Map.fromList [
    optNumInf opts = valIntOpts "number" 1000000000 opts ---- 10^9
    takeOptNum opts = take (optNumInf opts)
 
-   returnFromExprs es = return $ case es of
+   returnFromExprs es =
-     [] -> pipeMessage "no trees found"
+     return $ 
-     _  -> fromExprs es
+       case es of
+         [] -> pipeMessage "no trees found"
+         _  -> fromExprs es
 
    prGrammar pgf opts
      | isOpt "pgf"      opts = do

src/compiler/GF/Command/Interpreter.hs

@@ -101,4 +101,4 @@ getCommandTrees env needsTypeCheck a args =
     ATerm t -> return (Term t)
     ANoArg  -> return args  -- use piped
   where
-    one e = return (Exprs [e]) -- ignore piped
+    one e = return (Exprs [(e,0)]) -- ignore piped