Mercurial > urweb
diff src/sqlcache.sml @ 2212:388ba4dc7c96
Small cleanup.
author | Ziv Scully <ziv@mit.edu> |
---|---|
date | Mon, 15 Sep 2014 20:01:16 -0400 |
parents | 0ca11d57c175 |
children | 365727ff68f4 |
line wrap: on
line diff
--- a/src/sqlcache.sml Sat Sep 13 19:16:07 2014 -0400 +++ b/src/sqlcache.sml Mon Sep 15 20:01:16 2014 -0400 @@ -12,6 +12,37 @@ val ffiIndices : int list ref = ref [] +(* Expression construction utilities. *) + +fun intExp (n, loc) = (EPrim (Prim.Int (Int64.fromInt n)), loc) +fun intTyp loc = (TFfi ("Basis", "int"), loc) +fun boolPat (b, loc) = (PCon (Enum, + PConFfi {mod = "Basis", datatyp = "bool", arg = NONE, + con = if b then "True" else "False"}, + NONE), + loc) +fun boolTyp loc = (TFfi ("Basis", "int"), loc) + +fun ffiAppExp (module, func, index, loc) = + (EFfiApp (module, func ^ Int.toString index, []), loc) + +fun sequence ((exp :: exps), loc) = + List.foldl (fn (exp, seq) => (ESeq (seq, exp), loc)) exp exps + +fun antiguardUnit (cond, exp, loc) = + (ECase (cond, + [(boolPat (false, loc), exp), + (boolPat (true, loc), (ERecord [], loc))], + {disc = boolTyp loc, result = (TRecord [], loc)}), + loc) + +fun underAbs f (exp as (exp', loc)) = + case exp' of + EAbs (x, y, z, body) => (EAbs (x, y, z, underAbs f body), loc) + | _ => f exp + +(* Program analysis and augmentation. *) + val rec tablesRead = fn Query1 {From=tablePairs, ...} => SS.fromList (map #1 tablePairs) | Union (q1,q2) => SS.union (tablesRead q1, tablesRead q2) @@ -47,37 +78,6 @@ {read = SS.empty, written = SS.empty} end -fun intExp (n, loc) = (EPrim (Prim.Int (Int64.fromInt n)), loc) -fun intTyp loc = (TFfi ("Basis", "int"), loc) -fun boolPat (b, loc) = (PCon (Enum, - PConFfi {mod = "Basis", datatyp = "bool", arg = NONE, - con = if b then "True" else "False"}, - NONE), - loc) -fun boolTyp loc = (TFfi ("Basis", "int"), loc) - -fun ffiAppExp (module, func, index, loc) = - (EFfiApp (module, func ^ Int.toString index, []), loc) - -fun sequence (befores, center, afters, loc) = - List.foldr (fn (exp, seq) => (ESeq (exp, seq), loc)) - (List.foldl (fn (exp, seq) => (ESeq (seq, exp), loc)) - center - afters) - befores - -fun antiguardUnit (cond, exp, loc) = - (ECase (cond, - [(boolPat (false, loc), exp), - (boolPat (true, loc), (ERecord [], loc))], - {disc = boolTyp loc, result = (TRecord [], loc)}), - loc) - -fun underAbs f (exp as (exp', loc)) = - case exp' of - EAbs (x, y, z, body) => (EAbs (x, y, z, underAbs f body), loc) - | _ => f exp - fun addCacheCheck (index, exp) = let fun f (body as (_, loc)) = @@ -85,7 +85,7 @@ val check = ffiAppExp ("Cache", "check", index, loc) val store = ffiAppExp ("Cache", "store", index, loc) in - antiguardUnit (check, sequence ([], body, [store], loc), loc) + antiguardUnit (check, sequence ([body, store], loc), loc) end in underAbs f exp @@ -99,9 +99,8 @@ fun mapFfi func = List.map (fn i => ffiAppExp ("Cache", func, i, loc)) val flushes = IS.listItems (SS.foldr addIndices IS.empty (#written (tablesInExp body))) - in - sequence (mapFfi "flush" flushes, body, mapFfi "ready" flushes, loc) + sequence (mapFfi "flush" flushes @ [body] @ mapFfi "ready" flushes, loc) end in underAbs f exp