diff options
| author |  Adam Chlipala <adamc@hcoop.net> | 2009-05-16 12:41:33 -0400 |
|---|---|---|
| committer | Adam Chlipala <adamc@hcoop.net> | 2009-05-16 12:41:33 -0400 |
| commit | 768fd72de4842c23813cd45bfae4918c7395e0c1 (patch) | |
| tree | b05b4f028035c9fbcc9f2477a69002c8b0034312 /src/core_util.sml | |
| parent | 79655b086c036d07806d0c345ffc9e6683891fe4 (diff) | |
Fix a Core_untangle bug that missed closure variable references; XHTMLize
Diffstat (limited to 'src/core_util.sml')
| -rw-r--r-- | src/core_util.sml | 30 |
1 files changed, 19 insertions, 11 deletions
diff --git a/src/core_util.sml b/src/core_util.sml index e3ec8a1d..96a05b2d 100644 --- a/src/core_util.sml +++ b/src/core_util.sml @@ -940,17 +940,25 @@ fun mapfoldB {kind = fk, con = fc, exp = fe, decl = fd, bind} = 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, |