GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-09 04:59:31 -06:00
Code Issues Packages Projects Releases Wiki Activity

small fixes in GF.Grammar.Printer

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