msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

small fixes in GF.Grammar.Printer

Browse Source
This commit is contained in:
krasimir
2009-02-01 12:23:58 +00:00
parent 9275cd20c6
commit ccaf6a38a3
1 changed files with 11 additions and 9 deletions
Download Patch File Download Diff File Expand all files Collapse all files

20
src/GF/Grammar/Printer.hs
View File

@@ -8,7 +8,8 @@
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module GF.Grammar.Printer module GF.Grammar.Printer
( ppModule ( ppIdent
, ppModule
, ppJudgement , ppJudgement
, ppTerm , ppTerm
, ppPatt , ppPatt
@@ -26,20 +27,21 @@ import Data.List (intersperse)
ppModule :: SourceModule -> Doc ppModule :: SourceModule -> Doc
ppModule (mn, ModInfo mtype mstat opts exts with opens _ jments _) = ppModule (mn, ModInfo mtype mstat opts exts with opens _ jments _) =
(let defs = tree2list jments hdr $$ nest 2 (ppOptions opts $$ vcat (map ppJudgement defs)) $$ ftr
in if null defs
then hdr
else hdr <+> lbrace $$ nest 2 (ppOptions opts $$ vcat (map ppJudgement defs)) $$ rbrace)
where where
defs = tree2list jments
hdr = complModDoc <+> modTypeDoc <+> equals <+> hdr = complModDoc <+> modTypeDoc <+> equals <+>
hsep (intersperse (text "**") $ hsep (intersperse (text "**") $
filter (not . isEmpty) $ [ commaPunct ppExtends exts filter (not . isEmpty) $ [ commaPunct ppExtends exts
, maybe empty ppWith with , maybe empty ppWith with
, if null opens , if null opens
then empty then lbrace
else text "open" <+> commaPunct ppOpenSpec opens <+> text "in" else text "open" <+> commaPunct ppOpenSpec opens <+> text "in" <+> lbrace
]) ])
ftr = rbrace
complModDoc = complModDoc =
case mstat of case mstat of
MSComplete -> empty MSComplete -> empty
@@ -169,8 +171,8 @@ ppTerm d (Meta _) = char '?'
ppTerm d (Empty) = text "[]" ppTerm d (Empty) = text "[]"
ppTerm d (EData) = text "data" ppTerm d (EData) = text "data"
ppTerm d (R xs) = braces (fsep (punctuate semi [ppLabel l <+> ppTerm d (R xs) = braces (fsep (punctuate semi [ppLabel l <+>
case mb_t of {Just t -> colon <+> ppTerm 0 t; Nothing -> empty} <+> fsep [case mb_t of {Just t -> colon <+> ppTerm 0 t; Nothing -> empty},
equals <+> ppTerm 0 e | (l,(mb_t,e)) <- xs])) equals <+> ppTerm 0 e] | (l,(mb_t,e)) <- xs]))
ppTerm d (RecType xs)= braces (fsep (punctuate semi [ppLabel l <+> colon <+> ppTerm 0 t | (l,t) <- xs])) ppTerm d (RecType xs)= braces (fsep (punctuate semi [ppLabel l <+> colon <+> ppTerm 0 t | (l,t) <- xs]))
ppTerm d (Typed e t) = char '<' <> ppTerm 0 e <+> colon <+> ppTerm 0 t <> char '>' ppTerm d (Typed e t) = char '<' <> ppTerm 0 e <+> colon <+> ppTerm 0 t <> char '>'