From f02c2bbef06e7e4c6240e0cc6bec364a2bbad069 Mon Sep 17 00:00:00 2001
From: bringert <unknown>
Date: Thu, 22 Jul 2004 09:00:27 +0000
Subject: [PATCH] Recreated GF and GFC pretty printers using the new BNFC
 version which makes more efficient pretty printers.

---
 src/GF/Canon/PrintGFC.hs | 336 +++++++++++++------------
 src/GF/Source/PrintGF.hs | 526 ++++++++++++++++++++-------------------
 2 files changed, 445 insertions(+), 417 deletions(-)

diff --git a/src/GF/Canon/PrintGFC.hs b/src/GF/Canon/PrintGFC.hs
index 81bea7b34..77e60c75d 100644
--- a/src/GF/Canon/PrintGFC.hs
+++ b/src/GF/Canon/PrintGFC.hs
@@ -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])
 
 
diff --git a/src/GF/Source/PrintGF.hs b/src/GF/Source/PrintGF.hs
index e44891e44..6275f1a66 100644
--- a/src/GF/Source/PrintGF.hs
+++ b/src/GF/Source/PrintGF.hs
@@ -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])