Printsyntax.hs

   1 module Printsyntax where
   2
   3 -- pretty-printer generated by the BNF converter
   4
   5 import Abssyntax
   6 import Char
   7
   8 -- the top-level printing method
   9 printTree :: Print a => a -> String
  10 printTree = render . prt 0
  11
  12 type Doc = [ShowS] -> [ShowS]
  13
  14 doc :: ShowS -> Doc
  15 doc = (:)
  16
  17 render :: Doc -> String
  18 render d = rend 0 (map ($ "") $ d []) "" where
  19   rend i ss = case ss of
  20     "["      :ts -> showChar '[' . rend i ts
  21     "("      :ts -> showChar '(' . rend i ts
  22     "{"      :ts -> showChar '{' . new (i+1) . rend (i+1) ts
  23     "}" : ";":ts -> new (i-1) . space "}" . showChar ';' . new (i-1) . rend (i-1) ts
  24     "}"      :ts -> new (i-1) . showChar '}' . new (i-1) . rend (i-1) ts
  25     ";"      :ts -> showChar ';' . new i . rend i ts
  26     t  : "," :ts -> showString t . space "," . rend i ts
  27     t  : ")" :ts -> showString t . showChar ')' . rend i ts
  28     t  : "]" :ts -> showString t . showChar ']' . rend i ts
  29     t        :ts -> space t . rend i ts
  30     _            -> id
  31   new i   = showChar '\n' . replicateS (2*i) (showChar ' ') . dropWhile isSpace
  32   space t = showString t . (\s -> if null s then "" else (' ':s))
  33
  34 parenth :: Doc -> Doc
  35 parenth ss = doc (showChar '(') . ss . doc (showChar ')')
  36
  37 concatS :: [ShowS] -> ShowS
  38 concatS = foldr (.) id
  39
  40 concatD :: [Doc] -> Doc
  41 concatD = foldr (.) id
  42
  43 replicateS :: Int -> ShowS -> ShowS
  44 replicateS n f = concatS (replicate n f)
  45
  46 -- the printer class does the job
  47 class Print a where
  48   prt :: Int -> a -> Doc
  49   prtList :: [a] -> Doc
  50   prtList = concatD . map (prt 0)
  51
  52 instance Print a => Print [a] where
  53   prt _ = prtList
  54
  55 instance Print Char where
  56   prt _ s = doc (showChar '\'' . mkEsc '\'' s . showChar '\'')
  57   prtList s = doc (showChar '"' . concatS (map (mkEsc '"') s) . showChar '"')
  58
  59 mkEsc :: Char -> Char -> ShowS
  60 mkEsc q s = case s of
  61   _ | s == q -> showChar '\\' . showChar s
  62   '\\'-> showString "\\\\"
  63   '\n' -> showString "\\n"
  64   '\t' -> showString "\\t"
  65   _ -> showChar s
  66
  67 prPrec :: Int -> Int -> Doc -> Doc
  68 prPrec i j = if j<i then parenth else id
  69
  70
  71 instance Print Integer where
  72   prt _ x = doc (shows x)
  73
  74
  75 instance Print Double where
  76   prt _ x = doc (shows x)
  77
  78
  79 instance Print Ident where
  80   prt _ (Ident i) = doc (showString i)
  81
  82
  83
  84 instance Print Bool where
  85   prt i e = case e of
  86    True  -> prPrec i 0 (concatD [doc (showString "true")])
  87    False  -> prPrec i 0 (concatD [doc (showString "false")])
  88
  89
  90 instance Print Type where
  91   prt i e = case e of
  92    TInt  -> prPrec i 0 (concatD [doc (showString "int")])
  93    TBool  -> prPrec i 0 (concatD [doc (showString "bool")])
  94
  95
  96 instance Print Program where
  97   prt i e = case e of
  98    Program funcstms -> prPrec i 0 (concatD [prt 0 funcstms])
  99
 100
 101 instance Print Stm where
 102   prt i e = case e of
 103    SExp exp -> prPrec i 0 (concatD [prt 0 exp , doc (showString ";")])
 104    SBlock stms -> prPrec i 0 (concatD [doc (showString "{") , prt 0 stms , doc (showString "}")])
 105    SDecl type' id exp -> prPrec i 0 (concatD [prt 0 type' , prt 0 id , doc (showString "=") , prt 0 exp , doc (showString ";")])
 106    SDeclD type' id -> prPrec i 0 (concatD [prt 0 type' , prt 0 id , doc (showString ";")])
 107    SWhile exp stm -> prPrec i 0 (concatD [doc (showString "while") , doc (showString "(") , prt 0 exp , doc (showString ")") , prt 0 stm])
 108    SIf exp stm0 stm -> prPrec i 0 (concatD [doc (showString "if") , doc (showString "(") , prt 0 exp , doc (showString ")") , prt 0 stm0 , doc (showString "else") , prt 0 stm])
 109    SPrint exp -> prPrec i 0 (concatD [doc (showString "print") , prt 0 exp , doc (showString ";")])
 110    SReturn exp -> prPrec i 0 (concatD [doc (showString "return") , prt 0 exp , doc (showString ";")])
 111    SNoop  -> prPrec i 0 (concatD [])
 112
 113   prtList es = case es of
 114    [] -> (concatD [])
 115    x:xs -> (concatD [prt 0 x , prt 0 xs])
 116
 117 instance Print Exp where
 118   prt i e = case e of
 119    EAss id exp -> prPrec i 0 (concatD [prt 0 id , doc (showString "=") , prt 0 exp])
 120    EVar id -> prPrec i 3 (concatD [prt 0 id])
 121    EInt n -> prPrec i 3 (concatD [prt 0 n])
 122    EBool bool -> prPrec i 3 (concatD [prt 0 bool])
 123    ENeg exp -> prPrec i 3 (concatD [doc (showString "-") , prt 3 exp])
 124    ENot exp -> prPrec i 3 (concatD [doc (showString "!") , prt 3 exp])
 125    EReadI  -> prPrec i 3 (concatD [doc (showString "readInt")])
 126    EReadB  -> prPrec i 3 (concatD [doc (showString "readBool")])
 127    EFunc id exps -> prPrec i 3 (concatD [prt 0 id , doc (showString "(") , prt 0 exps , doc (showString ")")])
 128    BiOpExp exp0 op exp -> prPrec i 0 (concatD [prt 0 exp0 , prt 0 op , prt 0 exp])
 129    EPost id op -> prPrec i 0 (concatD [prt 0 id , prt 1 op])
 130
 131   prtList es = case es of
 132    [] -> (concatD [])
 133    [x] -> (concatD [prt 0 x])
 134    x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
 135
 136 instance Print Decl where
 137   prt i e = case e of
 138    Decl type' id -> prPrec i 0 (concatD [prt 0 type' , prt 0 id])
 139
 140   prtList es = case es of
 141    [] -> (concatD [])
 142    [x] -> (concatD [prt 0 x])
 143    x:xs -> (concatD [prt 0 x , doc (showString ",") , prt 0 xs])
 144
 145 instance Print Func where
 146   prt i e = case e of
 147    Func type' id decls stms -> prPrec i 0 (concatD [prt 0 type' , prt 0 id , doc (showString "(") , prt 0 decls , doc (showString ")") , doc (showString "{") , prt 0 stms , doc (showString "}")])
 148
 149   prtList es = case es of
 150    [] -> (concatD [])
 151    x:xs -> (concatD [prt 0 x , prt 0 xs])
 152
 153 instance Print FuncStm where
 154   prt i e = case e of
 155    S stm -> prPrec i 0 (concatD [prt 0 stm])
 156    F func -> prPrec i 0 (concatD [prt 0 func])
 157
 158   prtList es = case es of
 159    [] -> (concatD [])
 160    x:xs -> (concatD [prt 0 x , prt 0 xs])
 161
 162 instance Print Op where
 163   prt i e = case e of
 164    Lt  -> prPrec i 0 (concatD [doc (showString "<")])
 165    ELt  -> prPrec i 0 (concatD [doc (showString "<=")])
 166    Gt  -> prPrec i 0 (concatD [doc (showString ">")])
 167    EGt  -> prPrec i 0 (concatD [doc (showString ">=")])
 168    Eq  -> prPrec i 0 (concatD [doc (showString "==")])
 169    NEq  -> prPrec i 0 (concatD [doc (showString "!=")])
 170    Plus  -> prPrec i 1 (concatD [doc (showString "+")])
 171    Minus  -> prPrec i 1 (concatD [doc (showString "-")])
 172    Times  -> prPrec i 2 (concatD [doc (showString "*")])
 173    Div  -> prPrec i 2 (concatD [doc (showString "/")])
 174
 175
 176