summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authoraarne <aarne@cs.chalmers.se>2007-02-23 16:28:06 +0000
committeraarne <aarne@cs.chalmers.se>2007-02-23 16:28:06 +0000
commit5264780e67d74eb16a4cb499072b89b57ca4a37c (patch)
tree25925ff4bf8532101f180400f68045be3932d7ed
parent1d803dff1056e8cc04e9ef3998a7107b952b99c1 (diff)
cc -table
-rw-r--r--src/GF/API.hs21
-rw-r--r--src/GF/Shell.hs3
-rw-r--r--src/GF/Shell/HelpFile.hs1
-rw-r--r--src/GF/Shell/ShellCommands.hs2
-rw-r--r--src/HelpFile1
5 files changed, 26 insertions, 2 deletions
diff --git a/src/GF/API.hs b/src/GF/API.hs
index 9eb60ef19..f7bd5fc9c 100644
--- a/src/GF/API.hs
+++ b/src/GF/API.hs
@@ -434,3 +434,24 @@ nonLiteralsToUTF8 ('"':cs) = '"' : l ++ nonLiteralsToUTF8 rs
takeStringLit (c:cs) = (c:xs,ys)
where (xs,ys) = takeStringLit cs
nonLiteralsToUTF8 (c:cs) = encodeUTF8 [c] ++ nonLiteralsToUTF8 cs
+
+
+printParadigm :: G.Term -> String
+printParadigm term =
+ if hasTable term then
+ (unlines . map prBranch . branches . head . tables) term
+ else
+ prt term
+ where
+ tables t = case t of
+ G.R rs -> concatMap (tables . snd . snd) rs
+ G.T _ cs -> [cs]
+ _ -> []
+ hasTable t = not $ null $ tables t
+ branches cs = [(p:ps,s) |
+ (p,t) <- cs,
+ let ts = tables t,
+ (ps,s) <- if null ts then [([],t)]
+ else concatMap branches ts
+ ]
+ prBranch (ps,s) = unwords (map prt ps ++ [prt s])
diff --git a/src/GF/Shell.hs b/src/GF/Shell.hs
index 2543a8e91..19394855e 100644
--- a/src/GF/Shell.hs
+++ b/src/GF/Shell.hs
@@ -375,11 +375,12 @@ execC co@(comm, opts0) sa@(sh@(st,(h,_,_,_)),a) = checkOptions st co >> case com
CTestTokenizer -> changeArg (AString . optTokenizer opts gro . prCommandArg) sa
CComputeConcrete t -> do
+ let prin = if (oElem (iOpt "table") opts) then printParadigm else prt
m <- return $
maybe (I.identC "?") id $ -- meaningful if no opers in t
maybe (resourceOfShellState st) (return . I.identC) $ -- topmost res
getOptVal opts useResource -- flag -res=m
- justOutput opts (putStrLn (err id (prt . stripTerm) (
+ justOutput opts (putStrLn (err id (prin . stripTerm) (
string2srcTerm src m t >>=
Ch.justCheckLTerm src >>=
Co.computeConcrete src))) sa
diff --git a/src/GF/Shell/HelpFile.hs b/src/GF/Shell/HelpFile.hs
index 56e1b5903..eebaebd57 100644
--- a/src/GF/Shell/HelpFile.hs
+++ b/src/GF/Shell/HelpFile.hs
@@ -299,6 +299,7 @@ txtHelpFile =
"\n N.B.' The resulting Term is not a term in the sense of abstract syntax," ++
"\n and hence not a valid input to a Tree-demanding command." ++
"\n flags:" ++
+ "\n -table show output in a similar readable format as 'l -table'" ++
"\n -res use another module than the topmost one" ++
"\n examples:" ++
"\n cc -res=ParadigmsFin (nLukko \"hyppy\") -- inflect \"hyppy\" with nLukko" ++
diff --git a/src/GF/Shell/ShellCommands.hs b/src/GF/Shell/ShellCommands.hs
index cdfc75057..1ed778188 100644
--- a/src/GF/Shell/ShellCommands.hs
+++ b/src/GF/Shell/ShellCommands.hs
@@ -197,7 +197,7 @@ optionsOfCommand co = case co of
CApplyTransfer _ -> flags "lang transfer"
CMorphoAnalyse -> both "short" "lang"
CTestTokenizer -> flags "lexer"
- CComputeConcrete _ -> flags "res"
+ CComputeConcrete _ -> both "table" "res"
CShowOpers _ -> flags "res"
CTranslationQuiz _ _ -> flags "cat"
diff --git a/src/HelpFile b/src/HelpFile
index b1d3f3a83..be06efb0b 100644
--- a/src/HelpFile
+++ b/src/HelpFile
@@ -270,6 +270,7 @@ cc, compute_concrete: cc Term
N.B.' The resulting Term is not a term in the sense of abstract syntax,
and hence not a valid input to a Tree-demanding command.
flags:
+ -table show output in a similar readable format as 'l -table'
-res use another module than the topmost one
examples:
cc -res=ParadigmsFin (nLukko "hyppy") -- inflect "hyppy" with nLukko