printing options for source GF terms defined in API and used in cc command

3 files changed, 38 insertions, 4 deletions

diff --git a/src-3.0/GF/Grammar/API.hs b/src-3.0/GF/Grammar/API.hs
index 57936ac45..bfbfb3d14 100644
--- a/src-3.0/GF/Grammar/API.hs
+++ b/src-3.0/GF/Grammar/API.hs
@@ -4,7 +4,8 @@ module GF.Grammar.API (
   pTerm,
   prTerm,
   checkTerm,
-  computeTerm
+  computeTerm,
+  showTerm
   ) where
 
 import GF.Source.ParGF
@@ -21,6 +22,8 @@ import GF.Compile.CheckGrammar (justCheckLTerm)
 import GF.Compile.Compute (computeConcrete)
 
 import GF.Data.Operations
+import GF.Infra.Option
+
 import qualified Data.ByteString.Char8 as BS
 
 type Grammar = SourceGrammar
@@ -49,3 +52,9 @@ checkTermAny gr m t = do
 computeTerm :: Grammar -> Term -> Err Term
 computeTerm = computeConcrete
 
+showTerm :: Options -> Term -> String
+showTerm opts t
+  | oElem (iOpt "table")  opts = unlines [p +++ s | (p,s) <- prTermTabular t]
+  | oElem (iOpt "all")    opts = unlines [      s | (p,s) <- prTermTabular t]
+  | oElem (iOpt "unqual") opts = prt_ t
+  | otherwise = prt t
diff --git a/src-3.0/GF/Grammar/PrGrammar.hs b/src-3.0/GF/Grammar/PrGrammar.hs
index 734aa13ca..027abe9f3 100644
--- a/src-3.0/GF/Grammar/PrGrammar.hs
+++ b/src-3.0/GF/Grammar/PrGrammar.hs
@@ -30,7 +30,8 @@ module GF.Grammar.PrGrammar (Print(..),
 		  prConstrs, prConstraints, 
 		  prMetaSubst, prEnv, prMSubst, 
 		  prExp, prOperSignature,
-                  lookupIdent, lookupIdentInfo
+                  lookupIdent, lookupIdentInfo,
+                  prTermTabular
 		 ) where
 
 import GF.Data.Operations
@@ -89,6 +90,12 @@ instance Print Ident where
 
 instance Print Patt where
   prt = pprintTree . trp
+  prt_ = prt . unqual where
+    unqual p = case p of
+      PP _ c [] -> PV c --- to remove curlies
+      PP _ c ps -> PC c (map unqual ps)
+      PC   c ps -> PC c (map unqual ps)
+      _ -> p ---- records
 
 instance Print Label where
   prt = pprintTree . trLabel
@@ -247,3 +254,20 @@ lookupIdent c t = case lookupTree prt c t of
 
 lookupIdentInfo :: Module Ident a -> Ident -> Err a
 lookupIdentInfo mo i = lookupIdent i (jments mo)
+
+
+--- printing cc command output AR 26/5/2008
+
+prTermTabular :: Term -> [(String,String)]
+prTermTabular = pr where
+  pr t = case t of
+    R rs   -> 
+      [(prt_ lab +++ "." +++ path, str) | (lab,(_,val)) <- rs, (path,str) <- pr val]
+    T _ cs -> 
+      [(prt_ lab +++"=>" +++ path, str) | (lab,   val)  <- cs, (path,str) <- pr val]
+    _ -> [([],ps t)]
+  ps t = case t of
+    K s   -> s
+    C s u -> ps s +++ ps u
+    FV ts -> unwords (intersperse "/" (map ps ts))
+    _ -> prt_ t 
diff --git a/src-3.0/GFI.hs b/src-3.0/GFI.hs
index ae2c2440d..5769d0550 100644
--- a/src-3.0/GFI.hs
+++ b/src-3.0/GFI.hs
@@ -34,8 +34,9 @@ loop gfenv0 = do
 
   -- special commands, requiring source grammar in env
     "cc":ws -> do
-       let t = pTerm (unwords ws) >>= checkTerm sgr >>= computeTerm sgr
-       err putStrLn (putStrLn . prTerm) t ---- make pipable
+       let (opts,term) = getOptions "-" ws
+       let t = pTerm (unwords term) >>= checkTerm sgr >>= computeTerm sgr
+       err putStrLn (putStrLn . showTerm opts) t ---- make pipable
        loopNewCPU gfenv
 
     "i":args -> do