1 module Print where 2 3 4 import LambdaLift 5 import Utilities 6 7 8 9 pprint :: (binder -> Iseq) -> Expr binder -> [Char] 10 pprint pb e = i_mkstr (ppr pb e) 11 12 13 14 pprintExpr = pprint i_str 15 16 17 18 pprintLevel :: (Expr ([Char], Integer)) -> [Char] 19 20 pprintLevel = pprint (\(name,level) -> i_concat [ i_str name, i_str "{", 21 i_num level, i_str "}" ]) 22 23 24 25 pprintSCs scs = i_mkstr (i_concat (map ppsc scs)) 26 ppsc (name, args, rhs) = 27 i_concat [ i_newline, i_str name, i_str " ", 28 i_interleave (i_str " ") (map i_str args), 29 i_str " = ", 30 i_indent 6 (ppr i_str rhs) ] 31 32 33 34 ppr pb (EAp e1 e2) = i_concat [ppr pb e1, i_space, ppr_atomic pb e2] 35 ppr pb (ELet isrec defs e) = 36 i_concat [ i_str keyword, i_newline, 37 i_indent 4 (i_interleave (i_str ";\n") (map (ppr_def pb) defs)), 38 i_str "\nin ", 39 ppr pb e 40 ] 41 where 42 keyword | isrec = "letrec" 43 | not isrec = "let" 44 ppr pb (ELam args body) = 45 i_concat [ i_str "\\[", 46 i_interleave (i_str ",") (map pb args), 47 i_str "] ", ppr pb body ] 48 49 ppr pb e = ppr_atomic pb e 50 51 ppr_atomic pb (EConst (CNum n)) = i_num n 52 ppr_atomic pb (EConst (CFun name)) = i_str name 53 ppr_atomic pb (EConst (CBool b)) = i_str (show b) 54 ppr_atomic pb (EVar v) = i_str v 55 ppr_atomic pb e = i_concat [i_str "(", ppr pb e, i_str ")"] 56 57 58 59 60 ppr_def pb (binder, (ELam args body)) = 61 i_concat [ pb binder, i_space, 62 i_interleave i_space (map pb args), 63 i_str " = ", 64 ppr pb body 65 ] 66 ppr_def pb (binder, rhs) = i_concat [pb binder, i_str " = ", ppr pb rhs] 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 type Iseq = Oseq -> Oseq 102 103 104 105 106 107 i_concat :: [Iseq] -> Iseq 108 i_concat = foldr i_append i_nil 109 110 111 112 113 i_interleave :: Iseq -> [Iseq] -> Iseq 114 i_interleave is [] = i_nil 115 i_interleave is iss = foldr1 glue iss 116 where glue is1 is2 = is1 `i_append` (is `i_append` is2) 117 foldr1 f [x] = x 118 foldr1 f (x:xs) = f x (foldr1 f xs) 119 120 121 122 i_num :: Num a => a -> Iseq 123 i_num = i_str . show 124 125 i_newline = i_str "\n" 126 i_space = i_str " " 127 128 129 130 131 132 133 134 type Oseq = Int -> Bool -> [Char] 135 136 137 138 o_empty :: Oseq -- An empty oseq 139 o_empty indent npend = [] 140 141 o_mkstr :: Oseq -> [Char] 142 o_mkstr oseq = oseq 0 False 143 144 145 146 147 148 149 150 i_nil x = x 151 i_append = (.) 152 i_str = foldr (i_append . i_char) i_nil 153 i_mkstr iseq = o_mkstr (iseq o_empty) 154 155 156 157 158 159 160 161 162 i_char :: Char -> Iseq 163 i_char '\n' rest indent npend = '\n' : rest indent True 164 i_char c rest indent False = c : rest indent False 165 i_char c rest indent True = pspaces indent (c : rest indent False) 166 167 168 169 170 i_indent n iseq oseq indent npend = 171 iseq oseq' (indent+n) npend 172 where 173 oseq' indent' npend' = oseq indent npend' 174 -- Ignore the indent passed along to oseq; 175 -- use the original indent instead. 176 177 178 179 pspaces 0 cs = cs 180 pspaces n cs = ' ' : pspaces (n-1) cs 181 182 183 184 185 186 187 188