diff --git a/runtime/runtime.c b/runtime/runtime.c index 73dd2b802..336569bfa 100644 --- a/runtime/runtime.c +++ b/runtime/runtime.c @@ -517,7 +517,7 @@ void *Lclone (void *p) { return res; } -# define HASH_DEPTH 10 +# define HASH_DEPTH 3 # define HASH_APPEND(acc, x) (((acc + (unsigned) x) << (WORD_SIZE / 2)) | ((acc + (unsigned) x) >> (WORD_SIZE / 2))) int inner_hash (int depth, unsigned acc, void *p) { @@ -1163,7 +1163,7 @@ extern void __gc_root_scan_stack (); /* Mark-and-copy */ /* ======================================== */ -static size_t SPACE_SIZE = 32 * 1024; +static size_t SPACE_SIZE = 32 * 10240; // static size_t SPACE_SIZE = 128; // static size_t SPACE_SIZE = 1024 * 1024; diff --git a/stdlib/Collection.expr b/stdlib/Collection.expr index 701ce5f12..01ecfe8a5 100644 --- a/stdlib/Collection.expr +++ b/stdlib/Collection.expr @@ -5,6 +5,7 @@ -- data structures. import List; +import Ref; fun insertColl (m, pk, v, sort) { local k = case sort of Hash -> hash (pk) | _ -> pk esac; @@ -259,24 +260,24 @@ public fun foldSet (f, acc, s) { -- Hash consing public fun emptyMemo () { - [{}] + ref ({}) } public fun lookupMemo (m, v) { case v of #unboxed -> v | _ -> - case findMap (m[0], v) of + case findMap (deref (m), v) of Some (w) -> w | None -> case v of - #string -> m[0] := addMap (m[0], v, v); v + #string -> m ::= addMap (deref (m), v, v); v | _ -> local vc = clone (v), i = case vc of #fun -> 1 | _ -> 0 esac; for skip, i < v.length, i := i + 1 do vc [i] := lookupMemo (m, vc [i]) od; - m[0] := addMap (m[0], vc, vc); + m ::= addMap (deref (m), vc, vc); vc esac esac diff --git a/stdlib/Fun.expr b/stdlib/Fun.expr new file mode 100644 index 000000000..39587edca --- /dev/null +++ b/stdlib/Fun.expr @@ -0,0 +1,24 @@ +import Ref; + +public fun id (x) { + x +} + +public infixl $ after * (f, x) { + f (x) +} + +public infix # at $ (f, g) { + fun (x) { + f (g (x)) + } +} + +public fun fix (f) { + local knot = ref (0); + + knot ::= fun () {fun (x) {f (deref (knot) ()) (x)}}; + + + deref (knot) () +} \ No newline at end of file diff --git a/stdlib/Lazy.expr b/stdlib/Lazy.expr new file mode 100644 index 000000000..7ca2f270f --- /dev/null +++ b/stdlib/Lazy.expr @@ -0,0 +1,14 @@ +public fun lazy (f) { + local value, set = false; + + fun () { + if set + then value + else set := true; value := f (); value + fi + } +} + +public fun force (f) { + f () +} \ No newline at end of file diff --git a/stdlib/List.expr b/stdlib/List.expr index 26ebe507b..4c00190eb 100644 --- a/stdlib/List.expr +++ b/stdlib/List.expr @@ -1,3 +1,7 @@ +public fun list (x) { + x : {} +} + public fun size (l) { case l of {} -> 0 diff --git a/stdlib/Makefile b/stdlib/Makefile index e608e70c3..22a963340 100644 --- a/stdlib/Makefile +++ b/stdlib/Makefile @@ -6,10 +6,14 @@ RC=../src/rc.opt all: $(ALL) -Collection.o: List.o +Fun.o: Ref.o + +Collection.o: List.o Ref.o Array.o: List.o +Ostap.o: List.o Collection.o Ref.o Fun.o + %.o: %.expr $(RC) -I . -c $< diff --git a/stdlib/Ostap.expr b/stdlib/Ostap.expr new file mode 100644 index 000000000..6b3b8ad45 --- /dev/null +++ b/stdlib/Ostap.expr @@ -0,0 +1,178 @@ +import List; +import Collection; +import Ref; +import Fun; + +fun token_k (x) { + fun (k) { + fun (s) { + case s of + h : t -> if compare (h, x) == 0 then k (Succ (x, t)) else k (Fail ("expected " ++ x.string)) fi + | _ -> k (Fail ("expected " ++ x.string)) + esac + } + } +} + +fun token (x) { + fun (s) { + case s of + h : t -> if compare (h, x) == 0 then return Succ (list ([x, t]), {}) fi + | _ -> skip + esac; + Fail (list ("expected " ++ x.string)) + } +} + +fun eof_k (k) { + fun (s) { + case s of + {} -> k (Succ ({}, {})) + | _ -> k (Fail ("expected ")) + esac + } +} + +fun eof (s) { + case s of + {} -> Succ (list ([{}, {}]), {}) + | _ -> Fail (list ("expected ")) + esac +} + +fun empty_k (k) { + fun (s) {k (Succ ({}, s))} +} + +fun empty (s) { + Succ ({[{}, s]}, {}) +} + +infix ** at * (a, b) { + case [a, b] of + [Succ (r1, e1), Succ (r2, e2)] -> Succ (r1 +++ r2, e1 +++ e2) + | [Fail (e1) , Fail (e2) ] -> Fail (e1 +++ e2) + | [Succ (r1, e1), Fail (e2) ] -> Succ (r1, e1 +++ e2) + | [Fail (e1) , Succ (r2, e2)] -> Succ (r2, e1 +++ e2) + esac +} + +fun alt_k (a, b) { + fun (k) { + fun (s) { + a (k) (s); + b (k) (s) + } + } +} + +fun alt (a, b) { + fun (s) {a (s) ** b (s)} +} + +fun seq_nm (a, b) { + fun (k) { + fun (s) { + a (fun (ar) {case ar of Fail (_) -> k (ar) | Succ (x, s) -> b (k) (s) esac}) (s) + } + } +} + +fun seq_k (a, b) { + fun (k) { + fun (s) { + a (fun (ar) {case ar of Fail (_) -> k (ar) | Succ (x, s) -> b (x) (k) (s) esac}) (s) + } + } +} + +fun seq (a, b) { + fun (s) { + case a (s) of + r@(Fail (_)) -> r + | Succ (r, e) -> + foldl (fun (r, p) {r ** b (p.fst) (p.snd)}, Fail (e), r) + esac + } +} + + +--infixr | before !! (a, b) {alt (a, b)} +--infixr |> after | (a, b) {seq (a, b)} + +infixr || before !! (a, b) {alt_k (a, b)} +infixr ||> after || (a, b) {seq_nm (a, b)} + +infix @ at * (a, f) { + fun (k) { + fun (s) { + a (fun (x) {k (case x of Fail (_) -> x | Succ (x, s) -> Succ (f (x), s) esac)}) (s) + } + } +} + +local tab = emptyMemo (), memo_tab = ref (emptyHashTab ()); + +fun memo (f) { + local t; + + --f := lookupMemo (tab, f); + printf ("Memoizing: f=%x\n", f); + + case findHashTab (deref (memo_tab), f) of + None -> t := ref (emptyMap ()); memo_tab ::= addHashTab (deref (memo_tab), f, t) + | Some (tt) -> t := tt + esac; + + fun (k) { + fun (s) { + -- printf ("s=%s\n", s.string); + case findMap (deref (t), s) of + None -> + t ::= addMap (deref (t), s, [addSet (emptySet (), k), emptySet ()]); + f (fun (r) { + -- printf ("Result: %s\n", r.string); + case findMap (deref (t), s) of + Some ([ks, rs]) -> + if memSet (rs, r) + then skip + else + t ::= addMap (deref (t), s, [ks, addSet (rs, r)]); + iterSet (fun (k) {k (r)}, ks) + fi + esac + } + ) + (s) + | Some ([ks, rs]) -> + t ::= addMap (deref (t), s, [addSet (ks, k), rs]); + iterSet (k, rs) + esac + } + } +} + +fun lift (f) { + fun (x) {f} +} + +fun observe (name, f) { + fun (k) { + fun (s) { + printf ("%s at %s\n", name, s.string); + f (k)(s) + } + } +} + +fun print (x) {printf ("k: %s\n", x.string)} + +local a = token_k ("a"); + +local as = memo ( + fun (k) { + (empty_k || (as ||> a)) (k) + } +); + +as (print) ({"a", "a"}) \ No newline at end of file diff --git a/stdlib/Ref.expr b/stdlib/Ref.expr new file mode 100644 index 000000000..d0d6a5cae --- /dev/null +++ b/stdlib/Ref.expr @@ -0,0 +1,11 @@ +public fun ref (x) { + [x] +} + +public fun deref (x) { + x[0] +} + +public infix ::= before := (x, y) { + x[0] := y +} \ No newline at end of file diff --git a/stdlib/regression/orig/test08.log b/stdlib/regression/orig/test08.log new file mode 100644 index 000000000..9edaa2d53 --- /dev/null +++ b/stdlib/regression/orig/test08.log @@ -0,0 +1,3 @@ +6 +120 +5040 diff --git a/stdlib/regression/test08.expr b/stdlib/regression/test08.expr new file mode 100644 index 000000000..97e33ab28 --- /dev/null +++ b/stdlib/regression/test08.expr @@ -0,0 +1,7 @@ +import Fun; + +local fact = fix (fun (self) {fun (n) {if n <= 1 then 1 else n * self (n-1) fi}}); + +printf ("%d\n", fact (3)); +printf ("%d\n", fact (5)); +printf ("%d\n", fact (7)) \ No newline at end of file