From b90e56a94e335d42dd5abe653555cc0854803037 Mon Sep 17 00:00:00 2001 From: krasimir Date: Wed, 3 Feb 2010 17:33:55 +0000 Subject: fix the tabular printing when there is a V constructor --- src/compiler/GF/Grammar/ShowTerm.hs | 40 +++++++++++++++++++++++++++++++++++++ 1 file changed, 40 insertions(+) create mode 100644 src/compiler/GF/Grammar/ShowTerm.hs (limited to 'src/compiler/GF/Grammar/ShowTerm.hs') diff --git a/src/compiler/GF/Grammar/ShowTerm.hs b/src/compiler/GF/Grammar/ShowTerm.hs new file mode 100644 index 000000000..e039aea79 --- /dev/null +++ b/src/compiler/GF/Grammar/ShowTerm.hs @@ -0,0 +1,40 @@ +module GF.Grammar.ShowTerm where + +import GF.Grammar.Grammar +import GF.Grammar.Printer +import GF.Grammar.Lookup +import GF.Data.Operations + +import Text.PrettyPrint +import Data.List (intersperse) + +showTerm :: SourceGrammar -> TermPrintStyle -> TermPrintQual -> Term -> String +showTerm gr style q t = render $ + case style of + TermPrintTable -> vcat [p <+> s | (p,s) <- ppTermTabular gr q t] + TermPrintAll -> vcat [ s | (p,s) <- ppTermTabular gr q t] + TermPrintDefault -> ppTerm q 0 t + +ppTermTabular :: SourceGrammar -> TermPrintQual -> Term -> [(Doc,Doc)] +ppTermTabular gr q = pr where + pr t = case t of + R rs -> + [(ppLabel lab <+> char '.' <+> path, str) | (lab,(_,val)) <- rs, (path,str) <- pr val] + T _ cs -> + [(ppPatt q 0 patt <+> text "=>" <+> path, str) | (patt, val ) <- cs, (path,str) <- pr val] + V ty cs -> + let pvals = case allParamValues gr ty of + Ok pvals -> pvals + Bad _ -> map Meta [1..] + in [(ppTerm q 0 pval <+> text "=>" <+> path, str) | (pval, val) <- zip pvals cs, (path,str) <- pr val] + _ -> [(empty,ps t)] + ps t = case t of + K s -> text s + C s u -> ps s <+> ps u + FV ts -> hsep (intersperse (char '/') (map ps ts)) + _ -> ppTerm q 0 t + +data TermPrintStyle + = TermPrintTable + | TermPrintAll + | TermPrintDefault -- cgit v1.2.3