From 5053cc1cc65d193cc4d3298a9d2485c0139a9bf9 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adamc@hcoop.net>
Date: Tue, 22 Sep 2009 14:15:29 -0400
Subject: Compiled an 'option' pattern-match

---
 lib/js/urweb.js | 56 +++++++++++++++++++++++++++++++++++++++++++++++++++-----
 1 file changed, 51 insertions(+), 5 deletions(-)

(limited to 'lib/js/urweb.js')

diff --git a/lib/js/urweb.js b/lib/js/urweb.js
index 0cafd8f8..13f93867 100644
--- a/lib/js/urweb.js
+++ b/lib/js/urweb.js
@@ -803,6 +803,39 @@ function lookup(env, n) {
   throw "Out-of-bounds Ur variable reference";
 }
 
+function execP(env, p, v) {
+  switch (p.c) {
+  case "w":
+    return env;
+  case "v":
+    return cons(v, env);
+  case "c":
+    if (v == p.v)
+      return env;
+    else
+      return false;
+  case "s":
+    if (v == null)
+      return false;
+    else
+      return execP(env, p.p, p.n ? v.v : v);
+  case "1":
+    if (v.n != p.n)
+      return false;
+    else
+      return execP(env, p.p, v.v);
+  case "r":
+    for (var fs = p.l; fs != null; fs = fs.next) {
+      env = execP(env, fs.data.p, v["_" + fs.data.n]);
+      if (env == false)
+        return false;
+    }
+    return env;
+  default:
+    throw ("Unknown Ur pattern kind" + p.c);
+  }
+}
+
 function exec0(env, e) {
   var stack = null;
 
@@ -872,16 +905,25 @@ function exec0(env, e) {
         e = fr.e2;
         stack = stack.next;
         break;
-      case "=1":
-        env = cons(v, env);
-        e = fr.e2;
-        stack = stack.next;
-        break;
       case "=":
         env = cons(v, env);
         e = fr.e2;
         stack = cons({c: "a3", env: env}, stack.next);
         break;
+      case "m":
+        var ps;
+        for (ps = fr.p; ps != null; ps = ps.next) {
+          var r = execP(env, ps.data.p, v);
+          if (r != false) {
+            stack = cons({c: "a3", env: env}, stack.next);
+            env = r;
+            e = ps.data.b;
+            break;
+          }
+        }
+        if (ps == null)
+          throw "Match failure in Ur interpretation";
+        break;
       default:
         throw ("Unknown Ur continuation kind " + fr.c);
       }
@@ -936,6 +978,10 @@ function exec0(env, e) {
       stack = cons({c: "=", e2: e.e2}, stack);
       e = e.e1;
       break;
+    case "m":
+      stack = cons({c: "m", p: e.p}, stack);
+      e = e.e;
+      break;
     case "e":
       var env0 = env;
       var e0 = e.e;
-- 
cgit v1.2.3