miloignis/kraken
1
0 Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Using a nice Pure Nix Flake now, implement Koka-style rb-tree test (only running on 100 instead of 42,000,000 - .06s compiled, 40m54s interpreted!!!), also a small fact to test loops - spoiler alert we need tail-call-elimination

Browse Source
This commit is contained in:
Nathan Braswell committed 2022-05-09 23:42:39 -04:00
1 parent 20d554dfe6
commit a966c0c0ba
12 files changed
+187 -95
Download Patch File Download Diff File Expand all files Collapse all files

No files matched your search

fib_test/builtin_fib.wasm
BIN
View File
Binary file not shown.
fib_test/fib_compiled.wasm
BIN
View File
Binary file not shown.
fib_test/fib_compiled_let.wasm
BIN
View File
Binary file not shown.
fib_test/fib_compiled_manual.wasm
BIN
View File
Binary file not shown.
fib_test/fib_interpreted.wasm
BIN
View File
Binary file not shown.
fib_test/fib_interpreted_let.wasm
BIN
View File
Binary file not shown.
flake.lock
Generated
+93
View File
@@ -0,0 +1,93 @@
{
"nodes": {
"flake-utils": {
"locked": {
"lastModified": 1649676176,
"narHash": "sha256-OWKJratjt2RW151VUlJPRALb7OU2S5s+f0vLj4o1bHM=",
"owner": "numtide",
"repo": "flake-utils",
"rev": "a4b154ebbdc88c8498a5c7b01589addc9e9cb678",
"type": "github"
},
"original": {
"owner": "numtide",
"repo": "flake-utils",
"type": "github"
}
},
"flake-utils_2": {
"locked": {
"lastModified": 1649676176,
"narHash": "sha256-OWKJratjt2RW151VUlJPRALb7OU2S5s+f0vLj4o1bHM=",
"owner": "numtide",
"repo": "flake-utils",
"rev": "a4b154ebbdc88c8498a5c7b01589addc9e9cb678",
"type": "github"
},
"original": {
"owner": "numtide",
"repo": "flake-utils",
"type": "github"
}
},
"moz_overlay": {
"inputs": {
"flake-utils": "flake-utils_2",
"nixpkgs": "nixpkgs"
},
"locked": {
"lastModified": 1652149774,
"narHash": "sha256-rms5yNnnlmaqzEnI/9Log+5k/yVz4fB1BUVx5HXf8i8=",
"owner": "oxalica",
"repo": "rust-overlay",
"rev": "1dcdd08fcd39e4e053f58f9959be801399c5211e",
"type": "github"
},
"original": {
"owner": "oxalica",
"repo": "rust-overlay",
"type": "github"
}
},
"nixpkgs": {
"locked": {
"lastModified": 1652133925,
"narHash": "sha256-kfATGChLe9/fQVZkXN9G71JAVMlhePv1qDbaRKklkQs=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "51d859cdab1ef58755bd342d45352fc607f5e59b",
"type": "github"
},
"original": {
"owner": "NixOS",
"ref": "nixpkgs-unstable",
"repo": "nixpkgs",
"type": "github"
}
},
"nixpkgs_2": {
"locked": {
"lastModified": 1652020977,
"narHash": "sha256-V6VYIwTeI5BCfYK9f5EsMbjsjsis1rUDHMsaDbTvt+A=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "715dc137b08213aabbbe0965b78ab938e5d8d3b7",
"type": "github"
},
"original": {
"id": "nixpkgs",
"ref": "nixos-21.11",
"type": "indirect"
}
},
"root": {
"inputs": {
"flake-utils": "flake-utils",
"moz_overlay": "moz_overlay",
"nixpkgs": "nixpkgs_2"
}
}
},
"root": "root",
"version": 7
}
flake.nix
+52
View File
@@ -0,0 +1,52 @@
{
description = "Env for Kraken and the extacted Koka bencmarks";
inputs = {
#flake.lock pins a particular version of 21.11 that has non-broken Swift
nixpkgs.url = "nixpkgs/nixos-21.11";
#nixpkgs.url = "github:NixOS/nixpkgs";
# Pure-er, so we don't have to mess with the --impure flag
moz_overlay.url = "github:oxalica/rust-overlay";
#moz_overlay.url = "github:mozilla/nixpkgs-mozilla";
flake-utils.url = "github:numtide/flake-utils";
};
outputs = { self, nixpkgs, moz_overlay, flake-utils }:
(flake-utils.lib.eachDefaultSystem (system:
let
pkgs = import nixpkgs {
inherit system;
overlays = [ moz_overlay.overlay ];
};
in {
devShell = pkgs.mkShell {
buildInputs = with pkgs; [
chicken
#gambit
gambit-unstable
chez
wabt
wasmtime
wasm3
wasmer
leiningen
clang
kakoune
hyperfine
(rust-bin.stable.latest.default.override {
targets = [ "wasm32-wasi" ];
})
cmake
stack (haskellPackages.ghcWithPackages (p: [p.parallel]))
koka
ocaml
jdk
swift
];
};
}
));
}
misc_tests/fact_lognoopt.kp
+33
View File
@@ -0,0 +1,33 @@
((wrap (vau root_env (quote)
((wrap (vau (let1)
(let1 lambda (vau se (p b1) (wrap (eval (array vau p b1) se)))
(let1 current-env (vau de () de)
(let1 cons (lambda (h t) (concat (array h) t))
(let1 Y (lambda (f3)
((lambda (x1) (x1 x1))
(lambda (x2) (f3 (wrap (vau app_env (& y) (lapply (x2 x2) y app_env)))))))
(let1 vY (lambda (f)
((lambda (x3) (x3 x3))
(lambda (x4) (f (vau de1 (& y) (vapply (x4 x4) y de1))))))
(let1 let (vY (lambda (recurse) (vau de2 (vs b) (cond (= (len vs) 0) (eval b de2)
true (vapply let1 (array (idx vs 0) (idx vs 1) (array recurse (slice vs 2 -1) b)) de2)))))
(let (
rec-lambda (vau se (n p b) (eval (array Y (array lambda (array n) (array lambda p b))) se))
fact (rec-lambda fact (n) (cond (= 0 n) 1
(= 1 n) 1
true (band #xFFFFFF (* n (fact (- n 1))))))
monad (array 'write 1 "hao" (vau (written code)
(array 'exit (log (fact (log 10000))))
))
) monad)
; end of all lets
))))))
; impl of let1
)) (vau de (s v b) (eval (array (array wrap (array vau (array s) b)) v) de)))
; impl of quote
)) (vau (x5) x5))
partial_eval.scm
+1 -1
View File
@@ -734,7 +734,7 @@
((prim_comb? x) (array pectx nil x))
((marked_symbol? x) (mif (.marked_symbol_is_val x) x
(env-lookup-helper (.env_marked env) (.marked_symbol_value x) 0
(lambda () (array pectx (str "could't find " (str_strip x) " in " (str_strip env)) nil))
(lambda () (array pectx (str "could't find " (true_str_strip x) " in " (str_strip env)) nil))
(lambda (x) (array pectx nil x)))))
; Does this ever happen? non-fully-value arrays?
((marked_array? x) (cond ((.marked_array_is_val x) (dlet ( ((pectx err inner_arr) (foldl (dlambda ((c er ds) p) (dlet (((c e d) (partial_eval_helper p false env env_stack c (+ 1 indent) false))) (array c (mif er er e) (concat ds (array d)))))
rb_tree_test/matching.kp
+8 -69
View File
@@ -279,76 +279,15 @@
match_result1 (match 1
2 true
a (+ a 1)
)
make-test-tree (rec-lambda make-test-tree (n t) (if (<= n 0) t
(make-test-tree (- n 1) (map-insert t n (= 0 (% n 10))))))
reduce-test-tree (lambda (tree) (generic-foldl (lambda (a x) (if (idx x 1) (+ a 1) a)) 0 tree))
monad (array 'write 1 (str "enter number to fact: " match_result1 " ") (vau (written code)
(array 'read 0 60 (vau (data code)
(let (
first set-empty
_ (log first " set-contains? " 1 " ? " (set-contains? first 1) " size " (size first))
second (set-insert first 1)
_ (log second " set-contains? " 1 " ? " (set-contains? second 1) " size " (size second))
third (set-insert second 2)
_ (log third " set-contains? " 1 " ? " (set-contains? third 1) " size " (size third))
_ (log third " set-contains? " 2 " ? " (set-contains? third 2) " size " (size third))
fourth (set-insert third 3)
_ (log fourth " set-contains? " 1 " ? " (set-contains? fourth 1) " size " (size fourth))
_ (log fourth " set-contains? " 2 " ? " (set-contains? fourth 2) " size " (size fourth))
_ (log fourth " set-contains? " 3 " ? " (set-contains? fourth 3) " size " (size fourth))
_ (log fourth " set-contains? " 4 " ? " (set-contains? fourth 4) " size " (size fourth))
_ (log fourth " foldl with + " (set-foldl + 0 fourth))
fifth (set-remove fourth 1)
_ (log fifth " set-contains? " 1 " ? " (set-contains? fifth 1) " size " (size fifth))
_ (log fifth " set-contains? " 2 " ? " (set-contains? fifth 2) " size " (size fifth))
_ (log fifth " set-contains? " 3 " ? " (set-contains? fifth 3) " size " (size fifth))
_ (log fifth " set-contains? " 4 " ? " (set-contains? fifth 4) " size " (size fifth))
sixth (set-remove fifth 3)
_ (log sixth " set-contains? " 1 " ? " (set-contains? sixth 1) " size " (size sixth))
_ (log sixth " set-contains? " 2 " ? " (set-contains? sixth 2) " size " (size sixth))
_ (log sixth " set-contains? " 3 " ? " (set-contains? sixth 3) " size " (size sixth))
_ (log sixth " set-contains? " 4 " ? " (set-contains? sixth 4) " size " (size sixth))
seventh (set-remove sixth 2)
_ (log seventh " set-contains? " 1 " ? " (set-contains? seventh 1) " size " (size seventh))
_ (log seventh " set-contains? " 2 " ? " (set-contains? seventh 2) " size " (size seventh))
_ (log seventh " set-contains? " 3 " ? " (set-contains? seventh 3) " size " (size seventh))
_ (log seventh " set-contains? " 4 " ? " (set-contains? seventh 4) " size " (size seventh))
first map-empty
_ (log first " map-contains-key? " 1 " ? " (map-contains-key? first 1) " size " (size first))
second (map-insert first 1 "hello")
_ (log second " map-contains-key? " 1 " ? " (map-contains-key? second 1) " size " (size second))
_ (log second " map-get " 1 " ? " (map-get second 1) " size " (size second))
third (map-insert second 1 "goodbye")
_ (log third " map-contains-key? " 1 " ? " (map-contains-key? third 1) " size " (size third))
_ (log third " map-get " 1 " ? " (map-get third 1) " size " (size third))
fourth (map-insert third 2 "hmmm")
_ (log fourth " map-contains-key? " 2 " ? " (map-contains-key? fourth 2) " size " (size fourth))
_ (log fourth " map-get " 2 " ? " (map-get fourth 2) " size " (size fourth))
_ (log fourth " map-contains-key? " 1 " ? " (map-contains-key? fourth 1) " size " (size fourth))
_ (log fourth " map-get " 1 " ? " (map-get fourth 1) " size " (size fourth))
_ (log fourth " map-contains-key? " 3 " ? " (map-contains-key? fourth 3) " size " (size fourth))
_ (log fourth " map-get-or-default " 3 " 'hi ? " (map-get-or-default fourth 3 'hi) " size " (size fourth))
_ (log fourth " map-get-with-default " 3 " (lambda () 'bye) ? " (map-get-with-default fourth 3 (lambda () 'bye)) " size " (size fourth))
fifth (map-remove fourth 2)
_ (log fifth " map-contains-key? " 2 " ? " (map-contains-key? fifth 2) " size " (size fifth))
) (array 'exit (map-get fifth (read-string data))))
;(array 'exit (match (read-string data)
; 1 "one"
; 'jkl "it's jkl"
; ,match_result1 383838
; (1 b) (+ 1337 b)
; (,match_result1 b) (+ 2337 b)
; (a b) (+ a b)
; a (+ a 13)
; ))
))
monad (array 'write 1 (str "running tree test") (vau (written code)
;(array 'exit (log (reduce-test-tree (make-test-tree (log 100) map-empty))))
(array 'read 0 60 (vau (data code)
(array 'exit (log (reduce-test-tree (make-test-tree (read-string data) map-empty))))
))
))
shell.nix
-25
View File
@@ -1,25 +0,0 @@
let
moz_overlay = import (builtins.fetchTarball https://github.com/mozilla/nixpkgs-mozilla/archive/master.tar.gz);
nixpkgs = import <nixpkgs> { overlays = [ moz_overlay ]; };
in with nixpkgs;
mkShell {
LANG="en_US.UTF-8";
nativeBuildInputs = [
chicken
#gambit
gambit-unstable
chez
wabt
wasmtime
wasm3
wasmer
kakoune
#(rustChannelOf { rustToolchain = ./rust-toolchain; }).rust
#(rustChannelOf { date = "2022-04-10"; channel = "nightly"; targets = [ "wasm32-wasi" ]; }).rust
(latest.rustChannels.nightly.rust.override { targets = [ "wasm32-wasi" ]; })
leiningen
clang
hyperfine
];
}