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

Recreated GF and GFC pretty printers using the new BNFC version which makes more efficient pretty printers.

Browse Source
This commit is contained in:
bringert
2004-07-22 09:00:27 +00:00
parent db433bc409
commit f02c2bbef0
2 changed files with 445 additions and 417 deletions
Download Patch File Download Diff File Expand all files Collapse all files

336
src/GF/Canon/PrintGFC.hs
View File

@@ -10,312 +10,328 @@ import Char
printTree :: Print a => a -> String printTree :: Print a => a -> String
printTree = render . prt 0 printTree = render . prt 0
-- you may want to change render and parenth type Doc = [ShowS] -> [ShowS]
render :: [String] -> String doc :: ShowS -> Doc
render = rend 0 where doc = (:)
render :: Doc -> String
render d = rend 0 (map ($ "") $ d []) "" where
rend i ss = case ss of rend i ss = case ss of
"NEW" :ts -> realnew $ rend i ts --H "NEW" :ts -> realnew . rend i ts --H
"<" :ts -> cons "<" $ rend i ts --H "<" :ts -> showString "<" . rend i ts --H
"$" :ts -> cons "$" $ rend i ts --H "$" :ts -> showString "$" . rend i ts --H
"?" :ts -> cons "?" $ rend i ts --H "?" :ts -> showString "?" . rend i ts --H
"[" :ts -> cons "[" $ rend i ts "[" :ts -> showChar '[' . rend i ts
"(" :ts -> cons "(" $ rend i ts "(" :ts -> showChar '(' . rend i ts
"{" :ts -> cons "{" $ new (i+1) $ rend (i+1) ts "{" :ts -> showChar '{' . new (i+1) . rend (i+1) ts
"}" : ";":ts -> new (i-1) $ space "}" $ cons ";" $ new (i-1) $ rend (i-1) ts "}" : ";":ts -> new (i-1) . space "}" . showChar ';' . new (i-1) . rend (i-1) ts
"}" :ts -> new (i-1) $ cons "}" $ new (i-1) $ rend (i-1) ts "}" :ts -> new (i-1) . showChar '}' . new (i-1) . rend (i-1) ts
";" :ts -> cons ";" $ new i $ rend i ts ";" :ts -> showChar ';' . new i . rend i ts
t : "," :ts -> cons t $ space "," $ rend i ts t : "," :ts -> showString t . space "," . rend i ts
t : ")" :ts -> cons t $ cons ")" $ rend i ts t : ")" :ts -> showString t . showChar ')' . rend i ts
t : "]" :ts -> cons t $ cons "]" $ rend i ts t : "]" :ts -> showString t . showChar ']' . rend i ts
t : ">" :ts -> cons t $ cons ">" $ rend i ts --H t : ">" :ts -> showString t . showString ">" . rend i ts --H
t : "." :ts -> cons t $ cons "." $ rend i ts --H t : "." :ts -> showString t . showString "." . rend i ts --H
t :ts -> realspace t $ rend i ts --H t :ts -> realspace t . rend i ts --H
_ -> "" _ -> id
cons s t = s ++ t space t = showString t . showChar ' ' -- H
space t s = t ++ " " ++ s --H realspace t = showString t . (\s -> if null s then "" else (' ':s)) -- H
realspace t s = if null s then t else t ++ " " ++ s --H new i s = s -- H
new i s = s --H '\n' : replicate (2*i) ' ' ++ dropWhile isSpace s realnew = showChar '\n' --H
realnew s = '\n':s --H
parenth :: [String] -> [String]
parenth ss = ["("] ++ ss ++ [")"] parenth :: Doc -> Doc
parenth ss = doc (showChar '(') . ss . doc (showChar ')')
concatS :: [ShowS] -> ShowS
concatS = foldr (.) id
concatD :: [Doc] -> Doc
concatD = foldr (.) id
replicateS :: Int -> ShowS -> ShowS
replicateS n f = concatS (replicate n f)
-- the printer class does the job -- the printer class does the job
class Print a where class Print a where
prt :: Int -> a -> [String] prt :: Int -> a -> Doc
prtList :: [a] -> [String] prtList :: [a] -> Doc
prtList = concat . map (prt 0) prtList = concatD . map (prt 0)
instance Print a => Print [a] where instance Print a => Print [a] where
prt _ = prtList prt _ = prtList
instance Print Integer where instance Print Integer where
prt _ = (:[]) . show prt _ x = doc (shows x)
instance Print Double where instance Print Double where
prt _ = (:[]) . show prt _ x = doc (shows x)
instance Print Char where instance Print Char where
prt _ s = ["'" ++ mkEsc s ++ "'"] prt _ s = doc (showChar '\'' . mkEsc s . showChar '\'')
prtList s = ["\"" ++ concatMap mkEsc s ++ "\""] prtList s = doc (showChar '"' . concatS (map mkEsc s) . showChar '"')
mkEsc :: Char -> ShowS
mkEsc s = case s of mkEsc s = case s of
_ | elem s "\\\"'" -> '\\':[s] _ | elem s "\\\"'" -> showChar '\\' . showChar s
'\n' -> "\\n" '\n' -> showString "\\n"
'\t' -> "\\t" '\t' -> showString "\\t"
_ -> [s] _ -> showChar s
prPrec :: Int -> Int -> [String] -> [String] prPrec :: Int -> Int -> Doc -> Doc
prPrec i j = if j<i then parenth else id prPrec i j = if j<i then parenth else id
instance Print Ident where instance Print Ident where
prt _ i = [prIdent i] prt _ i = doc (showString $ prIdent i)
prtList es = case es of prtList es = case es of
[] -> (concat []) [] -> (concatD [])
[x] -> (concat [prt 0 x]) [x] -> (concatD [prt 0 x])
x:xs -> (concat [prt 0 x , [","] , prt 0 xs]) x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
instance Print Canon where instance Print Canon where
prt i e = case e of prt i e = case e of
Gr modules -> prPrec i 0 (concat [prt 0 modules]) Gr modules -> prPrec i 0 (concatD [prt 0 modules])
instance Print Module where instance Print Module where
prt i e = case e of prt i e = case e of
Mod modtype extend open flags defs -> prPrec i 0 (concat [prt 0 modtype , ["="] , prt 0 extend , prt 0 open , ["{"] , prt 0 flags , prt 0 defs , ["}"]]) Mod modtype extend open flags defs -> prPrec i 0 (concatD [prt 0 modtype , doc (showString "=") , prt 0 extend , prt 0 open , doc (showString "{") , prt 0 flags , prt 0 defs , doc (showString "}")])
prtList es = case es of prtList es = case es of
[] -> (concat []) [] -> (concatD [])
x:xs -> (concat [prt 0 x , prt 0 xs]) x:xs -> (concatD [prt 0 x , prt 0 xs])
instance Print ModType where instance Print ModType where
prt i e = case e of prt i e = case e of
MTAbs id -> prPrec i 0 (concat [["abstract"] , prt 0 id]) MTAbs id -> prPrec i 0 (concatD [doc (showString "abstract") , prt 0 id])
MTCnc id0 id -> prPrec i 0 (concat [["concrete"] , prt 0 id0 , ["of"] , prt 0 id]) MTCnc id0 id -> prPrec i 0 (concatD [doc (showString "concrete") , prt 0 id0 , doc (showString "of") , prt 0 id])
MTRes id -> prPrec i 0 (concat [["resource"] , prt 0 id]) MTRes id -> prPrec i 0 (concatD [doc (showString "resource") , prt 0 id])
MTTrans id open0 open -> prPrec i 0 (concat [["transfer"] , prt 0 id , [":"] , prt 0 open0 , ["->"] , prt 0 open]) MTTrans id0 id1 id -> prPrec i 0 (concatD [doc (showString "transfer") , prt 0 id0 , doc (showString ":") , prt 0 id1 , doc (showString "->") , prt 0 id])
instance Print Extend where instance Print Extend where
prt i e = case e of prt i e = case e of
Ext id -> prPrec i 0 (concat [prt 0 id , ["**"]]) Ext id -> prPrec i 0 (concatD [prt 0 id , doc (showString "**")])
NoExt -> prPrec i 0 (concat []) NoExt -> prPrec i 0 (concatD [])
instance Print Open where instance Print Open where
prt i e = case e of prt i e = case e of
NoOpens -> prPrec i 0 (concat []) Opens ids -> prPrec i 0 (concatD [doc (showString "open") , prt 0 ids , doc (showString "in")])
Opens ids -> prPrec i 0 (concat [["open"] , prt 0 ids , ["in"]]) NoOpens -> prPrec i 0 (concatD [])
instance Print Flag where instance Print Flag where
prt i e = case e of prt i e = case e of
Flg id0 id -> prPrec i 0 (concat [["flags"] , prt 0 id0 , ["="] , prt 0 id]) Flg id0 id -> prPrec i 0 (concatD [doc (showString "flags") , prt 0 id0 , doc (showString "=") , prt 0 id])
prtList es = case es of prtList es = case es of
[] -> (concat []) [] -> (concatD [])
x:xs -> (concat [prt 0 x , [";"] , prt 0 xs]) x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
instance Print Def where instance Print Def where
prt i e = case e of prt i e = case e of
AbsDCat id decls cidents -> prPrec i 0 (concat [["cat"] , prt 0 id , ["["] , prt 0 decls , ["]"] , ["="] , prt 0 cidents]) AbsDCat id decls cidents -> prPrec i 0 (concatD [doc (showString "cat") , prt 0 id , doc (showString "[") , prt 0 decls , doc (showString "]") , doc (showString "=") , prt 0 cidents])
AbsDFun id exp0 exp -> prPrec i 0 (concat [["fun"] , prt 0 id , [":"] , prt 0 exp0 , ["="] , prt 0 exp]) AbsDFun id exp0 exp -> prPrec i 0 (concatD [doc (showString "fun") , prt 0 id , doc (showString ":") , prt 0 exp0 , doc (showString "=") , prt 0 exp])
AbsDTrans id exp -> prPrec i 0 (concat [["transfer"] , prt 0 id , ["="] , prt 0 exp]) AbsDTrans id exp -> prPrec i 0 (concatD [doc (showString "transfer") , prt 0 id , doc (showString "=") , prt 0 exp])
ResDPar id pardefs -> prPrec i 0 (concat [["param"] , prt 0 id , ["="] , prt 0 pardefs]) ResDPar id pardefs -> prPrec i 0 (concatD [doc (showString "param") , prt 0 id , doc (showString "=") , prt 0 pardefs])
ResDOper id ctype term -> prPrec i 0 (concat [["oper"] , prt 0 id , [":"] , prt 0 ctype , ["="] , prt 0 term]) ResDOper id ctype term -> prPrec i 0 (concatD [doc (showString "oper") , prt 0 id , doc (showString ":") , prt 0 ctype , doc (showString "=") , prt 0 term])
CncDCat id ctype term0 term -> prPrec i 0 (concat [["lincat"] , prt 0 id , ["="] , prt 0 ctype , ["="] , prt 0 term0 , [";"] , prt 0 term]) CncDCat id ctype term0 term -> prPrec i 0 (concatD [doc (showString "lincat") , prt 0 id , doc (showString "=") , prt 0 ctype , doc (showString "=") , prt 0 term0 , doc (showString ";") , prt 0 term])
CncDFun id cident argvars term0 term -> prPrec i 0 (concat [["lin"] , prt 0 id , [":"] , prt 0 cident , ["="] , ["\\"] , prt 0 argvars , ["->"] , prt 0 term0 , [";"] , prt 0 term]) CncDFun id cident argvars term0 term -> prPrec i 0 (concatD [doc (showString "lin") , prt 0 id , doc (showString ":") , prt 0 cident , doc (showString "=") , doc (showString "\\") , prt 0 argvars , doc (showString "->") , prt 0 term0 , doc (showString ";") , prt 0 term])
AnyDInd id0 status id -> prPrec i 0 (concat [prt 0 id0 , prt 0 status , ["in"] , prt 0 id]) AnyDInd id0 status id -> prPrec i 0 (concatD [prt 0 id0 , prt 0 status , doc (showString "in") , prt 0 id])
prtList es = case es of prtList es = case es of
[] -> (concat []) [] -> (concatD [])
x:xs -> (concat [prt 0 x , [";","NEW"] , prt 0 xs]) --H x:xs -> (concatD [prt 0 x , doc (showString ";"), doc (showString "NEW") , prt 0 xs]) -- H
instance Print ParDef where instance Print ParDef where
prt i e = case e of prt i e = case e of
ParD id ctypes -> prPrec i 0 (concat [prt 0 id , prt 0 ctypes]) ParD id ctypes -> prPrec i 0 (concatD [prt 0 id , prt 0 ctypes])
prtList es = case es of prtList es = case es of
[] -> (concat []) [] -> (concatD [])
[x] -> (concat [prt 0 x]) [x] -> (concatD [prt 0 x])
x:xs -> (concat [prt 0 x , ["|"] , prt 0 xs]) x:xs -> (concatD [prt 0 x , doc (showString "|") , prt 0 xs])
instance Print Status where instance Print Status where
prt i e = case e of prt i e = case e of
Canon -> prPrec i 0 (concat [["data"]]) Canon -> prPrec i 0 (concatD [doc (showString "data")])
NonCan -> prPrec i 0 (concat []) NonCan -> prPrec i 0 (concatD [])
instance Print CIdent where instance Print CIdent where
prt i e = case e of prt i e = case e of
CIQ id0 id -> prPrec i 0 (concat [prt 0 id0 , ["."] , prt 0 id]) CIQ id0 id -> prPrec i 0 (concatD [prt 0 id0 , doc (showString ".") , prt 0 id])
prtList es = case es of prtList es = case es of
[] -> (concat []) [] -> (concatD [])
x:xs -> (concat [prt 0 x , prt 0 xs]) x:xs -> (concatD [prt 0 x , prt 0 xs])
instance Print Exp where instance Print Exp where
prt i e = case e of prt i e = case e of
EApp exp0 exp -> prPrec i 1 (concat [prt 1 exp0 , prt 2 exp]) EApp exp0 exp -> prPrec i 1 (concatD [prt 1 exp0 , prt 2 exp])
EProd id exp0 exp -> prPrec i 0 (concat [["("] , prt 0 id , [":"] , prt 0 exp0 , [")"] , ["->"] , prt 0 exp]) EProd id exp0 exp -> prPrec i 0 (concatD [doc (showString "(") , prt 0 id , doc (showString ":") , prt 0 exp0 , doc (showString ")") , doc (showString "->") , prt 0 exp])
EAtom atom -> prPrec i 2 (concat [prt 0 atom]) EAbs id exp -> prPrec i 0 (concatD [doc (showString "\\") , prt 0 id , doc (showString "->") , prt 0 exp])
EAbs id exp -> prPrec i 0 (concat [["\\"] , prt 0 id , ["->"] , prt 0 exp]) EAtom atom -> prPrec i 2 (concatD [prt 0 atom])
EEq equations -> prPrec i 0 (concat [["{"] , prt 0 equations , ["}"]]) EData -> prPrec i 2 (concatD [doc (showString "data")])
EData -> prPrec i 2 (concat [["data"]]) EEq equations -> prPrec i 0 (concatD [doc (showString "{") , prt 0 equations , doc (showString "}")])
instance Print Sort where instance Print Sort where
prt i e = case e of prt i e = case e of
SType -> prPrec i 0 (concat [["Type"]]) SType -> prPrec i 0 (concatD [doc (showString "Type")])
instance Print Equation where instance Print Equation where
prt i e = case e of prt i e = case e of
Equ apatts exp -> prPrec i 0 (concat [prt 0 apatts , ["->"] , prt 0 exp]) Equ apatts exp -> prPrec i 0 (concatD [prt 0 apatts , doc (showString "->") , prt 0 exp])
prtList es = case es of prtList es = case es of
[] -> (concat []) [] -> (concatD [])
x:xs -> (concat [prt 0 x , [";"] , prt 0 xs]) x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
instance Print APatt where instance Print APatt where
prt i e = case e of prt i e = case e of
APC cident apatts -> prPrec i 0 (concat [["("] , prt 0 cident , prt 0 apatts , [")"]]) APC cident apatts -> prPrec i 0 (concatD [doc (showString "(") , prt 0 cident , prt 0 apatts , doc (showString ")")])
APV id -> prPrec i 0 (concat [prt 0 id]) APV id -> prPrec i 0 (concatD [prt 0 id])
APS str -> prPrec i 0 (concat [prt 0 str]) APS str -> prPrec i 0 (concatD [prt 0 str])
API n -> prPrec i 0 (concat [prt 0 n]) API n -> prPrec i 0 (concatD [prt 0 n])
APW -> prPrec i 0 (concat [["_"]]) APW -> prPrec i 0 (concatD [doc (showString "_")])
prtList es = case es of prtList es = case es of
[] -> (concat []) [] -> (concatD [])
x:xs -> (concat [prt 0 x , prt 0 xs]) x:xs -> (concatD [prt 0 x , prt 0 xs])
instance Print Atom where instance Print Atom where
prt i e = case e of prt i e = case e of
AC cident -> prPrec i 0 (concat [prt 0 cident]) AC cident -> prPrec i 0 (concatD [prt 0 cident])
AD cident -> prPrec i 0 (concat [["<"] , prt 0 cident , [">"]]) AD cident -> prPrec i 0 (concatD [doc (showString "<") , prt 0 cident , doc (showString ">")])
AV id -> prPrec i 0 (concat [["$"] , prt 0 id]) AV id -> prPrec i 0 (concatD [doc (showString "$") , prt 0 id])
AM n -> prPrec i 0 (concat [["?"] , prt 0 n]) AM n -> prPrec i 0 (concatD [doc (showString "?") , prt 0 n])
AS str -> prPrec i 0 (concat [prt 0 str]) AS str -> prPrec i 0 (concatD [prt 0 str])
AI n -> prPrec i 0 (concat [prt 0 n]) AI n -> prPrec i 0 (concatD [prt 0 n])
AT sort -> prPrec i 0 (concat [prt 0 sort]) AT sort -> prPrec i 0 (concatD [prt 0 sort])
instance Print Decl where instance Print Decl where
prt i e = case e of prt i e = case e of
Decl id exp -> prPrec i 0 (concat [prt 0 id , [":"] , prt 0 exp]) Decl id exp -> prPrec i 0 (concatD [prt 0 id , doc (showString ":") , prt 0 exp])
prtList es = case es of prtList es = case es of
[] -> (concat []) [] -> (concatD [])
[x] -> (concat [prt 0 x]) [x] -> (concatD [prt 0 x])
x:xs -> (concat [prt 0 x , [";"] , prt 0 xs]) x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
instance Print CType where instance Print CType where
prt i e = case e of prt i e = case e of
RecType labellings -> prPrec i 0 (concat [["{"] , prt 0 labellings , ["}"]]) RecType labellings -> prPrec i 0 (concatD [doc (showString "{") , prt 0 labellings , doc (showString "}")])
Table ctype0 ctype -> prPrec i 0 (concat [["("] , prt 0 ctype0 , ["=>"] , prt 0 ctype , [")"]]) Table ctype0 ctype -> prPrec i 0 (concatD [doc (showString "(") , prt 0 ctype0 , doc (showString "=>") , prt 0 ctype , doc (showString ")")])
Cn cident -> prPrec i 0 (concat [prt 0 cident]) Cn cident -> prPrec i 0 (concatD [prt 0 cident])
TStr -> prPrec i 0 (concat [["Str"]]) TStr -> prPrec i 0 (concatD [doc (showString "Str")])
prtList es = case es of prtList es = case es of
[] -> (concat []) [] -> (concatD [])
x:xs -> (concat [prt 0 x , prt 0 xs]) x:xs -> (concatD [prt 0 x , prt 0 xs])
instance Print Labelling where instance Print Labelling where
prt i e = case e of prt i e = case e of
Lbg label ctype -> prPrec i 0 (concat [prt 0 label , [":"] , prt 0 ctype]) Lbg label ctype -> prPrec i 0 (concatD [prt 0 label , doc (showString ":") , prt 0 ctype])
prtList es = case es of prtList es = case es of
[] -> (concat []) [] -> (concatD [])
[x] -> (concat [prt 0 x]) [x] -> (concatD [prt 0 x])
x:xs -> (concat [prt 0 x , [";"] , prt 0 xs]) x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
instance Print Term where instance Print Term where
prt i e = case e of prt i e = case e of
Arg argvar -> prPrec i 2 (concat [prt 0 argvar]) Arg argvar -> prPrec i 2 (concatD [prt 0 argvar])
I cident -> prPrec i 2 (concat [prt 0 cident]) I cident -> prPrec i 2 (concatD [prt 0 cident])
Con cident terms -> prPrec i 2 (concat [["<"] , prt 0 cident , prt 2 terms , [">"]]) Con cident terms -> prPrec i 2 (concatD [doc (showString "<") , prt 0 cident , prt 2 terms , doc (showString ">")])
LI id -> prPrec i 2 (concat [["$"] , prt 0 id]) LI id -> prPrec i 2 (concatD [doc (showString "$") , prt 0 id])
R assigns -> prPrec i 2 (concat [["{"] , prt 0 assigns , ["}"]]) R assigns -> prPrec i 2 (concatD [doc (showString "{") , prt 0 assigns , doc (showString "}")])
P term label -> prPrec i 1 (concat [prt 2 term , ["."] , prt 0 label]) P term label -> prPrec i 1 (concatD [prt 2 term , doc (showString ".") , prt 0 label])
T ctype cases -> prPrec i 1 (concat [["table"] , prt 0 ctype , ["{"] , prt 0 cases , ["}"]]) T ctype cases -> prPrec i 1 (concatD [doc (showString "table") , prt 0 ctype , doc (showString "{") , prt 0 cases , doc (showString "}")])
S term0 term -> prPrec i 1 (concat [prt 1 term0 , ["!"] , prt 2 term]) S term0 term -> prPrec i 1 (concatD [prt 1 term0 , doc (showString "!") , prt 2 term])
C term0 term -> prPrec i 0 (concat [prt 0 term0 , ["++"] , prt 1 term]) C term0 term -> prPrec i 0 (concatD [prt 0 term0 , doc (showString "++") , prt 1 term])
FV terms -> prPrec i 1 (concat [["variants"] , ["{"] , prt 2 terms , ["}"]]) FV terms -> prPrec i 1 (concatD [doc (showString "variants") , doc (showString "{") , prt 2 terms , doc (showString "}")])
K tokn -> prPrec i 2 (concat [prt 0 tokn]) K tokn -> prPrec i 2 (concatD [prt 0 tokn])
E -> prPrec i 2 (concat [["["] , ["]"]]) E -> prPrec i 2 (concatD [doc (showString "[") , doc (showString "]")])
prtList es = case es of prtList es = case es of
[] -> (concat []) [] -> (concatD [])
x:xs -> (concat [prt 2 x , prt 2 xs]) x:xs -> (concatD [prt 2 x , prt 2 xs])
instance Print Tokn where instance Print Tokn where
prt i e = case e of prt i e = case e of
KS str -> prPrec i 0 (concat [prt 0 str]) KS str -> prPrec i 0 (concatD [prt 0 str])
KP strs variants -> prPrec i 0 (concat [["["] , ["pre"] , prt 0 strs , ["{"] , prt 0 variants , ["}"] , ["]"]]) KP strs variants -> prPrec i 0 (concatD [doc (showString "[") , doc (showString "pre") , prt 0 strs , doc (showString "{") , prt 0 variants , doc (showString "}") , doc (showString "]")])
instance Print Assign where instance Print Assign where
prt i e = case e of prt i e = case e of
Ass label term -> prPrec i 0 (concat [prt 0 label , ["="] , prt 0 term]) Ass label term -> prPrec i 0 (concatD [prt 0 label , doc (showString "=") , prt 0 term])
prtList es = case es of prtList es = case es of
[] -> (concat []) [] -> (concatD [])
[x] -> (concat [prt 0 x]) [x] -> (concatD [prt 0 x])
x:xs -> (concat [prt 0 x , [";"] , prt 0 xs]) x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
instance Print Case where instance Print Case where
prt i e = case e of prt i e = case e of
Cas patts term -> prPrec i 0 (concat [prt 0 patts , ["=>"] , prt 0 term]) Cas patts term -> prPrec i 0 (concatD [prt 0 patts , doc (showString "=>") , prt 0 term])
prtList es = case es of prtList es = case es of
[] -> (concat []) [] -> (concatD [])
[x] -> (concat [prt 0 x]) [x] -> (concatD [prt 0 x])
x:xs -> (concat [prt 0 x , [";"] , prt 0 xs]) x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
instance Print Variant where instance Print Variant where
prt i e = case e of prt i e = case e of
Var strs0 strs -> prPrec i 0 (concat [prt 0 strs0 , ["/"] , prt 0 strs]) Var strs0 strs -> prPrec i 0 (concatD [prt 0 strs0 , doc (showString "/") , prt 0 strs])
prtList es = case es of prtList es = case es of
[] -> (concat []) [] -> (concatD [])
[x] -> (concat [prt 0 x]) [x] -> (concatD [prt 0 x])
x:xs -> (concat [prt 0 x , [";"] , prt 0 xs]) x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
instance Print Label where instance Print Label where
prt i e = case e of prt i e = case e of
L id -> prPrec i 0 (concat [prt 0 id]) L id -> prPrec i 0 (concatD [prt 0 id])
LV n -> prPrec i 0 (concat [["$"] , prt 0 n]) LV n -> prPrec i 0 (concatD [doc (showString "$") , prt 0 n])
instance Print ArgVar where instance Print ArgVar where
prt i e = case e of prt i e = case e of
A id n -> prPrec i 0 (concat [prt 0 id , ["@"] , prt 0 n]) A id n -> prPrec i 0 (concatD [prt 0 id , doc (showString "@") , prt 0 n])
AB id n0 n -> prPrec i 0 (concat [prt 0 id , ["+"] , prt 0 n0 , ["@"] , prt 0 n]) AB id n0 n -> prPrec i 0 (concatD [prt 0 id , doc (showString "+") , prt 0 n0 , doc (showString "@") , prt 0 n])
prtList es = case es of prtList es = case es of
[] -> (concat []) [] -> (concatD [])
[x] -> (concat [prt 0 x]) [x] -> (concatD [prt 0 x])
x:xs -> (concat [prt 0 x , [","] , prt 0 xs]) x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
instance Print Patt where instance Print Patt where
prt i e = case e of prt i e = case e of
PC cident patts -> prPrec i 0 (concat [["("] , prt 0 cident , prt 0 patts , [")"]]) PC cident patts -> prPrec i 0 (concatD [doc (showString "(") , prt 0 cident , prt 0 patts , doc (showString ")")])
PV id -> prPrec i 0 (concat [prt 0 id]) PV id -> prPrec i 0 (concatD [prt 0 id])
PW -> prPrec i 0 (concat [["_"]]) PW -> prPrec i 0 (concatD [doc (showString "_")])
PR pattassigns -> prPrec i 0 (concat [["{"] , prt 0 pattassigns , ["}"]]) PR pattassigns -> prPrec i 0 (concatD [doc (showString "{") , prt 0 pattassigns , doc (showString "}")])
prtList es = case es of prtList es = case es of
[] -> (concat []) [] -> (concatD [])
x:xs -> (concat [prt 0 x , prt 0 xs]) x:xs -> (concatD [prt 0 x , prt 0 xs])
instance Print PattAssign where instance Print PattAssign where
prt i e = case e of prt i e = case e of
PAss label patt -> prPrec i 0 (concat [prt 0 label , ["="] , prt 0 patt]) PAss label patt -> prPrec i 0 (concatD [prt 0 label , doc (showString "=") , prt 0 patt])
prtList es = case es of prtList es = case es of
[] -> (concat []) [] -> (concatD [])
[x] -> (concat [prt 0 x]) [x] -> (concatD [prt 0 x])
x:xs -> (concat [prt 0 x , [";"] , prt 0 xs]) x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])

526
src/GF/Source/PrintGF.hs
View File

@@ -2,489 +2,501 @@ module PrintGF where
-- pretty-printer generated by the BNF converter, except --H -- pretty-printer generated by the BNF converter, except --H
import AbsGF
import Ident --H import Ident --H
import AbsGF
import Char import Char
-- the top-level printing method -- the top-level printing method
printTree :: Print a => a -> String printTree :: Print a => a -> String
printTree = render . prt 0 printTree = render . prt 0
-- you may want to change render and parenth type Doc = [ShowS] -> [ShowS]
render :: [String] -> String doc :: ShowS -> Doc
render = rend 0 where doc = (:)
render :: Doc -> String
render d = rend 0 (map ($ "") $ d []) "" where
rend i ss = case ss of rend i ss = case ss of
--H these four are hand-written --H these four are hand-written
"{0" :ts -> cons "{" $ rend (i+1) ts "{0" :ts -> showChar '{' . rend (i+1) ts
t :"}0" :ts -> cons t $ space "}" $ rend (i-1) ts t :"}0" :ts -> showString t . space "}" . rend (i-1) ts
t : "." :ts -> cons t $ cons "." $ rend i ts t : "." :ts -> showString t . showString "." . rend i ts
"\\" :ts -> cons "\\" $ rend i ts "\\" :ts -> showString "\\" . rend i ts
"[" :ts -> cons "[" $ rend i ts "[" :ts -> showChar '[' . rend i ts
"(" :ts -> cons "(" $ rend i ts "(" :ts -> showChar '(' . rend i ts
"{" :ts -> cons "{" $ new (i+1) $ rend (i+1) ts "{" :ts -> showChar '{' . new (i+1) . rend (i+1) ts
"}" : ";":ts -> new (i-1) $ space "}" $ cons ";" $ new (i-1) $ rend (i-1) ts "}" : ";":ts -> new (i-1) . space "}" . showChar ';' . new (i-1) . rend (i-1) ts
"}" :ts -> new (i-1) $ cons "}" $ new (i-1) $ rend (i-1) ts "}" :ts -> new (i-1) . showChar '}' . new (i-1) . rend (i-1) ts
";" :ts -> cons ";" $ new i $ rend i ts ";" :ts -> showChar ';' . new i . rend i ts
t : "," :ts -> cons t $ space "," $ rend i ts t : "," :ts -> showString t . space "," . rend i ts
t : ")" :ts -> cons t $ cons ")" $ rend i ts t : ")" :ts -> showString t . showChar ')' . rend i ts
t : "]" :ts -> cons t $ cons "]" $ rend i ts t : "]" :ts -> showString t . showChar ']' . rend i ts
t :ts -> space t $ rend i ts t :ts -> space t . rend i ts
_ -> "" _ -> id
cons s t = s ++ t new i = showChar '\n' . replicateS (2*i) (showChar ' ') . dropWhile isSpace
new i s = '\n' : replicate (2*i) ' ' ++ dropWhile isSpace s space t = showString t . (\s -> if null s then "" else (' ':s))
space t s = if null s then t else t ++ " " ++ s
parenth :: [String] -> [String] parenth :: Doc -> Doc
parenth ss = ["("] ++ ss ++ [")"] parenth ss = doc (showChar '(') . ss . doc (showChar ')')
concatS :: [ShowS] -> ShowS
concatS = foldr (.) id
concatD :: [Doc] -> Doc
concatD = foldr (.) id
replicateS :: Int -> ShowS -> ShowS
replicateS n f = concatS (replicate n f)
-- the printer class does the job -- the printer class does the job
class Print a where class Print a where
prt :: Int -> a -> [String] prt :: Int -> a -> Doc
prtList :: [a] -> [String] prtList :: [a] -> Doc
prtList = concat . map (prt 0) prtList = concatD . map (prt 0)
instance Print a => Print [a] where instance Print a => Print [a] where
prt _ = prtList prt _ = prtList
instance Print Integer where instance Print Integer where
prt _ = (:[]) . show prt _ x = doc (shows x)
instance Print Double where instance Print Double where
prt _ = (:[]) . show prt _ x = doc (shows x)
instance Print Char where instance Print Char where
prt _ s = ["'" ++ mkEsc s ++ "'"] prt _ s = doc (showChar '\'' . mkEsc s . showChar '\'')
prtList s = ["\"" ++ concatMap mkEsc s ++ "\""] prtList s = doc (showChar '"' . concatS (map mkEsc s) . showChar '"')
mkEsc :: Char -> ShowS
mkEsc s = case s of mkEsc s = case s of
_ | elem s "\\\"" -> '\\':[s] _ | elem s "\\\"'" -> showChar '\\' . showChar s
'\n' -> "\\n" '\n' -> showString "\\n"
'\t' -> "\\t" '\t' -> showString "\\t"
_ -> [s] _ -> showChar s
prPrec :: Int -> Int -> [String] -> [String] prPrec :: Int -> Int -> Doc -> Doc
prPrec i j = if j<i then parenth else id prPrec i j = if j<i then parenth else id
instance Print Ident where instance Print Ident where
prt _ i = [prIdent i] --H prt _ i = doc (showString $ prIdent i)
prtList es = case es of prtList es = case es of
[x] -> (concat [prt 0 x]) [x] -> (concatD [prt 0 x])
x:xs -> (concat [prt 0 x , [","] , prt 0 xs]) x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
instance Print LString where instance Print LString where
prt _ (LString i) = [i] prt _ (LString i) = doc (showString i)
instance Print Grammar where instance Print Grammar where
prt i e = case e of prt i e = case e of
Gr moddefs -> prPrec i 0 (concat [prt 0 moddefs]) Gr moddefs -> prPrec i 0 (concatD [prt 0 moddefs])
instance Print ModDef where instance Print ModDef where
prt i e = case e of prt i e = case e of
MMain id0 id concspecs -> prPrec i 0 (concat [["grammar"] , prt 0 id0 , ["="] , ["{"] , ["abstract"] , ["="] , prt 0 id , [";"] , prt 0 concspecs , ["}"]]) MMain id0 id concspecs -> prPrec i 0 (concatD [doc (showString "grammar") , prt 0 id0 , doc (showString "=") , doc (showString "{") , doc (showString "abstract") , doc (showString "=") , prt 0 id , doc (showString ";") , prt 0 concspecs , doc (showString "}")])
MModule complmod modtype modbody -> prPrec i 0 (concat [prt 0 complmod , prt 0 modtype , ["="] , prt 0 modbody]) MModule complmod modtype modbody -> prPrec i 0 (concatD [prt 0 complmod , prt 0 modtype , doc (showString "=") , prt 0 modbody])
prtList es = case es of prtList es = case es of
[] -> (concat []) [] -> (concatD [])
x:xs -> (concat [prt 0 x , prt 0 xs]) x:xs -> (concatD [prt 0 x , prt 0 xs])
instance Print ConcSpec where instance Print ConcSpec where
prt i e = case e of prt i e = case e of
ConcSpec id concexp -> prPrec i 0 (concat [prt 0 id , ["="] , prt 0 concexp]) ConcSpec id concexp -> prPrec i 0 (concatD [prt 0 id , doc (showString "=") , prt 0 concexp])
prtList es = case es of prtList es = case es of
[] -> (concat []) [] -> (concatD [])
[x] -> (concat [prt 0 x]) [x] -> (concatD [prt 0 x])
x:xs -> (concat [prt 0 x , [";"] , prt 0 xs]) x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
instance Print ConcExp where instance Print ConcExp where
prt i e = case e of prt i e = case e of
ConcExp id transfers -> prPrec i 0 (concat [prt 0 id , prt 0 transfers]) ConcExp id transfers -> prPrec i 0 (concatD [prt 0 id , prt 0 transfers])
instance Print Transfer where instance Print Transfer where
prt i e = case e of prt i e = case e of
TransferIn open -> prPrec i 0 (concat [["("] , ["transfer"] , ["in"] , prt 0 open , [")"]]) TransferIn open -> prPrec i 0 (concatD [doc (showString "(") , doc (showString "transfer") , doc (showString "in") , prt 0 open , doc (showString ")")])
TransferOut open -> prPrec i 0 (concat [["("] , ["transfer"] , ["out"] , prt 0 open , [")"]]) TransferOut open -> prPrec i 0 (concatD [doc (showString "(") , doc (showString "transfer") , doc (showString "out") , prt 0 open , doc (showString ")")])
prtList es = case es of prtList es = case es of
[] -> (concat []) [] -> (concatD [])
x:xs -> (concat [prt 0 x , prt 0 xs]) x:xs -> (concatD [prt 0 x , prt 0 xs])
instance Print ModType where instance Print ModType where
prt i e = case e of prt i e = case e of
MTAbstract id -> prPrec i 0 (concat [["abstract"] , prt 0 id]) MTAbstract id -> prPrec i 0 (concatD [doc (showString "abstract") , prt 0 id])
MTResource id -> prPrec i 0 (concat [["resource"] , prt 0 id]) MTResource id -> prPrec i 0 (concatD [doc (showString "resource") , prt 0 id])
MTInterface id -> prPrec i 0 (concat [["interface"] , prt 0 id]) MTInterface id -> prPrec i 0 (concatD [doc (showString "interface") , prt 0 id])
MTConcrete id0 id -> prPrec i 0 (concat [["concrete"] , prt 0 id0 , ["of"] , prt 0 id]) MTConcrete id0 id -> prPrec i 0 (concatD [doc (showString "concrete") , prt 0 id0 , doc (showString "of") , prt 0 id])
MTInstance id0 id -> prPrec i 0 (concat [["instance"] , prt 0 id0 , ["of"] , prt 0 id]) MTInstance id0 id -> prPrec i 0 (concatD [doc (showString "instance") , prt 0 id0 , doc (showString "of") , prt 0 id])
MTTransfer id open0 open -> prPrec i 0 (concat [["transfer"] , prt 0 id , [":"] , prt 0 open0 , ["->"] , prt 0 open]) MTTransfer id open0 open -> prPrec i 0 (concatD [doc (showString "transfer") , prt 0 id , doc (showString ":") , prt 0 open0 , doc (showString "->") , prt 0 open])
instance Print ModBody where instance Print ModBody where
prt i e = case e of prt i e = case e of
MBody extend opens topdefs -> prPrec i 0 (concat [prt 0 extend , prt 0 opens , ["{"] , prt 0 topdefs , ["}"]]) MBody extend opens topdefs -> prPrec i 0 (concatD [prt 0 extend , prt 0 opens , doc (showString "{") , prt 0 topdefs , doc (showString "}")])
MWith id opens -> prPrec i 0 (concat [prt 0 id , ["with"] , prt 0 opens]) MWith id opens -> prPrec i 0 (concatD [prt 0 id , doc (showString "with") , prt 0 opens])
MReuse id -> prPrec i 0 (concat [["reuse"] , prt 0 id]) MReuse id -> prPrec i 0 (concatD [doc (showString "reuse") , prt 0 id])
MUnion includeds -> prPrec i 0 (concat [["union"] , prt 0 includeds]) MUnion includeds -> prPrec i 0 (concatD [doc (showString "union") , prt 0 includeds])
instance Print Extend where instance Print Extend where
prt i e = case e of prt i e = case e of
Ext id -> prPrec i 0 (concat [prt 0 id , ["**"]]) Ext id -> prPrec i 0 (concatD [prt 0 id , doc (showString "**")])
NoExt -> prPrec i 0 (concat []) NoExt -> prPrec i 0 (concatD [])
instance Print Opens where instance Print Opens where
prt i e = case e of prt i e = case e of
NoOpens -> prPrec i 0 (concat []) NoOpens -> prPrec i 0 (concatD [])
Opens opens -> prPrec i 0 (concat [["open"] , prt 0 opens , ["in"]]) Opens opens -> prPrec i 0 (concatD [doc (showString "open") , prt 0 opens , doc (showString "in")])
instance Print Open where instance Print Open where
prt i e = case e of prt i e = case e of
OName id -> prPrec i 0 (concat [prt 0 id]) OName id -> prPrec i 0 (concatD [prt 0 id])
OQualQO qualopen id -> prPrec i 0 (concat [["("] , prt 0 qualopen , prt 0 id , [")"]]) OQualQO qualopen id -> prPrec i 0 (concatD [doc (showString "(") , prt 0 qualopen , prt 0 id , doc (showString ")")])
OQual qualopen id0 id -> prPrec i 0 (concat [["("] , prt 0 qualopen , prt 0 id0 , ["="] , prt 0 id , [")"]]) OQual qualopen id0 id -> prPrec i 0 (concatD [doc (showString "(") , prt 0 qualopen , prt 0 id0 , doc (showString "=") , prt 0 id , doc (showString ")")])
prtList es = case es of prtList es = case es of
[] -> (concat []) [] -> (concatD [])
[x] -> (concat [prt 0 x]) [x] -> (concatD [prt 0 x])
x:xs -> (concat [prt 0 x , [","] , prt 0 xs]) x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
instance Print ComplMod where instance Print ComplMod where
prt i e = case e of prt i e = case e of
CMCompl -> prPrec i 0 (concat []) CMCompl -> prPrec i 0 (concatD [])
CMIncompl -> prPrec i 0 (concat [["incomplete"]]) CMIncompl -> prPrec i 0 (concatD [doc (showString "incomplete")])
instance Print QualOpen where instance Print QualOpen where
prt i e = case e of prt i e = case e of
QOCompl -> prPrec i 0 (concat []) QOCompl -> prPrec i 0 (concatD [])
QOIncompl -> prPrec i 0 (concat [["incomplete"]]) QOIncompl -> prPrec i 0 (concatD [doc (showString "incomplete")])
QOInterface -> prPrec i 0 (concat [["interface"]]) QOInterface -> prPrec i 0 (concatD [doc (showString "interface")])
instance Print Included where instance Print Included where
prt i e = case e of prt i e = case e of
IAll id -> prPrec i 0 (concat [prt 0 id]) IAll id -> prPrec i 0 (concatD [prt 0 id])
ISome id ids -> prPrec i 0 (concat [prt 0 id , ["["] , prt 0 ids , ["]"]]) ISome id ids -> prPrec i 0 (concatD [prt 0 id , doc (showString "[") , prt 0 ids , doc (showString "]")])
prtList es = case es of prtList es = case es of
[] -> (concat []) [] -> (concatD [])
[x] -> (concat [prt 0 x]) [x] -> (concatD [prt 0 x])
x:xs -> (concat [prt 0 x , [","] , prt 0 xs]) x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
instance Print Def where instance Print Def where
prt i e = case e of prt i e = case e of
DDecl ids exp -> prPrec i 0 (concat [prt 0 ids , [":"] , prt 0 exp]) DDecl ids exp -> prPrec i 0 (concatD [prt 0 ids , doc (showString ":") , prt 0 exp])
DDef ids exp -> prPrec i 0 (concat [prt 0 ids , ["="] , prt 0 exp]) DDef ids exp -> prPrec i 0 (concatD [prt 0 ids , doc (showString "=") , prt 0 exp])
DPatt id patts exp -> prPrec i 0 (concat [prt 0 id , prt 0 patts , ["="] , prt 0 exp]) DPatt id patts exp -> prPrec i 0 (concatD [prt 0 id , prt 0 patts , doc (showString "=") , prt 0 exp])
DFull ids exp0 exp -> prPrec i 0 (concat [prt 0 ids , [":"] , prt 0 exp0 , ["="] , prt 0 exp]) DFull ids exp0 exp -> prPrec i 0 (concatD [prt 0 ids , doc (showString ":") , prt 0 exp0 , doc (showString "=") , prt 0 exp])
prtList es = case es of prtList es = case es of
[x] -> (concat [prt 0 x , [";"]]) [x] -> (concatD [prt 0 x , doc (showString ";")])
x:xs -> (concat [prt 0 x , [";"] , prt 0 xs]) x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
instance Print TopDef where instance Print TopDef where
prt i e = case e of prt i e = case e of
DefCat catdefs -> prPrec i 0 (concat [["cat"] , prt 0 catdefs]) DefCat catdefs -> prPrec i 0 (concatD [doc (showString "cat") , prt 0 catdefs])
DefFun fundefs -> prPrec i 0 (concat [["fun"] , prt 0 fundefs]) DefFun fundefs -> prPrec i 0 (concatD [doc (showString "fun") , prt 0 fundefs])
DefDef defs -> prPrec i 0 (concat [["def"] , prt 0 defs]) DefDef defs -> prPrec i 0 (concatD [doc (showString "def") , prt 0 defs])
DefData datadefs -> prPrec i 0 (concat [["data"] , prt 0 datadefs]) DefData datadefs -> prPrec i 0 (concatD [doc (showString "data") , prt 0 datadefs])
DefTrans defs -> prPrec i 0 (concat [["transfer"] , prt 0 defs]) DefTrans defs -> prPrec i 0 (concatD [doc (showString "transfer") , prt 0 defs])
DefPar pardefs -> prPrec i 0 (concat [["param"] , prt 0 pardefs]) DefPar pardefs -> prPrec i 0 (concatD [doc (showString "param") , prt 0 pardefs])
DefOper defs -> prPrec i 0 (concat [["oper"] , prt 0 defs]) DefOper defs -> prPrec i 0 (concatD [doc (showString "oper") , prt 0 defs])
DefLincat printdefs -> prPrec i 0 (concat [["lincat"] , prt 0 printdefs]) DefLincat printdefs -> prPrec i 0 (concatD [doc (showString "lincat") , prt 0 printdefs])
DefLindef defs -> prPrec i 0 (concat [["lindef"] , prt 0 defs]) DefLindef defs -> prPrec i 0 (concatD [doc (showString "lindef") , prt 0 defs])
DefLin defs -> prPrec i 0 (concat [["lin"] , prt 0 defs]) DefLin defs -> prPrec i 0 (concatD [doc (showString "lin") , prt 0 defs])
DefPrintCat printdefs -> prPrec i 0 (concat [["printname"] , ["cat"] , prt 0 printdefs]) DefPrintCat printdefs -> prPrec i 0 (concatD [doc (showString "printname") , doc (showString "cat") , prt 0 printdefs])
DefPrintFun printdefs -> prPrec i 0 (concat [["printname"] , ["fun"] , prt 0 printdefs]) DefPrintFun printdefs -> prPrec i 0 (concatD [doc (showString "printname") , doc (showString "fun") , prt 0 printdefs])
DefFlag flagdefs -> prPrec i 0 (concat [["flags"] , prt 0 flagdefs]) DefFlag flagdefs -> prPrec i 0 (concatD [doc (showString "flags") , prt 0 flagdefs])
DefPrintOld printdefs -> prPrec i 0 (concat [["printname"] , prt 0 printdefs]) DefPrintOld printdefs -> prPrec i 0 (concatD [doc (showString "printname") , prt 0 printdefs])
DefLintype defs -> prPrec i 0 (concat [["lintype"] , prt 0 defs]) DefLintype defs -> prPrec i 0 (concatD [doc (showString "lintype") , prt 0 defs])
DefPattern defs -> prPrec i 0 (concat [["pattern"] , prt 0 defs]) DefPattern defs -> prPrec i 0 (concatD [doc (showString "pattern") , prt 0 defs])
DefPackage id topdefs -> prPrec i 0 (concat [["package"] , prt 0 id , ["="] , ["{"] , prt 0 topdefs , ["}"] , [";"]]) DefPackage id topdefs -> prPrec i 0 (concatD [doc (showString "package") , prt 0 id , doc (showString "=") , doc (showString "{") , prt 0 topdefs , doc (showString "}") , doc (showString ";")])
DefVars defs -> prPrec i 0 (concat [["var"] , prt 0 defs]) DefVars defs -> prPrec i 0 (concatD [doc (showString "var") , prt 0 defs])
DefTokenizer id -> prPrec i 0 (concat [["tokenizer"] , prt 0 id , [";"]]) DefTokenizer id -> prPrec i 0 (concatD [doc (showString "tokenizer") , prt 0 id , doc (showString ";")])
prtList es = case es of prtList es = case es of
[] -> (concat []) [] -> (concatD [])
x:xs -> (concat [prt 0 x , prt 0 xs]) x:xs -> (concatD [prt 0 x , prt 0 xs])
instance Print CatDef where instance Print CatDef where
prt i e = case e of prt i e = case e of
CatDef id ddecls -> prPrec i 0 (concat [prt 0 id , prt 0 ddecls]) CatDef id ddecls -> prPrec i 0 (concatD [prt 0 id , prt 0 ddecls])
prtList es = case es of prtList es = case es of
[x] -> (concat [prt 0 x , [";"]]) [x] -> (concatD [prt 0 x , doc (showString ";")])
x:xs -> (concat [prt 0 x , [";"] , prt 0 xs]) x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
instance Print FunDef where instance Print FunDef where
prt i e = case e of prt i e = case e of
FunDef ids exp -> prPrec i 0 (concat [prt 0 ids , [":"] , prt 0 exp]) FunDef ids exp -> prPrec i 0 (concatD [prt 0 ids , doc (showString ":") , prt 0 exp])
prtList es = case es of prtList es = case es of
[x] -> (concat [prt 0 x , [";"]]) [x] -> (concatD [prt 0 x , doc (showString ";")])
x:xs -> (concat [prt 0 x , [";"] , prt 0 xs]) x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
instance Print DataDef where instance Print DataDef where
prt i e = case e of prt i e = case e of
DataDef id dataconstrs -> prPrec i 0 (concat [prt 0 id , ["="] , prt 0 dataconstrs]) DataDef id dataconstrs -> prPrec i 0 (concatD [prt 0 id , doc (showString "=") , prt 0 dataconstrs])
prtList es = case es of prtList es = case es of
[x] -> (concat [prt 0 x , [";"]]) [x] -> (concatD [prt 0 x , doc (showString ";")])
x:xs -> (concat [prt 0 x , [";"] , prt 0 xs]) x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
instance Print DataConstr where instance Print DataConstr where
prt i e = case e of prt i e = case e of
DataId id -> prPrec i 0 (concat [prt 0 id]) DataId id -> prPrec i 0 (concatD [prt 0 id])
DataQId id0 id -> prPrec i 0 (concat [prt 0 id0 , ["."] , prt 0 id]) DataQId id0 id -> prPrec i 0 (concatD [prt 0 id0 , doc (showString ".") , prt 0 id])
prtList es = case es of prtList es = case es of
[] -> (concat []) [] -> (concatD [])
[x] -> (concat [prt 0 x]) [x] -> (concatD [prt 0 x])
x:xs -> (concat [prt 0 x , ["|"] , prt 0 xs]) x:xs -> (concatD [prt 0 x , doc (showString "|") , prt 0 xs])
instance Print ParDef where instance Print ParDef where
prt i e = case e of prt i e = case e of
ParDef id parconstrs -> prPrec i 0 (concat [prt 0 id , ["="] , prt 0 parconstrs]) ParDef id parconstrs -> prPrec i 0 (concatD [prt 0 id , doc (showString "=") , prt 0 parconstrs])
ParDefIndir id0 id -> prPrec i 0 (concat [prt 0 id0 , ["="] , ["("] , ["in"] , prt 0 id , [")"]]) ParDefIndir id0 id -> prPrec i 0 (concatD [prt 0 id0 , doc (showString "=") , doc (showString "(") , doc (showString "in") , prt 0 id , doc (showString ")")])
ParDefAbs id -> prPrec i 0 (concat [prt 0 id]) ParDefAbs id -> prPrec i 0 (concatD [prt 0 id])
prtList es = case es of prtList es = case es of
[x] -> (concat [prt 0 x , [";"]]) [x] -> (concatD [prt 0 x , doc (showString ";")])
x:xs -> (concat [prt 0 x , [";"] , prt 0 xs]) x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
instance Print ParConstr where instance Print ParConstr where
prt i e = case e of prt i e = case e of
ParConstr id ddecls -> prPrec i 0 (concat [prt 0 id , prt 0 ddecls]) ParConstr id ddecls -> prPrec i 0 (concatD [prt 0 id , prt 0 ddecls])
prtList es = case es of prtList es = case es of
[] -> (concat []) [] -> (concatD [])
[x] -> (concat [prt 0 x]) [x] -> (concatD [prt 0 x])
x:xs -> (concat [prt 0 x , ["|"] , prt 0 xs]) x:xs -> (concatD [prt 0 x , doc (showString "|") , prt 0 xs])
instance Print PrintDef where instance Print PrintDef where
prt i e = case e of prt i e = case e of
PrintDef ids exp -> prPrec i 0 (concat [prt 0 ids , ["="] , prt 0 exp]) PrintDef ids exp -> prPrec i 0 (concatD [prt 0 ids , doc (showString "=") , prt 0 exp])
prtList es = case es of prtList es = case es of
[x] -> (concat [prt 0 x , [";"]]) [x] -> (concatD [prt 0 x , doc (showString ";")])
x:xs -> (concat [prt 0 x , [";"] , prt 0 xs]) x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
instance Print FlagDef where instance Print FlagDef where
prt i e = case e of prt i e = case e of
FlagDef id0 id -> prPrec i 0 (concat [prt 0 id0 , ["="] , prt 0 id]) FlagDef id0 id -> prPrec i 0 (concatD [prt 0 id0 , doc (showString "=") , prt 0 id])
prtList es = case es of prtList es = case es of
[x] -> (concat [prt 0 x , [";"]]) [x] -> (concatD [prt 0 x , doc (showString ";")])
x:xs -> (concat [prt 0 x , [";"] , prt 0 xs]) x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
instance Print LocDef where instance Print LocDef where
prt i e = case e of prt i e = case e of
LDDecl ids exp -> prPrec i 0 (concat [prt 0 ids , [":"] , prt 0 exp]) LDDecl ids exp -> prPrec i 0 (concatD [prt 0 ids , doc (showString ":") , prt 0 exp])
LDDef ids exp -> prPrec i 0 (concat [prt 0 ids , ["="] , prt 0 exp]) LDDef ids exp -> prPrec i 0 (concatD [prt 0 ids , doc (showString "=") , prt 0 exp])
LDFull ids exp0 exp -> prPrec i 0 (concat [prt 0 ids , [":"] , prt 0 exp0 , ["="] , prt 0 exp]) LDFull ids exp0 exp -> prPrec i 0 (concatD [prt 0 ids , doc (showString ":") , prt 0 exp0 , doc (showString "=") , prt 0 exp])
prtList es = case es of prtList es = case es of
[] -> (concat []) [] -> (concatD [])
[x] -> (concat [prt 0 x]) [x] -> (concatD [prt 0 x])
x:xs -> (concat [prt 0 x , [";"] , prt 0 xs]) x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
instance Print Exp where instance Print Exp where
prt i e = case e of prt i e = case e of
EIdent id -> prPrec i 4 (concat [prt 0 id]) EIdent id -> prPrec i 4 (concatD [prt 0 id])
EConstr id -> prPrec i 4 (concat [["{0"] , prt 0 id , ["}0"]]) --H EConstr id -> prPrec i 4 (concatD [doc (showString "{0") , prt 0 id , doc (showString "}0")]) -- H
ECons id -> prPrec i 4 (concat [["["] , prt 0 id , ["]"]]) ECons id -> prPrec i 4 (concatD [doc (showString "[") , prt 0 id , doc (showString "]")])
ESort sort -> prPrec i 4 (concat [prt 0 sort]) ESort sort -> prPrec i 4 (concatD [prt 0 sort])
EString str -> prPrec i 4 (concat [prt 0 str]) EString str -> prPrec i 4 (concatD [prt 0 str])
EInt n -> prPrec i 4 (concat [prt 0 n]) EInt n -> prPrec i 4 (concatD [prt 0 n])
EMeta -> prPrec i 4 (concat [["?"]]) EMeta -> prPrec i 4 (concatD [doc (showString "?")])
EEmpty -> prPrec i 4 (concat [["["] , ["]"]]) EEmpty -> prPrec i 4 (concatD [doc (showString "[") , doc (showString "]")])
EStrings str -> prPrec i 4 (concat [["["] , prt 0 str , ["]"]]) EStrings str -> prPrec i 4 (concatD [doc (showString "[") , prt 0 str , doc (showString "]")])
ERecord locdefs -> prPrec i 4 (concat [["{"] , prt 0 locdefs , ["}"]]) ERecord locdefs -> prPrec i 4 (concatD [doc (showString "{") , prt 0 locdefs , doc (showString "}")])
ETuple tuplecomps -> prPrec i 4 (concat [["<"] , prt 0 tuplecomps , [">"]]) ETuple tuplecomps -> prPrec i 4 (concatD [doc (showString "<") , prt 0 tuplecomps , doc (showString ">")])
EIndir id -> prPrec i 4 (concat [["("] , ["in"] , prt 0 id , [")"]]) EIndir id -> prPrec i 4 (concatD [doc (showString "(") , doc (showString "in") , prt 0 id , doc (showString ")")])
ETyped exp0 exp -> prPrec i 4 (concat [["<"] , prt 0 exp0 , [":"] , prt 0 exp , [">"]]) ETyped exp0 exp -> prPrec i 4 (concatD [doc (showString "<") , prt 0 exp0 , doc (showString ":") , prt 0 exp , doc (showString ">")])
EProj exp label -> prPrec i 3 (concat [prt 3 exp , ["."] , prt 0 label]) EProj exp label -> prPrec i 3 (concatD [prt 3 exp , doc (showString ".") , prt 0 label])
EQConstr id0 id -> prPrec i 3 (concat [["{0"] , prt 0 id0 , ["."] , prt 0 id , ["}0"]]) --H EQConstr id0 id -> prPrec i 3 (concatD [doc (showString "{0") , prt 0 id0 , doc (showString ".") , prt 0 id , doc (showString "}0")])
EQCons id0 id -> prPrec i 3 (concat [["["] , prt 0 id0 , ["."] , prt 0 id , ["]"]]) EQCons id0 id -> prPrec i 3 (concatD [doc (showString "[") , prt 0 id0 , doc (showString ".") , prt 0 id , doc (showString "]")])
EApp exp0 exp -> prPrec i 2 (concat [prt 2 exp0 , prt 3 exp]) EApp exp0 exp -> prPrec i 2 (concatD [prt 2 exp0 , prt 3 exp])
ETable cases -> prPrec i 2 (concat [["table"] , ["{"] , prt 0 cases , ["}"]]) ETable cases -> prPrec i 2 (concatD [doc (showString "table") , doc (showString "{") , prt 0 cases , doc (showString "}")])
ETTable exp cases -> prPrec i 2 (concat [["table"] , prt 4 exp , ["{"] , prt 0 cases , ["}"]]) ETTable exp cases -> prPrec i 2 (concatD [doc (showString "table") , prt 4 exp , doc (showString "{") , prt 0 cases , doc (showString "}")])
ECase exp cases -> prPrec i 2 (concat [["case"] , prt 0 exp , ["of"] , ["{"] , prt 0 cases , ["}"]]) ECase exp cases -> prPrec i 2 (concatD [doc (showString "case") , prt 0 exp , doc (showString "of") , doc (showString "{") , prt 0 cases , doc (showString "}")])
EVariants exps -> prPrec i 2 (concat [["variants"] , ["{"] , prt 0 exps , ["}"]]) EVariants exps -> prPrec i 2 (concatD [doc (showString "variants") , doc (showString "{") , prt 0 exps , doc (showString "}")])
EPre exp alterns -> prPrec i 2 (concat [["pre"] , ["{"] , prt 0 exp , [";"] , prt 0 alterns , ["}"]]) EPre exp alterns -> prPrec i 2 (concatD [doc (showString "pre") , doc (showString "{") , prt 0 exp , doc (showString ";") , prt 0 alterns , doc (showString "}")])
EStrs exps -> prPrec i 2 (concat [["strs"] , ["{"] , prt 0 exps , ["}"]]) EStrs exps -> prPrec i 2 (concatD [doc (showString "strs") , doc (showString "{") , prt 0 exps , doc (showString "}")])
EConAt id exp -> prPrec i 2 (concat [prt 0 id , ["@"] , prt 4 exp]) EConAt id exp -> prPrec i 2 (concatD [prt 0 id , doc (showString "@") , prt 4 exp])
ESelect exp0 exp -> prPrec i 1 (concat [prt 1 exp0 , ["!"] , prt 2 exp]) ESelect exp0 exp -> prPrec i 1 (concatD [prt 1 exp0 , doc (showString "!") , prt 2 exp])
ETupTyp exp0 exp -> prPrec i 1 (concat [prt 1 exp0 , ["*"] , prt 2 exp]) ETupTyp exp0 exp -> prPrec i 1 (concatD [prt 1 exp0 , doc (showString "*") , prt 2 exp])
EExtend exp0 exp -> prPrec i 1 (concat [prt 1 exp0 , ["**"] , prt 2 exp]) EExtend exp0 exp -> prPrec i 1 (concatD [prt 1 exp0 , doc (showString "**") , prt 2 exp])
EAbstr binds exp -> prPrec i 0 (concat [["\\"] , prt 0 binds , ["->"] , prt 0 exp]) EAbstr binds exp -> prPrec i 0 (concatD [doc (showString "\\") , prt 0 binds , doc (showString "->") , prt 0 exp])
ECTable binds exp -> prPrec i 0 (concat [["\\"] , ["\\"] , prt 0 binds , ["=>"] , prt 0 exp]) ECTable binds exp -> prPrec i 0 (concatD [doc (showString "\\") , doc (showString "\\") , prt 0 binds , doc (showString "=>") , prt 0 exp])
EProd decl exp -> prPrec i 0 (concat [prt 0 decl , ["->"] , prt 0 exp]) EProd decl exp -> prPrec i 0 (concatD [prt 0 decl , doc (showString "->") , prt 0 exp])
ETType exp0 exp -> prPrec i 0 (concat [prt 1 exp0 , ["=>"] , prt 0 exp]) ETType exp0 exp -> prPrec i 0 (concatD [prt 1 exp0 , doc (showString "=>") , prt 0 exp])
EConcat exp0 exp -> prPrec i 0 (concat [prt 1 exp0 , ["++"] , prt 0 exp]) EConcat exp0 exp -> prPrec i 0 (concatD [prt 1 exp0 , doc (showString "++") , prt 0 exp])
EGlue exp0 exp -> prPrec i 0 (concat [prt 1 exp0 , ["+"] , prt 0 exp]) EGlue exp0 exp -> prPrec i 0 (concatD [prt 1 exp0 , doc (showString "+") , prt 0 exp])
ELet locdefs exp -> prPrec i 0 (concat [["let"] , ["{"] , prt 0 locdefs , ["}"] , ["in"] , prt 0 exp]) ELet locdefs exp -> prPrec i 0 (concatD [doc (showString "let") , doc (showString "{") , prt 0 locdefs , doc (showString "}") , doc (showString "in") , prt 0 exp])
ELetb locdefs exp -> prPrec i 0 (concat [["let"] , prt 0 locdefs , ["in"] , prt 0 exp]) ELetb locdefs exp -> prPrec i 0 (concatD [doc (showString "let") , prt 0 locdefs , doc (showString "in") , prt 0 exp])
EWhere exp locdefs -> prPrec i 0 (concat [prt 1 exp , ["where"] , ["{"] , prt 0 locdefs , ["}"]]) EWhere exp locdefs -> prPrec i 0 (concatD [prt 1 exp , doc (showString "where") , doc (showString "{") , prt 0 locdefs , doc (showString "}")])
EEqs equations -> prPrec i 0 (concat [["fn"] , ["{"] , prt 0 equations , ["}"]]) EEqs equations -> prPrec i 0 (concatD [doc (showString "fn") , doc (showString "{") , prt 0 equations , doc (showString "}")])
ELString lstring -> prPrec i 4 (concat [prt 0 lstring]) ELString lstring -> prPrec i 4 (concatD [prt 0 lstring])
ELin id -> prPrec i 2 (concat [["Lin"] , prt 0 id]) ELin id -> prPrec i 2 (concatD [doc (showString "Lin") , prt 0 id])
prtList es = case es of prtList es = case es of
[] -> (concat []) [] -> (concatD [])
[x] -> (concat [prt 0 x]) [x] -> (concatD [prt 0 x])
x:xs -> (concat [prt 0 x , [";"] , prt 0 xs]) x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
instance Print Patt where instance Print Patt where
prt i e = case e of prt i e = case e of
PW -> prPrec i 1 (concat [["_"]]) PW -> prPrec i 1 (concatD [doc (showString "_")])
PV id -> prPrec i 1 (concat [prt 0 id]) PV id -> prPrec i 1 (concatD [prt 0 id])
PCon id -> prPrec i 1 (concat [["{0"] , prt 0 id , ["}0"]]) --H PCon id -> prPrec i 1 (concatD [doc (showString "{0") , prt 0 id , doc (showString "}0")]) -- H
PQ id0 id -> prPrec i 1 (concat [prt 0 id0 , ["."] , prt 0 id]) PQ id0 id -> prPrec i 1 (concatD [prt 0 id0 , doc (showString ".") , prt 0 id])
PInt n -> prPrec i 1 (concat [prt 0 n]) PInt n -> prPrec i 1 (concatD [prt 0 n])
PStr str -> prPrec i 1 (concat [prt 0 str]) PStr str -> prPrec i 1 (concatD [prt 0 str])
PR pattasss -> prPrec i 1 (concat [["{"] , prt 0 pattasss , ["}"]]) PR pattasss -> prPrec i 1 (concatD [doc (showString "{") , prt 0 pattasss , doc (showString "}")])
PTup patttuplecomps -> prPrec i 1 (concat [["<"] , prt 0 patttuplecomps , [">"]]) PTup patttuplecomps -> prPrec i 1 (concatD [doc (showString "<") , prt 0 patttuplecomps , doc (showString ">")])
PC id patts -> prPrec i 0 (concat [prt 0 id , prt 0 patts]) PC id patts -> prPrec i 0 (concatD [prt 0 id , prt 0 patts])
PQC id0 id patts -> prPrec i 0 (concat [prt 0 id0 , ["."] , prt 0 id , prt 0 patts]) PQC id0 id patts -> prPrec i 0 (concatD [prt 0 id0 , doc (showString ".") , prt 0 id , prt 0 patts])
prtList es = case es of prtList es = case es of
[x] -> (concat [prt 1 x]) [x] -> (concatD [prt 1 x])
x:xs -> (concat [prt 1 x , prt 0 xs]) x:xs -> (concatD [prt 1 x , prt 0 xs])
instance Print PattAss where instance Print PattAss where
prt i e = case e of prt i e = case e of
PA ids patt -> prPrec i 0 (concat [prt 0 ids , ["="] , prt 0 patt]) PA ids patt -> prPrec i 0 (concatD [prt 0 ids , doc (showString "=") , prt 0 patt])
prtList es = case es of prtList es = case es of
[] -> (concat []) [] -> (concatD [])
[x] -> (concat [prt 0 x]) [x] -> (concatD [prt 0 x])
x:xs -> (concat [prt 0 x , [";"] , prt 0 xs]) x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
instance Print Label where instance Print Label where
prt i e = case e of prt i e = case e of
LIdent id -> prPrec i 0 (concat [prt 0 id]) LIdent id -> prPrec i 0 (concatD [prt 0 id])
LVar n -> prPrec i 0 (concat [["$"] , prt 0 n]) LVar n -> prPrec i 0 (concatD [doc (showString "$") , prt 0 n])
instance Print Sort where instance Print Sort where
prt i e = case e of prt i e = case e of
Sort_Type -> prPrec i 0 (concat [["Type"]]) Sort_Type -> prPrec i 0 (concatD [doc (showString "Type")])
Sort_PType -> prPrec i 0 (concat [["PType"]]) Sort_PType -> prPrec i 0 (concatD [doc (showString "PType")])
Sort_Tok -> prPrec i 0 (concat [["Tok"]]) Sort_Tok -> prPrec i 0 (concatD [doc (showString "Tok")])
Sort_Str -> prPrec i 0 (concat [["Str"]]) Sort_Str -> prPrec i 0 (concatD [doc (showString "Str")])
Sort_Strs -> prPrec i 0 (concat [["Strs"]]) Sort_Strs -> prPrec i 0 (concatD [doc (showString "Strs")])
instance Print PattAlt where instance Print PattAlt where
prt i e = case e of prt i e = case e of
AltP patt -> prPrec i 0 (concat [prt 0 patt]) AltP patt -> prPrec i 0 (concatD [prt 0 patt])
prtList es = case es of prtList es = case es of
[x] -> (concat [prt 0 x]) [x] -> (concatD [prt 0 x])
x:xs -> (concat [prt 0 x , ["|"] , prt 0 xs]) x:xs -> (concatD [prt 0 x , doc (showString "|") , prt 0 xs])
instance Print Bind where instance Print Bind where
prt i e = case e of prt i e = case e of
BIdent id -> prPrec i 0 (concat [prt 0 id]) BIdent id -> prPrec i 0 (concatD [prt 0 id])
BWild -> prPrec i 0 (concat [["_"]]) BWild -> prPrec i 0 (concatD [doc (showString "_")])
prtList es = case es of prtList es = case es of
[] -> (concat []) [] -> (concatD [])
[x] -> (concat [prt 0 x]) [x] -> (concatD [prt 0 x])
x:xs -> (concat [prt 0 x , [","] , prt 0 xs]) x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
instance Print Decl where instance Print Decl where
prt i e = case e of prt i e = case e of
DDec binds exp -> prPrec i 0 (concat [["("] , prt 0 binds , [":"] , prt 0 exp , [")"]]) DDec binds exp -> prPrec i 0 (concatD [doc (showString "(") , prt 0 binds , doc (showString ":") , prt 0 exp , doc (showString ")")])
DExp exp -> prPrec i 0 (concat [prt 2 exp]) DExp exp -> prPrec i 0 (concatD [prt 2 exp])
instance Print TupleComp where instance Print TupleComp where
prt i e = case e of prt i e = case e of
TComp exp -> prPrec i 0 (concat [prt 0 exp]) TComp exp -> prPrec i 0 (concatD [prt 0 exp])
prtList es = case es of prtList es = case es of
[] -> (concat []) [] -> (concatD [])
[x] -> (concat [prt 0 x]) [x] -> (concatD [prt 0 x])
x:xs -> (concat [prt 0 x , [","] , prt 0 xs]) x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
instance Print PattTupleComp where instance Print PattTupleComp where
prt i e = case e of prt i e = case e of
PTComp patt -> prPrec i 0 (concat [prt 0 patt]) PTComp patt -> prPrec i 0 (concatD [prt 0 patt])
prtList es = case es of prtList es = case es of
[] -> (concat []) [] -> (concatD [])
[x] -> (concat [prt 0 x]) [x] -> (concatD [prt 0 x])
x:xs -> (concat [prt 0 x , [","] , prt 0 xs]) x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
instance Print Case where instance Print Case where
prt i e = case e of prt i e = case e of
Case pattalts exp -> prPrec i 0 (concat [prt 0 pattalts , ["=>"] , prt 0 exp]) Case pattalts exp -> prPrec i 0 (concatD [prt 0 pattalts , doc (showString "=>") , prt 0 exp])
prtList es = case es of prtList es = case es of
[x] -> (concat [prt 0 x]) [x] -> (concatD [prt 0 x])
x:xs -> (concat [prt 0 x , [";"] , prt 0 xs]) x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
instance Print Equation where instance Print Equation where
prt i e = case e of prt i e = case e of
Equ patts exp -> prPrec i 0 (concat [prt 0 patts , ["->"] , prt 0 exp]) Equ patts exp -> prPrec i 0 (concatD [prt 0 patts , doc (showString "->") , prt 0 exp])
prtList es = case es of prtList es = case es of
[] -> (concat []) [] -> (concatD [])
[x] -> (concat [prt 0 x]) [x] -> (concatD [prt 0 x])
x:xs -> (concat [prt 0 x , [";"] , prt 0 xs]) x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
instance Print Altern where instance Print Altern where
prt i e = case e of prt i e = case e of
Alt exp0 exp -> prPrec i 0 (concat [prt 0 exp0 , ["/"] , prt 0 exp]) Alt exp0 exp -> prPrec i 0 (concatD [prt 0 exp0 , doc (showString "/") , prt 0 exp])
prtList es = case es of prtList es = case es of
[] -> (concat []) [] -> (concatD [])
[x] -> (concat [prt 0 x]) [x] -> (concatD [prt 0 x])
x:xs -> (concat [prt 0 x , [";"] , prt 0 xs]) x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
instance Print DDecl where instance Print DDecl where
prt i e = case e of prt i e = case e of
DDDec binds exp -> prPrec i 0 (concat [["("] , prt 0 binds , [":"] , prt 0 exp , [")"]]) DDDec binds exp -> prPrec i 0 (concatD [doc (showString "(") , prt 0 binds , doc (showString ":") , prt 0 exp , doc (showString ")")])
DDExp exp -> prPrec i 0 (concat [prt 4 exp]) DDExp exp -> prPrec i 0 (concatD [prt 4 exp])
prtList es = case es of prtList es = case es of
[] -> (concat []) [] -> (concatD [])
x:xs -> (concat [prt 0 x , prt 0 xs]) x:xs -> (concatD [prt 0 x , prt 0 xs])
instance Print OldGrammar where instance Print OldGrammar where
prt i e = case e of prt i e = case e of
OldGr include topdefs -> prPrec i 0 (concat [prt 0 include , prt 0 topdefs]) OldGr include topdefs -> prPrec i 0 (concatD [prt 0 include , prt 0 topdefs])
instance Print Include where instance Print Include where
prt i e = case e of prt i e = case e of
NoIncl -> prPrec i 0 (concat []) NoIncl -> prPrec i 0 (concatD [])
Incl filenames -> prPrec i 0 (concat [["include"] , prt 0 filenames]) Incl filenames -> prPrec i 0 (concatD [doc (showString "include") , prt 0 filenames])
instance Print FileName where instance Print FileName where
prt i e = case e of prt i e = case e of
FString str -> prPrec i 0 (concat [prt 0 str]) FString str -> prPrec i 0 (concatD [prt 0 str])
FIdent id -> prPrec i 0 (concat [prt 0 id]) FIdent id -> prPrec i 0 (concatD [prt 0 id])
FSlash filename -> prPrec i 0 (concat [["/"] , prt 0 filename]) FSlash filename -> prPrec i 0 (concatD [doc (showString "/") , prt 0 filename])
FDot filename -> prPrec i 0 (concat [["."] , prt 0 filename]) FDot filename -> prPrec i 0 (concatD [doc (showString ".") , prt 0 filename])
FMinus filename -> prPrec i 0 (concat [["-"] , prt 0 filename]) FMinus filename -> prPrec i 0 (concatD [doc (showString "-") , prt 0 filename])
FAddId id filename -> prPrec i 0 (concat [prt 0 id , prt 0 filename]) FAddId id filename -> prPrec i 0 (concatD [prt 0 id , prt 0 filename])
prtList es = case es of prtList es = case es of
[x] -> (concat [prt 0 x , [";"]]) [x] -> (concatD [prt 0 x , doc (showString ";")])
x:xs -> (concat [prt 0 x , [";"] , prt 0 xs]) x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])