comparison src/expl_print.sml @ 176:33d4a8eea484

Case through explify
author Adam Chlipala <adamc@hcoop.net>
date Thu, 31 Jul 2008 16:28:55 -0400
parents 80192edca30d
children d11754ffe252
comparison
equal deleted inserted replaced
175:b2d752455182 176:33d4a8eea484
153 and p_name env (all as (c, _)) = 153 and p_name env (all as (c, _)) =
154 case c of 154 case c of
155 CName s => string s 155 CName s => string s
156 | _ => p_con env all 156 | _ => p_con env all
157 157
158 fun p_patCon env pc =
159 case pc of
160 PConVar n =>
161 ((if !debug then
162 string (#1 (E.lookupENamed env n) ^ "__" ^ Int.toString n)
163 else
164 string (#1 (E.lookupENamed env n)))
165 handle E.UnboundRel _ => string ("UNBOUND_NAMED" ^ Int.toString n))
166 | PConProj (m1, ms, x) =>
167 let
168 val m1x = #1 (E.lookupStrNamed env m1)
169 handle E.UnboundNamed _ => "UNBOUND_STR_" ^ Int.toString m1
170
171 val m1s = if !debug then
172 m1x ^ "__" ^ Int.toString m1
173 else
174 m1x
175 in
176 p_list_sep (string ".") string (m1x :: ms @ [x])
177 end
178
179 fun p_pat' par env (p, _) =
180 case p of
181 PWild => string "_"
182 | PVar s => string s
183 | PPrim p => Prim.p_t p
184 | PCon (pc, NONE) => p_patCon env pc
185 | PCon (pc, SOME p) => parenIf par (box [p_patCon env pc,
186 space,
187 p_pat' true env p])
188 | PRecord xps =>
189 box [string "{",
190 p_list_sep (box [string ",", space]) (fn (x, p) =>
191 box [string x,
192 space,
193 string "=",
194 space,
195 p_pat env p]) xps,
196 string "}"]
197
198 and p_pat x = p_pat' false x
199
158 fun p_exp' par env (e, loc) = 200 fun p_exp' par env (e, loc) =
159 case e of 201 case e of
160 EPrim p => Prim.p_t p 202 EPrim p => Prim.p_t p
161 | ERel n => 203 | ERel n =>
162 if !debug then 204 if !debug then
261 | EFold _ => string "fold" 303 | EFold _ => string "fold"
262 304
263 | EWrite e => box [string "write(", 305 | EWrite e => box [string "write(",
264 p_exp env e, 306 p_exp env e,
265 string ")"] 307 string ")"]
308
309 | ECase (e, pes, _) => parenIf par (box [string "case",
310 space,
311 p_exp env e,
312 space,
313 string "of",
314 space,
315 p_list_sep (box [space, string "|", space])
316 (fn (p, e) => box [p_pat env p,
317 space,
318 string "=>",
319 space,
320 p_exp env e]) pes])
266 321
267 and p_exp env = p_exp' false env 322 and p_exp env = p_exp' false env
268 323
269 fun p_named x n = 324 fun p_named x n =
270 if !debug then 325 if !debug then