Mercurial > urweb
diff src/core_util.sml @ 802:ef6de4075dc1
Fix a Core_untangle bug that missed closure variable references; XHTMLize
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Sat, 16 May 2009 12:41:33 -0400 |
| parents | 6271f0e3c272 |
| children | 61a1f5c5ae2c |
line wrap: on
line diff
--- a/src/core_util.sml Thu May 14 18:13:09 2009 -0400 +++ b/src/core_util.sml Sat May 16 12:41:33 2009 -0400 @@ -940,17 +940,25 @@ end | DExport _ => S.return2 dAll | DTable (x, n, c, s, pe, pc, ce, cc) => - S.bind2 (mfc ctx c, - fn c' => - S.bind2 (mfe ctx pe, - fn pe' => - S.bind2 (mfc ctx pc, - fn pc' => - S.bind2 (mfe ctx ce, - fn ce' => - S.map2 (mfc ctx cc, - fn cc' => - (DTable (x, n, c', s, pe', pc', ce', cc'), loc)))))) + let + val loc = #2 ce + val ct = (CFfi ("Basis", "sql_table"), loc) + val ct = (CApp (ct, (CConcat (pc, cc), loc)), loc) + val ct = (CApp (ct, cc), loc) + val ctx' = bind (ctx, NamedE (x, n, ct, NONE, s)) + in + S.bind2 (mfc ctx c, + fn c' => + S.bind2 (mfe ctx' pe, + fn pe' => + S.bind2 (mfc ctx pc, + fn pc' => + S.bind2 (mfe ctx' ce, + fn ce' => + S.map2 (mfc ctx cc, + fn cc' => + (DTable (x, n, c', s, pe', pc', ce', cc'), loc)))))) + end | DSequence _ => S.return2 dAll | DView (x, n, s, e, c) => S.bind2 (mfe ctx e,