Mercurial > urweb

comparison src/elab_print.sml @ 31:1c91c5e6840f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Simple signature matching
author Adam Chlipala <adamc@hcoop.net>
date Thu, 12 Jun 2008 17:16:20 -0400
parents 537db4ee89f4
children 0ff8c2728634
comparison
equal deleted inserted replaced
30:e6ccf961d8a3 31:1c91c5e6840f
226 226
227 | EError => string "<ERROR>" 227 | EError => string "<ERROR>"
228 228
229 and p_exp env = p_exp' false env 229 and p_exp env = p_exp' false env
230 230
231 fun p_named x n =
232 if !debug then
233 box [string x,
234 string "__",
235 string (Int.toString n)]
236 else
237 string x
238
239 fun p_sgn_item env (sgi, _) =
240 case sgi of
241 SgiConAbs (x, n, k) => box [string "con",
242 space,
243 p_named x n,
244 space,
245 string "::",
246 space,
247 p_kind k]
248 | SgiCon (x, n, k, c) => box [string "con",
249 space,
250 p_named x n,
251 space,
252 string "::",
253 space,
254 p_kind k,
255 space,
256 string "=",
257 space,
258 p_con env c]
259 | SgiVal (x, n, c) => box [string "val",
260 space,
261 p_named x n,
262 space,
263 string ":",
264 space,
265 p_con env c]
266 | SgiStr (x, n, sgn) => box [string "structure",
267 space,
268 p_named x n,
269 space,
270 string ":",
271 space,
272 p_sgn env sgn]
273
274 and p_sgn env (sgn, _) =
275 case sgn of
276 SgnConst sgis => box [string "sig",
277 newline,
278 p_list_sep newline (p_sgn_item env) sgis,
279 newline,
280 string "end"]
281 | SgnVar n => string (#1 (E.lookupSgnNamed env n))
282 | SgnError => string "<ERROR>"
283
231 fun p_decl env ((d, _) : decl) = 284 fun p_decl env ((d, _) : decl) =
232 case d of 285 case d of
233 DCon (x, n, k, c) => 286 DCon (x, n, k, c) => box [string "con",
234 let 287 space,
235 val xp = if !debug then 288 p_named x n,
236 box [string x, 289 space,
237 string "__", 290 string "::",
238 string (Int.toString n)] 291 space,
239 else 292 p_kind k,
240 string x 293 space,
241 in 294 string "=",
242 box [string "con", 295 space,
243 space, 296 p_con env c]
244 xp, 297 | DVal (x, n, t, e) => box [string "val",
245 space, 298 space,
246 string "::", 299 p_named x n,
247 space, 300 space,
248 p_kind k, 301 string ":",
249 space, 302 space,
250 string "=", 303 p_con env t,
251 space, 304 space,
252 p_con env c] 305 string "=",
253 end 306 space,
254 | DVal (x, n, t, e) => 307 p_exp env e]
255 let 308
256 val xp = if !debug then 309 | DSgn (x, n, sgn) => box [string "signature",
257 box [string x, 310 space,
258 string "__", 311 p_named x n,
259 string (Int.toString n)] 312 space,
260 else 313 string "=",
261 string x 314 space,
262 in 315 p_sgn env sgn]
263 box [string "val", 316 | DStr (x, n, sgn, str) => box [string "structure",
264 space, 317 space,
265 xp, 318 p_named x n,
266 space, 319 space,
267 string ":", 320 string ":",
268 space, 321 space,
269 p_con env t, 322 p_sgn env sgn,
270 space, 323 space,
271 string "=", 324 string "=",
272 space, 325 space,
273 p_exp env e] 326 p_str env str]
274 end 327
328 and p_str env (str, _) =
329 case str of
330 StrConst ds => box [string "struct",
331 newline,
332 p_list_sep newline (p_decl env) ds,
333 newline,
334 string "end"]
335 | StrVar n => string (#1 (E.lookupStrNamed env n))
336 | StrError => string "<ERROR>"
275 337
276 fun p_file env file = 338 fun p_file env file =
277 let 339 let
278 val (_, pds) = ListUtil.mapfoldl (fn (d, env) => 340 val (pds, _) = ListUtil.foldlMap (fn (d, env) =>
279 (E.declBinds env d, 341 (p_decl env d,
280 p_decl env d)) 342 E.declBinds env d))
281 env file 343 env file
282 in 344 in
283 p_list_sep newline (fn x => x) pds 345 p_list_sep newline (fn x => x) pds
284 end 346 end
285 347
286 end 348 end