dhil · yallop · Sep 13, 2017 · Sep 15, 2017 · Sep 15, 2017 · Sep 15, 2017
diff --git a/benchmarks/environments/Dockerfile.base b/benchmarks/environments/Dockerfile.base
@@ -0,0 +1,6 @@
+# An image with various build packages that we'll need to build everything else
+
+FROM debian:sid
+
+RUN apt-get update
+RUN apt-get install --yes wget git subversion python pkg-config clang make cmake opam libicu-dev g++ lsb-release sudo
diff --git a/benchmarks/environments/Dockerfile.js b/benchmarks/environments/Dockerfile.js
@@ -0,0 +1,56 @@
+FROM links-handlers-base
+
+#
+# v8
+#
+RUN git clone https://chromium.googlesource.com/chromium/tools/depot_tools.git /depot_tools
+ENV PATH=/depot_tools:$PATH
+RUN fetch v8
+WORKDIR /v8
+RUN git fetch --all
+RUN git checkout -b v6.2 branch-heads/6.2
+
+RUN gclient config https://chromium.googlesource.com/v8/v8
+RUN gclient runhooks
+RUN gclient sync
+
+RUN ./build/install-build-deps.sh   --no-arm   --no-chromeos-fonts   --no-nacl --no-syms --no-prompt
+RUN tools/dev/v8gen.py -vv x64.release
+
+RUN find . -type f -print0 | xargs -0 sed -i 's!-Werror!-Wall!g'
+
+# RUN ninja -C out.gn/x64.release d8
+# (This fails with segmentation faults.)
+# RUN make_bin "$CWD/$v8dir/out.gn/x64.release/d8" "d8"
+
+#
+# JavaScriptCore / webkit
+#
+WORKDIR /
+#RUN svn checkout -q https://svn.webkit.org/repository/webkit/releases/WebKitGTK/webkit-2.18.0/
+#WORKDIR webkit-2.18.0
+#RUN Tools/Scripts/build-webkit --jsc-only --release
+ADD https://webkitgtk.org/releases/webkitgtk-2.19.91.tar.xz /webkitgtk-2.19.91.tar.xz 
+RUN tar xfJ webkitgtk-2.19.91.tar.xz 
+WORKDIR /webkitgtk-2.19.91
+RUN mkdir PerformanceTests && touch PerformanceTests/CMakeLists.txt
+RUN cmake  -DPORT=JSCOnly -GNinja
+# RUN ninja
+# This fails with:
+#
+#   collect2: error: ld returned 1 exit status
+
+#
+# node.js
+#
+RUN apt-get install nodejs
+
+#
+# chakracore
+#
+# (TODO)
+
+#
+# spidermonkey
+#
+# (TODO)
diff --git a/benchmarks/environments/Makefile b/benchmarks/environments/Makefile
@@ -0,0 +1,9 @@
+VARIANTS=base js # links tests
+IMAGES=$(foreach variant,$(VARIANTS),links-handlers-$(variant))
+
+all: $(IMAGES)
+
+links-handlers-%:
+	docker build -t $@ -f Dockerfile.$* .
+
+.PHONY: links-handlers-%
diff --git a/benchmarks/environments/NOTES.md b/benchmarks/environments/NOTES.md
@@ -0,0 +1,11 @@
+Plan: build everything in layers
+
+base image: debian:sid
+next layer: development tools (opam, make, etc.)
+            (links-handlers-base Dockerfile.base)
+next layer: js runtime(s)
+            (links-handlers-js Dockerfile.js)
+next layer: links build
+            (links-handlers-links Dockerfile.links)
+next layer: test cases
+            (links-handlers-tests Dockerfile.tests)
diff --git a/benchmarks/handlers/js/aop.links b/benchmarks/handlers/js/aop.links
@@ -0,0 +1,204 @@
+# Aspect oriented programming
+# Microbenchmark adapted from Kammar et al. (2013)
+
+typename Zero = [||];
+
+typename Comp(e::Row,a) = (() ~e~> a);
+
+sig runState :
+        (Comp ({Get:s,  Put:(s) {}-> ()|e}, a)) ->
+  (s) -> Comp ({Get{_}, Put{_}         |e}, (a, s))
+fun runState(m)(st)() {
+  var st = ref(st);
+  handle(m()) {
+     case Return(x)      -> (x, deref(st))
+     case Get(resume)    -> resume(deref(st))
+     case Put(p, resume) -> st := p; resume(())
+  }
+}
+
+sig evalState :
+        (Comp ({Get:s,  Put:(s) {}-> ()|e}, a)) ->
+  (s) -> Comp ({Get{_}, Put{_}         |e}, a)
+fun evalState(m)(s)() { runState(m)(s)().1 }
+
+sig runStringWriter :
+             (Comp ({Tell:(String) {}-> ()|e}, a)) ->
+  (String) -> Comp ({Tell{_}              |e}, (a, String))
+fun runStringWriter(m)(st)() {
+  var st = ref(st);
+  handle(m()) {
+     case Return(x )      -> (x, deref(st))
+     case Tell(t, resume) -> st := deref(st) ^^ t; resume(())
+  }
+}
+
+sig printer :
+  (Comp ({Tell:(String) {}-> ()}, a)) {}~> a
+fun printer(m) {
+  handle(m()) {
+     case Return(x) -> x
+     case Tell(s, resume) -> print(s); resume(())
+  }
+}
+
+sig get : () {Get:s|_}-> s
+fun get() {do Get}
+
+sig put : (s) {Put:(s) {}-> ()|_}-> ()
+fun put(s) {do Put(s)}
+
+sig tell : (String) {Tell:(String) {}-> ()|_}-> ()
+fun tell(s) {do Tell(s)}
+
+typename Expr =
+  [| Lit : Int
+   | Var : String
+   | Plus : (Expr, Expr)
+   | Assign : (String, Expr)
+   | Sequence : [Expr]
+   | While : (Expr, Expr)
+   |];
+
+fun showExpr(e) {
+  switch (e) {
+    case Lit(i)        -> intToString(i)
+    case Var(x)        -> x
+    case Plus(l, r)    -> "(" ^^ showExpr(l) ^^ ")+(" ^^ showExpr(r) ^^ ")"
+    case Assign(x, e)  -> x ^^ " := " ^^ showExpr(e)
+    case Sequence(es)  ->
+      fun showExprs(es) {
+        switch (es) {
+          case []      -> ""
+          case [e]     -> showExpr(e)
+          case (e::es) -> showExpr(e) ^^ ", " ^^ showExprs(es)
+        }
+      }
+      "[" ^^ showExprs(es) ^^ "]"
+    case While(c, b)   -> "while (" ^^ showExpr(c) ^^ ") {" ^^ showExpr(b) ^^ "}"
+  }
+}
+
+typename SComp(e::Row, a) =
+  Comp ({Suspend:(Expr, SComp({ |e}, a)) {}-> a |e}, a);
+
+sig suspend :
+  forall e::Row, a.
+    (Expr) ->
+      (SComp({ |e}, a))
+        {Suspend:(Expr, SComp({ |e}, a)) {}-> a|e}~> a
+fun suspend(e)(m) {do Suspend(e, m)}
+
+typename Env = [(String, Int)];
+fun showEnv(env) {
+  fun showEntry((x, i)) {x ^^ "=" ^^ intToString(i)}
+
+  fun showEntries(es) {
+    switch(es) {
+      case []      -> ""
+      case [e]     -> showEntry(e)
+      case (e::es) -> showEntry(e) ^^ "; " ^^ showEntries(es)
+    }
+  }
+  "{" ^^ showEntries(env) ^^ "}"
+}
+
+sig lookup : (a, [(a,b)]) ~> Maybe(b)
+fun lookup(y, elems) {
+  switch (elems) {
+    case [] -> Nothing
+    case (x,e) :: elems ->
+      if (x == y) Just(e)
+      else lookup(y, elems)
+  }
+}
+
+sig bevalStep :
+  (Expr) -> SComp ({Get:Env, Put: (Env) {}-> () |e}, Int)
+fun bevalStep(exp)() {
+  switch(exp) {
+    case Lit(x) -> x
+    case Var(x) ->
+      switch (lookup(x, get())) {
+        case Just(v) -> v
+        case Nothing -> error("variable: " ^^ x ^^ " not found!")
+      }
+    case Plus(l, r) -> beval(l) + beval(r)
+    case Assign(x, e) ->
+      var v = beval(e);
+      put ((x, v) :: get());
+      v
+    case Sequence([])    -> 0
+    case Sequence([e])   -> beval(e)
+    case Sequence(e::es) ->
+      ignore(beval(e)); beval (Sequence(es))
+    case While(c, b)     ->
+      if (beval(c) == 0) {
+        0
+      } else {
+        ignore(beval(b)); beval(exp)
+      }
+  }
+}
+
+sig beval : (Expr) {Get:Env,
+                    Put:(Env) {}-> (),
+                    Suspend:(Expr, SComp({Get:Env,
+                                          Put:(Env) {}-> ()|e}, Int)) {}-> Int|e}~> Int
+fun beval(e) {suspend(e)(bevalStep(e))}
+
+var beval = fun (e)() {beval(e)};
+
+sig force :
+(SComp({          |e}, a)) ~>
+  Comp({Suspend{_}|e}, a)
+fun force(m)() {
+  handle(m()) {
+    case Return(x)        -> x
+    case Suspend(e, m, k) -> k (force(m)())
+  }
+}
+
+sig logger :  (SComp ({Tell:(String) {}-> ()|e}, Int)) ->
+  (String) -> (SComp ({Tell:(String) {}-> ()|e}, Int))
+fun logger(m)(name)() {
+  (handle(m()) {
+     case Return(x)        -> fun (_) {x}
+     case Suspend(e, m, k) ->
+       fun (name) {
+         tell("Entering " ^^ name ^^ " with " ^^ showExpr(e) ^^ "\n");
+         var y = suspend(e)(logger(m)(name));
+         tell("Exiting " ^^ name ^^ " with " ^^ intToString(y) ^^ "\n");
+         k(y)(name)
+       }
+   })(name)
+}
+
+sig dump : (SComp ({Get:Env, Tell:(String) {}-> ()|e}, Int)) ->
+           (SComp ({Get:Env, Tell:(String) {}-> ()|e}, Int))
+fun dump(m)() {
+  handle(m()) {
+    case Return(x)        -> x
+    case Suspend(e, m, k) ->
+      tell(showEnv(get()));
+      k(suspend(e)(dump(m)))
+  }
+}
+
+sig e1 : Expr
+var e1 = Plus (Lit(3), Lit(4));
+sig e2 : Expr
+var e2 = Plus (Assign("x", Lit(3)), Assign("y", Lit(4)));
+sig e3 : Expr
+var e3 = Plus (Plus(Assign ("x", Lit(3)), Assign("y", Lit(4))), Plus (Var("x"), Var("y")));
+
+fun test0(e) {printer(evalState (force (beval(e)))([]))}
+fun test1(e) {printer(evalState (force (logger (beval(e))("eval")))([]))}
+fun test2(e) {printer(evalState (force (dump (beval(e))))([]))}
+fun test3(e) {printer(evalState (force (dump (logger (beval(e))("eval"))))([]))}
+
+fun main() {
+   ignore (map(fun(f) { assert((==), intToString, 7, f(e1)) }, [test0, test1, test2, test3]))
+}
+
+