fixes

danyaberezun · May 13, 2024 · af15923 · af15923
1 parent 49ede27
commit af15923
Show file tree

Hide file tree

Showing 2 changed files with 17 additions and 21 deletions.
diff --git a/src/Expr.lama b/src/Expr.lama
@@ -110,6 +110,7 @@ fun addDefs (state, defs) {
     case def of
         Fun (name, args, body) -> addFunction(s, name, args, body)
       | Var (vars) -> addNames(s, vars)
+      | Val (vars) -> addNames(s, vars)
     esac
   }, state, defs)
 }
@@ -226,40 +227,35 @@ fun eval (c@[s, w], expr) {
 }
 
 fun chooseBranch(c, x, [p, code] : branches) {
-  if (matches(lookup(c, x), p)) 
+  if (matches(x, p)) 
     then eval(c, code)
     else chooseBranch(c, x, branches)
   fi
 }
 
 fun matches(value, pat) {
-  fun matchList(values, patterns) {
-    case values of 
-      v : values -> 
-        case patterns of 
-          p : patterns -> 
-            if matches(v, p) then matchList(values, patterns) else 0 fi       
-        esac
-    | [] -> 1
-    esac
+  fun compareLists(patts, vals) {
+    if (patts.size != vals.size) then
+      false
+    else foldl (fun (acc, [pat, vall]) {
+    if acc then matches(vall, pat) else false fi
+    }, true, zip (patts, vals))
+    fi
   }
   case pat of 
     Wildcard -> true  
-    | Named(_, pat) -> matches(value, pat)
+    | Named(_, patt) -> matches(value, patt)
     | Const(value) -> true
     | Sexp(ptag, pats) -> 
       case value of 
         Sexp(vtag, vals) -> 
-          case arrayList(vals) of 
-            vals -> 
-              (compare(ptag, vtag) == 0) && pats.size == vals.size && matchList(vals, pats)
-          esac
+          (compare(ptag, vtag) == 0) && compareLists(pats, arrayList(vals))
         | _ -> false
        esac
     | Array(pats) -> 
       case value of 
         Array(vals) -> 
-          pats.size == vals.size && matchList(vals, pats)
+          compareLists(pats, arrayList(vals))
       | _ -> false
       esac
   esac

diff --git a/src/Parser.lama b/src/Parser.lama
@@ -279,10 +279,10 @@ var
       }
     } | 
 
-    loc=pos kCase e=expr kOf brs=branches kEsac {
+    loc=pos kCase e=exp kOf brs=branches kEsac {
       fun(a) {
-        e(Val) =>> fun(e) {
-          freshName =>> fun(name) {
+        freshName =>> fun(name) {
+          e(Val) =>> fun(e) {
             brs(a) => fun(brs) {
               Scope({ Var({name}) }, 
                 Seq(Ignore(Assn(Ref(name), e)), Case (name, reifyPatternBindings(name, brs)))
@@ -301,7 +301,7 @@ var
     loc=pos s["_"] { fun(a) {returnST $ Wildcard} } | 
 
     loc=pos name=lident { fun(a) {returnST $ Named(name, Wildcard)} } | 
-    loc=pos name=lident p=(-s["@"] pattern) { fun(a) { p(Val) => fun(p) {returnST $ Named(name, p)} } } | 
+    loc=pos name=lident p=(-s["@"] pattern) { fun(a) { p(Val) =>> fun(p) {returnST $ Named(name, p)} } } | 
 
     loc=pos x=decimal { fun(a) { assertValue(a, returnST $ Const (stringInt (x)) , loc) } } | 
 
@@ -321,7 +321,7 @@ var
   ), 
 
   branch = memo $ eta syntax (
-    loc=pos p=pattern s["->"] s=scopeExpr { fun(a) { p(a) =>> fun(p) { s(a) => fun(s) { returnST $ [p, s] } } } }
+    loc=pos p=pattern s["->"] s=scopeExpr { fun(a) { p(Val) =>> fun(p) { s(a) =>> fun(s) { returnST $ [p, s] } } } }
   ),
   branches = memo $ eta syntax (
     loc=pos brs=listBy[branch, s("|")] { fun(a) { chainST(map(fun(br) {br(a)}, brs)) } }