summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/compiler.sml2
-rw-r--r--src/monoize.sml46
-rw-r--r--src/reduce.sml25
3 files changed, 48 insertions, 25 deletions
diff --git a/src/compiler.sml b/src/compiler.sml
index ba10ed74..def0e6c3 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -75,7 +75,7 @@ type ('src, 'dst) transform = {
}
val debug = ref false
-val doIflow = ref true
+val doIflow = ref false
fun transform (ph : ('src, 'dst) phase) name = {
func = fn input => let
diff --git a/src/monoize.sml b/src/monoize.sml
index 3983624b..e6c91abd 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -3742,25 +3742,39 @@ fun monoDecl (env, fm) (all as (d, loc)) =
end
| L.DPolicy e =>
let
- val (e, make) =
+ fun policies (e, fm) =
case #1 e of
- L.EApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sendClient"), _), _), _), _), _), e) =>
- (e, L'.PolClient)
- | L.EApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "mayInsert"), _), _), _), _), _), e) =>
- (e, L'.PolInsert)
- | L.EApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "mayDelete"), _), _), _), _), _), e) =>
- (e, L'.PolDelete)
- | L.EApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "mayUpdate"), _), _), _), _), _), e) =>
- (e, L'.PolUpdate)
- | L.EFfiApp ("Basis", "sendOwnIds", [e]) =>
- (e, L'.PolSequence)
- | _ => (poly (); (e, L'.PolClient))
+ L.EFfiApp ("Basis", "also", [e1, e2]) =>
+ let
+ val (ps1, fm) = policies (e1, fm)
+ val (ps2, fm) = policies (e2, fm)
+ in
+ (ps1 @ ps2, fm)
+ end
+ | _ =>
+ let
+ val (e, make) =
+ case #1 e of
+ L.EApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "sendClient"), _), _), _), _), _), e) =>
+ (e, L'.PolClient)
+ | L.EApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "mayInsert"), _), _), _), _), _), e) =>
+ (e, L'.PolInsert)
+ | L.EApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "mayDelete"), _), _), _), _), _), e) =>
+ (e, L'.PolDelete)
+ | L.EApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "mayUpdate"), _), _), _), _), _), e) =>
+ (e, L'.PolUpdate)
+ | L.EFfiApp ("Basis", "sendOwnIds", [e]) =>
+ (e, L'.PolSequence)
+ | _ => (poly (); (e, L'.PolClient))
+
+ val (e, fm) = monoExp (env, St.empty, fm) e
+ in
+ ([(L'.DPolicy (make e), loc)], fm)
+ end
- val (e, fm) = monoExp (env, St.empty, fm) e
+ val (ps, fm) = policies (e, fm)
in
- SOME (env,
- fm,
- [(L'.DPolicy (make e), loc)])
+ SOME (env, fm, ps)
end
end
diff --git a/src/reduce.sml b/src/reduce.sml
index cefe1955..b2911a5f 100644
--- a/src/reduce.sml
+++ b/src/reduce.sml
@@ -668,14 +668,23 @@ fun reduce file =
exp = fn (_, n) => n + 1} 0
fun mayInline (polyC, n, t, e) =
- case IM.find (uses, n) of
- NONE => false
- | SOME count => count <= 1
- orelse (case #1 e of
- ERecord _ => true
- | _ => false)
- orelse isPoly polyC t
- orelse size e <= Settings.getCoreInline ()
+ let
+ fun isPolicy t =
+ case #1 t of
+ CFfi ("Basis", "sql_policy") => true
+ | TFun (_, t) => isPolicy t
+ | _ => false
+ in
+ case IM.find (uses, n) of
+ NONE => false
+ | SOME count => count <= 1
+ orelse (case #1 e of
+ ERecord _ => true
+ | _ => false)
+ orelse isPolicy t
+ orelse isPoly polyC t
+ orelse size e <= Settings.getCoreInline ()
+ end
fun doDecl (d as (_, loc), st as (polyC, namedC, namedE)) =
case #1 d of