Mercurial > urweb

comparison src/cjr_print.sml @ 185:19ee24bffbc0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
FFI datatypes
author Adam Chlipala <adamc@hcoop.net>
date Sun, 03 Aug 2008 17:57:47 -0400
parents d11754ffe252
children 88d46972de53
comparison
equal deleted inserted replaced
184:98c29e3986d3 185:19ee24bffbc0
264 count := r + 1; 264 count := r + 1;
265 string ("L" ^ Int.toString r) 265 string ("L" ^ Int.toString r)
266 end 266 end
267 end 267 end
268 268
269 fun patConInfo env pc =
270 case pc of
271 PConVar n =>
272 let
273 val (x, _, dn) = E.lookupConstructor env n
274 val (dx, _) = E.lookupDatatype env dn
275 in
276 ("__lwd_" ^ dx ^ "_" ^ Int.toString dn,
277 "__lwc_" ^ x ^ "_" ^ Int.toString n)
278 end
279 | PConFfi {mod = m, datatyp, con} =>
280 ("lw_" ^ m ^ "_" ^ datatyp,
281 "lw_" ^ m ^ "_" ^ con)
282
269 fun p_exp' par env (e, loc) = 283 fun p_exp' par env (e, loc) =
270 case e of 284 case e of
271 EPrim p => Prim.p_t p 285 EPrim p => Prim.p_t p
272 | ERel n => p_rel env n 286 | ERel n => p_rel env n
273 | ENamed n => p_enamed env n 287 | ENamed n => p_enamed env n
274 | ECon (n, eo) => 288 | ECon (pc, eo) =>
275 let 289 let
276 val (x, _, dn) = E.lookupConstructor env n 290 val (xd, xc) = patConInfo env pc
277 val (dx, _) = E.lookupDatatype env dn
278 in 291 in
279 box [string "({", 292 box [string "({",
280 newline, 293 newline,
281 string "struct", 294 string "struct",
282 space, 295 space,
283 string "__lwd_", 296 string xd,
284 string dx,
285 string "_",
286 string (Int.toString dn),
287 space, 297 space,
288 string "*tmp", 298 string "*tmp",
289 space, 299 space,
290 string "=", 300 string "=",
291 space, 301 space,
292 string "lw_malloc(ctx, sizeof(struct __lwd_", 302 string "lw_malloc(ctx, sizeof(struct ",
293 string dx, 303 string xd,
294 string "_",
295 string (Int.toString dn),
296 string "));", 304 string "));",
297 newline, 305 newline,
298 string "tmp->tag", 306 string "tmp->tag",
299 space, 307 space,
300 string "=", 308 string "=",
301 space, 309 space,
302 string ("__lwc_" ^ x ^ "_" ^ Int.toString n), 310 string xc,
303 string ";", 311 string ";",
304 newline, 312 newline,
305 case eo of 313 case eo of
306 NONE => box [] 314 NONE => box []
307 | SOME e => box [string "tmp->data.__lwc_", 315 | SOME e => box [string "tmp->data.",
308 string x, 316 string xd,
309 space, 317 space,
310 string "=", 318 string "=",
311 space, 319 space,
312 p_exp env e, 320 p_exp env e,
313 string ";", 321 string ";",