Mercurial > urweb
comparison src/core_print.sml @ 177:5d030ee143e2
Case through corify
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Sat, 02 Aug 2008 11:15:32 -0400 |
parents | 80192edca30d |
children | d11754ffe252 |
comparison
equal
deleted
inserted
replaced
176:33d4a8eea484 | 177:5d030ee143e2 |
---|---|
150 string (#1 (E.lookupENamed env n) ^ "__" ^ Int.toString n) | 150 string (#1 (E.lookupENamed env n) ^ "__" ^ Int.toString n) |
151 else | 151 else |
152 string (#1 (E.lookupENamed env n))) | 152 string (#1 (E.lookupENamed env n))) |
153 handle E.UnboundNamed _ => string ("UNBOUNDN_" ^ Int.toString n) | 153 handle E.UnboundNamed _ => string ("UNBOUNDN_" ^ Int.toString n) |
154 | 154 |
155 fun p_con_named env n = | |
156 (if !debug then | |
157 string (#1 (E.lookupConstructor env n) ^ "__" ^ Int.toString n) | |
158 else | |
159 string (#1 (E.lookupConstructor env n))) | |
160 handle E.UnboundNamed _ => string ("CONSTRUCTOR_" ^ Int.toString n) | |
161 | |
162 fun p_patCon env pc = | |
163 case pc of | |
164 PConVar n => p_con_named env n | |
165 | PConFfi (m, x) => box [string "FFI(", | |
166 string m, | |
167 string ".", | |
168 string x, | |
169 string ")"] | |
170 | |
171 fun p_pat' par env (p, _) = | |
172 case p of | |
173 PWild => string "_" | |
174 | PVar s => string s | |
175 | PPrim p => Prim.p_t p | |
176 | PCon (n, NONE) => p_patCon env n | |
177 | PCon (n, SOME p) => parenIf par (box [p_patCon env n, | |
178 space, | |
179 p_pat' true env p]) | |
180 | PRecord xps => | |
181 box [string "{", | |
182 p_list_sep (box [string ",", space]) (fn (x, p) => | |
183 box [string x, | |
184 space, | |
185 string "=", | |
186 space, | |
187 p_pat env p]) xps, | |
188 string "}"] | |
189 | |
190 and p_pat x = p_pat' false x | |
191 | |
155 fun p_exp' par env (e, _) = | 192 fun p_exp' par env (e, _) = |
156 case e of | 193 case e of |
157 EPrim p => Prim.p_t p | 194 EPrim p => Prim.p_t p |
158 | ERel n => | 195 | ERel n => |
159 ((if !debug then | 196 ((if !debug then |
160 string (#1 (E.lookupERel env n) ^ "_" ^ Int.toString n) | 197 string (#1 (E.lookupERel env n) ^ "_" ^ Int.toString n) |
161 else | 198 else |
162 string (#1 (E.lookupERel env n))) | 199 string (#1 (E.lookupERel env n))) |
163 handle E.UnboundRel _ => string ("UNBOUND_" ^ Int.toString n)) | 200 handle E.UnboundRel _ => string ("UNBOUND_" ^ Int.toString n)) |
164 | ENamed n => p_enamed env n | 201 | ENamed n => p_enamed env n |
202 | ECon (n, NONE) => p_con_named env n | |
203 | ECon (n, SOME e) => parenIf par (box [p_con_named env n, | |
204 space, | |
205 p_exp' true env e]) | |
165 | EFfi (m, x) => box [string "FFI(", string m, string ".", string x, string ")"] | 206 | EFfi (m, x) => box [string "FFI(", string m, string ".", string x, string ")"] |
166 | EFfiApp (m, x, es) => box [string "FFI(", | 207 | EFfiApp (m, x, es) => box [string "FFI(", |
167 string m, | 208 string m, |
168 string ".", | 209 string ".", |
169 string x, | 210 string x, |
247 string "--", | 288 string "--", |
248 space, | 289 space, |
249 p_con' true env c]) | 290 p_con' true env c]) |
250 | EFold _ => string "fold" | 291 | EFold _ => string "fold" |
251 | 292 |
293 | ECase (e, pes, _) => parenIf par (box [string "case", | |
294 space, | |
295 p_exp env e, | |
296 space, | |
297 string "of", | |
298 space, | |
299 p_list_sep (box [space, string "|", space]) | |
300 (fn (p, e) => box [p_pat env p, | |
301 space, | |
302 string "=>", | |
303 space, | |
304 p_exp env e]) pes]) | |
305 | |
252 | EWrite e => box [string "write(", | 306 | EWrite e => box [string "write(", |
253 p_exp env e, | 307 p_exp env e, |
254 string ")"] | 308 string ")"] |
255 | 309 |
256 | EClosure (n, es) => box [string "CLOSURE(", | 310 | EClosure (n, es) => box [string "CLOSURE(", |