mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-09 04:59:31 -06:00
Recreated GF and GFC pretty printers using the new BNFC version which makes more efficient pretty printers.
This commit is contained in:
bringert
@@ -10,312 +10,328 @@ import Char
|
||||
printTree :: Print a => a -> String
|
||||
printTree = render . prt 0
|
||||
|
||||
-- you may want to change render and parenth
|
||||
type Doc = [ShowS] -> [ShowS]
|
||||
|
||||
render :: [String] -> String
|
||||
render = rend 0 where
|
||||
doc :: ShowS -> Doc
|
||||
doc = (:)
|
||||
|
||||
render :: Doc -> String
|
||||
render d = rend 0 (map ($ "") $ d []) "" where
|
||||
rend i ss = case ss of
|
||||
"NEW" :ts -> realnew $ rend i ts --H
|
||||
"<" :ts -> cons "<" $ rend i ts --H
|
||||
"$" :ts -> cons "$" $ rend i ts --H
|
||||
"?" :ts -> cons "?" $ rend i ts --H
|
||||
"[" :ts -> cons "[" $ rend i ts
|
||||
"(" :ts -> cons "(" $ rend i ts
|
||||
"{" :ts -> cons "{" $ new (i+1) $ rend (i+1) ts
|
||||
"}" : ";":ts -> new (i-1) $ space "}" $ cons ";" $ new (i-1) $ rend (i-1) ts
|
||||
"}" :ts -> new (i-1) $ cons "}" $ new (i-1) $ rend (i-1) ts
|
||||
";" :ts -> cons ";" $ new i $ rend i ts
|
||||
t : "," :ts -> cons t $ space "," $ rend i ts
|
||||
t : ")" :ts -> cons t $ cons ")" $ rend i ts
|
||||
t : "]" :ts -> cons t $ cons "]" $ rend i ts
|
||||
t : ">" :ts -> cons t $ cons ">" $ rend i ts --H
|
||||
t : "." :ts -> cons t $ cons "." $ rend i ts --H
|
||||
t :ts -> realspace t $ rend i ts --H
|
||||
_ -> ""
|
||||
cons s t = s ++ t
|
||||
space t s = t ++ " " ++ s --H
|
||||
realspace t s = if null s then t else t ++ " " ++ s --H
|
||||
new i s = s --H '\n' : replicate (2*i) ' ' ++ dropWhile isSpace s
|
||||
realnew s = '\n':s --H
|
||||
"NEW" :ts -> realnew . rend i ts --H
|
||||
"<" :ts -> showString "<" . rend i ts --H
|
||||
"$" :ts -> showString "$" . rend i ts --H
|
||||
"?" :ts -> showString "?" . rend i ts --H
|
||||
"[" :ts -> showChar '[' . rend i ts
|
||||
"(" :ts -> showChar '(' . rend i ts
|
||||
"{" :ts -> showChar '{' . new (i+1) . rend (i+1) ts
|
||||
"}" : ";":ts -> new (i-1) . space "}" . showChar ';' . new (i-1) . rend (i-1) ts
|
||||
"}" :ts -> new (i-1) . showChar '}' . new (i-1) . rend (i-1) ts
|
||||
";" :ts -> showChar ';' . new i . rend i ts
|
||||
t : "," :ts -> showString t . space "," . rend i ts
|
||||
t : ")" :ts -> showString t . showChar ')' . rend i ts
|
||||
t : "]" :ts -> showString t . showChar ']' . rend i ts
|
||||
t : ">" :ts -> showString t . showString ">" . rend i ts --H
|
||||
t : "." :ts -> showString t . showString "." . rend i ts --H
|
||||
t :ts -> realspace t . rend i ts --H
|
||||
_ -> id
|
||||
space t = showString t . showChar ' ' -- H
|
||||
realspace t = showString t . (\s -> if null s then "" else (' ':s)) -- H
|
||||
new i s = s -- H
|
||||
realnew = showChar '\n' --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
|
||||
class Print a where
|
||||
prt :: Int -> a -> [String]
|
||||
prtList :: [a] -> [String]
|
||||
prtList = concat . map (prt 0)
|
||||
prt :: Int -> a -> Doc
|
||||
prtList :: [a] -> Doc
|
||||
prtList = concatD . map (prt 0)
|
||||
|
||||
instance Print a => Print [a] where
|
||||
prt _ = prtList
|
||||
|
||||
instance Print Integer where
|
||||
prt _ = (:[]) . show
|
||||
prt _ x = doc (shows x)
|
||||
|
||||
instance Print Double where
|
||||
prt _ = (:[]) . show
|
||||
prt _ x = doc (shows x)
|
||||
|
||||
instance Print Char where
|
||||
prt _ s = ["'" ++ mkEsc s ++ "'"]
|
||||
prtList s = ["\"" ++ concatMap mkEsc s ++ "\""]
|
||||
prt _ s = doc (showChar '\'' . mkEsc s . showChar '\'')
|
||||
prtList s = doc (showChar '"' . concatS (map mkEsc s) . showChar '"')
|
||||
|
||||
mkEsc :: Char -> ShowS
|
||||
mkEsc s = case s of
|
||||
_ | elem s "\\\"'" -> '\\':[s]
|
||||
'\n' -> "\\n"
|
||||
'\t' -> "\\t"
|
||||
_ -> [s]
|
||||
_ | elem s "\\\"'" -> showChar '\\' . showChar s
|
||||
'\n' -> showString "\\n"
|
||||
'\t' -> showString "\\t"
|
||||
_ -> showChar s
|
||||
|
||||
prPrec :: Int -> Int -> [String] -> [String]
|
||||
prPrec :: Int -> Int -> Doc -> Doc
|
||||
prPrec i j = if j<i then parenth else id
|
||||
|
||||
|
||||
instance Print Ident where
|
||||
prt _ i = [prIdent i]
|
||||
prt _ i = doc (showString $ prIdent i)
|
||||
prtList es = case es of
|
||||
[] -> (concat [])
|
||||
[x] -> (concat [prt 0 x])
|
||||
x:xs -> (concat [prt 0 x , [","] , prt 0 xs])
|
||||
[] -> (concatD [])
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
|
||||
|
||||
|
||||
|
||||
instance Print Canon where
|
||||
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
|
||||
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
|
||||
[] -> (concat [])
|
||||
x:xs -> (concat [prt 0 x , prt 0 xs])
|
||||
[] -> (concatD [])
|
||||
x:xs -> (concatD [prt 0 x , prt 0 xs])
|
||||
|
||||
instance Print ModType where
|
||||
prt i e = case e of
|
||||
MTAbs id -> prPrec i 0 (concat [["abstract"] , prt 0 id])
|
||||
MTCnc id0 id -> prPrec i 0 (concat [["concrete"] , prt 0 id0 , ["of"] , prt 0 id])
|
||||
MTRes id -> prPrec i 0 (concat [["resource"] , prt 0 id])
|
||||
MTTrans id open0 open -> prPrec i 0 (concat [["transfer"] , prt 0 id , [":"] , prt 0 open0 , ["->"] , prt 0 open])
|
||||
MTAbs id -> prPrec i 0 (concatD [doc (showString "abstract") , 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 (concatD [doc (showString "resource") , prt 0 id])
|
||||
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
|
||||
prt i e = case e of
|
||||
Ext id -> prPrec i 0 (concat [prt 0 id , ["**"]])
|
||||
NoExt -> prPrec i 0 (concat [])
|
||||
Ext id -> prPrec i 0 (concatD [prt 0 id , doc (showString "**")])
|
||||
NoExt -> prPrec i 0 (concatD [])
|
||||
|
||||
|
||||
instance Print Open where
|
||||
prt i e = case e of
|
||||
NoOpens -> prPrec i 0 (concat [])
|
||||
Opens ids -> prPrec i 0 (concat [["open"] , prt 0 ids , ["in"]])
|
||||
Opens ids -> prPrec i 0 (concatD [doc (showString "open") , prt 0 ids , doc (showString "in")])
|
||||
NoOpens -> prPrec i 0 (concatD [])
|
||||
|
||||
|
||||
instance Print Flag where
|
||||
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
|
||||
[] -> (concat [])
|
||||
x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
|
||||
[] -> (concatD [])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
|
||||
|
||||
instance Print Def where
|
||||
prt i e = case e of
|
||||
AbsDCat id decls cidents -> prPrec i 0 (concat [["cat"] , prt 0 id , ["["] , prt 0 decls , ["]"] , ["="] , prt 0 cidents])
|
||||
AbsDFun id exp0 exp -> prPrec i 0 (concat [["fun"] , prt 0 id , [":"] , prt 0 exp0 , ["="] , prt 0 exp])
|
||||
AbsDTrans id exp -> prPrec i 0 (concat [["transfer"] , prt 0 id , ["="] , prt 0 exp])
|
||||
ResDPar id pardefs -> prPrec i 0 (concat [["param"] , prt 0 id , ["="] , prt 0 pardefs])
|
||||
ResDOper id ctype term -> prPrec i 0 (concat [["oper"] , prt 0 id , [":"] , prt 0 ctype , ["="] , 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])
|
||||
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])
|
||||
AnyDInd id0 status id -> prPrec i 0 (concat [prt 0 id0 , prt 0 status , ["in"] , prt 0 id])
|
||||
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 (concatD [doc (showString "fun") , prt 0 id , doc (showString ":") , prt 0 exp0 , doc (showString "=") , 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 (concatD [doc (showString "param") , prt 0 id , doc (showString "=") , prt 0 pardefs])
|
||||
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 (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 (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 (concatD [prt 0 id0 , prt 0 status , doc (showString "in") , prt 0 id])
|
||||
|
||||
prtList es = case es of
|
||||
[] -> (concat [])
|
||||
x:xs -> (concat [prt 0 x , [";","NEW"] , prt 0 xs]) --H
|
||||
[] -> (concatD [])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ";"), doc (showString "NEW") , prt 0 xs]) -- H
|
||||
|
||||
instance Print ParDef where
|
||||
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
|
||||
[] -> (concat [])
|
||||
[x] -> (concat [prt 0 x])
|
||||
x:xs -> (concat [prt 0 x , ["|"] , prt 0 xs])
|
||||
[] -> (concatD [])
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString "|") , prt 0 xs])
|
||||
|
||||
instance Print Status where
|
||||
prt i e = case e of
|
||||
Canon -> prPrec i 0 (concat [["data"]])
|
||||
NonCan -> prPrec i 0 (concat [])
|
||||
Canon -> prPrec i 0 (concatD [doc (showString "data")])
|
||||
NonCan -> prPrec i 0 (concatD [])
|
||||
|
||||
|
||||
instance Print CIdent where
|
||||
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
|
||||
[] -> (concat [])
|
||||
x:xs -> (concat [prt 0 x , prt 0 xs])
|
||||
[] -> (concatD [])
|
||||
x:xs -> (concatD [prt 0 x , prt 0 xs])
|
||||
|
||||
instance Print Exp where
|
||||
prt i e = case e of
|
||||
EApp exp0 exp -> prPrec i 1 (concat [prt 1 exp0 , prt 2 exp])
|
||||
EProd id exp0 exp -> prPrec i 0 (concat [["("] , prt 0 id , [":"] , prt 0 exp0 , [")"] , ["->"] , prt 0 exp])
|
||||
EAtom atom -> prPrec i 2 (concat [prt 0 atom])
|
||||
EAbs id exp -> prPrec i 0 (concat [["\\"] , prt 0 id , ["->"] , prt 0 exp])
|
||||
EEq equations -> prPrec i 0 (concat [["{"] , prt 0 equations , ["}"]])
|
||||
EData -> prPrec i 2 (concat [["data"]])
|
||||
EApp exp0 exp -> prPrec i 1 (concatD [prt 1 exp0 , prt 2 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])
|
||||
EAbs id exp -> prPrec i 0 (concatD [doc (showString "\\") , prt 0 id , doc (showString "->") , prt 0 exp])
|
||||
EAtom atom -> prPrec i 2 (concatD [prt 0 atom])
|
||||
EData -> prPrec i 2 (concatD [doc (showString "data")])
|
||||
EEq equations -> prPrec i 0 (concatD [doc (showString "{") , prt 0 equations , doc (showString "}")])
|
||||
|
||||
|
||||
instance Print Sort where
|
||||
prt i e = case e of
|
||||
SType -> prPrec i 0 (concat [["Type"]])
|
||||
SType -> prPrec i 0 (concatD [doc (showString "Type")])
|
||||
|
||||
|
||||
instance Print Equation where
|
||||
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
|
||||
[] -> (concat [])
|
||||
x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
|
||||
[] -> (concatD [])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
|
||||
|
||||
instance Print APatt where
|
||||
prt i e = case e of
|
||||
APC cident apatts -> prPrec i 0 (concat [["("] , prt 0 cident , prt 0 apatts , [")"]])
|
||||
APV id -> prPrec i 0 (concat [prt 0 id])
|
||||
APS str -> prPrec i 0 (concat [prt 0 str])
|
||||
API n -> prPrec i 0 (concat [prt 0 n])
|
||||
APW -> prPrec i 0 (concat [["_"]])
|
||||
APC cident apatts -> prPrec i 0 (concatD [doc (showString "(") , prt 0 cident , prt 0 apatts , doc (showString ")")])
|
||||
APV id -> prPrec i 0 (concatD [prt 0 id])
|
||||
APS str -> prPrec i 0 (concatD [prt 0 str])
|
||||
API n -> prPrec i 0 (concatD [prt 0 n])
|
||||
APW -> prPrec i 0 (concatD [doc (showString "_")])
|
||||
|
||||
prtList es = case es of
|
||||
[] -> (concat [])
|
||||
x:xs -> (concat [prt 0 x , prt 0 xs])
|
||||
[] -> (concatD [])
|
||||
x:xs -> (concatD [prt 0 x , prt 0 xs])
|
||||
|
||||
instance Print Atom where
|
||||
prt i e = case e of
|
||||
AC cident -> prPrec i 0 (concat [prt 0 cident])
|
||||
AD cident -> prPrec i 0 (concat [["<"] , prt 0 cident , [">"]])
|
||||
AV id -> prPrec i 0 (concat [["$"] , prt 0 id])
|
||||
AM n -> prPrec i 0 (concat [["?"] , prt 0 n])
|
||||
AS str -> prPrec i 0 (concat [prt 0 str])
|
||||
AI n -> prPrec i 0 (concat [prt 0 n])
|
||||
AT sort -> prPrec i 0 (concat [prt 0 sort])
|
||||
AC cident -> prPrec i 0 (concatD [prt 0 cident])
|
||||
AD cident -> prPrec i 0 (concatD [doc (showString "<") , prt 0 cident , doc (showString ">")])
|
||||
AV id -> prPrec i 0 (concatD [doc (showString "$") , prt 0 id])
|
||||
AM n -> prPrec i 0 (concatD [doc (showString "?") , prt 0 n])
|
||||
AS str -> prPrec i 0 (concatD [prt 0 str])
|
||||
AI n -> prPrec i 0 (concatD [prt 0 n])
|
||||
AT sort -> prPrec i 0 (concatD [prt 0 sort])
|
||||
|
||||
|
||||
instance Print Decl where
|
||||
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
|
||||
[] -> (concat [])
|
||||
[x] -> (concat [prt 0 x])
|
||||
x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
|
||||
[] -> (concatD [])
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
|
||||
|
||||
instance Print CType where
|
||||
prt i e = case e of
|
||||
RecType labellings -> prPrec i 0 (concat [["{"] , prt 0 labellings , ["}"]])
|
||||
Table ctype0 ctype -> prPrec i 0 (concat [["("] , prt 0 ctype0 , ["=>"] , prt 0 ctype , [")"]])
|
||||
Cn cident -> prPrec i 0 (concat [prt 0 cident])
|
||||
TStr -> prPrec i 0 (concat [["Str"]])
|
||||
RecType labellings -> prPrec i 0 (concatD [doc (showString "{") , prt 0 labellings , doc (showString "}")])
|
||||
Table ctype0 ctype -> prPrec i 0 (concatD [doc (showString "(") , prt 0 ctype0 , doc (showString "=>") , prt 0 ctype , doc (showString ")")])
|
||||
Cn cident -> prPrec i 0 (concatD [prt 0 cident])
|
||||
TStr -> prPrec i 0 (concatD [doc (showString "Str")])
|
||||
|
||||
prtList es = case es of
|
||||
[] -> (concat [])
|
||||
x:xs -> (concat [prt 0 x , prt 0 xs])
|
||||
[] -> (concatD [])
|
||||
x:xs -> (concatD [prt 0 x , prt 0 xs])
|
||||
|
||||
instance Print Labelling where
|
||||
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
|
||||
[] -> (concat [])
|
||||
[x] -> (concat [prt 0 x])
|
||||
x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
|
||||
[] -> (concatD [])
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
|
||||
|
||||
instance Print Term where
|
||||
prt i e = case e of
|
||||
Arg argvar -> prPrec i 2 (concat [prt 0 argvar])
|
||||
I cident -> prPrec i 2 (concat [prt 0 cident])
|
||||
Con cident terms -> prPrec i 2 (concat [["<"] , prt 0 cident , prt 2 terms , [">"]])
|
||||
LI id -> prPrec i 2 (concat [["$"] , prt 0 id])
|
||||
R assigns -> prPrec i 2 (concat [["{"] , prt 0 assigns , ["}"]])
|
||||
P term label -> prPrec i 1 (concat [prt 2 term , ["."] , prt 0 label])
|
||||
T ctype cases -> prPrec i 1 (concat [["table"] , prt 0 ctype , ["{"] , prt 0 cases , ["}"]])
|
||||
S term0 term -> prPrec i 1 (concat [prt 1 term0 , ["!"] , prt 2 term])
|
||||
C term0 term -> prPrec i 0 (concat [prt 0 term0 , ["++"] , prt 1 term])
|
||||
FV terms -> prPrec i 1 (concat [["variants"] , ["{"] , prt 2 terms , ["}"]])
|
||||
K tokn -> prPrec i 2 (concat [prt 0 tokn])
|
||||
E -> prPrec i 2 (concat [["["] , ["]"]])
|
||||
Arg argvar -> prPrec i 2 (concatD [prt 0 argvar])
|
||||
I cident -> prPrec i 2 (concatD [prt 0 cident])
|
||||
Con cident terms -> prPrec i 2 (concatD [doc (showString "<") , prt 0 cident , prt 2 terms , doc (showString ">")])
|
||||
LI id -> prPrec i 2 (concatD [doc (showString "$") , prt 0 id])
|
||||
R assigns -> prPrec i 2 (concatD [doc (showString "{") , prt 0 assigns , doc (showString "}")])
|
||||
P term label -> prPrec i 1 (concatD [prt 2 term , doc (showString ".") , prt 0 label])
|
||||
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 (concatD [prt 1 term0 , doc (showString "!") , prt 2 term])
|
||||
C term0 term -> prPrec i 0 (concatD [prt 0 term0 , doc (showString "++") , prt 1 term])
|
||||
FV terms -> prPrec i 1 (concatD [doc (showString "variants") , doc (showString "{") , prt 2 terms , doc (showString "}")])
|
||||
K tokn -> prPrec i 2 (concatD [prt 0 tokn])
|
||||
E -> prPrec i 2 (concatD [doc (showString "[") , doc (showString "]")])
|
||||
|
||||
prtList es = case es of
|
||||
[] -> (concat [])
|
||||
x:xs -> (concat [prt 2 x , prt 2 xs])
|
||||
[] -> (concatD [])
|
||||
x:xs -> (concatD [prt 2 x , prt 2 xs])
|
||||
|
||||
instance Print Tokn where
|
||||
prt i e = case e of
|
||||
KS str -> prPrec i 0 (concat [prt 0 str])
|
||||
KP strs variants -> prPrec i 0 (concat [["["] , ["pre"] , prt 0 strs , ["{"] , prt 0 variants , ["}"] , ["]"]])
|
||||
KS str -> prPrec i 0 (concatD [prt 0 str])
|
||||
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
|
||||
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
|
||||
[] -> (concat [])
|
||||
[x] -> (concat [prt 0 x])
|
||||
x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
|
||||
[] -> (concatD [])
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
|
||||
|
||||
instance Print Case where
|
||||
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
|
||||
[] -> (concat [])
|
||||
[x] -> (concat [prt 0 x])
|
||||
x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
|
||||
[] -> (concatD [])
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
|
||||
|
||||
instance Print Variant where
|
||||
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
|
||||
[] -> (concat [])
|
||||
[x] -> (concat [prt 0 x])
|
||||
x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
|
||||
[] -> (concatD [])
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
|
||||
|
||||
instance Print Label where
|
||||
prt i e = case e of
|
||||
L id -> prPrec i 0 (concat [prt 0 id])
|
||||
LV n -> prPrec i 0 (concat [["$"] , prt 0 n])
|
||||
L id -> prPrec i 0 (concatD [prt 0 id])
|
||||
LV n -> prPrec i 0 (concatD [doc (showString "$") , prt 0 n])
|
||||
|
||||
|
||||
instance Print ArgVar where
|
||||
prt i e = case e of
|
||||
A id n -> prPrec i 0 (concat [prt 0 id , ["@"] , prt 0 n])
|
||||
AB id n0 n -> prPrec i 0 (concat [prt 0 id , ["+"] , prt 0 n0 , ["@"] , 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 (concatD [prt 0 id , doc (showString "+") , prt 0 n0 , doc (showString "@") , prt 0 n])
|
||||
|
||||
prtList es = case es of
|
||||
[] -> (concat [])
|
||||
[x] -> (concat [prt 0 x])
|
||||
x:xs -> (concat [prt 0 x , [","] , prt 0 xs])
|
||||
[] -> (concatD [])
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
|
||||
|
||||
instance Print Patt where
|
||||
prt i e = case e of
|
||||
PC cident patts -> prPrec i 0 (concat [["("] , prt 0 cident , prt 0 patts , [")"]])
|
||||
PV id -> prPrec i 0 (concat [prt 0 id])
|
||||
PW -> prPrec i 0 (concat [["_"]])
|
||||
PR pattassigns -> prPrec i 0 (concat [["{"] , prt 0 pattassigns , ["}"]])
|
||||
PC cident patts -> prPrec i 0 (concatD [doc (showString "(") , prt 0 cident , prt 0 patts , doc (showString ")")])
|
||||
PV id -> prPrec i 0 (concatD [prt 0 id])
|
||||
PW -> prPrec i 0 (concatD [doc (showString "_")])
|
||||
PR pattassigns -> prPrec i 0 (concatD [doc (showString "{") , prt 0 pattassigns , doc (showString "}")])
|
||||
|
||||
prtList es = case es of
|
||||
[] -> (concat [])
|
||||
x:xs -> (concat [prt 0 x , prt 0 xs])
|
||||
[] -> (concatD [])
|
||||
x:xs -> (concatD [prt 0 x , prt 0 xs])
|
||||
|
||||
instance Print PattAssign where
|
||||
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
|
||||
[] -> (concat [])
|
||||
[x] -> (concat [prt 0 x])
|
||||
x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
|
||||
[] -> (concatD [])
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
|
||||
|
||||
|
||||
|
||||
@@ -2,489 +2,501 @@ module PrintGF where
|
||||
|
||||
-- pretty-printer generated by the BNF converter, except --H
|
||||
|
||||
import AbsGF
|
||||
import Ident --H
|
||||
import AbsGF
|
||||
import Char
|
||||
|
||||
-- the top-level printing method
|
||||
|
||||
printTree :: Print a => a -> String
|
||||
printTree = render . prt 0
|
||||
|
||||
-- you may want to change render and parenth
|
||||
type Doc = [ShowS] -> [ShowS]
|
||||
|
||||
render :: [String] -> String
|
||||
render = rend 0 where
|
||||
doc :: ShowS -> Doc
|
||||
doc = (:)
|
||||
|
||||
render :: Doc -> String
|
||||
render d = rend 0 (map ($ "") $ d []) "" where
|
||||
rend i ss = case ss of
|
||||
|
||||
--H these four are hand-written
|
||||
"{0" :ts -> cons "{" $ rend (i+1) ts
|
||||
t :"}0" :ts -> cons t $ space "}" $ rend (i-1) ts
|
||||
t : "." :ts -> cons t $ cons "." $ rend i ts
|
||||
"\\" :ts -> cons "\\" $ rend i ts
|
||||
"{0" :ts -> showChar '{' . rend (i+1) ts
|
||||
t :"}0" :ts -> showString t . space "}" . rend (i-1) ts
|
||||
t : "." :ts -> showString t . showString "." . rend i ts
|
||||
"\\" :ts -> showString "\\" . rend i ts
|
||||
|
||||
"[" :ts -> cons "[" $ rend i ts
|
||||
"(" :ts -> cons "(" $ rend i ts
|
||||
"{" :ts -> cons "{" $ new (i+1) $ rend (i+1) ts
|
||||
"}" : ";":ts -> new (i-1) $ space "}" $ cons ";" $ new (i-1) $ rend (i-1) ts
|
||||
"}" :ts -> new (i-1) $ cons "}" $ new (i-1) $ rend (i-1) ts
|
||||
";" :ts -> cons ";" $ new i $ rend i ts
|
||||
t : "," :ts -> cons t $ space "," $ rend i ts
|
||||
t : ")" :ts -> cons t $ cons ")" $ rend i ts
|
||||
t : "]" :ts -> cons t $ cons "]" $ rend i ts
|
||||
t :ts -> space t $ rend i ts
|
||||
_ -> ""
|
||||
cons s t = s ++ t
|
||||
new i s = '\n' : replicate (2*i) ' ' ++ dropWhile isSpace s
|
||||
space t s = if null s then t else t ++ " " ++ s
|
||||
"[" :ts -> showChar '[' . rend i ts
|
||||
"(" :ts -> showChar '(' . rend i ts
|
||||
"{" :ts -> showChar '{' . new (i+1) . rend (i+1) ts
|
||||
"}" : ";":ts -> new (i-1) . space "}" . showChar ';' . new (i-1) . rend (i-1) ts
|
||||
"}" :ts -> new (i-1) . showChar '}' . new (i-1) . rend (i-1) ts
|
||||
";" :ts -> showChar ';' . new i . rend i ts
|
||||
t : "," :ts -> showString t . space "," . rend i ts
|
||||
t : ")" :ts -> showString t . showChar ')' . rend i ts
|
||||
t : "]" :ts -> showString t . showChar ']' . rend i ts
|
||||
t :ts -> space t . rend i ts
|
||||
_ -> id
|
||||
new i = showChar '\n' . replicateS (2*i) (showChar ' ') . dropWhile isSpace
|
||||
space t = showString t . (\s -> if null s then "" else (' ':s))
|
||||
|
||||
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
|
||||
class Print a where
|
||||
prt :: Int -> a -> [String]
|
||||
prtList :: [a] -> [String]
|
||||
prtList = concat . map (prt 0)
|
||||
prt :: Int -> a -> Doc
|
||||
prtList :: [a] -> Doc
|
||||
prtList = concatD . map (prt 0)
|
||||
|
||||
instance Print a => Print [a] where
|
||||
prt _ = prtList
|
||||
|
||||
instance Print Integer where
|
||||
prt _ = (:[]) . show
|
||||
prt _ x = doc (shows x)
|
||||
|
||||
instance Print Double where
|
||||
prt _ = (:[]) . show
|
||||
prt _ x = doc (shows x)
|
||||
|
||||
instance Print Char where
|
||||
prt _ s = ["'" ++ mkEsc s ++ "'"]
|
||||
prtList s = ["\"" ++ concatMap mkEsc s ++ "\""]
|
||||
prt _ s = doc (showChar '\'' . mkEsc s . showChar '\'')
|
||||
prtList s = doc (showChar '"' . concatS (map mkEsc s) . showChar '"')
|
||||
|
||||
mkEsc :: Char -> ShowS
|
||||
mkEsc s = case s of
|
||||
_ | elem s "\\\"" -> '\\':[s]
|
||||
'\n' -> "\\n"
|
||||
'\t' -> "\\t"
|
||||
_ -> [s]
|
||||
_ | elem s "\\\"'" -> showChar '\\' . showChar s
|
||||
'\n' -> showString "\\n"
|
||||
'\t' -> showString "\\t"
|
||||
_ -> showChar s
|
||||
|
||||
prPrec :: Int -> Int -> [String] -> [String]
|
||||
prPrec :: Int -> Int -> Doc -> Doc
|
||||
prPrec i j = if j<i then parenth else id
|
||||
|
||||
|
||||
instance Print Ident where
|
||||
prt _ i = [prIdent i] --H
|
||||
prt _ i = doc (showString $ prIdent i)
|
||||
prtList es = case es of
|
||||
[x] -> (concat [prt 0 x])
|
||||
x:xs -> (concat [prt 0 x , [","] , prt 0 xs])
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
|
||||
|
||||
|
||||
instance Print LString where
|
||||
prt _ (LString i) = [i]
|
||||
prt _ (LString i) = doc (showString i)
|
||||
|
||||
|
||||
|
||||
instance Print Grammar where
|
||||
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
|
||||
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 , ["}"]])
|
||||
MModule complmod modtype modbody -> prPrec i 0 (concat [prt 0 complmod , prt 0 modtype , ["="] , prt 0 modbody])
|
||||
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 (concatD [prt 0 complmod , prt 0 modtype , doc (showString "=") , prt 0 modbody])
|
||||
|
||||
prtList es = case es of
|
||||
[] -> (concat [])
|
||||
x:xs -> (concat [prt 0 x , prt 0 xs])
|
||||
[] -> (concatD [])
|
||||
x:xs -> (concatD [prt 0 x , prt 0 xs])
|
||||
|
||||
instance Print ConcSpec where
|
||||
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
|
||||
[] -> (concat [])
|
||||
[x] -> (concat [prt 0 x])
|
||||
x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
|
||||
[] -> (concatD [])
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
|
||||
|
||||
instance Print ConcExp where
|
||||
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
|
||||
prt i e = case e of
|
||||
TransferIn open -> prPrec i 0 (concat [["("] , ["transfer"] , ["in"] , prt 0 open , [")"]])
|
||||
TransferOut open -> prPrec i 0 (concat [["("] , ["transfer"] , ["out"] , 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 (concatD [doc (showString "(") , doc (showString "transfer") , doc (showString "out") , prt 0 open , doc (showString ")")])
|
||||
|
||||
prtList es = case es of
|
||||
[] -> (concat [])
|
||||
x:xs -> (concat [prt 0 x , prt 0 xs])
|
||||
[] -> (concatD [])
|
||||
x:xs -> (concatD [prt 0 x , prt 0 xs])
|
||||
|
||||
instance Print ModType where
|
||||
prt i e = case e of
|
||||
MTAbstract id -> prPrec i 0 (concat [["abstract"] , prt 0 id])
|
||||
MTResource id -> prPrec i 0 (concat [["resource"] , prt 0 id])
|
||||
MTInterface id -> prPrec i 0 (concat [["interface"] , prt 0 id])
|
||||
MTConcrete id0 id -> prPrec i 0 (concat [["concrete"] , prt 0 id0 , ["of"] , prt 0 id])
|
||||
MTInstance id0 id -> prPrec i 0 (concat [["instance"] , prt 0 id0 , ["of"] , prt 0 id])
|
||||
MTTransfer id open0 open -> prPrec i 0 (concat [["transfer"] , prt 0 id , [":"] , prt 0 open0 , ["->"] , prt 0 open])
|
||||
MTAbstract id -> prPrec i 0 (concatD [doc (showString "abstract") , prt 0 id])
|
||||
MTResource id -> prPrec i 0 (concatD [doc (showString "resource") , prt 0 id])
|
||||
MTInterface id -> prPrec i 0 (concatD [doc (showString "interface") , 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 (concatD [doc (showString "instance") , prt 0 id0 , doc (showString "of") , prt 0 id])
|
||||
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
|
||||
prt i e = case e of
|
||||
MBody extend opens topdefs -> prPrec i 0 (concat [prt 0 extend , prt 0 opens , ["{"] , prt 0 topdefs , ["}"]])
|
||||
MWith id opens -> prPrec i 0 (concat [prt 0 id , ["with"] , prt 0 opens])
|
||||
MReuse id -> prPrec i 0 (concat [["reuse"] , prt 0 id])
|
||||
MUnion includeds -> prPrec i 0 (concat [["union"] , prt 0 includeds])
|
||||
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 (concatD [prt 0 id , doc (showString "with") , prt 0 opens])
|
||||
MReuse id -> prPrec i 0 (concatD [doc (showString "reuse") , prt 0 id])
|
||||
MUnion includeds -> prPrec i 0 (concatD [doc (showString "union") , prt 0 includeds])
|
||||
|
||||
|
||||
instance Print Extend where
|
||||
prt i e = case e of
|
||||
Ext id -> prPrec i 0 (concat [prt 0 id , ["**"]])
|
||||
NoExt -> prPrec i 0 (concat [])
|
||||
Ext id -> prPrec i 0 (concatD [prt 0 id , doc (showString "**")])
|
||||
NoExt -> prPrec i 0 (concatD [])
|
||||
|
||||
|
||||
instance Print Opens where
|
||||
prt i e = case e of
|
||||
NoOpens -> prPrec i 0 (concat [])
|
||||
Opens opens -> prPrec i 0 (concat [["open"] , prt 0 opens , ["in"]])
|
||||
NoOpens -> prPrec i 0 (concatD [])
|
||||
Opens opens -> prPrec i 0 (concatD [doc (showString "open") , prt 0 opens , doc (showString "in")])
|
||||
|
||||
|
||||
instance Print Open where
|
||||
prt i e = case e of
|
||||
OName id -> prPrec i 0 (concat [prt 0 id])
|
||||
OQualQO qualopen id -> prPrec i 0 (concat [["("] , prt 0 qualopen , prt 0 id , [")"]])
|
||||
OQual qualopen id0 id -> prPrec i 0 (concat [["("] , prt 0 qualopen , prt 0 id0 , ["="] , prt 0 id , [")"]])
|
||||
OName id -> prPrec i 0 (concatD [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 (concatD [doc (showString "(") , prt 0 qualopen , prt 0 id0 , doc (showString "=") , prt 0 id , doc (showString ")")])
|
||||
|
||||
prtList es = case es of
|
||||
[] -> (concat [])
|
||||
[x] -> (concat [prt 0 x])
|
||||
x:xs -> (concat [prt 0 x , [","] , prt 0 xs])
|
||||
[] -> (concatD [])
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
|
||||
|
||||
instance Print ComplMod where
|
||||
prt i e = case e of
|
||||
CMCompl -> prPrec i 0 (concat [])
|
||||
CMIncompl -> prPrec i 0 (concat [["incomplete"]])
|
||||
CMCompl -> prPrec i 0 (concatD [])
|
||||
CMIncompl -> prPrec i 0 (concatD [doc (showString "incomplete")])
|
||||
|
||||
|
||||
instance Print QualOpen where
|
||||
prt i e = case e of
|
||||
QOCompl -> prPrec i 0 (concat [])
|
||||
QOIncompl -> prPrec i 0 (concat [["incomplete"]])
|
||||
QOInterface -> prPrec i 0 (concat [["interface"]])
|
||||
QOCompl -> prPrec i 0 (concatD [])
|
||||
QOIncompl -> prPrec i 0 (concatD [doc (showString "incomplete")])
|
||||
QOInterface -> prPrec i 0 (concatD [doc (showString "interface")])
|
||||
|
||||
|
||||
instance Print Included where
|
||||
prt i e = case e of
|
||||
IAll id -> prPrec i 0 (concat [prt 0 id])
|
||||
ISome id ids -> prPrec i 0 (concat [prt 0 id , ["["] , prt 0 ids , ["]"]])
|
||||
IAll id -> prPrec i 0 (concatD [prt 0 id])
|
||||
ISome id ids -> prPrec i 0 (concatD [prt 0 id , doc (showString "[") , prt 0 ids , doc (showString "]")])
|
||||
|
||||
prtList es = case es of
|
||||
[] -> (concat [])
|
||||
[x] -> (concat [prt 0 x])
|
||||
x:xs -> (concat [prt 0 x , [","] , prt 0 xs])
|
||||
[] -> (concatD [])
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
|
||||
|
||||
instance Print Def where
|
||||
prt i e = case e of
|
||||
DDecl ids exp -> prPrec i 0 (concat [prt 0 ids , [":"] , prt 0 exp])
|
||||
DDef ids exp -> prPrec i 0 (concat [prt 0 ids , ["="] , prt 0 exp])
|
||||
DPatt id patts exp -> prPrec i 0 (concat [prt 0 id , prt 0 patts , ["="] , prt 0 exp])
|
||||
DFull ids exp0 exp -> prPrec i 0 (concat [prt 0 ids , [":"] , prt 0 exp0 , ["="] , prt 0 exp])
|
||||
DDecl ids exp -> prPrec i 0 (concatD [prt 0 ids , doc (showString ":") , 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 (concatD [prt 0 id , prt 0 patts , doc (showString "=") , 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
|
||||
[x] -> (concat [prt 0 x , [";"]])
|
||||
x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
|
||||
[x] -> (concatD [prt 0 x , doc (showString ";")])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
|
||||
|
||||
instance Print TopDef where
|
||||
prt i e = case e of
|
||||
DefCat catdefs -> prPrec i 0 (concat [["cat"] , prt 0 catdefs])
|
||||
DefFun fundefs -> prPrec i 0 (concat [["fun"] , prt 0 fundefs])
|
||||
DefDef defs -> prPrec i 0 (concat [["def"] , prt 0 defs])
|
||||
DefData datadefs -> prPrec i 0 (concat [["data"] , prt 0 datadefs])
|
||||
DefTrans defs -> prPrec i 0 (concat [["transfer"] , prt 0 defs])
|
||||
DefPar pardefs -> prPrec i 0 (concat [["param"] , prt 0 pardefs])
|
||||
DefOper defs -> prPrec i 0 (concat [["oper"] , prt 0 defs])
|
||||
DefLincat printdefs -> prPrec i 0 (concat [["lincat"] , prt 0 printdefs])
|
||||
DefLindef defs -> prPrec i 0 (concat [["lindef"] , prt 0 defs])
|
||||
DefLin defs -> prPrec i 0 (concat [["lin"] , prt 0 defs])
|
||||
DefPrintCat printdefs -> prPrec i 0 (concat [["printname"] , ["cat"] , prt 0 printdefs])
|
||||
DefPrintFun printdefs -> prPrec i 0 (concat [["printname"] , ["fun"] , prt 0 printdefs])
|
||||
DefFlag flagdefs -> prPrec i 0 (concat [["flags"] , prt 0 flagdefs])
|
||||
DefPrintOld printdefs -> prPrec i 0 (concat [["printname"] , prt 0 printdefs])
|
||||
DefLintype defs -> prPrec i 0 (concat [["lintype"] , prt 0 defs])
|
||||
DefPattern defs -> prPrec i 0 (concat [["pattern"] , prt 0 defs])
|
||||
DefPackage id topdefs -> prPrec i 0 (concat [["package"] , prt 0 id , ["="] , ["{"] , prt 0 topdefs , ["}"] , [";"]])
|
||||
DefVars defs -> prPrec i 0 (concat [["var"] , prt 0 defs])
|
||||
DefTokenizer id -> prPrec i 0 (concat [["tokenizer"] , prt 0 id , [";"]])
|
||||
DefCat catdefs -> prPrec i 0 (concatD [doc (showString "cat") , prt 0 catdefs])
|
||||
DefFun fundefs -> prPrec i 0 (concatD [doc (showString "fun") , prt 0 fundefs])
|
||||
DefDef defs -> prPrec i 0 (concatD [doc (showString "def") , prt 0 defs])
|
||||
DefData datadefs -> prPrec i 0 (concatD [doc (showString "data") , prt 0 datadefs])
|
||||
DefTrans defs -> prPrec i 0 (concatD [doc (showString "transfer") , prt 0 defs])
|
||||
DefPar pardefs -> prPrec i 0 (concatD [doc (showString "param") , prt 0 pardefs])
|
||||
DefOper defs -> prPrec i 0 (concatD [doc (showString "oper") , prt 0 defs])
|
||||
DefLincat printdefs -> prPrec i 0 (concatD [doc (showString "lincat") , prt 0 printdefs])
|
||||
DefLindef defs -> prPrec i 0 (concatD [doc (showString "lindef") , prt 0 defs])
|
||||
DefLin defs -> prPrec i 0 (concatD [doc (showString "lin") , prt 0 defs])
|
||||
DefPrintCat printdefs -> prPrec i 0 (concatD [doc (showString "printname") , doc (showString "cat") , prt 0 printdefs])
|
||||
DefPrintFun printdefs -> prPrec i 0 (concatD [doc (showString "printname") , doc (showString "fun") , prt 0 printdefs])
|
||||
DefFlag flagdefs -> prPrec i 0 (concatD [doc (showString "flags") , prt 0 flagdefs])
|
||||
DefPrintOld printdefs -> prPrec i 0 (concatD [doc (showString "printname") , prt 0 printdefs])
|
||||
DefLintype defs -> prPrec i 0 (concatD [doc (showString "lintype") , prt 0 defs])
|
||||
DefPattern defs -> prPrec i 0 (concatD [doc (showString "pattern") , prt 0 defs])
|
||||
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 (concatD [doc (showString "var") , prt 0 defs])
|
||||
DefTokenizer id -> prPrec i 0 (concatD [doc (showString "tokenizer") , prt 0 id , doc (showString ";")])
|
||||
|
||||
prtList es = case es of
|
||||
[] -> (concat [])
|
||||
x:xs -> (concat [prt 0 x , prt 0 xs])
|
||||
[] -> (concatD [])
|
||||
x:xs -> (concatD [prt 0 x , prt 0 xs])
|
||||
|
||||
instance Print CatDef where
|
||||
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
|
||||
[x] -> (concat [prt 0 x , [";"]])
|
||||
x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
|
||||
[x] -> (concatD [prt 0 x , doc (showString ";")])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
|
||||
|
||||
instance Print FunDef where
|
||||
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
|
||||
[x] -> (concat [prt 0 x , [";"]])
|
||||
x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
|
||||
[x] -> (concatD [prt 0 x , doc (showString ";")])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
|
||||
|
||||
instance Print DataDef where
|
||||
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
|
||||
[x] -> (concat [prt 0 x , [";"]])
|
||||
x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
|
||||
[x] -> (concatD [prt 0 x , doc (showString ";")])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
|
||||
|
||||
instance Print DataConstr where
|
||||
prt i e = case e of
|
||||
DataId id -> prPrec i 0 (concat [prt 0 id])
|
||||
DataQId id0 id -> prPrec i 0 (concat [prt 0 id0 , ["."] , prt 0 id])
|
||||
DataId id -> prPrec i 0 (concatD [prt 0 id])
|
||||
DataQId id0 id -> prPrec i 0 (concatD [prt 0 id0 , doc (showString ".") , prt 0 id])
|
||||
|
||||
prtList es = case es of
|
||||
[] -> (concat [])
|
||||
[x] -> (concat [prt 0 x])
|
||||
x:xs -> (concat [prt 0 x , ["|"] , prt 0 xs])
|
||||
[] -> (concatD [])
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString "|") , prt 0 xs])
|
||||
|
||||
instance Print ParDef where
|
||||
prt i e = case e of
|
||||
ParDef id parconstrs -> prPrec i 0 (concat [prt 0 id , ["="] , prt 0 parconstrs])
|
||||
ParDefIndir id0 id -> prPrec i 0 (concat [prt 0 id0 , ["="] , ["("] , ["in"] , prt 0 id , [")"]])
|
||||
ParDefAbs id -> prPrec i 0 (concat [prt 0 id])
|
||||
ParDef id parconstrs -> prPrec i 0 (concatD [prt 0 id , doc (showString "=") , prt 0 parconstrs])
|
||||
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 (concatD [prt 0 id])
|
||||
|
||||
prtList es = case es of
|
||||
[x] -> (concat [prt 0 x , [";"]])
|
||||
x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
|
||||
[x] -> (concatD [prt 0 x , doc (showString ";")])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
|
||||
|
||||
instance Print ParConstr where
|
||||
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
|
||||
[] -> (concat [])
|
||||
[x] -> (concat [prt 0 x])
|
||||
x:xs -> (concat [prt 0 x , ["|"] , prt 0 xs])
|
||||
[] -> (concatD [])
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString "|") , prt 0 xs])
|
||||
|
||||
instance Print PrintDef where
|
||||
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
|
||||
[x] -> (concat [prt 0 x , [";"]])
|
||||
x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
|
||||
[x] -> (concatD [prt 0 x , doc (showString ";")])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
|
||||
|
||||
instance Print FlagDef where
|
||||
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
|
||||
[x] -> (concat [prt 0 x , [";"]])
|
||||
x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
|
||||
[x] -> (concatD [prt 0 x , doc (showString ";")])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
|
||||
|
||||
instance Print LocDef where
|
||||
prt i e = case e of
|
||||
LDDecl ids exp -> prPrec i 0 (concat [prt 0 ids , [":"] , prt 0 exp])
|
||||
LDDef ids exp -> prPrec i 0 (concat [prt 0 ids , ["="] , prt 0 exp])
|
||||
LDFull ids exp0 exp -> prPrec i 0 (concat [prt 0 ids , [":"] , prt 0 exp0 , ["="] , prt 0 exp])
|
||||
LDDecl ids exp -> prPrec i 0 (concatD [prt 0 ids , doc (showString ":") , 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 (concatD [prt 0 ids , doc (showString ":") , prt 0 exp0 , doc (showString "=") , prt 0 exp])
|
||||
|
||||
prtList es = case es of
|
||||
[] -> (concat [])
|
||||
[x] -> (concat [prt 0 x])
|
||||
x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
|
||||
[] -> (concatD [])
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
|
||||
|
||||
instance Print Exp where
|
||||
prt i e = case e of
|
||||
EIdent id -> prPrec i 4 (concat [prt 0 id])
|
||||
EConstr id -> prPrec i 4 (concat [["{0"] , prt 0 id , ["}0"]]) --H
|
||||
ECons id -> prPrec i 4 (concat [["["] , prt 0 id , ["]"]])
|
||||
ESort sort -> prPrec i 4 (concat [prt 0 sort])
|
||||
EString str -> prPrec i 4 (concat [prt 0 str])
|
||||
EInt n -> prPrec i 4 (concat [prt 0 n])
|
||||
EMeta -> prPrec i 4 (concat [["?"]])
|
||||
EEmpty -> prPrec i 4 (concat [["["] , ["]"]])
|
||||
EStrings str -> prPrec i 4 (concat [["["] , prt 0 str , ["]"]])
|
||||
ERecord locdefs -> prPrec i 4 (concat [["{"] , prt 0 locdefs , ["}"]])
|
||||
ETuple tuplecomps -> prPrec i 4 (concat [["<"] , prt 0 tuplecomps , [">"]])
|
||||
EIndir id -> prPrec i 4 (concat [["("] , ["in"] , prt 0 id , [")"]])
|
||||
ETyped exp0 exp -> prPrec i 4 (concat [["<"] , prt 0 exp0 , [":"] , prt 0 exp , [">"]])
|
||||
EProj exp label -> prPrec i 3 (concat [prt 3 exp , ["."] , prt 0 label])
|
||||
EQConstr id0 id -> prPrec i 3 (concat [["{0"] , prt 0 id0 , ["."] , prt 0 id , ["}0"]]) --H
|
||||
EQCons id0 id -> prPrec i 3 (concat [["["] , prt 0 id0 , ["."] , prt 0 id , ["]"]])
|
||||
EApp exp0 exp -> prPrec i 2 (concat [prt 2 exp0 , prt 3 exp])
|
||||
ETable cases -> prPrec i 2 (concat [["table"] , ["{"] , prt 0 cases , ["}"]])
|
||||
ETTable exp cases -> prPrec i 2 (concat [["table"] , prt 4 exp , ["{"] , prt 0 cases , ["}"]])
|
||||
ECase exp cases -> prPrec i 2 (concat [["case"] , prt 0 exp , ["of"] , ["{"] , prt 0 cases , ["}"]])
|
||||
EVariants exps -> prPrec i 2 (concat [["variants"] , ["{"] , prt 0 exps , ["}"]])
|
||||
EPre exp alterns -> prPrec i 2 (concat [["pre"] , ["{"] , prt 0 exp , [";"] , prt 0 alterns , ["}"]])
|
||||
EStrs exps -> prPrec i 2 (concat [["strs"] , ["{"] , prt 0 exps , ["}"]])
|
||||
EConAt id exp -> prPrec i 2 (concat [prt 0 id , ["@"] , prt 4 exp])
|
||||
ESelect exp0 exp -> prPrec i 1 (concat [prt 1 exp0 , ["!"] , prt 2 exp])
|
||||
ETupTyp exp0 exp -> prPrec i 1 (concat [prt 1 exp0 , ["*"] , prt 2 exp])
|
||||
EExtend exp0 exp -> prPrec i 1 (concat [prt 1 exp0 , ["**"] , prt 2 exp])
|
||||
EAbstr binds exp -> prPrec i 0 (concat [["\\"] , prt 0 binds , ["->"] , prt 0 exp])
|
||||
ECTable binds exp -> prPrec i 0 (concat [["\\"] , ["\\"] , prt 0 binds , ["=>"] , prt 0 exp])
|
||||
EProd decl exp -> prPrec i 0 (concat [prt 0 decl , ["->"] , prt 0 exp])
|
||||
ETType exp0 exp -> prPrec i 0 (concat [prt 1 exp0 , ["=>"] , prt 0 exp])
|
||||
EConcat exp0 exp -> prPrec i 0 (concat [prt 1 exp0 , ["++"] , prt 0 exp])
|
||||
EGlue exp0 exp -> prPrec i 0 (concat [prt 1 exp0 , ["+"] , prt 0 exp])
|
||||
ELet locdefs exp -> prPrec i 0 (concat [["let"] , ["{"] , prt 0 locdefs , ["}"] , ["in"] , prt 0 exp])
|
||||
ELetb locdefs exp -> prPrec i 0 (concat [["let"] , prt 0 locdefs , ["in"] , prt 0 exp])
|
||||
EWhere exp locdefs -> prPrec i 0 (concat [prt 1 exp , ["where"] , ["{"] , prt 0 locdefs , ["}"]])
|
||||
EEqs equations -> prPrec i 0 (concat [["fn"] , ["{"] , prt 0 equations , ["}"]])
|
||||
ELString lstring -> prPrec i 4 (concat [prt 0 lstring])
|
||||
ELin id -> prPrec i 2 (concat [["Lin"] , prt 0 id])
|
||||
EIdent id -> prPrec i 4 (concatD [prt 0 id])
|
||||
EConstr id -> prPrec i 4 (concatD [doc (showString "{0") , prt 0 id , doc (showString "}0")]) -- H
|
||||
ECons id -> prPrec i 4 (concatD [doc (showString "[") , prt 0 id , doc (showString "]")])
|
||||
ESort sort -> prPrec i 4 (concatD [prt 0 sort])
|
||||
EString str -> prPrec i 4 (concatD [prt 0 str])
|
||||
EInt n -> prPrec i 4 (concatD [prt 0 n])
|
||||
EMeta -> prPrec i 4 (concatD [doc (showString "?")])
|
||||
EEmpty -> prPrec i 4 (concatD [doc (showString "[") , doc (showString "]")])
|
||||
EStrings str -> prPrec i 4 (concatD [doc (showString "[") , prt 0 str , doc (showString "]")])
|
||||
ERecord locdefs -> prPrec i 4 (concatD [doc (showString "{") , prt 0 locdefs , doc (showString "}")])
|
||||
ETuple tuplecomps -> prPrec i 4 (concatD [doc (showString "<") , prt 0 tuplecomps , doc (showString ">")])
|
||||
EIndir id -> prPrec i 4 (concatD [doc (showString "(") , doc (showString "in") , prt 0 id , doc (showString ")")])
|
||||
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 (concatD [prt 3 exp , doc (showString ".") , prt 0 label])
|
||||
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 (concatD [doc (showString "[") , prt 0 id0 , doc (showString ".") , prt 0 id , doc (showString "]")])
|
||||
EApp exp0 exp -> prPrec i 2 (concatD [prt 2 exp0 , prt 3 exp])
|
||||
ETable cases -> prPrec i 2 (concatD [doc (showString "table") , doc (showString "{") , prt 0 cases , doc (showString "}")])
|
||||
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 (concatD [doc (showString "case") , prt 0 exp , doc (showString "of") , doc (showString "{") , prt 0 cases , doc (showString "}")])
|
||||
EVariants exps -> prPrec i 2 (concatD [doc (showString "variants") , doc (showString "{") , prt 0 exps , doc (showString "}")])
|
||||
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 (concatD [doc (showString "strs") , doc (showString "{") , prt 0 exps , doc (showString "}")])
|
||||
EConAt id exp -> prPrec i 2 (concatD [prt 0 id , doc (showString "@") , prt 4 exp])
|
||||
ESelect exp0 exp -> prPrec i 1 (concatD [prt 1 exp0 , doc (showString "!") , prt 2 exp])
|
||||
ETupTyp exp0 exp -> prPrec i 1 (concatD [prt 1 exp0 , doc (showString "*") , prt 2 exp])
|
||||
EExtend exp0 exp -> prPrec i 1 (concatD [prt 1 exp0 , doc (showString "**") , prt 2 exp])
|
||||
EAbstr binds exp -> prPrec i 0 (concatD [doc (showString "\\") , prt 0 binds , doc (showString "->") , 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 (concatD [prt 0 decl , doc (showString "->") , prt 0 exp])
|
||||
ETType exp0 exp -> prPrec i 0 (concatD [prt 1 exp0 , doc (showString "=>") , prt 0 exp])
|
||||
EConcat exp0 exp -> prPrec i 0 (concatD [prt 1 exp0 , doc (showString "++") , prt 0 exp])
|
||||
EGlue exp0 exp -> prPrec i 0 (concatD [prt 1 exp0 , doc (showString "+") , 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 (concatD [doc (showString "let") , prt 0 locdefs , doc (showString "in") , prt 0 exp])
|
||||
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 (concatD [doc (showString "fn") , doc (showString "{") , prt 0 equations , doc (showString "}")])
|
||||
ELString lstring -> prPrec i 4 (concatD [prt 0 lstring])
|
||||
ELin id -> prPrec i 2 (concatD [doc (showString "Lin") , prt 0 id])
|
||||
|
||||
prtList es = case es of
|
||||
[] -> (concat [])
|
||||
[x] -> (concat [prt 0 x])
|
||||
x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
|
||||
[] -> (concatD [])
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
|
||||
|
||||
instance Print Patt where
|
||||
prt i e = case e of
|
||||
PW -> prPrec i 1 (concat [["_"]])
|
||||
PV id -> prPrec i 1 (concat [prt 0 id])
|
||||
PCon id -> prPrec i 1 (concat [["{0"] , prt 0 id , ["}0"]]) --H
|
||||
PQ id0 id -> prPrec i 1 (concat [prt 0 id0 , ["."] , prt 0 id])
|
||||
PInt n -> prPrec i 1 (concat [prt 0 n])
|
||||
PStr str -> prPrec i 1 (concat [prt 0 str])
|
||||
PR pattasss -> prPrec i 1 (concat [["{"] , prt 0 pattasss , ["}"]])
|
||||
PTup patttuplecomps -> prPrec i 1 (concat [["<"] , prt 0 patttuplecomps , [">"]])
|
||||
PC id patts -> prPrec i 0 (concat [prt 0 id , prt 0 patts])
|
||||
PQC id0 id patts -> prPrec i 0 (concat [prt 0 id0 , ["."] , prt 0 id , prt 0 patts])
|
||||
PW -> prPrec i 1 (concatD [doc (showString "_")])
|
||||
PV id -> prPrec i 1 (concatD [prt 0 id])
|
||||
PCon id -> prPrec i 1 (concatD [doc (showString "{0") , prt 0 id , doc (showString "}0")]) -- H
|
||||
PQ id0 id -> prPrec i 1 (concatD [prt 0 id0 , doc (showString ".") , prt 0 id])
|
||||
PInt n -> prPrec i 1 (concatD [prt 0 n])
|
||||
PStr str -> prPrec i 1 (concatD [prt 0 str])
|
||||
PR pattasss -> prPrec i 1 (concatD [doc (showString "{") , prt 0 pattasss , doc (showString "}")])
|
||||
PTup patttuplecomps -> prPrec i 1 (concatD [doc (showString "<") , prt 0 patttuplecomps , doc (showString ">")])
|
||||
PC id patts -> prPrec i 0 (concatD [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
|
||||
[x] -> (concat [prt 1 x])
|
||||
x:xs -> (concat [prt 1 x , prt 0 xs])
|
||||
[x] -> (concatD [prt 1 x])
|
||||
x:xs -> (concatD [prt 1 x , prt 0 xs])
|
||||
|
||||
instance Print PattAss where
|
||||
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
|
||||
[] -> (concat [])
|
||||
[x] -> (concat [prt 0 x])
|
||||
x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
|
||||
[] -> (concatD [])
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
|
||||
|
||||
instance Print Label where
|
||||
prt i e = case e of
|
||||
LIdent id -> prPrec i 0 (concat [prt 0 id])
|
||||
LVar n -> prPrec i 0 (concat [["$"] , prt 0 n])
|
||||
LIdent id -> prPrec i 0 (concatD [prt 0 id])
|
||||
LVar n -> prPrec i 0 (concatD [doc (showString "$") , prt 0 n])
|
||||
|
||||
|
||||
instance Print Sort where
|
||||
prt i e = case e of
|
||||
Sort_Type -> prPrec i 0 (concat [["Type"]])
|
||||
Sort_PType -> prPrec i 0 (concat [["PType"]])
|
||||
Sort_Tok -> prPrec i 0 (concat [["Tok"]])
|
||||
Sort_Str -> prPrec i 0 (concat [["Str"]])
|
||||
Sort_Strs -> prPrec i 0 (concat [["Strs"]])
|
||||
Sort_Type -> prPrec i 0 (concatD [doc (showString "Type")])
|
||||
Sort_PType -> prPrec i 0 (concatD [doc (showString "PType")])
|
||||
Sort_Tok -> prPrec i 0 (concatD [doc (showString "Tok")])
|
||||
Sort_Str -> prPrec i 0 (concatD [doc (showString "Str")])
|
||||
Sort_Strs -> prPrec i 0 (concatD [doc (showString "Strs")])
|
||||
|
||||
|
||||
instance Print PattAlt where
|
||||
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
|
||||
[x] -> (concat [prt 0 x])
|
||||
x:xs -> (concat [prt 0 x , ["|"] , prt 0 xs])
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString "|") , prt 0 xs])
|
||||
|
||||
instance Print Bind where
|
||||
prt i e = case e of
|
||||
BIdent id -> prPrec i 0 (concat [prt 0 id])
|
||||
BWild -> prPrec i 0 (concat [["_"]])
|
||||
BIdent id -> prPrec i 0 (concatD [prt 0 id])
|
||||
BWild -> prPrec i 0 (concatD [doc (showString "_")])
|
||||
|
||||
prtList es = case es of
|
||||
[] -> (concat [])
|
||||
[x] -> (concat [prt 0 x])
|
||||
x:xs -> (concat [prt 0 x , [","] , prt 0 xs])
|
||||
[] -> (concatD [])
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
|
||||
|
||||
instance Print Decl where
|
||||
prt i e = case e of
|
||||
DDec binds exp -> prPrec i 0 (concat [["("] , prt 0 binds , [":"] , prt 0 exp , [")"]])
|
||||
DExp exp -> prPrec i 0 (concat [prt 2 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 (concatD [prt 2 exp])
|
||||
|
||||
|
||||
instance Print TupleComp where
|
||||
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
|
||||
[] -> (concat [])
|
||||
[x] -> (concat [prt 0 x])
|
||||
x:xs -> (concat [prt 0 x , [","] , prt 0 xs])
|
||||
[] -> (concatD [])
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
|
||||
|
||||
instance Print PattTupleComp where
|
||||
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
|
||||
[] -> (concat [])
|
||||
[x] -> (concat [prt 0 x])
|
||||
x:xs -> (concat [prt 0 x , [","] , prt 0 xs])
|
||||
[] -> (concatD [])
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
|
||||
|
||||
instance Print Case where
|
||||
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
|
||||
[x] -> (concat [prt 0 x])
|
||||
x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
|
||||
|
||||
instance Print Equation where
|
||||
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
|
||||
[] -> (concat [])
|
||||
[x] -> (concat [prt 0 x])
|
||||
x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
|
||||
[] -> (concatD [])
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
|
||||
|
||||
instance Print Altern where
|
||||
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
|
||||
[] -> (concat [])
|
||||
[x] -> (concat [prt 0 x])
|
||||
x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
|
||||
[] -> (concatD [])
|
||||
[x] -> (concatD [prt 0 x])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
|
||||
|
||||
instance Print DDecl where
|
||||
prt i e = case e of
|
||||
DDDec binds exp -> prPrec i 0 (concat [["("] , prt 0 binds , [":"] , prt 0 exp , [")"]])
|
||||
DDExp exp -> prPrec i 0 (concat [prt 4 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 (concatD [prt 4 exp])
|
||||
|
||||
prtList es = case es of
|
||||
[] -> (concat [])
|
||||
x:xs -> (concat [prt 0 x , prt 0 xs])
|
||||
[] -> (concatD [])
|
||||
x:xs -> (concatD [prt 0 x , prt 0 xs])
|
||||
|
||||
instance Print OldGrammar where
|
||||
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
|
||||
prt i e = case e of
|
||||
NoIncl -> prPrec i 0 (concat [])
|
||||
Incl filenames -> prPrec i 0 (concat [["include"] , prt 0 filenames])
|
||||
NoIncl -> prPrec i 0 (concatD [])
|
||||
Incl filenames -> prPrec i 0 (concatD [doc (showString "include") , prt 0 filenames])
|
||||
|
||||
|
||||
instance Print FileName where
|
||||
prt i e = case e of
|
||||
FString str -> prPrec i 0 (concat [prt 0 str])
|
||||
FIdent id -> prPrec i 0 (concat [prt 0 id])
|
||||
FSlash filename -> prPrec i 0 (concat [["/"] , prt 0 filename])
|
||||
FDot filename -> prPrec i 0 (concat [["."] , prt 0 filename])
|
||||
FMinus filename -> prPrec i 0 (concat [["-"] , prt 0 filename])
|
||||
FAddId id filename -> prPrec i 0 (concat [prt 0 id , prt 0 filename])
|
||||
FString str -> prPrec i 0 (concatD [prt 0 str])
|
||||
FIdent id -> prPrec i 0 (concatD [prt 0 id])
|
||||
FSlash filename -> prPrec i 0 (concatD [doc (showString "/") , prt 0 filename])
|
||||
FDot filename -> prPrec i 0 (concatD [doc (showString ".") , prt 0 filename])
|
||||
FMinus filename -> prPrec i 0 (concatD [doc (showString "-") , prt 0 filename])
|
||||
FAddId id filename -> prPrec i 0 (concatD [prt 0 id , prt 0 filename])
|
||||
|
||||
prtList es = case es of
|
||||
[x] -> (concat [prt 0 x , [";"]])
|
||||
x:xs -> (concat [prt 0 x , [";"] , prt 0 xs])
|
||||
[x] -> (concatD [prt 0 x , doc (showString ";")])
|
||||
x:xs -> (concatD [prt 0 x , doc (showString ";") , prt 0 xs])
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user