Mercurial > urweb

comparison src/mono_print.sml @ 178:eb3f9913bf31

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
First part of getting cases through monoize
author Adam Chlipala <adamc@hcoop.net>
date Sun, 03 Aug 2008 09:26:49 -0400
parents 25b169416ea8
children 3bbed533fbd2
comparison
equal deleted inserted replaced
177:5d030ee143e2 178:eb3f9913bf31
52 string ":", 52 string ":",
53 space, 53 space,
54 p_typ env t]) xcs, 54 p_typ env t]) xcs,
55 string "}"] 55 string "}"]
56 | TDatatype (n, _) => 56 | TDatatype (n, _) =>
57 if !debug then 57 ((if !debug then
58 string (#1 (E.lookupDatatype env n) ^ "__" ^ Int.toString n) 58 string (#1 (E.lookupDatatype env n) ^ "__" ^ Int.toString n)
59 else 59 else
60 string (#1 (E.lookupDatatype env n)) 60 string (#1 (E.lookupDatatype env n)))
61 handle E.UnboundNamed _ => string ("UNBOUND_DATATYPE_" ^ Int.toString n))
61 | TFfi (m, x) => box [string "FFI(", string m, string ".", string x, string ")"] 62 | TFfi (m, x) => box [string "FFI(", string m, string ".", string x, string ")"]
62 63
63 and p_typ env = p_typ' false env 64 and p_typ env = p_typ' false env
64 65
65 fun p_enamed env n = 66 fun p_enamed env n =
66 if !debug then 67 (if !debug then
67 string (#1 (E.lookupENamed env n) ^ "__" ^ Int.toString n) 68 string (#1 (E.lookupENamed env n) ^ "__" ^ Int.toString n)
68 else 69 else
69 string (#1 (E.lookupENamed env n)) 70 string (#1 (E.lookupENamed env n)))
71 handle E.UnboundNamed _ => string ("UNBOUNDN_" ^ Int.toString n)
72
73 fun p_con_named env n =
74 (if !debug then
75 string (#1 (E.lookupConstructor env n) ^ "__" ^ Int.toString n)
76 else
77 string (#1 (E.lookupConstructor env n)))
78 handle E.UnboundNamed _ => string ("CONSTRUCTOR_" ^ Int.toString n)
79
80 fun p_patCon env pc =
81 case pc of
82 PConVar n => p_con_named env n
83 | PConFfi (m, x) => box [string "FFI(",
84 string m,
85 string ".",
86 string x,
87 string ")"]
88
89 fun p_pat' par env (p, _) =
90 case p of
91 PWild => string "_"
92 | PVar s => string s
93 | PPrim p => Prim.p_t p
94 | PCon (n, NONE) => p_patCon env n
95 | PCon (n, SOME p) => parenIf par (box [p_patCon env n,
96 space,
97 p_pat' true env p])
98 | PRecord xps =>
99 box [string "{",
100 p_list_sep (box [string ",", space]) (fn (x, p) =>
101 box [string x,
102 space,
103 string "=",
104 space,
105 p_pat env p]) xps,
106 string "}"]
107
108 and p_pat x = p_pat' false x
70 109
71 fun p_exp' par env (e, _) = 110 fun p_exp' par env (e, _) =
72 case e of 111 case e of
73 EPrim p => Prim.p_t p 112 EPrim p => Prim.p_t p
74 | ERel n => 113 | ERel n =>
75 if !debug then 114 ((if !debug then
76 string (#1 (E.lookupERel env n) ^ "_" ^ Int.toString n) 115 string (#1 (E.lookupERel env n) ^ "_" ^ Int.toString n)
77 else 116 else
78 string (#1 (E.lookupERel env n)) 117 string (#1 (E.lookupERel env n)))
118 handle E.UnboundRel _ => string ("UNBOUND_" ^ Int.toString n))
79 | ENamed n => p_enamed env n 119 | ENamed n => p_enamed env n
120 | ECon (n, NONE) => p_con_named env n
121 | ECon (n, SOME e) => parenIf par (box [p_con_named env n,
122 space,
123 p_exp' true env e])
80 124
81 | EFfi (m, x) => box [string "FFI(", string m, string ".", string x, string ")"] 125 | EFfi (m, x) => box [string "FFI(", string m, string ".", string x, string ")"]
82 | EFfiApp (m, x, es) => box [string "FFI(", 126 | EFfiApp (m, x, es) => box [string "FFI(",
83 string m, 127 string m,
84 string ".", 128 string ".",
112 | EField (e, x) => 156 | EField (e, x) =>
113 box [p_exp' true env e, 157 box [p_exp' true env e,
114 string ".", 158 string ".",
115 string x] 159 string x]
116 160
161 | ECase (e, pes, _) => parenIf par (box [string "case",
162 space,
163 p_exp env e,
164 space,
165 string "of",
166 space,
167 p_list_sep (box [space, string "|", space])
168 (fn (p, e) => box [p_pat env p,
169 space,
170 string "=>",
171 space,
172 p_exp env e]) pes])
117 173
118 | EStrcat (e1, e2) => box [p_exp' true env e1, 174 | EStrcat (e1, e2) => box [p_exp' true env e1,
119 space, 175 space,
120 string "^", 176 string "^",
121 space, 177 space,