Merge pull request #131 from billhails/pettersson

Pettersson

.gitignore

@@ -8,6 +8,7 @@ tmp_scm/
 cekf
 pratt_test
 tags
+xref
 .generated
 .*.swp
 .$*.drawio.*

Makefile

@@ -23,7 +23,7 @@ ifeq ($(MODE),production)
 	CCMODE:= -O2
 	EXTRA_DEFINES:= -DPRODUCTION_BUILD -DBUILD_MODE=2
 else
-$(error invalid MODE $(MODE))
+$(error invalid MODE=$(MODE), allowed values: debugging, testing or production)
 endif
 endif
 endif
@@ -145,6 +145,9 @@ $(EXTRA_DOCS): docs/generated/%.md: src/%.yaml tools/makeAST.py src/primitives.y
 tags: src/* $(EXTRA_TARGETS)
 	ctags src/* $(EXTRA_TARGETS)
 
+xref: src/* $(EXTRA_TARGETS)
+	ctags -x src/* $(EXTRA_TARGETS) > $@
+
 $(MAIN_OBJ) $(OBJ): obj/%.o: src/%.c | obj
 	$(CC) $(INCLUDE_PATHS) -c $< -o $@
 
@@ -193,7 +196,7 @@ generated/UnicodeDigits.inc: unicode/UnicodeData.txt tools/makeUnicodeDigits.py
 	$(PYTHON) ./tools/makeUnicodeDigits.py > $@
 
 realclean: clean
-	rm -rf tags unicode
+	rm -rf tags xref unicode
 
 clean: deps
 	rm -rf $(TARGET) obj callgrind.out.* generated $(TEST_TARGETS) .typedefs src/*~ .generated gmon.out *.fnc core.*

docs/generated/anf.md

@@ -25,8 +25,6 @@ AexpAnnotatedVar --var--> HashSymbol
 AexpPrimApp --type--> AexpPrimOp
 AexpPrimApp --exp1--> Aexp
 AexpPrimApp --exp2--> Aexp
-AexpUnaryApp --type--> AexpUnaryOp
-AexpUnaryApp --exp--> Aexp
 AexpList --exp--> Aexp
 AexpList --next--> AexpList
 AexpIntList --integer--> int
@@ -80,7 +78,6 @@ Aexp --biginteger--> MaybeBigInt
 Aexp --littleinteger--> int
 Aexp --character--> character
 Aexp --prim--> AexpPrimApp
-Aexp --unary--> AexpUnaryApp
 Aexp --makeVec--> AexpMakeVec
 Aexp --namespaces--> AexpNamespaces
 Cexp --back--> void_ptr
@@ -101,7 +98,6 @@ Exp --let--> ExpLet
 Exp --lookup--> ExpLookup
 AexpAnnotatedVarType["enum AexpAnnotatedVarType"]
 AexpPrimOp["enum AexpPrimOp"]
-AexpUnaryOp["enum AexpUnaryOp"]
 AexpNamespaceArray["AexpNamespaceArray[]"] --entries--> AexpNamespace
 CTEnvArray["CTEnvArray[]"] --entries--> CTEnv
 CexpCondCasesVal

docs/generated/builtins.md

@@ -12,6 +12,7 @@ BuiltIn --implementation--> void_ptr
 BuiltInImplementation --implementation--> void_ptr
 BuiltInImplementation --nargs--> int
 BuiltInMemBuf --buffer--> string
+BuiltInMemBuf --index--> index
 BuiltInMemBuf --size--> size
 BuiltInArgs["BuiltInArgs[]"] --entries--> TcType
 BuiltIns["BuiltIns[]"] --entries--> BuiltIn

docs/generated/lambda.md

@@ -16,8 +16,6 @@ LamVarList --next--> LamVarList
 LamPrimApp --type--> LamPrimOp
 LamPrimApp --exp1--> LamExp
 LamPrimApp --exp2--> LamExp
-LamUnaryApp --type--> LamUnaryOp
-LamUnaryApp --exp--> LamExp
 LamSequence --exp--> LamExp
 LamSequence --next--> LamSequence
 LamList --exp--> LamExp
@@ -116,7 +114,6 @@ LamExp --var--> HashSymbol
 LamExp --stdint--> int
 LamExp --biginteger--> MaybeBigInt
 LamExp --prim--> LamPrimApp
-LamExp --unary--> LamUnaryApp
 LamExp --list--> LamSequence
 LamExp --makeVec--> LamMakeVec
 LamExp --construct--> LamConstruct
@@ -156,7 +153,6 @@ LamInfo --typeConstructorInfo--> LamTypeConstructorInfo
 LamInfo --namespaceInfo--> LamContext
 LamInfo --nsid--> int
 LamPrimOp["enum LamPrimOp"]
-LamUnaryOp["enum LamUnaryOp"]
 LamNamespaceArray["LamNamespaceArray[]"] --entries--> LamExp
 LamExpVal
 LamExpType

fn/dictionary.fn

@@ -32,7 +32,7 @@ print Dict(pt, pu, d) {
         d;
 }
 
-unsafe fn foreach {
+fn foreach {
     (_, E) | (_, EE) { nothing }
     (f, D(_, l, #(t, u), r)) {
         foreach(f, l);
@@ -42,6 +42,26 @@ unsafe fn foreach {
     }
 }
 
+fn keys (d) {
+    let fn h {
+        (E, lst) | (EE, lst) { lst }
+        (D(_, l, #(k, _), r), lst) {
+            h(l, k @ h(r, lst))
+        }
+    }
+    in h(d, [])
+}
+
+fn values (d) {
+    let fn h {
+        (E, lst) | (EE, lst) { lst }
+        (D(_, l, #(_, v), r), lst) {
+            h(l, v @ h(r, lst))
+        }
+    }
+    in h(d, [])
+}
+
 fn balance {
     (B, D(R, D(R, a, x, b), y, c), z, d)  |
     (B, D(R, a, x, D(R, b, y, c)), z, d)  |
@@ -53,7 +73,7 @@ fn balance {
 }
 
 // #t -> Dict(#t, #u) -> Maybe(#u)
-unsafe fn lookup {
+fn lookup {
     (_, E) | (_, EE) { nothing }
     (x, D(_, _, #(x, y), _)) { some(y) }
     (x, D(_, a, #(y, _), b)) {
@@ -72,7 +92,7 @@ fn insert(x, v, s) {
             (D(R, a, x, t=D(R, _, _, _))) { D(B, a, x, t) }
             (t) { t }
         }
-        unsafe fn ins {
+        fn ins {
             (x, EE) | (x, E) { D(R, E, #(x, v), E) }
             (x, D(c, a, #(x, _), b)) { D(c, a, #(x, v), b) }
             (x, D(color, a, s=#(y, _), b)) {
@@ -89,7 +109,7 @@ fn insert(x, v, s) {
 
 fn delete(x, s) {
     let
-        unsafe fn del {
+        fn del {
             (_, EE, throw) | (_, E, throw) { throw(s) }
             (x, D(R, E, #(x, _), E), _) { E }
             (x, D(B, E, #(x, _), E), _) { EE }
@@ -152,5 +172,5 @@ fn delete(x, s) {
 }
 
 fn make (keys, values) {
-    list.foldl(unsafe fn (#(k, v), d) { insert(k, v, d) }, E, list.zip(keys, values))
+    list.foldl(fn (#(k, v), d) { insert(k, v, d) }, E, list.zip(keys, values))
 }

fn/fns.fn

@@ -0,0 +1 @@
+print (car of cdr of cdr)([[], [], ['a']]);

fn/listutils.fn

@@ -7,6 +7,18 @@ fn member {
     (x, _ @ t) { member(x, t) }
 }
 
+// unique: list(#a) -> list(#a)
+fn unique {
+    ([]) { [] }
+    (h @ t) {
+        if (member(h, t)) {
+            unique(t)
+        } else {
+            h @ unique(t)
+        }
+    }
+}
+
 // exclude: list(#t) -> list(#t) -> list(#t)
 fn exclude {
     (items, []) { [] }
@@ -59,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
@@ -82,22 +97,61 @@ fn scanl (func, acc, lst) {
     in scan([acc], lst)
 }
 
-// filter: (#a -> bool) list(#a) -> list(#a)
-// TCO, but does not preserve order
-fn filter(func, lst) {
+// filter: (#a -> bool) -> list(#a) -> list(#a)
+fn filter {
+    (f, []) { [] }
+    (f, h @ t) {
+        if (f(h)) {
+            h @ filter(f, t)
+        } else {
+            filter(f, t)
+        }
+    }
+}
+
+// filter_out: (#a -> bool) -> list(#a) -> list(#a)
+fn filter_not (f, l) {
+    filter(fn (x) { not f(x) }, l)
+}
+
+// indices: (#a -> bool) -> list(#a) -> list(number)
+// like filter but returns the indices of the matching elements
+fn indices(f, lst) {
     let
         fn helper {
-            ([], res) { res }
-            (h @ t, res) {
-                if (func(h)) {
-                    helper(t, h @ res)
+            ([], _) { [] }
+            (h @ t, n) {
+                if (f(h)) {
+                    n @ helper(t, n + 1)
                 } else {
-                    helper(t, res)
+                    helper(t, n + 1)
                 }
             }
         }
     in
-        helper(lst, [])
+        helper(lst, 0)
+}
+
+// nths: list(number) -> list(#a) -> list(#a)
+fn nths (indices, lst) {
+    map(fn (n) { nth(n, lst) }, indices)
+}
+
+// except_nth: number -> list(#a) -> list(#a)
+fn except_nth (index, lst) {
+    let
+        fn helper {
+            ([], _) { [] }
+            (h @ t, n) {
+                if (n == index) {
+                    helper(t, n + 1)
+                } else {
+                    h @ helper(t, n + 1)
+                }
+            }
+        }
+    in
+        helper(lst, 0)
 }
 
 // concat: list(list(#a)) -> list(#a)
@@ -149,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
@@ -175,8 +230,19 @@ fn zipWith {
     (_, _, _) { [] }
 }
 
+// unzip: list(#(#a, #b)) -> #(list(#a), list(#b))
+fn unzip {
+    ([]) { #([], []) }
+    (#(x, y) @ rest) {
+        switch (unzip(rest)) {
+            (#(xs, ys)) { #(x @ xs, y @ ys) }
+        }
+    }
+}
+
 // last: list(#a) -> #a
-unsafe fn last {
+fn last {
+    ([]) { error("last") }
     ([a]) { a }
     (_ @ t) { last(t) }
 }

fn/rewrite/README.md

@@ -0,0 +1,14 @@
+# Rewrite
+
+An exploratory sub-project to investigate re-writing F♯ in F♯. For
+this to be practical we would need to target LLVM rather than a bytecode
+interpreter.
+
+* [ceskf.fn](ceskf.fn) - The core CESKF machine.
+* [infer.fn](infer.fn) - Type inference.
+* [interpreter.fn](interpreter.fn) - A naïve lambda interpreter demo.
+* [normalize.fn](normalize.fn) - ANF conversion.
+* [petterson92.fn](petterson92.fn) - Pettersson's Term Pattern Matching Compiler algorithm.
+* [pratt.fn](pratt.fn) - Pratt Parser.
+   * [pratt_lexer.fn](pratt_lexer.fn) - Lexer Support for the Parser.
+   * [pratt_sexpr.fn](pratt_sexpr.fn) - Target Symbolic Expressions for the parser.

fn/ceskf.fn → fn/rewrite/ceskf.fn

@@ -22,7 +22,7 @@
 // in a purely functional language. It does include the Fail register though,
 // making this technically a CESKF machine
 let
-    link "listutils.fn" as list;
+    link "../listutils.fn" as list;
 
     typedef prim { add | sub | mul | div }
 
@@ -142,11 +142,11 @@ let
         (Σ(cexp(letrec(bindings, body)), ρ, σ, κ, ς)) {
             let
                 inds = indices(bindings, σ);
-                ks = list.map(unsafe fn (#(k, _)) { k }, bindings);
+                ks = list.map(fn (#(k, _)) { k }, bindings);
                 e = zipEnv(ks, inds, ρ);
                 tempStore = list.repeat_prefix(list.length(inds), f, σ);
                 s = list.map_prefix(A(e, tempStore),
-                                    list.map(unsafe fn (#(_, v)) { v }, bindings),
+                                    list.map(fn (#(_, v)) { v }, bindings),
                                     σ);
             in
                 Σ(body, e, s, κ, ς)