comparison src/elab_print.sml @ 171:c7a6e6dbc318

Elaborating some basic pattern matching
author Adam Chlipala <adamc@hcoop.net>
date Thu, 31 Jul 2008 10:06:27 -0400
parents 06a98129b23f
children 8221b95cc24c
comparison
equal deleted inserted replaced
170:a158f8c5aa55 171:c7a6e6dbc318
187 187
188 and p_name env (all as (c, _)) = 188 and p_name env (all as (c, _)) =
189 case c of 189 case c of
190 CName s => string s 190 CName s => string s
191 | _ => p_con env all 191 | _ => p_con env all
192
193 fun p_patCon env pc =
194 case pc of
195 PConVar n =>
196 ((if !debug then
197 string (#1 (E.lookupENamed env n) ^ "__" ^ Int.toString n)
198 else
199 string (#1 (E.lookupENamed env n)))
200 handle E.UnboundRel _ => string ("UNBOUND_NAMED" ^ Int.toString n))
201 | PConProj (m1, ms, x) =>
202 let
203 val m1x = #1 (E.lookupStrNamed env m1)
204 handle E.UnboundNamed _ => "UNBOUND_STR_" ^ Int.toString m1
205
206 val m1s = if !debug then
207 m1x ^ "__" ^ Int.toString m1
208 else
209 m1x
210 in
211 p_list_sep (string ".") string (m1x :: ms @ [x])
212 end
213
214 fun p_pat' par env (p, _) =
215 case p of
216 PWild => string "_"
217 | PVar s => string s
218 | PCon (pc, NONE) => p_patCon env pc
219 | PCon (pc, SOME p) => parenIf par (box [p_patCon env pc,
220 space,
221 p_pat' true env p])
222
223 val p_pat = p_pat' false
192 224
193 fun p_exp' par env (e, _) = 225 fun p_exp' par env (e, _) =
194 case e of 226 case e of
195 EPrim p => Prim.p_t p 227 EPrim p => Prim.p_t p
196 | ERel n => 228 | ERel n =>
294 space, 326 space,
295 string "--", 327 string "--",
296 space, 328 space,
297 p_con' true env c]) 329 p_con' true env c])
298 | EFold _ => string "fold" 330 | EFold _ => string "fold"
331
332 | ECase (e, pes, _) => parenIf par (box [string "case",
333 space,
334 p_exp env e,
335 space,
336 string "of",
337 space,
338 p_list_sep (box [space, string "|", space])
339 (fn (p, e) => box [p_pat env p,
340 space,
341 string "=>",
342 space,
343 p_exp env e]) pes])
299 344
300 | EError => string "<ERROR>" 345 | EError => string "<ERROR>"
301 346
302 and p_exp env = p_exp' false env 347 and p_exp env = p_exp' false env
303 348