support aliasing and comparison

billhails · Nov 27, 2024 · 165fd0c · 165fd0c
1 parent d6f0200
commit 165fd0c
Show file tree

Hide file tree

Showing 3 changed files with 44 additions and 48 deletions.
diff --git a/fn/listutils.fn b/fn/listutils.fn
@@ -71,8 +71,11 @@ fn foldr(func, acc, lst) {
 }
 
 // foldl1 (#a -> #a -> #a) -> list(#a) -> #a
-unsafe fn foldl1(func, h @ t) {
-    foldl(func, h, t)
+fn foldl1 {
+    (func, h @ t) {
+        foldl(func, h, t)
+    }
+    (_, _) { error("foldl1") }
 }
 
 // foldr1 (#a -> #a -> #a) -> list(#a) -> #a
@@ -200,9 +203,10 @@ fn repeat_prefix(n, v, tail) {
 }
 
 // nth: number -> list(#a) -> #a
-unsafe fn nth {
+fn nth {
     (0, h @ _) { h }
     (n, _ @ t) { nth(n - 1, t) }
+    (_, _) { error("nth") }
 }
 
 // sum: list(number) -> number
@@ -237,7 +241,8 @@ fn unzip {
 }
 
 // last: list(#a) -> #a
-unsafe fn last {
+fn last {
+    ([]) { error("last") }
     ([a]) { a }
     (_ @ t) { last(t) }
 }

diff --git a/fn/pettersson92.fn b/fn/pettersson92.fn
@@ -20,7 +20,9 @@ let
         const(number) |
         ctor(string, list(pattern)) |
         tuple(list(pattern)) |
-        tagged(string, pattern)
+        named(string, pattern) | // input name=pattern
+        comparison(string) |     // output re-used variable in subsequent pattern
+        tagged(string, pattern)  // output tag=pattern
     }
 
     print pattern(p) {
@@ -33,6 +35,7 @@ let
             fn h {
                 (wildcard) { puts("_") }
                 (variable(name)) { puts('$' @ name) }
+                (comparison(tag)) { puts("="); puts(tag) }
                 (const(n)) { puts($n) }
                 (ctor(tag, pats)) {
                     puts(tag);
@@ -43,6 +46,7 @@ let
                 (tuple(pats)) {
                     puts("#("); i(pats); puts(")")
                 }
+                (named(name, p)) { puts('$' @ name); puts(":="); h(p) }
                 (tagged(tag, p)) { puts(tag); putc('='); h(p) }
             }
         in h(p); p
@@ -154,8 +158,15 @@ let
                                 #(tagged(base, wildcard), d)
                             }
                             (base, variable(name), d) {
-                                #(tagged(base, wildcard),
-                                  dict.insert(name, base, d))
+                                switch (dict.lookup(name, d)) {
+                                    (nothing) {
+                                        #(tagged(base, wildcard),
+                                          dict.insert(name, base, d))
+                                    }
+                                    (some(other)) {
+                                        #(tagged(base, comparison(other)), d)
+                                    }
+                                }
                             }
                             (base, c = const(_), d) {
                                 #(tagged(base, c), d)
@@ -172,6 +183,12 @@ let
                                     #(tagged(base, tuple(pats)), d)
                                 }
                             }
+                            (base, named(name, pat), d) {
+                                tag(base, pat, dict.insert(name, base, d))
+                            }
+                            (_, comparison(t), _) {
+                                error("already compared: " @@ t)
+                            }
                             (_, tagged(t, _), _) {
                                 error("already tagged: " @@ t)
                             }
@@ -370,6 +387,7 @@ let
             ctorsAreExhaustive(arcs)
         }
         (arc(tagged(_, const(_)), _, _) @ _) { false }
+        (arc(tagged(_, comparison(_)), _, _) @ _) { false }
         (_) { true }
     }
 
@@ -413,6 +431,7 @@ let
         (tagged(_, ctor(_, l))) |
         (tagged(_, tuple(l))) { lst.length(l) }
         (tagged(_, const(_))) { 0 }
+        (tagged(_, comparison(_))) { 0 }
         (x) { error("arity failed on " @@ $x) }
     }
 
@@ -422,7 +441,8 @@ let
             fn ctorMatches {
                 (tagged(_, const(n)), tagged(_, const(n))) { true }
                 (tagged(_, ctor(s, _)), tagged(_, ctor(s, _))) { true }
-                (tagged(_, tuple(_)), tagged(_, tuple(_))) { true }
+                (tagged(_, tuple(a)), tagged(_, tuple(b))) { lst.length(a) == lst.length(b) }
+                (_, tagged(_, comparison(_))) { true }
                 (_, tagged(_, wildcard)) { true }
                 (_, _) { false }
             }
@@ -444,6 +464,7 @@ let
         (tagged(_, ctor(_, _))) { false }
         (tagged(_, tuple(_))) { false }
         (tagged(_, const(_))) { false }
+        (tagged(_, comparison(_))) { false }
         (_) { true }
     }
 
@@ -530,9 +551,9 @@ let
             fn calculateFreeArc (arc(pat, _, s)) {
                 let s2 = calculateFree(s);
                     fn arcFree (pat, s3) {
-                        // varsInPat: pattern -> list(string)
                         let
-                            unsafe fn varsInPat {
+                            // varsInPat: pattern -> list(string)
+                            fn varsInPat {
                                 (tagged(x, ctor(_, args))) {
                                     x @ ((args |> varsInPat) =>
                                             lst.concat)
@@ -542,6 +563,7 @@ let
                                             lst.concat)
                                 }
                                 (tagged(x, _)) { [x] }
+                                (x) { error($x) }
                             }
                             // freeVarsInState: tpmc -> list(string)
                             fn freeVarsInState {
@@ -587,14 +609,14 @@ let
             fn translateState {
                 (final(stamp, free, rc, _, code)) {
                     if (rc > 1) {
-                        apply(symbol(stamp), free |> fn(s){symbol(s)})
+                        apply(symbol(stamp), free |> fn (s) { symbol(s) })
                     } else {
                         code
                     }
                 }
                 (test(stamp, var, free, rc, arcs)) {
                     if (rc > 1) {
-                        apply(symbol(stamp), free |> fn(s){symbol(s)})
+                        apply(symbol(stamp), free |> fn (s) { symbol(s) })
                     } else {
                         case(symbol(var), arcs |> translateArc)
                     }
@@ -643,15 +665,15 @@ let
             [
                 variable("base"),
                 const(1),
-                tuple([variable("d"), const(3)]),
+                named("c", tuple([variable("d"), const(3)])),
                 ctor("cons", [variable("pat"), variable("pats")])
             ],
-            apply(symbol("cons"), [symbol("pat"), symbol("pats")])
+            apply(symbol("c"), [symbol("pat"), symbol("pats")])
         ),
         #(
             [
                 wildcard,
-                wildcard,
+                variable("d"),
                 tuple([variable("d"), wildcard]),
                 ctor("nil", [])
             ],
@@ -667,36 +689,3 @@ in
     print input => rename => match => countStates =>
           transferRefCountsToStates => calculateFreeVariables =>
           translate(input)
-
-// lambda(
-//     [ symbol("x$0"), symbol("x$1"), symbol("x$2"), symbol("x$3") ],
-//     letrec([
-//         #(symbol("Q$1"), lambda([symbol("x$2$0")], symbol("x$2$0"))),
-//         #(symbol("error"), lambda([], symbol("error")))],
-//         case(symbol("x$1"), [
-//             when(x$1=1,
-//                 case(symbol("x$2"), [
-//                     when(x$2=#(x$2$0=_, x$2$1=_),
-//                         case(symbol("x$3"), [
-//                             when(x$3=cons(x$3$0=_, x$3$1=_),
-//                                 case(symbol("x$2$1"), [
-//                                     when(x$2$1=3,
-//                                         apply(symbol("cons"), [
-//                                             symbol("x$3$0"),
-//                                             symbol("x$3$1")])),
-//                                     when(x$2$1=_,
-//                                         apply(symbol("error"),
-//                                             []))])),
-//                             when(x$3=nil,
-//                                 apply(symbol("Q$1"),
-//                                     [symbol("x$2$0")]))]))])),
-//             when(x$1=_,
-//                 case(symbol("x$2"), [
-//                     when(x$2=#(x$2$0=_, x$2$1=_),
-//                         case(symbol("x$3"), [
-//                             when(x$3=nil,
-//                                 apply(symbol("Q$1"),
-//                                     [symbol("x$2$0")])),
-//                             when(x$3=_,
-//                                 apply(symbol("error"),
-//                                     []))]))]))])))
diff --git a/src/pratt_scanner.c b/src/pratt_scanner.c
@@ -734,6 +734,8 @@ static PrattToken *parseString(PrattParser *parser, bool single, char sep) {
                     state = PRATTSTRINGSTATE_TYPE_END;
                 } else {
                     parserError(parser, "expected terminator");
+                    ++buffer->length;
+                    state = PRATTSTRINGSTATE_TYPE_END;
                 }
                 break;
             case PRATTSTRINGSTATE_TYPE_END: