From c50a06b4118eac12702518e03ecca87f95f34cc4 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sat, 16 May 2009 12:41:33 -0400 Subject: Fix a Core_untangle bug that missed closure variable references; XHTMLize --- src/core_util.sml | 30 +++++++++++++++++++----------- 1 file changed, 19 insertions(+), 11 deletions(-) (limited to 'src/core_util.sml') 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, -- cgit v1.2.3