more commands in gfcc

4 files changed, 37 insertions, 47 deletions

diff --git a/src/GF/Canon/CanonToGFCC.hs b/src/GF/Canon/CanonToGFCC.hs
index 020dbbdd9..43e0e8f5c 100644
--- a/src/GF/Canon/CanonToGFCC.hs
+++ b/src/GF/Canon/CanonToGFCC.hs
@@ -217,10 +217,9 @@ term2term cgr env@(labels,untyps,typs) tr = case tr of
       then R rs'
       else R [Ass (L (IC "_")) (mkValCase tr), Ass (L (IC "__")) (R rs')]
   P t l    -> r2r tr
-  T _ cs0  -> checkCases cs0 $
-    case expandLinTables cgr tr of  -- normalize order of cases
-      Ok (T ty cs) -> V ty [t2t t | Cas _ t <- cs]
-      _ -> K (KS (A.prt tr +++ prtTrace tr "66668"))
+  T _ cs0  -> case expandLinTables cgr tr of  -- normalize order of cases
+    Ok (T ty cs) -> checkCases cs $ V ty [t2t t | Cas _ t <- cs]
+    _ -> K (KS (A.prt tr +++ prtTrace tr "66668"))
   V ty ts  -> V ty [t2t t | t <- ts]
   S t p    -> S (t2t t) (t2t p)
   _ -> composSafeOp t2t tr
@@ -249,18 +248,6 @@ term2term cgr env@(labels,untyps,typs) tr = case tr of
      S p _ -> getLab p
      _ -> Bad "getLab"
 
-{-
-(table{n:ParamX.Number;p:ParamX.Person}
-  [{fin=\"am\";inf=[]}
-   {fin=\"are\";inf=[]}
-   {fin=\"is\";inf=[]}
-   {fin=\"are\";inf=[]}
-   {fin=\"are\";inf=[]}
-   {fin=\"are\";inf=[]}]  
- ! (NP@0.a))
-.fin 66665"
--}
-
    doVar :: Term -> STM [((CType,[Term]),(Term,Term))] Term
    doVar tr = case getLab tr of
      Ok (cat, lab) -> do
diff --git a/src/GF/Canon/GFCC/GenGFCC.hs b/src/GF/Canon/GFCC/GenGFCC.hs
index 58c185f12..00821cceb 100644
--- a/src/GF/Canon/GFCC/GenGFCC.hs
+++ b/src/GF/Canon/GFCC/GenGFCC.hs
@@ -66,7 +66,7 @@ generateRandom gen gfcc cat = genTrees (randomRs (0.0, 1.0) gen) cat where
 -- note: you cannot throw away rules with unknown words from the grammar
 -- because it is not known which field in each rule may match the input
 
-parse :: GFCC -> CId -> [String] -> [Exp]
-parse gfcc cat ws = [t | t <- gen, s <- lins t, words s == ws] where 
-  gen    = take 1024 $ generate gfcc cat
+parse :: Int -> GFCC -> CId -> [String] -> [Exp]
+parse i gfcc cat ws = [t | t <- gen, s <- lins t, words s == ws] where 
+  gen    = take i $ generate gfcc cat
   lins t = [linearize gfcc lang t | lang <- cncnames gfcc]
diff --git a/src/GF/Canon/GFCC/RunGFCC.hs b/src/GF/Canon/GFCC/RunGFCC.hs
index be471da7a..7cf611d40 100644
--- a/src/GF/Canon/GFCC/RunGFCC.hs
+++ b/src/GF/Canon/GFCC/RunGFCC.hs
@@ -30,13 +30,18 @@ loop grammar = do
 treat :: GFCC -> String -> IO ()
 treat grammar s = case words s of
   "gt":cat:n:_ -> do
-    mapM_ prlins $ take (read n) $ generate grammar (CId cat)
+    mapM_ prlinonly $ take (read n) $ generate grammar (CId cat)
+  "gtt":cat:n:_ -> do
+    mapM_ prlin $ take (read n) $ generate grammar (CId cat)
   "gr":cat:n:_ -> do
     gen <- newStdGen
-    mapM_ prlins $ take (read n) $ generateRandom gen grammar (CId cat)
-  "p":cat:ws -> do
-    case parse grammar (CId cat) ws of
-      t:_ -> prlins t
+    mapM_ prlinonly $ take (read n) $ generateRandom gen grammar (CId cat)
+  "grt":cat:n:_ -> do
+    gen <- newStdGen
+    mapM_ prlin $ take (read n) $ generateRandom gen grammar (CId cat)
+  "p":cat:n:ws -> do
+    case parse (read n) grammar (CId cat) ws of
+      t:_ -> prlin t
       _ -> putStrLn "no parse found" 
   _ -> lins $ readExp s
  where
@@ -49,6 +54,11 @@ treat grammar s = case words s of
   prlins t = do
     putStrLn $ printTree t
     lins t
+  prlin t = do
+    putStrLn $ printTree t
+    prlinonly t
+  prlinonly t = mapM_ (lin t) $ cncnames grammar
+
 
 --- should be in an API
 
@@ -63,18 +73,3 @@ err f g ex = case ex of
   Ok x -> g x
   Bad s -> f s
 
-
-{-
-treat grammar s = putStrLn $ case comm of
-  ["lin"]        -> unlines $ linearizeAll grammar $ readTree grammar rest 
-  ["lin",lang]   -> linearize grammar lang $ readTree grammar rest 
-  ["parse",cat]  -> unlines $ map showTree $ concat $ parseAll grammar cat rest
-  ["parse",lang,cat] -> unlines $ map showTree $ parse grammar lang cat rest
-  ["langs"]      -> unwords $ languages grammar
-  ["cats"]       -> unwords $ categories grammar
-  ["help"]       -> helpMsg
-  _ -> "command not interpreted: " ++ s
- where
-   (comm,rest) = (words c,drop 1 r) where
-      (c,r) = span (/=':') s
--}
diff --git a/src/GF/Canon/GFCC/doc/gfcc.txt b/src/GF/Canon/GFCC/doc/gfcc.txt
index 62ddfc1cd..38e722169 100644
--- a/src/GF/Canon/GFCC/doc/gfcc.txt
+++ b/src/GF/Canon/GFCC/doc/gfcc.txt
@@ -497,12 +497,15 @@ GFCC generation is a part of the
 [developers' version http://www.cs.chalmers.se/Cs/Research/Language-technology/darcs/GF/doc/darcs.html] 
 of GF since September 2006. To invoke the compiler, the flag 
 ``-printer=gfcc`` to the command
-``pm = print_multi`` is used. It is wise to recompile the grammar with
-the ``values`` optimization, and to ``strip`` the grammar before
-GFCC translation. Here is an example, performed in
+``pm = print_multi`` is used. It is wise to recompile the grammar from
+source, since previously compiled libraries may not obey the canonical
+order of records. To ``strip`` the grammar before
+GFCC translation removes unnecessary interface references.
+Here is an example, performed in
 [example/bronzeage ../../../../../examples/bronzeage].
 ```
   i -src -path=.:prelude:resource-1.0/* -optimize=values BronzeageEng.gf
+  i -src -path=.:prelude:resource-1.0/* -optimize=values BronzeageGer.gf
   strip
   pm -printer=gfcc | wf bronze.gfcc
 ```
@@ -520,7 +523,7 @@ The reference interpreter written in Haskell consists of the following files:
   AbsGFCC.hs    -- abstrac syntax of gfcc
   ErrM.hs       -- error monad used internally
   LexGFCC.hs    -- lexer of gfcc files
-  ParGFCC.hs    -- parser of gfcc files
+  ParGFCC.hs    -- parser of gfcc files and syntax trees
   PrintGFCC.hs  -- printer of gfcc files and syntax trees
 
   -- hand-written files
@@ -542,11 +545,16 @@ in ``GF/src``. To run it, type
 ```
 The available commands are
 - ``gr <Cat> <Int>``:  generate a number of random trees in category.
-  with their linearizations in all languages
+  and show their linearizations in all languages
+- ``grt <Cat> <Int>``:  generate a number of random trees in category.
+  and show the trees and their linearizations in all languages
 - ``gt <Cat> <Int>``:  generate a number of trees in category from smallest,
-  with their linearizations in all languages
-- ``p <Cat> <String>``: "parse", i.e. generate trees until match or time-out
-- ``<Tree>``: linearize tree in all languages
+  and show their linearizations in all languages
+- ``gtt <Cat> <Int>``:  generate a number of trees in category from smallest,
+  and show the trees and their linearizations in all languages
+- ``p <Int> <Cat> <String>``: "parse", i.e. generate trees until match or 
+  until the given number have been generated
+- ``<Tree>``: linearize tree in all languages, also showing full records
 - ``quit``: terminate the system cleanly