Mercurial > urweb

comparison src/cjr_print.sml @ 757:fa2019a63ea4

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Basis.list
author Adam Chlipala <adamc@hcoop.net>
date Thu, 30 Apr 2009 11:07:29 -0400
parents 8ce31c052dce
children 8323c1beef2e
comparison
equal deleted inserted replaced
756:8ce31c052dce 757:fa2019a63ea4
100 if isUnboxable t then 100 if isUnboxable t then
101 p_typ' par env t 101 p_typ' par env t
102 else 102 else
103 box [p_typ' par env t, 103 box [p_typ' par env t,
104 string "*"] 104 string "*"]
105 | TList (_, i) => box [string "struct",
106 space,
107 string "__uws_",
108 string (Int.toString i),
109 string "*"]
105 110
106 and p_typ env = p_typ' false env 111 and p_typ env = p_typ' false env
107 112
108 fun p_rel env n = string ("__uwr_" ^ ident (#1 (E.lookupERel env n)) ^ "_" ^ Int.toString (E.countERels env - n - 1)) 113 fun p_rel env n = string ("__uwr_" ^ ident (#1 (E.lookupERel env n)) ^ "_" ^ Int.toString (E.countERels env - n - 1))
109 handle CjrEnv.UnboundRel _ => string ("__uwr_UNBOUND_" ^ Int.toString (E.countERels env - n - 1)) 114 handle CjrEnv.UnboundRel _ => string ("__uwr_UNBOUND_" ^ Int.toString (E.countERels env - n - 1))
145 fun p_patCon env pc = 150 fun p_patCon env pc =
146 case pc of 151 case pc of
147 PConVar n => p_con_named env n 152 PConVar n => p_con_named env n
148 | PConFfi {mod = m, con, ...} => string ("uw_" ^ ident m ^ "_" ^ ident con) 153 | PConFfi {mod = m, con, ...} => string ("uw_" ^ ident m ^ "_" ^ ident con)
149 154
150 fun p_pat (env, exit, depth) (p, _) = 155 fun p_pat (env, exit, depth) (p, loc) =
151 case p of 156 case p of
152 PWild => 157 PWild =>
153 (box [], env) 158 (box [], env)
154 | PVar (x, t) => 159 | PVar (x, t) =>
155 (box [string "__uwr_", 160 (box [string "__uwr_",
326 let 331 let
327 val (p, env) = p_pat (env, exit, depth + 1) p 332 val (p, env) = p_pat (env, exit, depth + 1) p
328 in 333 in
329 (box [string "{", 334 (box [string "{",
330 newline, 335 newline,
336 string "/* ",
337 string (ErrorMsg.spanToString loc),
338 string "*/",
339 newline,
331 p_typ env t, 340 p_typ env t,
332 space, 341 space,
333 string "disc", 342 string "disc",
334 string (Int.toString (depth + 1)), 343 string (Int.toString (depth + 1)),
335 space, 344 space,
572 end) 581 end)
573 | TFfi ("Basis", "string") => false 582 | TFfi ("Basis", "string") => false
574 | TFfi ("Basis", "blob") => allowHeapAllocated 583 | TFfi ("Basis", "blob") => allowHeapAllocated
575 | TFfi _ => true 584 | TFfi _ => true
576 | TOption t => allowHeapAllocated andalso nl ok t 585 | TOption t => allowHeapAllocated andalso nl ok t
586 | TList (t, _) => allowHeapAllocated andalso nl ok t
577 in 587 in
578 nl IS.empty 588 nl IS.empty
579 end 589 end
580 590
581 fun capitalize s = 591 fun capitalize s =