summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adam@chlipala.net>2015-02-01 12:29:14 -0500
committerGravatar Adam Chlipala <adam@chlipala.net>2015-02-01 12:29:14 -0500
commit6413f39758d223c6763c4bbe708048b4e570a98e (patch)
treedf37df1329c579861b6337d2de241d67084f9618
parent1a063e0d926ebaf414349df3854af12369c81f5a (diff)
A new MonoReduce optimization for lifting 'let' out of field projection; JavaScript compilation for exponentiation
-rw-r--r--lib/js/urweb.js4
-rw-r--r--src/jscomp.sml2
-rw-r--r--src/mono_reduce.sml17
3 files changed, 19 insertions, 4 deletions
diff --git a/lib/js/urweb.js b/lib/js/urweb.js
index df9097b1..3bf21dd2 100644
--- a/lib/js/urweb.js
+++ b/lib/js/urweb.js
@@ -112,6 +112,10 @@ function round(n) {
return Math.round(n);
}
+function pow(n, m) {
+ return Math.pow(n, m);
+}
+
// Time, represented as counts of microseconds since the epoch
diff --git a/src/jscomp.sml b/src/jscomp.sml
index 1a476739..3709bcd3 100644
--- a/src/jscomp.sml
+++ b/src/jscomp.sml
@@ -724,6 +724,8 @@ fun process (file : file) =
| "<" => "lt"
| "<=" => "le"
| "strcmp" => "strcmp"
+ | "powl" => "pow"
+ | "powf" => "pow"
| _ => raise Fail ("Jscomp: Unknown binary operator " ^ s)
val (e1, st) = jsE inner (e1, st)
diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml
index 8ca84c15..39d02b99 100644
--- a/src/mono_reduce.sml
+++ b/src/mono_reduce.sml
@@ -818,10 +818,19 @@ fun reduce (file : file) =
search pes
end
- | EField ((ERecord xes, _), x) =>
- (case List.find (fn (x', _, _) => x' = x) xes of
- SOME (_, e, _) => #1 e
- | NONE => e)
+ | EField (e1, x) =>
+ let
+ fun yankLets (e : exp) =
+ case #1 e of
+ ELet (x, t, e1, e2) => (ELet (x, t, e1, yankLets e2), #2 e)
+ | ERecord xes =>
+ (case List.find (fn (x', _, _) => x' = x) xes of
+ SOME (_, e, _) => e
+ | NONE => (EField (e, x), #2 e))
+ | _ => (EField (e, x), #2 e)
+ in
+ #1 (yankLets e1)
+ end
| ELet (x1, t1, (ELet (x2, t2, e1, b1), loc), b2) =>
let