Mercurial > urweb

comparison src/cjr_print.sml @ 168:25b169416ea8

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Storing datatype constructors in type references past monoize
author Adam Chlipala <adamc@hcoop.net>
date Tue, 29 Jul 2008 15:43:17 -0400
parents 2be573fec9a6
children 31dfab1d4050
comparison
equal deleted inserted replaced
167:2be573fec9a6 168:25b169416ea8
51 val compare = Char.compare 51 val compare = Char.compare
52 end) 52 end)
53 53
54 val debug = ref false 54 val debug = ref false
55 55
56 val dummyTyp = (TDatatype 0, ErrorMsg.dummySpan) 56 val dummyTyp = (TDatatype (0, []), ErrorMsg.dummySpan)
57 57
58 fun p_typ' par env (t, loc) = 58 fun p_typ' par env (t, loc) =
59 case t of 59 case t of
60 TTop => string "void*" 60 TTop => string "void*"
61 | TFun (t1, t2) => parenIf par (box [p_typ' true env t2, 61 | TFun (t1, t2) => parenIf par (box [p_typ' true env t2,
67 string ")"]) 67 string ")"])
68 | TRecord i => box [string "struct", 68 | TRecord i => box [string "struct",
69 space, 69 space,
70 string "__lws_", 70 string "__lws_",
71 string (Int.toString i)] 71 string (Int.toString i)]
72 | TDatatype n => 72 | TDatatype (n, _) =>
73 (box [string "struct", 73 (box [string "struct",
74 space, 74 space,
75 string ("__lwd_" ^ #1 (E.lookupDatatype env n) ^ "_" ^ Int.toString n ^ "*")] 75 string ("__lwd_" ^ #1 (E.lookupDatatype env n) ^ "_" ^ Int.toString n ^ "*")]
76 handle CjrEnv.UnboundNamed _ => string ("__lwd_UNBOUND__" ^ Int.toString n)) 76 handle CjrEnv.UnboundNamed _ => string ("__lwd_UNBOUND__" ^ Int.toString n))
77 | TFfi (m, x) => box [string "lw_", string m, string "_", string x] 77 | TFfi (m, x) => box [string "lw_", string m, string "_", string x]
443 string "__lw_tmp;", 443 string "__lw_tmp;",
444 newline, 444 newline,
445 string "})"] 445 string "})"]
446 end 446 end
447 447
448 | TDatatype i => 448 | TDatatype (i, _) =>
449 let 449 let
450 val (x, xncs) = E.lookupDatatype env i 450 val (x, xncs) = E.lookupDatatype env i
451 451
452 fun doEm xncs = 452 fun doEm xncs =
453 case xncs of 453 case xncs of