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