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

Clean out, start sl JIT project (no jit yet)

Browse Source
This commit is contained in:
Nathan Braswell
2023-11-19 16:33:19 -05:00
parent c1a0608b7c
commit 774eb668de
111 changed files with 1337 additions and 17773 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
.gitignore vendored
View File

@@ -13,3 +13,4 @@ build-ninja
callgrind*
.stfolder
*.wasm
*/target

12
README.md
View File

@@ -5,11 +5,19 @@ The Kraken Programming Language
(more information online at http://kraken-lang.org/ which is also under construction / needs to be updated / has a try-it-online feature for an older version without partial evaluation)
Currently developing the third iteration, a Scheme-like based on a functional Vau calculus partially-evaluated for efficency and compiling to WebAssembly.
*Heavily* inspiried by John Shutt's thesis: https://web.wpi.edu/Pubs/ETD/Available/etd-090110-124904/unrestricted/jshutt.pdf
with partial evaluation during compilation to make it efficient.
Currently developing the fourth iteration, a Scheme-like based on a functional Vau calculus JIT compiled for speed.
Working up to a JIT for fexprs by starting with
- sl - a Simple Lisp JIT (WIP)
- ?
- ?
- ?
- kv - A fexpr interpeter with mutation and delimited continuations - need to add a JIT to this
koka_bench: Licensed under Apache-2.0, as they are derived from the benchmarks of the Koka project, see the readme and license in koka_bench for more, or https://github.com/koka-lang/koka for the source project.

88
basic_dyns
View File

@@ -1,88 +0,0 @@
RB-TREE
evals all_evals evaled_wrap_1 evaled_wrap_0 compiled_dyn_1 compiled_dyn_0
non-PE10 114_170 5_032_297 1_291_489 398_104 1 0
PE10 0 0 0 0 10 0
nonPE9 97087 4278001 1097965 338383 1 0
PE9 0 0 0 0 9 0
nonPE8 80160 3532131 906548 279379 1 0
PE8 0 0 0 0 8 0
nonPE7 67050 2952848 757932 233513 1 0
PE7 0 0 0 0 7 0
nonPE6 50361 2219792 569723 175593 1 0
PE6 0 0 0 0 6 0
nonPE5 37299 1643049 421745 129938 1 0
PE5 0 0 0 0 5 0
nonPE4 24393 1074730 275873 85000 1 0
PE4 0 0 0 0 4 0
nonPE3 15304 672998 172802 53200 1 0
PE3 0 0 0 0 3 0
nonPE2 6453 284080 72939 22484 1 0
PE2 0 0 0 0 2 0
nonPE1 1385 59899 15413 4750 1 0
PE1 0 0 0 0 1 0
Fib
evals all_evals evaled_wrap_1 evaled_wrap_0 compiled_dyn_1 compiled_dyn_0
non-PE35 29860726 1320920726 337695363 119442881 1 0
non-PE30 2692560 119107888 30450112 10770217 1 0
non-PE25 242808 10740492 2745825 971209 1 0
non-PE20 21914 969010 247731 87633 1 0
non-PE15 1996 87916 22478 7961 1 0
non-PE10 200 8468 2167 777 1 0
PE10 0 0 0 0 0 0
PE15 0 0 0 0 0 0
PE20 0 0 0 0 0 0
PE25 0 0 0 0 0 0
PE30 0 0 0 0 0 0
PE35 0 0 0 0 0 0
cfold
evals all_evals evaled_wrap_1 evaled_wrap_0 compiled_dyn_1 compiled_dyn_0
non-PE5 239660 10897376 2784275 879066 1 0
PE5 0 0 0 0 0 0
deriv
evals all_evals evaled_wrap_1 evaled_wrap_0 compiled_dyn_1 compiled_dyn_0
non-PE2 257693 11708558 2990090 946500 1 0
PE2 0 0 0 0 2 0
nqueens
evals all_evals evaled_wrap_1 evaled_wrap_0 compiled_dyn_1 compiled_dyn_0
non-PE7 271720 13530241 3429161 1108393 1 0
PE7 0 0 0 0 0 0
scheme --script ../../partial_eval.scm rbtree-opt.kp no_partial_eval && mv csc_out.wasm rbtree-opt.wasm && time wasmtime ./rbtree-opt.wasm 10
scheme --script ../../partial_eval.scm rbtree-opt.kp && mv csc_out.wasm rbtree-opt.wasm && time wasmtime ./rbtree-opt.wasm 10

12
doc/.gitignore vendored
View File

@@ -1,12 +0,0 @@
*.swp
*.zip
*.aux
*.bbl
*.blg
*.log
*.out
*.pdf
*.nav
*.snm
*.toc
*.vrb

11
doc/cited-paper.bib
View File

@@ -1,11 +0,0 @@
@phdthesis{shutt2010fexprs,
title={Fexprs as the basis of Lisp function application or \$vau: the ultimate abstraction},
author={Shutt, John N},
year={2010}
}
@article{kearsleyimplementing,
title={Implementing a Vau-based Language With Multiple Evaluation Strategies},
author={Kearsley, Logan}
}

9
doc/make_presentation.sh
View File

@@ -1,9 +0,0 @@
#!/usr/bin/env bash
rm presentation.aux
rm presentation.bbl
rm presentation.blg
rm presentation.log
rm presentation.out
rm presentation.pdf
#pdflatex presentation && bibtex presentation && pdflatex presentation && bibtex presentation && pdflatex presentation && bibtex presentation && evince presentation.pdf
pdflatex presentation && evince presentation.pdf

8
doc/make_writeup.sh
View File

@@ -1,8 +0,0 @@
#!/usr/bin/env bash
rm writeup.aux
rm writeup.bbl
rm writeup.blg
rm writeup.log
rm writeup.out
rm writeup.pdf
pdflatex writeup && bibtex writeup && pdflatex writeup && bibtex writeup && pdflatex writeup && bibtex writeup && evince writeup.pdf

38
doc/nix/sources.json
View File

@@ -1,38 +0,0 @@
{
"niv": {
"branch": "master",
"description": "Easy dependency management for Nix projects",
"homepage": "https://github.com/nmattia/niv",
"owner": "nmattia",
"repo": "niv",
"rev": "65a61b147f307d24bfd0a5cd56ce7d7b7cc61d2e",
"sha256": "17mirpsx5wyw262fpsd6n6m47jcgw8k2bwcp1iwdnrlzy4dhcgqh",
"type": "tarball",
"url": "https://github.com/nmattia/niv/archive/65a61b147f307d24bfd0a5cd56ce7d7b7cc61d2e.tar.gz",
"url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
},
"nixpkgs": {
"branch": "master",
"description": "Nix Packages collection",
"homepage": "",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "2b65a74aba274a06a673dfb6f28b96cbe0b032fb",
"sha256": "0f62z6q00dpxnf4c5ip8362kzzcmnlhx6fbia6dr97a21fzbc8aq",
"type": "tarball",
"url": "https://github.com/NixOS/nixpkgs/archive/2b65a74aba274a06a673dfb6f28b96cbe0b032fb.tar.gz",
"url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
},
"nixpkgs-mozilla": {
"branch": "master",
"description": "mozilla related nixpkgs (extends nixos/nixpkgs repo)",
"homepage": "",
"owner": "mozilla",
"repo": "nixpkgs-mozilla",
"rev": "0510159186dd2ef46e5464484fbdf119393afa58",
"sha256": "1c6r5ldkh71v6acsfhni7f9sxvi7xrqzshcwd8w0hl2rrqyzi58w",
"type": "tarball",
"url": "https://github.com/mozilla/nixpkgs-mozilla/archive/0510159186dd2ef46e5464484fbdf119393afa58.tar.gz",
"url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
}
}

174
doc/nix/sources.nix
View File

@@ -1,174 +0,0 @@
# This file has been generated by Niv.
let
#
# The fetchers. fetch_<type> fetches specs of type <type>.
#
fetch_file = pkgs: name: spec:
let
name' = sanitizeName name + "-src";
in
if spec.builtin or true then
builtins_fetchurl { inherit (spec) url sha256; name = name'; }
else
pkgs.fetchurl { inherit (spec) url sha256; name = name'; };
fetch_tarball = pkgs: name: spec:
let
name' = sanitizeName name + "-src";
in
if spec.builtin or true then
builtins_fetchTarball { name = name'; inherit (spec) url sha256; }
else
pkgs.fetchzip { name = name'; inherit (spec) url sha256; };
fetch_git = name: spec:
let
ref =
if spec ? ref then spec.ref else
if spec ? branch then "refs/heads/${spec.branch}" else
if spec ? tag then "refs/tags/${spec.tag}" else
abort "In git source '${name}': Please specify `ref`, `tag` or `branch`!";
in
builtins.fetchGit { url = spec.repo; inherit (spec) rev; inherit ref; };
fetch_local = spec: spec.path;
fetch_builtin-tarball = name: throw
''[${name}] The niv type "builtin-tarball" is deprecated. You should instead use `builtin = true`.
$ niv modify ${name} -a type=tarball -a builtin=true'';
fetch_builtin-url = name: throw
''[${name}] The niv type "builtin-url" will soon be deprecated. You should instead use `builtin = true`.
$ niv modify ${name} -a type=file -a builtin=true'';
#
# Various helpers
#
# https://github.com/NixOS/nixpkgs/pull/83241/files#diff-c6f540a4f3bfa4b0e8b6bafd4cd54e8bR695
sanitizeName = name:
(
concatMapStrings (s: if builtins.isList s then "-" else s)
(
builtins.split "[^[:alnum:]+._?=-]+"
((x: builtins.elemAt (builtins.match "\\.*(.*)" x) 0) name)
)
);
# The set of packages used when specs are fetched using non-builtins.
mkPkgs = sources: system:
let
sourcesNixpkgs =
import (builtins_fetchTarball { inherit (sources.nixpkgs) url sha256; }) { inherit system; };
hasNixpkgsPath = builtins.any (x: x.prefix == "nixpkgs") builtins.nixPath;
hasThisAsNixpkgsPath = <nixpkgs> == ./.;
in
if builtins.hasAttr "nixpkgs" sources
then sourcesNixpkgs
else if hasNixpkgsPath && ! hasThisAsNixpkgsPath then
import <nixpkgs> {}
else
abort
''
Please specify either <nixpkgs> (through -I or NIX_PATH=nixpkgs=...) or
add a package called "nixpkgs" to your sources.json.
'';
# The actual fetching function.
fetch = pkgs: name: spec:
if ! builtins.hasAttr "type" spec then
abort "ERROR: niv spec ${name} does not have a 'type' attribute"
else if spec.type == "file" then fetch_file pkgs name spec
else if spec.type == "tarball" then fetch_tarball pkgs name spec
else if spec.type == "git" then fetch_git name spec
else if spec.type == "local" then fetch_local spec
else if spec.type == "builtin-tarball" then fetch_builtin-tarball name
else if spec.type == "builtin-url" then fetch_builtin-url name
else
abort "ERROR: niv spec ${name} has unknown type ${builtins.toJSON spec.type}";
# If the environment variable NIV_OVERRIDE_${name} is set, then use
# the path directly as opposed to the fetched source.
replace = name: drv:
let
saneName = stringAsChars (c: if isNull (builtins.match "[a-zA-Z0-9]" c) then "_" else c) name;
ersatz = builtins.getEnv "NIV_OVERRIDE_${saneName}";
in
if ersatz == "" then drv else
# this turns the string into an actual Nix path (for both absolute and
# relative paths)
if builtins.substring 0 1 ersatz == "/" then /. + ersatz else /. + builtins.getEnv "PWD" + "/${ersatz}";
# Ports of functions for older nix versions
# a Nix version of mapAttrs if the built-in doesn't exist
mapAttrs = builtins.mapAttrs or (
f: set: with builtins;
listToAttrs (map (attr: { name = attr; value = f attr set.${attr}; }) (attrNames set))
);
# https://github.com/NixOS/nixpkgs/blob/0258808f5744ca980b9a1f24fe0b1e6f0fecee9c/lib/lists.nix#L295
range = first: last: if first > last then [] else builtins.genList (n: first + n) (last - first + 1);
# https://github.com/NixOS/nixpkgs/blob/0258808f5744ca980b9a1f24fe0b1e6f0fecee9c/lib/strings.nix#L257
stringToCharacters = s: map (p: builtins.substring p 1 s) (range 0 (builtins.stringLength s - 1));
# https://github.com/NixOS/nixpkgs/blob/0258808f5744ca980b9a1f24fe0b1e6f0fecee9c/lib/strings.nix#L269
stringAsChars = f: s: concatStrings (map f (stringToCharacters s));
concatMapStrings = f: list: concatStrings (map f list);
concatStrings = builtins.concatStringsSep "";
# https://github.com/NixOS/nixpkgs/blob/8a9f58a375c401b96da862d969f66429def1d118/lib/attrsets.nix#L331
optionalAttrs = cond: as: if cond then as else {};
# fetchTarball version that is compatible between all the versions of Nix
builtins_fetchTarball = { url, name ? null, sha256 }@attrs:
let
inherit (builtins) lessThan nixVersion fetchTarball;
in
if lessThan nixVersion "1.12" then
fetchTarball ({ inherit url; } // (optionalAttrs (!isNull name) { inherit name; }))
else
fetchTarball attrs;
# fetchurl version that is compatible between all the versions of Nix
builtins_fetchurl = { url, name ? null, sha256 }@attrs:
let
inherit (builtins) lessThan nixVersion fetchurl;
in
if lessThan nixVersion "1.12" then
fetchurl ({ inherit url; } // (optionalAttrs (!isNull name) { inherit name; }))
else
fetchurl attrs;
# Create the final "sources" from the config
mkSources = config:
mapAttrs (
name: spec:
if builtins.hasAttr "outPath" spec
then abort
"The values in sources.json should not have an 'outPath' attribute"
else
spec // { outPath = replace name (fetch config.pkgs name spec); }
) config.sources;
# The "config" used by the fetchers
mkConfig =
{ sourcesFile ? if builtins.pathExists ./sources.json then ./sources.json else null
, sources ? if isNull sourcesFile then {} else builtins.fromJSON (builtins.readFile sourcesFile)
, system ? builtins.currentSystem
, pkgs ? mkPkgs sources system
}: rec {
# The sources, i.e. the attribute set of spec name to spec
inherit sources;
# The "pkgs" (evaluated nixpkgs) to use for e.g. non-builtin fetchers
inherit pkgs;
};
in
mkSources (mkConfig {}) // { __functor = _: settings: mkSources (mkConfig settings); }

570
doc/presentation.tex
View File

@@ -1,570 +0,0 @@
\documentclass{beamer}
%from https://www.overleaf.com/learn/latex/Beamer
%Information to be included in the title page:
\title{Efficient compilation of a functional Lisp based on Vau calculus}
\author{Nathan Braswell}
\institute{Georgia Tech}
\date{2022}
\begin{document}
\frame{\titlepage}
\begin{frame}
\frametitle{Combiners and Vau Introduction}
Motivation and examples
\begin{enumerate}
\item<1-> Vau/Combiners unify and make first class functions, macros, and built-in forms in a single simple system
\item<2-> They are also much simpler conceptually than macro systems, which often end up quite complex (Racket has positive and negative evaluation levels, etc)
\item<3-> Downside: naively executing a language using combiners instead of macros is exceedingly slow
\begin{enumerate}
\item<4-> The code of the fexpr (analogus to a macro invocation) is re-executed at runtime, every time it is encountered
\item<5-> Additionally, because it is unclear what code will be evaluated as a parameter to a function call and what code must be passed unevaluated to the combiner, little optimization can be done.
\end{enumerate}
\end{enumerate}
\end{frame}
\begin{frame}
\frametitle{Solution: Partial Eval}
\begin{enumerate}
\item<1-> Partially evaluate a purely functional version of this language in a nearly-single pass over the entire program
\item<2-> Environment chains consisting of both "real" environments with every contained symbol mapped to a value and "fake" environments that only have placeholder values.
\item<3-> Since the language is purely functional, we know that if a symbol evaluates to a value anywhere, it will always evaluate to that value at runtime, and we can perform inlining and continue partial evaluation.
\item<4-> If the resulting partially-evaluated program only contains static references to a subset of built in combiners and functions (combiners that evaluate their parameters exactly once), the program can be compiled just like it was a normal Scheme program
\end{enumerate}
\end{frame}
\begin{frame}[fragile]
\frametitle{Example time!}
\begin{enumerate}
\item<1-> We will wrap angle brackets $<>$ around values that are not representable in the syntax of the language - i.e. $+$ is a symbol that will be looked up in an environment, $<+>$ is the addition function.
\item<2-> We will use square brackets $[]$ to indiciate array values, and we will use a single quote to indicate symbol values $'$, for instance $'+$ is the symbol $+$ as a value.
\item<3-> Additionally, we will use curly braces ($\{\}$) to indicate the environment (mapping symbols to values). Elipses will be used to omit unnecessary information.
\item<4-> Finally, we will not show the static environment nested in combiners, but know that each combiner carries with it the environment it was created with, which becomes the upper environment when its body is executing (the immediate environment being populated with the parameters).
\end{enumerate}
\end{frame}
\begin{frame}[fragile]
\frametitle{A few more things..}
\begin{enumerate}
\item<1-> ; is the comment character for the language
\item<2-> We will sometimes make larger evaluation jumps for (some) brevity
\item<3-> wraplevel is how many times a combiner will evaluate its parameters before the body starts executing. 0 makes it work like a macro, 1 is like a function, etc
\item<4-> Wrap takes a combiner and returns the same combiner with an incremented wraplevel, unwrap does the reverese
\item<5-> Typing these examples by hand is too finicky, next time they'll be autogenerated with color by the prototype partial evaluator!
\end{enumerate}
\end{frame}
\begin{frame}[fragile]
\frametitle{Smallest Example}
\footnotesize
\begin{verbatim}
{ ...root environment...}
(wrap (vau (n) (* n 2)))
\end{verbatim}
\end{frame}
\begin{frame}[fragile]
\footnotesize
\begin{verbatim}
{...}
(<wrap> (vau (n) (* n 2)))
\end{verbatim}
\end{frame}
\begin{frame}[fragile]
\footnotesize
\begin{verbatim}
{...}
(<wrap> (<vau> (n) (* n 2)))
\end{verbatim}
\end{frame}
\begin{frame}[fragile]
\footnotesize
\begin{verbatim}
{...}
(<wrap> <comb wraplevel=0 (n) (* n 2)>)
\end{verbatim}
\end{frame}
\begin{frame}[fragile]
\footnotesize
\begin{verbatim}
{...}
<comb wraplevel=1 (n) (* n 2)>
\end{verbatim}
\end{frame}
\begin{frame}[fragile]
\frametitle{Small Example}
\footnotesize
\begin{verbatim}
{ ...root environment...}
((wrap (vau (n) (* n 2))) (+ 2 2))
\end{verbatim}
\end{frame}
\begin{frame}[fragile]
\footnotesize
\begin{verbatim}
{...}
((<wrap> (vau (n) (* n 2))) (+ 2 2))
\end{verbatim}
\end{frame}
\begin{frame}[fragile]
\footnotesize
\begin{verbatim}
{...}
((<wrap> (<vau> (n) (* n 2))) (+ 2 2))
\end{verbatim}
\end{frame}
\begin{frame}[fragile]
\footnotesize
\begin{verbatim}
{...}
((<wrap> <comb wraplevel=0 (n) (* n 2)>) (+ 2 2))
\end{verbatim}
\end{frame}
\begin{frame}[fragile]
\footnotesize
\begin{verbatim}
{...}
(<comb wraplevel=1 (n) (* n 2)> (+ 2 2))
\end{verbatim}
\end{frame}
\begin{frame}[fragile]
\footnotesize
\begin{verbatim}
{...}
(<comb wraplevel=1 (n) (* n 2)> (<+> 2 2))
\end{verbatim}
\end{frame}
\begin{frame}[fragile]
\footnotesize
\begin{verbatim}
{...}
(<comb wraplevel=1 (n) (* n 2)> 4)
\end{verbatim}
\end{frame}
\begin{frame}[fragile]
\footnotesize
\begin{verbatim}
{n: 4 | upper: {...root environment...}}
(* n 2)
\end{verbatim}
\end{frame}
\begin{frame}[fragile]
\footnotesize
\begin{verbatim}
{n: 4 | upper: {...root environment...}}
(<*> n 2)
\end{verbatim}
\end{frame}
\begin{frame}[fragile]
\footnotesize
\begin{verbatim}
{n: 4 | upper: {...root environment...}}
(<*> 4 2)
\end{verbatim}
\end{frame}
\begin{frame}[fragile]
\footnotesize
\begin{verbatim}
8
\end{verbatim}
\end{frame}
\begin{frame}[fragile]
\frametitle{Small Vau-specific Example (implementing quote)}
\footnotesize
\begin{verbatim}
{ ...root environment...}
((vau (x) x) hello)
\end{verbatim}
\end{frame}
\begin{frame}[fragile]
\footnotesize
\begin{verbatim}
{ ...root environment...}
((<vau> (x) x) hello)
\end{verbatim}
\end{frame}
\begin{frame}[fragile]
\footnotesize
\begin{verbatim}
{ ...root environment...}
(<comb wraplevel=0 (x) x> hello)
\end{verbatim}
\end{frame}
\begin{frame}[fragile]
\footnotesize
\begin{verbatim}
{ x: 'hello | upper: {...root env....}}
x
\end{verbatim}
\end{frame}
\begin{frame}[fragile]
\footnotesize
\begin{verbatim}
'hello
\end{verbatim}
\end{frame}
\begin{frame}[fragile]
\frametitle{Larger Example}
\footnotesize
\begin{verbatim}
{...root environment...}
((wrap (vau (let1)
(let1 lambda (vau se (p b1) (wrap (eval (array vau p b1) se)))
(lambda (n) (* n 2))
)
; impl of let1
)) (vau de (s v b) (eval (array (array vau (array s) b) (eval v de))
de)))
\end{verbatim}
\end{frame}
\begin{frame}[fragile]
\footnotesize
\begin{verbatim}
{...}
((<wrap> (vau (let1)
(let1 lambda (vau se (p b1) (wrap (eval (array vau p b1) se)))
(lambda (n) (* n 2))
)
; impl of let1
)) (vau de (s v b) (eval (array (array vau (array s) b) (eval v de))
de)))
\end{verbatim}
\end{frame}
\begin{frame}[fragile]
\footnotesize
\begin{verbatim}
{...}
((<wrap> (<vau> (let1)
(let1 lambda (vau se (p b1) (wrap (eval (array vau p b1) se)))
(lambda (n) (* n 2))
)
; impl of let1
)) (vau de (s v b) (eval (array (array vau (array s) b) (eval v de))
de)))
\end{verbatim}
\end{frame}
\begin{frame}[fragile]
\footnotesize
\begin{verbatim}
{...}
((<wrap> <comb wraplevel=0 (let1)
(let1 lambda (vau se (p b1) (wrap (eval (array vau p b1) se)))
(lambda (n) (* n 2))
)
; impl of let1
>) (vau de (s v b) (eval (array (array vau (array s) b) (eval v de))
de)))
\end{verbatim}
\end{frame}
\begin{frame}[fragile]
\footnotesize
\begin{verbatim}
{...}
(<comb wraplevel=1 (let1)
(let1 lambda (vau se (p b1) (wrap (eval (array vau p b1) se)))
(lambda (n) (* n 2))
)
; impl of let1
> (vau de (s v b) (eval (array (array vau (array s) b) (eval v de))
de)))
\end{verbatim}
\end{frame}
\begin{frame}[fragile]
\footnotesize
\begin{verbatim}
{...}
(<comb wraplevel=1 (let1)
(let1 lambda (vau se (p b1) (wrap (eval (array vau p b1) se)))
(lambda (n) (* n 2))
)
; impl of let1
> <comb wraplevel=0 de (s v b) (eval (array (array vau (array s) b)
(eval v de)) de)>)
\end{verbatim}
\end{frame}
\begin{frame}[fragile]
\footnotesize
\begin{verbatim}
{let1: <comb wraplevel=0 de (s v b)
(eval (array (array vau (array s) b) (eval v de)) de)> | upper: {...}}
(let1 lambda (vau se (p b1) (wrap (eval (array vau p b1) se)))
(lambda (n) (* n 2)))
\end{verbatim}
\end{frame}
\begin{frame}[fragile]
\footnotesize
\begin{verbatim}
{let1: ... | upper: {...}}
(<comb wraplevel=0 de (s v b) (eval (array (array vau (array s) b)
(eval v de)) de)>
lambda
(vau se (p b1) (wrap (eval (array vau p b1) se)))
(lambda (n) (* n 2))
)
\end{verbatim}
\end{frame}
\begin{frame}[fragile]
Note the de in the environment being the environment the combiner was called in,
as well as the current environment's upper being not the environment with let, but
the root environment (the static environment from the function's creation).
\footnotesize
\begin{verbatim}
{s: 'lambda,
v: ['vau 'se ['p 'b1] ['wrap ['eval ['array 'vau 'p 'b1] 'se]]],
b: ['lambda ['n] ['* 'n 2]]
de: {let1: ... | upper: {root...}} | upper: {root...}}
(eval (array (array vau (array s) b) (eval v de)) de)
\end{verbatim}
\end{frame}
\begin{frame}[fragile]
\footnotesize
\begin{verbatim}
{s: 'lambda,
v: ['vau 'se ['p 'b1] ['wrap ['eval ['array 'vau 'p 'b1] 'se]]],
b: ['lambda ['n] ['* 'n 2]]
de: {let1: ... | upper: {root...}} | upper: {root...}}
(<eval> (array (array vau (array s) b) (eval v de)) de)
\end{verbatim}
\end{frame}
\begin{frame}[fragile]
\footnotesize
\begin{verbatim}
{s: 'lambda,
v: ['vau 'se ['p 'b1] ['wrap ['eval ['array 'vau 'p 'b1] 'se]]],
b: ['lambda ['n] ['* 'n 2]]
de: {let1: ... | upper: {root...}} | upper: {root...}}
(<eval> (<array> (array vau (array s) b) (eval v de)) de)
\end{verbatim}
\end{frame}
\begin{frame}[fragile]
\footnotesize
\begin{verbatim}
{s: 'lambda,
v: ['vau 'se ['p 'b1] ['wrap ['eval ['array 'vau 'p 'b1] 'se]]],
b: ['lambda ['n] ['* 'n 2]]
de: {let1: ... | upper: {root...}} | upper: {root...}}
(<eval> (<array> (<array> vau (array s) b) (eval v de)) de)
\end{verbatim}
\end{frame}
\begin{frame}[fragile]
Ok, evaluating all parameters of the array at the same time to be (slightly) consise.
Note the replacement of de with the de environment, and that (eval v de) was fully executed to it's value. We'll see what the execution inside of eval looks like in a minute.
\footnotesize
\begin{verbatim}
{s: 'lambda,
v: ['vau 'se ['p 'b1] ['wrap ['eval ['array 'vau 'p 'b1] 'se]]],
b: ['lambda ['n] ['* 'n 2]]
de: {let1: ... | upper: {root...}} | upper: {root...}}
(<eval> (<array> (<array> <vau> ['lambda] ['lambda ['n] ['* 'n 2]])
<comb wraplevel=0 se (p b1) (wrap (eval (array vau p b1)
se))>) {let1: ...
| upper: {root...}})
\end{verbatim}
\end{frame}
\begin{frame}[fragile]
Again, let's take a few steps til we get the arrays as values
\footnotesize
\begin{verbatim}
(<eval> [ [ <vau> ['lambda] ['lambda ['n] ['* 'n 2]]]
<comb wraplevel=0 se (p b1) (wrap (eval (array vau p b1)
se))>] {let1: ...
| upper: {root...}})
\end{verbatim}
\end{frame}
\begin{frame}[fragile]
Note that now that we are inside the eval call, our environment has swapped
to that specified in the call.
\footnotesize
\begin{verbatim}
{let1: ... | upper: {root...}}
( ( <vau> (lambda) (lambda (n) (* n 2)))
<comb wraplevel=0 se (p b1) (wrap (eval (array vau p b1) se))>)
\end{verbatim}
\end{frame}
\begin{frame}[fragile]
\footnotesize
\begin{verbatim}
{let1: ... | upper: {root...}}
( <comb wraplevel=0 (lambda) (lambda (n) (* n 2))>
<comb wraplevel=0 se (p b1) (wrap (eval (array vau p b1) se))>)
\end{verbatim}
Ok, finally the let1 has reduced to a function application
\end{frame}
\begin{frame}[fragile]
\footnotesize
\begin{verbatim}
{lambda: <comb wraplevel=0 se (p b1)
(wrap (eval (array vau p b1) se))>
| upper: {let1: ... }}
(lambda (n) (* n 2))
\end{verbatim}
\end{frame}
\begin{frame}[fragile]
\footnotesize
\begin{verbatim}
{lambda: ...}
(<comb wraplevel=0 se (p b1) (wrap (eval (array vau p b1) se))>
(n) (* n 2))
\end{verbatim}
\end{frame}
\begin{frame}[fragile]
\footnotesize
\begin{verbatim}
{p: ['n],
b1: ['* 'n 2],
se:{lambda: ...} | upper: {let1: ...}}
(wrap (eval (array vau p b1) se))
\end{verbatim}
\end{frame}
\begin{frame}[fragile]
\footnotesize
\begin{verbatim}
{p: ['n],
b1: ['* 'n 2],
se:{lambda: ...} | upper: {let1: ...}}
(<wrap> (eval (array vau p b1) se))
\end{verbatim}
\end{frame}
\begin{frame}[fragile]
We'll evaluate a few parameters at a time again
\footnotesize
\begin{verbatim}
{p: ['n],
b1: ['* 'n 2],
se:{lambda: ...} | upper: {let1: ...}}
(<wrap> (<eval> (<array> <vau> ['n] ['* 'n 2]) {lambda: ...}))
\end{verbatim}
\end{frame}
\begin{frame}[fragile]
\footnotesize
\begin{verbatim}
{p: ['n],
b1: ['* 'n 2],
se:{lambda: ...} | upper: {let1: ...}}
(<wrap> (<eval> [<vau> ['n] ['* 'n 2]] {lambda: ...}))
\end{verbatim}
\end{frame}
\begin{frame}[fragile]
\footnotesize
\begin{verbatim}
{p: ['n],
b1: ['* 'n 2],
se:{lambda: ...} | upper: {let1: ...}}
(<wrap> <comb wraplevel=0 (n) (* n 2)>)
\end{verbatim}
\end{frame}
\begin{frame}[fragile]
\footnotesize
\begin{verbatim}
<comb wraplevel=1 (n) (* n 2)>
\end{verbatim}
\end{frame}
\begin{frame}
\frametitle{Conclusion: slow}
\begin{enumerate}
\item<1-> Look at all of the steps it took to simply get a function value that multiplies by 2!
\item<2-> This would make our program much slower if this happened at runtime, for every function in the program.
\item<3-> What's the solution? Partial Evaluation!
\end{enumerate}
\end{frame}
\begin{frame}
\frametitle{Partial Eval: How it works}
\begin{enumerate}
\item<1-> Evaluate as much as possible ahead of time, at compile time.
\item<2-> If some call sites are indeterminate, they can still be compiled, but there will have to be a runtime check inserted that splits evaluation based on if the combiner evaluates its parameters or not, and eval and all builtins will have to be compiled into the resulting executable.
\item<3-> When compiling in the wraplevel=1 side of conditional, further partial evaluate the parameter value
\end{enumerate}
\end{frame}
\begin{frame}[fragile]
Partial evaluation could have done all the work from that last big example at compile time, leaving only the final value to be compiled:
\footnotesize
\begin{verbatim}
<comb wraplevel=1 (n) (* n 2)>
\end{verbatim}
Additionally, if this was a more complex function that used other functions, those functions would also generally be fully partially evaluated at compile time.
It's the full power of Vau/Combiners/Fexprs with the expected runtime performance of Scheme!
\end{frame}
\begin{frame}
\frametitle{Partial Eval: Current Status}
\begin{enumerate}
\item<1-> No longer *super* slow
\item<2-> Fixed most BigO algo problems (any naive traversal is exponential)
\item<3-> Otherwise, the implementation is slow (pure function, Chicken Scheme not built for it, mostly un-profiled and optimized, etc)
\item<4-> Compiles wraplevel=0 combs to a assert(false), but simple to implement.
\item<5-> Working through bugs - right now figuring out why some things don't partially evaluate as far as they should
\end{enumerate}
\end{frame}
\begin{frame}
\frametitle{Partial Eval: Future: Type System Hints}
Allow type systems to be built using Vaus, like the type-systems-as-macros paper (\url{https://www.ccs.neu.edu/home/stchang/pubs/ckg-popl2017.pdf}).
This type system could pass down type hints to the partial evaluator, enabling:
\begin{enumerate}
\item<2-> Compiletime: Drop optimizing compiled version if wraplevel=0
\item<3-> Compiletime: Drop emitting constant code for if wraplevel=1
\item<4-> Runtime: Eliminate branch on wrap level
\item<5-> Runtime: Eliminate other typechecks for builtin functions
\end{enumerate}
\end{frame}
\end{document}

306
doc/psudocode.txt
View File

@@ -1,306 +0,0 @@
Key Contributions to look out for that make this work in practical time:
1. First class environments that:
a. Have IDs
b. Can either be "real", in which case it maps symbols to values,
or "fake", in which case it maps symbols to themselves, but with the env ID as it's for-progress
c. Chain up to an upper environment that may be fake or real
2. AST nodes that maintain on-node:
a. The IDs of environments that, if "real", can be used to make progress in this subtree
b. The hashes of infinite recursive calls that were detected and stopped - if this hash isn't in the current call chain, this subtree can make progress
c. Extra IDs of environments that are "real" but have "fake" environments in their chain - this is used to make return value checking fast O(1 or log n, depending)
3. Combiners, both user-defined and built in (including that maintain a "wrap level" that:
a. Is a property of this function value, *not* the function itself
* meaning that if wrap_level > 1, you can evaluate each parameter and decrement wrap_level, even if you can't execute the call
4. The return value of a combiner is checked for:
a. If it is a value, in which case it is good to be returned if it doesn't contain a reference to the envID of the function it is being returned from
b. If it is (veval something env) where env doesn't contain a reference to the envID of the function it is being returned from
c. If it is a call to a function (func params...) and func doesn't take in a dynamic environment and params... are all good to be returned
This makes it so that combiner calls can return partially-evaluated code - any macro-like combiner would calculate the new code and return
(eval <constructed-code> dynamic_env), which would do what partial evaluation it could and either become a value or a call like case "b" above.
Case "b" allows this code essentially "tagged" with the environment it should be evaluated in to be returned out of "macro-like" combiners,
and this dovetails with the next point
5. The (veval something env) form essentially "tags" a piece of code with the environment it should be evaluated in. At each stage where
it is possible, the system checks for redundent constructions like these, where the env in (veval something env) is the currently active env.
In this case, it unwraps it to just "something" and continues on - this completes the second half of the macro-like combiner evaluation where
after being returned to the calling function the code is essentially spliced in.
6. The compiler can emit if/else branches on the wrap_level of combiners and in each branch further compile/partial eval if appropriate, allowing
dynamic calls to either functions or combiners with the overhead of a single branch
Note that points 4&5 make it so that any macro written as a combiner in "macro-style" will be expanded just like a macro would and cause no runtime overhead!
Additionally, point 6 makes it so that functions (wrap level 1 combiners) and non-parameter-evaluating (wrap level 0) combiners can be dynamically passed around and called with very minimal overhead.
Combine them together and you get a simpler but more flexiable semantics than macro based (pure functional) languages with little-to-no overhead.
Additional tricky spots to look out for:
1. If you don't do the needed-for-progress tracking, you have exponential runtime
2. If you aren't careful about storing analysis information on the AST node itself or memoize, a naive tree traversal of the DAG has exponential runtime
3. Infinite recursion can hide in sneaky places, including the interply between the partial evaluator and the compiler, and careful use of multiple recursion blockers / memoization is needed to prevent all cases
4. The invarients needed to prevent mis-evaluation are non-trivial to get right. Our invarients:
a. All calls to user-combiners have the parameters as total values, thus not moving something that needs a particular environment underneath a different environment
b. All return values from functions must not depend on the function's environment (there are a couple of interesting cases here, see combiner_return_ok(func_result, env_id))
c. All array values are made up of total values
d. Some primitive combiners don't obey "a", but they must be written with extreme care, and often partially evaluate only some of their parameters and have to keep track of which.
Everything operates on AST nodes, an ADT:
* val - integers, strings, booleans
* marked_array
* marked_symbol
* comb
* prim_comb
* marked_env
Each AST node contains a hash representing it&it's subtree.
fun needed_for_progress(ast_node) -> (progress_IDs, rec_stopping_hashes, extra_IDs):
returns
- environment IDs (stored in each AST node for it and it's children)
that must have real values if the partial evaluation of the subtree rooted at
this node is going to make progress partial evaluating.
progress_IDs is either true (meaning it will make progress no matter what), an
intset of env IDs (the ones that will cause it to make progress), or an empty
set, meaning it can't make forward progress no matter what
- hashes that if you're not inside the evaluation of, it could make progress
- extra IDs for envs it contains that don't count as forward progress IDs because the
env does have values, but envs in it's parent chain doesn't have values.
The calculation for needed_for_progress is straightforward-ish, with some tricky bits at comb and array.
Under these definitions, we call an AST subtree a "total val" if it is either a val or it's needed-for-progress IDs is nil.
fun mark(x, eval_pos):
x is env -> error
x is combiner -> error
x is symbol -> if x == true than MarkedVal(true)
else if x == false than MarkedVal(false)
else MarkedSymbol(x, needed_IDs=if eval_pos true else nil)
x is array ->
MarkedArray(is_val=!eval_pos, attempted=false, resume_hashes=nil,
values = [mark(x[0], eval_pos)] + [mark(xi, false) for xi in x[1:]])
true -> MarkedVal(x)
fun strip(x) -> value:
if X is an AST node representing a value, it returns the value.
May strip recursively in the case of an array value, etc.
Errors on env, comb (but not prim_comb!) non value symbols or arrays
fun try_unval(x) -> Result<ASTNode>:
//Removes one level of "value-ness".
x is Array -> if !x.array_is_val Error()
else Ok(MarkedArray(is_value=false,
values = [try_unval(x.values[0])] + x.values[1:]))
x is Symbol -> if !x.symbol_is_val Error()
else Ok(MarkedSymbol(symbol=x.symbol, is_value=false))
true -> Ok(x)
fun check_for_env_id_in_result(env_id, x):
return env_id in <either progress_IDs or extra_IDs in needed_for_progress(x)>
if either progress_IDs or extra_IDs is true, then we have a fallback, but
that doesn't get called even on large testcases so it's either rare or impossible.
Fallback is slow though, whereas this is just a check for set membership
// We only allow returning a value out of a combiner if the return value
// doesn't reference the environment of the combiner
fun combiner_return_ok(func_result, env_id):
func_result isn't later -> !check_for_env_id_in_result(env_id, func_result)
// special cases now
(veval body {env}) => (combiner_return_ok {env})
// The reason we don't have to check body is that this form is only creatable in ways that body was origionally a value and only need {env}
// Either it's created by eval, in which case it's fine, or it's created by something like (eval (array veval x de) de2) and the array has checked it,
// or it's created via literal vau invocation, in which case the body is a value.
(func ...params) => func doesn't take dynamic env && all params are combiner_return_ok
otherwise -> false
// We may end up in situations where the value/code we care about is wrapped up in
// a redundent call to veval, namely after sucessfully returning based on combiner_return_ok above.
// This call may prevent other optimizations though, so we should unwrap the redundent call if possible,
// and if it causes a change we should re-partially-evaluate to make further progress if we can
fun drop_redundent_veval(x, dynamic_env, env_stack, memostuff):
(veval node env) if env.id == dynamic_env.id -> drop_redundent_veval(node, dynamic_env, env_stack, memostuff)
(comb params...) if comb.wrap_level != -1 -> map drop_redundent_veval over params and if any change: partial_eval( (comb new_params...), dynamic_env, env_stack, memostuff)
else: x
else -> x
fun make_tmp_inner_env(params, de?, ue, env_id):
...
fun partial_eval_helper(x, only_head, env, env_stack, memostuff, force):
needed, hashes, _extra = needed_for_partial_eval(x)
if force || one of hashes is not in memostuff || needed == true || set_intersection(needed, env_stack.set_of_ids_that_are_vals) != empty_set:
x is MarkedVal -> x
x is MarkedEnv -> find(x.env_id == it.env_id, env_stack) ?: x
x is MarkedComb -> if !env.is_real && !x.se.is_real // both aren't real, re-evaluation of closure creation site
|| env.is_real && !x.se.is_real // new env real, but se isn't - the creation of the closure!
then let inner_env = make_tmp_inner_env(x.params, x.de?, env, x.env_id)
in MarkedComb(se=env, body=partial_eval_helper(body, false, inner_env, <add inner_env to env_stack>, memostuff, false))
x is MarkedPrimComb -> x
x is MarkedSymbol -> if x.is_val then x
else env_lookup_helper(x, env)
x is MarkedArray -> if x.is_val then x
else let
comb = partial_eval_helper(x.values[0], only_head=true, env, env_stack, memostuff, false)
params = x.values[1:]
if later_head?(comb) return MarkedArray(values=[comb]+params)
if comb.needed_for_progress == true:
comb = partial_eval_helper(comb, only_head=false, ...)
// If not -1, we always partial eval, if >0 we also unval/partial eval to do one full round of eval
wrap_level = comb.wrap_level
while wrap_level >= 0:
if wrap_level >= 1:
params = map(unval, map(\x. partial_eval_helper(x, ...), params))
params = map(\x. partial_eval_helper(x, ...), params)
wrap_level -= 1
if <any of the above error, or couldn't be unvaled yet>:
return MarkedArray(values=[comb.with_wrap_level(wrap_level)] + <params at whatever level they were sucessfully evaluated to>)
if comb is MarkedPrimComb:
result = comb.impl(params)
if result == 'LATER:
return MarkedArray(values=[comb.with_wrap_level(wrap_level)] + params)
else:
return result
if comb.is_varadic:
params = params[:comb.params.len-1] + [ params[comb.params.len-1:] ]
inner_env = MarkedEnv(id=comb.env_id, possible_de_symbol=comb.de?, possible_de=env, symbols=comb.params, values=params, upper=comb.se)
rec_stop_hash = combine_hash(inner_env.hash, comb.body.hash)
if rec_stop_hash in memostuff:
return MarkedArray(values=[comb] + params, transient_needed_env_id=true, rec_stopping_hash=rec_stop_hash)
memostuff.add(rec_stop_hash)
result = partial_eval_helper(body, false, inner_env, <add inner_env to env_stack>, memostuff, false)
memostuff.remove(rec_stop_hash)
if !combiner_return_ok(result, comb.env_id):
transiently_needed = if comb.de? != nil then env.id else nil
return MarkedArray(values=[comb] + params, transient_needed_env_id=transiently_needed, rec_stopping_hash=rec_stop_hash)
return drop_redundent_veval(result, env, env_stack, memostuff)
And then we define a root_env with PrimComb versions of all of the standard functions.
The ones that are most interesting and interact the most with partial evaluation are
vau eval cond
The other key is that array only takes in values, that is an array value never hides something that isn't a total value and needs more partial-evaluation
(this makes a lot of things simpler in other places since we can treat array values as values no matter what and know things aren't hiding in sneaky places)
fun needs_params_prim(...):
...
fun give_up_params_prim(...):
...
fun veval_inner(only_head, de, env_stack, memostuff, params):
body = params[0]
implicent_env = len(params) != 2
eval_env = if implicit_env { de } else { partial_eval_helper(params[1], only_head, de, env_stack, memostuff, false) }
evaled_body = partial_eval_helper(body, only_head, eval_env, env_stack, memostuff, false)
if implicit_env or combiner_return_ok(evaled_body, eval_env.idx):
return drop_redundent_veval(evaled_body, de, env_stack, memostuff)
else:
return drop_redundent_veval(MarkedArray(values=[MarkedPrimComb('veval, wrap_level=-1, val_head_ok=true, handler=veval_inner), evaled_body, eval_env], de, env_stack, memostuff)
root_env = {
eval: MarkedPrimComb('eval, wrap_level=1, val_head_ok=true, handler=lambda(only_head, de, env_stack, memostuff, params):
let
body = params[0]
implicit_env = len(params) != 2
return veval_inner(only_head, de, env_stack, memostuff, if implicit_env { [try_unval(body)] } else { [try_unval(body), params[1]] })
)
vapply: MarkedPrimComb('vapply, wrap_level=1, val_head_ok=true, handler=lambda(only_head, de, env_stack, memostuff, [func params env]):
return veval_inner(only_head, de, env_stack, memostuff, [MarkedArray(values=[func]+params), env)
)
lapply: MarkedPrimComb('lapply, wrap_level=1, val_head_ok=true, handler=lambda(only_head, de, env_stack, memostuff, [func params env]):
return veval_inner(only_head, de, env_stack, memostuff, [MarkedArray(values=[func.offset_wrap_level(-1)]+params), env)
)
vau: MarkedPrimComb('vau, wrap_level=0, val_head_ok=true, handler=lambda(only_head, de, env_stack, memostuff, params):
let
de? = if len(params) == 3 { params[0].symbol_value } else { nil }
params = map(lambda(x): s.symbol_value, if de? { params[1] } else { params[0] })
varadic = '& in params
params.remove('&)
implicit_env = len(params) != 2
body = try_unval(if de? { params[2] } else { params[1] })
env_id = <new_id>
if !only_head:
inner_env = make_tmp_inner_env(params, de?, upper=de, id=env_id)
body = partial_eval_helper(body, false, inner_env, <add inner_env to env_stack>, memostuff, false)
return MarkedComb(wrap_level=0, id=new_id, de?=de?, static_env=de, variadic=varadic, params=params, body=body)
)
wrap: ...<returns new MarkedPrimComb/MarkedComb with incremented wrap_level>...
unwrap: ...<returns new MarkedPrimComb/MarkedComb with decremented wrap_level>...
cond: ...
...Oddly tricky - is wrap_level 0, but...
... 1. unvals & partially evaluates starting from the first condition
... 2. if this condition is true, return the unvald & partially evaluated corresponding arm
... 3. if this condition is false, drop the arm and return to 1
... 4. In this case, we have an unknown between true & false
... 5. check to see if combine_hash(x.hash, env.hash) is in memostuff (prevent infinite recursion blocked on a cond guard!)
... 6. if the hash was in memostuff, return MarkedArray(later_hash=the_hash,
... values=[MarkedPrimComb('vcond,wraplevel=-1,...)] + map(unval, <remaining preds/arms>))
... 7. else new_preds_arms = map(partial_eval..., map(unval, <remaining preds/arms>))
... <TODO: 8. remove arms/preds now guarenteed to be false, remove all arms/preds after first true>
... 9. return MarkedArray(values=[MarkedPrimComb('vcond,wraplevel=-1,...)] + new_preds)
...
...The vcond is like cond but doesn't do any unvaling (as it's already been done) (and wrap_level is set to -1 so the function call machinery doesn't touch the params either)
...
symbol?: needs_params_prim(symbol?)
int?: needs_params_prim(int?)
string?: needs_params_prim(string?)
combiner?: ...
env?: ...
nil?: needs_params_prim(nil?)
bool?: needs_params_prim(bool?)
str-to-symbol: needs_params_prim(str-to-symbol)
get-text: needs_params_prim(get-text)
array?: ...
array: ...
len: ...
idx: ...
slice: ...
concat: ...
+: needs_params_prim(+)
-: needs_params_prim(-)
*: needs_params_prim(*)
/: needs_params_prim(/)
%: needs_params_prim(%)
band: needs_params_prim(band)
bor: needs_params_prim(bor)
bnot: needs_params_prim(bnot)
bxor: needs_params_prim(bxor)
<<: needs_params_prim(<<)
>>: needs_params_prim(>>)
=: needs_params_prim(=)
!=: needs_params_prim(!=)
<: needs_params_prim(<)
<=: needs_params_prim(<=)
>: needs_params_prim(>)
>=: needs_params_prim(>=)
str: needs_params_prim(true_str)
log: give_up_params_prim(log)
error: give_up_params_prim(error)
read-string: needs_params_prim(read-string)
empty_env: MarkedEnv()
}
fun compile(...):
...
... tagged words, etc
... eval
... vau / vau helper closure
...
Note that when it's compiling a call, it compiles an if/else chain on the wrap level of the combiner being called.
in the 0 branch, it emits the parameters as constant data
in the 1 branch, it unval's and partial evals all of the parameters before compiling them.
- note that this must be robust to partial-eval errors, as this branch might not ever happen at runtime and be nonsense code!
- if the partial evaluation errors, it emits a value that will cause an error at runtime into the compiled code
in the > 1 branch, it errors
...
...
Must be careful about infiniate recursion, including tricky cases that infinitly ping back and forth between
partial eval and compile even though both have individual internal recursion checks
...

11
doc/shell.nix
View File

@@ -1,11 +0,0 @@
let
sources = import ./nix/sources.nix;
pkgs = import sources.nixpkgs { };
in
pkgs.mkShell {
buildInputs = with pkgs; [
texlive.combined.scheme-full
evince
];
}

263
doc/writeup.tex
View File

@@ -1,263 +0,0 @@
%%
%% This is file `sample-acmsmall.tex',
%% generated with the docstrip utility.
%%
%% The original source files were:
%%
%% samples.dtx (with options: `acmsmall')
%%
%% IMPORTANT NOTICE:
%%
%% For the copyright see the source file.
%%
%% Any modified versions of this file must be renamed
%% with new filenames distinct from sample-acmsmall.tex.
%%
%% For distribution of the original source see the terms
%% for copying and modification in the file samples.dtx.
%%
%% This generated file may be distributed as long as the
%% original source files, as listed above, are part of the
%% same distribution. (The sources need not necessarily be
%% in the same archive or directory.)
%%
%%
%% Commands for TeXCount
%TC:macro \cite [option:text,text]
%TC:macro \citep [option:text,text]
%TC:macro \citet [option:text,text]
%TC:envir table 0 1
%TC:envir table* 0 1
%TC:envir tabular [ignore] word
%TC:envir displaymath 0 word
%TC:envir math 0 word
%TC:envir comment 0 0
%%
%%
%% The first command in your LaTeX source must be the \documentclass command.
\documentclass[acmsmall]{acmart}
%%
%% \BibTeX command to typeset BibTeX logo in the docs
\AtBeginDocument{%
\providecommand\BibTeX{{%
\normalfont B\kern-0.5em{\scshape i\kern-0.25em b}\kern-0.8em\TeX}}}
%% Rights management information. This information is sent to you
%% when you complete the rights form. These commands have SAMPLE
%% values in them; it is your responsibility as an author to replace
%% the commands and values with those provided to you when you
%% complete the rights form.
\setcopyright{acmcopyright}
\copyrightyear{2022}
\acmYear{2022}
\acmDOI{10.1145/1122445.1122456}
%%
%% These commands are for a JOURNAL article.
\acmJournal{JACM}
\acmVolume{37}
\acmNumber{4}
\acmArticle{111}
\acmMonth{8}
%%
%% Submission ID.
%% Use this when submitting an article to a sponsored event. You'll
%% receive a unique submission ID from the organizers
%% of the event, and this ID should be used as the parameter to this command.
\acmSubmissionID{123-A56-BU3}
%%
%% The majority of ACM publications use numbered citations and
%% references. The command \citestyle{authoryear} switches to the
%% "author year" style.
%%
%% If you are preparing content for an event
%% sponsored by ACM SIGGRAPH, you must use the "author year" style of
%% citations and references.
%% Uncommenting
%% the next command will enable that style.
%%\citestyle{acmauthoryear}
%%
%% end of the preamble, start of the body of the document source.
\begin{document}
%%
%% The "title" command has an optional parameter,
%% allowing the author to define a "short title" to be used in page headers.
\title{Efficient compilation of a functional Lisp based on Vau calculus}
%%
%% The "author" command and its associated commands are used to define
%% the authors and their affiliations.
%% Of note is the shared affiliation of the first two authors, and the
%% "authornote" and "authornotemark" commands
%% used to denote shared contribution to the research.
\author{Nathan Braswell}
\email{nathan.braswell@gtri.@gatech.edu}
%%\orcid{1234-5678-9012}
%%\author{G.K.M. Tobin}
%%\authornotemark[1]
%%\email{webmaster@marysville-ohio.com}
\affiliation{%
\institution{Georgia Tech}
%%\streetaddress{P.O. Box 1212}
\city{Atlanta}
\state{GA}
\country{USA}
%%\postcode{43017-6221}
}
%%
%% By default, the full list of authors will be used in the page
%% headers. Often, this list is too long, and will overlap
%% other information printed in the page headers. This command allows
%% the author to define a more concise list
%% of authors' names for this purpose.
%%\renewcommand{\shortauthors}{Trovato and Tobin, et al.}
%%
%% The abstract is a short summary of the work to be presented in the
%% article.
\begin{abstract}
Vau and Fexprs, as formulated by John Shutt \cite{shutt2010fexprs}, provide a first class and more powerful alternative to
macros. On the other hand, naively executing a language using Vau and Fexprs instead of macros is exceedingly slow,
as the code of the fexpr (analogus to a macro invocation) is re-executed at runtime, every time it is encountered.
Additionally, because it is unclear what code will be evaluated as a parameter to a function call and what code
must be passed unevaluated to a combiner, little optimization can be done. We address this problem with, to our knowledge,
the first partial evaluation system that can completely optimize away fexprs that are used and written in the style of macros,
as well as some other more naturally written combiners.
\end{abstract}
%%
%% The code below is generated by the tool at http://dl.acm.org/ccs.cfm.
%% Please copy and paste the code instead of the example below.
%%
%%\begin{CCSXML}
%%<ccs2012>
%% <concept>
%% <concept_id>10010520.10010553.10010562</concept_id>
%% <concept_desc>Computer systems organization~Embedded systems</concept_desc>
%% <concept_significance>500</concept_significance>
%% </concept>
%% <concept>
%% <concept_id>10010520.10010575.10010755</concept_id>
%% <concept_desc>Computer systems organization~Redundancy</concept_desc>
%% <concept_significance>300</concept_significance>
%% </concept>
%% <concept>
%% <concept_id>10010520.10010553.10010554</concept_id>
%% <concept_desc>Computer systems organization~Robotics</concept_desc>
%% <concept_significance>100</concept_significance>
%% </concept>
%% <concept>
%% <concept_id>10003033.10003083.10003095</concept_id>
%% <concept_desc>Networks~Network reliability</concept_desc>
%% <concept_significance>100</concept_significance>
%% </concept>
%%</ccs2012>
%%\end{CCSXML}
%%\ccsdesc[500]{Computer systems organization~Embedded systems}
%%\ccsdesc[300]{Computer systems organization~Redundancy}
%%\ccsdesc{Computer systems organization~Robotics}
%%\ccsdesc[100]{Networks~Network reliability}
%%
%% Keywords. The author(s) should pick words that accurately describe
%% the work being presented. Separate the keywords with commas.
\keywords{partial evaluation, vau, fexprs, WebAssembly}
%%
%% This command processes the author and affiliation and title
%% information and builds the first part of the formatted document.
\maketitle
\section{Introduction and Motivation}
Lisps generally have two different abstraction methods, functions and macros. Functions operate at runtime and always
evaluate their parameters, while macros operate at compiletime and do not evaluate their parameters. This generally
splits the language to a degree, and macros are not able to be used at runtime, though generally functions are
able to be used in macros, with various restrictions. The macro systems generally attempt to be hygenic, either preventing
or making it difficult to manipulate the environment of the code that the macro invocation will expand to. This is often
needed, however, and various escape hatches can be implemented.
Creating a powerful, safe, and easy to use macro system is quite difficult, and the resulting systems are often quite complex,
generally more complex than the base language in which the reside. Macros are also not first class, and cannot be passed
around as values and do not exist at all at runtime.
Vau and Fexprs, as formulated by John Shutt \cite{shutt2010fexprs}, (at \url{https://web.wpi.edu/Pubs/ETD/Available/etd-090110-124904/unrestricted/jshutt.pdf}),
provide a first class and more powerful alternative to macros, unifying functions, macros, and built-in language forms
into a single concept called a combiner. A combiner may evaluate its arguments 0 or more times,
and recieves the calling environment as an additional parameter. There is also an eval function which takes in an expression to evaluate
and an environment in which to do the evaluation. Note that functions, macros, and even built-in language constructs like if, cond, let can be implemented
as either user-defined or built-in combiners, making both macros and what were previously Lisp special forms first class! They can be named,
passed to higher-order combiners, put into datastructures, etc.
On the other hand, naively executing a language using combiners instead of macros is exceedingly slow,
as the code of the fexpr (analogus to a macro invocation) is re-executed at runtime, every time it is encountered.
Additionally, because it is unclear what code will be evaluated as a parameter to a function call and what code
must be passed unevaluated to the combiner, little optimization can be done. We address this problem with, to our knowledge,
the first partial evaluation system that can completely optimize away fexprs that are used and written in the style of macros,
as well as some other more naturally written combiners. Our language is more restricted than Shutt's Kernel language, being
purely functional and allowing no mutation, making the tracking of environments and optimization of access tractable.
All code available at \url{https://github.com/limvot/kraken}
\section{Prior Work}
\begin{itemize}
\item{} Axis of Eval list of 22 attempted implmentations - \url{https://axisofeval.blogspot.com/2011/09/kernel-underground.html} \\
None doing partial evaluation, to my knowledge. I belive all abandond or linkrotted with the seeming exception of \url{https://github.com/rocketnia/fexpress},
which is taking a very different approach (Lisp-2, explicit apply form, etc) in Racket.
\item{} Lambda The Ultimate small discussion of partial eval for Vau/Kernel - \url{http://lambda-the-ultimate.org/node/4346}
\item{} Implementing a Vau-based Language With Multiple Evaluation Strategies - \cite{kearsleyimplementing} \\
Talks about how partial evaluation could make efficient, doesn't do it.
\item{} Google Groups email thread by Andres Navarro - \url{https://groups.google.com/g/klisp/c/Dva-Le8Hr-g/m/pyl1Ufu-vksJ} \\
Andres Navarro talks about his experimental fklisp which is a "very simple functional dialect of Kernel" with no mutation or first class continuations.
It doesn't compile anything, but prints out the partially evalauted expression. Was a work in progress, ran into performance problems, seems abandond.
\end{itemize}
\subsection{Issues}
As described in the introduction, the main issue with basing a langauge off of Vau and combiners is slowness.
This comes from two main problems: one, the combiners taking the place of macros are re-executed every time
they are encountered instead of being expanded into intermediate code like in a macro system, and two, because
the compiler in general cannot tell if the combiner being called takes in its parameters by value or not, it cannot
do practically any optimization.
\section{Solution}
We partially evaluate a purely function version of this language in a nearly-single pass over the entire program.
We allow environment chains consisting of both "real" environments with every contained symbol mapped to a value and "fake" environments
that only have placeholder values. Since the language is purely functional, we know that if a symbol evaluates to a value anywhere, it
will always evaluate to that value at runtime. With this, we can notice most calls to combiners that don't evaluate their parameters
(since if we can resolve the combiner to a value, we know that will always be the combiner called at that location) and we can perform
inlining and continue partial evaluation.
If the resulting partially-evaluated program only contains static references to a subset of built in combiners and function (combiners that
evaluate their parameters exactly once), the program can be compiled just like it was a normal Scheme program.
If some call sites are indeterminate, they can still be compiled, but there will have to be a runtime check inserted that splits
evaluation based on if the combiner evaluates its parameters or not, and eval and all builtins will have to be compiled into the resulting executable.
A Vau/combiner based language allows most of the language to be built up in the language itself, as combiners. For instance, even lambda and let
are derived instead of primitive. See below, where we define both let1 (a simple version of let binding only one variable) and lambda.
\begin{verbatim}
((wrap (vau (let1)
(let1 lambda (vau se (p b1) (wrap (eval (array vau p b1) se)))
(lambda (n) (* n 2))
)
; impl of let1
)) (vau de (s v b) (eval (array (array vau (array s) b) (eval v de)) de)))
\end{verbatim}
\bibliographystyle{ACM-Reference-Format}
\bibliography{cited-paper}
\end{document}
\endinput
%%
%% End of file `sample-acmsmall.tex'.

36
fib_test/builtin_fib.kp
View File

@@ -1,36 +0,0 @@
((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 (
lcompose (lambda (g f) (lambda (& args) (lapply g (array (lapply f args)))))
rec-lambda (vau se (n p b) (eval (array Y (array lambda (array n) (array lambda p b))) se))
fib (rec-lambda fib (n) (cond (= 0 n) 1
(= 1 n) 1
true (+ (fib (- n 1)) (fib (- n 2)))))
monad (array 'write 1 "enter number to fact: " (vau (written code)
(array 'read 0 60 (vau (data code)
(array 'exit (builtin_fib (read-string data)))
))
))
) 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))

13
fib_test/clojure_fib/.gitignore vendored
View File

@@ -1,13 +0,0 @@
/target
/classes
/checkouts
profiles.clj
pom.xml
pom.xml.asc
*.jar
*.class
/.lein-*
/.nrepl-port
/.prepl-port
.hgignore
.hg/

280
fib_test/clojure_fib/LICENSE
View File

@@ -1,280 +0,0 @@
Eclipse Public License - v 2.0
THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE
PUBLIC LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR DISTRIBUTION
OF THE PROGRAM CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT.
1. DEFINITIONS
"Contribution" means:
a) in the case of the initial Contributor, the initial content
Distributed under this Agreement, and
b) in the case of each subsequent Contributor:
i) changes to the Program, and
ii) additions to the Program;
where such changes and/or additions to the Program originate from
and are Distributed by that particular Contributor. A Contribution
"originates" from a Contributor if it was added to the Program by
such Contributor itself or anyone acting on such Contributor's behalf.
Contributions do not include changes or additions to the Program that
are not Modified Works.
"Contributor" means any person or entity that Distributes the Program.
"Licensed Patents" mean patent claims licensable by a Contributor which
are necessarily infringed by the use or sale of its Contribution alone
or when combined with the Program.
"Program" means the Contributions Distributed in accordance with this
Agreement.
"Recipient" means anyone who receives the Program under this Agreement
or any Secondary License (as applicable), including Contributors.
"Derivative Works" shall mean any work, whether in Source Code or other
form, that is based on (or derived from) the Program and for which the
editorial revisions, annotations, elaborations, or other modifications
represent, as a whole, an original work of authorship.
"Modified Works" shall mean any work in Source Code or other form that
results from an addition to, deletion from, or modification of the
contents of the Program, including, for purposes of clarity any new file
in Source Code form that contains any contents of the Program. Modified
Works shall not include works that contain only declarations,
interfaces, types, classes, structures, or files of the Program solely
in each case in order to link to, bind by name, or subclass the Program
or Modified Works thereof.
"Distribute" means the acts of a) distributing or b) making available
in any manner that enables the transfer of a copy.
"Source Code" means the form of a Program preferred for making
modifications, including but not limited to software source code,
documentation source, and configuration files.
"Secondary License" means either the GNU General Public License,
Version 2.0, or any later versions of that license, including any
exceptions or additional permissions as identified by the initial
Contributor.
2. GRANT OF RIGHTS
a) Subject to the terms of this Agreement, each Contributor hereby
grants Recipient a non-exclusive, worldwide, royalty-free copyright
license to reproduce, prepare Derivative Works of, publicly display,
publicly perform, Distribute and sublicense the Contribution of such
Contributor, if any, and such Derivative Works.
b) Subject to the terms of this Agreement, each Contributor hereby
grants Recipient a non-exclusive, worldwide, royalty-free patent
license under Licensed Patents to make, use, sell, offer to sell,
import and otherwise transfer the Contribution of such Contributor,
if any, in Source Code or other form. This patent license shall
apply to the combination of the Contribution and the Program if, at
the time the Contribution is added by the Contributor, such addition
of the Contribution causes such combination to be covered by the
Licensed Patents. The patent license shall not apply to any other
combinations which include the Contribution. No hardware per se is
licensed hereunder.
c) Recipient understands that although each Contributor grants the
licenses to its Contributions set forth herein, no assurances are
provided by any Contributor that the Program does not infringe the
patent or other intellectual property rights of any other entity.
Each Contributor disclaims any liability to Recipient for claims
brought by any other entity based on infringement of intellectual
property rights or otherwise. As a condition to exercising the
rights and licenses granted hereunder, each Recipient hereby
assumes sole responsibility to secure any other intellectual
property rights needed, if any. For example, if a third party
patent license is required to allow Recipient to Distribute the
Program, it is Recipient's responsibility to acquire that license
before distributing the Program.
d) Each Contributor represents that to its knowledge it has
sufficient copyright rights in its Contribution, if any, to grant
the copyright license set forth in this Agreement.
e) Notwithstanding the terms of any Secondary License, no
Contributor makes additional grants to any Recipient (other than
those set forth in this Agreement) as a result of such Recipient's
receipt of the Program under the terms of a Secondary License
(if permitted under the terms of Section 3).
3. REQUIREMENTS
3.1 If a Contributor Distributes the Program in any form, then:
a) the Program must also be made available as Source Code, in
accordance with section 3.2, and the Contributor must accompany
the Program with a statement that the Source Code for the Program
is available under this Agreement, and informs Recipients how to
obtain it in a reasonable manner on or through a medium customarily
used for software exchange; and
b) the Contributor may Distribute the Program under a license
different than this Agreement, provided that such license:
i) effectively disclaims on behalf of all other Contributors all
warranties and conditions, express and implied, including
warranties or conditions of title and non-infringement, and
implied warranties or conditions of merchantability and fitness
for a particular purpose;
ii) effectively excludes on behalf of all other Contributors all
liability for damages, including direct, indirect, special,
incidental and consequential damages, such as lost profits;
iii) does not attempt to limit or alter the recipients' rights
in the Source Code under section 3.2; and
iv) requires any subsequent distribution of the Program by any
party to be under a license that satisfies the requirements
of this section 3.
3.2 When the Program is Distributed as Source Code:
a) it must be made available under this Agreement, or if the
Program (i) is combined with other material in a separate file or
files made available under a Secondary License, and (ii) the initial
Contributor attached to the Source Code the notice described in
Exhibit A of this Agreement, then the Program may be made available
under the terms of such Secondary Licenses, and
b) a copy of this Agreement must be included with each copy of
the Program.
3.3 Contributors may not remove or alter any copyright, patent,
trademark, attribution notices, disclaimers of warranty, or limitations
of liability ("notices") contained within the Program from any copy of
the Program which they Distribute, provided that Contributors may add
their own appropriate notices.
4. COMMERCIAL DISTRIBUTION
Commercial distributors of software may accept certain responsibilities
with respect to end users, business partners and the like. While this
license is intended to facilitate the commercial use of the Program,
the Contributor who includes the Program in a commercial product
offering should do so in a manner which does not create potential
liability for other Contributors. Therefore, if a Contributor includes
the Program in a commercial product offering, such Contributor
("Commercial Contributor") hereby agrees to defend and indemnify every
other Contributor ("Indemnified Contributor") against any losses,
damages and costs (collectively "Losses") arising from claims, lawsuits
and other legal actions brought by a third party against the Indemnified
Contributor to the extent caused by the acts or omissions of such
Commercial Contributor in connection with its distribution of the Program
in a commercial product offering. The obligations in this section do not
apply to any claims or Losses relating to any actual or alleged
intellectual property infringement. In order to qualify, an Indemnified
Contributor must: a) promptly notify the Commercial Contributor in
writing of such claim, and b) allow the Commercial Contributor to control,
and cooperate with the Commercial Contributor in, the defense and any
related settlement negotiations. The Indemnified Contributor may
participate in any such claim at its own expense.
For example, a Contributor might include the Program in a commercial
product offering, Product X. That Contributor is then a Commercial
Contributor. If that Commercial Contributor then makes performance
claims, or offers warranties related to Product X, those performance
claims and warranties are such Commercial Contributor's responsibility
alone. Under this section, the Commercial Contributor would have to
defend claims against the other Contributors related to those performance
claims and warranties, and if a court requires any other Contributor to
pay any damages as a result, the Commercial Contributor must pay
those damages.
5. NO WARRANTY
EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, AND TO THE EXTENT
PERMITTED BY APPLICABLE LAW, THE PROGRAM IS PROVIDED ON AN "AS IS"
BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, EITHER EXPRESS OR
IMPLIED INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES OR CONDITIONS OF
TITLE, NON-INFRINGEMENT, MERCHANTABILITY OR FITNESS FOR A PARTICULAR
PURPOSE. Each Recipient is solely responsible for determining the
appropriateness of using and distributing the Program and assumes all
risks associated with its exercise of rights under this Agreement,
including but not limited to the risks and costs of program errors,
compliance with applicable laws, damage to or loss of data, programs
or equipment, and unavailability or interruption of operations.
6. DISCLAIMER OF LIABILITY
EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, AND TO THE EXTENT
PERMITTED BY APPLICABLE LAW, NEITHER RECIPIENT NOR ANY CONTRIBUTORS
SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING WITHOUT LIMITATION LOST
PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
ARISING IN ANY WAY OUT OF THE USE OR DISTRIBUTION OF THE PROGRAM OR THE
EXERCISE OF ANY RIGHTS GRANTED HEREUNDER, EVEN IF ADVISED OF THE
POSSIBILITY OF SUCH DAMAGES.
7. GENERAL
If any provision of this Agreement is invalid or unenforceable under
applicable law, it shall not affect the validity or enforceability of
the remainder of the terms of this Agreement, and without further
action by the parties hereto, such provision shall be reformed to the
minimum extent necessary to make such provision valid and enforceable.
If Recipient institutes patent litigation against any entity
(including a cross-claim or counterclaim in a lawsuit) alleging that the
Program itself (excluding combinations of the Program with other software
or hardware) infringes such Recipient's patent(s), then such Recipient's
rights granted under Section 2(b) shall terminate as of the date such
litigation is filed.
All Recipient's rights under this Agreement shall terminate if it
fails to comply with any of the material terms or conditions of this
Agreement and does not cure such failure in a reasonable period of
time after becoming aware of such noncompliance. If all Recipient's
rights under this Agreement terminate, Recipient agrees to cease use
and distribution of the Program as soon as reasonably practicable.
However, Recipient's obligations under this Agreement and any licenses
granted by Recipient relating to the Program shall continue and survive.
Everyone is permitted to copy and distribute copies of this Agreement,
but in order to avoid inconsistency the Agreement is copyrighted and
may only be modified in the following manner. The Agreement Steward
reserves the right to publish new versions (including revisions) of
this Agreement from time to time. No one other than the Agreement
Steward has the right to modify this Agreement. The Eclipse Foundation
is the initial Agreement Steward. The Eclipse Foundation may assign the
responsibility to serve as the Agreement Steward to a suitable separate
entity. Each new version of the Agreement will be given a distinguishing
version number. The Program (including Contributions) may always be
Distributed subject to the version of the Agreement under which it was
received. In addition, after a new version of the Agreement is published,
Contributor may elect to Distribute the Program (including its
Contributions) under the new version.
Except as expressly stated in Sections 2(a) and 2(b) above, Recipient
receives no rights or licenses to the intellectual property of any
Contributor under this Agreement, whether expressly, by implication,
estoppel or otherwise. All rights in the Program not expressly granted
under this Agreement are reserved. Nothing in this Agreement is intended
to be enforceable by any entity that is not a Contributor or Recipient.
No third-party beneficiary rights are created under this Agreement.
Exhibit A - Form of Secondary Licenses Notice
"This Source Code may also be made available under the following
Secondary Licenses when the conditions for such availability set forth
in the Eclipse Public License, v. 2.0 are satisfied: GNU General Public
License as published by the Free Software Foundation, either version 2
of the License, or (at your option) any later version, with the GNU
Classpath Exception which is available at
https://www.gnu.org/software/classpath/license.html."
Simply including a copy of this Agreement, including this Exhibit A
is not sufficient to license the Source Code under Secondary Licenses.
If it is not possible or desirable to put the notice in a particular
file, then You may include the notice in a location (such as a LICENSE
file in a relevant directory) where a recipient would be likely to
look for such a notice.
You may add additional accurate notices of copyright ownership.

10
fib_test/clojure_fib/project.clj
View File

@@ -1,10 +0,0 @@
(defproject clojure_fib "0.1.0-SNAPSHOT"
:description "FIXME: write description"
:url "http://example.com/FIXME"
:license {:name "EPL-2.0 OR GPL-2.0-or-later WITH Classpath-exception-2.0"
:url "https://www.eclipse.org/legal/epl-2.0/"}
:dependencies [[org.clojure/clojure "1.10.3"]]
:main ^:skip-aot clojure-fib.core
:target-path "target/%s"
:profiles {:uberjar {:aot :all
:jvm-opts ["-Dclojure.compiler.direct-linking=true"]}})

14
fib_test/clojure_fib/src/clojure_fib/core.clj
View File

@@ -1,14 +0,0 @@
(ns clojure-fib.core
(:gen-class))
(defn fib
[n]
(cond (= n 0) 1
(= n 1) 1
:else (+ (fib (- n 1)) (fib (- n 2)))))
(defn -main
"I don't do a whole lot ... yet."
[& args]
(println "Enter to fib: ")
(println "was " (fib (Integer/parseInt (read-line)))))

13
fib_test/clojure_hi/.gitignore vendored
View File

@@ -1,13 +0,0 @@
/target
/classes
/checkouts
profiles.clj
pom.xml
pom.xml.asc
*.jar
*.class
/.lein-*
/.nrepl-port
/.prepl-port
.hgignore
.hg/

280
fib_test/clojure_hi/LICENSE
View File

@@ -1,280 +0,0 @@
Eclipse Public License - v 2.0
THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE
PUBLIC LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR DISTRIBUTION
OF THE PROGRAM CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT.
1. DEFINITIONS
"Contribution" means:
a) in the case of the initial Contributor, the initial content
Distributed under this Agreement, and
b) in the case of each subsequent Contributor:
i) changes to the Program, and
ii) additions to the Program;
where such changes and/or additions to the Program originate from
and are Distributed by that particular Contributor. A Contribution
"originates" from a Contributor if it was added to the Program by
such Contributor itself or anyone acting on such Contributor's behalf.
Contributions do not include changes or additions to the Program that
are not Modified Works.
"Contributor" means any person or entity that Distributes the Program.
"Licensed Patents" mean patent claims licensable by a Contributor which
are necessarily infringed by the use or sale of its Contribution alone
or when combined with the Program.
"Program" means the Contributions Distributed in accordance with this
Agreement.
"Recipient" means anyone who receives the Program under this Agreement
or any Secondary License (as applicable), including Contributors.
"Derivative Works" shall mean any work, whether in Source Code or other
form, that is based on (or derived from) the Program and for which the
editorial revisions, annotations, elaborations, or other modifications
represent, as a whole, an original work of authorship.
"Modified Works" shall mean any work in Source Code or other form that
results from an addition to, deletion from, or modification of the
contents of the Program, including, for purposes of clarity any new file
in Source Code form that contains any contents of the Program. Modified
Works shall not include works that contain only declarations,
interfaces, types, classes, structures, or files of the Program solely
in each case in order to link to, bind by name, or subclass the Program
or Modified Works thereof.
"Distribute" means the acts of a) distributing or b) making available
in any manner that enables the transfer of a copy.
"Source Code" means the form of a Program preferred for making
modifications, including but not limited to software source code,
documentation source, and configuration files.
"Secondary License" means either the GNU General Public License,
Version 2.0, or any later versions of that license, including any
exceptions or additional permissions as identified by the initial
Contributor.
2. GRANT OF RIGHTS
a) Subject to the terms of this Agreement, each Contributor hereby
grants Recipient a non-exclusive, worldwide, royalty-free copyright
license to reproduce, prepare Derivative Works of, publicly display,
publicly perform, Distribute and sublicense the Contribution of such
Contributor, if any, and such Derivative Works.
b) Subject to the terms of this Agreement, each Contributor hereby
grants Recipient a non-exclusive, worldwide, royalty-free patent
license under Licensed Patents to make, use, sell, offer to sell,
import and otherwise transfer the Contribution of such Contributor,
if any, in Source Code or other form. This patent license shall
apply to the combination of the Contribution and the Program if, at
the time the Contribution is added by the Contributor, such addition
of the Contribution causes such combination to be covered by the
Licensed Patents. The patent license shall not apply to any other
combinations which include the Contribution. No hardware per se is
licensed hereunder.
c) Recipient understands that although each Contributor grants the
licenses to its Contributions set forth herein, no assurances are
provided by any Contributor that the Program does not infringe the
patent or other intellectual property rights of any other entity.
Each Contributor disclaims any liability to Recipient for claims
brought by any other entity based on infringement of intellectual
property rights or otherwise. As a condition to exercising the
rights and licenses granted hereunder, each Recipient hereby
assumes sole responsibility to secure any other intellectual
property rights needed, if any. For example, if a third party
patent license is required to allow Recipient to Distribute the
Program, it is Recipient's responsibility to acquire that license
before distributing the Program.
d) Each Contributor represents that to its knowledge it has
sufficient copyright rights in its Contribution, if any, to grant
the copyright license set forth in this Agreement.
e) Notwithstanding the terms of any Secondary License, no
Contributor makes additional grants to any Recipient (other than
those set forth in this Agreement) as a result of such Recipient's
receipt of the Program under the terms of a Secondary License
(if permitted under the terms of Section 3).
3. REQUIREMENTS
3.1 If a Contributor Distributes the Program in any form, then:
a) the Program must also be made available as Source Code, in
accordance with section 3.2, and the Contributor must accompany
the Program with a statement that the Source Code for the Program
is available under this Agreement, and informs Recipients how to
obtain it in a reasonable manner on or through a medium customarily
used for software exchange; and
b) the Contributor may Distribute the Program under a license
different than this Agreement, provided that such license:
i) effectively disclaims on behalf of all other Contributors all
warranties and conditions, express and implied, including
warranties or conditions of title and non-infringement, and
implied warranties or conditions of merchantability and fitness
for a particular purpose;
ii) effectively excludes on behalf of all other Contributors all
liability for damages, including direct, indirect, special,
incidental and consequential damages, such as lost profits;
iii) does not attempt to limit or alter the recipients' rights
in the Source Code under section 3.2; and
iv) requires any subsequent distribution of the Program by any
party to be under a license that satisfies the requirements
of this section 3.
3.2 When the Program is Distributed as Source Code:
a) it must be made available under this Agreement, or if the
Program (i) is combined with other material in a separate file or
files made available under a Secondary License, and (ii) the initial
Contributor attached to the Source Code the notice described in
Exhibit A of this Agreement, then the Program may be made available
under the terms of such Secondary Licenses, and
b) a copy of this Agreement must be included with each copy of
the Program.
3.3 Contributors may not remove or alter any copyright, patent,
trademark, attribution notices, disclaimers of warranty, or limitations
of liability ("notices") contained within the Program from any copy of
the Program which they Distribute, provided that Contributors may add
their own appropriate notices.
4. COMMERCIAL DISTRIBUTION
Commercial distributors of software may accept certain responsibilities
with respect to end users, business partners and the like. While this
license is intended to facilitate the commercial use of the Program,
the Contributor who includes the Program in a commercial product
offering should do so in a manner which does not create potential
liability for other Contributors. Therefore, if a Contributor includes
the Program in a commercial product offering, such Contributor
("Commercial Contributor") hereby agrees to defend and indemnify every
other Contributor ("Indemnified Contributor") against any losses,
damages and costs (collectively "Losses") arising from claims, lawsuits
and other legal actions brought by a third party against the Indemnified
Contributor to the extent caused by the acts or omissions of such
Commercial Contributor in connection with its distribution of the Program
in a commercial product offering. The obligations in this section do not
apply to any claims or Losses relating to any actual or alleged
intellectual property infringement. In order to qualify, an Indemnified
Contributor must: a) promptly notify the Commercial Contributor in
writing of such claim, and b) allow the Commercial Contributor to control,
and cooperate with the Commercial Contributor in, the defense and any
related settlement negotiations. The Indemnified Contributor may
participate in any such claim at its own expense.
For example, a Contributor might include the Program in a commercial
product offering, Product X. That Contributor is then a Commercial
Contributor. If that Commercial Contributor then makes performance
claims, or offers warranties related to Product X, those performance
claims and warranties are such Commercial Contributor's responsibility
alone. Under this section, the Commercial Contributor would have to
defend claims against the other Contributors related to those performance
claims and warranties, and if a court requires any other Contributor to
pay any damages as a result, the Commercial Contributor must pay
those damages.
5. NO WARRANTY
EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, AND TO THE EXTENT
PERMITTED BY APPLICABLE LAW, THE PROGRAM IS PROVIDED ON AN "AS IS"
BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, EITHER EXPRESS OR
IMPLIED INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES OR CONDITIONS OF
TITLE, NON-INFRINGEMENT, MERCHANTABILITY OR FITNESS FOR A PARTICULAR
PURPOSE. Each Recipient is solely responsible for determining the
appropriateness of using and distributing the Program and assumes all
risks associated with its exercise of rights under this Agreement,
including but not limited to the risks and costs of program errors,
compliance with applicable laws, damage to or loss of data, programs
or equipment, and unavailability or interruption of operations.
6. DISCLAIMER OF LIABILITY
EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, AND TO THE EXTENT
PERMITTED BY APPLICABLE LAW, NEITHER RECIPIENT NOR ANY CONTRIBUTORS
SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING WITHOUT LIMITATION LOST
PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
ARISING IN ANY WAY OUT OF THE USE OR DISTRIBUTION OF THE PROGRAM OR THE
EXERCISE OF ANY RIGHTS GRANTED HEREUNDER, EVEN IF ADVISED OF THE
POSSIBILITY OF SUCH DAMAGES.
7. GENERAL
If any provision of this Agreement is invalid or unenforceable under
applicable law, it shall not affect the validity or enforceability of
the remainder of the terms of this Agreement, and without further
action by the parties hereto, such provision shall be reformed to the
minimum extent necessary to make such provision valid and enforceable.
If Recipient institutes patent litigation against any entity
(including a cross-claim or counterclaim in a lawsuit) alleging that the
Program itself (excluding combinations of the Program with other software
or hardware) infringes such Recipient's patent(s), then such Recipient's
rights granted under Section 2(b) shall terminate as of the date such
litigation is filed.
All Recipient's rights under this Agreement shall terminate if it
fails to comply with any of the material terms or conditions of this
Agreement and does not cure such failure in a reasonable period of
time after becoming aware of such noncompliance. If all Recipient's
rights under this Agreement terminate, Recipient agrees to cease use
and distribution of the Program as soon as reasonably practicable.
However, Recipient's obligations under this Agreement and any licenses
granted by Recipient relating to the Program shall continue and survive.
Everyone is permitted to copy and distribute copies of this Agreement,
but in order to avoid inconsistency the Agreement is copyrighted and
may only be modified in the following manner. The Agreement Steward
reserves the right to publish new versions (including revisions) of
this Agreement from time to time. No one other than the Agreement
Steward has the right to modify this Agreement. The Eclipse Foundation
is the initial Agreement Steward. The Eclipse Foundation may assign the
responsibility to serve as the Agreement Steward to a suitable separate
entity. Each new version of the Agreement will be given a distinguishing
version number. The Program (including Contributions) may always be
Distributed subject to the version of the Agreement under which it was
received. In addition, after a new version of the Agreement is published,
Contributor may elect to Distribute the Program (including its
Contributions) under the new version.
Except as expressly stated in Sections 2(a) and 2(b) above, Recipient
receives no rights or licenses to the intellectual property of any
Contributor under this Agreement, whether expressly, by implication,
estoppel or otherwise. All rights in the Program not expressly granted
under this Agreement are reserved. Nothing in this Agreement is intended
to be enforceable by any entity that is not a Contributor or Recipient.
No third-party beneficiary rights are created under this Agreement.
Exhibit A - Form of Secondary Licenses Notice
"This Source Code may also be made available under the following
Secondary Licenses when the conditions for such availability set forth
in the Eclipse Public License, v. 2.0 are satisfied: GNU General Public
License as published by the Free Software Foundation, either version 2
of the License, or (at your option) any later version, with the GNU
Classpath Exception which is available at
https://www.gnu.org/software/classpath/license.html."
Simply including a copy of this Agreement, including this Exhibit A
is not sufficient to license the Source Code under Secondary Licenses.
If it is not possible or desirable to put the notice in a particular
file, then You may include the notice in a location (such as a LICENSE
file in a relevant directory) where a recipient would be likely to
look for such a notice.
You may add additional accurate notices of copyright ownership.

10
fib_test/clojure_hi/project.clj
View File

@@ -1,10 +0,0 @@
(defproject clojure_hi "0.1.0-SNAPSHOT"
:description "FIXME: write description"
:url "http://example.com/FIXME"
:license {:name "EPL-2.0 OR GPL-2.0-or-later WITH Classpath-exception-2.0"
:url "https://www.eclipse.org/legal/epl-2.0/"}
:dependencies [[org.clojure/clojure "1.10.3"]]
:main ^:skip-aot clojure-hi.core
:target-path "target/%s"
:profiles {:uberjar {:aot :all
:jvm-opts ["-Dclojure.compiler.direct-linking=true"]}})

7
fib_test/clojure_hi/src/clojure_hi/core.clj
View File

@@ -1,7 +0,0 @@
(ns clojure-hi.core
(:gen-class))
(defn -main
"I don't do a whole lot ... yet."
[& args]
(println "Hello, World!"))

14
fib_test/fib.c
View File

@@ -1,14 +0,0 @@
int fib(n) {
if (n == 0) {
return 1;
} else if (n == 1) {
return 1;
} else {
return fib(n-1) + fib(n-2);
}
}
int main(int argc, char **argv) {
printf("%d\n", fib(atoi(argv[1])));
return 0;
}

36
fib_test/fib.kp
View File

@@ -1,36 +0,0 @@
((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 (
lcompose (lambda (g f) (lambda (& args) (lapply g (array (lapply f args)))))
rec-lambda (vau se (n p b) (eval (array Y (array lambda (array n) (array lambda p b))) se))
fib (rec-lambda fib (n) (cond (= 0 n) 1
(= 1 n) 1
true (+ (fib (- n 1)) (fib (- n 2)))))
monad (array 'write 1 "enter number to fact: " (vau (written code)
(array 'read 0 60 (vau (data code)
(array 'exit (fib (read-string data)))
))
))
) 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))

9
fib_test/fib.py
View File

@@ -1,9 +0,0 @@
import sys
def fib(n):
if n == 0:
return 1
elif n == 1:
return 1
else:
return fib(n-1) + fib(n-2)
print(fib(int(sys.argv[1])))

4
fib_test/fib.scm
View File

@@ -1,4 +0,0 @@
(pretty-print ((letrec ((fib (lambda (n) (cond ((equal? n 0) 1)
((equal? n 1) 1)
(#t (+ (fib (- n 1)) (fib (- n 2))))))))
fib) (read (open-input-string (list-ref (command-line) 1)))))

36
fib_test/fib2.kp
View File

@@ -1,36 +0,0 @@
((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 (
lcompose (lambda (g f) (lambda (& args) (lapply g (array (lapply f args)))))
rec-lambda (vau se (n p b) (eval (array Y (array lambda (array n) (array lambda p b))) se))
fib (lambda (n) ((lambda (fib) (fib fib n)) (lambda (fib n) (cond (= 0 n) 1
(= 1 n) 1
true (+ (fib fib (- n 1)) (fib fib (- n 2)))))))
monad (array 'write 1 "enter number to fact: " (vau (written code)
(array 'read 0 60 (vau (data code)
(array 'exit (fib (read-string data)))
))
))
) 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))

16
fib_test/fib_let.c
View File

@@ -1,16 +0,0 @@
int fib(n) {
if (n == 0) {
return 1;
} else if (n == 1) {
return 1;
} else {
int r1 = fib(n-1);
int r2 = fib(n-2);
return r1 + r2;
}
}
int main(int argc, char **argv) {
printf("%d\n", fib(atoi(argv[1])));
return 0;
}

39
fib_test/fib_let.kp
View File

@@ -1,39 +0,0 @@
((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 (
lcompose (lambda (g f) (lambda (& args) (lapply g (array (lapply f args)))))
rec-lambda (vau se (n p b) (eval (array Y (array lambda (array n) (array lambda p b))) se))
fib (rec-lambda fib (n) (cond (= 0 n) 1
(= 1 n) 1
true (let (
fib_minus_1 (fib (- n 1))
fib_minus_2 (fib (- n 2))
) (+ fib_minus_1 fib_minus_2))))
monad (array 'write 1 "enter number to fact: " (vau (written code)
(array 'read 0 60 (vau (data code)
(array 'exit (fib (read-string data)))
))
))
) 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))

11
fib_test/fib_let.py
View File

@@ -1,11 +0,0 @@
import sys
def fib(n):
if n == 0:
return 1
elif n == 1:
return 1
else:
r1 = fib(n-1)
r2 = fib(n-2)
return r1 + r2
print(fib(int(sys.argv[1])))

7
fib_test/fib_let.scm
View File

@@ -1,7 +0,0 @@
(pretty-print ((letrec ((fib (lambda (n) (cond ((equal? n 0) 1)
((equal? n 1) 1)
(#t (let (
(r1 (fib (- n 1)))
(r2 (fib (- n 2)))
) (+ r1 r2)))))))
fib) (read (open-input-string (list-ref (command-line) 1)))))

44
fib_test/fib_tests.sh
View File

@@ -1,44 +0,0 @@
#!/usr/bin/env bash
NUMBER=30
#NUMBER=27
touch csc_out.wasm && rm csc_out.wasm && scheme --script ../partial_eval.scm fib.kp
mv csc_out.wasm fib_compiled.wasm
touch csc_out.wasm && rm csc_out.wasm && scheme --script ../partial_eval.scm fib_let.kp
mv csc_out.wasm fib_compiled_let.wasm
touch csc_out.wasm && rm csc_out.wasm && scheme --script ../partial_eval.scm fib.kp no_compile
mv csc_out.wasm fib_interpreted.wasm
touch csc_out.wasm && rm csc_out.wasm && scheme --script ../partial_eval.scm fib_let.kp no_compile
mv csc_out.wasm fib_interpreted_let.wasm
touch csc_out.wasm && rm csc_out.wasm && scheme --script ../partial_eval.scm fib2.kp
mv csc_out.wasm fib_compiled_manual.wasm
touch csc_out.wasm && rm csc_out.wasm && scheme --script ../partial_eval.scm builtin_fib.kp
mv csc_out.wasm builtin_fib.wasm
pushd rust_fib
cargo build --target=wasm32-wasi
cargo build --release --target=wasm32-wasi
cargo build
cargo build --release
popd
pushd clojure_fib
lein uberjar
popd
pushd clojure_hi
lein uberjar
popd
hyperfine --warmup 2 --export-markdown table.md \
'echo '$NUMBER' | wasmtime ./fib_compiled.wasm' 'echo '$NUMBER' | wasmtime ./fib_compiled_let.wasm' \
'echo '$NUMBER' | wasmtime ./builtin_fib.wasm' 'echo '$NUMBER' | wasmtime ./fib_compiled_manual.wasm' \
"scheme --script ./fib.scm $NUMBER" "scheme --script ./fib_let.scm $NUMBER" \
"python3 ./fib.py $NUMBER" "python3 ./fib_let.py $NUMBER" \
'echo '$NUMBER' | wasmtime ./rust_fib/target/wasm32-wasi/debug/rust_let.wasm' 'echo '$NUMBER' | wasmtime ./rust_fib/target/wasm32-wasi/release/rust_let.wasm' \
"echo $NUMBER | java -jar ./clojure_fib/target/uberjar/clojure_fib-0.1.0-SNAPSHOT-standalone.jar" "echo $NUMBER | java -jar ./clojure_hi/target/uberjar/clojure_hi-0.1.0-SNAPSHOT-standalone.jar" \
'echo '$NUMBER' | wasmtime ./fib_interpreted.wasm' 'echo '$NUMBER' | wasmtime ./fib_interpreted_let.wasm' \
#end

7
fib_test/rust_fib/Cargo.lock generated
View File

@@ -1,7 +0,0 @@
# This file is automatically @generated by Cargo.
# It is not intended for manual editing.
version = 3
[[package]]
name = "rust_let"
version = "0.1.0"

8
fib_test/rust_fib/Cargo.toml
View File

@@ -1,8 +0,0 @@
[package]
name = "rust_let"
version = "0.1.0"
edition = "2021"
# See more keys and their definitions at https://doc.rust-lang.org/cargo/reference/manifest.html
[dependencies]

18
fib_test/rust_fib/src/main.rs
View File

@@ -1,18 +0,0 @@
use std::io;
fn fib(n: i64) -> i64 {
match n {
0 => 1,
1 => 1,
o => fib(o-1) + fib(o-2),
}
}
fn main() {
println!("enter number to fib:");
let mut buffer = String::new();
let stdin = io::stdin();
stdin.read_line(&mut buffer).unwrap();
println!("{}", fib(buffer.trim().parse::<i64>().unwrap()));
}

16
fib_test/table.md
View File

@@ -1,16 +0,0 @@
| Command | Mean [ms] | Min [ms] | Max [ms] | Relative |
|:---|---:|---:|---:|---:|
| `echo 30 \| wasmtime ./fib_compiled.wasm` | 93.1 ± 0.7 | 91.6 | 94.7 | 7.28 ± 0.34 |
| `echo 30 \| wasmtime ./fib_compiled_let.wasm` | 119.1 ± 0.7 | 118.2 | 120.4 | 9.31 ± 0.43 |
| `echo 30 \| wasmtime ./builtin_fib.wasm` | 12.8 ± 0.6 | 11.4 | 14.7 | 1.00 |
| `echo 30 \| wasmtime ./fib_compiled_manual.wasm` | 257.4 ± 5.8 | 245.4 | 262.8 | 20.12 ± 1.03 |
| `scheme --script ./fib.scm 30` | 54.7 ± 1.2 | 52.7 | 57.9 | 4.27 ± 0.22 |
| `scheme --script ./fib_let.scm 30` | 54.5 ± 0.9 | 52.7 | 56.1 | 4.26 ± 0.21 |
| `python3 ./fib.py 30` | 283.5 ± 4.1 | 280.7 | 294.8 | 22.16 ± 1.07 |
| `python3 ./fib_let.py 30` | 299.4 ± 2.1 | 296.9 | 304.7 | 23.41 ± 1.09 |
| `echo 30 \| wasmtime ./rust_fib/target/wasm32-wasi/debug/rust_let.wasm` | 29.6 ± 0.6 | 28.5 | 31.4 | 2.31 ± 0.12 |
| `echo 30 \| wasmtime ./rust_fib/target/wasm32-wasi/release/rust_let.wasm` | 18.7 ± 0.6 | 17.2 | 20.2 | 1.47 ± 0.08 |
| `echo 30 \| java -jar ./clojure_fib/target/uberjar/clojure_fib-0.1.0-SNAPSHOT-standalone.jar` | 572.6 ± 17.4 | 546.0 | 599.5 | 44.76 ± 2.47 |
| `echo 30 \| java -jar ./clojure_hi/target/uberjar/clojure_hi-0.1.0-SNAPSHOT-standalone.jar` | 555.2 ± 12.0 | 536.6 | 571.4 | 43.40 ± 2.21 |
| `echo 30 \| wasmtime ./fib_interpreted.wasm` | 7716.7 ± 27.4 | 7679.8 | 7761.5 | 603.19 ± 27.93 |
| `echo 30 \| wasmtime ./fib_interpreted_let.wasm` | 21414.3 ± 307.9 | 21122.2 | 22246.7 | 1673.87 ± 80.94 |

18
flake.lock generated
View File

@@ -5,11 +5,11 @@
"systems": "systems"
},
"locked": {
"lastModified": 1687709756,
"narHash": "sha256-Y5wKlQSkgEK2weWdOu4J3riRd+kV/VCgHsqLNTTWQ/0=",
"lastModified": 1694529238,
"narHash": "sha256-zsNZZGTGnMOf9YpHKJqMSsa0dXbfmxeoJ7xHlrt+xmY=",
"owner": "numtide",
"repo": "flake-utils",
"rev": "dbabf0ca0c0c4bce6ea5eaf65af5cb694d2082c7",
"rev": "ff7b65b44d01cf9ba6a71320833626af21126384",
"type": "github"
},
"original": {
@@ -42,11 +42,11 @@
"nixpkgs": "nixpkgs"
},
"locked": {
"lastModified": 1688265347,
"narHash": "sha256-oe3kLnNvw2VWbG4Rp6IWUO5Uu5gF8J2oq8DbqbCsdZ4=",
"lastModified": 1700360261,
"narHash": "sha256-8fRSHx5osjDELHSL7OHEfj/cOh8q+B7M9EF/yPR3bw8=",
"owner": "oxalica",
"repo": "rust-overlay",
"rev": "b8f3db465405014039985f1c5cea92cc29e1b3b5",
"rev": "45066cb0b2505d8da581be8432a16238c867f199",
"type": "github"
},
"original": {
@@ -73,11 +73,11 @@
},
"nixpkgs_unstable": {
"locked": {
"lastModified": 1688334313,
"narHash": "sha256-FHDgNHqyc4lzL+5Xifm5H0c3EZ06O2N1qoccjQisqb0=",
"lastModified": 1700412808,
"narHash": "sha256-1yU5WT0sfRJ2DOVZ+6oDdpUZ6j0hz0JBPpbqj8/VCJQ=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "5a193fb4ddbc0df84c96d213d36d27e60f14d7ae",
"rev": "38b1656c2d775b6abc6d08cfc8f38b8847a73ec4",
"type": "github"
},
"original": {

1
kr/.gitignore vendored
View File

@@ -1 +0,0 @@
target

559
kr/Cargo.lock generated
View File

@@ -1,559 +0,0 @@
# This file is automatically @generated by Cargo.
# It is not intended for manual editing.
version = 3
[[package]]
name = "aho-corasick"
version = "0.7.20"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "cc936419f96fa211c1b9166887b38e5e40b19958e5b895be7c1f93adec7071ac"
dependencies = [
"memchr",
]
[[package]]
name = "anyhow"
version = "1.0.70"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "7de8ce5e0f9f8d88245311066a578d72b7af3e7088f32783804676302df237e4"
[[package]]
name = "ascii-canvas"
version = "3.0.0"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "8824ecca2e851cec16968d54a01dd372ef8f95b244fb84b84e70128be347c3c6"
dependencies = [
"term",
]
[[package]]
name = "atty"
version = "0.2.14"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "d9b39be18770d11421cdb1b9947a45dd3f37e93092cbf377614828a319d5fee8"
dependencies = [
"hermit-abi",
"libc",
"winapi",
]
[[package]]
name = "autocfg"
version = "1.1.0"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "d468802bab17cbc0cc575e9b053f41e72aa36bfa6b7f55e3529ffa43161b97fa"
[[package]]
name = "bit-set"
version = "0.5.3"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "0700ddab506f33b20a03b13996eccd309a48e5ff77d0d95926aa0210fb4e95f1"
dependencies = [
"bit-vec",
]
[[package]]
name = "bit-vec"
version = "0.6.3"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "349f9b6a179ed607305526ca489b34ad0a41aed5f7980fa90eb03160b69598fb"
[[package]]
name = "bitflags"
version = "1.3.2"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "bef38d45163c2f1dde094a7dfd33ccf595c92905c8f8f4fdc18d06fb1037718a"
[[package]]
name = "cfg-if"
version = "1.0.0"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "baf1de4339761588bc0619e3cbc0120ee582ebb74b53b4efbf79117bd2da40fd"
[[package]]
name = "crunchy"
version = "0.2.2"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "7a81dae078cea95a014a339291cec439d2f232ebe854a9d672b796c6afafa9b7"
[[package]]
name = "diff"
version = "0.1.13"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "56254986775e3233ffa9c4d7d3faaf6d36a2c09d30b20687e9f88bc8bafc16c8"
[[package]]
name = "dirs-next"
version = "2.0.0"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "b98cf8ebf19c3d1b223e151f99a4f9f0690dca41414773390fc824184ac833e1"
dependencies = [
"cfg-if",
"dirs-sys-next",
]
[[package]]
name = "dirs-sys-next"
version = "0.1.2"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "4ebda144c4fe02d1f7ea1a7d9641b6fc6b580adcfa024ae48797ecdeb6825b4d"
dependencies = [
"libc",
"redox_users",
"winapi",
]
[[package]]
name = "either"
version = "1.8.1"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "7fcaabb2fef8c910e7f4c7ce9f67a1283a1715879a7c230ca9d6d1ae31f16d91"
[[package]]
name = "ena"
version = "0.14.0"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "d7402b94a93c24e742487327a7cd839dc9d36fec9de9fb25b09f2dae459f36c3"
dependencies = [
"log",
]
[[package]]
name = "fixedbitset"
version = "0.4.2"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "0ce7134b9999ecaf8bcd65542e436736ef32ddca1b3e06094cb6ec5755203b80"
[[package]]
name = "getrandom"
version = "0.2.8"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "c05aeb6a22b8f62540c194aac980f2115af067bfe15a0734d7277a768d396b31"
dependencies = [
"cfg-if",
"libc",
"wasi",
]
[[package]]
name = "hashbrown"
version = "0.12.3"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "8a9ee70c43aaf417c914396645a0fa852624801b24ebb7ae78fe8272889ac888"
[[package]]
name = "hermit-abi"
version = "0.1.19"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "62b467343b94ba476dcb2500d242dadbb39557df889310ac77c5d99100aaac33"
dependencies = [
"libc",
]
[[package]]
name = "indexmap"
version = "1.9.2"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "1885e79c1fc4b10f0e172c475f458b7f7b93061064d98c3293e98c5ba0c8b399"
dependencies = [
"autocfg",
"hashbrown",
]
[[package]]
name = "itertools"
version = "0.10.5"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "b0fd2260e829bddf4cb6ea802289de2f86d6a7a690192fbe91b3f46e0f2c8473"
dependencies = [
"either",
]
[[package]]
name = "kr"
version = "0.1.0"
dependencies = [
"anyhow",
"lalrpop",
"lalrpop-util",
"once_cell",
"regex",
]
[[package]]
name = "lalrpop"
version = "0.19.8"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "b30455341b0e18f276fa64540aff54deafb54c589de6aca68659c63dd2d5d823"
dependencies = [
"ascii-canvas",
"atty",
"bit-set",
"diff",
"ena",
"itertools",
"lalrpop-util",
"petgraph",
"pico-args",
"regex",
"regex-syntax",
"string_cache",
"term",
"tiny-keccak",
"unicode-xid",
]
[[package]]
name = "lalrpop-util"
version = "0.19.8"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "bcf796c978e9b4d983414f4caedc9273aa33ee214c5b887bd55fde84c85d2dc4"
dependencies = [
"regex",
]
[[package]]
name = "libc"
version = "0.2.139"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "201de327520df007757c1f0adce6e827fe8562fbc28bfd9c15571c66ca1f5f79"
[[package]]
name = "lock_api"
version = "0.4.9"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "435011366fe56583b16cf956f9df0095b405b82d76425bc8981c0e22e60ec4df"
dependencies = [
"autocfg",
"scopeguard",
]
[[package]]
name = "log"
version = "0.4.17"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "abb12e687cfb44aa40f41fc3978ef76448f9b6038cad6aef4259d3c095a2382e"
dependencies = [
"cfg-if",
]
[[package]]
name = "memchr"
version = "2.5.0"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "2dffe52ecf27772e601905b7522cb4ef790d2cc203488bbd0e2fe85fcb74566d"
[[package]]
name = "new_debug_unreachable"
version = "1.0.4"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "e4a24736216ec316047a1fc4252e27dabb04218aa4a3f37c6e7ddbf1f9782b54"
[[package]]
name = "once_cell"
version = "1.17.0"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "6f61fba1741ea2b3d6a1e3178721804bb716a68a6aeba1149b5d52e3d464ea66"
[[package]]
name = "parking_lot"
version = "0.12.1"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "3742b2c103b9f06bc9fff0a37ff4912935851bee6d36f3c02bcc755bcfec228f"
dependencies = [
"lock_api",
"parking_lot_core",
]
[[package]]
name = "parking_lot_core"
version = "0.9.7"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "9069cbb9f99e3a5083476ccb29ceb1de18b9118cafa53e90c9551235de2b9521"
dependencies = [
"cfg-if",
"libc",
"redox_syscall",
"smallvec",
"windows-sys",
]
[[package]]
name = "petgraph"
version = "0.6.3"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "4dd7d28ee937e54fe3080c91faa1c3a46c06de6252988a7f4592ba2310ef22a4"
dependencies = [
"fixedbitset",
"indexmap",
]
[[package]]
name = "phf_shared"
version = "0.10.0"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "b6796ad771acdc0123d2a88dc428b5e38ef24456743ddb1744ed628f9815c096"
dependencies = [
"siphasher",
]
[[package]]
name = "pico-args"
version = "0.4.2"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "db8bcd96cb740d03149cbad5518db9fd87126a10ab519c011893b1754134c468"
[[package]]
name = "precomputed-hash"
version = "0.1.1"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "925383efa346730478fb4838dbe9137d2a47675ad789c546d150a6e1dd4ab31c"
[[package]]
name = "proc-macro2"
version = "1.0.51"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "5d727cae5b39d21da60fa540906919ad737832fe0b1c165da3a34d6548c849d6"
dependencies = [
"unicode-ident",
]
[[package]]
name = "quote"
version = "1.0.23"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "8856d8364d252a14d474036ea1358d63c9e6965c8e5c1885c18f73d70bff9c7b"
dependencies = [
"proc-macro2",
]
[[package]]
name = "redox_syscall"
version = "0.2.16"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "fb5a58c1855b4b6819d59012155603f0b22ad30cad752600aadfcb695265519a"
dependencies = [
"bitflags",
]
[[package]]
name = "redox_users"
version = "0.4.3"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "b033d837a7cf162d7993aded9304e30a83213c648b6e389db233191f891e5c2b"
dependencies = [
"getrandom",
"redox_syscall",
"thiserror",
]
[[package]]
name = "regex"
version = "1.7.1"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "48aaa5748ba571fb95cd2c85c09f629215d3a6ece942baa100950af03a34f733"
dependencies = [
"aho-corasick",
"memchr",
"regex-syntax",
]
[[package]]
name = "regex-syntax"
version = "0.6.28"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "456c603be3e8d448b072f410900c09faf164fbce2d480456f50eea6e25f9c848"
[[package]]
name = "rustversion"
version = "1.0.11"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "5583e89e108996506031660fe09baa5011b9dd0341b89029313006d1fb508d70"
[[package]]
name = "scopeguard"
version = "1.1.0"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "d29ab0c6d3fc0ee92fe66e2d99f700eab17a8d57d1c1d3b748380fb20baa78cd"
[[package]]
name = "siphasher"
version = "0.3.10"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "7bd3e3206899af3f8b12af284fafc038cc1dc2b41d1b89dd17297221c5d225de"
[[package]]
name = "smallvec"
version = "1.10.0"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "a507befe795404456341dfab10cef66ead4c041f62b8b11bbb92bffe5d0953e0"
[[package]]
name = "string_cache"
version = "0.8.4"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "213494b7a2b503146286049378ce02b482200519accc31872ee8be91fa820a08"
dependencies = [
"new_debug_unreachable",
"once_cell",
"parking_lot",
"phf_shared",
"precomputed-hash",
]
[[package]]
name = "syn"
version = "1.0.107"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "1f4064b5b16e03ae50984a5a8ed5d4f8803e6bc1fd170a3cda91a1be4b18e3f5"
dependencies = [
"proc-macro2",
"quote",
"unicode-ident",
]
[[package]]
name = "term"
version = "0.7.0"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "c59df8ac95d96ff9bede18eb7300b0fda5e5d8d90960e76f8e14ae765eedbf1f"
dependencies = [
"dirs-next",
"rustversion",
"winapi",
]
[[package]]
name = "thiserror"
version = "1.0.38"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "6a9cd18aa97d5c45c6603caea1da6628790b37f7a34b6ca89522331c5180fed0"
dependencies = [
"thiserror-impl",
]
[[package]]
name = "thiserror-impl"
version = "1.0.38"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "1fb327af4685e4d03fa8cbcf1716380da910eeb2bb8be417e7f9fd3fb164f36f"
dependencies = [
"proc-macro2",
"quote",
"syn",
]
[[package]]
name = "tiny-keccak"
version = "2.0.2"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "2c9d3793400a45f954c52e73d068316d76b6f4e36977e3fcebb13a2721e80237"
dependencies = [
"crunchy",
]
[[package]]
name = "unicode-ident"
version = "1.0.6"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "84a22b9f218b40614adcb3f4ff08b703773ad44fa9423e4e0d346d5db86e4ebc"
[[package]]
name = "unicode-xid"
version = "0.2.4"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "f962df74c8c05a667b5ee8bcf162993134c104e96440b663c8daa176dc772d8c"
[[package]]
name = "wasi"
version = "0.11.0+wasi-snapshot-preview1"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "9c8d87e72b64a3b4db28d11ce29237c246188f4f51057d65a7eab63b7987e423"
[[package]]
name = "winapi"
version = "0.3.9"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "5c839a674fcd7a98952e593242ea400abe93992746761e38641405d28b00f419"
dependencies = [
"winapi-i686-pc-windows-gnu",
"winapi-x86_64-pc-windows-gnu",
]
[[package]]
name = "winapi-i686-pc-windows-gnu"
version = "0.4.0"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "ac3b87c63620426dd9b991e5ce0329eff545bccbbb34f3be09ff6fb6ab51b7b6"
[[package]]
name = "winapi-x86_64-pc-windows-gnu"
version = "0.4.0"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "712e227841d057c1ee1cd2fb22fa7e5a5461ae8e48fa2ca79ec42cfc1931183f"
[[package]]
name = "windows-sys"
version = "0.45.0"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "75283be5efb2831d37ea142365f009c02ec203cd29a3ebecbc093d52315b66d0"
dependencies = [
"windows-targets",
]
[[package]]
name = "windows-targets"
version = "0.42.1"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "8e2522491fbfcd58cc84d47aeb2958948c4b8982e9a2d8a2a35bbaed431390e7"
dependencies = [
"windows_aarch64_gnullvm",
"windows_aarch64_msvc",
"windows_i686_gnu",
"windows_i686_msvc",
"windows_x86_64_gnu",
"windows_x86_64_gnullvm",
"windows_x86_64_msvc",
]
[[package]]
name = "windows_aarch64_gnullvm"
version = "0.42.1"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "8c9864e83243fdec7fc9c5444389dcbbfd258f745e7853198f365e3c4968a608"
[[package]]
name = "windows_aarch64_msvc"
version = "0.42.1"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "4c8b1b673ffc16c47a9ff48570a9d85e25d265735c503681332589af6253c6c7"
[[package]]
name = "windows_i686_gnu"
version = "0.42.1"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "de3887528ad530ba7bdbb1faa8275ec7a1155a45ffa57c37993960277145d640"
[[package]]
name = "windows_i686_msvc"
version = "0.42.1"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "bf4d1122317eddd6ff351aa852118a2418ad4214e6613a50e0191f7004372605"
[[package]]
name = "windows_x86_64_gnu"
version = "0.42.1"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "c1040f221285e17ebccbc2591ffdc2d44ee1f9186324dd3e84e99ac68d699c45"
[[package]]
name = "windows_x86_64_gnullvm"
version = "0.42.1"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "628bfdf232daa22b0d64fdb62b09fcc36bb01f05a3939e20ab73aaf9470d0463"
[[package]]
name = "windows_x86_64_msvc"
version = "0.42.1"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "447660ad36a13288b1db4d4248e857b510e8c3a225c822ba4fb748c0aafecffd"

338
kr/src/ast.rs
View File

@@ -1,338 +0,0 @@
use std::fmt;
use std::rc::Rc;
use std::convert::From;
// TODO:
// -extend vau & env logic and SuspendedPair PE with sequence_params & wrap_level
// -add current-hashes to if
// -expand combiner_Return_ok with (func ...params) | func doesn't take de and func+params are return ok
// -add recursive drop redundent veval
// -mark rec-hash on DeriComb
// -add compiler
//
// -use current fake comb ids instead of hashes
// -do they have to be added to not-under thing like hashes
// -make cons work only for SuspendedParam/Env
impl From<i32> for Form { fn from(item: i32) -> Self { Form::Int(item) } }
impl From<bool> for Form { fn from(item: bool) -> Self { Form::Bool(item) } }
// todo, strings not symbols?
impl From<String> for Form { fn from(item: String) -> Self { Form::Symbol(item) } }
impl From<&str> for Form { fn from(item: &str) -> Self { Form::Symbol(item.to_owned()) } }
impl<A: Into<Form>, B: Into<Form>> From<(A, B)> for Form {
fn from(item: (A, B)) -> Self {
Form::Pair(Rc::new(item.0.into()), Rc::new(item.1.into()))
}
}
pub enum PossibleTailCall {
Result(Rc<Form>),
TailCall(Rc<Form>, Rc<Form>),
}
#[derive(Debug, Eq, PartialEq)]
pub enum Form {
Nil,
Int(i32),
Bool(bool),
Symbol(String),
Pair(Rc<Form>,Rc<Form>),
PrimComb(String, fn(Rc<Form>, Rc<Form>) -> PossibleTailCall),
DeriComb { se: Rc<Form>, de: Option<String>, params: String, body: Rc<Form> },
}
impl Form {
pub fn truthy(&self) -> bool {
match self {
Form::Bool(b) => *b,
Form::Nil => false,
_ => true,
}
}
pub fn int(&self) -> Option<i32> {
match self {
Form::Int(i) => Some(*i),
_ => None,
}
}
pub fn sym(&self) -> Option<&str> {
match self {
Form::Symbol(s) => Some(s),
_ => None,
}
}
pub fn car(&self) -> Option<Rc<Form>> {
match self {
Form::Pair(car, _cdr) => Some(Rc::clone(car)),
_ => None,
}
}
pub fn cdr(&self) -> Option<Rc<Form>> {
match self {
Form::Pair(_car, cdr) => Some(Rc::clone(cdr)),
_ => None,
}
}
pub fn append(&self, x: Rc<Form>) -> Option<Form> {
match self {
Form::Pair(car, cdr) => cdr.append(x).map(|x| Form::Pair(Rc::clone(car), Rc::new(x))),
Form::Nil => Some(Form::Pair(x, Rc::new(Form::Nil))),
_ => None,
}
}
}
impl fmt::Display for Form {
fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result {
match self {
Form::Nil => write!(f, "nil"),
Form::Int(i) => write!(f, "{}", i),
Form::Bool(b) => write!(f, "{}", b),
Form::Symbol(s) => write!(f, "{}", s),
Form::Pair(car, cdr) => {
write!(f, "({}", car)?;
let mut traverse: Rc<Form> = Rc::clone(cdr);
loop {
match &*traverse {
Form::Pair(ref carp, ref cdrp) => {
write!(f, " {}", carp)?;
traverse = Rc::clone(cdrp);
},
Form::Nil => {
write!(f, ")")?;
return Ok(());
},
x => {
write!(f, ". {})", x)?;
return Ok(());
},
}
}
},
Form::PrimComb(name, _f) => write!(f, "<{}>", name),
Form::DeriComb { se, de, params, body } => {
write!(f, "<{} {} {}>", de.as_ref().unwrap_or(&"".to_string()), params, body)
},
}
}
}
pub fn eval(e: Rc<Form>, f: Rc<Form>) -> Rc<Form> {
let mut e = e;
let mut x = Option::Some(f);
loop {
let cur = x.take().unwrap();
//println!("Evaluating {:?} in {:?}", cur, e);
match *cur {
Form::Symbol(ref s) => {
let mut t = e;
//println!("Looking up {} in {:?}", s, t);
//println!("Looking up {}", s);
while s != t.car().unwrap().car().unwrap().sym().unwrap() {
t = t.cdr().unwrap();
}
return t.car().unwrap().cdr().unwrap();
},
Form::Pair(ref c, ref p) => {
let comb = eval(Rc::clone(&e), Rc::clone(c));
match *comb {
Form::PrimComb(ref _n, ref f) => match f(e, Rc::clone(p)) {
PossibleTailCall::Result(r) => return r,
PossibleTailCall::TailCall(ne, nx) => {
e = ne;
x = Some(nx);
},
},
Form::DeriComb{ref se, ref de, ref params, ref body } => {
let mut new_e = Rc::clone(se);
if let Some(de) = de {
new_e = assoc(de, Rc::clone(&e), new_e);
}
new_e = assoc(params, Rc::clone(p), new_e);
// always a tail call
e = new_e;
x = Some(Rc::clone(body));
},
_ => panic!("Tried to call not a Prim/DeriComb {:?}", comb),
}
},
_ => return cur,
}
}
}
fn assoc(k: &str, v: Rc<Form>, l: Rc<Form>) -> Rc<Form> {
Rc::new(Form::Pair(
Rc::new(Form::Pair(
Rc::new(Form::Symbol(k.to_owned())),
v)),
l))
}
fn assoc_vec(kvs: Vec<(&str, Rc<Form>)>) -> Rc<Form> {
let mut to_ret = Rc::new(Form::Nil);
for (k, v) in kvs {
to_ret = assoc(k, v, to_ret);
}
to_ret
}
pub fn root_env() -> Rc<Form> {
assoc_vec(vec![
("eval", Rc::new(Form::PrimComb("eval".to_owned(), |e, p| {
let b = eval(Rc::clone(&e), p.car().unwrap());
let e = eval(e, p.cdr().unwrap().car().unwrap());
PossibleTailCall::TailCall(e, b)
}))),
// (vau de params body)
("vau", Rc::new(Form::PrimComb("vau".to_owned(), |e, p| {
let de = p.car().unwrap().sym().map(|s| s.to_owned());
let params = p.cdr().unwrap().car().unwrap().sym().unwrap().to_owned();
let body = p.cdr().unwrap().cdr().unwrap().car().unwrap();
PossibleTailCall::Result(Rc::new(Form::DeriComb { se: e, de, params, body }))
}))),
("=", Rc::new(Form::PrimComb("=".to_owned(), |e, p| {
let a = eval(Rc::clone(&e), p.car().unwrap());
let b = eval(e, p.cdr().unwrap().car().unwrap());
PossibleTailCall::Result(Rc::new(Form::Bool(a == b)))
}))),
("<", Rc::new(Form::PrimComb("<".to_owned(), |e, p| {
let a = eval(Rc::clone(&e), p.car().unwrap());
let b = eval(e, p.cdr().unwrap().car().unwrap());
PossibleTailCall::Result(Rc::new(Form::Bool(a.int().unwrap() < b.int().unwrap())))
}))),
(">", Rc::new(Form::PrimComb(">".to_owned(), |e, p| {
let a = eval(Rc::clone(&e), p.car().unwrap());
let b = eval(e, p.cdr().unwrap().car().unwrap());
PossibleTailCall::Result(Rc::new(Form::Bool(a.int().unwrap() > b.int().unwrap())))
}))),
("<=", Rc::new(Form::PrimComb("<=".to_owned(), |e, p| {
let a = eval(Rc::clone(&e), p.car().unwrap());
let b = eval(e, p.cdr().unwrap().car().unwrap());
PossibleTailCall::Result(Rc::new(Form::Bool(a.int().unwrap() <= b.int().unwrap())))
}))),
(">=", Rc::new(Form::PrimComb(">=".to_owned(), |e, p| {
let a = eval(Rc::clone(&e), p.car().unwrap());
let b = eval(e, p.cdr().unwrap().car().unwrap());
PossibleTailCall::Result(Rc::new(Form::Bool(a.int().unwrap() >= b.int().unwrap())))
}))),
("if", Rc::new(Form::PrimComb("if".to_owned(), |e, p| {
if eval(Rc::clone(&e), p.car().unwrap()).truthy() {
PossibleTailCall::TailCall(e, p.cdr().unwrap().car().unwrap())
} else {
PossibleTailCall::TailCall(e, p.cdr().unwrap().cdr().unwrap().car().unwrap())
}
}))),
("cons", Rc::new(Form::PrimComb("cons".to_owned(), |e, p| {
let h = eval(Rc::clone(&e), p.car().unwrap());
let t = eval(e, p.cdr().unwrap().car().unwrap());
PossibleTailCall::Result(Rc::new(Form::Pair(h, t)))
}))),
("car", Rc::new(Form::PrimComb("car".to_owned(), |e, p| {
PossibleTailCall::Result(eval(Rc::clone(&e), p.car().unwrap()).car().unwrap())
}))),
("cdr", Rc::new(Form::PrimComb("cdr".to_owned(), |e, p| {
PossibleTailCall::Result(eval(Rc::clone(&e), p.car().unwrap()).cdr().unwrap())
}))),
("quote", Rc::new(Form::PrimComb("quote".to_owned(), |_e, p| {
PossibleTailCall::Result(p.car().unwrap())
}))),
("debug", Rc::new(Form::PrimComb("debug".to_owned(), |e, p| {
//println!("Debug: {:?}", eval(Rc::clone(&e), p.car().unwrap()));
println!("Debug: {}", eval(Rc::clone(&e), p.car().unwrap()));
PossibleTailCall::TailCall(e, p.cdr().unwrap().car().unwrap())
}))),
("assert", Rc::new(Form::PrimComb("assert".to_owned(), |e, p| {
let thing = eval(Rc::clone(&e), p.car().unwrap());
if !thing.truthy() {
println!("Assert failed: {:?}", thing);
}
assert!(thing.truthy());
PossibleTailCall::TailCall(e, p.cdr().unwrap().car().unwrap())
}))),
("+", Rc::new(Form::PrimComb("+".to_owned(), |e, p| {
let a = eval(Rc::clone(&e), p.car().unwrap()).int().unwrap();
let b = eval(e, p.cdr().unwrap().car().unwrap()).int().unwrap();
PossibleTailCall::Result(Rc::new(Form::Int(a + b)))
}))),
("-", Rc::new(Form::PrimComb("-".to_owned(), |e, p| {
let a = eval(Rc::clone(&e), p.car().unwrap()).int().unwrap();
let b = eval(e, p.cdr().unwrap().car().unwrap()).int().unwrap();
PossibleTailCall::Result(Rc::new(Form::Int(a - b)))
}))),
("*", Rc::new(Form::PrimComb("*".to_owned(), |e, p| {
let a = eval(Rc::clone(&e), p.car().unwrap()).int().unwrap();
let b = eval(e, p.cdr().unwrap().car().unwrap()).int().unwrap();
PossibleTailCall::Result(Rc::new(Form::Int(a * b)))
}))),
("/", Rc::new(Form::PrimComb("/".to_owned(), |e, p| {
let a = eval(Rc::clone(&e), p.car().unwrap()).int().unwrap();
let b = eval(e, p.cdr().unwrap().car().unwrap()).int().unwrap();
PossibleTailCall::Result(Rc::new(Form::Int(a / b)))
}))),
("%", Rc::new(Form::PrimComb("%".to_owned(), |e, p| {
let a = eval(Rc::clone(&e), p.car().unwrap()).int().unwrap();
let b = eval(e, p.cdr().unwrap().car().unwrap()).int().unwrap();
PossibleTailCall::Result(Rc::new(Form::Int(a % b)))
}))),
("&", Rc::new(Form::PrimComb("&".to_owned(), |e, p| {
let a = eval(Rc::clone(&e), p.car().unwrap()).int().unwrap();
let b = eval(e, p.cdr().unwrap().car().unwrap()).int().unwrap();
PossibleTailCall::Result(Rc::new(Form::Int(a & b)))
}))),
("|", Rc::new(Form::PrimComb("|".to_owned(), |e, p| {
let a = eval(Rc::clone(&e), p.car().unwrap()).int().unwrap();
let b = eval(e, p.cdr().unwrap().car().unwrap()).int().unwrap();
PossibleTailCall::Result(Rc::new(Form::Int(a | b)))
}))),
("^", Rc::new(Form::PrimComb("^".to_owned(), |e, p| {
let a = eval(Rc::clone(&e), p.car().unwrap()).int().unwrap();
let b = eval(e, p.cdr().unwrap().car().unwrap()).int().unwrap();
PossibleTailCall::Result(Rc::new(Form::Int(a ^ b)))
}))),
("comb?", Rc::new(Form::PrimComb("comb?".to_owned(), |e, p| {
PossibleTailCall::Result(Rc::new(Form::Bool(match &*eval(e, p.car().unwrap()) {
Form::PrimComb(_n, _f) => true,
Form::DeriComb { .. } => true,
_ => false,
})))
}))),
("pair?", Rc::new(Form::PrimComb("pair?".to_owned(), |e, p| {
PossibleTailCall::Result(Rc::new(Form::Bool(match &*eval(e, p.car().unwrap()) {
Form::Pair(_a,_b) => true,
_ => false,
})))
}))),
("symbol?", Rc::new(Form::PrimComb("symbol?".to_owned(), |e, p| {
PossibleTailCall::Result(Rc::new(Form::Bool(match &*eval(e, p.car().unwrap()) {
Form::Symbol(_) => true,
_ => false,
})))
}))),
("int?", Rc::new(Form::PrimComb("int?".to_owned(), |e, p| {
PossibleTailCall::Result(Rc::new(Form::Bool(match &*eval(e, p.car().unwrap()) {
Form::Int(_) => true,
_ => false,
})))
}))),
// maybe bool? but also could be derived. Nil def
("bool?", Rc::new(Form::PrimComb("bool?".to_owned(), |e, p| {
PossibleTailCall::Result(Rc::new(Form::Bool(match &*eval(e, p.car().unwrap()) {
Form::Bool(_) => true,
_ => false,
})))
}))),
("nil?", Rc::new(Form::PrimComb("nil?".to_owned(), |e, p| {
PossibleTailCall::Result(Rc::new(Form::Bool(match &*eval(e, p.car().unwrap()) {
Form::Nil => true,
_ => false,
})))
}))),
// consts
("true", Rc::new(Form::Bool(true))),
("false", Rc::new(Form::Bool(false))),
("nil", Rc::new(Form::Nil)),
])
}

31
kr/src/grammar.lalrpop
View File

@@ -1,31 +0,0 @@
use std::str::FromStr;
use std::rc::Rc;
use crate::ast::Form;
grammar;
pub Term: Form = {
NUM => Form::Int(i32::from_str(<>).unwrap()),
SYM => Form::Symbol(<>.to_owned()),
"(" <ListInside?> ")" => <>.unwrap_or(Form::Nil),
"'" <Term> => Form::Pair(Rc::new(Form::Symbol("quote".to_owned())), Rc::new(Form::Pair(Rc::new(<>), Rc::new(Form::Nil)))),
"!" <h: Term> <t: Term> => {
h.append(Rc::new(t)).unwrap()
},
};
ListInside: Form = {
<Term> => Form::Pair(Rc::new(<>), Rc::new(Form::Nil)),
<h: Term> <t: ListInside> => Form::Pair(Rc::new(h), Rc::new(t)),
<a: Term> "." <d: Term> => Form::Pair(Rc::new(a), Rc::new(d)),
}
match {
"(",
")",
".",
"'",
"!",
r"[0-9]+" => NUM,
r"[a-zA-Z+*/_=?%&|^<>-][\w+*/=_?%&|^<>-]*" => SYM,
r"(;[^\n]*\n)|\s+" => { }
}

26
kr/src/main.rs
View File

@@ -1,26 +0,0 @@
#[macro_use] extern crate lalrpop_util;
lalrpop_mod!(pub grammar);
use std::rc::Rc;
mod ast;
use crate::ast::{eval,root_env};
mod pe_ast;
use crate::pe_ast::{mark,partial_eval,new_base_ctxs};
mod test;
fn main() {
let input = "(= 17 ((vau d p (+ (eval (car p) d) 13)) (+ 1 3)))";
let parsed_input = Rc::new(grammar::TermParser::new().parse(input).unwrap());
println!("Parsed input is {} - {:?}", parsed_input, parsed_input);
let (bctx, dctx) = new_base_ctxs();
let (bctx, marked) = mark(Rc::clone(&parsed_input),bctx);
let unvaled = marked.unval().unwrap();
println!("Parsed unvaled that is {}", unvaled);
let (bctx, ped) = partial_eval(bctx, dctx, unvaled, true).unwrap();
let result = eval(root_env(), parsed_input);
println!("Result is {} - {:?}", result, result);
}

1493
kr/src/pe_ast.rs
View File

File diff suppressed because it is too large Load Diff

625
kr/src/test.rs
View File

@@ -1,625 +0,0 @@
use std::rc::Rc;
use crate::grammar;
use crate::ast::{eval,root_env,Form,PossibleTailCall};
use crate::pe_ast::{mark,partial_eval,new_base_ctxs,MarkedForm};
#[test]
fn parse_test() {
let g = grammar::TermParser::new();
for test in [
"22", "(22)", "(((22)))",
"(22 )", "()", "( )", "( 44)", "(44 )",
"(22 44 (1) 33 (4 5 (6) 6))", "hello",
"-", "+", "(+ 1 ;hi
3)", "'13", "hello-world", "_",
] {
assert!(g.parse(test).is_ok());
}
assert!(g.parse("((22)").is_err());
}
fn eval_test<T: Into<Form>>(also_pe: bool, gram: &grammar::TermParser, e: &Rc<Form>, code: &str, expected: T) {
println!("Doing test {}", code);
let parsed = Rc::new(gram.parse(code).unwrap());
let basic_result = eval(Rc::clone(e), Rc::clone(&parsed));
assert_eq!(*basic_result, expected.into());
if also_pe {
let (bctx, dctx) = new_base_ctxs();
let (bctx, marked) = mark(parsed,bctx);
let unvaled = marked.unval().unwrap();
let (bctx, ped) = partial_eval(bctx, dctx, unvaled, true).unwrap();
let (bctx, marked_basic_result) = mark(basic_result,bctx);
println!("Final PE {}", ped);
println!("wanted {}", marked_basic_result);
assert_eq!(*ped, *marked_basic_result);
}
}
fn partial_eval_test(gram: &grammar::TermParser, code: &str, expected: &str) {
println!("Doing PE test {}", code);
let parsed = Rc::new(gram.parse(code).unwrap());
let (bctx, dctx) = new_base_ctxs();
let (bctx, marked) = mark(parsed,bctx);
let unvaled = marked.unval().unwrap();
let (bctx, ped) = partial_eval(bctx, dctx, unvaled, true).unwrap();
println!("Final PE {}", ped);
println!("wanted {}", expected);
assert_eq!(format!("{}", ped), expected);
}
#[test]
fn basic_pe_test() {
let g = grammar::TermParser::new();
partial_eval_test(&g, "(+ 2 (car (cons 4 '(1 2))))", "6");
partial_eval_test(&g, "(vau 0 p (+ 1 2))", "NeedsNone#[None/None/EnvID(1)/0/[]/Some(\"p\")/3]");
partial_eval_test(&g, "(vau de p (+ (eval (car p) de) (eval (car (cdr p)) de)))", "NeedsNone#[None/Some(\"de\")/EnvID(1)/0/[]/Some(\"p\")/NeedsH{EnvID(1)}#{<+0> Some(\"p\")(EnvID(1)0truetrue) Some(\"p\")(EnvID(1)1truetrue)}]");
partial_eval_test(&g, "(vau de p (eval '(+ a 2) (cons (cons 'a (eval (car p) de))
((vau de p de)))))", "NeedsNone#[None/Some(\"de\")/EnvID(1)/0/[]/Some(\"p\")/NeedsH{EnvID(1)}#{<+0> Some(\"a\")(EnvID(1)0truetrue) 2}]");
//partial_eval_test(&g, "(vau de p (eval (+ a b) (cons (cons 'a (eval (car p) de))
// (cons (cons 'b (eval (car (cdr p)) de))
// de))))", "");
}
#[test]
fn basic_eval_test() { let g = grammar::TermParser::new(); let e = root_env();
eval_test(true, &g, &e, "(+ 2 (car (cons 4 '(1 2))))", 6);
eval_test(true, &g, &e, "(= 17 ((vau d p (+ (eval (car p) d) 13)) (+ 1 3)))", true);
eval_test(true, &g, &e, "(if (= 2 2) (+ 1 2) (+ 3 4))", 3);
eval_test(true, &g, &e, "(quote a)", "a");
eval_test(true, &g, &e, "'a", "a");
eval_test(true, &g, &e, "'(1 . a)", (1, "a"));
eval_test(true, &g, &e, "'(1 a)", (1, ("a", Form::Nil)));
eval_test(true, &g, &e, "true", true);
eval_test(true, &g, &e, "false", false);
eval_test(true, &g, &e, "nil", Form::Nil);
eval_test(true, &g, &e, "(+ 1 2)", 3);
eval_test(true, &g, &e, "(- 1 2)", -1);
eval_test(true, &g, &e, "(* 1 2)", 2);
eval_test(true, &g, &e, "(/ 4 2)", 2);
eval_test(true, &g, &e, "(% 3 2)", 1);
eval_test(true, &g, &e, "(& 3 2)", 2);
eval_test(true, &g, &e, "(| 2 1)", 3);
eval_test(true, &g, &e, "(^ 2 1)", 3);
eval_test(true, &g, &e, "(^ 3 1)", 2);
eval_test(true, &g, &e, "(< 3 1)", false);
eval_test(true, &g, &e, "(<= 3 1)", false);
eval_test(true, &g, &e, "(> 3 1)", true);
eval_test(true, &g, &e, "(>= 3 1)", true);
eval_test(true, &g, &e, "(comb? +)", true);
eval_test(true, &g, &e, "(comb? (vau d p 1))", true);
eval_test(true, &g, &e, "(comb? 1)", false);
eval_test(true, &g, &e, "(pair? '(a))", true);
//eval_test(true, &g, &e, "(pair? '())", true);
eval_test(true, &g, &e, "(nil? nil)", true);
eval_test(true, &g, &e, "(nil? 1)", false);
eval_test(true, &g, &e, "(pair? 1)", false);
eval_test(true, &g, &e, "(symbol? 'a)", true);
eval_test(true, &g, &e, "(symbol? 1)", false);
eval_test(true, &g, &e, "(int? 1)", true);
eval_test(true, &g, &e, "(int? true)", false);
eval_test(true, &g, &e, "(bool? true)", true);
eval_test(true, &g, &e, "(bool? 1)", false);
eval_test(true, &g, &e, "!(bool?) 1", false);
eval_test(true, &g, &e, "!(bool?) true", true);
eval_test(true, &g, &e, "((vau root_env _ (eval 'a (cons (cons 'a 2) root_env))))", 2);
eval_test(true, &g, &e, "'name-dash", "name-dash");
}
use once_cell::sync::Lazy;
static LET: Lazy<String> = Lazy::new(|| {
"!((vau root_env p (eval (car p)
(cons (cons 'let1
(vau de p (eval (car (cdr (cdr p))) (cons (cons (car p) (eval (car (cdr p)) de)) de)))
) root_env))))".to_owned()
});
#[test]
fn let_pe_test() {
let g = grammar::TermParser::new();
partial_eval_test(&g, &format!("{} (let1 a 2 (+ a (car (cons 4 '(1 2)))))", *LET), "6");
partial_eval_test(&g, &format!("{} (let1 a 2 (vau 0 p (+ 1 a)))", *LET),"NeedsNone#[None/None/EnvID(3)/0/[]/Some(\"p\")/3]");
partial_eval_test(&g, &format!("{}
!(let1 a 2)
(vau 0 p (+ 1 a))
", *LET), "NeedsNone#[None/None/EnvID(3)/0/[]/Some(\"p\")/3]");
partial_eval_test(&g, &format!("{}
!(let1 a 2)
!(let1 b 5)
(vau 0 p (+ b a))
", *LET), "NeedsNone#[None/None/EnvID(3)/0/[]/Some(\"p\")/7]");
/*
partial_eval_test(&g, &format!("{}
(vau 0 p
!(let1 a 2)
!(let1 b 5)
(+ b a)
)
", *LET), "None({})#[None/None/EnvID(0)/0/[]/Some(\"p\")/7]");
partial_eval_test(&g, &format!("{}
(vau d p
!(let1 a 2)
(+ (eval (car p) d) a)
)
", *LET), "None({})#[None/None/EnvID(2)/0/[]/Some(\"p\")/7]");
*/
}
#[test]
fn fib_eval_test() { let g = grammar::TermParser::new(); let e = root_env();
eval_test(true, &g, &e, &format!("{} (let1 x 10 (+ x 7))", *LET), 17);
let def_fib = "
!(let1 fib (vau de p
!(let1 self (eval (car p) de))
!(let1 n (eval (car (cdr p)) de))
!(if (= 0 n) 0)
!(if (= 1 n) 1)
(+ (self self (- n 1)) (self self (- n 2)))
))";
eval_test(false, &g, &e, &format!("{} {} (fib fib 6)", *LET, def_fib), 8);
}
#[test]
fn fact_eval_test() { let g = grammar::TermParser::new(); let e = root_env();
let def_fact = "
!(let1 fact (vau de p
!(let1 self (eval (car p) de))
!(let1 n (eval (car (cdr p)) de))
!(if (= 0 n) 1)
(* n (self self (- n 1)))
))";
eval_test(true, &g, &e, &format!("{} {} (fact fact 6)", *LET, def_fact), 720);
}
static VAPPLY: Lazy<String> = Lazy::new(|| {
format!("
{}
!(let1 vapply (vau de p
!(let1 f (eval (car p) de))
!(let1 ip (eval (car (cdr p)) de))
!(let1 nde (eval (car (cdr (cdr p))) de))
(eval (cons f ip) nde)
))", *LET)
});
#[test]
fn vapply_eval_test() { let g = grammar::TermParser::new(); let e = root_env();
// need the vapply to keep env in check because otherwise the env keeps growing
// and the Rc::drop will overflow the stack lol
let def_badid = format!("
{}
!(let1 badid (vau de p
!(let1 inner (vau ide ip
!(let1 self (car ip))
!(let1 n (car (cdr ip)))
!(let1 acc (car (cdr (cdr ip))))
!(if (= 0 n) acc)
(vapply self (cons self (cons (- n 1) (cons (+ acc 1) nil))) de)
))
(vapply inner (cons inner (cons (eval (car p) de) (cons 0 nil))) de)
))", *VAPPLY);
// Won't work unless tail calls work
// so no PE?
eval_test(false, &g, &e, &format!("{} (badid 1000)", def_badid), 1000);
}
static VMAP: Lazy<String> = Lazy::new(|| {
format!("
{}
!(let1 vmap (vau de p
!(let1 vmap_inner (vau ide ip
!(let1 self (car ip))
!(let1 f (car (cdr ip)))
!(let1 l (car (cdr (cdr ip))))
!(if (= nil l) l)
(cons (vapply f (cons (car l) nil) de) (vapply self (cons self (cons f (cons (cdr l) nil))) de))
))
(vapply vmap_inner (cons vmap_inner (cons (eval (car p) de) (cons (eval (car (cdr p)) de) nil))) de)
))", *VAPPLY)
});
#[test]
fn vmap_eval_test() { let g = grammar::TermParser::new(); let e = root_env();
// Maybe define in terms of a right fold?
//eval_test(true, &g, &e, &format!("{} (vmap (vau de p (+ 1 (car p))) '(1 2 3))", *VMAP), (2, (3, (4, Form::Nil))));
eval_test(true, &g, &e, &format!("{} (vmap (vau de p (+ 1 (car p))) '(1))", *VMAP), (2, Form::Nil));
}
static WRAP: Lazy<String> = Lazy::new(|| {
format!("
{}
!(let1 wrap (vau de p
!(let1 f (eval (car p) de))
(vau ide p (vapply f (vmap (vau _ xp (eval (car xp) ide)) p) ide))
))", *VMAP)
});
#[test]
fn wrap_eval_test() { let g = grammar::TermParser::new(); let e = root_env();
// Make sure (wrap (vau ...)) and internal style are optimized the same
eval_test(true, &g, &e, &format!("{} ((wrap (vau _ p (+ (car p) 1))) (+ 1 2))", *WRAP), 4);
}
static UNWRAP: Lazy<String> = Lazy::new(|| {
format!("
{}
!(let1 unwrap (vau de p
!(let1 f (eval (car p) de))
(vau ide p (vapply f (vmap (vau _ xp (cons quote (cons (car xp) nil))) p) ide))
))", *WRAP)
});
#[test]
fn unwrap_eval_test() { let g = grammar::TermParser::new(); let e = root_env();
// Can't represent prims in tests :( - they do work though, uncommenting and checking the
// failed assert verifies
//eval_test(true, &g, &e, &format!("{} ((unwrap (vau de p (car p))) (+ 1 2))", def_unwrap), ("quote", (("+", (1, (2, Form::Nil))), Form::Nil)));
//eval_test(true, &g, &e, &format!("{} ((unwrap (vau de p (eval (car p) de))) (+ 1 2))", def_unwrap), (("+", (1, (2, Form::Nil))), Form::Nil));
eval_test(true, &g, &e, &format!("{} ((unwrap (vau de p (eval (eval (car p) de) de))) (+ 1 2))", *UNWRAP), 3);
eval_test(true, &g, &e, &format!("{} ((unwrap (vau de p (+ (eval (eval (car p) de) de) 1))) (+ 1 2))", *UNWRAP), 4);
}
static LAPPLY: Lazy<String> = Lazy::new(|| {
format!("
{}
!(let1 lapply (vau de p
!(let1 f (eval (car p) de))
!(let1 ip (eval (car (cdr p)) de))
!(let1 nde (eval (car (cdr (cdr p))) de))
(eval (cons (unwrap f) ip) nde)
))", *UNWRAP)
});
#[test]
fn lapply_eval_test() { let g = grammar::TermParser::new(); let e = root_env();
// Should this allow envs at all? It technically can, but I feel like it kinda goes against the
// sensible deriviation
let def_lbadid = format!("
{}
!(let1 lbadid (vau de p
!(let1 inner (wrap (vau ide ip
!(let1 self (car ip))
!(let1 n (car (cdr ip)))
!(let1 acc (car (cdr (cdr ip))))
!(if (= 0 n) acc)
(lapply self (cons self (cons (- n 1) (cons (+ acc 1) nil))) de)
)))
(lapply inner (cons inner (cons (eval (car p) de) (cons 0 nil))) de)
))", *LAPPLY);
// Won't work unless tail calls work
// takes a while though
eval_test(false, &g, &e, &format!("{} (lbadid 1000)", def_lbadid), 1000);
}
static VFOLDL: Lazy<String> = Lazy::new(|| {
format!("
{}
!(let1 vfoldl (vau de p
!(let1 vfoldl_inner (vau ide ip
!(let1 self (car ip))
!(let1 f (car (cdr ip)))
!(let1 a (car (cdr (cdr ip))))
!(let1 l (car (cdr (cdr (cdr ip)))))
!(if (= nil l) a)
(vapply self (cons self (cons f (cons (vapply f (cons a (cons (car l) nil)) de) (cons (cdr l) nil)))) de)
))
(vapply vfoldl_inner (cons vfoldl_inner (cons (eval (car p) de) (cons (eval (car (cdr p)) de) (cons (eval (car (cdr (cdr p))) de) nil)))) de)
))", *LAPPLY)
});
#[test]
fn vfoldl_eval_test() { let g = grammar::TermParser::new(); let e = root_env();
eval_test(true, &g, &e, &format!("{} (vfoldl (vau de p (+ (car p) (car (cdr p)))) 0 '(1 2 3))", *VFOLDL), 6);
}
static ZIPD: Lazy<String> = Lazy::new(|| {
format!("
{}
!(let1 zipd (vau de p
!(let1 zipd_inner (vau ide ip
!(let1 self (car ip))
!(let1 a (car (cdr ip)))
!(let1 b (car (cdr (cdr ip))))
!(if (= nil a) a)
!(if (= nil b) b)
(cons (cons (car a) (car b)) (vapply self (cons self (cons (cdr a) (cons (cdr b) nil))) de))
))
(vapply zipd_inner (cons zipd_inner (cons (eval (car p) de) (cons (eval (car (cdr p)) de) nil))) de)
))", *VFOLDL)
});
#[test]
fn zipd_eval_test() { let g = grammar::TermParser::new(); let e = root_env();
eval_test(true, &g, &e, &format!("{} (zipd '(1 2 3) '(4 5 6))", *ZIPD), ((1,4), ((2,5), ((3,6), Form::Nil))));
}
static CONCAT: Lazy<String> = Lazy::new(|| {
format!("
{}
!(let1 concat (vau de p
!(let1 concat_inner (vau ide ip
!(let1 self (car ip))
!(let1 a (car (cdr ip)))
!(let1 b (car (cdr (cdr ip))))
!(if (= nil a) b)
(cons (car a) (vapply self (cons self (cons (cdr a) (cons b nil))) de))
))
(vapply concat_inner (cons concat_inner (cons (eval (car p) de) (cons (eval (car (cdr p)) de) nil))) de)
))", *ZIPD)
});
#[test]
fn concat_eval_test() { let g = grammar::TermParser::new(); let e = root_env();
eval_test(true, &g, &e, &format!("{} (concat '(1 2 3) '(4 5 6))", *CONCAT), (1, (2, (3, (4, (5, (6, Form::Nil)))))));
}
static BVAU: Lazy<String> = Lazy::new(|| {
format!("
{}
!(let1 match_params (wrap (vau 0 p
!(let1 self (car p))
!(let1 p_ls (car (cdr p)))
!(let1 dp (car (cdr (cdr p))))
!(let1 e (car (cdr (cdr (cdr p)))))
!(if (= nil p_ls) (assert (= nil dp) e))
!(if (symbol? p_ls) (cons (cons p_ls dp) e))
(self self (cdr p_ls) (cdr dp) (self self (car p_ls) (car dp) e))
)))
!(let1 bvau (vau se p
(if (= nil (cdr (cdr p)))
; No de case
!(let1 p_ls (car p))
!(let1 b_v (car (cdr p)))
(vau 0 dp
(eval b_v (match_params match_params p_ls dp se))
)
; de case
!(let1 de_s (car p))
!(let1 p_ls (car (cdr p)))
!(let1 b_v (car (cdr (cdr p))))
(vau dde dp
(eval b_v (match_params match_params p_ls dp (cons (cons de_s dde) se)))
)
)
))", *CONCAT)
});
#[test]
fn bvau_eval_test() { let g = grammar::TermParser::new(); let e = root_env();
eval_test(true, &g, &e, &format!("{} ((bvau _ (a b c) (+ a (- b c))) 10 2 3)", *BVAU), 9);
//eval_test(true, &g, &e, &format!("{} ((bvau (a b c) (+ a (- b c))) 10 2 3)", *BVAU), 9);
//eval_test(true, &g, &e, &format!("{} ((bvau (a b . c) c) 10 2 3)", *BVAU), (3, Form::Nil));
//eval_test(true, &g, &e, &format!("{} ((bvau (a b . c) c) 10 2)", *BVAU), Form::Nil);
//eval_test(true, &g, &e, &format!("{} ((bvau (a b . c) c) 10 2 3 4 5)", *BVAU), (3, (4, (5, Form::Nil))));
//eval_test(true, &g, &e, &format!("{} ((bvau c c) 3 4 5)", *BVAU), (3, (4, (5, Form::Nil))));
//eval_test(true, &g, &e, &format!("{} ((bvau c c))", *BVAU), Form::Nil);
//eval_test(true, &g, &e, &format!("{} ((bvau ((a b) . c) c) (10 2) 3 4 5)", *BVAU), (3, (4, (5, Form::Nil))));
//eval_test(true, &g, &e, &format!("{} ((bvau ((a b) . c) a) (10 2) 3 4 5)", *BVAU), 10);
//eval_test(true, &g, &e, &format!("{} ((bvau ((a b) . c) b) (10 2) 3 4 5)", *BVAU), 2);
//eval_test(true, &g, &e, &format!("{} ((wrap (bvau _ (a b c) (+ a (- b c)))) (+ 10 1) (+ 2 2) (+ 5 3))", *BVAU), 7);
//eval_test(true, &g, &e, &format!("{} ((wrap (bvau (a b c) (+ a (- b c)))) (+ 10 1) (+ 2 2) (+ 5 3))", *BVAU), 7);
}
static LAMBDA: Lazy<String> = Lazy::new(|| {
format!("
{}
!(let1 lambda (vau de p
(wrap (vapply bvau p de))
))", *BVAU)
});
#[test]
fn lambda_eval_test() { let g = grammar::TermParser::new(); let e = root_env();
eval_test(true, &g, &e, &format!("{} ((lambda (a b c) (+ a (- b c))) (+ 10 1) (+ 2 2) (+ 5 3))", *LAMBDA), 7);
eval_test(true, &g, &e, &format!("{} ((lambda (a b . c) c) 10 2 3)", *LAMBDA), (3, Form::Nil));
eval_test(true, &g, &e, &format!("{} ((lambda (a b . c) c) 10 2)", *LAMBDA), Form::Nil);
eval_test(true, &g, &e, &format!("{} ((lambda (a b . c) c) 10 2 3 4 5)", *LAMBDA), (3, (4, (5, Form::Nil))));
eval_test(true, &g, &e, &format!("{} ((lambda c c) 3 4 5)", *LAMBDA), (3, (4, (5, Form::Nil))));
eval_test(true, &g, &e, &format!("{} ((lambda c c))", *LAMBDA), Form::Nil);
eval_test(true, &g, &e, &format!("{} ((lambda ((a b) . c) c) '(10 2) 3 4 5)", *LAMBDA), (3, (4, (5, Form::Nil))));
eval_test(true, &g, &e, &format!("{} ((lambda ((a b) . c) a) '(10 2) 3 4 5)", *LAMBDA), 10);
eval_test(true, &g, &e, &format!("{} ((lambda ((a b) . c) b) '(10 2) 3 4 5)", *LAMBDA), 2);
eval_test(true, &g, &e, &format!("{} ((lambda ((a b . c) d) b) '(10 2 3 4) 3)", *LAMBDA), 2);
eval_test(true, &g, &e, &format!("{} ((lambda ((a b . c) d) c) '(10 2 3 4) 3)", *LAMBDA), (3, (4, Form::Nil)));
// should fail
//eval_test(true, &g, &e, &format!("{} ((lambda (a b c) c) 10 2 3 4)", *LAMBDA), 3);
}
static LET2: Lazy<String> = Lazy::new(|| {
format!("
{}
!(let1 let1 (bvau dp (s v b)
(eval b (match_params match_params s (eval v dp) dp))
))
", *LAMBDA)
});
#[test]
fn let2_eval_test() { let g = grammar::TermParser::new(); let e = root_env();
eval_test(true, &g, &e, &format!("{} (let1 x (+ 10 1) (+ x 1))", *LET2), 12);
eval_test(true, &g, &e, &format!("{} (let1 x '(10 1) x)", *LET2), (10, (1, Form::Nil)));
eval_test(true, &g, &e, &format!("{} (let1 (a b) '(10 1) a)", *LET2), 10);
eval_test(true, &g, &e, &format!("{} (let1 (a b) '(10 1) b)", *LET2), 1);
eval_test(true, &g, &e, &format!("{} (let1 (a b . c) '(10 1) c)", *LET2), Form::Nil);
eval_test(true, &g, &e, &format!("{} (let1 (a b . c) '(10 1 2 3) c)", *LET2), (2, (3, Form::Nil)));
eval_test(true, &g, &e, &format!("{} (let1 ((a . b) . c) '((10 1) 2 3) a)", *LET2), 10);
eval_test(true, &g, &e, &format!("{} (let1 ((a . b) . c) '((10 1) 2 3) b)", *LET2), (1, Form::Nil));
// should fail
//eval_test(true, &g, &e, &format!("{} (let1 (a b c) '(10 2 3 4) a)", *LET2), 10);
}
static LIST: Lazy<String> = Lazy::new(|| {
format!("
{}
!(let1 list (lambda args args))
", *LET2)
});
#[test]
fn list_eval_test() { let g = grammar::TermParser::new(); let e = root_env();
eval_test(true, &g, &e, &format!("{} (list 1 2 (+ 3 4))", *LIST), (1, (2, (7, Form::Nil))));
}
static Y: Lazy<String> = Lazy::new(|| {
format!("
{}
!(let1 Y (lambda (f3)
((lambda (x1) (x1 x1))
(lambda (x2) (f3 (wrap (vau app_env y (lapply (x2 x2) y app_env)))))))
)
", *LIST)
});
#[test]
fn y_eval_test() { let g = grammar::TermParser::new(); let e = root_env();
eval_test(true, &g, &e, &format!("{} ((Y (lambda (recurse) (lambda (n) (if (= 0 n) 1 (* n (recurse (- n 1))))))) 5)", *Y), 120);
}
static RLAMBDA: Lazy<String> = Lazy::new(|| {
format!("
{}
!(let1 rlambda (bvau se (n p b)
(eval (list Y (list lambda (list n) (list lambda p b))) se)
))
", *Y)
});
#[test]
fn rlambda_eval_test() { let g = grammar::TermParser::new(); let e = root_env();
eval_test(true, &g, &e, &format!("{} ((rlambda recurse (n) (if (= 0 n) 1 (* n (recurse (- n 1))))) 5)", *RLAMBDA), 120);
}
static AND_OR: Lazy<String> = Lazy::new(|| {
// need to extend for varidac
format!("
{}
!(let1 and (bvau se (a b)
!(let1 ae (eval a se))
(if ae (eval b se) ae)
))
!(let1 or (bvau se (a b)
!(let1 ae (eval a se))
(if ae ae (eval b se))
))
", *RLAMBDA)
});
#[test]
fn and_or_eval_test() { let g = grammar::TermParser::new(); let e = root_env();
eval_test(true, &g, &e, &format!("{} (and true true)", *AND_OR), true);
eval_test(true, &g, &e, &format!("{} (and false true)", *AND_OR), false);
eval_test(true, &g, &e, &format!("{} (and true false)", *AND_OR), false);
eval_test(true, &g, &e, &format!("{} (and false false)", *AND_OR), false);
eval_test(true, &g, &e, &format!("{} (or true true)", *AND_OR), true);
eval_test(true, &g, &e, &format!("{} (or false true)", *AND_OR), true);
eval_test(true, &g, &e, &format!("{} (or true false)", *AND_OR), true);
eval_test(true, &g, &e, &format!("{} (or false false)", *AND_OR), false);
}
static LEN: Lazy<String> = Lazy::new(|| {
format!("
{}
!(let1 len (lambda (l)
!(let1 len_helper (rlambda len_helper (l a)
(if (pair? l) (len_helper (cdr l) (+ 1 a))
a)
))
(len_helper l 0)
))
", *AND_OR)
});
#[test]
fn len_eval_test() { let g = grammar::TermParser::new(); let e = root_env();
eval_test(true, &g, &e, &format!("{} (len '())", *LEN), 0);
eval_test(true, &g, &e, &format!("{} (len '(1))", *LEN), 1);
eval_test(true, &g, &e, &format!("{} (len '(1 2))", *LEN), 2);
eval_test(true, &g, &e, &format!("{} (len '(1 2 3))", *LEN), 3);
}
static MATCH: Lazy<String> = Lazy::new(|| {
format!("
{}
!(let1 match (bvau de (x . cases)
!(let1 evaluate_case (rlambda evaluate_case (access c)
!(if (symbol? c) (list true (lambda (b) (list let1 c access b))))
!(if (and (pair? c) (= 'unquote (car c))) (list (list = access (car (cdr c))) (lambda (b) b)))
!(if (and (pair? c) (= 'quote (car c))) (list (list = access c) (lambda (b) b)))
!(if (pair? c)
!(let1 tests (list and (list pair? access) (list = (len c) (list len access))))
!(let1 (tests body_func) ((rlambda recurse (c tests access body_func) (if (pair? c)
!(let1 (inner_test inner_body_func) (evaluate_case (list car access) (car c)))
(recurse (cdr c)
(list and tests inner_test)
(list cdr access)
(lambda (b) (body_func (inner_body_func b))))
; else
(list tests body_func)
))
c tests access (lambda (b) b)))
(list tests body_func))
(list (list = access c) (lambda (b) b))
))
!(let1 helper (rlambda helper (x_sym cases) (if (= nil cases) (list assert false)
(let1 (test body_func) (evaluate_case x_sym (car cases))
(concat (list if test (body_func (car (cdr cases)))) (list (helper x_sym (cdr (cdr cases)))))))))
(eval (list let1 '___MATCH_SYM x (helper '___MATCH_SYM cases)) de)
;!(let1 expanded (list let1 '___MATCH_SYM x (helper '___MATCH_SYM cases)))
;(debug expanded (eval expanded de))
))
", *LEN)
});
#[test]
fn match_eval_test() { let g = grammar::TermParser::new(); let e = root_env();
eval_test(true, &g, &e, &format!("{} (match (+ 1 2) 1 2 2 3 3 4 _ 0)", *MATCH), 4);
eval_test(true, &g, &e, &format!("{} (match '(1 2) 1 2 2 3 3 4 _ 0)", *MATCH), 0);
eval_test(true, &g, &e, &format!("{} (match '(1 2) 1 2 2 3 (a b) (+ a (+ 2 b)) _ 0)", *MATCH), 5);
eval_test(true, &g, &e, &format!("{} (match '(1 2) 1 2 2 3 '(1 2) 7 _ 0)", *MATCH), 7);
eval_test(true, &g, &e, &format!("{} (let1 a 70 (match (+ 60 10) (unquote a) 100 2 3 _ 0))", *MATCH), 100);
}
static RBTREE: Lazy<String> = Lazy::new(|| {
format!("
{}
!(let1 empty (list 'B nil nil nil))
!(let1 E empty)
!(let1 EE (list 'BB nil nil nil))
!(let1 generic-foldl (rlambda generic-foldl (f z t) (match t
(unquote E) z
(c a x b) !(let1 new_left_result (generic-foldl f z a))
!(let1 folded (f new_left_result x))
(generic-foldl f folded b))))
!(let1 blacken (lambda (t) (match t
('R a x b) (list 'B a x b)
t t)))
!(let1 balance (lambda (t) (match t
; figures 1 and 2
('B ('R ('R a x b) y c) z d) (list 'R (list 'B a x b) y (list 'B c z d))
('B ('R a x ('R b y c)) z d) (list 'R (list 'B a x b) y (list 'B c z d))
('B a x ('R ('R b y c) z d)) (list 'R (list 'B a x b) y (list 'B c z d))
('B a x ('R b y ('R c z d))) (list 'R (list 'B a x b) y (list 'B c z d))
; figure 8, double black cases
('BB ('R a x ('R b y c)) z d) (list 'B (list 'B a x b) y (list 'B c z d))
('BB a x ('R ('R b y c) z d)) (list 'B (list 'B a x b) y (list 'B c z d))
; already balenced
t t)))
!(let1 map-insert !(let1 ins (rlambda ins (t k v) (match t
(unquote E) (list 'R t (list k v) t)
(c a x b) !(if (< k (car x)) (balance (list c (ins a k v) x b)))
!(if (= k (car x)) (list c a (list k v) b))
(balance (list c a x (ins b k v))))))
(lambda (t k v) (blacken (ins t k v))))
!(let1 map-empty empty)
!(let1 make-test-tree (rlambda make-test-tree (n t) (if (<= n 0) t
(make-test-tree (- n 1) (map-insert t n (= 0 (% n 10)))))))
!(let1 reduce-test-tree (lambda (tree) (generic-foldl (lambda (a x) (if (car (cdr x)) (+ a 1) a)) 0 tree)))
", *MATCH)
});
#[test]
fn rbtree_eval_test() { let g = grammar::TermParser::new(); let e = root_env();
eval_test(false, &g, &e, &format!("{} (reduce-test-tree (make-test-tree 10 map-empty))", *RBTREE), 1);
//eval_test(false, &g, &e, &format!("{} (reduce-test-tree (make-test-tree 20 map-empty))", *RBTREE), 2);
}

292
kv/Cargo.lock generated
View File

@@ -4,29 +4,30 @@ version = 3
[[package]]
name = "ahash"
version = "0.8.3"
version = "0.8.6"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "2c99f64d1e06488f620f932677e24bc6e2897582980441ae90a671415bd7ec2f"
checksum = "91429305e9f0a25f6205c5b8e0d2db09e0708a7a6df0f42212bb56c32c8ac97a"
dependencies = [
"cfg-if",
"once_cell",
"version_check",
"zerocopy",
]
[[package]]
name = "aho-corasick"
version = "1.0.2"
version = "1.1.2"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "43f6cb1bf222025340178f382c426f13757b2960e89779dfcb319c32542a5a41"
checksum = "b2969dcb958b36655471fc61f7e416fa76033bdd4bfed0678d8fee1e2d07a1f0"
dependencies = [
"memchr",
]
[[package]]
name = "anyhow"
version = "1.0.71"
version = "1.0.75"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "9c7d0618f0e0b7e8ff11427422b64564d5fb0be1940354bfe2e0529b18a9d9b8"
checksum = "a4668cab20f66d8d020e1fbc0ebe47217433c1b6c8f2040faf858554e394ace6"
[[package]]
name = "ascii-canvas"
@@ -66,27 +67,21 @@ checksum = "bef38d45163c2f1dde094a7dfd33ccf595c92905c8f8f4fdc18d06fb1037718a"
[[package]]
name = "bitflags"
version = "2.3.3"
version = "2.4.1"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "630be753d4e58660abd17930c71b647fe46c27ea6b63cc59e1e3851406972e42"
checksum = "327762f6e5a765692301e5bb513e0d9fef63be86bbc14528052b1cd3e6f03e07"
[[package]]
name = "bumpalo"
version = "3.13.0"
version = "3.14.0"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "a3e2c3daef883ecc1b5d58c15adae93470a91d425f3532ba1695849656af3fc1"
checksum = "7f30e7476521f6f8af1a1c4c0b8cc94f0bee37d91763d0ca2665f299b6cd8aec"
[[package]]
name = "byteorder"
version = "1.4.3"
version = "1.5.0"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "14c189c53d098945499cdfa7ecc63567cf3886b3332b312a5b4585d8d3a6a610"
[[package]]
name = "cc"
version = "1.0.79"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "50d30906286121d95be3d479533b458f87493b30a4b5f79a607db8f5d11aa91f"
checksum = "1fd0f2584146f6f2ef48085050886acf353beff7305ebd1ae69500e27c67f64b"
[[package]]
name = "cfg-if"
@@ -247,9 +242,9 @@ dependencies = [
[[package]]
name = "either"
version = "1.8.1"
version = "1.9.0"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "7fcaabb2fef8c910e7f4c7ce9f67a1283a1715879a7c230ca9d6d1ae31f16d91"
checksum = "a26ae43d7bcc3b814de94796a5e736d4029efb0ee900c12e2d54c993ad1a1e07"
[[package]]
name = "ena"
@@ -261,24 +256,19 @@ dependencies = [
]
[[package]]
name = "errno"
version = "0.3.1"
name = "equivalent"
version = "1.0.1"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "4bcfec3a70f97c962c307b2d2c56e358cf1d00b558d74262b5f929ee8cc7e73a"
dependencies = [
"errno-dragonfly",
"libc",
"windows-sys 0.48.0",
]
checksum = "5443807d6dff69373d433ab9ef5378ad8df50ca6298caf15de6e52e24aaf54d5"
[[package]]
name = "errno-dragonfly"
version = "0.1.2"
name = "errno"
version = "0.3.7"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "aa68f1b12764fab894d2755d2518754e71b4fd80ecfb822714a1206c2aab39bf"
checksum = "f258a7194e7f7c2a7837a8913aeab7fd8c383457034fa20ce4dd3dcb813e8eb8"
dependencies = [
"cc",
"libc",
"windows-sys 0.48.0",
]
[[package]]
@@ -304,9 +294,9 @@ dependencies = [
[[package]]
name = "getrandom"
version = "0.2.10"
version = "0.2.11"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "be4136b2a15dd319360be1c07d9933517ccf0be8f16bf62a3bee4f0d618df427"
checksum = "fe9006bed769170c11f845cf00c7c1e9092aeb3f268e007c3e760ac68008070f"
dependencies = [
"cfg-if",
"libc",
@@ -320,7 +310,7 @@ source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "b6c80984affa11d98d1b88b66ac8853f143217b399d3c74116778ff8fdb4ed2e"
dependencies = [
"fallible-iterator",
"indexmap",
"indexmap 1.9.3",
"stable_deref_trait",
]
@@ -340,10 +330,16 @@ dependencies = [
]
[[package]]
name = "hermit-abi"
version = "0.3.1"
name = "hashbrown"
version = "0.14.2"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "fed44880c466736ef9a5c5b5facefb5ed0785676d0c02d612db14e54f0d84286"
checksum = "f93e7192158dbcda357bdec5fb5788eebf8bbac027f3f33e719d29135ae84156"
[[package]]
name = "hermit-abi"
version = "0.3.3"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "d77f7ec81a6d05a3abb01ab6eb7590f6083d08449fe5a1c8b1e620283546ccb7"
[[package]]
name = "indexmap"
@@ -356,10 +352,20 @@ dependencies = [
]
[[package]]
name = "is-terminal"
version = "0.4.8"
name = "indexmap"
version = "2.1.0"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "24fddda5af7e54bf7da53067d6e802dbcc381d0a8eef629df528e3ebf68755cb"
checksum = "d530e1a18b1cb4c484e6e34556a0d948706958449fca0cab753d649f2bce3d1f"
dependencies = [
"equivalent",
"hashbrown 0.14.2",
]
[[package]]
name = "is-terminal"
version = "0.4.9"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "cb0889898416213fab133e1d33a0e5858a48177452750691bde3666d0fdbaf8b"
dependencies = [
"hermit-abi",
"rustix",
@@ -423,21 +429,32 @@ dependencies = [
[[package]]
name = "libc"
version = "0.2.147"
version = "0.2.150"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "b4668fb0ea861c1df094127ac5f1da3409a82116a4ba74fca2e58ef927159bb3"
checksum = "89d92a4743f9a61002fae18374ed11e7973f530cb3a3255fb354818118b2203c"
[[package]]
name = "libredox"
version = "0.0.1"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "85c833ca1e66078851dba29046874e38f08b2c883700aa29a03ddd3b23814ee8"
dependencies = [
"bitflags 2.4.1",
"libc",
"redox_syscall",
]
[[package]]
name = "linux-raw-sys"
version = "0.4.3"
version = "0.4.11"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "09fc20d2ca12cb9f044c93e3bd6d32d523e6e2ec3db4f7b2939cd99026ecd3f0"
checksum = "969488b55f8ac402214f3f5fd243ebb7206cf82de60d3172994707a4bcc2b829"
[[package]]
name = "lock_api"
version = "0.4.10"
version = "0.4.11"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "c1cc9717a20b1bb222f333e6a92fd32f7d8a18ddc5a3191a11af45dcbf4dcd16"
checksum = "3c168f8615b12bc01f9c17e2eb0cc07dcae1940121185446edc3744920e8ef45"
dependencies = [
"autocfg",
"scopeguard",
@@ -445,9 +462,9 @@ dependencies = [
[[package]]
name = "log"
version = "0.4.19"
version = "0.4.20"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "b06a4cde4c0f271a446782e3eff8de789548ce57dbc8eca9292c27f4a42004b4"
checksum = "b5e6163cb8c49088c2c36f57875e58ccd8c87c7427f7fbd50ea6710b2f3f2e8f"
[[package]]
name = "mach"
@@ -460,9 +477,9 @@ dependencies = [
[[package]]
name = "memchr"
version = "2.5.0"
version = "2.6.4"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "2dffe52ecf27772e601905b7522cb4ef790d2cc203488bbd0e2fe85fcb74566d"
checksum = "f665ee40bc4a3c5590afb1e9677db74a508659dfd71e126420da8274909a0167"
[[package]]
name = "new_debug_unreachable"
@@ -488,25 +505,25 @@ dependencies = [
[[package]]
name = "parking_lot_core"
version = "0.9.8"
version = "0.9.9"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "93f00c865fe7cabf650081affecd3871070f26767e7b2070a3ffae14c654b447"
checksum = "4c42a9226546d68acdd9c0a280d17ce19bfe27a46bf68784e4066115788d008e"
dependencies = [
"cfg-if",
"libc",
"redox_syscall 0.3.5",
"redox_syscall",
"smallvec",
"windows-targets 0.48.1",
"windows-targets 0.48.5",
]
[[package]]
name = "petgraph"
version = "0.6.3"
version = "0.6.4"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "4dd7d28ee937e54fe3080c91faa1c3a46c06de6252988a7f4592ba2310ef22a4"
checksum = "e1d3afd2628e69da2be385eb6f2fd57c8ac7977ceeff6dc166ff1657b0e386a9"
dependencies = [
"fixedbitset",
"indexmap",
"indexmap 2.1.0",
]
[[package]]
@@ -526,48 +543,39 @@ checksum = "925383efa346730478fb4838dbe9137d2a47675ad789c546d150a6e1dd4ab31c"
[[package]]
name = "proc-macro2"
version = "1.0.63"
version = "1.0.69"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "7b368fba921b0dce7e60f5e04ec15e565b3303972b42bcfde1d0713b881959eb"
checksum = "134c189feb4956b20f6f547d2cf727d4c0fe06722b20a0eec87ed445a97f92da"
dependencies = [
"unicode-ident",
]
[[package]]
name = "quote"
version = "1.0.29"
version = "1.0.33"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "573015e8ab27661678357f27dc26460738fd2b6c86e46f386fde94cb5d913105"
checksum = "5267fca4496028628a95160fc423a33e8b2e6af8a5302579e322e4b520293cae"
dependencies = [
"proc-macro2",
]
[[package]]
name = "redox_syscall"
version = "0.2.16"
version = "0.4.1"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "fb5a58c1855b4b6819d59012155603f0b22ad30cad752600aadfcb695265519a"
dependencies = [
"bitflags 1.3.2",
]
[[package]]
name = "redox_syscall"
version = "0.3.5"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "567664f262709473930a4bf9e51bf2ebf3348f2e748ccc50dea20646858f8f29"
checksum = "4722d768eff46b75989dd134e5c353f0d6296e5aaa3132e776cbdb56be7731aa"
dependencies = [
"bitflags 1.3.2",
]
[[package]]
name = "redox_users"
version = "0.4.3"
version = "0.4.4"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "b033d837a7cf162d7993aded9304e30a83213c648b6e389db233191f891e5c2b"
checksum = "a18479200779601e498ada4e8c1e1f50e3ee19deb0259c25825a98b5603b2cb4"
dependencies = [
"getrandom",
"redox_syscall 0.2.16",
"libredox",
"thiserror",
]
@@ -585,13 +593,25 @@ dependencies = [
[[package]]
name = "regex"
version = "1.8.4"
version = "1.10.2"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "d0ab3ca65655bb1e41f2a8c8cd662eb4fb035e67c3f78da1d61dffe89d07300f"
checksum = "380b951a9c5e80ddfd6136919eef32310721aa4aacd4889a8d39124b026ab343"
dependencies = [
"aho-corasick",
"memchr",
"regex-syntax 0.7.2",
"regex-automata",
"regex-syntax 0.8.2",
]
[[package]]
name = "regex-automata"
version = "0.4.3"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "5f804c7828047e88b2d32e2d7fe5a105da8ee3264f01902f796c8e067dc2483f"
dependencies = [
"aho-corasick",
"memchr",
"regex-syntax 0.8.2",
]
[[package]]
@@ -602,9 +622,9 @@ checksum = "f162c6dd7b008981e4d40210aca20b4bd0f9b60ca9271061b07f78537722f2e1"
[[package]]
name = "regex-syntax"
version = "0.7.2"
version = "0.8.2"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "436b050e76ed2903236f032a59761c1eb99e1b0aead2c257922771dab1fc8c78"
checksum = "c08c74e62047bb2de4ff487b251e4a92e24f48745648451635cec7d591162d9f"
[[package]]
name = "region"
@@ -620,11 +640,11 @@ dependencies = [
[[package]]
name = "rustix"
version = "0.38.2"
version = "0.38.25"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "aabcb0461ebd01d6b79945797c27f8529082226cb630a9865a71870ff63532a4"
checksum = "dc99bc2d4f1fed22595588a013687477aedf3cdcfb26558c559edb67b4d9b22e"
dependencies = [
"bitflags 2.3.3",
"bitflags 2.4.1",
"errno",
"libc",
"linux-raw-sys",
@@ -633,21 +653,21 @@ dependencies = [
[[package]]
name = "rustversion"
version = "1.0.12"
version = "1.0.14"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "4f3208ce4d8448b3f3e7d168a73f5e0c43a61e32930de3bceeccedb388b6bf06"
checksum = "7ffc183a10b4478d04cbbbfc96d0873219d962dd5accaff2ffbd4ceb7df837f4"
[[package]]
name = "scopeguard"
version = "1.1.0"
version = "1.2.0"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "d29ab0c6d3fc0ee92fe66e2d99f700eab17a8d57d1c1d3b748380fb20baa78cd"
checksum = "94143f37725109f92c262ed2cf5e59bce7498c01bcc1502d7b9afe439a4e9f49"
[[package]]
name = "siphasher"
version = "0.3.10"
version = "0.3.11"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "7bd3e3206899af3f8b12af284fafc038cc1dc2b41d1b89dd17297221c5d225de"
checksum = "38b58827f4464d87d377d175e90bf58eb00fd8716ff0a62f80356b5e61555d0d"
[[package]]
name = "slice-group-by"
@@ -657,9 +677,9 @@ checksum = "826167069c09b99d56f31e9ae5c99049e932a98c9dc2dac47645b08dbbf76ba7"
[[package]]
name = "smallvec"
version = "1.10.0"
version = "1.11.2"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "a507befe795404456341dfab10cef66ead4c041f62b8b11bbb92bffe5d0953e0"
checksum = "4dccd0940a2dcdf68d092b8cbab7dc0ad8fa938bf95787e1b916b0e3d0e8e970"
[[package]]
name = "stable_deref_trait"
@@ -682,9 +702,9 @@ dependencies = [
[[package]]
name = "syn"
version = "2.0.23"
version = "2.0.39"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "59fb7d6d8281a51045d62b8eb3a7d1ce347b76f312af50cd3dc0af39c87c1737"
checksum = "23e78b90f2fcf45d3e842032ce32e3f2d1545ba6636271dcbf24fa306d87be7a"
dependencies = [
"proc-macro2",
"quote",
@@ -693,9 +713,9 @@ dependencies = [
[[package]]
name = "target-lexicon"
version = "0.12.8"
version = "0.12.12"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "1b1c7f239eb94671427157bd93b3694320f3668d4e1eff08c7285366fd777fac"
checksum = "14c39fd04924ca3a864207c66fc2cd7d22d7c016007f9ce846cbb9326331930a"
[[package]]
name = "term"
@@ -710,18 +730,18 @@ dependencies = [
[[package]]
name = "thiserror"
version = "1.0.40"
version = "1.0.50"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "978c9a314bd8dc99be594bc3c175faaa9794be04a5a5e153caba6915336cebac"
checksum = "f9a7210f5c9a7156bb50aa36aed4c95afb51df0df00713949448cf9e97d382d2"
dependencies = [
"thiserror-impl",
]
[[package]]
name = "thiserror-impl"
version = "1.0.40"
version = "1.0.50"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "f9456a42c5b0d803c8cd86e73dd7cc9edd429499f37a3550d286d5e86720569f"
checksum = "266b2e40bc00e5a6c09c3584011e08b06f123c00362c92b975ba9843aaaa14b8"
dependencies = [
"proc-macro2",
"quote",
@@ -739,9 +759,9 @@ dependencies = [
[[package]]
name = "unicode-ident"
version = "1.0.9"
version = "1.0.12"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "b15811caf2415fb889178633e7724bad2509101cde276048e013b9def5e51fa0"
checksum = "3354b9ac3fae1ff6755cb6db53683adb661634f67557942dea4facebec0fee4b"
[[package]]
name = "unicode-xid"
@@ -809,7 +829,7 @@ version = "0.48.0"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "677d2418bec65e3338edb076e806bc1ec15693c5d0104683f2efe857f61056a9"
dependencies = [
"windows-targets 0.48.1",
"windows-targets 0.48.5",
]
[[package]]
@@ -829,17 +849,17 @@ dependencies = [
[[package]]
name = "windows-targets"
version = "0.48.1"
version = "0.48.5"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "05d4b17490f70499f20b9e791dcf6a299785ce8af4d709018206dc5b4953e95f"
checksum = "9a2fa6e2155d7247be68c096456083145c183cbbbc2764150dda45a87197940c"
dependencies = [
"windows_aarch64_gnullvm 0.48.0",
"windows_aarch64_msvc 0.48.0",
"windows_i686_gnu 0.48.0",
"windows_i686_msvc 0.48.0",
"windows_x86_64_gnu 0.48.0",
"windows_x86_64_gnullvm 0.48.0",
"windows_x86_64_msvc 0.48.0",
"windows_aarch64_gnullvm 0.48.5",
"windows_aarch64_msvc 0.48.5",
"windows_i686_gnu 0.48.5",
"windows_i686_msvc 0.48.5",
"windows_x86_64_gnu 0.48.5",
"windows_x86_64_gnullvm 0.48.5",
"windows_x86_64_msvc 0.48.5",
]
[[package]]
@@ -850,9 +870,9 @@ checksum = "597a5118570b68bc08d8d59125332c54f1ba9d9adeedeef5b99b02ba2b0698f8"
[[package]]
name = "windows_aarch64_gnullvm"
version = "0.48.0"
version = "0.48.5"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "91ae572e1b79dba883e0d315474df7305d12f569b400fcf90581b06062f7e1bc"
checksum = "2b38e32f0abccf9987a4e3079dfb67dcd799fb61361e53e2882c3cbaf0d905d8"
[[package]]
name = "windows_aarch64_msvc"
@@ -862,9 +882,9 @@ checksum = "e08e8864a60f06ef0d0ff4ba04124db8b0fb3be5776a5cd47641e942e58c4d43"
[[package]]
name = "windows_aarch64_msvc"
version = "0.48.0"
version = "0.48.5"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "b2ef27e0d7bdfcfc7b868b317c1d32c641a6fe4629c171b8928c7b08d98d7cf3"
checksum = "dc35310971f3b2dbbf3f0690a219f40e2d9afcf64f9ab7cc1be722937c26b4bc"
[[package]]
name = "windows_i686_gnu"
@@ -874,9 +894,9 @@ checksum = "c61d927d8da41da96a81f029489353e68739737d3beca43145c8afec9a31a84f"
[[package]]
name = "windows_i686_gnu"
version = "0.48.0"
version = "0.48.5"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "622a1962a7db830d6fd0a69683c80a18fda201879f0f447f065a3b7467daa241"
checksum = "a75915e7def60c94dcef72200b9a8e58e5091744960da64ec734a6c6e9b3743e"
[[package]]
name = "windows_i686_msvc"
@@ -886,9 +906,9 @@ checksum = "44d840b6ec649f480a41c8d80f9c65108b92d89345dd94027bfe06ac444d1060"
[[package]]
name = "windows_i686_msvc"
version = "0.48.0"
version = "0.48.5"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "4542c6e364ce21bf45d69fdd2a8e455fa38d316158cfd43b3ac1c5b1b19f8e00"
checksum = "8f55c233f70c4b27f66c523580f78f1004e8b5a8b659e05a4eb49d4166cca406"
[[package]]
name = "windows_x86_64_gnu"
@@ -898,9 +918,9 @@ checksum = "8de912b8b8feb55c064867cf047dda097f92d51efad5b491dfb98f6bbb70cb36"
[[package]]
name = "windows_x86_64_gnu"
version = "0.48.0"
version = "0.48.5"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "ca2b8a661f7628cbd23440e50b05d705db3686f894fc9580820623656af974b1"
checksum = "53d40abd2583d23e4718fddf1ebec84dbff8381c07cae67ff7768bbf19c6718e"
[[package]]
name = "windows_x86_64_gnullvm"
@@ -910,9 +930,9 @@ checksum = "26d41b46a36d453748aedef1486d5c7a85db22e56aff34643984ea85514e94a3"
[[package]]
name = "windows_x86_64_gnullvm"
version = "0.48.0"
version = "0.48.5"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "7896dbc1f41e08872e9d5e8f8baa8fdd2677f29468c4e156210174edc7f7b953"
checksum = "0b7b52767868a23d5bab768e390dc5f5c55825b6d30b86c844ff2dc7414044cc"
[[package]]
name = "windows_x86_64_msvc"
@@ -922,6 +942,26 @@ checksum = "9aec5da331524158c6d1a4ac0ab1541149c0b9505fde06423b02f5ef0106b9f0"
[[package]]
name = "windows_x86_64_msvc"
version = "0.48.0"
version = "0.48.5"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "1a515f5799fe4961cb532f983ce2b23082366b898e52ffbce459c86f67c8378a"
checksum = "ed94fce61571a4006852b7389a063ab983c02eb1bb37b47f8272ce92d06d9538"
[[package]]
name = "zerocopy"
version = "0.7.26"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "e97e415490559a91254a2979b4829267a57d2fcd741a98eee8b722fb57289aa0"
dependencies = [
"zerocopy-derive",
]
[[package]]
name = "zerocopy-derive"
version = "0.7.26"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "dd7e48ccf166952882ca8bd778a43502c64f33bf94c12ebe2a7f08e5a0f6689f"
dependencies = [
"proc-macro2",
"quote",
"syn",
]

2
kv/src/basic.rs
View File

@@ -166,6 +166,8 @@ impl FormT for Form {
Rc::new(Form::Nil))),
e: e,
nc: Box::new(Cont::MetaRet) },
// I think this is unnecessary and can just be "metac },"
// because reset puts this metac in
metac: Cont::CatchRet { nc: Box::new(metac.clone()), restore_meta: Box::new(metac) } },
PrimCombI::Assert => {
let thing = Rc::clone(&ps[0]);

175
misc_tests/basic_match.kp
View File

@@ -1,175 +0,0 @@
((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 (
lcompose (lambda (g f) (lambda (& args) (lapply g (array (lapply f args)))))
rec-lambda (vau se (n p b) (eval (array Y (array lambda (array n) (array lambda p b))) se))
if (vau de (con than & else) (eval (array cond con than
true (cond (> (len else) 0) (idx else 0)
true false)) de))
map (lambda (f5 l5)
(let (helper (rec-lambda recurse (f4 l4 n4 i4)
(cond (= i4 (len l4)) n4
(<= i4 (- (len l4) 4)) (recurse f4 l4 (concat n4 (array
(f4 (idx l4 (+ i4 0)))
(f4 (idx l4 (+ i4 1)))
(f4 (idx l4 (+ i4 2)))
(f4 (idx l4 (+ i4 3)))
)) (+ i4 4))
true (recurse f4 l4 (concat n4 (array (f4 (idx l4 i4)))) (+ i4 1)))))
(helper f5 l5 (array) 0)))
map_i (lambda (f l)
(let (helper (rec-lambda recurse (f l n i)
(cond (= i (len l)) n
(<= i (- (len l) 4)) (recurse f l (concat n (array
(f (+ i 0) (idx l (+ i 0)))
(f (+ i 1) (idx l (+ i 1)))
(f (+ i 2) (idx l (+ i 2)))
(f (+ i 3) (idx l (+ i 3)))
)) (+ i 4))
true (recurse f l (concat n (array (f i (idx l i)))) (+ i 1)))))
(helper f l (array) 0)))
filter_i (lambda (f l)
(let (helper (rec-lambda recurse (f l n i)
(if (= i (len l))
n
(if (f i (idx l i)) (recurse f l (concat n (array (idx l i))) (+ i 1))
(recurse f l n (+ i 1))))))
(helper f l (array) 0)))
filter (lambda (f l) (filter_i (lambda (i x) (f x)) l))
; Huge thanks to Oleg Kiselyov for his fantastic website
; http://okmij.org/ftp/Computation/fixed-point-combinators.html
Y* (lambda (& l)
((lambda (u) (u u))
(lambda (p)
(map (lambda (li) (lambda (& x) (lapply (lapply li (p p)) x))) l))))
vY* (lambda (& l)
((lambda (u) (u u))
(lambda (p)
(map (lambda (li) (vau ide (& x) (vapply (lapply li (p p)) x ide))) l))))
let-rec (vau de (name_func body)
(let (names (filter_i (lambda (i x) (= 0 (% i 2))) name_func)
funcs (filter_i (lambda (i x) (= 1 (% i 2))) name_func)
overwrite_name (idx name_func (- (len name_func) 2)))
(eval (array let (concat (array overwrite_name (concat (array Y*) (map (lambda (f) (array lambda names f)) funcs)))
(lapply concat (map_i (lambda (i n) (array n (array idx overwrite_name i))) names)))
body) de)))
let-vrec (vau de (name_func body)
(let (names (filter_i (lambda (i x) (= 0 (% i 2))) name_func)
funcs (filter_i (lambda (i x) (= 1 (% i 2))) name_func)
overwrite_name (idx name_func (- (len name_func) 2)))
(eval (array let (concat (array overwrite_name (concat (array vY*) (map (lambda (f) (array lambda names f)) funcs)))
(lapply concat (map_i (lambda (i n) (array n (array idx overwrite_name i))) names)))
body) de)))
flat_map (lambda (f l)
(let (helper (rec-lambda recurse (f l n i)
(if (= i (len l))
n
(recurse f l (concat n (f (idx l i))) (+ i 1)))))
(helper f l (array) 0)))
flat_map_i (lambda (f l)
(let (helper (rec-lambda recurse (f l n i)
(if (= i (len l))
n
(recurse f l (concat n (f i (idx l i))) (+ i 1)))))
(helper f l (array) 0)))
; with all this, we make a destrucutring-capable let
let (let (
destructure_helper (rec-lambda recurse (vs i r)
(cond (= (len vs) i) r
(array? (idx vs i)) (let (bad_sym (str-to-symbol (str (idx vs i)))
new_vs (flat_map_i (lambda (i x) (array x (array idx bad_sym i))) (idx vs i))
)
(recurse (concat new_vs (slice vs (+ i 2) -1)) 0 (concat r (array bad_sym (idx vs (+ i 1))))))
true (recurse vs (+ i 2) (concat r (slice vs i (+ i 2))))
))) (vau de (vs b) (vapply let (array (destructure_helper vs 0 (array)) b) de)))
nil (array)
not (lambda (x) (if x false true))
or (let (macro_helper (rec-lambda recurse (bs i) (cond (= i (len bs)) false
(= (+ 1 i) (len bs)) (idx bs i)
true (array let (array 'tmp (idx bs i)) (array if 'tmp 'tmp (recurse bs (+ i 1)))))))
(vau se (& bs) (eval (macro_helper bs 0) se)))
and (let (macro_helper (rec-lambda recurse (bs i) (cond (= i (len bs)) true
(= (+ 1 i) (len bs)) (idx bs i)
true (array let (array 'tmp (idx bs i)) (array if 'tmp (recurse bs (+ i 1)) 'tmp)))))
(vau se (& bs) (eval (macro_helper bs 0) se)))
foldl (let (helper (rec-lambda recurse (f z vs i) (if (= i (len (idx vs 0))) z
(recurse f (lapply f (cons z (map (lambda (x) (idx x i)) vs))) vs (+ i 1)))))
(lambda (f z & vs) (helper f z vs 0)))
foldr (let (helper (rec-lambda recurse (f z vs i) (if (= i (len (idx vs 0))) z
(lapply f (cons (recurse f z vs (+ i 1)) (map (lambda (x) (idx x i)) vs))))))
(lambda (f z & vs) (helper f z vs 0)))
reverse (lambda (x) (foldl (lambda (acc i) (cons i acc)) (array) x))
zip (lambda (& xs) (lapply foldr (concat (array (lambda (a & ys) (cons ys a)) (array)) xs)))
match (let (
evaluate_case (rec-lambda evaluate_case (access c) (cond
(symbol? c) (array true (lambda (b) (array let (array c access) b)))
(and (array? c) (= 2 (len c)) (= 'unquote (idx c 0))) (array (array = access (idx c 1)) (lambda (b) b))
(and (array? c) (= 2 (len c)) (= 'quote (idx c 0))) (array (array = access c) (lambda (b) b))
(array? c) (let (
tests (array and (array array? access) (array = (len c) (array len access)))
(tests body_func) ((rec-lambda recurse (tests body_func i) (if (= i (len c))
(array tests body_func)
(let ( (inner_test inner_body_func) (evaluate_case (array idx access i) (idx c i)) )
(recurse (concat tests (array inner_test))
(lambda (b) (body_func (inner_body_func b)))
(+ i 1)))))
tests (lambda (b) b) 0)
) (array tests body_func))
true (array (array = access c) (lambda (b) b))
))
helper (rec-lambda helper (x_sym cases i) (cond (< i (- (len cases) 1)) (let ( (test body_func) (evaluate_case x_sym (idx cases i)) )
(concat (array test (body_func (idx cases (+ i 1)))) (helper x_sym cases (+ i 2))))
true (array true (array error "none matched"))))
) (vau de (x & cases) (eval (array let (array '___MATCH_SYM x) (concat (array cond) (helper '___MATCH_SYM cases 0))) de)))
ll-nil nil
ll-cons array
ll-make (rec-lambda ll-make (n) (if (= 0 n) ll-nil
(ll-cons n (ll-make (- n 1)))))
ll-sum (rec-lambda ll-sum (l) (match l
,nil 0
(hh (h t)) (+ h hh (ll-sum t))
(h t) (+ h (ll-sum t))
))
monad (array 'write 1 (str "running tree test") (vau (written code)
(array 'args (vau (args code)
;(array 'exit (log (reduce-test-tree (make-test-tree (read-string (idx args 1)) map-empty))))
(array 'exit (log (let (l (ll-make (read-string (idx args 1)))
_ (log "swapping to sum")
) (ll-sum l))))
))
))
) 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))

35
misc_tests/fact.kp
View File

@@ -1,35 +0,0 @@
((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 (* n (fact (- n 1)))))
monad (array 'write 1 "enter number to fact: " (vau (written code)
(array 'read 0 60 (vau (data code)
(array 'exit (fact (read-string data)))
))
))
) 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))

36
misc_tests/fact_lognoopt.kp
View File

@@ -1,36 +0,0 @@
((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))))))
fact (rec-lambda fact (n r) (cond (= 0 n) r
(= 1 n) r
true (fact (- n 1) (band #xFFFFFF (* n r)))))
monad (array 'write 1 "hao" (vau (written code)
(array 'exit (log (fact (log 10000) 1)))
))
) 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))

110
misc_tests/find.kp
View File

@@ -1,110 +0,0 @@
((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 (lambda (& y) (lapply (x2 x2) y))))))
(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))
cdr (lambda (x) (slice x 1 -1))
if (vau de (con than & else) (eval (array cond con than
true (cond (> (len else) 0) (idx else 0)
true false)) de))
and (let (macro_helper (rec-lambda recurse (bs i) (cond (= i (len bs)) true
(= (+ 1 i) (len bs)) (idx bs i)
true (array let (array 'tmp (idx bs i)) (array if 'tmp (recurse bs (+ i 1)) 'tmp)))))
(vau se (& bs) (eval (macro_helper bs 0) se)))
; if len(s1) > 0 && len(sub) > 0:
; char1 = s1[0]
; rest1 = s1[1:]
; char2 = sub[0]
; rest2 = sub[1:]
; if char1 == char2:
; return recurse(rest1, rest2)
; else
; return false
; else if len(s1) > 0 && len(sub) == 0:
; return true
; else if len(s1) == 0:
; return false
; else:
; return false
;
;
compare_substr (rec-lambda cmp (str1 str2) (let (
str1_len (len str1)
str2_len (len str2))
; len(s1) > 0 && len(sub) > 0
(cond (and (> str1_len 0) (> str2_len 0))
(let (
char1 (idx str1 0)
rest1 (cdr str1)
char2 (idx str2 0)
rest2 (cdr str2)
same_char (= char1 char2)
; if char1 == char2: return recurse(str, sub)
; else: return false
) (cond same_char (cmp rest1 rest2)
true false
))
; len(s1) > 0 && len(sub) == 0
(and (> str1_len 0) (= str2_len 0)) true
; else
true false
)
))
; i = index of current match start, passed in
; len1 = len(str)
; len2 = len(sub)
;
; if len2 > len1:
; return -1
; else if len1 > 0 && len2 == 0:
; // No more substr, we matched?
; return i
; else if len1 > 0 && len2 > 0:
; if compare(str, sub):
; return i
; else:
; rest1 = str[1:]
; return recurse(rest1, sub, i+1)
; else
; return -1
;
_find (rec-lambda _find (str sub i) (let (
len1 (len str)
len2 (len sub)
) (cond (> len2 len1) -1
(= len2 0) i
(and (> len1 0) (> len2 0)) (cond (compare_substr str sub) i
true (_find (cdr str) sub (+ i 1)))
true -1
)))
; find the index of a substr in a str
; check if a substr is in a str
find (lambda (str sub) (_find str sub 0))
contains (lambda (str sub) (!= (find str sub) -1))
monad (array 'write 1 "testing find funcs: \n" (vau (written code)
(array 'write 1 "find in \"foobar\" the string \"oba\"\n" (vau (written code)
(array 'write 1 (concat (str (contains "foobar" "oba")) "\n") (vau (written code)
(array 'exit 0)))
))
))
) 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))

66
misc_tests/int2hex.kp
View File

@@ -1,66 +0,0 @@
((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 (lambda (& y) (lapply (x2 x2) y))))))
(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 (
; Some helper hex literals
xF 15
xF0 240
xFF 255
xFF00 65280
xFFFF 65535
xFFFF0000 4294901760
; nibble to hex digit
nibble_to_hexstr(lambda (n)
(cond (= n 15) "f"
(= n 14) "e"
(= n 13) "d"
(= n 12) "c"
(= n 11) "b"
(= n 10) "a"
true (str n))
)
; char to hex str
char_to_hexstr (lambda (c)
(concat
(nibble_to_hexstr (>> (band c xF0) 4))
(nibble_to_hexstr (band c xF)))
)
; short to hex str
short_to_hexstr (lambda (s)
(concat
(char_to_hexstr (>> (band s xFF00) 8))
(char_to_hexstr (band s xFF)))
)
; 32 bit int to hex string helper
int_to_hexstr (lambda (i)
(str
(concat
(short_to_hexstr (>> (band i xFFFF0000) 16))
(short_to_hexstr (band i xFFFF)))
)
)
monad (array 'write 1 "enter int to get hex string: " (vau (written code)
(array 'read 0 60 (vau (num code)
(array 'write 1 (concat (int_to_hexstr (read-string num)) "\n") (vau (written code)
(array 'exit 0)
))))))
) 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))

36
misc_tests/leftrotate32bit.kp
View File

@@ -1,36 +0,0 @@
((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 (lambda (& y) (lapply (x2 x2) y))))))
(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 (
; bitwise left rotate
leftrotate (lambda (i shift_amt)
; Rotate i left by shift amt
(bor (<< i shift_amt) (>> i (- 32 shift_amt)))
)
monad (array 'write 1 "enter int to left rotate: " (vau (written code)
(array 'read 0 60 (vau (num code)
(array 'write 1 "enter rotate amount: " (vau (written code)
(array 'read 0 60 (vau (amount code)
(array 'write 1 (concat (str (leftrotate (read-string num) (read-string amount))) "\n") (vau (written code)
(array 'exit 0)
))))))))))
) 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))

49
misc_tests/palindrome.kp
View File

@@ -1,49 +0,0 @@
((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 (lambda (& y) (lapply (x2 x2) y))))))
(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))
palindrome (rec-lambda palindrome (s) (let (
; _ (log "palindrome called")
length (- (len s) 1) ; -1 because we don't care about \n chars
; _ (log "length is" (str length))
) (cond (= length 0) true
(= length 1) true
true (let (
; _ (log "getting first + last chars")
first (idx s 0)
last (idx s (- length 1))
; _ (log "Checking chars")
; _ (log first " == " last)
)(cond (!= first last) false
true (palindrome (slice s 1 -2)))
)
)))
palindrome_wrap (lambda (s) (cond (palindrome s) (concat "TRUE! " s " is a palindrome!!\n")
true (concat "FALSE! " s " is not a palindrome!!\n")))
monad (array 'write 1 "enter string to check if it is a palindrome: " (vau (written code)
(array 'read 0 60 (vau (s code)
(array 'write 1 (palindrome_wrap s) (vau (written code)
(array 'exit 0)
))))))
) 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))

15
misc_tests/t.kp
View File

@@ -1,15 +0,0 @@
((wrap (vau root_env (quote)
((wrap (vau (let1)
(array 'write 1 "enter form: " (vau (written code)
(array 'read 0 200 (vau (data code)
((wrap (vau (asdf) (array 'exit (log (eval (log (read-string data))))))) code)
;((wrap (vau (asdf) (array 'exit (eval (read-string data))))) code)
;((wrap (vau (asdf) (array 'exit (cond (log "hi") written true code)))) code)
))
))
)) (vau de (s v b) (eval (array (array wrap (array vau (array s) b)) v) de)))
)) (vau (x5) x5))

917
misc_tests/to_compile.kp
View File

@@ -1,917 +0,0 @@
((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 (
lcompose (lambda (g f) (lambda (& args) (lapply g (array (lapply f args)))))
rec-lambda (vau se (n p b) (eval (array Y (array lambda (array n) (array lambda p b))) se))
;if (vau de (con than & else) (cond (eval con de) (eval than de)
; (> (len else) 0) (eval (idx else 0) de)
; true false))
if (vau de (con than & else) (eval (array cond con than
true (cond (> (len else) 0) (idx else 0)
true false)) de))
map (lambda (f5 l5)
; now maybe errors on can't find helper?
(let (helper (rec-lambda recurse (f4 l4 n4 i4)
(cond (= i4 (len l4)) n4
(<= i4 (- (len l4) 4)) (recurse f4 l4 (concat n4 (array
(f4 (idx l4 (+ i4 0)))
(f4 (idx l4 (+ i4 1)))
(f4 (idx l4 (+ i4 2)))
(f4 (idx l4 (+ i4 3)))
)) (+ i4 4))
true (recurse f4 l4 (concat n4 (array (f4 (idx l4 i4)))) (+ i4 1)))))
(helper f5 l5 (array) 0)))
map_i (lambda (f l)
(let (helper (rec-lambda recurse (f l n i)
(cond (= i (len l)) n
(<= i (- (len l) 4)) (recurse f l (concat n (array
(f (+ i 0) (idx l (+ i 0)))
(f (+ i 1) (idx l (+ i 1)))
(f (+ i 2) (idx l (+ i 2)))
(f (+ i 3) (idx l (+ i 3)))
)) (+ i 4))
true (recurse f l (concat n (array (f i (idx l i)))) (+ i 1)))))
(helper f l (array) 0)))
filter_i (lambda (f l)
(let (helper (rec-lambda recurse (f l n i)
(if (= i (len l))
n
(if (f i (idx l i)) (recurse f l (concat n (array (idx l i))) (+ i 1))
(recurse f l n (+ i 1))))))
(helper f l (array) 0)))
filter (lambda (f l) (filter_i (lambda (i x) (f x)) l))
; Huge thanks to Oleg Kiselyov for his fantastic website
; http://okmij.org/ftp/Computation/fixed-point-combinators.html
Y* (lambda (& l)
((lambda (u) (u u))
(lambda (p)
(map (lambda (li) (lambda (& x) (lapply (lapply li (p p)) x))) l))))
vY* (lambda (& l)
((lambda (u) (u u))
(lambda (p)
(map (lambda (li) (vau ide (& x) (vapply (lapply li (p p)) x ide))) l))))
let-rec (vau de (name_func body)
(let (names (filter_i (lambda (i x) (= 0 (% i 2))) name_func)
funcs (filter_i (lambda (i x) (= 1 (% i 2))) name_func)
overwrite_name (idx name_func (- (len name_func) 2)))
(eval (array let (concat (array overwrite_name (concat (array Y*) (map (lambda (f) (array lambda names f)) funcs)))
(lapply concat (map_i (lambda (i n) (array n (array idx overwrite_name i))) names)))
body) de)))
let-vrec (vau de (name_func body)
(let (names (filter_i (lambda (i x) (= 0 (% i 2))) name_func)
funcs (filter_i (lambda (i x) (= 1 (% i 2))) name_func)
overwrite_name (idx name_func (- (len name_func) 2)))
(eval (array let (concat (array overwrite_name (concat (array vY*) (map (lambda (f) (array lambda names f)) funcs)))
(lapply concat (map_i (lambda (i n) (array n (array idx overwrite_name i))) names)))
body) de)))
flat_map (lambda (f l)
(let (helper (rec-lambda recurse (f l n i)
(if (= i (len l))
n
(recurse f l (concat n (f (idx l i))) (+ i 1)))))
(helper f l (array) 0)))
flat_map_i (lambda (f l)
(let (helper (rec-lambda recurse (f l n i)
(if (= i (len l))
n
(recurse f l (concat n (f i (idx l i))) (+ i 1)))))
(helper f l (array) 0)))
; with all this, we make a destrucutring-capable let
let (let (
destructure_helper (rec-lambda recurse (vs i r)
(cond (= (len vs) i) r
(array? (idx vs i)) (let (bad_sym (str-to-symbol (str (idx vs i)))
new_vs (flat_map_i (lambda (i x) (array x (array idx bad_sym i))) (idx vs i))
)
(recurse (concat new_vs (slice vs (+ i 2) -1)) 0 (concat r (array bad_sym (idx vs (+ i 1))))))
true (recurse vs (+ i 2) (concat r (slice vs i (+ i 2))))
))) (vau de (vs b) (vapply let (array (destructure_helper vs 0 (array)) b) de)))
; and a destructuring-capable lambda!
only_symbols (rec-lambda recurse (a i) (cond (= i (len a)) true
(symbol? (idx a i)) (recurse a (+ i 1))
true false))
; Note that if macro_helper is inlined, the mapping lambdas will close over
; se, and then not be able to be taken in as values to the maps, and the vau
; will fail to partially evaluate away.
lambda (let (macro_helper (lambda (p b) (let (
sym_params (map (lambda (param) (if (symbol? param) param
(str-to-symbol (str param)))) p)
body (array let (flat_map_i (lambda (i x) (array (idx p i) x)) sym_params) b)
) (array vau sym_params body))))
(vau se (p b) (if (only_symbols p 0) (vapply lambda (array p b) se)
(wrap (eval (macro_helper p b) se)))))
; and rec-lambda - yes it's the same definition again
rec-lambda (vau se (n p b) (eval (array Y (array lambda (array n) (array lambda p b))) se))
nil (array)
not (lambda (x) (if x false true))
or (let (macro_helper (rec-lambda recurse (bs i) (cond (= i (len bs)) false
(= (+ 1 i) (len bs)) (idx bs i)
true (array let (array 'tmp (idx bs i)) (array if 'tmp 'tmp (recurse bs (+ i 1)))))))
(vau se (& bs) (eval (macro_helper bs 0) se)))
and (let (macro_helper (rec-lambda recurse (bs i) (cond (= i (len bs)) true
(= (+ 1 i) (len bs)) (idx bs i)
true (array let (array 'tmp (idx bs i)) (array if 'tmp (recurse bs (+ i 1)) 'tmp)))))
(vau se (& bs) (eval (macro_helper bs 0) se)))
foldl (let (helper (rec-lambda recurse (f z vs i) (if (= i (len (idx vs 0))) z
(recurse f (lapply f (cons z (map (lambda (x) (idx x i)) vs))) vs (+ i 1)))))
(lambda (f z & vs) (helper f z vs 0)))
foldr (let (helper (rec-lambda recurse (f z vs i) (if (= i (len (idx vs 0))) z
(lapply f (cons (recurse f z vs (+ i 1)) (map (lambda (x) (idx x i)) vs))))))
(lambda (f z & vs) (helper f z vs 0)))
reverse (lambda (x) (foldl (lambda (acc i) (cons i acc)) (array) x))
zip (lambda (& xs) (lapply foldr (concat (array (lambda (a & ys) (cons ys a)) (array)) xs)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Begin kludges to align with Scheme kludges
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
dlet (vau se (inners body) (vapply let (array (lapply concat inners) body) se))
cond (vau se (& inners) (vapply cond (lapply concat inners) se))
print log
println log
dlambda lambda
mif (vau de (c & bs) (vapply if (cons (array let (array 'tmp c) (array and (array != 'tmp (array quote (array))) 'tmp)) bs) de))
;mif (vau de (c & bs) (eval (concat (array if (array let (array 'tmp c) (array and (array != 'tmp) 'tmp))) bs) de))
)
(dlet (
(empty_dict-list (array))
(put-list (lambda (m k v) (cons (array k v) m)))
(get-list (lambda (d k) ((rec-lambda recurse (k d len_d i) (cond ((= len_d i) false)
((= k (idx (idx d i) 0)) (idx d i))
(true (recurse k d len_d (+ 1 i)))))
k d (len d) 0)))
;(combine_hash (lambda (a b) (+ (* 37 a) b)))
(combine_hash (lambda (a b) (band #xFFFFFFFFFFFFFF (+ (* 37 a) b))))
(hash_bool (lambda (b) (if b 2 3)))
(hash_num (lambda (n) (combine_hash 5 n)))
;(hash_string (lambda (s) (foldl combine_hash 7 (map char->integer (string->list s)))))
(hash_string (lambda (s) (foldl combine_hash 7 s)))
;(hash_string (lambda (s) (foldl combine_hash 102233 (map char->integer (string->list s)))))
(empty_dict-tree nil)
(trans-key (lambda (k) (cond ((string? k) (hash_string k))
((symbol? k) (hash_string (get-text k)))
(true k))))
(put-helper (rec-lambda put-helper (m hk k v) (cond ((nil? m) (array hk k v nil nil))
((and (= hk (idx m 0))
(= k (idx m 1))) (array hk k v (idx m 3) (idx m 4)))
((< hk (idx m 0)) (array (idx m 0) (idx m 1) (idx m 2) (put-helper (idx m 3) hk k v) (idx m 4)))
(true (array (idx m 0) (idx m 1) (idx m 2) (idx m 3) (put-helper (idx m 4) hk k v))))))
(put-tree (lambda (m k v) (put-helper m (trans-key k) k v)))
(get-helper (rec-lambda get-helper (m hk k) (cond ((nil? m) false)
((and (= hk (idx m 0))
(= k (idx m 1))) (array k (idx m 2)))
((< hk (idx m 0)) (get-helper (idx m 3) hk k))
(true (get-helper (idx m 4) hk k)))))
(get-tree (lambda (m k) (get-helper m (trans-key k) k)))
;(empty_dict empty_dict-list)
;(put put-list)
;(get get-list)
(empty_dict empty_dict-tree)
(put put-tree)
(get get-tree)
(get-value (lambda (d k) (dlet ((result (get d k)))
(if (array? result) (idx result 1)
(error (str "could not find " k " in " d))))))
(get-value-or-false (lambda (d k) (dlet ((result (get d k)))
(if (array? result) (idx result 1)
false))))
(in_array (dlet ((helper (rec-lambda recurse (x a len_a i) (cond ((= i len_a) false)
((= x (idx a i)) true)
(true (recurse x a len_a (+ i 1)))))))
(lambda (x a) (helper x a (len a) 0))))
(array_item_union (lambda (a bi) (if (in_array bi a) a (cons bi a))))
(array_union (lambda (a b) (foldl array_item_union a b)))
(array_union_without (lambda (wo a b)
(foldl (lambda (o xi) (if (or (= wo xi) (in_array xi o)) o (cons xi o)))
(array) (concat a b))))
; just for now, should just add all normal linked list primitives
; as they should be
(car (lambda (x) (idx x 0)))
(cdr (lambda (x) (slice x 1 -1)))
(intset_word_size 64)
(in_intset (rec-lambda in_intset (x a) (cond ((nil? a) false)
((>= x intset_word_size) (in_intset (- x intset_word_size) (cdr a)))
(true (!= (band (>> (car a) x) 1) 0)))))
(intset_item_union (rec-lambda intset_item_union (a bi) (cond ((nil? a) (intset_item_union (array 0) bi))
((>= bi intset_word_size) (cons (car a) (intset_item_union (cdr a) (- bi intset_word_size))))
(true (cons (bor (car a) (<< 1 bi)) (cdr a))))))
(intset_item_remove (rec-lambda intset_item_remove (a bi) (cond ((nil? a) nil)
((>= bi intset_word_size) (dlet ((new_tail (intset_item_remove (cdr a) (- bi intset_word_size))))
(if (and (nil? new_tail) (= 0 (car a))) nil
(cons (car a) new_tail))))
(true (dlet ((new_int (band (car a) (bnot (<< 1 bi)))))
(if (and (nil? (cdr a)) (= 0 new_int)) nil
(cons new_int (cdr a))))))))
(intset_union (rec-lambda intset_union (a b) (cond ((and (nil? a) (nil? b)) nil)
((nil? a) b)
((nil? b) a)
(true (cons (bor (car a) (car b)) (intset_union (cdr a) (cdr b)))))))
(intset_intersection_nonempty (rec-lambda intset_intersection_nonempty (a b) (cond ((nil? a) false)
((nil? b) false)
(true (or (!= 0 (band (car a) (car b))) (intset_intersection_nonempty (cdr a) (cdr b)))))))
(intset_union_without (lambda (wo a b) (intset_item_remove (intset_union a b) wo)))
(val? (lambda (x) (= 'val (idx x 0))))
(marked_array? (lambda (x) (= 'marked_array (idx x 0))))
(marked_symbol? (lambda (x) (= 'marked_symbol (idx x 0))))
(comb? (lambda (x) (= 'comb (idx x 0))))
(prim_comb? (lambda (x) (= 'prim_comb (idx x 0))))
(marked_env? (lambda (x) (= 'env (idx x 0))))
(.hash (lambda (x) (idx x 1)))
(.val (lambda (x) (idx x 2)))
(.marked_array_is_val (lambda (x) (idx x 2)))
(.marked_array_is_attempted (lambda (x) (idx x 3)))
(.marked_array_needed_for_progress (lambda (x) (idx x 4)))
(.marked_array_values (lambda (x) (idx x 5)))
(.marked_symbol_needed_for_progress (lambda (x) (idx x 2)))
(.marked_symbol_is_val (lambda (x) (= nil (.marked_symbol_needed_for_progress x))))
(.marked_symbol_value (lambda (x) (idx x 3)))
(.comb (lambda (x) (slice x 2 -1)))
(.comb_id (lambda (x) (idx x 3)))
(.comb_des (lambda (x) (idx x 4)))
(.comb_env (lambda (x) (idx x 5)))
(.comb_body (lambda (x) (idx x 8)))
(.comb_wrap_level (lambda (x) (idx x 2)))
(.prim_comb_sym (lambda (x) (idx x 3)))
(.prim_comb_handler (lambda (x) (idx x 2)))
(.prim_comb_wrap_level (lambda (x) (idx x 4)))
(.prim_comb_val_head_ok (lambda (x) (idx x 5)))
(.prim_comb (lambda (x) (slice x 2 -1)))
(.marked_env (lambda (x) (slice x 2 -1)))
(.marked_env_has_vals (lambda (x) (idx x 2)))
(.marked_env_needed_for_progress (lambda (x) (idx x 3)))
(.marked_env_idx (lambda (x) (idx x 4)))
(.marked_env_upper (lambda (x) (idx (idx x 5) -1)))
(.env_marked (lambda (x) (idx x 5)))
(marked_env_real? (lambda (x) (= nil (idx (.marked_env_needed_for_progress x) 0))))
(.any_comb_wrap_level (lambda (x) (cond ((prim_comb? x) (.prim_comb_wrap_level x))
((comb? x) (.comb_wrap_level x))
(true (error "bad .any_comb_level")))))
; The actual needed_for_progress values are either
; #t - any eval will do something
; nil - is a value, no eval will do anything
; (3 4 1...) - list of env ids that would allow forward progress
; But these are paired with another list of hashes that if you're not inside
; of an evaluation of, then it could progress futher. These are all caused by
; the infinite recursion stopper.
(needed_for_progress (rec-lambda needed_for_progress (x) (cond ((marked_array? x) (.marked_array_needed_for_progress x))
((marked_symbol? x) (array (.marked_symbol_needed_for_progress x) nil nil))
((marked_env? x) (.marked_env_needed_for_progress x))
((comb? x) (dlet ((id (.comb_id x))
((body_needed _hashes extra1) (needed_for_progress (.comb_body x)))
((se_needed _hashes extra2) (needed_for_progress (.comb_env x))))
(if (or (= true body_needed) (= true se_needed)) (array true nil nil)
(array (array_union_without id body_needed se_needed)
nil (array_union_without id extra1 extra2))
)))
((prim_comb? x) (array nil nil nil))
((val? x) (array nil nil nil))
(true (error (str "what is this? in need for progress" x))))))
(needed_for_progress_slim (lambda (x) (idx (needed_for_progress x) 0)))
(hash_symbol (lambda (progress_idxs s) (combine_hash (if (= true progress_idxs) 11 (foldl combine_hash 13 (map (lambda (x) (if (= true x) 13 (+ 1 x))) progress_idxs))) (hash_string (get-text s)))))
(hash_array (lambda (is_val attempted a) (foldl combine_hash (if is_val 17 (cond ((int? attempted) (combine_hash attempted 19))
(attempted 61)
(true 107))) (map .hash a))))
(hash_env (lambda (has_vals progress_idxs dbi arrs) (combine_hash (if has_vals 107 109)
(combine_hash (mif dbi (hash_num dbi) 59) (dlet (
;(_ (begin (true_print "pre slice " (slice arrs 0 -2)) 0))
;(_ (begin (true_print "about to do a fold " progress_idxs " and " (slice arrs 0 -2)) 0))
(inner_hash (foldl (dlambda (c (s v)) (combine_hash c (combine_hash (hash_symbol true s) (.hash v))))
(cond ((= nil progress_idxs) 23)
((= true progress_idxs) 29)
(true (foldl combine_hash 31 progress_idxs)))
(slice arrs 0 -2)))
(end (idx arrs -1))
(end_hash (mif end (.hash end) 41))
) (combine_hash inner_hash end_hash))))))
(hash_comb (lambda (wrap_level env_id de? se variadic params body)
(combine_hash 43
(combine_hash wrap_level
(combine_hash env_id
(combine_hash (mif de? (hash_symbol true de?) 47)
(combine_hash (.hash se)
(combine_hash (hash_bool variadic)
(combine_hash (foldl (lambda (c x) (combine_hash c (hash_symbol true x))) 53 params)
(.hash body))))))))))
(hash_prim_comb (lambda (handler_fun real_or_name wrap_level val_head_ok) (combine_hash (combine_hash 59 (hash_symbol true real_or_name))
(combine_hash (if val_head_ok 89 97) wrap_level))))
(hash_val (lambda (x) (cond ((bool? x) (hash_bool x))
((string? x) (hash_string x))
((int? x) (hash_num x))
(true (error (str "bad thing to hash_val " x))))))
; 113 127 131 137 139 149 151 157 163 167 173
(marked_symbol (lambda (progress_idxs x) (array 'marked_symbol (hash_symbol progress_idxs x) progress_idxs x)))
(marked_array (lambda (is_val attempted resume_hashes x) (dlet (
((sub_progress_idxs hashes extra) (foldl (dlambda ((a ahs aeei) (x xhs x_extra_env_ids))
(array (cond ((or (= true a) (= true x)) true)
(true (array_union a x)))
(array_union ahs xhs)
(array_union aeei x_extra_env_ids))
) (array (array) resume_hashes (array)) (map needed_for_progress x)))
(progress_idxs (cond ((and (= nil sub_progress_idxs) (not is_val) (= true attempted)) nil)
((and (= nil sub_progress_idxs) (not is_val) (= false attempted)) true)
((and (= nil sub_progress_idxs) (not is_val) (int? attempted)) (array attempted))
(true (if (int? attempted)
(array_item_union sub_progress_idxs attempted)
sub_progress_idxs))))
) (array 'marked_array (hash_array is_val attempted x) is_val attempted (array progress_idxs hashes extra) x))))
(marked_env (lambda (has_vals de? de ue dbi arrs) (dlet (
(de_entry (mif de? (array (array de? de)) (array)))
(full_arrs (concat arrs de_entry (array ue)))
((progress_idxs1 _hashes extra1) (mif ue (needed_for_progress ue) (array nil nil nil)))
((progress_idxs2 _hashes extra2) (mif de? (needed_for_progress de) (array nil nil nil)))
(progress_idxs (array_union progress_idxs1 progress_idxs2))
(extra (array_union extra1 extra2))
(progress_idxs (if (not has_vals) (cons dbi progress_idxs) progress_idxs))
(extra (if (!= nil progress_idxs) (cons dbi extra) extra))
) (array 'env (hash_env has_vals progress_idxs dbi full_arrs) has_vals (array progress_idxs nil extra) dbi full_arrs))))
(marked_val (lambda (x) (array 'val (hash_val x) x)))
(marked_comb (lambda (wrap_level env_id de? se variadic params body) (array 'comb (hash_comb wrap_level env_id de? se variadic params body) wrap_level env_id de? se variadic params body)))
(marked_prim_comb (lambda (handler_fun real_or_name wrap_level val_head_ok) (array 'prim_comb (hash_prim_comb handler_fun real_or_name wrap_level val_head_ok) handler_fun real_or_name wrap_level val_head_ok)))
(with_wrap_level (lambda (x new_wrap) (cond ((prim_comb? x) (dlet (((handler_fun real_or_name wrap_level val_head_ok) (.prim_comb x)))
(marked_prim_comb handler_fun real_or_name new_wrap val_head_ok)))
((comb? x) (dlet (((wrap_level env_id de? se variadic params body) (.comb x)))
(marked_comb new_wrap env_id de? se variadic params body)))
(true (error "bad with_wrap_level")))))
(later_head? (rec-lambda recurse (x) (or (and (marked_array? x) (or (= false (.marked_array_is_val x)) (foldl (lambda (a x) (or a (recurse x))) false (.marked_array_values x))))
(and (marked_symbol? x) (= false (.marked_symbol_is_val x)))
)))
; array and comb are the ones wherewhere (= nil (needed_for_progress_slim x)) == total_value? isn't true.
; Right now we only call functions when all parameters are values, which means you can't
; create a true_value array with non-value memebers (*right now* anyway), but it does mean that
; you can create a nil needed for progress array that isn't a value, namely for the give_up_*
; primitive functions (extra namely, log and error, which are our two main sources of non-purity besides implicit runtime errors).
; OR, currently, having your code stopped because of infinite recursion checker. This comes up with the Y combiner
; For combs, being a value is having your env-chain be real?
(total_value? (lambda (x) (if (marked_array? x) (.marked_array_is_val x)
(= nil (needed_for_progress_slim x)))))
(is_all_values (lambda (evaled_params) (foldl (lambda (a x) (and a (total_value? x))) true evaled_params)))
(is_all_head_values (lambda (evaled_params) (foldl (lambda (a x) (and a (not (later_head? x)))) true evaled_params)))
(false? (lambda (x) (cond ((and (marked_array? x) (= false (.marked_array_is_val x))) (error "got a later marked_array passed to false? " x))
((and (marked_symbol? x) (= false (.marked_symbol_is_val x))) (error "got a later marked_symbol passed to false? " x))
((val? x) (not (.val x)))
(true false))))
(mark (rec-lambda recurse (eval_pos x) (cond ((env? x) (error "called mark with an env " x))
((combiner? x) (error "called mark with a combiner " x))
((symbol? x) (cond ((= 'true x) (marked_val #t))
((= 'false x) (marked_val #f))
(#t (marked_symbol (if eval_pos true nil) x))))
((array? x) (marked_array (not eval_pos) false nil
(idx (foldl (dlambda ((ep a) x) (array false (concat a (array (recurse ep x)))))
(array eval_pos (array))
x)
1)
))
(true (marked_val x)))))
(indent_str (rec-lambda recurse (i) (mif (= i 0) ""
(str " " (recurse (- i 1))))))
(speed_hack true)
(true_str str)
(indent_str (if speed_hack (lambda (i) "") indent_str))
(str_strip (lambda (& args) (lapply true_str (concat (slice args 0 -2) (array (idx ((rec-lambda recurse (x done_envs)
(cond ((= nil x) (array "<nil>" done_envs))
((string? x) (array (true_str "<raw string " x ">") done_envs))
((val? x) (array (true_str (.val x)) done_envs))
((marked_array? x) (dlet (((stripped_values done_envs) (foldl (dlambda ((vs de) x) (dlet (((v de) (recurse x de))) (array (concat vs (array v)) de)))
(array (array) done_envs) (.marked_array_values x))))
(mif (.marked_array_is_val x) (array (true_str "[" stripped_values "]") done_envs)
(array (true_str stripped_values) done_envs))))
;(array (true_str "<a" (.marked_array_is_attempted x) ",r" (needed_for_progress x) ">" stripped_values) done_envs))))
((marked_symbol? x) (mif (.marked_symbol_is_val x) (array (true_str "'" (.marked_symbol_value x)) done_envs)
(array (true_str (.marked_symbol_needed_for_progress x) "#" (.marked_symbol_value x)) done_envs)))
((comb? x) (dlet (((wrap_level env_id de? se variadic params body) (.comb x))
((se_s done_envs) (recurse se done_envs))
((body_s done_envs) (recurse body done_envs)))
(array (true_str "<n (comb " wrap_level " " env_id " " de? " " se_s " " params " " body_s ")>") done_envs)))
((prim_comb? x) (array (true_str "<wl=" (.prim_comb_wrap_level x) " " (.prim_comb_sym x) ">") done_envs))
((marked_env? x) (dlet ((e (.env_marked x))
(index (.marked_env_idx x))
(u (idx e -1))
(already (in_array index done_envs))
(opening (true_str "{" (mif (marked_env_real? x) "real" "fake") (mif (.marked_env_has_vals x) " real vals" " fake vals") " ENV idx: " (true_str index) ", "))
((middle done_envs) (if already (array "" done_envs) (foldl (dlambda ((vs de) (k v)) (dlet (((x de) (recurse v de))) (array (concat vs (array (array k x))) de)))
(array (array) done_envs)
(slice e 0 -2))))
((upper done_envs) (if already (array "" done_envs) (mif u (recurse u done_envs) (array "no_upper_likely_root_env" done_envs))))
(done_envs (if already done_envs (cons index done_envs)))
) (array (if already (true_str opening "omitted}")
(if (> (len e) 30) (true_str "{" (len e) "env}")
(true_str opening middle " upper: " upper "}"))) done_envs)
))
(true (error (true_str "some other str_strip? |" x "|")))
)
) (idx args -1) (array)) 0))))))
(true_str_strip str_strip)
(str_strip (if speed_hack (lambda (& args) 0) str_strip))
;(true_str_strip str_strip)
(print_strip (lambda (& args) (println (lapply str_strip args))))
(env-lookup-helper (rec-lambda recurse (dict key i fail success) (cond ((and (= i (- (len dict) 1)) (= nil (idx dict i))) (fail))
((= i (- (len dict) 1)) (recurse (.env_marked (idx dict i)) key 0 fail success))
((= key (idx (idx dict i) 0)) (success (idx (idx dict i) 1)))
(true (recurse dict key (+ i 1) fail success)))))
(env-lookup (lambda (env key) (env-lookup-helper (.env_marked env) key 0 (lambda () (error (str key " not found in env " (str_strip env)))) (lambda (x) x))))
(strip (dlet ((helper (rec-lambda recurse (x need_value)
(cond ((val? x) (.val x))
((marked_array? x) (dlet ((stripped_values (map (lambda (x) (recurse x need_value)) (.marked_array_values x))))
(mif (.marked_array_is_val x) stripped_values
(error (str "needed value for this strip but got" x)))))
((marked_symbol? x) (mif (.marked_symbol_is_val x) (.marked_symbol_value x)
(error (str "needed value for this strip but got" x))))
((comb? x) (error "got comb for strip, won't work"))
((prim_comb? x) (idx x 2))
; env emitting doesn't pay attention to real value right now, not sure mif that makes sense
; TODO: properly handle de Bruijn indexed envs
((marked_env? x) (error "got env for strip, won't work"))
(true (error (str "some other strip? " x)))
)
))) (lambda (x) (dlet (
;(_ (print_strip "stripping: " x))
(r (helper x true))
;(_ (println "result of strip " r))
) r))))
(try_unval (rec-lambda recurse (x fail_f)
(cond ((marked_array? x) (mif (not (.marked_array_is_val x)) (array false (fail_f x))
(if (!= 0 (len (.marked_array_values x)))
(dlet ((values (.marked_array_values x))
((ok f) (recurse (idx values 0) fail_f))
) (array ok (marked_array false false nil (cons f (slice values 1 -1)))))
(array true (marked_array false false nil (array))))))
((marked_symbol? x) (mif (.marked_symbol_is_val x) (array true (marked_symbol true (.marked_symbol_value x)))
(array false (fail_f x))))
(true (array true x))
)
))
(try_unval_array (lambda (x) (foldl (dlambda ((ok a) x) (dlet (((nok p) (try_unval x (lambda (_) nil))))
(array (and ok nok) (concat a (array p)))))
(array true (array))
x)))
(check_for_env_id_in_result (lambda (s_env_id x) (idx ((rec-lambda check_for_env_id_in_result (memo s_env_id x)
(dlet (
((need _hashes extra) (needed_for_progress x))
(in_need (if (!= true need) (in_intset s_env_id need) false))
(in_extra (in_intset s_env_id extra))
) (cond ((or in_need in_extra) (array memo true))
((!= true need) (array memo false))
(true (dlet (
(old_way (dlet (
(hash (.hash x))
(result (if (marked_env? x) (get memo hash) false))
) (if (array? result) (array memo (idx result 1)) (cond
((marked_symbol? x) (array memo false))
((marked_array? x) (dlet (
(values (.marked_array_values x))
((memo result) ((rec-lambda recurse (memo i) (if (= (len values) i) (array memo false)
(dlet (((memo r) (check_for_env_id_in_result memo s_env_id (idx values i))))
(if r (array memo true)
(recurse memo (+ i 1))))))
memo 0))
) (array memo result)))
((prim_comb? x) (array memo false))
((val? x) (array memo false))
((comb? x) (dlet (
((wrap_level i_env_id de? se variadic params body) (.comb x))
((memo in_se) (check_for_env_id_in_result memo s_env_id se))
((memo total) (if (and (not in_se) (!= s_env_id i_env_id)) (check_for_env_id_in_result memo s_env_id body)
(array memo in_se)))
) (array memo total)))
((marked_env? x) (if (and (not (marked_env_real? x)) (= s_env_id (.marked_env_idx x))) (array memo true)
(dlet (
(values (slice (.env_marked x) 0 -2))
(upper (idx (.env_marked x) -1))
((memo result) ((rec-lambda recurse (memo i) (if (= (len values) i) (array memo false)
(dlet (((memo r) (check_for_env_id_in_result memo s_env_id (idx (idx values i) 1))))
(if r (array memo true)
(recurse memo (+ i 1))))))
memo 0))
((memo result) (if (or result (= nil upper)) (array memo result)
(check_for_env_id_in_result memo s_env_id upper)))
(memo (put memo hash result))
) (array memo result))))
(true (error (str "Something odd passed to check_for_env_id_in_result " x)))
))))
;(new_if_working (or in_need in_extra))
;(_ (if (and (!= true need) (!= new_if_working (idx old_way 1))) (error "GAH looking for " s_env_id " - " need " - " extra " - " new_if_working " " (idx old_way 1))))
) old_way))))) (array) s_env_id x) 1)))
(comb_takes_de? (lambda (x l) (cond
((comb? x) (!= nil (.comb_des x)))
((prim_comb? x) (cond ( (= (.prim_comb_sym x) 'vau) true)
((and (= (.prim_comb_sym x) 'eval) (= 1 l)) true)
((and (= (.prim_comb_sym x) 'veval) (= 1 l)) true)
( (= (.prim_comb_sym x) 'lapply) true)
( (= (.prim_comb_sym x) 'vapply) true)
( (= (.prim_comb_sym x) 'cond) true) ; but not vcond
(true false)))
((and (marked_array? x) (not (.marked_array_is_val x))) true)
((and (marked_symbol? x) (not (.marked_symbol_is_val x))) true)
(true (error (str "illegal comb_takes_de? param " x)))
)))
; Handles let 4.3 through macro level leaving it as (<comb wraplevel=1 (y) (+ y x 12)> 13)
; need handling of symbols (which is illegal for eval but ok for calls) to push it farther
(combiner_return_ok (rec-lambda combiner_return_ok (func_result env_id)
(cond ((not (later_head? func_result)) (not (check_for_env_id_in_result env_id func_result)))
; special cases now
; *(veval body {env}) => (combiner_return_ok {env})
; The reason we don't have to check body is that this form is only creatable in ways that body was origionally a value and only need {env}
; Either it's created by eval, in which case it's fine, or it's created by something like (eval (array veval x de) de2) and the array has checked it,
; or it's created via literal vau invocation, in which case the body is a value.
((and (marked_array? func_result)
(prim_comb? (idx (.marked_array_values func_result) 0))
(= 'veval (.prim_comb_sym (idx (.marked_array_values func_result) 0)))
(= 3 (len (.marked_array_values func_result)))
(combiner_return_ok (idx (.marked_array_values func_result) 2) env_id)) true)
; (func ...params) => (and (doesn't take de func) (foldl combiner_return_ok (cons func params)))
;
((and (marked_array? func_result)
(not (comb_takes_de? (idx (.marked_array_values func_result) 0) (len (.marked_array_values func_result))))
(foldl (lambda (a x) (and a (combiner_return_ok x env_id))) true (.marked_array_values func_result))) true)
; So that's enough for macro like, but we would like to take it farther
; For like (let1 a 12 (wrap (vau (x) (let1 y (+ a 1) (+ y x a)))))
; we get to (+ 13 x 12) not being a value, and it reconstructs
; (<comb wraplevel=1 (y) (+ y x 12)> 13)
; and that's what eval gets, and eval then gives up as well.
; That will get caught by the above cases to remain the expansion (<comb wraplevel=1 (y) (+ y x 12)> 13),
; but ideally we really want another case to allow (+ 13 x 12) to bubble up
; I think it would be covered by the (func ...params) case if a case is added to allow symbols to be bubbled up if their
; needed for progress wasn't true or the current environment, BUT this doesn't work for eval, just for functions,
; since eval changes the entire env chain (but that goes back to case 1, and might be eliminated at compile if it's an env reachable from the func).
;
;
; Do note a key thing to be avoided is allowing any non-val inside a comb, since that can cause a fake env's ID to
; reference the wrong env/comb in the chain.
; We do allow calling eval with a fake env, but since it's only callable withbody value and is strict (by calling this)
; about it's return conditions, and the env it's called with must be ok in the chain, and eval doesn't introduce a new scope, it works ok.
; We do have to be careful about allowing returned later symbols from it though, since it could be an entirely different env chain.
(true false)
)
))
(drop_redundent_veval (rec-lambda drop_redundent_veval (partial_eval_helper x de env_stack pectx indent) (dlet (
(env_id (.marked_env_idx de))
(r (if
(and (marked_array? x)
(not (.marked_array_is_val x)))
(if (and (prim_comb? (idx (.marked_array_values x) 0))
(= 'veval (.prim_comb_sym (idx (.marked_array_values x) 0)))
(= 3 (len (.marked_array_values x)))
(not (marked_env_real? (idx (.marked_array_values x) 2)))
(= env_id (.marked_env_idx (idx (.marked_array_values x) 2)))) (drop_redundent_veval partial_eval_helper (idx (.marked_array_values x) 1) de env_stack pectx (+ 1 indent))
; wait, can it do this? will this mess with eval?
; basically making sure that this comb's params are still good to eval
(if (and (or (prim_comb? (idx (.marked_array_values x) 0)) (comb? (idx (.marked_array_values x) 0)))
(!= -1 (.any_comb_wrap_level (idx (.marked_array_values x) 0))))
(dlet (((pectx err ress changed) (foldl (dlambda ((c er ds changed) p) (dlet (
(pre_hash (.hash p))
((c e d) (drop_redundent_veval partial_eval_helper p de env_stack c (+ 1 indent)))
(err (mif er er e))
(changed (mif err false (or (!= pre_hash (.hash d)) changed)))
) (array c err (concat ds (array d)) changed)))
(array pectx nil (array) false)
(.marked_array_values x)))
((pectx err new_array) (if (or (!= nil err) (not changed))
(array pectx err x)
(partial_eval_helper (marked_array false (.marked_array_is_attempted x) nil ress)
false de env_stack pectx (+ indent 1) true)))
) (array pectx err new_array))
(array pectx nil x))
) (array pectx nil x))))
r)))
(make_tmp_inner_env (lambda (params de? ue env_id)
(dlet ((param_entries (map (lambda (p) (array p (marked_symbol env_id p))) params))
(possible_de (mif (= nil de?) (array) (marked_symbol env_id de?)))
) (marked_env false de? possible_de ue env_id param_entries))))
(partial_eval_helper (rec-lambda partial_eval_helper (x only_head env env_stack pectx indent force)
(dlet (((for_progress for_progress_hashes extra_env_ids) (needed_for_progress x))
(_ (print_strip (indent_str indent) "for_progress " for_progress ", for_progress_hashes " for_progress_hashes " for " x))
((env_counter memo) pectx)
(hashes_now (foldl (lambda (a hash) (or a (= false (get-value-or-false memo hash)))) false for_progress_hashes))
)
(if (or force hashes_now (= for_progress true) (intset_intersection_nonempty for_progress (idx env_stack 0)))
(cond ((val? x) (array pectx nil x))
((marked_env? x) (dlet ((dbi (.marked_env_idx x)))
; compiler calls with empty env stack
(mif dbi (dlet ( (new_env ((rec-lambda rec (i len_env_stack) (cond ((= i len_env_stack) nil)
((= dbi (.marked_env_idx (idx (idx env_stack 1) i))) (idx (idx env_stack 1) i))
(true (rec (+ i 1) len_env_stack))))
0 (len (idx env_stack 1))))
(_ (println (str_strip "replacing " x) (str_strip " with (if nonnil) " new_env)))
)
(array pectx nil (if (!= nil new_env) new_env x)))
(array pectx nil x))))
((comb? x) (dlet (((wrap_level env_id de? se variadic params body) (.comb x)))
(mif (or (and (not (marked_env_real? env)) (not (marked_env_real? se))) ; both aren't real, re-evaluation of creation site
(and (marked_env_real? env) (not (marked_env_real? se)))) ; new env real, but se isn't - creation!
(dlet ((inner_env (make_tmp_inner_env params de? env env_id))
((pectx err evaled_body) (partial_eval_helper body false inner_env (array (idx env_stack 0) (cons inner_env (idx env_stack 1))) pectx (+ indent 1) false)))
(array pectx err (mif err nil (marked_comb wrap_level env_id de? env variadic params evaled_body))))
(array pectx nil x))))
((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 (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)))))
(array pectx nil (array))
(.marked_array_values x)))
) (array pectx err (mif err nil (marked_array true false nil inner_arr)))))
((= 0 (len (.marked_array_values x))) (array pectx "Partial eval on empty array" nil))
(true (dlet ((values (.marked_array_values x))
(_ (print_strip (indent_str indent) "partial_evaling comb " (idx values 0)))
(literal_params (slice values 1 -1))
((pectx err comb) (partial_eval_helper (idx values 0) true env env_stack pectx (+ 1 indent) false))
) (cond ((!= nil err) (array pectx err nil))
((later_head? comb) (array pectx nil (marked_array false true nil (cons comb literal_params))))
((not (or (comb? comb) (prim_comb? comb))) (array pectx (str "impossible comb value " x) nil))
(true (dlet (
; If we haven't evaluated the function before at all, we would like to partially evaluate it so we know
; what it needs. We'll see if this re-introduces exponentail (I think this should limit it to twice?)
((pectx comb_err comb) (if (and (= nil err) (= true (needed_for_progress_slim comb)))
(partial_eval_helper comb false env env_stack pectx (+ 1 indent) false)
(array pectx err comb)))
(_ (println (indent_str indent) "Going to do an array call!"))
(indent (+ 1 indent))
(_ (print_strip (indent_str indent) "total (in env " (.marked_env_idx env) ") is (proceeding err " err ") " x))
(map_rp_eval (lambda (pectx ps) (foldl (dlambda ((c er ds) p) (dlet ((_ (print_strip (indent_str indent) "rp_evaling " p)) ((c e d) (partial_eval_helper p false env env_stack c (+ 1 indent) false)) (_ (print_strip (indent_str indent) "result of rp_eval was err " e " and value " d))) (array c (mif er er e) (concat ds (array d)))))
(array pectx nil (array))
ps)))
(wrap_level (.any_comb_wrap_level comb))
; -1 is a minor hack for veval to prevent re-eval
; in the wrong env and vcond to prevent guarded
; infinate recursion
((remaining_wrap param_err evaled_params pectx) (if (= -1 wrap_level)
(array -1 nil literal_params pectx)
((rec-lambda param-recurse (wrap cparams pectx)
(dlet (
(_ (print (indent_str indent) "For initial rp_eval:"))
(_ (map (lambda (x) (print_strip (indent_str indent) "item " x)) cparams))
((pectx er pre_evaled) (map_rp_eval pectx cparams))
(_ (print (indent_str indent) "er for intial rp_eval: " er))
)
(mif er (array wrap er nil pectx)
(mif (!= 0 wrap)
(dlet (((ok unval_params) (try_unval_array pre_evaled)))
(mif (not ok) (array wrap nil pre_evaled pectx)
(param-recurse (- wrap 1) unval_params pectx)))
(array wrap nil pre_evaled pectx)))))
wrap_level literal_params pectx)))
(_ (println (indent_str indent) "Done evaluating parameters"))
(l_later_call_array (lambda () (marked_array false true nil (cons (with_wrap_level comb remaining_wrap) evaled_params))))
(ok_and_non_later (or (= -1 remaining_wrap)
(and (= 0 remaining_wrap) (if (and (prim_comb? comb) (.prim_comb_val_head_ok comb))
(is_all_head_values evaled_params)
(is_all_values evaled_params)))))
(_ (println (indent_str indent) "ok_and_non_later " ok_and_non_later))
) (cond ((!= nil comb_err) (array pectx comb_err nil))
((!= nil param_err) (array pectx param_err nil))
((not ok_and_non_later) (array pectx nil (l_later_call_array)))
((prim_comb? comb) (dlet (
(_ (println (indent_str indent) "Calling prim comb " (.prim_comb_sym comb)))
((pectx err result) ((.prim_comb_handler comb) only_head env env_stack pectx evaled_params (+ 1 indent)))
) (if (= 'LATER err) (array pectx nil (l_later_call_array))
(array pectx err result))))
((comb? comb) (dlet (
((wrap_level env_id de? se variadic params body) (.comb comb))
(final_params (mif variadic (concat (slice evaled_params 0 (- (len params) 1))
(array (marked_array true false nil (slice evaled_params (- (len params) 1) -1))))
evaled_params))
(de_env (mif (!= nil de?) env nil))
(inner_env (marked_env true de? de_env se env_id (zip params final_params)))
(_ (print_strip (indent_str indent) " with inner_env is " inner_env))
(_ (print_strip (indent_str indent) "going to eval " body))
; prevent infinite recursion
(hash (combine_hash (.hash body) (.hash inner_env)))
((env_counter memo) pectx)
((pectx func_err func_result rec_stop) (if (!= false (get-value-or-false memo hash))
(array pectx nil "stopping for infinite recursion" true)
(dlet (
(new_memo (put memo hash nil))
(pectx (array env_counter new_memo))
((pectx func_err func_result) (partial_eval_helper body only_head inner_env
(array (intset_item_union (idx env_stack 0) env_id)
(cons inner_env (idx env_stack 1)))
pectx (+ 1 indent) false))
((env_counter new_memo) pectx)
(pectx (array env_counter memo))
) (array pectx func_err func_result false))))
(_ (print_strip (indent_str indent) "evaled result of function call (in env " (.marked_env_idx env) ", with inner " env_id ") and err " func_err " is " func_result))
(must_stop_maybe_id (and (= nil func_err)
(or rec_stop (if (not (combiner_return_ok func_result env_id))
(if (!= nil de?) (.marked_env_idx env) true)
false))))
) (if (!= nil func_err) (array pectx func_err nil)
(if must_stop_maybe_id
(array pectx nil (marked_array false must_stop_maybe_id (if rec_stop (array hash) nil) (cons (with_wrap_level comb remaining_wrap) evaled_params)))
(drop_redundent_veval partial_eval_helper func_result env env_stack pectx indent)))))
)))
)))))
(true (array pectx (str "impossible partial_eval value " x) nil))
)
; otherwise, we can't make progress yet
(drop_redundent_veval partial_eval_helper x env env_stack pectx indent)))
))
(needs_params_val_lambda (lambda (f_sym actual_function) (dlet (
(handler (rec-lambda recurse (only_head de env_stack pectx params indent)
(array pectx nil (mark false (lapply actual_function (map strip params))))))
) (array f_sym (marked_prim_comb handler f_sym 1 false)))))
(give_up_eval_params (lambda (f_sym actual_function) (dlet (
(handler (lambda (only_head de env_stack pectx params indent) (array pectx 'LATER nil)))
) (array f_sym (marked_prim_comb handler f_sym 1 false)))))
(veval_inner (rec-lambda recurse (only_head de env_stack pectx params indent) (dlet (
(body (idx params 0))
(implicit_env (!= 2 (len params)))
(eval_env (if implicit_env de (idx params 1)))
((pectx err eval_env) (if implicit_env (array pectx nil de)
(partial_eval_helper (idx params 1) only_head de env_stack pectx (+ 1 indent) false)))
((pectx err ebody) (if (or (!= nil err) (not (marked_env? eval_env)))
(array pectx err body)
(partial_eval_helper body only_head eval_env env_stack pectx (+ 1 indent) false)))
) (cond
((!= nil err) (array pectx err nil))
; If our env was implicit, then our unval'd code can be inlined directly in our caller
(implicit_env (drop_redundent_veval partial_eval_helper ebody de env_stack pectx indent))
((combiner_return_ok ebody (.marked_env_idx eval_env)) (drop_redundent_veval partial_eval_helper ebody de env_stack pectx indent))
(true (drop_redundent_veval partial_eval_helper (marked_array false true nil (array
(marked_prim_comb recurse 'veval -1 true)
ebody
eval_env
))
de env_stack pectx indent))
))))
(root_marked_env (marked_env true nil nil nil nil (array
(array 'eval (marked_prim_comb (rec-lambda recurse (only_head de env_stack pectx evaled_params indent)
(if (not (total_value? (idx evaled_params 0))) (array pectx nil (marked_array false true nil (cons (marked_prim_comb recurse 'eval 0 true) evaled_params)))
(if (and (= 2 (len evaled_params)) (not (marked_env? (idx evaled_params 1)))) (array pectx nil (marked_array false true nil (cons (marked_prim_comb recurse 'eval 0 true) evaled_params)))
(dlet (
(body (idx evaled_params 0))
(implicit_env (!= 2 (len evaled_params)))
(eval_env (if implicit_env de (idx evaled_params 1)))
((ok unval_body) (try_unval body (lambda (_) nil)))
(_ (if (not ok) (error "actually impossible eval unval")))
) (veval_inner only_head de env_stack pectx (if implicit_env (array unval_body) (array unval_body eval_env)) indent))))
) 'eval 1 true))
(array 'vapply (marked_prim_comb (dlambda (only_head de env_stack pectx (f ps ide) indent)
(veval_inner only_head de env_stack pectx (array (marked_array false false nil (cons f (.marked_array_values ps))) ide) (+ 1 indent))
) 'vapply 1 true))
(array 'lapply (marked_prim_comb (dlambda (only_head de env_stack pectx (f ps) indent)
(veval_inner only_head de env_stack pectx (array (marked_array false false nil (cons (with_wrap_level f (- (.any_comb_wrap_level f) 1)) (.marked_array_values ps)))) (+ 1 indent))
) 'lapply 1 true))
(array 'vau (marked_prim_comb (lambda (only_head de env_stack pectx params indent) (dlet (
(mde? (mif (= 3 (len params)) (idx params 0) nil))
(vau_mde? (mif (= nil mde?) (array) (array mde?)))
(_ (print (indent_str indent) "mde? is " mde?))
(_ (print (indent_str indent) "\tmde? if " (mif mde? #t #f)))
(de? (mif mde? (.marked_symbol_value mde?) nil))
(_ (print (indent_str indent) "de? is " de?))
(vau_de? (mif (= nil de?) (array) (array de?)))
(raw_marked_params (mif (= nil de?) (idx params 0) (idx params 1)))
(raw_params (map (lambda (x) (mif (not (marked_symbol? x)) (error (str "not a marked symbol " x))
(.marked_symbol_value x))) (.marked_array_values raw_marked_params)))
((variadic vau_params) (foldl (dlambda ((v a) x) (mif (= x '&) (array true a) (array v (concat a (array x))))) (array false (array)) raw_params))
((ok body) (try_unval (mif (= nil de?) (idx params 1) (idx params 2)) (lambda (_) nil)))
(_ (if (not ok) (error "actually impossible vau unval")))
((env_counter memo) pectx)
(new_id env_counter)
(env_counter (+ 1 env_counter))
(pectx (array env_counter memo))
((pectx err pe_body) (if only_head (array pectx nil body)
(dlet (
(inner_env (make_tmp_inner_env vau_params de? de new_id))
(_ (print_strip (indent_str indent) "in vau, evaluating body with 'later params - " body))
((pectx err pe_body) (partial_eval_helper body false inner_env (array (idx env_stack 0)
(cons inner_env (idx env_stack 1))) pectx (+ 1 indent) false))
(_ (print_strip (indent_str indent) "in vau, result of evaluating body was " pe_body))
) (array pectx err pe_body))))
) (mif err (array pectx err nil) (array pectx nil (marked_comb 0 new_id de? de variadic vau_params pe_body)))
)) 'vau 0 true))
(array 'empty_env (marked_env true nil nil nil nil nil))
)))
; This causes ?infinate? recursion, doesn't happen if "if" is replaced with cond
;(test_func (vau (x) (if x (COMICAL 0) 0)))
;(and_fold (foldl and true '(true true false true)))
;(monad (array 'write 1 (str "Hello from compiled code! " and_fold " here's a hashed string " (hash_string "hia") "\n") (vau (written code) (array 'exit 0))))
;(monad (array 'write 1 (str "Hello from compiled code! " (mif nil 1 2) " " (mif 1 3 4) "\n") (vau (written code) (array 'exit 0))))
(monad (array 'write 1 (str "Hello from compiled code! " "\n") (vau (written code) (array 'exit (if (not written) 1)))))
) monad)
)
; end of all lets
))))))
; impl of let1
; this would be the macro style version (((
)) (vau de (s v b) (eval (array (array wrap (array vau (array s) b)) v) de)))
;)) (vau de (s v b) (eval (array (array vau (array s) b) (eval v de)) de)))
; impl of quote
)) (vau (x5) x5))

6946
partial_eval.scm
View File

File diff suppressed because it is too large Load Diff

902
sl/Cargo.lock generated Normal file
View File

@@ -0,0 +1,902 @@
# This file is automatically @generated by Cargo.
# It is not intended for manual editing.
version = 3
[[package]]
name = "ahash"
version = "0.8.6"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "91429305e9f0a25f6205c5b8e0d2db09e0708a7a6df0f42212bb56c32c8ac97a"
dependencies = [
"cfg-if",
"once_cell",
"version_check",
"zerocopy",
]
[[package]]
name = "aho-corasick"
version = "1.1.2"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "b2969dcb958b36655471fc61f7e416fa76033bdd4bfed0678d8fee1e2d07a1f0"
dependencies = [
"memchr",
]
[[package]]
name = "anyhow"
version = "1.0.75"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "a4668cab20f66d8d020e1fbc0ebe47217433c1b6c8f2040faf858554e394ace6"
[[package]]
name = "arbitrary"
version = "1.3.2"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "7d5a26814d8dcb93b0e5a0ff3c6d80a8843bafb21b39e8e18a6f05471870e110"
[[package]]
name = "ascii-canvas"
version = "3.0.0"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "8824ecca2e851cec16968d54a01dd372ef8f95b244fb84b84e70128be347c3c6"
dependencies = [
"term",
]
[[package]]
name = "autocfg"
version = "1.1.0"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "d468802bab17cbc0cc575e9b053f41e72aa36bfa6b7f55e3529ffa43161b97fa"
[[package]]
name = "bit-set"
version = "0.5.3"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "0700ddab506f33b20a03b13996eccd309a48e5ff77d0d95926aa0210fb4e95f1"
dependencies = [
"bit-vec",
]
[[package]]
name = "bit-vec"
version = "0.6.3"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "349f9b6a179ed607305526ca489b34ad0a41aed5f7980fa90eb03160b69598fb"
[[package]]
name = "bitflags"
version = "1.3.2"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "bef38d45163c2f1dde094a7dfd33ccf595c92905c8f8f4fdc18d06fb1037718a"
[[package]]
name = "bitflags"
version = "2.4.1"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "327762f6e5a765692301e5bb513e0d9fef63be86bbc14528052b1cd3e6f03e07"
[[package]]
name = "bumpalo"
version = "3.14.0"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "7f30e7476521f6f8af1a1c4c0b8cc94f0bee37d91763d0ca2665f299b6cd8aec"
[[package]]
name = "cfg-if"
version = "1.0.0"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "baf1de4339761588bc0619e3cbc0120ee582ebb74b53b4efbf79117bd2da40fd"
[[package]]
name = "cranelift"
version = "0.101.4"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "e4fdf311b2564edbf43d3a06335d309814f6ec60f55d090885d68e1a2e664c04"
dependencies = [
"cranelift-codegen",
"cranelift-frontend",
]
[[package]]
name = "cranelift-bforest"
version = "0.101.4"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "2b5bb9245ec7dcc04d03110e538d31f0969d301c9d673145f4b4d5c3478539a3"
dependencies = [
"cranelift-entity",
]
[[package]]
name = "cranelift-codegen"
version = "0.101.4"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "ebb18d10e5ddac43ba4ca8fd4e310938569c3e484cc01b6372b27dc5bb4dfd28"
dependencies = [
"bumpalo",
"cranelift-bforest",
"cranelift-codegen-meta",
"cranelift-codegen-shared",
"cranelift-control",
"cranelift-entity",
"cranelift-isle",
"gimli",
"hashbrown 0.14.2",
"log",
"regalloc2",
"smallvec",
"target-lexicon",
]
[[package]]
name = "cranelift-codegen-meta"
version = "0.101.4"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "7a3ce6d22982c1b9b6b012654258bab1a13947bb12703518bef06b1a4867c3d6"
dependencies = [
"cranelift-codegen-shared",
]
[[package]]
name = "cranelift-codegen-shared"
version = "0.101.4"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "47220fd4f9a0ce23541652b6f16f83868d282602c600d14934b2a4c166b4bd80"
[[package]]
name = "cranelift-control"
version = "0.101.4"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "ed5a4c42672aea9b6e820046b52e47a1c05d3394a6cdf4cb3c3c4b702f954bd2"
dependencies = [
"arbitrary",
]
[[package]]
name = "cranelift-entity"
version = "0.101.4"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "0b4e9a3296fc827f9d35135dc2c0c8dd8d8359eb1ef904bae2d55d5bcb0c9f94"
[[package]]
name = "cranelift-frontend"
version = "0.101.4"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "33ec537d0f0b8e084517f3e7bfa1d89af343d7c7df455573fca9f272d4e01267"
dependencies = [
"cranelift-codegen",
"log",
"smallvec",
"target-lexicon",
]
[[package]]
name = "cranelift-isle"
version = "0.101.4"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "45bab6d69919d210a50331d35cc6ce111567bc040aebac63a8ae130d0400a075"
[[package]]
name = "cranelift-jit"
version = "0.101.4"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "1daca8224e77263494e1d949daeb0a0a0992f9c489d4dc395bfc8ddda0eafcaf"
dependencies = [
"anyhow",
"cranelift-codegen",
"cranelift-control",
"cranelift-entity",
"cranelift-module",
"cranelift-native",
"libc",
"log",
"region",
"target-lexicon",
"wasmtime-jit-icache-coherence",
"windows-sys",
]
[[package]]
name = "cranelift-module"
version = "0.101.4"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "533ebbad90a77980bdbbe6bd4beee9598a74db06316e8a9def7a6d9564e19f5e"
dependencies = [
"anyhow",
"cranelift-codegen",
"cranelift-control",
]
[[package]]
name = "cranelift-native"
version = "0.101.4"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "f32e81605f352cf37af5463f11cd7deec7b6572741931a8d372f7fdd4a744f5d"
dependencies = [
"cranelift-codegen",
"libc",
"target-lexicon",
]
[[package]]
name = "crunchy"
version = "0.2.2"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "7a81dae078cea95a014a339291cec439d2f232ebe854a9d672b796c6afafa9b7"
[[package]]
name = "diff"
version = "0.1.13"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "56254986775e3233ffa9c4d7d3faaf6d36a2c09d30b20687e9f88bc8bafc16c8"
[[package]]
name = "dirs-next"
version = "2.0.0"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "b98cf8ebf19c3d1b223e151f99a4f9f0690dca41414773390fc824184ac833e1"
dependencies = [
"cfg-if",
"dirs-sys-next",
]
[[package]]
name = "dirs-sys-next"
version = "0.1.2"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "4ebda144c4fe02d1f7ea1a7d9641b6fc6b580adcfa024ae48797ecdeb6825b4d"
dependencies = [
"libc",
"redox_users",
"winapi",
]
[[package]]
name = "either"
version = "1.9.0"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "a26ae43d7bcc3b814de94796a5e736d4029efb0ee900c12e2d54c993ad1a1e07"
[[package]]
name = "ena"
version = "0.14.2"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "c533630cf40e9caa44bd91aadc88a75d75a4c3a12b4cfde353cbed41daa1e1f1"
dependencies = [
"log",
]
[[package]]
name = "equivalent"
version = "1.0.1"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "5443807d6dff69373d433ab9ef5378ad8df50ca6298caf15de6e52e24aaf54d5"
[[package]]
name = "errno"
version = "0.3.7"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "f258a7194e7f7c2a7837a8913aeab7fd8c383457034fa20ce4dd3dcb813e8eb8"
dependencies = [
"libc",
"windows-sys",
]
[[package]]
name = "fallible-iterator"
version = "0.3.0"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "2acce4a10f12dc2fb14a218589d4f1f62ef011b2d0cc4b3cb1bba8e94da14649"
[[package]]
name = "fixedbitset"
version = "0.4.2"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "0ce7134b9999ecaf8bcd65542e436736ef32ddca1b3e06094cb6ec5755203b80"
[[package]]
name = "getrandom"
version = "0.2.11"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "fe9006bed769170c11f845cf00c7c1e9092aeb3f268e007c3e760ac68008070f"
dependencies = [
"cfg-if",
"libc",
"wasi",
]
[[package]]
name = "gimli"
version = "0.28.0"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "6fb8d784f27acf97159b40fc4db5ecd8aa23b9ad5ef69cdd136d3bc80665f0c0"
dependencies = [
"fallible-iterator",
"indexmap",
"stable_deref_trait",
]
[[package]]
name = "hashbrown"
version = "0.13.2"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "43a3c133739dddd0d2990f9a4bdf8eb4b21ef50e4851ca85ab661199821d510e"
dependencies = [
"ahash",
]
[[package]]
name = "hashbrown"
version = "0.14.2"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "f93e7192158dbcda357bdec5fb5788eebf8bbac027f3f33e719d29135ae84156"
[[package]]
name = "hermit-abi"
version = "0.3.3"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "d77f7ec81a6d05a3abb01ab6eb7590f6083d08449fe5a1c8b1e620283546ccb7"
[[package]]
name = "indexmap"
version = "2.1.0"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "d530e1a18b1cb4c484e6e34556a0d948706958449fca0cab753d649f2bce3d1f"
dependencies = [
"equivalent",
"hashbrown 0.14.2",
]
[[package]]
name = "is-terminal"
version = "0.4.9"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "cb0889898416213fab133e1d33a0e5858a48177452750691bde3666d0fdbaf8b"
dependencies = [
"hermit-abi",
"rustix",
"windows-sys",
]
[[package]]
name = "itertools"
version = "0.10.5"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "b0fd2260e829bddf4cb6ea802289de2f86d6a7a690192fbe91b3f46e0f2c8473"
dependencies = [
"either",
]
[[package]]
name = "lalrpop"
version = "0.20.0"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "da4081d44f4611b66c6dd725e6de3169f9f63905421e8626fcb86b6a898998b8"
dependencies = [
"ascii-canvas",
"bit-set",
"diff",
"ena",
"is-terminal",
"itertools",
"lalrpop-util",
"petgraph",
"pico-args",
"regex",
"regex-syntax 0.7.5",
"string_cache",
"term",
"tiny-keccak",
"unicode-xid",
]
[[package]]
name = "lalrpop-util"
version = "0.20.0"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "3f35c735096c0293d313e8f2a641627472b83d01b937177fe76e5e2708d31e0d"
dependencies = [
"regex",
]
[[package]]
name = "libc"
version = "0.2.150"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "89d92a4743f9a61002fae18374ed11e7973f530cb3a3255fb354818118b2203c"
[[package]]
name = "libredox"
version = "0.0.1"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "85c833ca1e66078851dba29046874e38f08b2c883700aa29a03ddd3b23814ee8"
dependencies = [
"bitflags 2.4.1",
"libc",
"redox_syscall",
]
[[package]]
name = "linux-raw-sys"
version = "0.4.11"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "969488b55f8ac402214f3f5fd243ebb7206cf82de60d3172994707a4bcc2b829"
[[package]]
name = "lock_api"
version = "0.4.11"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "3c168f8615b12bc01f9c17e2eb0cc07dcae1940121185446edc3744920e8ef45"
dependencies = [
"autocfg",
"scopeguard",
]
[[package]]
name = "log"
version = "0.4.20"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "b5e6163cb8c49088c2c36f57875e58ccd8c87c7427f7fbd50ea6710b2f3f2e8f"
[[package]]
name = "mach"
version = "0.3.2"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "b823e83b2affd8f40a9ee8c29dbc56404c1e34cd2710921f2801e2cf29527afa"
dependencies = [
"libc",
]
[[package]]
name = "memchr"
version = "2.6.4"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "f665ee40bc4a3c5590afb1e9677db74a508659dfd71e126420da8274909a0167"
[[package]]
name = "new_debug_unreachable"
version = "1.0.4"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "e4a24736216ec316047a1fc4252e27dabb04218aa4a3f37c6e7ddbf1f9782b54"
[[package]]
name = "once_cell"
version = "1.18.0"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "dd8b5dd2ae5ed71462c540258bedcb51965123ad7e7ccf4b9a8cafaa4a63576d"
[[package]]
name = "parking_lot"
version = "0.12.1"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "3742b2c103b9f06bc9fff0a37ff4912935851bee6d36f3c02bcc755bcfec228f"
dependencies = [
"lock_api",
"parking_lot_core",
]
[[package]]
name = "parking_lot_core"
version = "0.9.9"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "4c42a9226546d68acdd9c0a280d17ce19bfe27a46bf68784e4066115788d008e"
dependencies = [
"cfg-if",
"libc",
"redox_syscall",
"smallvec",
"windows-targets",
]
[[package]]
name = "petgraph"
version = "0.6.4"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "e1d3afd2628e69da2be385eb6f2fd57c8ac7977ceeff6dc166ff1657b0e386a9"
dependencies = [
"fixedbitset",
"indexmap",
]
[[package]]
name = "phf_shared"
version = "0.10.0"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "b6796ad771acdc0123d2a88dc428b5e38ef24456743ddb1744ed628f9815c096"
dependencies = [
"siphasher",
]
[[package]]
name = "pico-args"
version = "0.5.0"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "5be167a7af36ee22fe3115051bc51f6e6c7054c9348e28deb4f49bd6f705a315"
[[package]]
name = "precomputed-hash"
version = "0.1.1"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "925383efa346730478fb4838dbe9137d2a47675ad789c546d150a6e1dd4ab31c"
[[package]]
name = "proc-macro2"
version = "1.0.69"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "134c189feb4956b20f6f547d2cf727d4c0fe06722b20a0eec87ed445a97f92da"
dependencies = [
"unicode-ident",
]
[[package]]
name = "quote"
version = "1.0.33"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "5267fca4496028628a95160fc423a33e8b2e6af8a5302579e322e4b520293cae"
dependencies = [
"proc-macro2",
]
[[package]]
name = "redox_syscall"
version = "0.4.1"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "4722d768eff46b75989dd134e5c353f0d6296e5aaa3132e776cbdb56be7731aa"
dependencies = [
"bitflags 1.3.2",
]
[[package]]
name = "redox_users"
version = "0.4.4"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "a18479200779601e498ada4e8c1e1f50e3ee19deb0259c25825a98b5603b2cb4"
dependencies = [
"getrandom",
"libredox",
"thiserror",
]
[[package]]
name = "regalloc2"
version = "0.9.3"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "ad156d539c879b7a24a363a2016d77961786e71f48f2e2fc8302a92abd2429a6"
dependencies = [
"hashbrown 0.13.2",
"log",
"rustc-hash",
"slice-group-by",
"smallvec",
]
[[package]]
name = "regex"
version = "1.10.2"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "380b951a9c5e80ddfd6136919eef32310721aa4aacd4889a8d39124b026ab343"
dependencies = [
"aho-corasick",
"memchr",
"regex-automata",
"regex-syntax 0.8.2",
]
[[package]]
name = "regex-automata"
version = "0.4.3"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "5f804c7828047e88b2d32e2d7fe5a105da8ee3264f01902f796c8e067dc2483f"
dependencies = [
"aho-corasick",
"memchr",
"regex-syntax 0.8.2",
]
[[package]]
name = "regex-syntax"
version = "0.7.5"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "dbb5fb1acd8a1a18b3dd5be62d25485eb770e05afb408a9627d14d451bae12da"
[[package]]
name = "regex-syntax"
version = "0.8.2"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "c08c74e62047bb2de4ff487b251e4a92e24f48745648451635cec7d591162d9f"
[[package]]
name = "region"
version = "2.2.0"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "877e54ea2adcd70d80e9179344c97f93ef0dffd6b03e1f4529e6e83ab2fa9ae0"
dependencies = [
"bitflags 1.3.2",
"libc",
"mach",
"winapi",
]
[[package]]
name = "rustc-hash"
version = "1.1.0"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "08d43f7aa6b08d49f382cde6a7982047c3426db949b1424bc4b7ec9ae12c6ce2"
[[package]]
name = "rustix"
version = "0.38.25"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "dc99bc2d4f1fed22595588a013687477aedf3cdcfb26558c559edb67b4d9b22e"
dependencies = [
"bitflags 2.4.1",
"errno",
"libc",
"linux-raw-sys",
"windows-sys",
]
[[package]]
name = "rustversion"
version = "1.0.14"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "7ffc183a10b4478d04cbbbfc96d0873219d962dd5accaff2ffbd4ceb7df837f4"
[[package]]
name = "scopeguard"
version = "1.2.0"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "94143f37725109f92c262ed2cf5e59bce7498c01bcc1502d7b9afe439a4e9f49"
[[package]]
name = "siphasher"
version = "0.3.11"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "38b58827f4464d87d377d175e90bf58eb00fd8716ff0a62f80356b5e61555d0d"
[[package]]
name = "sl"
version = "0.1.0"
dependencies = [
"anyhow",
"cranelift",
"cranelift-jit",
"cranelift-module",
"cranelift-native",
"lalrpop",
"lalrpop-util",
"once_cell",
"regex",
]
[[package]]
name = "slice-group-by"
version = "0.3.1"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "826167069c09b99d56f31e9ae5c99049e932a98c9dc2dac47645b08dbbf76ba7"
[[package]]
name = "smallvec"
version = "1.11.2"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "4dccd0940a2dcdf68d092b8cbab7dc0ad8fa938bf95787e1b916b0e3d0e8e970"
[[package]]
name = "stable_deref_trait"
version = "1.2.0"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "a8f112729512f8e442d81f95a8a7ddf2b7c6b8a1a6f509a95864142b30cab2d3"
[[package]]
name = "string_cache"
version = "0.8.7"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "f91138e76242f575eb1d3b38b4f1362f10d3a43f47d182a5b359af488a02293b"
dependencies = [
"new_debug_unreachable",
"once_cell",
"parking_lot",
"phf_shared",
"precomputed-hash",
]
[[package]]
name = "syn"
version = "2.0.39"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "23e78b90f2fcf45d3e842032ce32e3f2d1545ba6636271dcbf24fa306d87be7a"
dependencies = [
"proc-macro2",
"quote",
"unicode-ident",
]
[[package]]
name = "target-lexicon"
version = "0.12.12"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "14c39fd04924ca3a864207c66fc2cd7d22d7c016007f9ce846cbb9326331930a"
[[package]]
name = "term"
version = "0.7.0"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "c59df8ac95d96ff9bede18eb7300b0fda5e5d8d90960e76f8e14ae765eedbf1f"
dependencies = [
"dirs-next",
"rustversion",
"winapi",
]
[[package]]
name = "thiserror"
version = "1.0.50"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "f9a7210f5c9a7156bb50aa36aed4c95afb51df0df00713949448cf9e97d382d2"
dependencies = [
"thiserror-impl",
]
[[package]]
name = "thiserror-impl"
version = "1.0.50"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "266b2e40bc00e5a6c09c3584011e08b06f123c00362c92b975ba9843aaaa14b8"
dependencies = [
"proc-macro2",
"quote",
"syn",
]
[[package]]
name = "tiny-keccak"
version = "2.0.2"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "2c9d3793400a45f954c52e73d068316d76b6f4e36977e3fcebb13a2721e80237"
dependencies = [
"crunchy",
]
[[package]]
name = "unicode-ident"
version = "1.0.12"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "3354b9ac3fae1ff6755cb6db53683adb661634f67557942dea4facebec0fee4b"
[[package]]
name = "unicode-xid"
version = "0.2.4"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "f962df74c8c05a667b5ee8bcf162993134c104e96440b663c8daa176dc772d8c"
[[package]]
name = "version_check"
version = "0.9.4"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "49874b5167b65d7193b8aba1567f5c7d93d001cafc34600cee003eda787e483f"
[[package]]
name = "wasi"
version = "0.11.0+wasi-snapshot-preview1"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "9c8d87e72b64a3b4db28d11ce29237c246188f4f51057d65a7eab63b7987e423"
[[package]]
name = "wasmtime-jit-icache-coherence"
version = "14.0.4"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "f67e6be36375c39cff57ed3b137ab691afbf2d9ba8ee1c01f77888413f218749"
dependencies = [
"cfg-if",
"libc",
"windows-sys",
]
[[package]]
name = "winapi"
version = "0.3.9"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "5c839a674fcd7a98952e593242ea400abe93992746761e38641405d28b00f419"
dependencies = [
"winapi-i686-pc-windows-gnu",
"winapi-x86_64-pc-windows-gnu",
]
[[package]]
name = "winapi-i686-pc-windows-gnu"
version = "0.4.0"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "ac3b87c63620426dd9b991e5ce0329eff545bccbbb34f3be09ff6fb6ab51b7b6"
[[package]]
name = "winapi-x86_64-pc-windows-gnu"
version = "0.4.0"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "712e227841d057c1ee1cd2fb22fa7e5a5461ae8e48fa2ca79ec42cfc1931183f"
[[package]]
name = "windows-sys"
version = "0.48.0"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "677d2418bec65e3338edb076e806bc1ec15693c5d0104683f2efe857f61056a9"
dependencies = [
"windows-targets",
]
[[package]]
name = "windows-targets"
version = "0.48.5"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "9a2fa6e2155d7247be68c096456083145c183cbbbc2764150dda45a87197940c"
dependencies = [
"windows_aarch64_gnullvm",
"windows_aarch64_msvc",
"windows_i686_gnu",
"windows_i686_msvc",
"windows_x86_64_gnu",
"windows_x86_64_gnullvm",
"windows_x86_64_msvc",
]
[[package]]
name = "windows_aarch64_gnullvm"
version = "0.48.5"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "2b38e32f0abccf9987a4e3079dfb67dcd799fb61361e53e2882c3cbaf0d905d8"
[[package]]
name = "windows_aarch64_msvc"
version = "0.48.5"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "dc35310971f3b2dbbf3f0690a219f40e2d9afcf64f9ab7cc1be722937c26b4bc"
[[package]]
name = "windows_i686_gnu"
version = "0.48.5"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "a75915e7def60c94dcef72200b9a8e58e5091744960da64ec734a6c6e9b3743e"
[[package]]
name = "windows_i686_msvc"
version = "0.48.5"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "8f55c233f70c4b27f66c523580f78f1004e8b5a8b659e05a4eb49d4166cca406"
[[package]]
name = "windows_x86_64_gnu"
version = "0.48.5"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "53d40abd2583d23e4718fddf1ebec84dbff8381c07cae67ff7768bbf19c6718e"
[[package]]
name = "windows_x86_64_gnullvm"
version = "0.48.5"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "0b7b52767868a23d5bab768e390dc5f5c55825b6d30b86c844ff2dc7414044cc"
[[package]]
name = "windows_x86_64_msvc"
version = "0.48.5"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "ed94fce61571a4006852b7389a063ab983c02eb1bb37b47f8272ce92d06d9538"
[[package]]
name = "zerocopy"
version = "0.7.26"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "e97e415490559a91254a2979b4829267a57d2fcd741a98eee8b722fb57289aa0"
dependencies = [
"zerocopy-derive",
]
[[package]]
name = "zerocopy-derive"
version = "0.7.26"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "dd7e48ccf166952882ca8bd778a43502c64f33bf94c12ebe2a7f08e5a0f6689f"
dependencies = [
"proc-macro2",
"quote",
"syn",
]

14
kr/Cargo.toml → sl/Cargo.toml
View File

@@ -1,20 +1,22 @@
[package]
name = "kr"
name = "sl"
version = "0.1.0"
edition = "2021"
build = "build.rs"
# See more keys and their definitions at https://doc.rust-lang.org/cargo/reference/manifest.html
[profile.bench]
debug = true
[dependencies]
lalrpop-util = {version="0.19.7", features=["lexer"]}
lalrpop-util = {version="0.20", features=["lexer"]}
regex = "1"
once_cell = "1.17.0"
once_cell = "1"
anyhow = "1"
cranelift = "0.101.4"
cranelift-module = "0.101.4"
cranelift-jit = "0.101.4"
cranelift-native = "0.101.4"
[build-dependencies]
lalrpop = "0.19.7"
lalrpop = "0.20"

0
kr/build.rs → sl/build.rs
View File

31
sl/src/grammar.lalrpop Normal file
View File

@@ -0,0 +1,31 @@
use std::str::FromStr;
use std::rc::Rc;
use sl::Form;
grammar;
pub Term: Rc<Form> = {
NUM => Rc::new(Form::Int(i32::from_str(<>).unwrap())),
SYM => Rc::new(Form::Symbol(<>.to_owned())),
"(" <ListInside?> ")" => <>.unwrap_or(Rc::new(Form::Nil)),
"'" <Term> => Rc::new(Form::Pair(Rc::new(Form::Symbol("quote".to_owned())), Rc::new(Form::Pair(<>, Rc::new(Form::Nil))))),
"!" <h: Term> <t: Term> => {
h.append(t).unwrap()
},
};
ListInside: Rc<Form> = {
<Term> => Rc::new(Form::Pair(<>, Rc::new(Form::Nil))),
<h: Term> <t: ListInside> => Rc::new(Form::Pair(h, t)),
<a: Term> "." <d: Term> => Rc::new(Form::Pair(a, d)),
}
match {
"(",
")",
".",
"'",
"!",
r"[0-9]+" => NUM,
r"[a-zA-Z+*/_=?%&|^<>-][\w+*/=_?%&|^<>-]*" => SYM,
r"(;[^\n]*\n)|\s+" => { }
}

186
sl/src/lib.rs Normal file
View File

@@ -0,0 +1,186 @@
use std::rc::Rc;
use std::collections::BTreeMap;
use std::fmt;
use anyhow::{anyhow,Result};
#[derive(Debug, Eq, PartialEq)]
pub enum Form {
Nil,
Int(i32),
Bool(bool),
Symbol(String),
Pair(Rc<Form>,Rc<Form>),
Prim(Prim),
}
#[derive(Debug, Eq, PartialEq, Clone, Copy)]
pub enum Prim {
Add,
Mul,
Eq,
}
impl Form {
fn new_nil() -> Rc<Form> {
Rc::new(Form::Nil)
}
fn new_int(i: i32) -> Rc<Form> {
Rc::new(Form::Int(i))
}
fn new_bool(b: bool) -> Rc<Form> {
Rc::new(Form::Bool(b))
}
fn truthy(&self) -> bool {
match self {
Form::Bool(b) => *b,
Form::Nil => false,
_ => true,
}
}
fn int(&self) -> Result<i32> {
match self {
Form::Int(i) => Ok(*i),
_ => Err(anyhow!("int on not a int")),
}
}
fn prim(&self) -> Result<Prim> {
match self {
Form::Prim(p) => Ok(*p),
_ => Err(anyhow!("prim on not a prim")),
}
}
fn sym(&self) -> Result<&str> {
match self {
Form::Symbol(s) => Ok(s),
_ => Err(anyhow!("sym on not a sym")),
}
}
fn pair(&self) -> Result<(Rc<Form>,Rc<Form>)> {
match self {
Form::Pair(car, cdr) => Ok((Rc::clone(car),Rc::clone(cdr))),
_ => Err(anyhow!("pair on not a pair")),
}
}
fn car(&self) -> Result<Rc<Form>> {
match self {
Form::Pair(car, _cdr) => Ok(Rc::clone(car)),
_ => Err(anyhow!("car on not a pair")),
}
}
fn cdr(&self) -> Result<Rc<Form>> {
match self {
Form::Pair(_car, cdr) => Ok(Rc::clone(cdr)),
_ => Err(anyhow!("cdr on not a pair")),
}
}
fn is_nil(&self) -> bool {
match self {
Form::Nil => true,
_ => false,
}
}
pub fn append(&self, x: Rc<Form>) -> Result<Rc<Form>> {
match self {
Form::Pair(car, cdr) => cdr.append(x).map(|x| Rc::new(Form::Pair(Rc::clone(car), x))),
Form::Nil => Ok(Rc::new(Form::Pair(x, Rc::new(Form::Nil)))),
_ => Err(anyhow!("append to not a pair")),
}
}
}
pub struct Env {
m: BTreeMap<String, Rc<Form>>
}
impl Env {
pub fn root_env() -> Env {
Env {
m: [
("+", Rc::new(Form::Prim(Prim::Add))),
("*", Rc::new(Form::Prim(Prim::Mul))),
("=", Rc::new(Form::Prim(Prim::Eq))),
].into_iter().map(|(s,p)| (s.to_owned(), p)).collect()
}
}
pub fn lookup(&self, s: &str) -> Result<Rc<Form>> {
Ok(Rc::clone(self.m.get(s).ok_or(anyhow!("lookup failed"))?))
}
}
pub fn tree_walker_eval(f: Rc<Form>, e: &mut Env) -> Result<Rc<Form>> {
Ok(match &*f {
Form::Symbol(s) => e.lookup(s)?,
Form::Pair(car, cdr) => {
match &**car {
Form::Symbol(s) if s == "if" => {
if tree_walker_eval(cdr.car()?, e)?.truthy() {
tree_walker_eval(cdr.cdr()?.car()?, e)?
} else {
tree_walker_eval(cdr.cdr()?.cdr()?.car()?, e)?
}
}
_ => {
let comb = tree_walker_eval(Rc::clone(car), e)?;
let a = tree_walker_eval(cdr.car()?, e)?;
let b = tree_walker_eval(cdr.cdr()?.car()?, e)?;
match comb.prim().unwrap() {
Prim::Add => Form::new_int(a.int()? + b.int()?),
Prim::Mul => Form::new_int(a.int()? * b.int()?),
Prim::Eq => Form::new_bool(a == b),
}
}
}
},
_ => f
})
}
// todo, strings not symbols?
impl From<String> for Form { fn from(item: String) -> Self { Form::Symbol(item) } }
impl From<&str> for Form { fn from(item: &str) -> Self { Form::Symbol(item.to_owned()) } }
impl From<i32> for Form { fn from(item: i32) -> Self { Form::Int(item) } }
impl From<bool> for Form { fn from(item: bool) -> Self { Form::Bool(item) } }
impl<A: Into<Form>, B: Into<Form>> From<(A, B)> for Form {
fn from(item: (A, B)) -> Self {
Form::Pair(Rc::new(item.0.into()), Rc::new(item.1.into()))
}
}
impl fmt::Display for Form {
fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result {
match self {
Form::Nil => write!(f, "nil"),
Form::Int(i) => write!(f, "{i}"),
Form::Bool(b) => write!(f, "{b}"),
Form::Symbol(s) => write!(f, "'{s}"),
Form::Pair(car, cdr) => {
write!(f, "({}", car)?;
let mut traverse: Rc<Form> = Rc::clone(cdr);
loop {
match &*traverse {
Form::Pair(ref carp, ref cdrp) => {
write!(f, " {}", carp)?;
traverse = Rc::clone(cdrp);
},
Form::Nil => {
write!(f, ")")?;
return Ok(());
},
x => {
write!(f, ". {x})")?;
return Ok(());
},
}
}
},
Form::Prim(p) => {
match p {
Prim::Add => write!(f, "+"),
Prim::Mul => write!(f, "*"),
Prim::Eq => write!(f, "="),
}
}
}
}
}

18
sl/src/main.rs Normal file
View File

@@ -0,0 +1,18 @@
#[macro_use] extern crate lalrpop_util;
lalrpop_mod!(pub grammar);
use std::rc::Rc;
use anyhow::Result;
use sl::{tree_walker_eval, Env};
fn main() -> Result<()> {
let input = "(if (= 1 2) (+ 2 3) (* 2 2))";
let parsed_input = Rc::new(grammar::TermParser::new().parse(input)?);
//println!("Hello, world: {parsed_input:?}");
println!("Hello, world: {parsed_input}");
let mut e = Env::root_env();
let tree_walker_evaled = tree_walker_eval(Rc::clone(&parsed_input), &mut e)?;
println!("tree walker evaled: {tree_walker_evaled}");
Ok(())
}

14
small_demo/demo.sh
View File

@@ -1,14 +0,0 @@
#!/usr/bin/env bash
echo
echo "Partially Evaluating & compiling " $@
echo "Source is"
cat $@
echo
touch csc_out.wasm && rm csc_out.wasm && time scheme --script ../partial_eval.scm $@
echo
echo "Running"
echo
wasmtime ./csc_out.wasm
echo
echo

156
small_demo/enter_debug.kp
View File

@@ -1,156 +0,0 @@
((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 (lambda (& y) (lapply (x2 x2) y))))))
(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 (
lcompose (lambda (g f) (lambda (& args) (lapply g (array (lapply f args)))))
rec-lambda (vau se (n p b) (eval (array Y (array lambda (array n) (array lambda p b))) se))
if (vau de (con than & else) (cond (eval con de) (eval than de)
(> (len else) 0) (eval (idx else 0) de)
true false))
map (lambda (f5 l5)
; now maybe errors on can't find helper?
(let (helper (rec-lambda recurse (f4 l4 n4 i4)
(cond (= i4 (len l4)) n4
(<= i4 (- (len l4) 4)) (recurse f4 l4 (concat n4 (array
(f4 (idx l4 (+ i4 0)))
(f4 (idx l4 (+ i4 1)))
(f4 (idx l4 (+ i4 2)))
(f4 (idx l4 (+ i4 3)))
)) (+ i4 4))
true (recurse f4 l4 (concat n4 (array (f4 (idx l4 i4)))) (+ i4 1)))))
(helper f5 l5 (array) 0)))
map_i (lambda (f l)
(let (helper (rec-lambda recurse (f l n i)
(cond (= i (len l)) n
(<= i (- (len l) 4)) (recurse f l (concat n (array
(f (+ i 0) (idx l (+ i 0)))
(f (+ i 1) (idx l (+ i 1)))
(f (+ i 2) (idx l (+ i 2)))
(f (+ i 3) (idx l (+ i 3)))
)) (+ i 4))
true (recurse f l (concat n (array (f i (idx l i)))) (+ i 1)))))
(helper f l (array) 0)))
filter_i (lambda (f l)
(let (helper (rec-lambda recurse (f l n i)
(if (= i (len l))
n
(if (f i (idx l i)) (recurse f l (concat n (array (idx l i))) (+ i 1))
(recurse f l n (+ i 1))))))
(helper f l (array) 0)))
filter (lambda (f l) (filter_i (lambda (i x) (f x)) l))
foldl (let (helper (rec-lambda recurse (f z vs i) (if (= i (len (idx vs 0))) z
(recurse f (lapply f (cons z (map (lambda (x) (idx x i)) vs))) vs (+ i 1)))))
(lambda (f z & vs) (helper f z vs 0)))
not (lambda (x) (if x false true))
; Huge thanks to Oleg Kiselyov for his fantastic website
; http://okmij.org/ftp/Computation/fixed-point-combinators.html
Y* (lambda (& l)
((lambda (u) (u u))
(lambda (p)
(map (lambda (li) (lambda (& x) (lapply (lapply li (p p)) x))) l))))
vY* (lambda (& l)
((lambda (u) (u u))
(lambda (p)
(map (lambda (li) (vau ide (& x) (vapply (lapply li (p p)) x ide))) l))))
let-rec (vau de (name_func body)
(let (names (filter_i (lambda (i x) (= 0 (% i 2))) name_func)
funcs (filter_i (lambda (i x) (= 1 (% i 2))) name_func)
overwrite_name (idx name_func (- (len name_func) 2)))
(eval (array let (concat (array overwrite_name (concat (array Y*) (map (lambda (f) (array lambda names f)) funcs)))
(lapply concat (map_i (lambda (i n) (array n (array idx overwrite_name i))) names)))
body) de)))
let-vrec (vau de (name_func body)
(let (names (filter_i (lambda (i x) (= 0 (% i 2))) name_func)
funcs (filter_i (lambda (i x) (= 1 (% i 2))) name_func)
overwrite_name (idx name_func (- (len name_func) 2)))
(eval (array let (concat (array overwrite_name (concat (array vY*) (map (lambda (f) (array lambda names f)) funcs)))
(lapply concat (map_i (lambda (i n) (array n (array idx overwrite_name i))) names)))
body) de)))
flat_map (lambda (f l)
(let (helper (rec-lambda recurse (f l n i)
(if (= i (len l))
n
(recurse f l (concat n (f (idx l i))) (+ i 1)))))
(helper f l (array) 0)))
flat_map_i (lambda (f l)
(let (helper (rec-lambda recurse (f l n i)
(if (= i (len l))
n
(recurse f l (concat n (f i (idx l i))) (+ i 1)))))
(helper f l (array) 0)))
; with all this, we make a destrucutring-capable let
let (let (
destructure_helper (rec-lambda recurse (vs i r)
(cond (= (len vs) i) r
(array? (idx vs i)) (let (bad_sym (str-to-symbol (str (idx vs i)))
;new_vs (flat_map_i (lambda (i x) (array x (array idx bad_sym i))) (slice (idx vs i) 1 -1))
new_vs (flat_map_i (lambda (i x) (array x (array idx bad_sym i))) (idx vs i))
)
(recurse (concat new_vs (slice vs (+ i 2) -1)) 0 (concat r (array bad_sym (idx vs (+ i 1))))))
true (recurse vs (+ i 2) (concat r (slice vs i (+ i 2))))
))) (vau de (vs b) (vapply let (array (destructure_helper vs 0 (array)) b) de)))
; and a destructuring-capable lambda!
only_symbols (rec-lambda recurse (a i) (cond (= i (len a)) true
(symbol? (idx a i)) (recurse a (+ i 1))
true false))
; Note that if macro_helper is inlined, the mapping lambdas will close over
; se, and then not be able to be taken in as values to the maps, and the vau
; will fail to partially evaluate away.
lambda (let (macro_helper (lambda (p b) (let (
sym_params (map (lambda (param) (if (symbol? param) param
(str-to-symbol (str param)))) p)
body (array let (flat_map_i (lambda (i x) (array (idx p i) x)) sym_params) b)
) (array vau sym_params body))))
(vau se (p b) (if (only_symbols p 0) (vapply lambda (array p b) se)
(wrap (eval (macro_helper p b) se)))))
; and rec-lambda - yes it's the same definition again
rec-lambda (vau se (n p b) (eval (array Y (array lambda (array n) (array lambda p b))) se))
nil (array)
or (let (macro_helper (rec-lambda recurse (bs i) (cond (= i (len bs)) false
(= (+ 1 i) (len bs)) (idx bs i)
true (array let (array 'tmp (idx bs i)) (array if 'tmp 'tmp (recurse bs (+ i 1)))))))
(vau se (& bs) (eval (macro_helper bs 0) se)))
and (let (macro_helper (rec-lambda recurse (bs i) (cond (= i (len bs)) true
(= (+ 1 i) (len bs)) (idx bs i)
true (array let (array 'tmp (idx bs i)) (array if 'tmp (recurse bs (+ i 1)) 'tmp)))))
(vau se (& bs) (eval (macro_helper bs 0) se)))
monad (array 'write 1 "entering debug time!" (vau (written code) (array 'exit (debug))))
)
monad
)
;(array 'write 1 "test_self_out2" (vau (written code) 7))
; end of all lets
))))))
; impl of let1
; this would be the macro style version (((
)) (vau de (s v b) (eval (array (array wrap (array vau (array s) b)) v) de)))
;)) (vau de (s v b) (eval (array (array vau (array s) b) (eval v de)) de)))
; impl of quote
)) (vau (x5) x5))

1
small_demo/small_demo.kp
View File

@@ -1 +0,0 @@
(+ 1 2)

1
small_demo/small_lambda_demo.kp
View File

@@ -1 +0,0 @@
(wrap (vau () (+ 1 2)))

8
small_demo/small_macro_demo.kp
View File

@@ -1,8 +0,0 @@
((wrap (vau (quote)
(vau () (array (quote a) (+ 1 2)))
; impl of quote
)) (vau (x5) x5))

154
small_demo/small_test.kp
View File

@@ -1,154 +0,0 @@
((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 (lambda (& y) (lapply (x2 x2) y))))))
(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 (
lcompose (lambda (g f) (lambda (& args) (lapply g (array (lapply f args)))))
rec-lambda (vau se (n p b) (eval (array Y (array lambda (array n) (array lambda p b))) se))
if (vau de (con than & else) (cond (eval con de) (eval than de)
(> (len else) 0) (eval (idx else 0) de)
true false))
map (lambda (f5 l5)
; now maybe errors on can't find helper?
(let (helper (rec-lambda recurse (f4 l4 n4 i4)
(cond (= i4 (len l4)) n4
(<= i4 (- (len l4) 4)) (recurse f4 l4 (concat n4 (array
(f4 (idx l4 (+ i4 0)))
(f4 (idx l4 (+ i4 1)))
(f4 (idx l4 (+ i4 2)))
(f4 (idx l4 (+ i4 3)))
)) (+ i4 4))
true (recurse f4 l4 (concat n4 (array (f4 (idx l4 i4)))) (+ i4 1)))))
(helper f5 l5 (array) 0)))
map_i (lambda (f l)
(let (helper (rec-lambda recurse (f l n i)
(cond (= i (len l)) n
(<= i (- (len l) 4)) (recurse f l (concat n (array
(f (+ i 0) (idx l (+ i 0)))
(f (+ i 1) (idx l (+ i 1)))
(f (+ i 2) (idx l (+ i 2)))
(f (+ i 3) (idx l (+ i 3)))
)) (+ i 4))
true (recurse f l (concat n (array (f i (idx l i)))) (+ i 1)))))
(helper f l (array) 0)))
filter_i (lambda (f l)
(let (helper (rec-lambda recurse (f l n i)
(if (= i (len l))
n
(if (f i (idx l i)) (recurse f l (concat n (array (idx l i))) (+ i 1))
(recurse f l n (+ i 1))))))
(helper f l (array) 0)))
filter (lambda (f l) (filter_i (lambda (i x) (f x)) l))
not (lambda (x) (if x false true))
; Huge thanks to Oleg Kiselyov for his fantastic website
; http://okmij.org/ftp/Computation/fixed-point-combinators.html
Y* (lambda (& l)
((lambda (u) (u u))
(lambda (p)
(map (lambda (li) (lambda (& x) (lapply (lapply li (p p)) x))) l))))
vY* (lambda (& l)
((lambda (u) (u u))
(lambda (p)
(map (lambda (li) (vau ide (& x) (vapply (lapply li (p p)) x ide))) l))))
let-rec (vau de (name_func body)
(let (names (filter_i (lambda (i x) (= 0 (% i 2))) name_func)
funcs (filter_i (lambda (i x) (= 1 (% i 2))) name_func)
overwrite_name (idx name_func (- (len name_func) 2)))
(eval (array let (concat (array overwrite_name (concat (array Y*) (map (lambda (f) (array lambda names f)) funcs)))
(lapply concat (map_i (lambda (i n) (array n (array idx overwrite_name i))) names)))
body) de)))
let-vrec (vau de (name_func body)
(let (names (filter_i (lambda (i x) (= 0 (% i 2))) name_func)
funcs (filter_i (lambda (i x) (= 1 (% i 2))) name_func)
overwrite_name (idx name_func (- (len name_func) 2)))
(eval (array let (concat (array overwrite_name (concat (array vY*) (map (lambda (f) (array lambda names f)) funcs)))
(lapply concat (map_i (lambda (i n) (array n (array idx overwrite_name i))) names)))
body) de)))
flat_map (lambda (f l)
(let (helper (rec-lambda recurse (f l n i)
(if (= i (len l))
n
(recurse f l (concat n (f (idx l i))) (+ i 1)))))
(helper f l (array) 0)))
flat_map_i (lambda (f l)
(let (helper (rec-lambda recurse (f l n i)
(if (= i (len l))
n
(recurse f l (concat n (f i (idx l i))) (+ i 1)))))
(helper f l (array) 0)))
; with all this, we make a destrucutring-capable let
let (let (
destructure_helper (rec-lambda recurse (vs i r)
(cond (= (len vs) i) r
(array? (idx vs i)) (let (bad_sym (str-to-symbol (str (idx vs i)))
;new_vs (flat_map_i (lambda (i x) (array x (array idx bad_sym i))) (slice (idx vs i) 1 -1))
new_vs (flat_map_i (lambda (i x) (array x (array idx bad_sym i))) (idx vs i))
)
(recurse (concat new_vs (slice vs (+ i 2) -1)) 0 (concat r (array bad_sym (idx vs (+ i 1))))))
true (recurse vs (+ i 2) (concat r (slice vs i (+ i 2))))
))) (vau de (vs b) (vapply let (array (destructure_helper vs 0 (array)) b) de)))
; and a destructuring-capable lambda!
only_symbols (rec-lambda recurse (a i) (cond (= i (len a)) true
(symbol? (idx a i)) (recurse a (+ i 1))
true false))
; Note that if macro_helper is inlined, the mapping lambdas will close over
; se, and then not be able to be taken in as values to the maps, and the vau
; will fail to partially evaluate away.
lambda (let (macro_helper (lambda (p b) (let (
sym_params (map (lambda (param) (if (symbol? param) param
(str-to-symbol (str param)))) p)
body (array let (flat_map_i (lambda (i x) (array (idx p i) x)) sym_params) b)
) (array vau sym_params body))))
(vau se (p b) (if (only_symbols p 0) (vapply lambda (array p b) se)
(wrap (eval (macro_helper p b) se)))))
; and rec-lambda - yes it's the same definition again
rec-lambda (vau se (n p b) (eval (array Y (array lambda (array n) (array lambda p b))) se))
nil (array)
or (let (macro_helper (rec-lambda recurse (bs i) (cond (= i (len bs)) false
(= (+ 1 i) (len bs)) (idx bs i)
true (array let (array 'tmp (idx bs i)) (array if 'tmp 'tmp (recurse bs (+ i 1)))))))
(vau se (& bs) (eval (macro_helper bs 0) se)))
and (let (macro_helper (rec-lambda recurse (bs i) (cond (= i (len bs)) true
(= (+ 1 i) (len bs)) (idx bs i)
true (array let (array 'tmp (idx bs i)) (array if 'tmp (recurse bs (+ i 1)) 'tmp)))))
(vau se (& bs) (eval (macro_helper bs 0) se)))
test17 (or false 1 "a" true)
test18 (and 1 "a" nil true)
monad (array 'write 1 "test_self_out2" (vau (written code) (array 'exit (or written code) test17 (or false nil 0) (and written code) test18 (and nil 0 false))))
)
monad
)
;(array 'write 1 "test_self_out2" (vau (written code) 7))
; end of all lets
))))))
; impl of let1
; this would be the macro style version (((
)) (vau de (s v b) (eval (array (array wrap (array vau (array s) b)) v) de)))
;)) (vau de (s v b) (eval (array (array vau (array s) b) (eval v de)) de)))
; impl of quote
)) (vau (x5) x5))

1
small_demo/small_vau_demo.kp
View File

@@ -1 +0,0 @@
(vau () (+ 1 2))

7
website/index.html
View File

@@ -10,6 +10,7 @@
<i>FOSS Fexprs: <a title="Kraken on GitHub" href="https://github.com/limvot/kraken">https://github.com/limvot/kraken</a></i>
<!--<button onclick="toggleTheme()" style="float: right;">Swap Theme</button>-->
<br>
<!--
<h3>Demo:</h3>
<div class="run_container">
<div class="editor" id="hello_editor">; Of course
@@ -20,16 +21,16 @@
<textarea class="output" id="hello_output">Output will appear here</textarea>
<button class="run_button" onclick="executeKraken(hello_editor_jar.toString(), 'hello_output')">Run</button> <br>
</div>
-->
<h3>Concept:</h3>
<ul>
<li> Minimal, purely functional Kernel/Scheme as core language, with Kernel/Vau calculus inspiration oblivating the need for non-reader macros (<a title="Kernel/Vau calculus thesis" href="https://web.wpi.edu/Pubs/ETD/Available/etd-090110-124904/unrestricted/jshutt.pdf">Kernel/Vau calculus thesis</a>)
<li> Partial evaluation to make fexprs fast (my PhD research! First paper on <a href="https://arxiv.org/abs/2303.12254">arXiv</a>)
<li> Partial evaluation (or now, maybe tracing JIT compilation) to make fexprs fast (my PhD research! First paper on <a href="https://arxiv.org/abs/2303.12254">arXiv</a>)
<li> Implement Type Systems as Macros (but using Fexprs instead of macros) (<a title="type systems as macros paper 1" href="http://www.ccs.neu.edu/home/stchang/pubs/ckg-popl2017.pdf">paper, up to System Fω</a>) (<a title="type systems as macros paper 2" href="https://www.ccs.neu.edu/home/stchang/pubs/cbtb-popl2020.pdf">second paper, up to dependent types</a>)
<li> Use fexprs to bootstrap more complex features, like delimited continuations
<li> Use above "type systems as fexprs" to add types and create a statically-typed language on top (with Algebraic Effects using the underlying delimited continuations, etc)
</ul>
<h3> About:</h3>
<p>This is my 3rd run at this Lisp concept, with Partial Evaluation to make fexprs fast forming the core of my current PhD research. <a href="https://miloignis.room409.xyz/">(tiny personal PhD website here)</a></p>
<p>This is my 4th run at this Lisp concept, with tracing JIT compilation to make fexprs fast forming the core of my current PhD research. <a href="https://miloignis.room409.xyz/">(tiny personal PhD website here)</a></p>
<h4>Vau/Kernel as simple core:</h4>
By constructing our core language on a very simple Vau/Kernel base, we can keep the base truely tiny, and build up normal Lisp functions and programming language features in the language itself. This should help implement other programming languages concisely, and will hopefully make optimization easier and more broadly applicable.
<br>

0
website/presentation.html → website/quals_presentation.html
View File

5
website/slides_to_add
View File

@@ -1,5 +0,0 @@
x lisp tree
x explain quote
x show fold's internals
x fix if0 primitive
_ partial evaluation

52
working_files/bf.kp
View File

@@ -1,52 +0,0 @@
(load-file "./k_prime_stdlib/prelude.kp")
; We don't have atoms built in, mutable arrays
; are our base building block. In order to make the
; following BF implementation nice, let's add atoms!
; They will be implmented as length 1 arrays with nice syntax for deref
(fun make-atom (x) [x])
(fun set-atom! (x y) (set-idx! x 0 y))
(fun get-atom (x) (idx x 0))
(add_grammar_rule 'form ["@" 'form] (lambda (_ x) `(get-atom ~x)))
; Now begin by defining our BF syntax & semantics
; Define our tokens as BF atoms
(add_grammar_rule 'bfs_atom ["<"] (lambda (_) '(set-atom! cursor (- @cursor 1))))
(add_grammar_rule 'bfs_atom [">"] (lambda (_) '(set-atom! cursor (+ @cursor 1))))
(add_grammar_rule 'bfs_atom ["\\+"] (lambda (_) '(set-idx! tape @cursor (+ (idx tape @cursor) 1))))
(add_grammar_rule 'bfs_atom ["-"] (lambda (_) '(set-idx! tape @cursor (- (idx tape @cursor) 1))))
(add_grammar_rule 'bfs_atom [","] (lambda (_) '(let (value (idx input @inptr))
(do (set-atom! inptr (+ 1 @inptr))
(set-idx! tape @cursor value)))))
(add_grammar_rule 'bfs_atom ["."] (lambda (_) '(set-atom! output (concat [(idx tape @cursor)] @output))))
; Define strings of BF atoms
(add_grammar_rule 'bfs ['bfs_atom *] (lambda (x) x))
; Add loop as an atom
; (note that closure cannot yet close over itself by value, so we pass it in)
(add_grammar_rule 'bfs_atom ["\\[" 'bfs "]"] (lambda (_ x _)
`(let (f (lambda (f)
(if (= 0 (idx tape @cursor))
nil
(do ,x (f f)))))
(f f))))
; For now, stick BFS rule inside an unambigious BFS block
; Also add setup code
(add_grammar_rule 'form ["bf" 'optional_WS "{" 'optional_WS 'bfs 'optional_WS "}"]
(lambda (_ _ _ _ x _ _)
`(lambda (input)
(let (
tape (array 0 0 0 0 0)
cursor (make-atom 0)
inptr (make-atom 0)
output (make-atom (array))
)
(do (println "beginning bfs") ,x (idx output 0))))))
; Let's try it out! This BF program prints the input 3 times
(println (bf { ,>+++[<.>-] } [1337]))
; we can also have it compile into our main program
(fun main () (do (println "BF: " (bf { ,>+++[<.>-] } [1337])) 0))

27
working_files/collections.kp
View File

@@ -1,27 +0,0 @@
(let (
foldl (let (helper (rec-lambda recurse (f z vs i) (if (= i (len (idx vs 0))) z
(recurse f (lapply f (cons z (map (lambda (x) (idx x i)) vs))) vs (+ i 1)))))
(lambda (f z & vs) (helper f z vs 0)))
foldr (let (helper (rec-lambda recurse (f z vs i) (if (= i (len (idx vs 0))) z
(lapply f (cons (recurse f z vs (+ i 1)) (map (lambda (x) (idx x i)) vs))))))
(lambda (f z & vs) (helper f z vs 0)))
reverse (lambda (x) (foldl (lambda (acc i) (cons i acc)) [] x))
zip (lambda (& xs) (lapply foldr (concat [(lambda (a & ys) (cons ys a)) []] xs)))
empty_dict []
put (lambda (m k v) (cons [k v] m))
get-value-helper (rec-lambda recurse (dict key i) (if (>= i (len dict))
(error (str key " not found in " dict))
(if (= key (idx (idx dict i) 0))
(idx (idx dict i) 1)
(recurse dict key (+ i 1)))))
get-value (lambda (dict key) (get-value-helper dict key 0))
add-dict-to-env (let (helper (rec-lambda recurse (env dict i)
(if (= i (len dict)) env
(recurse (eval [ [vau '_ [(idx (idx dict i) 0)] [ [vau 'inner [] 'inner] ] ] (idx (idx dict i) 1) ] env) dict (+ i 1)))))
(lambda (env dict) (helper env dict 0)))
)
(provide foldl foldr reverse zip empty_dict put get-value add-dict-to-env)
)

92
working_files/comp_wasm.kp
View File

@@ -1,92 +0,0 @@
(with_import "./wasm.kp"
(let (
_ (println "args" *ARGV*)
(_ _ out) (cond (!= (len *ARGV*) 3) (error "wrong number of params to comp_wasm (please provide out)")
true *ARGV*)
_ (println "out" out)
wasm_code
(module
(import "wasi_unstable" "path_open"
(func $path_open (param i32 i32 i32 i32 i32 i64 i64 i32 i32)
(result i32)))
(import "wasi_unstable" "fd_prestat_dir_name"
(func $fd_prestat_dir_name (param i32 i32 i32)
(result i32)))
(import "wasi_unstable" "fd_read"
(func $fd_read (param i32 i32 i32 i32)
(result i32)))
(import "wasi_unstable" "fd_write"
(func $fd_write (param i32 i32 i32 i32)
(result i32)))
(memory $mem 1)
(global $gi i32 (i32.const 8))
(global $gb (mut i64) (i64.const 9))
(table $tab 2 funcref)
;(table $tab2 8 16 funcref)
(data (i32.const 16) "HellH") ;; adder to put, then data
(func $start
(i32.store (i32.const 8) (i32.const 16)) ;; adder of data
(i32.store (i32.const 12) (i32.const 5)) ;; len of data
;; open file
(call $path_open
(i32.const 3) ;; file descriptor
(i32.const 0) ;; lookup flags
(i32.const 16) ;; path string *
(i32.load (i32.const 12)) ;; path string len
(i32.const 1) ;; o flags
(i64.const 66) ;; base rights
(i64.const 66) ;; inheriting rights
(i32.const 0) ;; fdflags
(i32.const 4) ;; opened fd out ptr
)
drop
(block $a
(block $b
(br $a)
(br_if $b (i32.const 3))
(loop $l
(br $a)
(br $l)
)
(_if $myif (i32.const 1)
(then
(i32.const 1)
drop
(br $b)
)
(else
(br $myif)
)
)
(_if $another (i32.const 1) (br $b))
(i32.const 1)
(_if $third (br $b))
(_if $fourth (br $fourth))
)
)
(call $fd_read
(i32.const 0) ;; file descriptor
(i32.const 8) ;; *iovs
(i32.const 1) ;; iovs_len
(i32.const 12) ;; nwritten, overwrite buf len with it
)
drop
;; print name
(call $fd_write
(i32.load (i32.const 4)) ;; file descriptor
(i32.const 8) ;; *iovs
(i32.const 1) ;; iovs_len
(i32.const 4) ;; nwritten
)
drop
)
(elem (i32.const 0) $start $start)
(export "memory" (memory $mem))
(export "_start" (func $start))
(start $start)
)
_ (write_file out (wasm_to_binary wasm_code))
return_code 0
) return_code ))

4
working_files/compile_for_web.sh
View File

@@ -1,4 +0,0 @@
#!/usr/bin/env bash
emcc ./k_prime.krak.c -o k_prime.html --embed-file k_prime_stdlib -s EXPORTED_FUNCTIONS='["_main"]' -s EXTRA_EXPORTED_RUNTIME_METHODS='["ccall", "cwrap"]' -s ERROR_ON_UNDEFINED_SYMBOLS=0
#emcc ./k_prime.krak.c -o k_prime.js -s EXPORTED_FUNCTIONS='["_fun_execute_code_starcharactercolonobkcbk_"]' -s EXTRA_EXPORTED_RUNTIME_METHODS='["ccall", "cwrap"]' -s ERROR_ON_UNDEFINED_SYMBOLS=0

141
working_files/damas_hindley_milner.kp
View File

@@ -1,141 +0,0 @@
(let (
; First quick lookup function, since maps are not built in
lookup (let (lookup-helper (rec-lambda recurse (dict key i) (if (>= i (len dict))
nil
(if (= key (idx (idx dict i) 0))
(idx (idx dict i) 1)
(recurse dict key (+ i 1))))))
(lambda (dict key) (lookup-helper dict key 0)))
contains (let (contains-helper (rec-lambda recurse (s x i) (cond (= i (len s)) false
(= x (idx s i)) true
true (recurse s x (+ i 1)))))
(lambda (s x) (contains-helper s x 0)))
applyST (rec-lambda recurse (S t)
(cond
(meta t) (with-meta (recurse (filter (lambda (x) (not (contains (meta t) x))) S) (with-meta t nil)) (meta t))
(int? t) (or (lookup S t) t)
(array? t) (map (lambda (x) (recurse S x)) t)
true t
))
applySE (lambda (S env) (map (lambda (x) [(idx x 0) (applyST S (idx x 1))]) env))
applySS (lambda (S_0 S_1) (let (r (concat S_0 (applySE S_0 S_1)) _ (println "applySS of " S_0 " and " S_1 " is " r)) r))
fvT (rec-lambda recurse (t) (cond (meta t) (filter (lambda (x) (not (contains (meta t) x))) (recurse (with-meta t nil)))
(int? t) [t]
(array? t) (flat_map recurse t)
true []
))
fvE (lambda (env) (flat_map (lambda (x) (fvT (idx x 1))) env))
varBind (lambda (a b) (cond
(= a b) []
(contains (fvT b) a) (error "Contains check failed for " a " and " b)
true [ [a b] ]))
mgu (rec-lambda mgu (a b) (let (r (cond
(and (array? a) (array? b) (= (len a) (len b))) ((rec-lambda recurse (S i) (if (= i (len a)) S
(recurse (applySS (mgu (idx a i) (idx b i)) S) (+ 1 i)))) [] 0)
(int? a) (varBind a b)
(int? b) (varBind b a)
(= a b) []
true (error (str "Cannot unify " a " and " b))
) _ (println "mgu of " a " and " b " is " r)) r))
generalize (lambda (env t) (do (println "generalize " t " with respect to " env) (let (free_T (fvT t)
free_E (fvE env))
(with-meta t (filter (lambda (x) (not (contains free_E x))) free_T)))))
instantiate (lambda (sigma idn) (do (println "instantiate " sigma " meta is " (meta sigma)) [(applyST (map_i (lambda (x i) [x (+ i idn)]) (meta sigma)) (with-meta sigma nil)) (+ idn (len (meta sigma)))]))
execute_type_com (lambda (tc e idn) (tc e idn))
simple_type_com (lambda (exp typ) (lambda (env idn) [exp typ [] idn]))
symbol_type_com (lambda (sym) (lambda (env idn) (let (
(t idn) (instantiate (lookup env sym) idn))
[sym t [] idn])))
call_type_com (lambda (innards)
(lambda (env idn)
(if (= 0 (len innards)) (error "stlc_error: Can't have a 0-length call")
(let (
(f_e f_t S_0 idn) (execute_type_com (idx innards 0) env idn)
across_params (rec-lambda recurse (env S idn params i out_e out_t)
(if (= i (len params)) [out_e out_t S idn]
(let (
(p_e p_t S_i idn) (execute_type_com (idx params i) env idn)
) (recurse (applySE S_i env) (applySS S_i S) idn params (+ 1 i) (concat out_e [p_e]) (concat out_t [p_t])))))
(p_es p_ts S_ps idn) (across_params (applySE S_0 env) [] idn (slice innards 1 -1) 0 [] [])
(r_t idn) [idn (+ 1 idn)]
S_f (mgu (applyST S_ps f_t) [p_ts r_t])
_ (println "mgu of " (applyST S_ps f_t) " and " [p_ts r_t] " produces substitution " S_f)
_ (println "For this call: " (cons f_e p_es) " the return type " r_t " transformed by " S_f " is " (applyST S_f r_t))
) [(cons f_e p_es) (applyST S_f r_t) (applySS S_f (applySS S_ps S_0)) idn])
)
)
)
lambda_type_com (lambda (p t b)
(lambda (env idn)
(let (
(p_t idn) (if (= nil t) [idn (+ 1 idn)]
[t idn])
extended_env (cons [p (with-meta p_t [])] env)
(b_e b_t S idn) (execute_type_com b extended_env idn)
f_e [lambda [p] b_e]
f_t [[ (applyST S p_t) ] b_t]
) [f_e f_t S idn])
)
)
let_type_com (lambda (x e1 e2)
(lambda (env0 idn)
(let (
(e1_e e1_t S_0 idn) (execute_type_com e1 env0 idn)
env1 (applySE S_0 env0)
e1_sigma (generalize env1 e1_t)
extended_env (cons [x e1_sigma] env1)
(e2_e e2_t S_1 idn) (execute_type_com e2 extended_env idn)
l_e [[lambda [x] e2_e] e1_e]
l_t e2_t
) [l_e l_t (applySS S_1 S_0) idn])
)
)
base_env [
[ '+ (with-meta [['int 'int] 'int] []) ]
[ '- (with-meta [['int 'int] 'int] []) ]
[ '< (with-meta [['int 'int] 'bool] []) ]
[ '> (with-meta [['int 'int] 'bool] []) ]
[ 'println (with-meta [['str] 'void] []) ]
]
current_env (vau de () de)
syms (map (lambda (x) (idx x 0)) base_env)
builtin_real_env (eval (concat (vapply provide syms root_env) [[current_env]]) empty_env)
top-level-erase-and-check (lambda (e) (let (
(e t S idn) (execute_type_com e base_env 0)
_ (println "Type of program is " t " with sub " S)
_ (println "expression code is " e)
) e))
stlc (concat basic_rules [
[ 'expr [ 'number ] (lambda (x) (simple_type_com x 'int)) ]
[ 'expr [ 'string ] (lambda (x) (simple_type_com x 'str)) ]
[ 'expr [ 'bool_nil_symbol ] (lambda (x) (cond (= x true) (simple_type_com x 'bool)
(= x false) (simple_type_com x 'bool)
(= x nil) (simple_type_com x 'nil)
true (symbol_type_com x)
)
) ]
[ 'expr [ "\\\\" 'WS * 'bool_nil_symbol 'WS * ":" 'WS * 'bool_nil_symbol 'WS * "." 'WS * 'expr ] (lambda (_ _ p _ _ _ t _ _ _ b) (lambda_type_com p t b)) ]
[ 'expr [ "\\\\" 'WS * 'bool_nil_symbol 'WS * "." 'WS * 'expr ] (lambda (_ _ p _ _ _ b) (lambda_type_com p nil b)) ]
[ 'expr [ "let" 'WS * 'bool_nil_symbol 'WS * "=" 'WS * 'expr 'WS * "in" 'WS * 'expr ] (lambda (_ _ x _ _ _ e1 _ _ _ e2) (let_type_com x e1 e2)) ]
[ 'call_innards [ 'WS * ] (lambda (_) []) ]
[ 'call_innards [ 'expr [ 'WS 'expr ] * ] (lambda (f r) (cons f (map (lambda (x) (idx x 1)) r))) ]
[ 'expr [ "\\(" 'call_innards "\\)" ] (lambda (_ innards _) (call_type_com innards)) ]
[ 'stlc_start_symbol [ 'WS * 'expr 'WS * ] (lambda (_ e _) [eval (top-level-erase-and-check e) builtin_real_env]) ]
]))
(provide stlc)
)

2
working_files/damas_hindley_milner_test.kp
View File

@@ -1,2 +0,0 @@
#lang (with_import "./types.kp" stlc) stlc_start_symbol
let id = \ x . x in ((id println) (id "woo"))

20
working_files/dlambda_test.kp
View File

@@ -1,20 +0,0 @@
(let (
dl1 (lambda ([a b]) (+ a b))
_ (println "dl1 " (dl1 [5 6]))
dl2 (lambda (a [b c]) (+ a b c))
_ (println "dl2 " (dl2 1 [5 6]))
dl3 (lambda ([a b] c) (+ a b c))
_ (println "dl3 " (dl3 [5 6] 2))
dl4 (lambda (a [b c] d) (+ a b c d))
_ (println "dl4 " (dl4 5 [5 6] 4))
dl5 (lambda (a) (+ a 1))
_ (println "dl5 " (dl5 1336))
dl6 (lambda (a b) (+ a b))
_ (println "dl6 " (dl6 1336 12))
dl7 (lambda () (+ 1 1))
_ (println "dl7 " (dl7))
fib (rec-lambda recurse (n [a b]) (if (= 0 n) a
(recurse (- n 1) [b (+ a b)])))
_ (println "fib 5 " (fib 5 [1 1]))
) nil)

51
working_files/even_odd.kp
View File

@@ -1,51 +0,0 @@
(do
(println "Double")
(let-rec (
even (lambda (n) (cond (= 0 n) true
(= 1 n) false
true (odd (- n 1))))
odd (lambda (n) (cond (= 0 n) false
(= 1 n) true
true (even (- n 1))))
)
(do
(println (even 7))
(println (even 8))
(println (odd 7))
(println (odd 8))
)
)
(println "Triple")
(let-rec (
first (lambda (n) (cond (= 0 n) true
(= 1 n) false
(= 2 n) false
true (third (- n 1))))
second (lambda (n) (cond (= 0 n) false
(= 1 n) true
(= 2 n) false
true (first (- n 1))))
third (lambda (n) (cond (= 0 n) false
(= 1 n) false
(= 2 n) true
true (second (- n 1))))
)
(do
(println)
(println (first 7))
(println (first 8))
(println (first 9))
(println)
(println (second 7))
(println (second 8))
(println (second 9))
(println)
(println (third 7))
(println (third 8))
(println (third 9))
)
)
)

8
working_files/fib-comp.kp
View File

@@ -1,8 +0,0 @@
(def! fib (fn* (n) (cond (= 0 n) 0
(= 1 n) 1
true (+ (fib (- n 1)) (fib (- n 2))))))
(def! main (fn* ()
(do
(let* (n 27)
(println "Fib(" n "): " (fib n)))
0)))

5
working_files/fib-interp.kp
View File

@@ -1,5 +0,0 @@
(def! fib (fn* (n) (cond (= 0 n) 0
(= 1 n) 1
true (+ (fib (- n 1)) (fib (- n 2))))))
(let* (n 27)
(println "Fib(" n "): " (fib n)))

17
working_files/fib.c
View File

@@ -1,17 +0,0 @@
#include <stdio.h>
int fib(int n) {
if (n == 0) {
return 0;
} else if (n == 1) {
return 1;
} else {
return fib(n-1) + fib(n-2);
}
}
int main(int argc, char** argv) {
int n = 27;
printf("Fib(%d): %d\n", n, fib(n));
return 0;
}

96
working_files/fungll.kp
View File

@@ -1,96 +0,0 @@
(with_import "./collections.kp"
(with_import "./rb.kp"
(let (
; Implementing "Purely Functional GLL Parsing"
; by L. Thomas van Binsbergena, Elizabeth Scott, Adrian Johnstone
; retrived from from http://ltvanbinsbergen.nl/publications/jcola-fgll.pdf
; discriptor is a triple of grammer-slot and 2 indicies of t-string
; corresponding to process
; <X::= a.b,l,k>
; I previously had this as nonterminal, rule-idx, idx into rule, l,r
; U - discriptors added to (worklist?), makes sure no duplicates added to "list"
; P - binary relation between pairs of commencments and right extants
; makes sure that later discoveries that use a sub-non-terminal that has already
; been processed can be completed since the sub-non-terminal won't be
; re-descended at the same index <s::=.d,k,k>
;
; a commencement is a pair of a nonterminal and a left extent (the arguemnts to
; descend, since that's what we're skipping) to a set of right extants
; G - binary relation between commencments and continuations, modified to include
; actional continuation.
; The normal continuation is a pair of as slot and a left extent.
; So <<X,k> -> <g,l>> in G, with a new are is combined to form
; discriptor <g,l,r> and BSR <g,l,k,r> whenever k,r are discovered for X
; Note we haven't finished things with the above P, since some subs of the form
; <s::=.d,k,k> or descriptors that follow them may not have been processed
; yet. When new Right extants are discovered, we must add descriptors
; <Y::=a's.b',l',r_j> and <X::as.b,l,rj> to R (if not in U) and add
; BSR elements <Y::=a's.b',l',k,r_j> and <X::=as.b,l,k,r_j> to Y
; Y - Our result BSR set!
; I've decided, a slot is [X [stff] int-for-dot]
id (lambda (sigma) sigma)
altStart (lambda (t s k c) id)
altOp (lambda (p q) (lambda (t s k c) (lcompose (p t s k c) (q t s [] k c))))
term_parser (lambda (t [X b i] l k c) (lambda (sigma)
(let (this_term (idx b (- i 1))
_ (println "term parser looking for " this_term " at position " k " in " t)
)
(if (and (<= (+ k (len this_term)) (len t)) (= this_term (slice t k (+ k (len this_term))))) ((c [[X b i] l (+ (len this_term) k)]) sigma)
sigma))))
; the extra lambda layer of indirection is so that
; recursive nonterminals can be made with rec-let, which
; only works on functions. So both term types get wrapped in
; an extra function which is evaluated in seqOp and parse
term (lambda (s) (lambda () [ s term_parser ]))
continue (lambda (BSR_element c) (lambda ([U G P Y])
(let (
[slot l k r] BSR_element
descriptor [slot l r]
(X b i) slot
Yp (if (or (!= 0 i) (= (len rhs) i)) (set-insert Y BSR_element)
Y)
Up (set-insert U descriptor)
) (if (set-contains? U descriptor) [U G P Yp]
((c descriptor) [Up G P Yp])))))
seqStart (lambda (t X b l c0) (continue [[X b 0] l l l] c0))
seqOp (lambda (p s_q) (lambda (t X b l c0) (let (
; see term discussion about extra lambda wrap
[s q] (s_q)
c1 (lambda ([[X b i] l k]) (let (
c2 (lambda ([slot l r]) (continue [slot l k r] c0))
) (q t [X b (+ 1 i)] l k c2)))
) (p t X (cons s b) l c1))))
cont_for (lambda (s p) (lambda ([[s d i] k r]) (lambda ([U G P Y]) (let (
composed (set-foldl (lambda (cp [g l c]) (lcompose cp (c [g l r]))) id (multimap-get G [s k]))
) (composed [U G (multimap-insert P [s k] r) Y])))))
nterm_parser (lambda (p) (lambda (t gram_slot l k c) (lambda ([U G P Y])
(let (
[X b i] gram_slot
s (idx b (- i 1))
R (multimap-get P [s k])
sigmap [U (multimap-insert G [s k] [gram_slot l c]) P Y]
) (if (= 0 (size R)) ((p t s k (cont_for s p)) sigmap)
(set-foldl (lambda (cp r) (lcompose cp (c [gram_slot l r]))) id R)
)))))
; see term discussion about extra lambda wrap
nterm (lambda (s p) (lambda () [ s (nterm_parser p) ]))
parse (lambda (s_f) (lambda (t)
(let (
; see term discussion about extra lambda wrap
[s f] (s_f)
X '__FUNGLL_UNIQUE_START_SYMBOL__
sigma [ set-empty multimap-empty multimap-empty set-empty ]
c (lambda (descriptor) (lambda (sigma) sigma))
[U G P Y] ((f t ['X [s] 1] 0 0 c) sigma)
) (set-foldl cons [] Y))))
)
(provide altStart altOp term seqStart seqOp nterm parse)
)))

48
working_files/fungll_test.kp
View File

@@ -1,48 +0,0 @@
(with_import "./fungll.kp"
(let (
_ (println "The a parser")
just_a_parser (parse (nterm 'A (altOp altStart (seqOp seqStart (term "a")))))
_ (println "parse result for a " (just_a_parser "a"))
_ (println "parse result for b " (just_a_parser "b"))
_ (println "parse result for aa " (just_a_parser "aa"))
_ (println "parse result for ba " (just_a_parser "ba"))
_ (println "parse result for ab " (just_a_parser "ab"))
_ (println "The aa parser")
just_aa_parser (parse (nterm 'A (altOp altStart (seqOp seqStart (term "aa")))))
_ (println "parse result for a " (just_aa_parser "a"))
_ (println "parse result for b " (just_aa_parser "b"))
_ (println "parse result for aa " (just_aa_parser "aa"))
_ (println "parse result for ba " (just_aa_parser "ba"))
_ (println "parse result for ab " (just_aa_parser "ab"))
_ (println "The a.a parser")
just_aa_parser (parse (nterm 'A (altOp altStart (seqOp (seqOp seqStart (term "a")) (term "a")))))
_ (println "parse result for a " (just_aa_parser "a"))
_ (println "parse result for b " (just_aa_parser "b"))
_ (println "parse result for aa " (just_aa_parser "aa"))
_ (println "parse result for ba " (just_aa_parser "ba"))
_ (println "parse result for ab " (just_aa_parser "ab"))
_ (println "The b|a.a parser")
just_aa_parser (parse (nterm 'A (altOp (altOp altStart (seqOp seqStart (term "b"))) (seqOp (seqOp seqStart (term "a")) (term "a")))))
_ (println "parse result for a " (just_aa_parser "a"))
_ (println "parse result for b " (just_aa_parser "b"))
_ (println "parse result for aa " (just_aa_parser "aa"))
_ (println "parse result for ba " (just_aa_parser "ba"))
_ (println "parse result for ab " (just_aa_parser "ab"))
_ (println "The a|a,A parser")
just_aa_parser (let-rec (
As (nterm 'A (altOp (altOp altStart (seqOp seqStart (term "a"))) (seqOp (seqOp (seqOp seqStart (term "a")) (term ",")) As)))
) (parse As))
_ (println "parse result for a " (just_aa_parser "a"))
_ (println "parse result for b " (just_aa_parser "b"))
_ (println "parse result for aa " (just_aa_parser "aa"))
_ (println "parse result for ba " (just_aa_parser "ba"))
_ (println "parse result for ab " (just_aa_parser "ab"))
_ (println "parse result for a,a " (just_aa_parser "a,a"))
_ (println "parse result for a,a,a " (just_aa_parser "a,a,a"))
) nil))

1
working_files/import_test.kp
View File

@@ -1 +0,0 @@
(let (a 123) (provide a))

425
working_files/index.html
View File

@@ -1,425 +0,0 @@
<!doctype html>
<html lang="en-us">
<meta charset="UTF-8">
<head>
<style>
h1, h2 ,h3 { line-height:1.2; }
body {
max-width: 45em;
margin: 1em auto;
padding: 0 .62em;
font: 1.2em/1.62 sans-serif;
}
th { text-align: center; }
th, td { padding: 0.5em; }
table, td {
border: 1px solid #333;
text-align: right;
}
thead, tfoot {
background-color: #000;
color: #fff;
}
#hello_editor { height: 7em; width: 70em; }
#hello_output { height: 7em; width: 70em; }
#prelude_editor { height: 54em; width: 70em; }
#prelude_output { height: 7em; width: 70em; }
#method_editor { height: 58em; width: 70em; }
#method_output { height: 7em; width: 70em; }
#bf_editor { height: 67em; width: 70em; }
#bf_output { height: 7em; width: 70em; }
#fib_editor { height: 8em; width: 70em; }
#fib_output { height: 7em; width: 70em; }
</style>
</head>
<body>
<header><h2>Nathan Braswell's Current Programming Language / Compiler Research</h2></header>
Repository: <a title="Kraken on GitHub" href="https://github.com/limvot/kraken">https://github.com/limvot/kraken</a>
<br> <br>
<b>Table of Contents:</b> <i>If you're impatient, jump to the code examples!</i>
<ul>
<li><a href="#concept">Concept</a>
<li><a href="#about">About</a>
<li><a href="#hello_example">Example: Hello World</a>
<li><a href="#vau_core">Vau as a core</a>
<li><a href="#method_example">Example: Implementing Methods</a>
<li><a href="#bf_example">Example: Embedding BF</a>
<li><a href="#next_steps">Next Steps</a>
</ul>
<a name="concept"/>
<h3>Concept:</h3>
<ul>
<li> Minimal, close to the metal Kernel/Scheme (operate on words, bytes, arrays) as AST / core language, with Kernel/Vau calculus inspiration oblivating the need for non-reader macros (<a title="Kernel/Vau calculus thesis" href="https://web.wpi.edu/Pubs/ETD/Available/etd-090110-124904/unrestricted/jshutt.pdf">Kernel/Vau calculus thesis</a>)
<li> Full Context-free (and eventually, context sensitive) reader macros using FUN-GLL (<a title="fun-gll paper" href="https://www.sciencedirect.com/science/article/pii/S2590118420300058">FUN-GLL paper</a>) to extend language's syntax dynamically
<li> Implement Type Systems as Macros (but using Vaus instead of macros) (<a title="type systems as macros paper 1" href="http://www.ccs.neu.edu/home/stchang/pubs/ckg-popl2017.pdf">paper, up to System Fω</a>) (<a title="type systems as macros paper 2" href="https://www.ccs.neu.edu/home/stchang/pubs/cbtb-popl2020.pdf">second paper, up to dependent types</a>)
<li> Use above "type systems as vaus" to create richer language and embed entire other programming languages (syntax, semantics, and type system) for flawless interop/FFI (C, Go, Lua, JS, etc)
<li> File is interpreted, and then if "main" exists it is compiled, spidering backwards to referenced functions and data (Allows interpreted code to do metaprogramming, dependency resolution, generate code, etc, which is then compiled)
<li> Regionalized Value State Dependence Graph as backend-IR, enabling simpler implementations of powerful optimizations (<a title="RSVDG paper" href="https://arxiv.org/pdf/1912.05036.pdf">RSVDG paper</a>) so that embedded languages have good performance when compiled with little code
</ul>
<a name="about"/>
<h3> About:</h3>
<p> Currently, I am bootstrapping this new core Lisp out of my prior compiler for my programming language, Kraken. I have implemented the first version of the FUN-GLL algorithm and have working vaus and context-free reader macros.
<p> The general flow is that the input files will be executed with the core Lisp interpreter, and if there is a "main" symbol defined the compiler emits C code for that function & all other functions & data that it references. In this way the language supports very powerful meta-programming at compile time, including adding syntax to the language, arbitrary computation, and importing other files, and then compiles into a static executable.
<p> Below are a few examples of using the vau / live grammar modification / context-free reader macros to implement basic methods as well as embed the BF language into the core Lisp. The core Lisp implementation has been compiled to WebAssembly and should be able to run in your browser. Feel free to make edits and play around below.
<br>
Note that the current implementation is inefficient, and sometimes has problems running in phone web browsers.
<a name="hello_example"/>
<h4>Runnable Example Code:</h4>
<button onclick="executeKraken(hello_editor.getValue(), 'hello_output')"><b>Run</b></button> <br>
<div id="hello_editor">; Of course
(println "Hello World")
; Just print 3
(println "Math works:" (+ 1 2))
</div>
<h4>Output:</h4>
<textarea id="hello_output">Output will appear here</textarea>
<a name="vau_core"/>
<h4>Vau/Kernel as simple core:</h4>
By constructing our core language on a very simple Vau/Kernel base, we can keep the base truely tiny, and build up normal Lisp functions and programming language features in the language itself. This should help implement other programming languages concisely, and will hopefully make optimization easier and more broadly applicable.
<br>
Below is the current prelude that adds quoting, quasiquoting, syntax for arrays and quoting/quasiquoting, do, if, let, and even lambda itself!
<br>
<button onclick="executeKraken(prelude_editor.getValue(), 'prelude_output')"><b>Run</b></button> <br>
<div id="prelude_editor">
(set! quote (vau _ (x) x))
(set! lambda (vau se (p b) (wrap (eval (array vau (quote _) p b) se))))
(set! current-env (vau de () de))
(set! fun (vau se (n p b) (eval (array set! n (array lambda p b)) se)))
; do_helper is basically mapping eval over statements, but the last one is in TCO position
; a bit of a hack, using cond to sequence (note the repitition of the eval in TCO position if it's last,
; otherwise the same eval in cond position, and wheather or not it returns a truthy value, it recurses in TCO position)
(fun do_helper (s i se) (cond (= i (len s)) nil
(= i (- (len s) 1)) (eval (idx s i) se)
(eval (idx s i) se) (do_helper s (+ i 1) se)
true (do_helper s (+ i 1) se)))
(set! do (vau se (& s) (do_helper s 0 se)))
(fun concat_helper (a1 a2 a3 i) (cond (< i (len a1)) (do (set-idx! a3 i (idx a1 i)) (concat_helper a1 a2 a3 (+ i 1)))
(< i (+ (len a1) (len a2))) (do (set-idx! a3 i (idx a2 (- i (len a1)))) (concat_helper a1 a2 a3 (+ i 1)))
true a3))
(fun concat (a1 a2) (concat_helper a1 a2 (array-with-len (+ (len a1) (len a2))) 0))
(add_grammar_rule (quote form) (quote ( "'" optional_WS form )) (vau de (_ _ f) (array quote (eval f de))))
(add_grammar_rule 'form '( "\\[" optional_WS space_forms optional_WS "\\]" ) (vau de (_ _ fs _ _) (concat (array array) (eval fs de))))
(fun vapply (f p ede) (eval (concat [f] p) ede))
(fun lapply (f p) (eval (concat [(unwrap f)] p) (current-env)))
(set! let1 (vau de (s v b) (eval [[vau '_ [s] b] (eval v de)] de)))
(set! let (vau de (vs b) (cond (= (len vs) 0) (eval b de) true (vapply let1 [(idx vs 0) (idx vs 1) [let (slice vs 2 -1) b]] de))))
(set! if (vau de (con than & else) (cond
(eval con de) (eval than de)
(> (len else) 0) (eval (idx else 0) de)
true nil)))
(fun map (f l)
(let (helper (lambda (f l n i recurse)
(if (= i (len l))
n
(do (set-idx! n i (f (idx l i)))
(recurse f l n (+ i 1) recurse)))))
(helper f l (array-with-len (len l)) 0 helper)))
(fun flat_map (f l)
(let (helper (lambda (f l n i recurse)
(if (= i (len l))
n
(recurse f l (concat n (f (idx l i))) (+ i 1) recurse))))
(helper f l (array) 0 helper)))
(fun map_with_idx (f l)
(let (helper (lambda (f l n i recurse)
(if (= i (len l))
n
(do (set-idx! n i (f i (idx l i)))
(recurse f l n (+ i 1) recurse)))))
(helper f l (array-with-len (len l)) 0 helper)))
(fun print_through (x) (do (println x) x))
(fun is_pair? (x) (and (array? x) (> (len x) 0)))
(set! quasiquote (vau de (x)
(cond (is_pair? x)
(cond (and (symbol? (idx x 0)) (= (get-text (idx x 0)) "unquote"))
(eval (idx x 1) de)
true
(cond (and (is_pair? (idx x 0)) (symbol? (idx (idx x 0) 0)) (= (get-text (idx (idx x 0) 0)) "splice-unquote"))
(concat (eval (idx (idx x 0) 1) de) (vapply quasiquote [(slice x 1 -1)] de))
true
(concat [(vapply quasiquote [(idx x 0)] de)] (vapply quasiquote [(slice x 1 -1)] de))))
true x)))
(add_grammar_rule 'form '("`" optional_WS form) (lambda (_ _ f) ['quasiquote f]))
(add_grammar_rule 'form '("~" optional_WS form) (lambda (_ _ f) ['unquote f]))
(add_grammar_rule 'form '("," optional_WS form) (lambda (_ _ f) ['splice-unquote f]))
(println "now with both array and quasiquote syntax, check out " `(1 2 3 ~(+ 7 8) ,[ 5 6 7]))
</div>
<h4>Output:</h4>
<textarea id="prelude_output">Output will appear here</textarea>
<a name="method_example"/>
<h4>Method Example:</h4>
Let's use our meta system (attaching objects to other objects) to implement basic objects/methods, a new lambda syntax, a new block syntax, and string interpolation!
We will attach a array of alternating symbols / functions (to make this example simple, since maps aren't built in) to our data as the meta, then look up methods on it when we perform a call. The add_grammar_rule function modifies the grammar/parser currently being used to parse the file and operates as a super-powerful reader macro. We use it in this code to add a rule that transforms <pre><code>a.b(c, d)</code></pre> into <pre><code>(method-call a 'b c d)</code></pre> where method-call is the function that looks up the symbol 'b on the meta object attached to a and calls it with the rest of the parameters.
Note also the block ({}) syntax that translates to nested do/let expressions, the nicer lambda syntax, and the string interpolation (that even works nested!).
<br>
<button onclick="executeKraken(method_editor.getValue(), 'method_output')"><b>Run</b></button>
<br>
<div id="method_editor">
; Load prelude so we get fun, lambda, if, quoting, etc
(load-file "./k_prime_stdlib/prelude.kp")
; First quick lookup function, since maps are not built in
(fun get-value-helper (dict key i) (if (>= i (len dict))
nil
(if (= key (idx (idx dict i) 0))
(idx (idx dict i) 1)
(get-value-helper dict key (+ i 1)))))
(fun get-value (dict key) (get-value-helper dict key 0))
; Our actual method call function
(fun method-call (object method & arguments) (let (method_fn (get-value (meta object) method))
(if (= method_fn nil)
(println "no method " method)
(lapply method_fn (concat [object] arguments)))))
; Some nice syntactic sugar for method calls
; No params
(add_grammar_rule 'form ['form "\\." 'atom]
(lambda (o _ m) `(method-call ~o '~m)))
; params
(add_grammar_rule 'form ['form "\\." 'atom 'optional_WS "\\(" 'optional_WS 'space_forms 'optional_WS "\\)"]
(lambda (o _ m _ _ _ p _ _) `(method-call ~o '~m ,p)))
; object creation
(fun make_constructor (members methods)
(eval `(lambda ~members
(with-meta [,members]
[,(map_with_idx (lambda (i x) [array `'~x (lambda (o) (idx o i))]) members)
,(map (lambda (x) [array `'~(idx x 0) (idx x 1)]) methods)]))))
; object syntax
(add_grammar_rule 'form ["obj" 'WS 'atom "\\(" ['optional_WS 'atom] * 'optional_WS "\\)" 'optional_WS "{" 'optional_WS ['atom 'optional_WS 'form 'optional_WS] * "}"] (lambda (_ _ name _ members _ _ _ _ _ methods _)
`(set! ~name (make_constructor [,(map (lambda (x) `'~(idx x 1)) members)]
[,(map (lambda (x) `['~(idx x 0) ~(idx x 2)]) methods)]))))
; Lambda syntax
(add_grammar_rule 'form ["\\|" 'optional_WS [ 'atom 'optional_WS ] * "\\|" 'optional_WS 'form ]
(lambda (_ _ params _ _ body) `(lambda (,(map (lambda (x) (idx x 0)) params)) ~body)))
; {} body translated to do and let
(add_grammar_rule 'block_member [ 'form ] |x| [x])
(add_grammar_rule 'block_member [ "let" 'optional_WS 'atom 'optional_WS "=" 'optional_WS 'form ]
|_ _ name _ _ _ rhs| `(~name ~rhs))
(fun construct_body (is_do current to_add i)
(if (> (len to_add) i)
(cond (and is_do (= (len (idx to_add i)) 1)) (construct_body true (concat current [(idx (idx to_add i) 0)]) to_add (+ i 1))
(= (len (idx to_add i)) 1) (concat current [(construct_body true [do (idx (idx to_add i) 0)] to_add (+ i 1))])
true (concat current [(construct_body false [let [(idx (idx to_add i) 0) (idx (idx to_add i) 1)] ] to_add (+ i 1))]))
current))
(add_grammar_rule 'form ["{" 'optional_WS [ 'block_member 'optional_WS ] * "}"]
|_ _ inner _| (construct_body true [do] (map |x| (idx x 0) inner) 0))
; Call functions with function first, c style (notice no whitespace)
(add_grammar_rule 'form [ 'form 'call_form ] |f ps| (concat [f] ps))
; fun syntax
(add_grammar_rule 'form [ "fun" 'WS 'atom 'optional_WS "\\(" 'optional_WS [ 'atom 'optional_WS ] * "\\)" 'optional_WS 'form ]
|_ _ name _ _ _ params _ _ body| `(fun ~name (,(map |x| (idx x 0) params)) ~body))
; string interpolation
fun remove_dollar(done to_do i j) (cond (>= j (- (len to_do) 2)) (str done (slice to_do i -1))
(= "\\$" (slice to_do j (+ j 2))) (remove_dollar (str done (slice to_do i j) "$") to_do (+ j 2) (+ j 2))
true (remove_dollar done to_do i (+ j 1)))
fun fixup_str_parts(s) (remove_dollar "" (slice s 0 -2) 0 0)
(add_grammar_rule 'form [ "$\"" [ "(#|[%-[]| |[]-~]|(\\\\)|(\\n)|(\\t)|(\\*)|(\\\\$)|
|[ -!]|(\\\\\"))*$" 'form ] * "(#|[%-[]| |[]-~]|(\\\\)|(\\n)|(\\t)|(\\*)|(\\\\$)|
|[ -!]|(\\\\\"))*\"" ]
|_ string_form_pairs end| `(str ,( flat_map |x| [ (fixup_str_parts (idx x 0)) (idx x 1) ] string_form_pairs) ~(fixup_str_parts end)))
(println $"unu |\$| $$"inner $(+ 1 2) post-inner" sual")
obj Point( x y ) {
add |self other| { Point((+ self.x other.x) (+ self.y other.y)) }
sub |self other| { Point((- self.x other.x) (- self.y other.y)) }
to_str |self| { str("x: " self.x ", y: " self.y) }
}
fun say_hi(name) {
println("hayo" name)
}
fun test() {
let plus_1 = |x| (+ x 1)
let a = 1
let b = plus_1(a)
println("some" b)
say_hi("Marcus")
let p1 = Point(1 2)
let p2 = Point(3 4)
let p3 = p1.add(p2)
let p4 = p1.sub(p2)
println("p1:" p1.to_str)
println("p2:" p2.to_str)
println("p3:" p3.to_str)
println("p4:" p4.to_str)
(+ a b)
}
println("Test result is" test())
</div>
<h4>Output: </h4>
<textarea id="method_output">Output will appear here</textarea>
<a name="bf_example"/>
<h4>More Complicated Example: BF as an embedded language</h4>
<button onclick="executeKraken(bf_editor.getValue(), 'bf_output')"><b>Run</b></button> <br>
<div id="bf_editor">
(load-file "./k_prime_stdlib/prelude.kp")
; We don't have atoms built in, mutable arrays
; are our base building block. In order to make the
; following BF implementation nice, let's add atoms!
; They will be implmented as length 1 arrays with nice syntax for deref
(fun make-atom (x) [x])
(fun set-atom! (x y) (set-idx! x 0 y))
(fun get-atom (x) (idx x 0))
(add_grammar_rule 'form ["@" 'form] (lambda (_ x) `(get-atom ~x)))
; Now begin by defining our BF syntax & semantics
; Define our tokens as BF atoms
(add_grammar_rule 'bfs_atom ["<"] (lambda (_) '(set-atom! cursor (- @cursor 1))))
(add_grammar_rule 'bfs_atom [">"] (lambda (_) '(set-atom! cursor (+ @cursor 1))))
(add_grammar_rule 'bfs_atom ["\\+"] (lambda (_) '(set-idx! tape @cursor (+ (idx tape @cursor) 1))))
(add_grammar_rule 'bfs_atom ["-"] (lambda (_) '(set-idx! tape @cursor (- (idx tape @cursor) 1))))
(add_grammar_rule 'bfs_atom [","] (lambda (_) '(let (value (idx input @inptr))
(do (set-atom! inptr (+ 1 @inptr))
(set-idx! tape @cursor value)))))
(add_grammar_rule 'bfs_atom ["."] (lambda (_) '(set-atom! output (concat [(idx tape @cursor)] @output))))
; Define strings of BF atoms
(add_grammar_rule 'bfs ['bfs_atom *] (lambda (x) x))
; Add loop as an atom
; (note that closure cannot yet close over itself by value, so we pass it in)
(add_grammar_rule 'bfs_atom ["\\[" 'bfs "]"] (lambda (_ x _)
`(let (f (lambda (f)
(if (= 0 (idx tape @cursor))
nil
(do ,x (f f)))))
(f f))))
; For now, stick BFS rule inside an unambigious BFS block
; Also add setup code
(add_grammar_rule 'form ["bf" 'optional_WS "{" 'optional_WS 'bfs 'optional_WS "}"]
(lambda (_ _ _ _ x _ _)
`(lambda (input)
(let (
tape (array 0 0 0 0 0)
cursor (make-atom 0)
inptr (make-atom 0)
output (make-atom (array))
)
(do (println "beginning bfs") ,x (idx output 0))))))
; Let's try it out! This BF program prints the input 3 times
(println (bf { ,>+++[<.>-] } [1337]))
; we can also have it compile into our main program
(fun main () (do (println "BF: " (bf { ,>+++[<.>-] } [1337])) 0))
</div>
<h4>Output: </h4>
<textarea id="bf_output">Output will appear here</textarea>
<a name="benchmarks"/>
<!--<h3>Performance Benchmarks</h3>-->
<!--<p>Performance is quite poor (for the interpreter mainly, the C compiler seems to be smart enough to make even the very inefficient generated C code fast), as almost no work has gone into it as of yet.-->
<!--We are currently focusing on the FUN-GLL macros and creating a more fully-featured language on top of the core Lisp using them. We will focus more on performance with the implementation of the functional persistent data structures and the self-hosting rewrite, and performance will be the main focus of the RVSDG IR part of the project.-->
<!--<p> Even so, it is worth keeping a rough estimate of performance in mind. For this, we have compiled a very basic benchmark below, with more benchmark programs (sorting, etc) to be included as the language gets developed:-->
<!--<br>-->
<!--<table>-->
<!--<thead>-->
<!--<tr>-->
<!--<th></th>-->
<!--<th>Core Lisp Interpreter</th>-->
<!--<th>Core Lisp Compiled to C</th>-->
<!--<th>Hand-written C</th>-->
<!--</tr>-->
<!--</thead>-->
<!--<tbody>-->
<!--<tr>-->
<!--<td><b>Fibonacci(27)</b></td>-->
<!--<td>51.505s</td>-->
<!--<td>0.007s</td>-->
<!--<td>0.002s</td>-->
<!--</tr>-->
<!--</tbody>-->
<!--</table>-->
<!--<br>-->
<!--Here is the core Lisp code run / compiled by the above test, which you can run in your web browser. The hand-written C code is an exact translation of this into idiomatic C.-->
<!--<br><i>Note: N is lowered in the web demo so WebAssembly doesn't run out of memory.</i>-->
<!--<a name="fib_example"/>-->
<!--<h4>Fibonacci:</h4>-->
<!--<button onclick="executeKraken(fib_editor.getValue(), 'fib_output')"><b>Run</b></button> <br>-->
<!--<div id="fib_editor">(def! fib (fn* (n) (cond (= 0 n) 0-->
<!--(= 1 n) 1-->
<!--true (+ (fib (- n 1)) (fib (- n 2))))))-->
<!--(let* (n 16)-->
<!--(println "Fib(" n "): " (fib n)))-->
<!--</div>-->
<!--<h4>Output:</h4>-->
<!--<textarea id="fib_output">Output will appear here</textarea>-->
<a name="next_steps"/>
<h3>Next Steps</h3>
<ul>
<li> Implement persistent functional data structures
<ul>
<li> Hash Array-Mapped Trie (HAMT) / Relaxed Radix Balance Tree (RRB-Tree)
<li> Hash Map based on the above
<li> Hash Set based on the above
</ul>
<li> Prototype Type Systems as Macros, may require macro system rewrite/upgrade
<li> Sketch out Kraken language on top of core Lisp, includes basic Hindley-Milner type system implemented with Macros and above data structures
<li> Re-self-host using functional approach in above Kraken language
<li> Use Type System Macros to implement automatic transient creation on HAMT/RBB-Tree as an optimization
<li> Implement RVSDG IR and develop best bang-for-buck optimizations using it
</ul>
<script type="text/javascript" src="https://cdnjs.cloudflare.com/ajax/libs/ace/1.4.11/ace.min.js"></script>
<script>
ace.config.set('basePath', 'https://cdnjs.cloudflare.com/ajax/libs/ace/1.4.11/')
var hello_editor = ace.edit("hello_editor")
var prelude_editor = ace.edit("prelude_editor")
var method_editor = ace.edit("method_editor")
var bf_editor = ace.edit("bf_editor")
//var fib_editor = ace.edit("fib_editor")
//for (let editor of [hello_editor, method_editor, bf_editor, fib_editor]) {
for (let editor of [hello_editor, prelude_editor, method_editor, bf_editor]) {
editor.session.setMode("ace/mode/clojure")
editor.setOption("displayIndentGuides", false)
editor.setShowPrintMargin(false)
}
var output_name = ""
var Module = {
noInitialRun: true,
onRuntimeInitialized: () => {
},
print: txt => {
document.getElementById(output_name).value += txt + "\n";
},
printErr: txt => {
document.getElementById(output_name).value += "STDERR:[" + txt + "]\n";
}
};
function executeKraken(code, new_output_name) {
output_name = new_output_name
document.getElementById(new_output_name).value = "running...\n";
Module.callMain(["-C", code]);
}
</script>
<script type="text/javascript" src="k_prime.js"></script>
</body>
</html>

100
working_files/k_prime_stdlib/method.kp
View File

@@ -1,100 +0,0 @@
; First quick lookup function, since maps are not built in
(fun get-value-helper (dict key i) (if (>= i (len dict))
nil
(if (= key (idx (idx dict i) 0))
(idx (idx dict i) 1)
(get-value-helper dict key (+ i 1)))))
(fun get-value (dict key) (get-value-helper dict key 0))
; Our actual method call function
(fun method-call (object method & arguments) (let (method_fn (get-value (meta object) method))
(if (= method_fn nil)
(println "no method " method)
(lapply method_fn (concat [object] arguments)))))
; Some nice syntactic sugar for method calls
; No params
(add_grammar_rule 'form ['form "\\." 'atom]
(lambda (o _ m) `(method-call ~o '~m)))
; params
(add_grammar_rule 'form ['form "\\." 'atom 'optional_WS "\\(" 'optional_WS 'space_forms 'optional_WS "\\)"]
(lambda (o _ m _ _ _ p _ _) `(method-call ~o '~m ,p)))
; object creation
(fun make_constructor (members methods)
(eval `(lambda ~members
(with-meta [,members]
[,(map_with_idx (lambda (i x) [array `'~x (lambda (o) (idx o i))]) members)
,(map (lambda (x) [array `'~(idx x 0) (idx x 1)]) methods)]))))
; object syntax
(add_grammar_rule 'form ["obj" 'WS 'atom "\\(" ['optional_WS 'atom] * 'optional_WS "\\)" 'optional_WS "{" 'optional_WS ['atom 'optional_WS 'form 'optional_WS] * "}"] (lambda (_ _ name _ members _ _ _ _ _ methods _)
`(set! ~name (make_constructor [,(map (lambda (x) `'~(idx x 1)) members)]
[,(map (lambda (x) `['~(idx x 0) ~(idx x 2)]) methods)]))))
; Lambda syntax
(add_grammar_rule 'form ["\\|" 'optional_WS [ 'atom 'optional_WS ] * "\\|" 'optional_WS 'form ]
(lambda (_ _ params _ _ body) `(lambda (,(map (lambda (x) (idx x 0)) params)) ~body)))
; {} body translated to do and let
(add_grammar_rule 'block_member [ 'form ] |x| [x])
(add_grammar_rule 'block_member [ "let" 'optional_WS 'atom 'optional_WS "=" 'optional_WS 'form ]
|_ _ name _ _ _ rhs| `(~name ~rhs))
(fun construct_body (is_do current to_add i)
(if (> (len to_add) i)
(cond (and is_do (= (len (idx to_add i)) 1)) (construct_body true (concat current [(idx (idx to_add i) 0)]) to_add (+ i 1))
(= (len (idx to_add i)) 1) (concat current [(construct_body true [do (idx (idx to_add i) 0)] to_add (+ i 1))])
true (concat current [(construct_body false [let [(idx (idx to_add i) 0) (idx (idx to_add i) 1)] ] to_add (+ i 1))]))
current))
(add_grammar_rule 'form ["{" 'optional_WS [ 'block_member 'optional_WS ] * "}"]
|_ _ inner _| (construct_body true [do] (map |x| (idx x 0) inner) 0))
; Call functions with function first, c style (notice no whitespace)
(add_grammar_rule 'form [ 'form 'call_form ] |f ps| (concat [f] ps))
; fun syntax
(add_grammar_rule 'form [ "fun" 'WS 'atom 'optional_WS "\\(" 'optional_WS [ 'atom 'optional_WS ] * "\\)" 'optional_WS 'form ]
|_ _ name _ _ _ params _ _ body| `(fun ~name (,(map |x| (idx x 0) params)) ~body))
; string interpolation
fun remove_dollar(done to_do i j) (cond (>= j (- (len to_do) 2)) (str done (slice to_do i -1))
(= "\\$" (slice to_do j (+ j 2))) (remove_dollar (str done (slice to_do i j) "$") to_do (+ j 2) (+ j 2))
true (remove_dollar done to_do i (+ j 1)))
fun fixup_str_parts(s) (remove_dollar "" (slice s 0 -2) 0 0)
(add_grammar_rule 'form [ "$\"" [ "(#|[%-[]| |[]-~]|(\\\\)|(\\n)|(\\t)|(\\*)|(\\\\$)|
|[ -!]|(\\\\\"))*$" 'form ] * "(#|[%-[]| |[]-~]|(\\\\)|(\\n)|(\\t)|(\\*)|(\\\\$)|
|[ -!]|(\\\\\"))*\"" ]
|_ string_form_pairs end| `(str ,( flat_map |x| [ (fixup_str_parts (idx x 0)) (idx x 1) ] string_form_pairs) ~(fixup_str_parts end)))
(println $"unu |\$| $$"inner $(+ 1 2) post-inner" sual")
obj Point( x y ) {
add |self other| { Point((+ self.x other.x) (+ self.y other.y)) }
sub |self other| { Point((- self.x other.x) (- self.y other.y)) }
to_str |self| { str("x: " self.x ", y: " self.y) }
}
fun say_hi(name) {
println("hayo" name)
}
fun test() {
let plus_1 = |x| (+ x 1)
let a = 1
let b = plus_1(a)
println("some" b)
say_hi("Marcus")
let p1 = Point(1 2)
let p2 = Point(3 4)
let p3 = p1.add(p2)
let p4 = p1.sub(p2)
println("p1:" p1.to_str)
println("p2:" p2.to_str)
println("p3:" p3.to_str)
println("p4:" p4.to_str)
(+ a b)
}
println("Test result is" test())

82
working_files/k_prime_stdlib/prelude.kp
View File

@@ -1,82 +0,0 @@
(set! quote (vau _ (x) x))
(set! lambda (vau se (p b) (wrap (eval (array vau (quote _) p b) se))))
(set! current-env (vau de () de))
(set! fun (vau se (n p b) (eval (array set! n (array lambda p b)) se)))
; do_helper is basically mapping eval over statements, but the last one is in TCO position
; a bit of a hack, using cond to sequence (note the repitition of the eval in TCO position if it's last,
; otherwise the same eval in cond position, and wheather or not it returns a truthy value, it recurses in TCO position)
(fun do_helper (s i se) (cond (= i (len s)) nil
(= i (- (len s) 1)) (eval (idx s i) se)
(eval (idx s i) se) (do_helper s (+ i 1) se)
true (do_helper s (+ i 1) se)))
(set! do (vau se (& s) (do_helper s 0 se)))
(fun concat_helper (a1 a2 a3 i) (cond (< i (len a1)) (do (set-idx! a3 i (idx a1 i)) (concat_helper a1 a2 a3 (+ i 1)))
(< i (+ (len a1) (len a2))) (do (set-idx! a3 i (idx a2 (- i (len a1)))) (concat_helper a1 a2 a3 (+ i 1)))
true a3))
(fun concat (a1 a2) (concat_helper a1 a2 (array-with-len (+ (len a1) (len a2))) 0))
(add_grammar_rule (quote form) (quote ( "'" optional_WS form )) (vau de (_ _ f) (array quote (eval f de))))
(add_grammar_rule 'form '( "\\[" optional_WS space_forms optional_WS "\\]" ) (vau de (_ _ fs _ _) (concat (array array) (eval fs de))))
(fun vapply (f p ede) (eval (concat [f] p) ede))
(fun lapply (f p) (eval (concat [(unwrap f)] p) (current-env)))
(set! let1 (vau de (s v b) (eval [[vau '_ [s] b] (eval v de)] de)))
(set! let (vau de (vs b) (cond (= (len vs) 0) (eval b de) true (vapply let1 [(idx vs 0) (idx vs 1) [let (slice vs 2 -1) b]] de))))
(set! if (vau de (con than & else) (cond
(eval con de) (eval than de)
(> (len else) 0) (eval (idx else 0) de)
true nil)))
(fun map (f l)
(let (helper (lambda (f l n i recurse)
(if (= i (len l))
n
(do (set-idx! n i (f (idx l i)))
(recurse f l n (+ i 1) recurse)))))
(helper f l (array-with-len (len l)) 0 helper)))
(fun flat_map (f l)
(let (helper (lambda (f l n i recurse)
(if (= i (len l))
n
(recurse f l (concat n (f (idx l i))) (+ i 1) recurse))))
(helper f l (array) 0 helper)))
(fun map_with_idx (f l)
(let (helper (lambda (f l n i recurse)
(if (= i (len l))
n
(do (set-idx! n i (f i (idx l i)))
(recurse f l n (+ i 1) recurse)))))
(helper f l (array-with-len (len l)) 0 helper)))
(fun print_through (x) (do (println x) x))
(fun is_pair? (x) (and (array? x) (> (len x) 0)))
(set! quasiquote (vau de (x)
(cond (is_pair? x)
(cond (and (symbol? (idx x 0)) (= (get-text (idx x 0)) "unquote"))
(eval (idx x 1) de)
true
(cond (and (is_pair? (idx x 0)) (symbol? (idx (idx x 0) 0)) (= (get-text (idx (idx x 0) 0)) "splice-unquote"))
(concat (eval (idx (idx x 0) 1) de) (vapply quasiquote [(slice x 1 -1)] de))
true
(concat [(vapply quasiquote [(idx x 0)] de)] (vapply quasiquote [(slice x 1 -1)] de))))
true x)))
(add_grammar_rule 'form '("`" optional_WS form) (lambda (_ _ f) ['quasiquote f]))
(add_grammar_rule 'form '("~" optional_WS form) (lambda (_ _ f) ['unquote f]))
(add_grammar_rule 'form '("," optional_WS form) (lambda (_ _ f) ['splice-unquote f]))
(set! Y (lambda (f)
((lambda (x) (x x))
(lambda (x) (f (lambda (& y) (lapply (x x) y)))))))
(set! vY (lambda (f)
((lambda (x) (x x))
(lambda (x) (f (vau de (& y) (vapply (x x) y de)))))))
(set! rep (Y (lambda (recurse) (wrap (vau de ()
(do (println (eval (read-string (get_line "> ")) de)) (recurse)))))))

32
working_files/match.kp
View File

@@ -1,32 +0,0 @@
(with_import "./collections.kp"
(let (
match (vau de (x & cases) (let (
x (eval x de)
evaluate_case (rec-lambda recurse (name_dict x c) (cond
; an explicit nil name_dict case allows us to simply fold over recurse in the array case later
(nil? name_dict) nil
(symbol? c) (put name_dict c x)
(and (int? x) (int? c) (= x c)) name_dict
(and (string? x) (string? c) (= x c)) name_dict
(and (bool? x) (bool? c) (= x c)) name_dict
(and (combiner? x) (combiner? c) (= x c)) name_dict
; check for invocation of quote directly
; not necessarily ideal if they define their own quote or something
(and (symbol? x) (array? c) (= 2 (len c)) (= quote (idx c 0)) (= x (idx c 1))) name_dict
; ditto with above, but with unquote to allow matching against the *value* of variables
(and (array? c) (= 2 (len c)) (= 'unquote (idx c 0)) (= x (eval (idx c 1) de))) name_dict
; ditto with above, but with array. Also note this means you have to use '[' and ']' as calling
; array explicitly will give you the symbol array instead...
(and (array? x) (array? c) (= (+ 1 (len x)) (len c)) (= array (idx c 0))) (foldl recurse name_dict x (slice c 1 -1))
true nil
))
iter (rec-lambda recurse (x i cases) (if (>= i (len cases)) (error "none of match arms matched!")
(let ( mapping (evaluate_case empty_dict x (idx cases i)))
(if (!= nil mapping) (eval (idx cases (+ i 1)) (add-dict-to-env de mapping))
(recurse x (+ i 2) cases)))))
) (iter x 0 cases)))
)
(provide match)
))

49
working_files/match_test.kp
View File

@@ -1,49 +0,0 @@
(with_import "./match.kp"
(do
(println "first "
(match 1
1 true
a (+ a 1)
))
(println "second "
(match 3
1 true
a (+ a 1)
))
(println "third "
(match "str"
1 true
"str" "It was a string!"
a (+ a 1)
))
(println "fourth "
(match [ 1337 "str" ]
1 true
"str" "It was a string!"
[ 1337 "str" ] "matched an array of int str"
a (+ a 1)
))
(println "fifth "
(match [ 1337 "str" 'sy ]
1 true
"str" "It was a string!"
[ 1337 "str" 'sy ] "matched an array of int str symbol"
a (+ a 1)
))
(println "sixth "
(match [ 1337 "str" 'walla + 11 false 'kraken [ 'inner 'middle 'end ] [ 'inner1 'middle1 'end1 ] ]
1 true
"str" "It was a string!"
[ 1337 "str" 'walla + a false b [ 'inner c 'end ] d ] (str "matched, and got " a b c d)
a (+ a 1)
))
(println "seventh "
(let (b 2)
(match [ 1337 [ 1 2 3] 11 ]
1 true
"str" "It was a string!"
[ 1337 [ a ~b c] 11 ] (str "matched, and got " a c " while checking based on inserted " b)
a "sigh, failed to match"
)))
))

103
working_files/method.kp
View File

@@ -1,103 +0,0 @@
; Load prelude so we get fun, lambda, if, quoting, etc
(load-file "./k_prime_stdlib/prelude.kp")
; First quick lookup function, since maps are not built in
(fun get-value-helper (dict key i) (if (>= i (len dict))
nil
(if (= key (idx (idx dict i) 0))
(idx (idx dict i) 1)
(get-value-helper dict key (+ i 1)))))
(fun get-value (dict key) (get-value-helper dict key 0))
; Our actual method call function
(fun method-call (object method & arguments) (let (method_fn (get-value (meta object) method))
(if (= method_fn nil)
(println "no method " method)
(lapply method_fn (concat [object] arguments)))))
; Some nice syntactic sugar for method calls
; No params
(add_grammar_rule 'form ['form "\\." 'atom]
(lambda (o _ m) `(method-call ~o '~m)))
; params
(add_grammar_rule 'form ['form "\\." 'atom 'optional_WS "\\(" 'optional_WS 'space_forms 'optional_WS "\\)"]
(lambda (o _ m _ _ _ p _ _) `(method-call ~o '~m ,p)))
; object creation
(fun make_constructor (members methods)
(eval `(lambda ~members
(with-meta [,members]
[,(map_with_idx (lambda (i x) [array `'~x (lambda (o) (idx o i))]) members)
,(map (lambda (x) [array `'~(idx x 0) (idx x 1)]) methods)]))))
; object syntax
(add_grammar_rule 'form ["obj" 'WS 'atom "\\(" ['optional_WS 'atom] * 'optional_WS "\\)" 'optional_WS "{" 'optional_WS ['atom 'optional_WS 'form 'optional_WS] * "}"] (lambda (_ _ name _ members _ _ _ _ _ methods _)
`(set! ~name (make_constructor [,(map (lambda (x) `'~(idx x 1)) members)]
[,(map (lambda (x) `['~(idx x 0) ~(idx x 2)]) methods)]))))
; Lambda syntax
(add_grammar_rule 'form ["\\|" 'optional_WS [ 'atom 'optional_WS ] * "\\|" 'optional_WS 'form ]
(lambda (_ _ params _ _ body) `(lambda (,(map (lambda (x) (idx x 0)) params)) ~body)))
; {} body translated to do and let
(add_grammar_rule 'block_member [ 'form ] |x| [x])
(add_grammar_rule 'block_member [ "let" 'optional_WS 'atom 'optional_WS "=" 'optional_WS 'form ]
|_ _ name _ _ _ rhs| `(~name ~rhs))
(fun construct_body (is_do current to_add i)
(if (> (len to_add) i)
(cond (and is_do (= (len (idx to_add i)) 1)) (construct_body true (concat current [(idx (idx to_add i) 0)]) to_add (+ i 1))
(= (len (idx to_add i)) 1) (concat current [(construct_body true [do (idx (idx to_add i) 0)] to_add (+ i 1))])
true (concat current [(construct_body false [let [(idx (idx to_add i) 0) (idx (idx to_add i) 1)] ] to_add (+ i 1))]))
current))
(add_grammar_rule 'form ["{" 'optional_WS [ 'block_member 'optional_WS ] * "}"]
|_ _ inner _| (construct_body true [do] (map |x| (idx x 0) inner) 0))
; Call functions with function first, c style (notice no whitespace)
(add_grammar_rule 'form [ 'form 'call_form ] |f ps| (concat [f] ps))
; fun syntax
(add_grammar_rule 'form [ "fun" 'WS 'atom 'optional_WS "\\(" 'optional_WS [ 'atom 'optional_WS ] * "\\)" 'optional_WS 'form ]
|_ _ name _ _ _ params _ _ body| `(fun ~name (,(map |x| (idx x 0) params)) ~body))
; string interpolation
fun remove_dollar(done to_do i j) (cond (>= j (- (len to_do) 2)) (str done (slice to_do i -1))
(= "\\$" (slice to_do j (+ j 2))) (remove_dollar (str done (slice to_do i j) "$") to_do (+ j 2) (+ j 2))
true (remove_dollar done to_do i (+ j 1)))
fun fixup_str_parts(s) (remove_dollar "" (slice s 0 -2) 0 0)
(add_grammar_rule 'form [ "$\"" [ "(#|[%-[]| |[]-~]|(\\\\)|(\\n)|(\\t)|(\\*)|(\\\\$)|
|[ -!]|(\\\\\"))*$" 'form ] * "(#|[%-[]| |[]-~]|(\\\\)|(\\n)|(\\t)|(\\*)|(\\\\$)|
|[ -!]|(\\\\\"))*\"" ]
|_ string_form_pairs end| `(str ,( flat_map |x| [ (fixup_str_parts (idx x 0)) (idx x 1) ] string_form_pairs) ~(fixup_str_parts end)))
(println $"unu |\$| $$"inner $(+ 1 2) post-inner" sual")
obj Point( x y ) {
add |self other| { Point((+ self.x other.x) (+ self.y other.y)) }
sub |self other| { Point((- self.x other.x) (- self.y other.y)) }
to_str |self| { str("x: " self.x ", y: " self.y) }
}
fun say_hi(name) {
println("hayo" name)
}
fun test() {
let plus_1 = |x| (+ x 1)
let a = 1
let b = plus_1(a)
println("some" b)
say_hi("Marcus")
let p1 = Point(1 2)
let p2 = Point(3 4)
let p3 = p1.add(p2)
let p4 = p1.sub(p2)
println("p1:" p1.to_str)
println("p2:" p2.to_str)
println("p3:" p3.to_str)
println("p4:" p4.to_str)
(+ a b)
}
println("Test result is" test())

102
working_files/new_kraken.kp
View File

@@ -1,102 +0,0 @@
(let (
; First quick lookup function, since maps are not built in
get-value-helper (rec-lambda recurse (dict key i) (if (>= i (len dict))
nil
(if (= key (idx (idx dict i) 0))
(idx (idx dict i) 1)
(recurse dict key (+ i 1)))))
get-value (lambda (dict key) (get-value-helper dict key 0))
; Our actual method call function
method-call (lambda (object method & arguments) (let (method_fn (get-value (meta object) method))
(if (= method_fn nil)
(println "no method " method)
(lapply method_fn (concat [object] arguments)))))
make_constructor (lambda (name members methods)
`(~rec-lambda ~name ~members
(~with-meta [,members]
[,(map_i (lambda (i x) [array `'~x (lambda (o) (idx o i))]) members)
,(map (lambda (x) [array `'~(idx x 0) (idx x 1)]) methods)])))
; {} body translated to do and let
construct_body (rec-lambda recurse (is_do current to_add i)
(if (> (len to_add) i)
(cond (and is_do (= (len (idx to_add i)) 1)) (recurse true (concat current [(idx (idx to_add i) 0)]) to_add (+ i 1))
(= (len (idx to_add i)) 1) (concat current [(recurse true [do (idx (idx to_add i) 0)] to_add (+ i 1))])
(= (len (idx to_add i)) 3) (concat current [[with_import (idx (idx to_add i) 0) (recurse false [do] to_add (+ i 1))]])
true (concat current [(recurse false [let [(idx (idx to_add i) 0) (idx (idx to_add i) 1)] ] to_add (+ i 1))]))
current))
; string interpolation
remove_dollar (rec-lambda recurse (done to_do i j) (cond (>= j (- (len to_do) 2)) (str done (slice to_do i -1))
(= "\\$" (slice to_do j (+ j 2))) (recurse (str done (slice to_do i j) "$") to_do (+ j 2) (+ j 2))
true (recurse done to_do i (+ j 1))))
fixup_str_parts (lambda (s) (remove_dollar "" (slice s 0 -2) 0 0))
new_kraken_untyped (concat standard_grammar [
[ 'expr [ 'number ] (lambda (x) x) ]
[ 'expr [ 'string ] (lambda (x) x) ]
[ 'expr [ 'bool_nil_symbol ] (lambda (x) x) ]
[ 'call_innards [ 'WS * ] (lambda (_) []) ]
[ 'call_innards [ 'expr [ 'WS 'expr ] * ] (lambda (f r) (concat [f] (map (lambda (x) (idx x 1)) r))) ]
[ 'expr ['expr "\\." 'bool_nil_symbol] (lambda (o _ m) `(~method-call ~o '~m)) ]
; params
[ 'expr ['expr "\\." 'bool_nil_symbol "\\(" 'call_innards "\\)"]
(lambda (o _ m _ p _) `(~method-call ~o '~m ,p)) ]
[ 'expr [ "\\|" 'call_innards "\\|" 'WS * 'expr ]
(lambda (_ params _ _ body) `(lambda (,params) ~body)) ]
; Call functions with function first, c style (notice no whitespace)
[ 'expr [ 'expr "\\(" 'call_innards "\\)" ]
(lambda (f _ ps _) (concat [f] ps)) ]
; fun syntax
[ 'block_member [ "fun" 'WS 'bool_nil_symbol 'WS * "\\(" 'call_innards "\\)" 'WS * 'expr ]
(lambda (_ _ name _ _ params _ _ body) `(~name (~lambda (,params) ~body))) ]
[ 'block_member [ 'expr ] (lambda (x) [x]) ]
[ 'block_member [ "let" 'WS * 'bool_nil_symbol 'WS * "=" 'WS * 'expr ]
(lambda (_ _ name _ _ _ rhs) `(~name ~rhs)) ]
; object syntax
[ 'block_member ["obj" 'WS 'bool_nil_symbol "\\(" ['WS * 'bool_nil_symbol] * 'WS * "\\)" 'WS * "{" 'WS * ['bool_nil_symbol 'WS * 'expr 'WS *] * "}"]
(lambda (_ _ name _ members _ _ _ _ _ methods _)
[name (make_constructor name (map (lambda (x) (idx x 1)) members)
(map (lambda (x) [(idx x 0) (idx x 2)]) methods))]) ]
; import
[ 'block_member [ "with_import" 'WS 'string 'WS * ":" ]
(lambda (_ _ file _ _) [file 0 0]) ]
[ 'expr ["{" 'WS * 'block_member "}"]
(lambda (_ _ inner _) (construct_body true [do] [inner] 0)) ]
[ 'expr ["{" 'WS * [ 'block_member 'WS ] * "}"]
(lambda (_ _ inner _) (construct_body true [do] (map (lambda (x) (idx x 0)) inner) 0)) ]
[ 'new_kraken_start_symbol [ 'WS * [ 'block_member 'WS ] * ]
(lambda (_ inner) (construct_body true [do] (map (lambda (x) (idx x 0)) inner) 0)) ]
[ 'expr [ "$\"" [ "(#|[%-[]| |[]-~]|(\\\\\\\\)|(\\\\n)|(\\\\t)|(\\*)|(\\\\$)|
|[ -!]|(\\\\\"))*$" 'expr ] * "(#|[%-[]| |[]-~]|(\\\\\\\\)|(\\\\n)|(\\\\t)|(\\*)|(\\\\$)|
|[ -!]|(\\\\\"))*\"" ]
(lambda (_ string_expr_pairs end) `(str ,( flat_map (lambda (x) [ (fixup_str_parts (idx x 0)) (idx x 1) ]) string_expr_pairs) ~(fixup_str_parts end))) ]
; Swapping back and forth between underlying Lisp syntax
; Might want to disable this when we start doing typing
; till we figure out how to type Vau and such.
[ 'expr [ "\\\\" 'form ] (lambda (_ inner) inner) ]
[ 'form [ "\\\\" 'expr ] (lambda (_ inner) inner) ]
]))
(provide new_kraken_untyped)
)

49
working_files/new_kraken_test.kp
View File

@@ -1,49 +0,0 @@
#lang (with_import "./new_kraken.kp" new_kraken_untyped) new_kraken_start_symbol
let my_var = 1337
println($"this is string interpolation: ${+(1 3 4)} <- cool right? another $my_var yep even variables")
obj Point( x y ) {
add |self other| { Point(+(self.x other.x) +(self.y other.y)) }
sub |self other| { Point(-(self.x other.x) -(self.y other.y)) }
to_str |self| { str("x: " self.x ", y: " self.y) }
}
fun say_hi(name) {
println("hayo" name)
}
fun test() {
let plus_1 = |x| { +(x 1) }
let a = 1
let b = plus_1(a)
println("some" b)
say_hi("Marcus")
let p1 = Point(1 2)
let p2 = Point(3 4)
let p3 = p1.add(p2)
let p4 = p1.sub(p2)
say_hi("Charlie/Betty")
println("p1:" p1.to_str)
println("p2:" p2.to_str)
println("p3:" p3.to_str)
println("p4:" p4.to_str)
println("before + a b" +(a b))
with_import("./import_test.kp" println("after + a b" +(a b)))
println("post after + a b" +(a b))
with_import "./import_test.kp":
println("post new impot after + a b" +(a b))
println("We're back baby" \(+ 1 13
(do
(println "hahaha" 'a \{
let a = 75
let b = 75
println("Inside hahaha more HAHAHAA " +(1 2 a b))
"Inside Result"
}) 4)))
}
println("Test result is" test())

521
working_files/partial_eval.kp
View File

@@ -1,521 +0,0 @@
(with_import "./collections.kp"
(let (
; For right now we only support calling partial_eval in such a way that it partial evals against
; the root env, but this is could and really should be extended. We could at least check if the env we're called with
; is the root_env, or if what we look up in whatever env is passed in matches something in the root env
; Care should also be taken when evaluating outside combinators to have them be in the right env, etc
; Here is every form in k'
; True
; False
; Env: *KPEnv
; Combiner: KPCombiner / BuiltinCombiner: KPBuiltinCombiner
; String: str
; Symbol: str
; Int: int
; Array: rc<vec<KPValue>>
; Nil
; Ok, some more things we need / need to change
; 1) meta...
; Honestly, I'm tempted to get rid of it
; Possible marked values
; ['val v] - v is a value that evaluates to itself, and not a combiner or env, as those have their own metadata. Not an array or symbol
; That means it's true/false/a string/ an int/nil
; ['marked_array is_val a] - a contains marked values. if is_val, then it's the value version, and must be stripped back into (array ...),
; otherwise it's a calling form, and should be lowered back to (...). Also, if it's is_val, partial_eval won't perform a call, etc
; ['marked_symbol is_val s] - a symbol. is_val has the same meaning as in marked_array
; ['comb wrap_level de? se variadic params body] - A combiner. Contains the static env and the actual function, if possible.
; It is possible to have a combiner without an actual function, but that's only generated when
; we know it's about to be called and we won't have to strip-lower it
; ['prim_comb <handler_function>] - A primitive combiner! It has it's own special handler function to partial eval
; ['env is_real de_bruijn_idx_or_nil [ ['symbol marked_value ]... <upper_marked_env> ]] - A marked env
val? (lambda (x) (= 'val (idx x 0)))
.val (lambda (x) (idx x 1))
marked_array? (lambda (x) (= 'marked_array (idx x 0)))
.marked_array_is_val (lambda (x) (idx x 1))
.marked_array_values (lambda (x) (idx x 2))
marked_symbol? (lambda (x) (= 'marked_symbol (idx x 0)))
.marked_symbol_is_val (lambda (x) (idx x 1))
.marked_symbol_value (lambda (x) (idx x 2))
comb? (lambda (x) (= 'comb (idx x 0)))
.comb (lambda (x) (slice x 1 -1))
prim_comb? (lambda (x) (= 'prim_comb (idx x 0)))
.prim_comb (lambda (x) (idx x 1))
marked_env? (lambda (x) (= 'env (idx x 0)))
marked_env_real? (lambda (x) (idx x 1))
.marked_env_idx (lambda (x) (idx x 2))
.env_marked (lambda (x) (idx x 3))
later? (rec-lambda recurse (x) (or (and (marked_array? x) (or (= false (.marked_array_is_val x)) (foldl (lambda (a x) (or a (recurse x))) false (.marked_array_values x))))
(and (marked_symbol? x) (= false (.marked_symbol_is_val x)))
; This is now taken care of via the de Bruijn >= 0 check in call, otherwise these are values, kinda, as long as they don't go negative (or are real)
;(and (marked_env? x) (not (marked_env_real? x)))
;(and (comb? x) (let ([wrap_level de? se variadic params body] (.comb x)
; ; this is the complex bit - we should do something like check if
; ; se is fake check to see if there are symbols or eval that could use it
; ; or a sub-comb's se, or if de is non-nil and used in some sub-call.
; comb_is_later (recurse se)
; ) comb_is_later))
))
false? (lambda (x) (cond (and (marked_array? x) (= false (.marked_array_is_val x))) (error (str "got a later marked_array passed to false? " x))
(and (marked_symbol? x) (= false (.marked_symbol_is_val x))) (error (str "got a later marked_symbol passed to false? " x))
(val? x) (not (.val x))
true false))
env-lookup-helper (rec-lambda recurse (dict key i fail success) (cond (and (= i (- (len dict) 1)) (= nil (idx dict i))) (fail)
(= i (- (len dict) 1)) (recurse (.env_marked (idx dict i)) key 0 fail success)
(= key (idx (idx dict i) 0)) (success (idx (idx dict i) 1))
true (recurse dict key (+ i 1) fail success)))
env-lookup (lambda (env key) (env-lookup-helper (.env_marked env) key 0 (lambda () (error (str key " not found in env " (.env_marked env)))) (lambda (x) x)))
mark (rec-lambda recurse (x) (cond (env? x) (error (str "called mark with an env " x))
(combiner? x) (error (str "called mark with a combiner " x))
(symbol? x) ['marked_symbol false x]
(array? x) ['marked_array false (map recurse x)]
true ['val x]))
indent_str (rec-lambda recurse (i) (if (= i 0) ""
(str " " (recurse (- i 1)))))
str_strip (lambda (& args) (lapply str (concat (slice args 0 -2) [((rec-lambda recurse (x)
(cond (val? x) (.val x)
(marked_array? x) (let (stripped_values (map recurse (.marked_array_values x)))
(if (.marked_array_is_val x) (cons array stripped_values)
stripped_values))
(marked_symbol? x) (if (.marked_symbol_is_val x) ['quote (.marked_symbol_value x)]
(.marked_symbol_value x))
(comb? x) (let ([wrap_level de? se variadic params body] (.comb x))
(str "<comb " wrap_level " " de? " <se " (recurse se) "> " params " " (recurse body) ">"))
(prim_comb? x) (idx x 2)
(marked_env? x) (let (e (.env_marked x)
index (.marked_env_idx x)
u (idx e -1)
) (if u (str "<" (if (marked_env_real? x) "real" "fake") " ENV idx: " (str index) ", " (map (lambda ([k v]) [k (recurse v)]) (slice e 0 -2)) " upper: " (recurse u) ">")
"<no_upper_likely_root_env>"))
true (error (str "some other str_strip? |" x "|"))
)
) (idx args -1))])))
print_strip (lambda (& args) (println (lapply str_strip args)))
strip (let (helper (rec-lambda recurse (x need_value)
(cond (val? x) (.val x)
(marked_array? x) (let (stripped_values (map (lambda (x) (recurse x need_value)) (.marked_array_values x)))
(if (.marked_array_is_val x) (if need_value (error (str "needed value for this strip but got" x)) (cons array stripped_values))
stripped_values))
(marked_symbol? x) (if (.marked_symbol_is_val x) (if need_value (error (str "needed value for this strip but got" x)) [quote (.marked_symbol_value x)])
(.marked_symbol_value x))
(comb? x) (let ([wrap_level de? se variadic params body] (.comb x)
de_entry (if de? [de?] [])
final_params (if variadic (concat (slice params 0 -2) '& [(idx params -1)]) params)
; Honestly, could trim down the env to match what could be evaluated in the comb
; Also if this isn't real, lower to a call to vau
se_env (if (marked_env_real? se) (recurse se true) nil)
body_v (recurse body false)
ve (concat [vau] de_entry [final_params] [body_v])
fe ((rec-lambda recurse (x i) (if (= i 0) x (recurse [wrap x] (- i 1)))) ve wrap_level)
) (if se_env (eval fe se_env) fe))
(prim_comb? x) (idx x 2)
; env emitting doesn't pay attention to real value right now, not sure if that makes sense
; TODO: properly handle de Bruijn indexed envs
(marked_env? x) (cond (and (not need_value) (= 0 (.marked_env_idx x))) [current-env]
true (let (_ (if (not (marked_env_real? x)) (error (str_strip "trying to emit fake env!" x)))
upper (idx (.env_marked x) -1)
upper_env (if upper (recurse upper true) empty_env)
just_entries (slice (.env_marked x) 0 -2)
vdict (map (lambda ([k v]) [k (recurse v true)]) just_entries)
) (add-dict-to-env upper_env vdict)))
true (error (str "some other strip? " x))
)
)) (lambda (x) (let (_ (print_strip "stripping: " x) r (helper x false) _ (println "result of strip " r)) r)))
; A bit wild, but what if instead of is_value we had an evaluation level integer, kinda like wrap?
; when lowering, it could just turn into multiple evals or somesuch, though we'd have to be careful of envs...
try_unval (rec-lambda recurse (x fail_f)
(cond (marked_array? x) (if (not (.marked_array_is_val x)) [false (fail_f x)]
(let ([sub_ok subs] (foldl (lambda ([ok a] x) (let ([nok p] (recurse x fail_f))
[(and ok nok) (concat a [p])]))
[true []]
(.marked_array_values x)))
[sub_ok ['marked_array false subs]]))
(marked_symbol? x) (if (.marked_symbol_is_val x) [true ['marked_symbol false (.marked_symbol_value x)]]
[false (fail_f x)])
true [true x]
)
)
try_unval_array (lambda (x) (foldl (lambda ([ok a] x) (let ([nok p] (try_unval x (lambda (_) nil)))
[(and ok nok) (concat a [p])]))
[true []]
x))
ensure_val (rec-lambda recurse (x)
(cond (marked_array? x) ['marked_array true (map recurse (.marked_array_values x))]
(marked_symbol? x) ['marked_symbol true (.marked_symbol_value x)]
true x
)
)
; This is a conservative analysis, since we can't always tell what constructs introduce
; a new binding scope & would be shadowing... we should at least be able to implement it for
; vau/lambda, but we won't at first
in_array (let (helper (rec-lambda recurse (x a i) (cond (= i (len a)) false
(= x (idx a i)) true
true (recurse x a (+ i 1)))))
(lambda (x a) (helper x a 0)))
; TODO: make this check for stop envs using de Bruijn indicies
contains_symbols (rec-lambda recurse (stop_envs symbols x) (cond
(val? x) false
(marked_symbol? x) (let (r (in_array (.marked_symbol_value x) symbols)
_ (if r (println "!!! contains symbols found " x " in symbols " symbols)))
r)
(marked_array? x) (foldl (lambda (a x) (or a (recurse stop_envs symbols x))) false (.marked_array_values x))
(comb? x) (let ([wrap_level de? se variadic params body] (.comb x))
(or (recurse stop_envs symbols se) (recurse stop_envs (filter (lambda (y) (not (or (= de? y) (in_array y params)))) symbols) body)))
(prim_comb? x) false
(marked_env? x) (let (inner (.env_marked x))
(cond (in_array x stop_envs) false
(foldl (lambda (a x) (or a (recurse stop_envs symbols (idx x 1)))) false (slice inner 0 -2)) true
(idx inner -1) (recurse stop_envs symbols (idx inner -1))
true false))
true (error (str "Something odd passed to contains_symbols " x))
))
is_all_values (lambda (evaled_params) (foldl (lambda (a x) (and a (not (later? x)))) true evaled_params))
; * TODO: allowing envs to be shead if they're not used.
shift_envs (rec-lambda recurse (cutoff d x) (cond
(val? x) [true x]
(marked_env? x) (let ([_env is_real dbi meat] x
[nmeat_ok nmeat] (foldl (lambda ([ok r] [k v]) (let ([tok tv] (recurse cutoff d v)) [(and ok tok) (concat r [[k tv]])])) [true []] (slice meat 0 -2))
[nupper_ok nupper] (if (idx meat -1) (recurse cutoff d (idx meat -1)) [true nil])
ndbi (cond (nil? dbi) nil
(>= dbi cutoff) (+ dbi d)
true dbi)
) [(and nmeat_ok nupper_ok (or is_real (and ndbi (>= ndbi 0)))) ['env is_real ndbi (concat nmeat [nupper])]])
(comb? x) (let ([wrap_level de? se variadic params body] (.comb x)
[se_ok nse] (recurse cutoff d se)
[body_ok nbody] (recurse (+ cutoff 1) d body)
) [(and se_ok body_ok) ['comb wrap_level de? nse variadic params nbody]])
(prim_comb? x) [true x]
(marked_symbol? x) [true x]
(marked_array? x) (let ([insides_ok insides] (foldl (lambda ([ok r] tx) (let ([tok tr] (recurse cutoff d tx)) [(and ok tok) (concat r [tr])])) [true []] (.marked_array_values x)))
[insides_ok ['marked_array (.marked_array_is_val x) insides]])
true (error (str "impossible shift_envs value " x))
))
increment_envs (lambda (x) (idx (shift_envs 0 1 x) 1))
decrement_envs (lambda (x) (shift_envs 0 -1 x))
; TODO: instead of returning the later symbols, we could create a new value of a new type
; ['ref de_bruijn_index_of_env index_into_env] or somesuch. Could really simplify
; compiling, and I think make partial-eval more efficient. More accurate closes_over analysis too, I think
make_tmp_inner_env (lambda (params de? de)
['env false 0 (concat (map (lambda (p) [p ['marked_symbol false p]]) params) (if (= nil de?) [] [ [de? ['marked_symbol false de?]] ]) [(increment_envs de)])])
partial_eval_helper (rec-lambda recurse (x env env_stack indent)
(cond (val? x) x
(marked_env? x) (let (dbi (.marked_env_idx x))
(if dbi (let (new_env (idx env_stack dbi)
ndbi (.marked_env_idx new_env)
;_ (if (!= dbi ndbi) (error (str (str_strip "same env with different dbis " x) (str_strip " and " new_env))))
_ (if (!= 0 ndbi) (error (str_strip "new env with non-zero dbis " x)))
_ (println (str_strip "replacing " x) (str_strip " with " new_env))
)
(if (= 0 dbi) new_env (idx (shift_envs 0 dbi new_env) 1)))
x))
(comb? x) (let ([wrap_level de? se variadic params body] (.comb x))
(if (or (and (not (marked_env_real? env)) (not (marked_env_real? se))) ; both aren't real, re-evaluation of creation site
(and (marked_env_real? env) (not (marked_env_real? se)))) ; new env real, but se isn't - creation!
(let (inner_env (make_tmp_inner_env params de? env))
['comb wrap_level de? env variadic params (recurse body inner_env (cons inner_env env_stack) (+ indent 1))])
x))
(prim_comb? x) x
(marked_symbol? x) (if (.marked_symbol_is_val x) x
(env-lookup env (.marked_symbol_value x)))
(marked_array? x) (cond (.marked_array_is_val x) x
(= 0 (len (.marked_array_values x))) (error "Partial eval on empty array")
true (let (values (.marked_array_values x)
;_ (println (indent_str indent) "partial_evaling comb " (idx values 0))
_ (print_strip (indent_str indent) "partial_evaling comb " (idx values 0))
comb (recurse (idx values 0) env env_stack (+ 1 indent))
literal_params (slice values 1 -1)
_ (println (indent_str indent) "Going to do an array call!")
_ (print_strip (indent_str indent) " total is " x)
_ (print_strip (indent_str indent) " evaled comb is " comb)
ident (+ 1 indent)
)
(cond (prim_comb? comb) ((.prim_comb comb) env env_stack literal_params (+ 1 indent))
(comb? comb) (let (
rp_eval (lambda (p) (recurse p env env_stack (+ 1 indent)))
[wrap_level de? se variadic params body] (.comb comb)
ensure_val_params (map ensure_val literal_params)
[ok appropriatly_evaled_params] ((rec-lambda param-recurse (wrap cparams)
(if (!= 0 wrap)
(let (pre_evaled (map rp_eval cparams)
[ok unval_params] (try_unval_array pre_evaled))
(if (not ok) [ok nil]
(let (evaled_params (map rp_eval unval_params))
(param-recurse (- wrap 1) evaled_params))))
[true cparams])
) wrap_level ensure_val_params)
ok_and_non_later (and ok (is_all_values appropriatly_evaled_params))
) (if (not ok_and_non_later) ['marked_array false (cons comb (if (> wrap_level 0) (map rp_eval literal_params)
literal_params))]
(let (
final_params (if variadic (concat (slice appropriatly_evaled_params 0 (- (len params) 1))
[['marked_array true (slice appropriatly_evaled_params (- (len params) 1) -1)]])
appropriatly_evaled_params)
[de_real de_entry] (if (!= nil de?) [ (marked_env_real? env) [ [de? (increment_envs env) ] ] ]
[ true []])
;_ (println (indent_str indent) "final_params params " final_params)
inner_env ['env (and de_real (marked_env_real? se)) 0 (concat (zip params (map (lambda (x) (increment_envs x)) final_params)) de_entry [(increment_envs se)])]
_ (print_strip (indent_str indent) " with inner_env is " inner_env)
_ (print_strip (indent_str indent) "going to eval " body)
tmp_func_result (recurse body inner_env (cons inner_env env_stack) (+ 1 indent))
_ (print_strip (indent_str indent) "evaled result of function call is " tmp_func_result)
[able_to_sub_env func_result] (decrement_envs tmp_func_result)
result_is_later (later? func_result)
_ (print_strip (indent_str indent) "success? " able_to_sub_env " decremented result of function call is " tmp_func_result)
stop_envs ((rec-lambda ser (a e) (if e (ser (cons e a) (idx (.env_marked e) -1)) a)) [] se)
result_closes_over (contains_symbols stop_envs (concat params (if de? [de?] [])) func_result)
_ (println (indent_str indent) "func call able_to_sub: " able_to_sub_env " result is later? " result_is_later " and result_closes_over " result_closes_over)
; This could be improved to a specialized version of the function
; just by re-wrapping it in a comb instead if we wanted.
; Something to think about!
result (if (or (not able_to_sub_env) (and result_is_later result_closes_over))
['marked_array false (cons comb (if (> wrap_level 0) (map rp_eval literal_params)
literal_params))]
func_result)
) result)))
(later? comb) ['marked_array false (cons comb literal_params)]
true (error (str "impossible comb value " x)))))
true (error (str "impossible partial_eval value " x))
)
)
needs_params_val_lambda (vau de (f_sym) (let (
actual_function (eval f_sym de)
handler (rec-lambda recurse (de env_stack params indent) (let (
;_ (println "partial_evaling params in need_params_val_lambda for " f_sym " is " params)
evaled_params (map (lambda (p) (partial_eval_helper p de env_stack (+ 1 indent))) params)
)
(if (is_all_values evaled_params) (mark (lapply actual_function (map strip evaled_params)))
['marked_array false (cons ['prim_comb recurse actual_function] evaled_params)])))
) [f_sym ['prim_comb handler actual_function]]))
give_up_eval_params (vau de (f_sym) (let (
actual_function (eval f_sym de)
handler (rec-lambda recurse (de env_stack params indent) (let (
_ (println "partial_evaling params in give_up_eval_params for " f_sym " is " params)
evaled_params (map (lambda (p) (partial_eval_helper p de env_stack (+ 1 indent))) params)
)
['marked_array false (cons ['prim_comb recurse actual_function] evaled_params)]))
) [f_sym ['prim_comb handler actual_function]]))
; !!!!!!
; ! I think needs_params_val_lambda should be combined with parameters_evaled_proxy
; !!!!!!
parameters_evaled_proxy (rec-lambda recurse (pasthr_ie inner_f) (lambda (de env_stack params indent) (let (
_ (println "partial_evaling params in parameters_evaled_proxy is " params)
[evaled_params l] (foldl (lambda ([ac i] p) (let (p (partial_eval_helper p de env_stack (+ 1 indent)))
[(concat ac [p]) (+ i 1)]))
[[] 0]
params)
) (inner_f (lambda (& args) (lapply (recurse pasthr_ie inner_f) args)) de env_stack evaled_params indent))))
root_marked_env ['env true nil [
; Ok, so for combinators, it should partial eval the body.
; It should then check to see if the partial-evaled body has closed over
; any 'later values from above the combinator. If so, the combinator should
; evaluate to a ['later [vau de? params (strip partially_evaled_body)]], otherwise it can evaluate to a 'comb.
; Note that this 'later may be re-evaluated later if the parent function is called.
['vau ['prim_comb (rec-lambda recurse (de env_stack params indent) (let (
mde? (if (= 3 (len params)) (idx params 0))
vau_mde? (if (= nil mde?) [] [mde?])
de? (if mde? (.marked_symbol_value mde?))
vau_de? (if (= nil de?) [] [de?])
raw_marked_params (if (= nil de?) (idx params 0) (idx params 1))
raw_params (map (lambda (x) (if (not (marked_symbol? x)) (error (str "not a marked symbol " x))
(.marked_symbol_value x))) (.marked_array_values raw_marked_params))
[variadic vau_params] (foldl (lambda ([v a] x) (if (= x '&) [true a] [v (concat a [x])])) [false []] raw_params)
body (if (= nil de?) (idx params 1) (idx params 2))
inner_env (make_tmp_inner_env vau_params de? de)
_ (print_strip (indent_str indent) "in vau, evaluating body with 'later params - " body)
pe_body (partial_eval_helper body inner_env (cons inner_env env_stack) (+ 1 indent))
_ (print_strip (indent_str indent) "in vau, result of evaluating body was " pe_body)
) ['comb 0 de? de variadic vau_params pe_body]
)) vau]]
['wrap ['prim_comb (parameters_evaled_proxy 0 (lambda (recurse de env_stack [evaled] indent)
(if (comb? evaled) (let ([wrap_level de? se variadic params body] (.comb evaled)
wrapped_marked_fun ['comb (+ 1 wrap_level) de? se variadic params body]
) wrapped_marked_fun)
['marked_array false [['prim_comb recurse wrap] evaled]]))
) wrap]]
['unwrap ['prim_comb (parameters_evaled_proxy 0 (lambda (recurse de env_stack [evaled] indent)
(if (comb? evaled) (let ([wrap_level de? se variadic params body] (.comb evaled)
unwrapped_marked_fun ['comb (- wrap_level 1) de? se variadic params body]
) unwrapped_marked_fun)
['marked_array false [['prim_comb recurse unwrap] evaled]]))
) unwrap]]
['eval ['prim_comb (rec-lambda recurse (de env_stack params indent) (let (
self ['prim_comb recurse eval]
eval_env (if (= 2 (len params)) (partial_eval_helper (idx params 1) de env_stack (+ 1 indent))
de)
eval_env_v (if (= 2 (len params)) [eval_env] [])
) (if (not (marked_env? eval_env)) (do (print_strip (indent_str indent) "eval got not a marked env " eval_env) ['marked_array false (cons self params)])
(let (
_ (print_strip (indent_str indent) " partial_evaling_body the first time " (idx params 0))
body1 (partial_eval_helper (idx params 0) de env_stack (+ 1 indent))
_ (print_strip (indent_str indent) "after first eval of param " body1)
; With this, we don't actually fail as this is always a legitimate uneval
fail_handler (lambda (failed) ['marked_array false (concat [self failed] eval_env_v)])
[ok unval_body] (try_unval body1 fail_handler)
self_fallback (fail_handler body1)
_ (print_strip (indent_str indent) "partial_evaling body for the second time in eval " unval_body)
body2 (if (= self_fallback unval_body) self_fallback (partial_eval_helper unval_body eval_env env_stack (+ 1 indent)))
_ (print_strip (indent_str indent) "and body2 is " body2)
) body2))
)) eval]]
;TODO: This could go a lot farther, not stopping after the first 'later, etc
; Also, GAH on odd params - but only one by one - a later odd param can't be imm_eval cuz it will
; be frozen if an earlier cond is 'later....
['cond ['prim_comb (parameters_evaled_proxy nil (lambda (recurse de env_stack evaled_params indent)
(if (!= 0 (% (len evaled_params) 2)) (error (str "partial eval cond with odd evaled_params " evaled_params))
((rec-lambda recurse_inner (i)
(cond (later? (idx evaled_params i)) ['marked_array false (cons ['prim_comb recurse cond] (slice evaled_params i -1))]
(false? (idx evaled_params i)) (recurse_inner (+ 2 i))
true (idx evaled_params (+ 1 i))) ; we could partially_eval again passing in immediate
; eval if it was true, to partially counteract the above GAH
) 0)
)
)) cond]]
(needs_params_val_lambda symbol?)
(needs_params_val_lambda int?)
(needs_params_val_lambda string?)
; not even a gah, but kinda!
['combiner? ['prim_comb (parameters_evaled_proxy nil (lambda (recurse de env_stack [evaled_param] indent)
(cond (comb? evaled_param) ['val true]
(prim_comb? evaled_param) ['val true]
(later? evaled_param) ['marked_array false [['prim_comb recurse combiner?] evaled_param]]
true ['val false]
)
)) combiner?]]
; not even a gah, but kinda!
['env? ['prim_comb (parameters_evaled_proxy nil (lambda (recurse de env_stack [evaled_param] indent)
(cond (marked_env? evaled_param) ['val true]
(later? evaled_param) ['marked_array false [['prim_comb recurse env?] evaled_param]]
true ['val false]
)
)) env?]]
(needs_params_val_lambda nil?)
(needs_params_val_lambda bool?)
(needs_params_val_lambda str-to-symbol)
(needs_params_val_lambda get-text)
['array? ['prim_comb (parameters_evaled_proxy nil (lambda (recurse de env_stack [evaled_param] indent)
(cond
(later? evaled_param) ['marked_array false [['prim_comb recurse array?] evaled_param]]
(marked_array? evaled_param) ['val true]
true ['val false]
)
)) array?]]
; This one's sad, might need to come back to it.
; We need to be able to differentiate between half-and-half arrays
; for when we ensure_params_values or whatever, because that's super wrong
['array ['prim_comb (parameters_evaled_proxy nil (lambda (recurse de env_stack evaled_params indent)
(if (is_all_values evaled_params) ['marked_array true evaled_params]
['marked_array false (cons ['prim_comb recurse array] evaled_params)])
)) array]]
['len ['prim_comb (parameters_evaled_proxy nil (lambda (recurse de env_stack [evaled_param] indent)
(cond (later? evaled_param) ['marked_array false [['prim_comb recurse len] evaled_param]]
(marked_array? evaled_param) ['val (len (.marked_array_values evaled_param))]
true (error (str "bad type to len " evaled_param))
)
)) len]]
['idx ['prim_comb (parameters_evaled_proxy nil (lambda (recurse de env_stack [evaled_array evaled_idx] indent)
(cond (and (val? evaled_idx) (marked_array? evaled_array) (.marked_array_is_val evaled_array)) (idx (.marked_array_values evaled_array) (.val evaled_idx))
true ['marked_array false [['prim_comb recurse idx] evaled_array evaled_idx]]
)
)) idx]]
['slice ['prim_comb (parameters_evaled_proxy nil (lambda (recurse de env_stack [evaled_array evaled_begin evaled_end] indent)
(cond (and (val? evaled_begin) (val? evaled_end) (marked_array? evaled_array) (.marked_array_is_val evaled_array))
['marked_array true (slice (.marked_array_values evaled_array) (.val evaled_begin) (.val evaled_end))]
true ['marked_array false [['prim_comb recurse slice] evaled_array evaled_idx evaled_begin evaled_end]]
)
)) slice]]
['concat ['prim_comb (parameters_evaled_proxy nil (lambda (recurse de env_stack evaled_params indent)
(cond (foldl (lambda (a x) (and a (and (marked_array? x) (.marked_array_is_val x)))) true evaled_params) ['marked_array true (lapply concat (map (lambda (x)
(.marked_array_values x))
evaled_params))]
true ['marked_array false (cons ['prim_comb recurse concat] evaled_params)]
)
)) concat]]
(needs_params_val_lambda +)
(needs_params_val_lambda -)
(needs_params_val_lambda *)
(needs_params_val_lambda /)
(needs_params_val_lambda %)
(needs_params_val_lambda &)
(needs_params_val_lambda |)
(needs_params_val_lambda <<)
(needs_params_val_lambda >>)
(needs_params_val_lambda =)
(needs_params_val_lambda !=)
(needs_params_val_lambda <)
(needs_params_val_lambda <=)
(needs_params_val_lambda >)
(needs_params_val_lambda >=)
; these could both be extended to eliminate other known true values except for the end and vice-versa
['and ['prim_comb (parameters_evaled_proxy nil (lambda (recurse de env_stack evaled_params indent)
((rec-lambda inner_recurse (i)
(cond (= i (- (len evaled_params) 1)) (idx evaled_params i)
(later? (idx evaled_params i)) ['marked_array false (cons ['prim_comb recurse and] (slice evaled_params i -1))]
(false? (idx evaled_params i)) (idx evaled_params i)
true (inner_recurse (+ 1 i)))
) 0)
)) and]]
; see above for improvement
['or ['prim_comb (parameters_evaled_proxy nil (lambda (recurse de env_stack evaled_params indent)
((rec-lambda inner_recurse (i)
(cond (= i (- (len evaled_params) 1)) (idx evaled_params i)
(later? (idx evaled_params i)) ['marked_array false (cons ['prim_comb recurse or] (slice evaled_params i -1))]
(false? (idx evaled_params i)) (recurse (+ 1 i))
true (idx evaled_params i))
) 0)
)) or]]
; should make not a built in and then do here
; OR not - I think it will actually lower correctly partially evaled
(needs_params_val_lambda pr-str)
(needs_params_val_lambda str)
(needs_params_val_lambda prn)
(give_up_eval_params println)
; really do need to figure out if we want to keep meta, and add it if so
(give_up_eval_params meta)
(give_up_eval_params with-meta)
; if we want to get fancy, we could do error/recover too
(give_up_eval_params error)
(give_up_eval_params recover)
(needs_params_val_lambda read-string)
(give_up_eval_params slurp)
(give_up_eval_params get_line)
(give_up_eval_params write_file)
['empty_env ['env true nil [nil]]]
nil
] root_env]
partial_eval (lambda (x) (partial_eval_helper (mark x) root_marked_env [] 0))
)
(provide partial_eval strip print_strip)
))

35
working_files/partial_eval_test.csc
View File

@@ -1,35 +0,0 @@
; Going to set some aliases just for this, the scheme version
; commenting out the first let with it's final ) should make this
; legal kraken
(import (chicken process-context))
(import (chicken port))
(load "partial_eval.csc")
(import (partial_eval))
(let* (
(array list)
(concat append)
(len length)
(idx list-ref)
;(array vector)
;(concat vector-append) ; only in extension vector library!
;(len vector-length)
;(idx vector-ref)
(= equal?)
)
(print (array 1 2 3))
(print (command-line-arguments))
(print (call-with-input-string "'(1 2)" (lambda (p) (read p))))
(print partial_eval)
)

176
working_files/partial_eval_test.kp
View File

@@ -1,176 +0,0 @@
(with_import "./partial_eval.kp"
(let (
test-case (lambda (code) (let (
_ (println "Code: " code)
; For right now we only support calling partial_eval in such a way that it partial evals against
; the root env, but this is could and really should be extended. We could at least check if the env we're called with
; is the root_env, or if what we look up in whatever env is passed in matches something in the root env
partially_evaled (partial_eval code)
_ (println "Partially evaled: " partially_evaled)
_ (print_strip partially_evaled)
stripped (strip partially_evaled)
_ (println "Stripped: " stripped)
fully_evaled (eval stripped root_env)
_ (println "Fully evaled: " fully_evaled)
fully_evaled_called (if (combiner? fully_evaled) (fully_evaled 1337))
_ (if (combiner? fully_evaled) (println "..and called " fully_evaled_called))
outer_eval (eval code root_env)
_ (println " outer-eval " outer_eval)
outer_called (if (combiner? outer_eval) (outer_eval 1337))
_ (if (combiner? outer_eval) (println "..and outer called " outer_called))
_ (cond (or (combiner? fully_evaled) (combiner? outer_eval))
(if (!= fully_evaled_called outer_called) (error (str "called versions unequal for " code " are " fully_evaled_called " vs " outer_called)))
(!= fully_evaled outer_eval) (error (str "partial-eval versions unequal for " code " are " fully_evaled " vs " outer_eval))
true nil)
_ (println)
) fully_evaled))
simple_add (read-string "(+ 1 2)")
vau_with_add (read-string "(vau (y) (+ 1 2))")
vau_with_add_called (read-string "((vau (y) (+ 1 2)) 4)")
vau_with_passthrough (read-string "((vau (y) y) 4)")
vau_with_no_eval_add (read-string "((vau (y) (+ 13 2 y)) 4)")
vau_with_wrap_add (read-string "((wrap (vau (y) (+ 13 2 y))) (+ 3 4))")
vau_with_add_p (read-string "(vau de (y) (+ (eval y de) (+ 1 2)))")
vau_with_add_p_called (read-string "((vau de (y) ((vau dde (z) (+ 1 (eval z dde))) y)) 17)")
cond_test (read-string "(cond false 1 false 2 (+ 1 2) 3 true 1337)")
cond_vau_test (read-string "(vau de (x) (cond false 1 false 2 x 3 true 42))")
cond_vau_test2 (read-string "(vau de (x) (cond false 1 false 2 3 x true 42))")
combiner_test (read-string "(combiner? true)")
combiner_test2 (read-string "(combiner? (vau de (x) x))")
combiner_test3 (read-string "(vau de (x) (combiner? x))")
symbol_test (read-string "((vau (x) x) a)")
env_test (read-string "(env? true)")
; this doesn't partially eval, but it could with a more percise if the marked values were more percise
env_test2 (read-string "(vau de (x) (env? de))")
env_test3 (read-string "(vau de (x) (env? x))")
env_test4 (read-string "((vau de (x) (env? de)) 1)")
; let1 test
; ((wrap (vau root_env (quote) ((wrap (vau (let1) ;HERE;)) (vau de (s v b) (eval (array (array vau (array s) b) (eval v de)) de))))) (vau (x) x))
;let1_test (read-string "((wrap (vau root_env (quote) ((wrap (vau (let1) (let1 a 12 (+ a 1)))) (vau de (s v b) (eval (array (array vau (array s) b) (eval v de)) de))))) (vau (x) x))")
let1_test (read-string "((wrap (vau (let1) (let1 a 12 (+ a 1)))) (vau de (s v b) (eval (array (array vau (array s) b) (eval v de)) de)))")
let2_test (read-string "((wrap (vau (let1) (let1 a 12 (vau (x) (+ a 1))))) (vau de (s v b) (eval (array (array vau (array s) b) (eval v de)) de)))")
let3_test (read-string "((wrap (vau (let1) (let1 a 12 (wrap (vau (x) (+ x a 1)))))) (vau de (s v b) (eval (array (array vau (array s) b) (eval v de)) de)))")
let4_test (read-string "((wrap (vau (let1) (let1 a 12 (wrap (vau (x) (let1 y (+ a 1) (+ y x a))))))) (vau de (s v b) (eval (array (array vau (array s) b) (eval v de)) de)))")
let4.3_test (read-string "((wrap (vau (let1)
(let1 a 12 (wrap (vau (x) (let1 y (+ a 1) (+ y x a))))
))) (vau de (s v b) (eval (array (array wrap (array vau (array s) b)) v) de)))")
let4.7_test (read-string "((wrap (vau (let1)
(let1 a 12 (wrap (vau (x) (let1 y (+ x a 1) (+ y x a))))
))) (vau de (s v b) (eval (array (array wrap (array vau (array s) b)) v) de)))")
;!!!!!!!!!!!!!!!!!!!!!!!!!!
; Which means we need TODO
;!!!!!!!!!!!!!!!!!!!!!!!!!!
; 1) Change from is_val as a bool to is_val as an int, and allow negative values in certain situations
; If we're not careful about the environment it was evaluated in vs current environment, we'll also have to carry around the environment
; We might be able to call partial_eval with them, but not pass them any further down, esp into anything that might change the scope.
; This will at least allow us to decend into and partial eval the other parts of the array calling form so we can partial eval inside the body's of lets
; where the value being assigned has some later? value.
; 2) Finish up closes_over_var_from_this_env_marked so it's less finicky
;
; I think we'll need both for this to actualy work
;
let5_test (read-string "((wrap (vau (let1)
(let1 a 12 (wrap (vau (x) (let1 y (+ x a 1) (+ y x a))))
))) (vau de (s v b) (eval (array (array vau (array s) b) (eval v de)) de)))")
lambda1_test (read-string "((wrap (vau (let1)
(let1 lambda (vau se (p b) (wrap (eval (array vau p b) se)))
(lambda (x) x)
))) (vau de (s v b) (eval (array (array vau (array s) b) (eval v de)) de)))")
lambda2_test (read-string "((wrap (vau (let1)
(let1 lambda (vau se (p b) (wrap (eval (array vau p b) se)))
(let1 a 12
(lambda (x) (+ a x)))
))) (vau de (s v b) (eval (array (array vau (array s) b) (eval v de)) de)))")
;!!!! Ditto to let5_test
lambda3_test (read-string "((wrap (vau (let1)
(let1 lambda (vau se (p b) (wrap (eval (array vau p b) se)))
(let1 a 12
(lambda (x) (let1 b (+ a x)
(+ a x b))))
))) (vau de (s v b) (eval (array (array vau (array s) b) (eval v de)) de)))")
array_test (read-string "(array 1 2 3 4 5)")
vararg_test (read-string "((wrap (vau (a & rest) rest)) 1 2 3 4 5)")
;do1_test (read-string "((wrap (vau (let1)
; (let1 lambda (vau se (p b) (wrap (eval (array vau p b) se)))
; (let1 do_helper (lambda (recurse s i se) (cond (= i (len s)) nil
; (= i (- (len s) 1)) (eval (idx s i) se)
; (eval (idx s i) se) (recurse recurse s (+ i 1) se)
; true (recurse recurse s (+ i 1) se)))
; (let1 do (vau se (& s) (do_helper do_helper s 0 se))
; (do (println 1 2 3)
; (println 4 5 6))
; ))))) (vau de (s v b) (eval (array (array vau (array s) b) (eval v de)) de)))")
;do2_test (read-string "((wrap (vau (let1)
; (let1 lambda (vau se (p b) (wrap (eval (array vau p b) se)))
; (let1 do_helper (lambda (recurse s i se) (cond (= i (len s)) nil
; (= i (- (len s) 1)) (eval (idx s i) se)
; (eval (idx s i) se) (recurse recurse s (+ i 1) se)
; true (recurse recurse s (+ i 1) se)))
; (let1 do (vau se (& s) (do_helper do_helper s 0 se))
; (do (println 1 2 3)
; (println 4 5 6))
; ))))) (vau de (s v b) (eval (array (array vau (array s) b) (eval v de)) de)))")
;big_test1 [[vau ['*ARGV*] (read-string (slurp "./prelude.kp"))] ["" "-C" "1339"]]
;big_test1 [[vau ['*ARGV*] (read-string (slurp "./prelude.kp"))] ["" "-C" "(let (a 17) (vau (x) a))"]]
big_test1 [[vau ['*ARGV*] (read-string (slurp "./prelude.kp"))] ["" "-C" "(let (a 17) a)"]]
;big_test1 [[vau ['*ARGV*] (read-string (slurp "./prelude.kp"))] []]
_ (test-case simple_add)
_ (test-case vau_with_add)
_ (test-case vau_with_add_called)
_ (test-case vau_with_passthrough)
_ (test-case vau_with_no_eval_add)
_ (test-case vau_with_wrap_add)
_ (test-case vau_with_add_p)
_ (test-case vau_with_add_p_called)
_ (test-case cond_test)
_ (test-case cond_vau_test)
_ (test-case cond_vau_test2)
_ (test-case combiner_test)
_ (test-case combiner_test2)
_ (test-case combiner_test3)
_ (test-case symbol_test)
_ (test-case env_test)
_ (test-case env_test2)
_ (test-case env_test3)
_ (test-case env_test4)
_ (test-case let1_test)
_ (test-case let2_test)
_ (test-case let3_test)
_ (test-case let4_test)
_ (test-case let4.3_test)
_ (test-case let4.7_test)
_ (test-case let5_test)
_ (test-case lambda1_test)
_ (test-case lambda2_test)
_ (test-case lambda3_test)
_ (test-case array_test)
_ (test-case vararg_test)
;_ (test-case do1_test)
;_ (test-case do2_test)
;_ (println "THE BIG SHOW")
;_ (println big_test1)
;_ (test-case big_test1)
) nil))

40
working_files/partial_eval_test_rec.kp
View File

@@ -1,40 +0,0 @@
(with_import "./partial_eval.kp"
(let (
test-case (lambda (source) (let (
_ (println "Source: " source)
code (read-string source)
_ (println "Code: " code)
partially_evaled (partial_eval code)
_ (println "Partially evaled: " partially_evaled)
_ (print_strip partially_evaled)
stripped (strip partially_evaled)
_ (println "Stripped: " stripped)
fully_evaled (eval stripped root_env)
_ (println "Fully evaled: " fully_evaled)
fully_evaled_called (if (combiner? fully_evaled) (fully_evaled 1337))
_ (if (combiner? fully_evaled) (println "..and called " fully_evaled_called))
outer_eval (eval code root_env)
_ (println " outer-eval " outer_eval)
outer_called (if (combiner? outer_eval) (outer_eval 1337))
_ (if (combiner? outer_eval) (println "..and outer called " outer_called))
_ (cond (or (combiner? fully_evaled) (combiner? outer_eval))
(if (!= fully_evaled_called outer_called) (error (str "called versions unequal for " code " are " fully_evaled_called " vs " outer_called)))
(!= fully_evaled outer_eval) (error (str "partial-eval versions unequal for " code " are " fully_evaled " vs " outer_eval))
true nil)
_ (println)
) fully_evaled))
;_ (test-case "(+ 1 2)")
_ (test-case "((wrap (vau (x n) (x x n))) (wrap (vau (self n) (cond (= n 0) 10 true (self self (- n 1))))) 2)")
;_ (test-case "((wrap (vau (let1)
; (let1 lambda (vau se (p b) (wrap (eval (array vau p b) se)))
; (let1 current-env (vau de () de)
; (let1 cons (lambda (h t) (concat (array h) t))
; (let1 lapply (lambda (f p) (eval (cons (unwrap f) p) (current-env)))
; (lambda (x) x)
; )))))) (vau de (s v b) (eval (array (array vau (array s) b) (eval v de)) de)))")
) nil))

297
working_files/prelude.kp
View File

@@ -1,297 +0,0 @@
((wrap (vau root_env (quote)
((wrap (vau (let1)
(let1 lambda (vau se (p b) (wrap (eval (array vau p b) se)))
(let1 do_helper (lambda (recurse s i se) (cond (= i (len s)) nil
(= i (- (len s) 1)) (eval (idx s i) se)
(eval (idx s i) se) (recurse recurse s (+ i 1) se)
true (recurse recurse s (+ i 1) se)))
(let1 do (vau se (& s) (do_helper do_helper s 0 se))
(let1 current-env (vau de () de)
(let1 cons (lambda (h t) (concat (array h) t))
(let1 lapply (lambda (f p) (eval (cons (unwrap f) p) (current-env)))
(let1 vapply (lambda (f p ede) (eval (cons f p) ede))
(let1 Y (lambda (f)
((lambda (x) (x x))
(lambda (x) (f (lambda (& y) (lapply (x x) y))))))
(let1 vY (lambda (f)
((lambda (x) (x x))
(lambda (x) (f (vau de (& y) (vapply (x x) y de))))))
(let1 let (vY (lambda (recurse) (vau de (vs b) (cond (= (len vs) 0) (eval b de)
true (vapply let1 (array (idx vs 0) (idx vs 1) (array recurse (slice vs 2 -1) b)) de)))))
(let (
print_through (lambda (x) (do (println x) x))
lcompose (lambda (g f) (lambda (& args) (lapply g (array (lapply f args)))))
rec-lambda (vau se (n p b) (eval (array Y (array lambda (array n) (array lambda p b))) se))
if (vau de (con than & else) (cond (eval con de) (eval than de)
(> (len else) 0) (eval (idx else 0) de)
true nil))
map (lambda (f l)
(let (helper (rec-lambda recurse (f l n i)
(cond (= i (len l)) n
(<= i (- (len l) 4)) (recurse f l (concat n (array
(f (idx l (+ i 0)))
(f (idx l (+ i 1)))
(f (idx l (+ i 2)))
(f (idx l (+ i 3)))
)) (+ i 4))
true (recurse f l (concat n (array (f (idx l i)))) (+ i 1)))))
(helper f l (array) 0)))
map_i (lambda (f l)
(let (helper (rec-lambda recurse (f l n i)
(cond (= i (len l)) n
(<= i (- (len l) 4)) (recurse f l (concat n (array
(f (+ i 0) (idx l (+ i 0)))
(f (+ i 1) (idx l (+ i 1)))
(f (+ i 2) (idx l (+ i 2)))
(f (+ i 3) (idx l (+ i 3)))
)) (+ i 4))
true (recurse f l (concat n (array (f i (idx l i)))) (+ i 1)))))
(helper f l (array) 0)))
filter_i (lambda (f l)
(let (helper (rec-lambda recurse (f l n i)
(if (= i (len l))
n
(if (f i (idx l i)) (recurse f l (concat n (array (idx l i))) (+ i 1))
(recurse f l n (+ i 1))))))
(helper f l (array) 0)))
filter (lambda (f l) (filter_i (lambda (i x) (f x)) l))
not (lambda (x) (if x false true))
; Huge thanks to Oleg Kiselyov for his fantastic website
; http://okmij.org/ftp/Computation/fixed-point-combinators.html
Y* (lambda (& l)
((lambda (u) (u u))
(lambda (p)
(map (lambda (li) (lambda (& x) (lapply (lapply li (p p)) x))) l))))
vY* (lambda (& l)
((lambda (u) (u u))
(lambda (p)
(map (lambda (li) (vau ide (& x) (vapply (lapply li (p p)) x ide))) l))))
let-rec (vau de (name_func body)
(let (names (filter_i (lambda (i x) (= 0 (% i 2))) name_func)
funcs (filter_i (lambda (i x) (= 1 (% i 2))) name_func)
overwrite_name (idx name_func (- (len name_func) 2)))
(eval (array let (concat (array overwrite_name (concat (array Y*) (map (lambda (f) (array lambda names f)) funcs)))
(lapply concat (map_i (lambda (i n) (array n (array idx overwrite_name i))) names)))
body) de)))
let-vrec (vau de (name_func body)
(let (names (filter_i (lambda (i x) (= 0 (% i 2))) name_func)
funcs (filter_i (lambda (i x) (= 1 (% i 2))) name_func)
overwrite_name (idx name_func (- (len name_func) 2)))
(eval (array let (concat (array overwrite_name (concat (array vY*) (map (lambda (f) (array lambda names f)) funcs)))
(lapply concat (map_i (lambda (i n) (array n (array idx overwrite_name i))) names)))
body) de)))
flat_map (lambda (f l)
(let (helper (rec-lambda recurse (f l n i)
(if (= i (len l))
n
(recurse f l (concat n (f (idx l i))) (+ i 1)))))
(helper f l (array) 0)))
flat_map_i (lambda (f l)
(let (helper (rec-lambda recurse (f l n i)
(if (= i (len l))
n
(recurse f l (concat n (f i (idx l i))) (+ i 1)))))
(helper f l (array) 0)))
; with all this, we make a destrucutring-capable let
let (let (
destructure_helper (rec-lambda recurse (vs i r)
(cond (= (len vs) i) r
(array? (idx vs i)) (let (bad_sym (str-to-symbol (str (idx vs i)))
new_vs (flat_map_i (lambda (i x) (array x (array idx bad_sym i))) (slice (idx vs i) 1 -1))
)
(recurse (concat new_vs (slice vs (+ i 2) -1)) 0 (concat r (array bad_sym (idx vs (+ i 1))))))
true (recurse vs (+ i 2) (concat r (slice vs i (+ i 2))))
))) (vau de (vs b) (vapply let (array (destructure_helper vs 0 (array)) b) de)))
; and a destructuring-capable lambda!
only_symbols (rec-lambda recurse (a i) (cond (= i (len a)) true
(symbol? (idx a i)) (recurse a (+ i 1))
true false))
lambda (vau se (p b) (if (only_symbols p 0) (vapply lambda (array p b) se)
(let (
sym_params (map (lambda (param) (if (symbol? param) param
(str-to-symbol (str param)))) p)
body (array let (flat_map_i (lambda (i x) (array (idx p i) x)) sym_params) b)
) (wrap (eval (array vau sym_params body) se)))))
; and rec-lambda - yes it's the same definition again
rec-lambda (vau se (n p b) (eval (array Y (array lambda (array n) (array lambda p b))) se))
is_pair? (lambda (x) (and (array? x) (> (len x) 0)))
quasiquote (vY (lambda (recurse) (vau de (x)
(cond (is_pair? x)
(cond (and (symbol? (idx x 0)) (= (get-text (idx x 0)) "unquote"))
(eval (idx x 1) de)
true
(cond (and (is_pair? (idx x 0)) (symbol? (idx (idx x 0) 0)) (= (get-text (idx (idx x 0) 0)) "splice-unquote"))
(concat (eval (idx (idx x 0) 1) de) (vapply recurse (array (slice x 1 -1)) de))
true
(concat (array (vapply recurse (array (idx x 0)) de)) (vapply recurse (array (slice x 1 -1)) de))))
true x))))
repl (vY (lambda (recurse) (wrap (vau de (grammer start_symbol)
(do (recover (println (eval (read-string (get_line "> ") grammer start_symbol) de))
captured_error (println "repl caught an exception:" captured_error))
(eval (array recurse (array quote grammer) (array quote start_symbol)) de))))))
string-to-int (lambda (s) (let (
c0 (idx "0" 0)
c9 (idx "9" 0)
ca (idx "a" 0)
cz (idx "z" 0)
cA (idx "A" 0)
cZ (idx "Z" 0)
helper (rec-lambda recurse (s i radix result)
(if (< i (len s))
(let (c (idx s i))
(cond (<= c0 c c9) (recurse s (+ i 1) radix (+ (* radix result) (- (idx s i) c0)))
(<= ca c cz) (recurse s (+ i 1) radix (+ (* radix result) (+ 10 (- (idx s i) ca))))
(<= cA c cZ) (recurse s (+ i 1) radix (+ (* radix result) (+ 10 (- (idx s i) cA))))
true (error "Impossible char in string-to-int"))
)
result
)
))
(cond (= (idx s 0) (idx "-" 0)) (- (helper s 1 10 0))
(and (> (len s) 2) (or (= "0x" (slice s 0 2)) (= "0X" (slice s 0 2)))) (helper s 2 16 0)
true (helper s 0 10 0))
))
unescape-str (lambda (s) (let (
helper (rec-lambda recurse (s i r)
(cond (>= (+ 1 i) (len s)) r
(= (idx s i) (idx "\\" 0)) (cond (= (+ i 1) (len s)) "BAD ESCAPE AT END"
(= (idx s (+ i 1)) (idx "n" 0)) (recurse s (+ i 2) (str r "\n"))
(= (idx s (+ i 1)) (idx "t" 0)) (recurse s (+ i 2) (str r "\t"))
(= (idx s (+ i 1)) (idx "0" 0)) (recurse s (+ i 2) (str r "\0"))
(= (idx s (+ i 1)) (idx "\\" 0)) (recurse s (+ i 2) (str r "\\"))
(= (idx s (+ i 1)) (idx "\"" 0)) (recurse s (+ i 2) (str r "\""))
true "BAD ESCAPE IS NORMAL CHAR"
)
true (recurse s (+ i 1) (str r (slice s i (+ i 1))))
)
)) (helper s 1 "")))
basic_rules (array
(array (quote WS) (array "( | |
|(;[ -~]*
))+") (lambda (x) nil))
(array (quote number) (array "(0(x|X)([0-9]|[a-f]|[A-F])+)|(-?[0-9]+)") (lambda (x) (string-to-int x)))
(array (quote string) (array "\"([#-[]| |[]-~]|(\\\\\\\\)|(\\\\n)|(\\\\t)|(\\*)|(\\\\0)|
|[ -!]|(\\\\\"))*\"") (lambda (x) (unescape-str x)))
(array (quote bool_nil_symbol) (array "-|(([a-z]|[A-Z]|_|\\*|/|\\?|\\+|!|=|&|\\||<|>|%|$|\\.)([a-z]|[A-Z]|_|[0-9]|\\*|\\?|\\+|-|!|=|&|\\||<|>|%|$|\\.)*)") (lambda (x) (cond (= "true" x) true
(= "false" x) false
(= "nil" x) nil
true (str-to-symbol x))))
)
provide (vau de (& items) (array let
(flat_map (lambda (item) (array item (array quote (eval item de)))) items)))
scope_let_sans_import_gram (provide
root_env
current-env
lambda
rec-lambda
let
let-rec
let-vrec
do
if
cons
map
map_i
flat_map
flat_map_i
filter_i
filter
not
lapply
vapply
lcompose
Y
vY
Y*
quote
quasiquote
repl
provide
print_through
basic_rules
)
insert_into_scope_let (lambda (scope_let name item) (array (idx scope_let 0) (concat (idx scope_let 1) (array name (array quote item)))))
scope_let (let-vrec (
with_import (vau de (lib_path code)
(let (imported_scope_let (eval (concat
(insert_into_scope_let
(insert_into_scope_let scope_let_sans_import_gram (quote standard_grammar) (gen_standard_grammar))
(quote with_import) with_import)
(array (read-string (slurp (eval lib_path de)) (gen_standard_grammar) (quote start_symbol)))) root_env))
(eval (concat imported_scope_let (array code)) de)))
gen_standard_grammar (vau de () (concat basic_rules (array
(array (quote form) (array (quote number)) (lambda (x) x))
(array (quote form) (array (quote string)) (lambda (x) x))
(array (quote form) (array (quote bool_nil_symbol)) (lambda (x) x))
(array (quote form) (array "\\(" (quote WS) * "\\)" ) (lambda (_ _ _) (array)))
(array (quote form) (array "\\(" (quote WS) * (quote form) (array (quote WS) + (quote form)) * (quote WS) * "\\)" ) (lambda (_ _ head tail _ _) (concat (array head) (map (lambda (x) (idx x 1)) tail))))
(array (quote form) (array "\\[" (quote WS) * "\\]" ) (lambda (_ _ _) (array array)))
(array (quote form) (array "\\[" (quote WS) * (quote form) (array (quote WS) + (quote form)) * (quote WS) * "\\]" ) (lambda (_ _ head tail _ _) (concat (array array head) (map (lambda (x) (idx x 1)) tail))))
(array (quote form) (array "'" (quote WS) * (quote form)) (lambda (_ _ x) (array quote x)))
(array (quote form) (array "`" (quote WS) * (quote form)) (lambda (_ _ x) (array quasiquote x)))
(array (quote form) (array "~" (quote WS) * (quote form)) (lambda (_ _ x) (array (quote unquote) x)))
(array (quote form) (array "," (quote WS) * (quote form)) (lambda (_ _ x) (array (quote splice-unquote) x)))
(array (quote start_symbol) (array (quote WS) * (quote form) (quote WS) *) (lambda (_ f _) f))
(array (quote start_symbol) (array (quote WS) * "#lang" (quote WS) (quote form) (quote WS) (quote form) "([ -~]|
)*")
(lambda (_ _ _ gram _ symbol source) (do (println "gonna do that # yo") (read-string source
(eval (concat
(insert_into_scope_let
(insert_into_scope_let scope_let_sans_import_gram (quote standard_grammar) (gen_standard_grammar))
(quote with_import) with_import)
(array gram)) root_env)
symbol))))
)))
)
(insert_into_scope_let
(insert_into_scope_let scope_let_sans_import_gram (quote standard_grammar) (gen_standard_grammar))
(quote with_import) with_import)
)
standard_grammar (eval (concat scope_let (array (quote standard_grammar))) root_env)
)
(do
(println "Welcome to Kraken! Parameters were" *ARGV*)
(cond (and (>= (len *ARGV*) 3) (= "-C" (idx *ARGV* 1))) (eval (concat scope_let (array (read-string (idx *ARGV* 2) standard_grammar (quote start_symbol)))) root_env)
(> (len *ARGV*) 1) (eval (concat scope_let (array (read-string (slurp (idx *ARGV* 1)) standard_grammar (quote start_symbol)))) root_env)
true (eval (concat scope_let (array (array repl (array quote standard_grammar) (array quote (quote start_symbol))))) root_env)
)
)
)
)))))))))) ; end of all the let1's
; impl of let1
)) (vau de (s v b) (eval (array (array vau (array s) b) (eval v de)) de)))
; impl of quote
)) (vau (x) x))

132
working_files/rb.kp
View File

@@ -1,132 +0,0 @@
(with_import "./match.kp"
(let (
; This is based on https://www.cs.cornell.edu/courses/cs3110/2020sp/a4/deletion.pdf
; and the figure references refer to it
; Insert is taken from the same paper, but is origional to Okasaki, I belive
; The tree has been modified slightly to take in a comparison function
; and override if insert replaces or not to allow use as a set or as a map
; I think this is actually pretty cool - instead of having a bunch of seperate ['B]
; be our leaf node, we use ['B] with all nils. This allows us to not use -B, as
; both leaf and non-leaf 'BB has the same structure with children! Also, we make
; sure to use empty itself so we don't make a ton of empties...
empty ['B nil nil nil]
E empty
EE ['BB nil nil nil]
size (rec-lambda recurse (t) (match t
~E 0
[c a x b] (+ 1 (recurse a) (recurse b))))
generic-foldl (rec-lambda recurse (f z t) (match t
~E z
[c a x b] (recurse f (f (recurse f z a) x) b)))
generic-contains? (rec-lambda recurse (t cmp v found not-found) (match t
~E (not-found)
[c a x b] (match (cmp v x) '< (recurse a cmp v found not-found)
'= (found x)
'> (recurse b cmp v found not-found))))
blacken (lambda (t) (match t
['R a x b] ['B a x b]
t t))
balance (lambda (t) (match t
; figures 1 and 2
['B ['R ['R a x b] y c] z d] ['R ['B a x b] y ['B c z d]]
['B ['R a x ['R b y c]] z d] ['R ['B a x b] y ['B c z d]]
['B a x ['R ['R b y c] z d]] ['R ['B a x b] y ['B c z d]]
['B a x ['R b y ['R c z d]]] ['R ['B a x b] y ['B c z d]]
; figure 8, double black cases
['BB ['R a x ['R b y c]] z d] ['B ['B a x b] y ['B c z d]]
['BB a x ['R ['R b y c] z d]] ['B ['B a x b] y ['B c z d]]
; already balenced
t t))
generic-insert (lambda (t cmp v replace) (let (
ins (rec-lambda ins (t) (match t
~E ['R t v t]
[c a x b] (match (cmp v x) '< (balance [c (ins a) x b])
'= (if replace [c a v b]
t)
'> (balance [c a x (ins b)]))))
) (blacken (ins t))))
rotate (lambda (t) (match t
; case 1, fig 6
['R ['BB a x b] y ['B c z d]] (balance ['B ['R ['B a x b] y c] z d])
['R ['B a x b] y ['BB c z d]] (balance ['B a x ['R b y ['B c z d]]])
; case 2, figure 7
['B ['BB a x b] y ['B c z d]] (balance ['BB ['R ['B a x b] y c] z d])
['B ['B a x b] y ['BB c z d]] (balance ['BB a x ['R b y ['B c z d]]])
; case 3, figure 9
['B ['BB a w b] x ['R ['B c y d] z e]] ['B (balance ['B ['R ['B a w b] x c] y d]) z e]
['B ['R a w ['B b x c]] y ['BB d z e]] ['B a w (balance ['B b x ['R c y ['B d z e]]])]
; fall through
t t))
redden (lambda (t) (match t
['B a x b] (if (and (= 'B (idx a 0)) (= 'B (idx b 0))) ['R a x b]
t)
t t))
min_delete (rec-lambda recurse (t) (match t
~E (error "min_delete empty tree")
['R ~E x ~E] [x E]
['B ~E x ~E] [x EE]
['B ~E x ['R a y b]] [x ['B a y b]]
[c a x b] (let ((v ap) (recurse a)) [v (rotate [c ap x b])])))
generic-delete (lambda (t cmp v) (let (
del (rec-lambda del (t v) (match t
; figure 3
~E t
; figure 4
['R ~E x ~E] (match (cmp v x) '= E
_ t)
['B ['R a x b] y ~E] (match (cmp v y) '< (rotate ['B (del ['R a x b] v) y ~E])
'= ['B a x b]
'> t)
; figure 5
['B ~E x ~E] (match (cmp v x) '= EE
_ t)
[c a x b] (match (cmp v x) '< (rotate [c (del a v) x b])
'= (let ([vp bp] (min_delete b))
(rotate [c a vp bp]))
'> (rotate [c a x (del b v)]))))
) (del (redden t) v)))
set-cmp (lambda (a b) (cond (< a b) '<
(= a b) '=
true '>))
set-empty empty
set-foldl generic-foldl
set-insert (lambda (t x) (generic-insert t set-cmp x false))
set-contains? (lambda (t x) (generic-contains? t set-cmp x (lambda (f) true) (lambda () false)))
set-remove (lambda (t x) (generic-delete t set-cmp x))
map-cmp (lambda (a b) (let (ak (idx a 0)
bk (idx b 0))
(cond (< ak bk) '<
(= ak bk) '=
true '>)))
map-empty empty
map-insert (lambda (t k v) (generic-insert t map-cmp [k v] true))
map-contains-key? (lambda (t k) (generic-contains? t map-cmp [k nil] (lambda (f) true) (lambda () false)))
map-get (lambda (t k) (generic-contains? t map-cmp [k nil] (lambda (f) (idx f 1)) (lambda () (error (str "didn't find key " k " in map " t)))))
map-get-or-default (lambda (t k d) (generic-contains? t map-cmp [k nil] (lambda (f) (idx f 1)) (lambda () d)))
map-get-with-default (lambda (t k d) (generic-contains? t map-cmp [k nil] (lambda (f) (idx f 1)) (lambda () (d))))
map-remove (lambda (t k) (generic-delete t map-cmp [k nil]))
; This could be 2x as efficent by being implmented on generic instead of map,
; as we wouldn't have to traverse once to find and once to insert
multimap-empty map-empty
multimap-insert (lambda (t k v) (map-insert t k (set-insert (map-get-or-default t k set-empty) v)))
multimap-get (lambda (t k) (map-get-or-default t k set-empty))
)
(provide set-empty set-foldl set-insert set-contains? set-remove
map-empty map-insert map-contains-key? map-get map-get-or-default map-get-with-default map-remove
multimap-empty multimap-insert multimap-get
size)
))

Some files were not shown because too many files have changed in this diff Show More