diff options
| author |  Adam Chlipala <adamc@hcoop.net> | 2008-08-03 17:57:47 -0400 |
|---|---|---|
| committer | Adam Chlipala <adamc@hcoop.net> | 2008-08-03 17:57:47 -0400 |
| commit | 3e65e1558de55a1a47a62690b48159d92a4ed072 (patch) | |
| tree | 57096304282d20c6a741d75fbeeedcbba1275a81 /src/cjr_print.sml | |
| parent | 289b94cdcffed0874ac10b38d69366d8a43057cf (diff) | |
FFI datatypes
Diffstat (limited to 'src/cjr_print.sml')
| -rw-r--r-- | src/cjr_print.sml | 36 |
1 files changed, 22 insertions, 14 deletions
diff --git a/src/cjr_print.sml b/src/cjr_print.sml index 4a6971b0..d35c93fe 100644 --- a/src/cjr_print.sml +++ b/src/cjr_print.sml @@ -266,46 +266,54 @@ fun newGoto () = end end +fun patConInfo env pc = + case pc of + PConVar n => + let + val (x, _, dn) = E.lookupConstructor env n + val (dx, _) = E.lookupDatatype env dn + in + ("__lwd_" ^ dx ^ "_" ^ Int.toString dn, + "__lwc_" ^ x ^ "_" ^ Int.toString n) + end + | PConFfi {mod = m, datatyp, con} => + ("lw_" ^ m ^ "_" ^ datatyp, + "lw_" ^ m ^ "_" ^ con) + fun p_exp' par env (e, loc) = case e of EPrim p => Prim.p_t p | ERel n => p_rel env n | ENamed n => p_enamed env n - | ECon (n, eo) => + | ECon (pc, eo) => let - val (x, _, dn) = E.lookupConstructor env n - val (dx, _) = E.lookupDatatype env dn + val (xd, xc) = patConInfo env pc in box [string "({", newline, string "struct", space, - string "__lwd_", - string dx, - string "_", - string (Int.toString dn), + string xd, space, string "*tmp", space, string "=", space, - string "lw_malloc(ctx, sizeof(struct __lwd_", - string dx, - string "_", - string (Int.toString dn), + string "lw_malloc(ctx, sizeof(struct ", + string xd, string "));", newline, string "tmp->tag", space, string "=", space, - string ("__lwc_" ^ x ^ "_" ^ Int.toString n), + string xc, string ";", newline, case eo of NONE => box [] - | SOME e => box [string "tmp->data.__lwc_", - string x, + | SOME e => box [string "tmp->data.", + string xd, space, string "=", space, |