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(",