fix the merge conflicts
This commit is contained in:
Scott Richmond
commit
940fc8ec31
4
.gitignore
vendored
4
.gitignore
vendored
|
|
@ -29,3 +29,7 @@ node_modules/
|
||||||
.cljs_node_repl/
|
.cljs_node_repl/
|
||||||
.helix/
|
.helix/
|
||||||
target/repl-port
|
target/repl-port
|
||||||
|
.repl-buffer
|
||||||
|
.repl-buffer.janet
|
||||||
|
.env
|
||||||
|
src/jpm_tree
|
||||||
|
|
|
||||||
24
CHANGELOG.md
24
CHANGELOG.md
|
|
@ -1,24 +0,0 @@
|
||||||
# Change Log
|
|
||||||
All notable changes to this project will be documented in this file. This change log follows the conventions of [keepachangelog.com](http://keepachangelog.com/).
|
|
||||||
|
|
||||||
## [Unreleased]
|
|
||||||
### Changed
|
|
||||||
- Add a new arity to `make-widget-async` to provide a different widget shape.
|
|
||||||
|
|
||||||
## [0.1.1] - 2021-10-23
|
|
||||||
### Changed
|
|
||||||
- Documentation on how to make the widgets.
|
|
||||||
|
|
||||||
### Removed
|
|
||||||
- `make-widget-sync` - we're all async, all the time.
|
|
||||||
|
|
||||||
### Fixed
|
|
||||||
- Fixed widget maker to keep working when daylight savings switches over.
|
|
||||||
|
|
||||||
## 0.1.0 - 2021-10-23
|
|
||||||
### Added
|
|
||||||
- Files from the new template.
|
|
||||||
- Widget maker public API - `make-widget-sync`.
|
|
||||||
|
|
||||||
[Unreleased]: https://sourcehost.site/your-name/cludus/compare/0.1.1...HEAD
|
|
||||||
[0.1.1]: https://sourcehost.site/your-name/cludus/compare/0.1.0...0.1.1
|
|
||||||
55
TODO.xit
55
TODO.xit
|
|
@ -1,55 +0,0 @@
|
||||||
|
|
||||||
[x] Fix recursive definition problems in grammar.clj
|
|
||||||
|
|
||||||
TODOS for parser
|
|
||||||
[ ] Make parser errors pretty
|
|
||||||
[ ] Use synchronization to make parsing more robust
|
|
||||||
[ ] Decide on synchronization tokens: [then else ] ) } , ; \n]
|
|
||||||
|
|
||||||
TODOS from interpreter
|
|
||||||
[x] implement tuple splat patterns
|
|
||||||
[x] update match-list to use new AST representation
|
|
||||||
[x] fix length comparison when pattern includes splats
|
|
||||||
[x] update match-dict to use new AST representation
|
|
||||||
[x] update match-struct to use new AST representation
|
|
||||||
[ ] update interpret-receive to use new AST representation
|
|
||||||
[ ] Check interpret-fn-inner ctx for cycles/bugs
|
|
||||||
|
|
||||||
Re-add processes to the language
|
|
||||||
[ ] Write send as function
|
|
||||||
[ ] update interpret-spawn to use new AST representation
|
|
||||||
[ ] ---- Investigate weird timing issue in current send implementation
|
|
||||||
[ ] Investigate `with-bindings` and virtual threads
|
|
||||||
|
|
||||||
Finish interpreter
|
|
||||||
[x] Wire up new interpreter to repl, script situation
|
|
||||||
[x] Merge new interpreter
|
|
||||||
|
|
||||||
Conditionals
|
|
||||||
[ ] Fix let bindings/scope in `if` expressions
|
|
||||||
[ ] Make `and` and `or` special forms
|
|
||||||
[ ] ---- `if and (let x ...)` pattern
|
|
||||||
[ ] ---- arguments are lazily, not eagerly, executed
|
|
||||||
|
|
||||||
Write a compiler: desugaring
|
|
||||||
[~] `...` to `..._` in tuple & list patterns
|
|
||||||
[ ] placeholder partial application to anonymous lambda
|
|
||||||
[ ] word -> :[word] word in pairs (patterns & expressions)
|
|
||||||
|
|
||||||
Write a compiler: correctness
|
|
||||||
[ ] check for unbound names
|
|
||||||
[ ] check for re-binding names
|
|
||||||
[ ] check that recur is in tail position
|
|
||||||
[ ] check that recur is only called inside loop or fn forms
|
|
||||||
[ ] check ns accesses
|
|
||||||
[ ] prevent import cycles
|
|
||||||
[ ] splattern is last member in a pattern
|
|
||||||
[ ] -----List/Tuple
|
|
||||||
[ ] -----Dict/Struct/Set
|
|
||||||
|
|
||||||
Write a compiler: optimization
|
|
||||||
[ ] devise tail call optimization
|
|
||||||
|
|
||||||
Next steps
|
|
||||||
[ ] Get drawing working?
|
|
||||||
[ ] Add stack traces for panics
|
|
||||||
|
|
@ -1,8 +0,0 @@
|
||||||
<html>
|
|
||||||
<head>
|
|
||||||
<title>Hello, world!</title>
|
|
||||||
</head>
|
|
||||||
<body>
|
|
||||||
<script src="main.js"></script>
|
|
||||||
</body>
|
|
||||||
</html>
|
|
||||||
143
build/driver.cpp
Normal file
143
build/driver.cpp
Normal file
|
|
@ -0,0 +1,143 @@
|
||||||
|
#include <cstdint>
|
||||||
|
#include <emscripten.h>
|
||||||
|
#include <emscripten/bind.h>
|
||||||
|
#include <string>
|
||||||
|
#include <stdio.h>
|
||||||
|
#include "janet.h"
|
||||||
|
|
||||||
|
using std::string;
|
||||||
|
|
||||||
|
// set all our exported Janet functions as null pointers
|
||||||
|
static JanetFunction *janet_ludus = NULL;
|
||||||
|
static JanetFunction *janet_hello = NULL;
|
||||||
|
|
||||||
|
// these let us look up functions
|
||||||
|
Janet env_lookup(JanetTable *env, const char *name) {
|
||||||
|
Janet out;
|
||||||
|
janet_resolve(env, janet_csymbol(name), &out);
|
||||||
|
return out;
|
||||||
|
}
|
||||||
|
|
||||||
|
JanetFunction *env_lookup_function(JanetTable *env, const char *name) {
|
||||||
|
Janet value = env_lookup(env, name);
|
||||||
|
if (!janet_checktype(value, JANET_FUNCTION)) {
|
||||||
|
janet_panicf("expected %s to be a function, got %q\n", name, value);
|
||||||
|
}
|
||||||
|
return janet_unwrap_function(value);
|
||||||
|
}
|
||||||
|
|
||||||
|
// this lets us call a function
|
||||||
|
bool call_fn(JanetFunction *fn, int argc, const Janet *argv, Janet *out) {
|
||||||
|
JanetFiber *fiber = NULL;
|
||||||
|
if (janet_pcall(fn, argc, argv, out, &fiber) == JANET_SIGNAL_OK) {
|
||||||
|
return true;
|
||||||
|
} else {
|
||||||
|
janet_stacktrace(fiber, *out);
|
||||||
|
return false;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
// this is darkish magic, reads an embedded file
|
||||||
|
// do not fuck with this, fellas
|
||||||
|
unsigned char *read_file(const char *filename, size_t *length) {
|
||||||
|
size_t capacity = 2 << 17;
|
||||||
|
unsigned char *src = (unsigned char *)malloc(capacity * sizeof(unsigned char));
|
||||||
|
assert(src);
|
||||||
|
size_t total_bytes_read = 0;
|
||||||
|
FILE *file = fopen(filename, "r");
|
||||||
|
assert(file);
|
||||||
|
size_t bytes_read;
|
||||||
|
do {
|
||||||
|
size_t remaining_capacity = capacity - total_bytes_read;
|
||||||
|
if (remaining_capacity == 0) {
|
||||||
|
capacity <<= 1;
|
||||||
|
src = (unsigned char*)realloc(src, capacity * sizeof(unsigned char));
|
||||||
|
assert(src);
|
||||||
|
remaining_capacity = capacity - total_bytes_read;
|
||||||
|
}
|
||||||
|
|
||||||
|
bytes_read = fread(&src[total_bytes_read], sizeof(unsigned char), remaining_capacity, file);
|
||||||
|
total_bytes_read += bytes_read;
|
||||||
|
} while (bytes_read > 0);
|
||||||
|
|
||||||
|
fclose(file);
|
||||||
|
*length = total_bytes_read;
|
||||||
|
return src;
|
||||||
|
}
|
||||||
|
|
||||||
|
// these are the C++ functions that wrap our Janet functions
|
||||||
|
// simplest case: takes nothing, returns nothing
|
||||||
|
void hello() {
|
||||||
|
Janet result; // we need a place to put the result
|
||||||
|
// args are: fn ptr, argc, argv, result
|
||||||
|
call_fn(janet_hello, 0, {}, &result);
|
||||||
|
}
|
||||||
|
|
||||||
|
// finally, getting a string back
|
||||||
|
// this is our result type
|
||||||
|
struct StringResult {
|
||||||
|
string value;
|
||||||
|
};
|
||||||
|
|
||||||
|
// this is our result constructor
|
||||||
|
// Janet's getcstring resturns const char*
|
||||||
|
StringResult string_result(const char* cstr) {
|
||||||
|
// ...which we have to cast to a std::string
|
||||||
|
return (StringResult) {.value = (string) cstr };
|
||||||
|
}
|
||||||
|
|
||||||
|
// and this is a function that takes and returns a string
|
||||||
|
// it returns a StringResult, tho
|
||||||
|
StringResult ludus(string source) {
|
||||||
|
Janet result;
|
||||||
|
const Janet args[1] = {janet_cstringv(source.c_str())};
|
||||||
|
call_fn(janet_ludus, 1, args, &result);
|
||||||
|
// get the cstring in the result
|
||||||
|
// the 0 passed here is the index in the result of the string
|
||||||
|
const char* cstr = janet_getcstring(&result, 0);
|
||||||
|
// return a constructed StringResult
|
||||||
|
return string_result(cstr);
|
||||||
|
}
|
||||||
|
|
||||||
|
// This function sets up our Janet interpreter, and fixes the null pointers
|
||||||
|
EMSCRIPTEN_KEEPALIVE
|
||||||
|
int main() {
|
||||||
|
janet_init(); // start the interpreter
|
||||||
|
JanetTable *core_env = janet_core_env(NULL); // get a core env
|
||||||
|
JanetTable *lookup = janet_env_lookup(core_env); // and get an env table
|
||||||
|
|
||||||
|
// load the janet image into memory
|
||||||
|
// note that the image is hardcoded here
|
||||||
|
size_t image_length;
|
||||||
|
unsigned char *image = read_file("ludus.jimage", &image_length);
|
||||||
|
|
||||||
|
// load the image into the Janet environment
|
||||||
|
Janet env = janet_unmarshal(image, image_length, 0, lookup, NULL);
|
||||||
|
|
||||||
|
if(!janet_checktype(env, JANET_TABLE)) {
|
||||||
|
janet_panicf("invalid image %q", env);
|
||||||
|
}
|
||||||
|
|
||||||
|
// fix the null pointers, as above
|
||||||
|
// note that the bound symbols are just the normal fn names
|
||||||
|
// no namespacing
|
||||||
|
janet_ludus = env_lookup_function(janet_unwrap_table(env), "ludus");
|
||||||
|
janet_gcroot(janet_wrap_function(janet_ludus));
|
||||||
|
|
||||||
|
janet_hello = env_lookup_function(janet_unwrap_table(env), "hello");
|
||||||
|
janet_gcroot(janet_wrap_function(janet_hello));
|
||||||
|
}
|
||||||
|
|
||||||
|
// these bindings are exported into javascript
|
||||||
|
EMSCRIPTEN_BINDINGS(module) {
|
||||||
|
using namespace emscripten;
|
||||||
|
|
||||||
|
// these are the functions that will be available
|
||||||
|
function("ludus", &ludus, allow_raw_pointers());
|
||||||
|
function("hello", &hello, allow_raw_pointers());
|
||||||
|
|
||||||
|
// we also want a wrapper for our StringResult
|
||||||
|
// we won't access it directly, but emcc makes it nice
|
||||||
|
value_object<StringResult>("StringResult")
|
||||||
|
.field("value", &StringResult::value);
|
||||||
|
}
|
||||||
51563
build/janet.c
Normal file
51563
build/janet.c
Normal file
File diff suppressed because it is too large
Load Diff
2277
build/janet.h
Normal file
2277
build/janet.h
Normal file
File diff suppressed because it is too large
Load Diff
15
build/justfile
Normal file
15
build/justfile
Normal file
|
|
@ -0,0 +1,15 @@
|
||||||
|
build:
|
||||||
|
# compile the janet into an image
|
||||||
|
# janet -c src/ludus.janet build/ludus.jimage
|
||||||
|
# the complex emscripten invocation
|
||||||
|
# note we have the stack size set to 1024*1024 (1 MB)
|
||||||
|
emcc \
|
||||||
|
-o out.mjs \
|
||||||
|
janet.c driver.cpp \
|
||||||
|
--embed-file ludus.jimage \
|
||||||
|
-lembind \
|
||||||
|
-s "EXPORTED_FUNCTIONS=['_main']" \
|
||||||
|
-s EXPORT_ES6 \
|
||||||
|
-s ALLOW_MEMORY_GROWTH=1 \
|
||||||
|
-s STACK_SIZE=1048576 \
|
||||||
|
-s MODULARIZE
|
||||||
BIN
build/ludus.jimage
Normal file
BIN
build/ludus.jimage
Normal file
Binary file not shown.
8
build/ludus.mjs
Normal file
8
build/ludus.mjs
Normal file
|
|
@ -0,0 +1,8 @@
|
||||||
|
import init from "./out.mjs"
|
||||||
|
|
||||||
|
const mod = await init()
|
||||||
|
|
||||||
|
export function run (source) {
|
||||||
|
const result = mod.ludus(source).value
|
||||||
|
return JSON.parse(result)
|
||||||
|
}
|
||||||
7170
build/out.mjs
Normal file
7170
build/out.mjs
Normal file
File diff suppressed because it is too large
Load Diff
BIN
build/out.wasm
Executable file
BIN
build/out.wasm
Executable file
Binary file not shown.
11
build/test.mjs
Normal file
11
build/test.mjs
Normal file
|
|
@ -0,0 +1,11 @@
|
||||||
|
console.log("Starting wasm test run.")
|
||||||
|
|
||||||
|
import init from "./out.mjs"
|
||||||
|
|
||||||
|
console.log("Imported module")
|
||||||
|
|
||||||
|
const mod = await init()
|
||||||
|
|
||||||
|
console.log("Initted module")
|
||||||
|
|
||||||
|
console.log(mod.ludus(":hello_from_ludus").value)
|
||||||
17
deps.edn
17
deps.edn
|
|
@ -1,17 +0,0 @@
|
||||||
{:deps
|
|
||||||
{org.clojure/clojurescript {:mvn/version "1.11.121"}
|
|
||||||
thheller/shadow-cljs {:mvn/version "2.26.0"}
|
|
||||||
babashka/fs {:mvn/version "0.4.19"}
|
|
||||||
}
|
|
||||||
|
|
||||||
:source-paths ["src/ludus"]
|
|
||||||
|
|
||||||
:aliases
|
|
||||||
{:main
|
|
||||||
{:exec-fn ludus.core/main!}
|
|
||||||
:repl
|
|
||||||
{:exec-fn clojure.core.server/start-server
|
|
||||||
:exec-args {:name "repl"
|
|
||||||
:port 5555
|
|
||||||
:accept clojure.core.server/repl
|
|
||||||
:server-daemon false}}}}
|
|
||||||
|
|
@ -1,7 +0,0 @@
|
||||||
#!/opt/homebrew/bin/fish
|
|
||||||
|
|
||||||
jenv shell graalvm64-19.0.2
|
|
||||||
|
|
||||||
lein uberjar
|
|
||||||
|
|
||||||
native-image --enable-preview --report-unsupported-elements-at-runtime --initialize-at-build-time -jar ./target/ludus-0.1.0-SNAPSHOT-standalone.jar -H:Name=./target/ludus
|
|
||||||
22
justfile
22
justfile
|
|
@ -1,6 +1,20 @@
|
||||||
# start a repl
|
# open a janet repl in a different os window
|
||||||
repl:
|
repl:
|
||||||
clj -X:repl
|
kitten @ launch --type=os-window --allow-remote-control --cwd=current --title=hx_repl:ludus --keep-focus
|
||||||
|
kitten @ send-text -m "title:hx_repl:ludus" "janet -s\n"
|
||||||
|
|
||||||
build:
|
restart:
|
||||||
shadow-cljs release module
|
kitten @ send-text -m "title:hx_repl:ludus" "\04"
|
||||||
|
kitten @ send-text -m "title:hx_repl:ludus" "janet -s\n"
|
||||||
|
|
||||||
|
# send what's selected to the repl and evaluate it
|
||||||
|
eval:
|
||||||
|
sd "$" "\n" | sd "\n\n" "\n" | kitten @ send-text -m "title:hx_repl:ludus" --stdin
|
||||||
|
|
||||||
|
# send what's selected to a buffer, and then evaluate what's in the buffer
|
||||||
|
buffer:
|
||||||
|
sd "$" "\n" | sd "\n\n" "\n" > .repl-buffer.janet
|
||||||
|
kitten @ send-text -m "title:hx_repl:ludus" "(import ./.repl-buffer :prefix \"\")"
|
||||||
|
|
||||||
|
doc:
|
||||||
|
sd "$" "\n" | sd "\n\n" "\n" | xargs -I _ echo "(doc " _ ")" | kitten @ send-text -m "title:hx_repl:ludus" --stdin
|
||||||
|
|
|
||||||
|
|
@ -1,19 +0,0 @@
|
||||||
{
|
|
||||||
"folders":
|
|
||||||
[
|
|
||||||
{
|
|
||||||
"path": "."
|
|
||||||
}
|
|
||||||
],
|
|
||||||
"settings": {
|
|
||||||
"on_post_save_project": [
|
|
||||||
{
|
|
||||||
"command": "exec",
|
|
||||||
"args": {
|
|
||||||
"shell_cmd": "lein cljfmt fix"
|
|
||||||
},
|
|
||||||
"scope": "window"
|
|
||||||
}
|
|
||||||
]
|
|
||||||
}
|
|
||||||
}
|
|
||||||
14
package.json
14
package.json
|
|
@ -1,18 +1,16 @@
|
||||||
{
|
{
|
||||||
"name": "@ludus/ludus-js-pure",
|
"name": "@ludus/ludus-js-pure",
|
||||||
"version": "0.1.3",
|
"version": "0.1.0-alpha.10",
|
||||||
"description": "A Ludus interpreter in a pure JS function.",
|
"description": "A Ludus interpreter in a pure JS function.",
|
||||||
"main": "target/js/ludus.js",
|
|
||||||
"type": "module",
|
"type": "module",
|
||||||
|
"main": "build/ludus.mjs",
|
||||||
"directories": {},
|
"directories": {},
|
||||||
"keywords": [],
|
"keywords": [],
|
||||||
"author": "Scott Richmond",
|
"author": "Scott Richmond",
|
||||||
"license": "GPL-3.0",
|
"license": "GPL-3.0",
|
||||||
"files": [
|
"files": [
|
||||||
"target/js/*"
|
"build/out.wasm",
|
||||||
],
|
"build/out.mjs",
|
||||||
"devDependencies": {
|
"build/ludus.mjs"],
|
||||||
"shadow-cljs": "^2.26.0",
|
"devDependencies": {}
|
||||||
"tap": "^18.6.1"
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
|
|
|
||||||
|
|
@ -3,22 +3,22 @@
|
||||||
& the goal is to output any global state held in Ludus
|
& the goal is to output any global state held in Ludus
|
||||||
& this does not have base loaded into it, only prelude: must be pure Ludus
|
& this does not have base loaded into it, only prelude: must be pure Ludus
|
||||||
|
|
||||||
if turtle_state() :visible? then render_turtle! () else nil
|
if turtle_state () :visible? then render_turtle! () else nil
|
||||||
|
|
||||||
reset_turtle! ()
|
reset_turtle! ()
|
||||||
|
|
||||||
let console_msgs = flush! ()
|
& let console_msgs = flush! ()
|
||||||
|
|
||||||
let (r, g, b, a) = deref (bgcolor)
|
let (r, g, b, a) = unbox (bgcolor)
|
||||||
make! (bgcolor, colors :black)
|
store! (bgcolor, colors :black)
|
||||||
|
|
||||||
let draw_calls = deref (p5_calls)
|
let draw_calls = unbox (p5_calls)
|
||||||
make! (p5_calls, [])
|
store! (p5_calls, [])
|
||||||
|
|
||||||
#{
|
#{
|
||||||
& :result result is provided elsewhere
|
& :result result is provided elsewhere
|
||||||
& :errors [] & if we get here there are no errors
|
& :errors [] & if we get here there are no errors
|
||||||
:console console_msgs
|
& :console console_msgs
|
||||||
:draw concat (
|
:draw concat (
|
||||||
[(:background, r, g, b, a), (:stroke, 255, 255, 255, 255)]
|
[(:background, r, g, b, a), (:stroke, 255, 255, 255, 255)]
|
||||||
draw_calls)
|
draw_calls)
|
||||||
|
|
@ -7,6 +7,29 @@
|
||||||
& tuple?
|
& tuple?
|
||||||
& ref?
|
& ref?
|
||||||
|
|
||||||
|
& some forward declarations
|
||||||
|
& TODO: fix this so that we don't need (as many of) them
|
||||||
|
fn first
|
||||||
|
fn append
|
||||||
|
fn some?
|
||||||
|
fn update!
|
||||||
|
fn string
|
||||||
|
fn join
|
||||||
|
fn neg?
|
||||||
|
fn atan/2
|
||||||
|
fn mod
|
||||||
|
fn assoc?
|
||||||
|
fn dict
|
||||||
|
fn get
|
||||||
|
fn unbox
|
||||||
|
fn store!
|
||||||
|
fn turn/rad
|
||||||
|
fn deg/rad
|
||||||
|
fn floor
|
||||||
|
fn and
|
||||||
|
fn apply_command
|
||||||
|
fn state/call
|
||||||
|
|
||||||
& the very base: know something's type
|
& the very base: know something's type
|
||||||
fn type {
|
fn type {
|
||||||
"Returns a keyword representing the type of the value passed in."
|
"Returns a keyword representing the type of the value passed in."
|
||||||
|
|
@ -28,6 +51,40 @@ fn eq? {
|
||||||
else false
|
else false
|
||||||
}
|
}
|
||||||
|
|
||||||
|
&&& true & false: boolean logic (part the first)
|
||||||
|
fn bool? {
|
||||||
|
"Returns true if a value is of type :boolean."
|
||||||
|
(false) -> true
|
||||||
|
(true) -> true
|
||||||
|
(_) -> false
|
||||||
|
}
|
||||||
|
|
||||||
|
fn true? {
|
||||||
|
"Returns true if a value is boolean `true`. Useful to distinguish between `true` and anything else."
|
||||||
|
(true) -> true
|
||||||
|
(_) -> false
|
||||||
|
}
|
||||||
|
|
||||||
|
fn false? {
|
||||||
|
"Returns `true` if a value is `false`, otherwise returns `false`. Useful to distinguish between `false` and `nil`."
|
||||||
|
(false) -> true
|
||||||
|
(_) -> false
|
||||||
|
}
|
||||||
|
|
||||||
|
fn bool {
|
||||||
|
"Returns false if a value is nil or false, otherwise returns true."
|
||||||
|
(nil) -> false
|
||||||
|
(false) -> false
|
||||||
|
(_) -> true
|
||||||
|
}
|
||||||
|
|
||||||
|
fn not {
|
||||||
|
"Returns false if a value is truthy, true if a value is falsy."
|
||||||
|
(nil) -> true
|
||||||
|
(false) -> true
|
||||||
|
(_) -> false
|
||||||
|
}
|
||||||
|
|
||||||
fn neq? {
|
fn neq? {
|
||||||
"Returns true if none of the arguments have the same value."
|
"Returns true if none of the arguments have the same value."
|
||||||
(x) -> false
|
(x) -> false
|
||||||
|
|
@ -73,63 +130,13 @@ fn dec {
|
||||||
(x as :number) -> base :dec (x)
|
(x as :number) -> base :dec (x)
|
||||||
}
|
}
|
||||||
|
|
||||||
fn at {
|
|
||||||
"Returns the element at index n of a list or tuple. Zero-indexed: the first element is at index 0."
|
|
||||||
(xs as :list, n as :number) -> when {
|
|
||||||
neg? (n) -> nil
|
|
||||||
gte? (n, count (xs)) -> nil
|
|
||||||
else -> base :nth (xs, inc (n))
|
|
||||||
}
|
|
||||||
(xs as :tuple, n as :number) -> when {
|
|
||||||
neg? (n) -> nil
|
|
||||||
gte? (n, count (xs)) -> nil
|
|
||||||
else -> base :nth (xs, inc (n))
|
|
||||||
}
|
|
||||||
(_) -> nil
|
|
||||||
}
|
|
||||||
|
|
||||||
fn first {
|
|
||||||
"Returns the first element of a list or tuple."
|
|
||||||
(xs) -> at (xs, 0)
|
|
||||||
}
|
|
||||||
|
|
||||||
fn second {
|
|
||||||
"Returns the second element of a list or tuple."
|
|
||||||
(xs) -> at (xs, 1)
|
|
||||||
}
|
|
||||||
|
|
||||||
fn last {
|
|
||||||
"Returns the last element of a list or tuple."
|
|
||||||
(xs) -> at (xs, sub (count (xs), 1))
|
|
||||||
}
|
|
||||||
|
|
||||||
fn butlast {
|
|
||||||
"Returns a list, omitting the last element."
|
|
||||||
(xs as :list) -> base :slice (xs, sub (count (xs), 1))
|
|
||||||
}
|
|
||||||
|
|
||||||
fn slice {
|
|
||||||
"Returns a slice of a list, representing a sub-list."
|
|
||||||
(xs as :list, end as :number) -> slice (xs, 0, end)
|
|
||||||
(xs as :list, start as :number, end as :number) -> when {
|
|
||||||
gte? (start, end) -> []
|
|
||||||
gt? (end, count (xs)) -> slice (xs, start, count (xs))
|
|
||||||
neg? (start) -> slice (xs, 0, end)
|
|
||||||
else -> {
|
|
||||||
let slice = base :slice (xs, inc (start), inc (end))
|
|
||||||
base :into ([], slice)
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
fn count {
|
fn count {
|
||||||
"Returns the number of elements in a collection (including string)."
|
"Returns the number of elements in a collection (including string)."
|
||||||
(xs as :list) -> dec (base :count (xs))
|
(xs as :list) -> base :count (xs)
|
||||||
(xs as :tuple) -> dec (base :count (xs))
|
(xs as :tuple) -> base :count (xs)
|
||||||
(xs as :dict) -> base :count (xs)
|
(xs as :dict) -> base :count (xs)
|
||||||
(xs as :string) -> base :count (xs)
|
(xs as :string) -> base :count (xs)
|
||||||
(xs as :set) -> base :count (xs)
|
(xs as :set) -> base :count (xs)
|
||||||
(xs as :struct) -> dec (base :count (xs))
|
|
||||||
}
|
}
|
||||||
|
|
||||||
fn empty? {
|
fn empty? {
|
||||||
|
|
@ -142,6 +149,16 @@ fn empty? {
|
||||||
(_) -> false
|
(_) -> false
|
||||||
}
|
}
|
||||||
|
|
||||||
|
fn any? {
|
||||||
|
"Returns true if something is not empty, otherwise returns false (including for things that can't be logically full, like numbers)."
|
||||||
|
([...]) -> true
|
||||||
|
(#{...}) -> true
|
||||||
|
(s as :set) -> not (empty? (s))
|
||||||
|
((...)) -> true
|
||||||
|
(s as :string) -> not (empty? (s))
|
||||||
|
(_) -> false
|
||||||
|
}
|
||||||
|
|
||||||
fn list? {
|
fn list? {
|
||||||
"Returns true if the value is a list."
|
"Returns true if the value is a list."
|
||||||
(l as :list) -> true
|
(l as :list) -> true
|
||||||
|
|
@ -153,6 +170,7 @@ fn list {
|
||||||
(x) -> base :to_list (x)
|
(x) -> base :to_list (x)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
& TODO: make this work with Janet base
|
||||||
fn set {
|
fn set {
|
||||||
"Takes an ordered collection--list or tuple--and turns it into a set."
|
"Takes an ordered collection--list or tuple--and turns it into a set."
|
||||||
(xs as :list) -> base :into (${}, xs)
|
(xs as :list) -> base :into (${}, xs)
|
||||||
|
|
@ -170,16 +188,20 @@ fn set? {
|
||||||
fn fold {
|
fn fold {
|
||||||
"Folds a list."
|
"Folds a list."
|
||||||
(f as :fn, xs as :list) -> fold (f, xs, f ())
|
(f as :fn, xs as :list) -> fold (f, xs, f ())
|
||||||
(f as :fn, xs as :list, root) -> loop (root, first (xs), rest (xs)) with {
|
(f as :fn, xs as :list, root) -> {
|
||||||
(prev, curr, []) -> f (prev, curr)
|
base :print! (("folding ", xs, " with ", f))
|
||||||
(prev, curr, remaining) -> recur (
|
loop (root, first (xs), rest (xs)) with {
|
||||||
f (prev, curr)
|
(prev, curr, []) -> f (prev, curr)
|
||||||
first (remaining)
|
(prev, curr, remaining) -> recur (
|
||||||
rest (remaining)
|
f (prev, curr)
|
||||||
)
|
first (remaining)
|
||||||
|
rest (remaining)
|
||||||
|
)
|
||||||
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
& TODO: optimize these with base :conj!
|
||||||
fn map {
|
fn map {
|
||||||
"Maps a function over a list: returns a new list with elements that are the result of applying the function to each element in the original list. E.g., `map ([1, 2, 3], inc) &=> [2, 3, 4]`."
|
"Maps a function over a list: returns a new list with elements that are the result of applying the function to each element in the original list. E.g., `map ([1, 2, 3], inc) &=> [2, 3, 4]`."
|
||||||
(f as :fn, xs) -> {
|
(f as :fn, xs) -> {
|
||||||
|
|
@ -218,7 +240,7 @@ fn append {
|
||||||
|
|
||||||
fn concat {
|
fn concat {
|
||||||
"Combines two lists, strings, or sets."
|
"Combines two lists, strings, or sets."
|
||||||
(x as :string, y as :string) -> base :str (x, y)
|
(x as :string, y as :string) -> base :concat (x, y)
|
||||||
(xs as :list, ys as :list) -> base :concat (xs, ys)
|
(xs as :list, ys as :list) -> base :concat (xs, ys)
|
||||||
(xs as :set, ys as :set) -> base :concat (xs, ys)
|
(xs as :set, ys as :set) -> base :concat (xs, ys)
|
||||||
(xs, ys, ...zs) -> fold (concat, zs, concat (xs, ys))
|
(xs, ys, ...zs) -> fold (concat, zs, concat (xs, ys))
|
||||||
|
|
@ -227,13 +249,13 @@ fn concat {
|
||||||
& the console: sending messages to the outside world
|
& the console: sending messages to the outside world
|
||||||
& the console is *both* something we send to the host language's console
|
& the console is *both* something we send to the host language's console
|
||||||
& ...and also a list of messages.
|
& ...and also a list of messages.
|
||||||
ref console = []
|
box console = []
|
||||||
|
|
||||||
fn flush! {
|
fn flush! {
|
||||||
"Clears the console, and returns the messages."
|
"Clears the console, and returns the messages."
|
||||||
() -> {
|
() -> {
|
||||||
let msgs = deref (console)
|
let msgs = unbox (console)
|
||||||
make! (console, [])
|
store! (console, [])
|
||||||
msgs
|
msgs
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
@ -242,7 +264,9 @@ fn add_msg! {
|
||||||
"Adds a message to the console."
|
"Adds a message to the console."
|
||||||
(msg as :string) -> update! (console, append (_, msg))
|
(msg as :string) -> update! (console, append (_, msg))
|
||||||
(msgs as :list) -> {
|
(msgs as :list) -> {
|
||||||
|
base :print! (("adding msg", msgs))
|
||||||
let msg = do msgs > map (string, _) > join
|
let msg = do msgs > map (string, _) > join
|
||||||
|
base :print! (("msg: ", msg))
|
||||||
update! (console, append (_, msg))
|
update! (console, append (_, msg))
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
@ -250,8 +274,8 @@ fn add_msg! {
|
||||||
fn print! {
|
fn print! {
|
||||||
"Sends a text representation of Ludus values to the console."
|
"Sends a text representation of Ludus values to the console."
|
||||||
(...args) -> {
|
(...args) -> {
|
||||||
base :print (args)
|
base :print! (args)
|
||||||
add_msg! (args)
|
& add_msg! (args)
|
||||||
:ok
|
:ok
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
@ -263,7 +287,11 @@ fn show {
|
||||||
|
|
||||||
fn prn! {
|
fn prn! {
|
||||||
"Prints the underlying Clojure data structure of a Ludus value."
|
"Prints the underlying Clojure data structure of a Ludus value."
|
||||||
(x) -> base :prn (x)
|
(x) -> {
|
||||||
|
base :prn (x)
|
||||||
|
& add_msg! (x)
|
||||||
|
:ok
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
fn report! {
|
fn report! {
|
||||||
|
|
@ -292,11 +320,11 @@ fn string? {
|
||||||
}
|
}
|
||||||
|
|
||||||
fn string {
|
fn string {
|
||||||
"Converts a value to a string by using `show`. If it is a string, returns it unharmed. Use this to build up strings of differen kinds of values."
|
"Converts a value to a string by using `show`. If it is a string, returns it unharmed. Use this to build up strings of different kinds of values."
|
||||||
(x as :string) -> x
|
(x as :string) -> x
|
||||||
(x) -> show (x)
|
(x) -> show (x)
|
||||||
(x, ...xs) -> loop (x, xs) with {
|
(x, ...xs) -> loop (x, xs) with {
|
||||||
(out, [x]) -> concat (out, show(x))
|
(out, [x]) -> concat (out, show (x))
|
||||||
(out, [x, ...xs]) -> recur (concat (out, show (x)), xs)
|
(out, [x, ...xs]) -> recur (concat (out, show (x)), xs)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
@ -320,28 +348,31 @@ fn join {
|
||||||
|
|
||||||
&&& references: mutable state and state changes
|
&&& references: mutable state and state changes
|
||||||
|
|
||||||
fn ref? {
|
fn box? {
|
||||||
"Returns true if a value is a ref."
|
"Returns true if a value is a box."
|
||||||
(r as :ref) -> true
|
(b as :box) -> true
|
||||||
(_) -> false
|
(_) -> false
|
||||||
}
|
}
|
||||||
|
|
||||||
fn deref {
|
fn unbox {
|
||||||
"Resolves a ref into a value."
|
"Returns the value that is stored in a box."
|
||||||
(r as :ref) -> base :deref (r)
|
(b as :box) -> base :unbox (b)
|
||||||
}
|
}
|
||||||
|
|
||||||
fn make! {
|
fn store! {
|
||||||
"Sets the value of a ref."
|
"Stores a value in a box, replacing the value that was previously there. Returns the value."
|
||||||
(r as :ref, value) -> base :set! (r, value)
|
(b as :box, value) -> {
|
||||||
|
base :store! (b, value)
|
||||||
|
value
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
fn update! {
|
fn update! {
|
||||||
"Updates a ref by applying a function to its value. Returns the new value."
|
"Updates a box by applying a function to its value. Returns the new value."
|
||||||
(r as :ref, f as :fn) -> {
|
(b as :box, f as :fn) -> {
|
||||||
let current = deref (r)
|
let current = unbox (b)
|
||||||
let new = f (current)
|
let new = f (current)
|
||||||
make! (r, new)
|
store! (b, new)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
@ -541,6 +572,56 @@ fn max {
|
||||||
(x, y, ...zs) -> fold (max, zs, max (x, y))
|
(x, y, ...zs) -> fold (max, zs, max (x, y))
|
||||||
}
|
}
|
||||||
|
|
||||||
|
& additional list operations now that we have comparitors
|
||||||
|
fn at {
|
||||||
|
"Returns the element at index n of a list or tuple. Zero-indexed: the first element is at index 0."
|
||||||
|
(xs as :list, n as :number) -> when {
|
||||||
|
neg? (n) -> nil
|
||||||
|
gte? (n, count (xs)) -> nil
|
||||||
|
true -> base :nth (n, xs)
|
||||||
|
}
|
||||||
|
(xs as :tuple, n as :number) -> when {
|
||||||
|
neg? (n) -> nil
|
||||||
|
gte? (n, count (xs)) -> nil
|
||||||
|
true -> base :nth (n, xs)
|
||||||
|
}
|
||||||
|
(_) -> nil
|
||||||
|
}
|
||||||
|
|
||||||
|
fn first {
|
||||||
|
"Returns the first element of a list or tuple."
|
||||||
|
(xs) -> at (xs, 0)
|
||||||
|
}
|
||||||
|
|
||||||
|
fn second {
|
||||||
|
"Returns the second element of a list or tuple."
|
||||||
|
(xs) -> at (xs, 1)
|
||||||
|
}
|
||||||
|
|
||||||
|
fn last {
|
||||||
|
"Returns the last element of a list or tuple."
|
||||||
|
(xs) -> at (xs, dec (count (xs)))
|
||||||
|
}
|
||||||
|
|
||||||
|
fn butlast {
|
||||||
|
"Returns a list, omitting the last element."
|
||||||
|
(xs as :list) -> base :slice (xs, dec (count (xs)))
|
||||||
|
}
|
||||||
|
|
||||||
|
fn slice {
|
||||||
|
"Returns a slice of a list, representing a sub-list."
|
||||||
|
(xs as :list, end as :number) -> slice (xs, 0, end)
|
||||||
|
(xs as :list, start as :number, end as :number) -> when {
|
||||||
|
gte? (start, end) -> []
|
||||||
|
gt? (end, count (xs)) -> slice (xs, start, count (xs))
|
||||||
|
neg? (start) -> slice (xs, 0, end)
|
||||||
|
true -> {
|
||||||
|
let slice = base :slice (xs, inc (start), inc (end))
|
||||||
|
base :into ([], slice)
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
&&& keywords: funny names
|
&&& keywords: funny names
|
||||||
fn keyword? {
|
fn keyword? {
|
||||||
"Returns true if a value is a keyword, otherwise returns false."
|
"Returns true if a value is a keyword, otherwise returns false."
|
||||||
|
|
@ -570,40 +651,6 @@ fn some {
|
||||||
(value, _) -> value
|
(value, _) -> value
|
||||||
}
|
}
|
||||||
|
|
||||||
&&& true & false: boolean logic
|
|
||||||
|
|
||||||
fn bool? {
|
|
||||||
"Returns true if a value is of type :boolean."
|
|
||||||
(false) -> true
|
|
||||||
(true) -> true
|
|
||||||
(_) -> false
|
|
||||||
}
|
|
||||||
|
|
||||||
fn true? {
|
|
||||||
"Returns true if a value is boolean `true`. Useful to distinguish between `true` and anything else."
|
|
||||||
(true) -> true
|
|
||||||
(_) -> false
|
|
||||||
}
|
|
||||||
|
|
||||||
fn false? {
|
|
||||||
"Returns `true` if a value is `false`, otherwise returns `false`. Useful to distinguish between `false` and `nil`."
|
|
||||||
(false) -> true
|
|
||||||
(_) -> false
|
|
||||||
}
|
|
||||||
|
|
||||||
fn bool {
|
|
||||||
"Returns false if a value is nil or false, otherwise returns true."
|
|
||||||
(nil) -> false
|
|
||||||
(false) -> false
|
|
||||||
(_) -> true
|
|
||||||
}
|
|
||||||
|
|
||||||
fn not {
|
|
||||||
"Returns false if a value is truthy, true if a value is falsy."
|
|
||||||
(nil) -> true
|
|
||||||
(false) -> true
|
|
||||||
(_) -> false
|
|
||||||
}
|
|
||||||
|
|
||||||
& TODO: make `and` and `or` special forms which lazily evaluate arguments
|
& TODO: make `and` and `or` special forms which lazily evaluate arguments
|
||||||
fn and {
|
fn and {
|
||||||
|
|
@ -689,11 +736,10 @@ fn diff {
|
||||||
fn coll? {
|
fn coll? {
|
||||||
"Returns true if a value is a collection: dict, struct, list, tuple, or set."
|
"Returns true if a value is a collection: dict, struct, list, tuple, or set."
|
||||||
(coll as :dict) -> true
|
(coll as :dict) -> true
|
||||||
(coll as :struct) -> true
|
|
||||||
(coll as :list) -> true
|
(coll as :list) -> true
|
||||||
(coll as :tuple) -> true
|
(coll as :tuple) -> true
|
||||||
(coll as :set) -> true
|
(coll as :set) -> true
|
||||||
(coll as :ns) -> true
|
(coll as :pkg) -> true
|
||||||
(_) -> false
|
(_) -> false
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
@ -707,8 +753,7 @@ fn ordered? {
|
||||||
fn assoc? {
|
fn assoc? {
|
||||||
"Returns true if a value is an associative collection: a dict, struct, or namespace."
|
"Returns true if a value is an associative collection: a dict, struct, or namespace."
|
||||||
(assoc as :dict) -> true
|
(assoc as :dict) -> true
|
||||||
(assoc as :struct) -> true
|
(assoc as :pkg) -> true
|
||||||
(assoc as :ns) -> true
|
|
||||||
(_) -> false
|
(_) -> false
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
@ -728,8 +773,7 @@ fn has? {
|
||||||
}
|
}
|
||||||
|
|
||||||
fn dict {
|
fn dict {
|
||||||
"Takes an ns, and returns it as a dict. Or, takes a list or tuple of (key, value) tuples and returns it as a dict. Returns dicts unharmed."
|
"Takes a list or tuple of (key, value) tuples and returns it as a dict. Returns dicts unharmed."
|
||||||
(ns_ as :ns) -> base :to_dict (ns_)
|
|
||||||
(dict as :dict) -> dict
|
(dict as :dict) -> dict
|
||||||
(list as :list) -> fold (assoc, list)
|
(list as :list) -> fold (assoc, list)
|
||||||
(tup as :tuple) -> do tup > list > dict
|
(tup as :tuple) -> do tup > list > dict
|
||||||
|
|
@ -988,29 +1032,30 @@ let turtle_init = #{
|
||||||
|
|
||||||
& turtle states: refs that get modified by calls
|
& turtle states: refs that get modified by calls
|
||||||
& turtle_commands is a list of commands, expressed as tuples
|
& turtle_commands is a list of commands, expressed as tuples
|
||||||
ref turtle_commands = []
|
box turtle_commands = []
|
||||||
|
|
||||||
& and a list of turtle states
|
& and a list of turtle states
|
||||||
ref turtle_states = [turtle_init]
|
box turtle_states = [turtle_init]
|
||||||
|
|
||||||
fn reset_turtle! {
|
fn reset_turtle! {
|
||||||
"Resets the turtle to its original state."
|
"Resets the turtle to its original state."
|
||||||
() -> make! (turtle_states, [turtle_init])
|
() -> store! (turtle_states, [turtle_init])
|
||||||
}
|
}
|
||||||
|
|
||||||
& and a list of calls to p5--at least for now
|
& and a list of calls to p5--at least for now
|
||||||
ref p5_calls = []
|
box p5_calls = []
|
||||||
|
|
||||||
& ...and finally, a background color
|
& ...and finally, a background color
|
||||||
& we need to store this separately because, while it can be updated later,
|
& we need to store this separately because, while it can be updated later,
|
||||||
& it must be the first call to p5.
|
& it must be the first call to p5.
|
||||||
ref bgcolor = colors :black
|
box bgcolor = colors :black
|
||||||
|
|
||||||
fn add_call! (call) -> update! (p5_calls, append (_, call))
|
fn add_call! (call) -> update! (p5_calls, append (_, call))
|
||||||
|
|
||||||
fn add_command! (command) -> {
|
fn add_command! (command) -> {
|
||||||
|
print! ("adding command", command)
|
||||||
update! (turtle_commands, append (_, command))
|
update! (turtle_commands, append (_, command))
|
||||||
let prev = do turtle_states > deref > last
|
let prev = do turtle_states > unbox > last
|
||||||
let curr = apply_command (prev, command)
|
let curr = apply_command (prev, command)
|
||||||
update! (turtle_states, append (_, curr))
|
update! (turtle_states, append (_, curr))
|
||||||
let call = state/call ()
|
let call = state/call ()
|
||||||
|
|
@ -1026,12 +1071,12 @@ let turtle_angle = 0.385
|
||||||
let turtle_color = (255, 255, 255, 150)
|
let turtle_color = (255, 255, 255, 150)
|
||||||
|
|
||||||
fn render_turtle! () -> {
|
fn render_turtle! () -> {
|
||||||
let state = do turtle_states > deref > last
|
let state = do turtle_states > unbox > last
|
||||||
if state :visible?
|
if state :visible?
|
||||||
then {
|
then {
|
||||||
let (r, g, b, a) = turtle_color
|
let (r, g, b, a) = turtle_color
|
||||||
add_call! ((:fill, r, g, b, a))
|
add_call! ((:fill, r, g, b, a))
|
||||||
let #{heading, :position (x, y)} = state
|
let #{heading, :position (x, y), ...} = state
|
||||||
let first = mult ((0, 1), turtle_radius)
|
let first = mult ((0, 1), turtle_radius)
|
||||||
let (x1, y1) = first
|
let (x1, y1) = first
|
||||||
let (x2, y2) = rotate (first, turtle_angle)
|
let (x2, y2) = rotate (first, turtle_angle)
|
||||||
|
|
@ -1055,8 +1100,8 @@ fn render_turtle! () -> {
|
||||||
}
|
}
|
||||||
|
|
||||||
fn state/call () -> {
|
fn state/call () -> {
|
||||||
let cmd = do turtle_commands > deref > last > first
|
let cmd = do turtle_commands > unbox > last > first
|
||||||
let states = deref (turtle_states)
|
let states = unbox (turtle_states)
|
||||||
let curr = last (states)
|
let curr = last (states)
|
||||||
let prev = at (states, sub (count (states), 2))
|
let prev = at (states, sub (count (states), 2))
|
||||||
match cmd with {
|
match cmd with {
|
||||||
|
|
@ -1078,7 +1123,7 @@ fn state/call () -> {
|
||||||
(:stroke, r, g, b, a)
|
(:stroke, r, g, b, a)
|
||||||
}
|
}
|
||||||
:clear -> (:background, 0, 0, 0, 255)
|
:clear -> (:background, 0, 0, 0, 255)
|
||||||
else -> nil
|
_ -> nil
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
@ -1144,9 +1189,9 @@ let pw! = penwidth!
|
||||||
|
|
||||||
fn background! {
|
fn background! {
|
||||||
"Sets the background color behind the turtle and path. Alias: bg!"
|
"Sets the background color behind the turtle and path. Alias: bg!"
|
||||||
(gray as :number) -> make! (bgcolor, (gray, gray, gray, 255))
|
(gray as :number) -> store! (bgcolor, (gray, gray, gray, 255))
|
||||||
((r as :number, g as :number, b as :number)) -> make! (bgcolor, (r, b, g, 255))
|
((r as :number, g as :number, b as :number)) -> store! (bgcolor, (r, b, g, 255))
|
||||||
((r as :number, g as :number, b as :number, a as :number)) -> make! (bgcolor, (r, g, b, a))
|
((r as :number, g as :number, b as :number, a as :number)) -> store! (bgcolor, (r, g, b, a))
|
||||||
}
|
}
|
||||||
|
|
||||||
let bg! = background!
|
let bg! = background!
|
||||||
|
|
@ -1185,13 +1230,13 @@ fn apply_command {
|
||||||
(:right, turns) -> update (state, :heading, add (_, turns))
|
(:right, turns) -> update (state, :heading, add (_, turns))
|
||||||
(:left, turns) -> update (state, :heading, sub (_, turns))
|
(:left, turns) -> update (state, :heading, sub (_, turns))
|
||||||
(:forward, steps) -> {
|
(:forward, steps) -> {
|
||||||
let #{heading, position} = state
|
let #{heading, position, ...} = state
|
||||||
let unit = heading/vector (heading)
|
let unit = heading/vector (heading)
|
||||||
let vect = mult (steps, unit)
|
let vect = mult (steps, unit)
|
||||||
update (state, :position, add (vect, _))
|
update (state, :position, add (vect, _))
|
||||||
}
|
}
|
||||||
(:back, steps) -> {
|
(:back, steps) -> {
|
||||||
let #{heading, position} = state
|
let #{heading, position, ...} = state
|
||||||
let unit = heading/vector (heading)
|
let unit = heading/vector (heading)
|
||||||
let vect = mult (steps, unit)
|
let vect = mult (steps, unit)
|
||||||
update (state, :position, sub (_, vect))
|
update (state, :position, sub (_, vect))
|
||||||
|
|
@ -1205,7 +1250,7 @@ fn apply_command {
|
||||||
|
|
||||||
fn turtle_state {
|
fn turtle_state {
|
||||||
"Returns the turtle's current state."
|
"Returns the turtle's current state."
|
||||||
() -> do turtle_states > deref > last
|
() -> do turtle_states > unbox > last
|
||||||
}
|
}
|
||||||
|
|
||||||
& position () -> (x, y)
|
& position () -> (x, y)
|
||||||
|
|
@ -1234,135 +1279,155 @@ fn penwidth {
|
||||||
() -> turtle_state () :pencolor
|
() -> turtle_state () :pencolor
|
||||||
}
|
}
|
||||||
|
|
||||||
ns prelude {
|
pkg Prelude {
|
||||||
type
|
abs
|
||||||
eq?
|
|
||||||
neq?
|
|
||||||
tuple?
|
|
||||||
fn?
|
|
||||||
first
|
|
||||||
second
|
|
||||||
rest
|
|
||||||
at
|
|
||||||
last
|
|
||||||
butlast
|
|
||||||
slice
|
|
||||||
count
|
|
||||||
append
|
|
||||||
fold
|
|
||||||
map
|
|
||||||
filter
|
|
||||||
keep
|
|
||||||
list
|
|
||||||
set
|
|
||||||
set?
|
|
||||||
inc
|
|
||||||
dec
|
|
||||||
print!
|
|
||||||
flush!
|
|
||||||
console
|
|
||||||
show
|
|
||||||
prn!
|
|
||||||
report!
|
|
||||||
doc!
|
|
||||||
concat
|
|
||||||
ref?
|
|
||||||
deref
|
|
||||||
make!
|
|
||||||
update!
|
|
||||||
string
|
|
||||||
string?
|
|
||||||
join
|
|
||||||
add
|
add
|
||||||
sub
|
and
|
||||||
mult
|
angle
|
||||||
|
any?
|
||||||
|
append
|
||||||
|
assert!
|
||||||
|
assoc
|
||||||
|
assoc?
|
||||||
|
at
|
||||||
|
atan/2
|
||||||
|
back!
|
||||||
|
background!
|
||||||
|
between?
|
||||||
|
bg!
|
||||||
|
bgcolor
|
||||||
|
bk!
|
||||||
|
bool
|
||||||
|
bool?
|
||||||
|
box?
|
||||||
|
butlast
|
||||||
|
ceil
|
||||||
|
clear!
|
||||||
|
coll?
|
||||||
|
colors
|
||||||
|
concat
|
||||||
|
console
|
||||||
|
cos
|
||||||
|
count
|
||||||
|
dec
|
||||||
|
deg/rad
|
||||||
|
deg/turn
|
||||||
|
dict
|
||||||
|
dict?
|
||||||
|
diff
|
||||||
|
dissoc
|
||||||
|
dist
|
||||||
div
|
div
|
||||||
div/0
|
div/0
|
||||||
div/safe
|
div/safe
|
||||||
inv
|
doc!
|
||||||
inv/0
|
|
||||||
angle
|
|
||||||
abs
|
|
||||||
neg
|
|
||||||
zero?
|
|
||||||
neg?
|
|
||||||
pos?
|
|
||||||
even?
|
|
||||||
odd?
|
|
||||||
gt?
|
|
||||||
gte?
|
|
||||||
lt?
|
|
||||||
lte?
|
|
||||||
min
|
|
||||||
max
|
|
||||||
between?
|
|
||||||
keyword?
|
|
||||||
nil?
|
|
||||||
some?
|
|
||||||
some
|
|
||||||
bool?
|
|
||||||
false?
|
|
||||||
bool
|
|
||||||
not
|
|
||||||
and
|
|
||||||
or
|
|
||||||
coll?
|
|
||||||
ordered?
|
|
||||||
assoc?
|
|
||||||
assoc
|
|
||||||
dissoc
|
|
||||||
update
|
|
||||||
get
|
|
||||||
dict
|
|
||||||
dict?
|
|
||||||
keys
|
|
||||||
values
|
|
||||||
diff
|
|
||||||
each!
|
each!
|
||||||
sin
|
empty?
|
||||||
cos
|
eq?
|
||||||
tan
|
|
||||||
turn/rad
|
|
||||||
rad/turn
|
|
||||||
turn/deg
|
|
||||||
deg/turn
|
|
||||||
rad/deg
|
|
||||||
deg/rad
|
|
||||||
atan/2
|
|
||||||
mod
|
|
||||||
square
|
|
||||||
sum_of_squares
|
|
||||||
dist
|
|
||||||
random
|
|
||||||
random_int
|
|
||||||
pi
|
|
||||||
tau
|
|
||||||
floor
|
|
||||||
ceil
|
|
||||||
round
|
|
||||||
range
|
|
||||||
ok
|
|
||||||
ok?
|
|
||||||
err
|
err
|
||||||
err?
|
err?
|
||||||
|
even?
|
||||||
|
false?
|
||||||
|
fd!
|
||||||
|
filter
|
||||||
|
first
|
||||||
|
floor
|
||||||
|
flush!
|
||||||
|
fn?
|
||||||
|
fold
|
||||||
|
forward!
|
||||||
|
get
|
||||||
|
goto!
|
||||||
|
gt?
|
||||||
|
gte?
|
||||||
|
heading
|
||||||
|
heading/vector
|
||||||
|
home!
|
||||||
|
inc
|
||||||
|
inv
|
||||||
|
inv/0
|
||||||
|
join
|
||||||
|
keep
|
||||||
|
keys
|
||||||
|
keyword?
|
||||||
|
last
|
||||||
|
left!
|
||||||
|
list
|
||||||
|
lt!
|
||||||
|
lt?
|
||||||
|
lte?
|
||||||
|
map
|
||||||
|
max
|
||||||
|
min
|
||||||
|
mod
|
||||||
|
mult
|
||||||
|
neg
|
||||||
|
neg?
|
||||||
|
neq?
|
||||||
|
nil?
|
||||||
|
not
|
||||||
|
odd?
|
||||||
|
ok
|
||||||
|
ok?
|
||||||
|
or
|
||||||
|
ordered?
|
||||||
|
p5_calls
|
||||||
|
pc!
|
||||||
|
pd!
|
||||||
|
pencolor
|
||||||
|
pencolor!
|
||||||
|
pendown!
|
||||||
|
pendown?
|
||||||
|
penup!
|
||||||
|
penwidth
|
||||||
|
penwidth!
|
||||||
|
pi
|
||||||
|
pos?
|
||||||
|
position
|
||||||
|
print!
|
||||||
|
prn!
|
||||||
|
pu!
|
||||||
|
pw!
|
||||||
|
rad/deg
|
||||||
|
rad/turn
|
||||||
|
random
|
||||||
|
random_int
|
||||||
|
range
|
||||||
|
render_turtle!
|
||||||
|
report!
|
||||||
|
reset_turtle!
|
||||||
|
rest
|
||||||
|
right!
|
||||||
|
round
|
||||||
|
rt!
|
||||||
|
second
|
||||||
|
set
|
||||||
|
set?
|
||||||
|
show
|
||||||
|
sin
|
||||||
|
slice
|
||||||
|
some
|
||||||
|
some?
|
||||||
|
square
|
||||||
|
store!
|
||||||
|
string
|
||||||
|
string?
|
||||||
|
sub
|
||||||
|
sum_of_squares
|
||||||
|
tan
|
||||||
|
tau
|
||||||
|
tuple?
|
||||||
|
turn/deg
|
||||||
|
turn/rad
|
||||||
|
turtle_commands
|
||||||
|
turtle_state
|
||||||
|
turtle_states
|
||||||
|
type
|
||||||
|
unbox
|
||||||
unwrap!
|
unwrap!
|
||||||
unwrap_or
|
unwrap_or
|
||||||
assert!
|
update
|
||||||
colors
|
update!
|
||||||
forward!, fd!
|
values
|
||||||
back!, bk!
|
zero?
|
||||||
right!, rt!
|
|
||||||
left!, lt!
|
|
||||||
penup!, pu!
|
|
||||||
pendown!, pd!
|
|
||||||
pencolor!, pc!
|
|
||||||
background!, bg!
|
|
||||||
penwidth!, pw!
|
|
||||||
home!, clear!, goto!,
|
|
||||||
heading, position, pendown?
|
|
||||||
pencolor, penwidth
|
|
||||||
heading/vector
|
|
||||||
turtle_state
|
|
||||||
p5_calls, turtle_states, turtle_commands, bgcolor
|
|
||||||
render_turtle!, reset_turtle!
|
|
||||||
}
|
}
|
||||||
14
project.clj
14
project.clj
|
|
@ -1,14 +0,0 @@
|
||||||
(defproject ludus "0.1.0-SNAPSHOT"
|
|
||||||
:description "FIXME: write description"
|
|
||||||
:url "http://ludus.dev"
|
|
||||||
: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.11.1"]
|
|
||||||
[babashka/fs "0.4.19"]
|
|
||||||
]
|
|
||||||
:plugins [[lein-cljfmt "0.8.0"]]
|
|
||||||
:repl-options {:init-ns ludus.core}
|
|
||||||
:main ludus.core
|
|
||||||
:profiles {:uberjar {:aot :all}}
|
|
||||||
:jvm-opts ["--enable-preview"]
|
|
||||||
)
|
|
||||||
111
sandbox.ld
111
sandbox.ld
|
|
@ -1,111 +0,0 @@
|
||||||
fn fib {
|
|
||||||
"Tells you a fib number."
|
|
||||||
(0) -> 0
|
|
||||||
(1) -> 1
|
|
||||||
(n) -> add (
|
|
||||||
fib (dec (n))
|
|
||||||
fib (sub (n, 2))
|
|
||||||
)
|
|
||||||
}
|
|
||||||
|
|
||||||
fn unwrap {
|
|
||||||
((:some, value)) -> value
|
|
||||||
((:ok, value)) -> value
|
|
||||||
}
|
|
||||||
|
|
||||||
fn default (default_value) -> fn (maybe) -> when maybe is {
|
|
||||||
(:ok, value) -> value
|
|
||||||
(:err, _) -> default_value
|
|
||||||
nil -> default_value
|
|
||||||
value -> value
|
|
||||||
}
|
|
||||||
|
|
||||||
fn some (value) -> (:some, value)
|
|
||||||
|
|
||||||
fn ok (value) -> (:ok, value)
|
|
||||||
|
|
||||||
let foo = unwrap ((:ok, 42))
|
|
||||||
|
|
||||||
print (:foo, foo)
|
|
||||||
|
|
||||||
let bar = unwrap ((:some, 23))
|
|
||||||
|
|
||||||
print (:bar, bar)
|
|
||||||
|
|
||||||
let baz = do 69 > default (12) > print (:baz, _)
|
|
||||||
|
|
||||||
let quux = do nil > default (12) > print (:quux, _)
|
|
||||||
|
|
||||||
& unwrap ((:err, "message"))
|
|
||||||
|
|
||||||
fn map {
|
|
||||||
(f) -> fn mapper (xs) -> map (f, xs)
|
|
||||||
(f, xs) -> {
|
|
||||||
let n = count (xs)
|
|
||||||
loop (0, []) with (i, ys) -> if eq (i, n)
|
|
||||||
then ys
|
|
||||||
else recur (
|
|
||||||
inc (i)
|
|
||||||
conj (ys, f (nth (i, xs))))
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
fn reduce {
|
|
||||||
(f) -> fn reducer {
|
|
||||||
(xs) -> reduce (f, xs)
|
|
||||||
(xs, init) -> reduce (f, xs, init)
|
|
||||||
}
|
|
||||||
(f, xs) -> {
|
|
||||||
let first_x = first (xs)
|
|
||||||
let more_xs = rest (xs)
|
|
||||||
reduce (f, more_xs, first_x)
|
|
||||||
}
|
|
||||||
(f, xs, init) -> {
|
|
||||||
let n = count (xs)
|
|
||||||
loop (0, init) with (i, acc) -> if eq (i, n)
|
|
||||||
then acc
|
|
||||||
else {
|
|
||||||
let curr = nth (i, xs)
|
|
||||||
let next = f (acc, curr)
|
|
||||||
recur (inc (i), next)
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
fn filter {
|
|
||||||
(f) -> fn filterer (xs) -> filter (f, xs)
|
|
||||||
(f, xs) -> {
|
|
||||||
let n = count (xs)
|
|
||||||
loop (0, []) with (i, ys) -> when {
|
|
||||||
eq (i, n) -> ys
|
|
||||||
f (nth (i, xs)) -> recur (inc (i), conj (ys, nth (i, xs)))
|
|
||||||
else -> recur (inc (i), ys)
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
& fn shuffle
|
|
||||||
|
|
||||||
ref x = 4
|
|
||||||
|
|
||||||
set! (x, "foo")
|
|
||||||
|
|
||||||
set! (x, :foo)
|
|
||||||
|
|
||||||
deref (x)
|
|
||||||
|
|
||||||
let greater_than_two? = gt (_, 2)
|
|
||||||
|
|
||||||
fn square (x) -> mult (x, x)
|
|
||||||
|
|
||||||
let xs = [1, 2, 3]
|
|
||||||
|
|
||||||
let ys = #{:a 1, :b 2}
|
|
||||||
|
|
||||||
ys :a
|
|
||||||
|
|
||||||
:a (ys)
|
|
||||||
|
|
||||||
let y = 1
|
|
||||||
|
|
||||||
do y > inc > square > sub (_, 3)
|
|
||||||
|
|
@ -1,18 +0,0 @@
|
||||||
;; shadow-cljs configuration
|
|
||||||
{:deps true
|
|
||||||
|
|
||||||
:dev-http {8234 "target"}
|
|
||||||
|
|
||||||
:builds
|
|
||||||
{:node {:target :node-library
|
|
||||||
:output-to "target/js/ludus.js"
|
|
||||||
:exports {:run ludus.node/run}
|
|
||||||
:modules {:main {:entries [ludus.node]}}}
|
|
||||||
:module {:target :esm
|
|
||||||
:output-dir "target/js"
|
|
||||||
:modules {:ludus {:exports {run ludus.node/run test ludus.node/doug}}}
|
|
||||||
}
|
|
||||||
:browser {:target :browser
|
|
||||||
:output-dir "target/js"
|
|
||||||
:asset-path "target"
|
|
||||||
:modules {:main {:init-fn ludus.web/init}}}}}
|
|
||||||
269
src/base.janet
Normal file
269
src/base.janet
Normal file
|
|
@ -0,0 +1,269 @@
|
||||||
|
# A base library for Ludus
|
||||||
|
# Only loaded in the prelude
|
||||||
|
|
||||||
|
(defn bool [x] (if (= :^nil x) nil x))
|
||||||
|
|
||||||
|
(defn ludus/and [& args] (every? (map bool args)))
|
||||||
|
|
||||||
|
(defn ludus/or [& args] (some bool args))
|
||||||
|
|
||||||
|
(defn ludus/type [value]
|
||||||
|
(def typed? (when (dictionary? value) (value :^type)))
|
||||||
|
(def the-type (if typed? typed? (type value)))
|
||||||
|
(case the-type
|
||||||
|
:buffer :string
|
||||||
|
:boolean :bool
|
||||||
|
:array :list
|
||||||
|
:table :dict
|
||||||
|
:cfunction :function
|
||||||
|
the-type))
|
||||||
|
|
||||||
|
(var stringify nil)
|
||||||
|
|
||||||
|
(defn- dict-str [dict]
|
||||||
|
(string/join
|
||||||
|
(map
|
||||||
|
(fn [[k v]] (string (stringify k) " " (stringify v)))
|
||||||
|
(pairs dict))
|
||||||
|
", "))
|
||||||
|
|
||||||
|
(defn- stringish? [x] (or (string? x) (buffer? x)))
|
||||||
|
|
||||||
|
(defn- stringify* [value]
|
||||||
|
(when (stringish? value) (break value))
|
||||||
|
(def type (ludus/type value))
|
||||||
|
(case type
|
||||||
|
:nil ""
|
||||||
|
:number (string value)
|
||||||
|
:bool (string value)
|
||||||
|
:keyword (string ":" value)
|
||||||
|
:tuple
|
||||||
|
(string/join (map stringify value) ", ")
|
||||||
|
:list
|
||||||
|
(string/join (map stringify value) ", ")
|
||||||
|
:dict (dict-str value)
|
||||||
|
:set
|
||||||
|
(string/join (map stringify (keys value)) ", ")
|
||||||
|
:box (stringify (value :^value))
|
||||||
|
:fn (string "fn " (value :name))
|
||||||
|
:function (string "builtin " (string value))
|
||||||
|
:pkg (dict-str value)
|
||||||
|
))
|
||||||
|
|
||||||
|
(set stringify stringify*)
|
||||||
|
|
||||||
|
(defn- show-pkg [x]
|
||||||
|
(def tab (struct/to-table x))
|
||||||
|
(set (tab :^name) nil)
|
||||||
|
(set (tab :^type) nil)
|
||||||
|
(string "pkg " (x :^name) " {" (stringify tab) "}")
|
||||||
|
)
|
||||||
|
|
||||||
|
(defn show [x]
|
||||||
|
(case (ludus/type x)
|
||||||
|
:nil "nil"
|
||||||
|
:string (string "\"" x "\"")
|
||||||
|
:tuple (string "(" (stringify x) ")")
|
||||||
|
:list (string "[" (stringify x) "]")
|
||||||
|
:dict (string "#{" (stringify x) "}")
|
||||||
|
:set (string "${" (stringify x) "}")
|
||||||
|
:box (string "box " (x :name) " [ " (stringify x) " ]")
|
||||||
|
:pkg (show-pkg x)
|
||||||
|
(stringify x)))
|
||||||
|
|
||||||
|
(var json nil)
|
||||||
|
|
||||||
|
(defn- dict-json [dict]
|
||||||
|
(string/join
|
||||||
|
(map
|
||||||
|
(fn [[k v]] (string (json k) ": " (json v)))
|
||||||
|
(pairs dict))
|
||||||
|
", "))
|
||||||
|
|
||||||
|
(defn- json* [x]
|
||||||
|
(case (ludus/type x)
|
||||||
|
:nil "null"
|
||||||
|
:number (string x)
|
||||||
|
:bool (if true "true" "false")
|
||||||
|
:string (string "\"" x "\"")
|
||||||
|
:keyword (string "\"" x "\"")
|
||||||
|
:tuple (string "[" (string/join (map json x) ", ") "]")
|
||||||
|
:list (string "[" (string/join (map json x) ", ")"]")
|
||||||
|
:dict (string "{" (dict-json x) "}")
|
||||||
|
:set (string "[" (string/join (map json (keys x)) ", ") "]")
|
||||||
|
(show x)))
|
||||||
|
|
||||||
|
(set json json*)
|
||||||
|
|
||||||
|
(defn show-patt [x]
|
||||||
|
(case (x :type)
|
||||||
|
:nil "nil"
|
||||||
|
:bool (string (x :data))
|
||||||
|
:number (string (x :data))
|
||||||
|
:keyword (string ":" (x :data))
|
||||||
|
:word (x :data)
|
||||||
|
:placeholder (get-in x [:token :lexeme])
|
||||||
|
:tuple (string "(" (string/join (map show-patt (x :data)) ", ") ")")
|
||||||
|
:list (string "[" (string/join (map show-patt (x :data)) ", ")"]")
|
||||||
|
:dict (string "#{" (string/join (map show-patt (x :data)) ", ") "}")
|
||||||
|
:pair (string (show-patt (get-in x [:data 0])) " " (show-patt (get-in x [:data 1])))
|
||||||
|
:typed (string (show-patt (get-in x [:data 1])) " as " (show-patt (get-in x [:data 0])))
|
||||||
|
:interpolated (get-in x [:token :lexeme])
|
||||||
|
:string (get-in x [:token :lexeme])
|
||||||
|
:splat (string "..." (when (x :splatted) (show-patt (x :splatted))))
|
||||||
|
(error (string "cannot show pattern of unknown type " (x :type)))))
|
||||||
|
|
||||||
|
(defn pretty-patterns [fnn]
|
||||||
|
(def {:body clauses} fnn)
|
||||||
|
(string/join (map (fn [x] (-> x first show-patt)) clauses) " "))
|
||||||
|
|
||||||
|
(defn doc [fnn]
|
||||||
|
(def {:name name :doc doc} fnn)
|
||||||
|
(string/join [name (pretty-patterns fnn) doc] "\n"))
|
||||||
|
|
||||||
|
(defn- conj!-set [sett value]
|
||||||
|
(set (sett value) true)
|
||||||
|
sett)
|
||||||
|
|
||||||
|
(defn- conj-set [sett value]
|
||||||
|
(def new (merge sett))
|
||||||
|
(conj!-set new value))
|
||||||
|
|
||||||
|
(defn- conj!-list [list value]
|
||||||
|
(array/push list value))
|
||||||
|
|
||||||
|
(defn- conj-list [list value]
|
||||||
|
(def new (array/slice list))
|
||||||
|
(conj!-list new value))
|
||||||
|
|
||||||
|
(defn conj! [x value]
|
||||||
|
(case (ludus/type x)
|
||||||
|
:list (conj!-list x value)
|
||||||
|
:set (conj!-set x value)))
|
||||||
|
|
||||||
|
(defn conj [x value]
|
||||||
|
(case (ludus/type x)
|
||||||
|
:list (conj-list x value)
|
||||||
|
:set (conj-set x value)
|
||||||
|
(error (string "cannot conj onto " (show x)))))
|
||||||
|
|
||||||
|
(defn disj! [sett value]
|
||||||
|
(set (sett value) nil)
|
||||||
|
sett)
|
||||||
|
|
||||||
|
(defn disj [sett value]
|
||||||
|
(def new (merge sett))
|
||||||
|
(set (new value) nil)
|
||||||
|
new)
|
||||||
|
|
||||||
|
(defn assoc! [dict key value]
|
||||||
|
(set (dict key) value)
|
||||||
|
dict)
|
||||||
|
|
||||||
|
(defn assoc [dict key value]
|
||||||
|
(merge dict {key value}))
|
||||||
|
|
||||||
|
(defn dissoc! [dict key]
|
||||||
|
(set (dict key) nil)
|
||||||
|
dict)
|
||||||
|
|
||||||
|
(defn dissoc [dict key]
|
||||||
|
(def new (merge dict))
|
||||||
|
(set (new key) nil)
|
||||||
|
new)
|
||||||
|
|
||||||
|
(defn ludus/get [key dict &opt def]
|
||||||
|
(default def :^nil)
|
||||||
|
(get dict key def))
|
||||||
|
|
||||||
|
(defn rest [indexed]
|
||||||
|
(array/slice indexed 1))
|
||||||
|
|
||||||
|
(defn to_list [x]
|
||||||
|
(case (ludus/type x)
|
||||||
|
:list x
|
||||||
|
:tuple @[;x]
|
||||||
|
:dict (pairs x)
|
||||||
|
:set (-> x (dissoc :^type) keys)
|
||||||
|
@[x]))
|
||||||
|
|
||||||
|
(defn print! [args]
|
||||||
|
(print ;(map show args)))
|
||||||
|
|
||||||
|
(defn prn [x]
|
||||||
|
(pp x)
|
||||||
|
x)
|
||||||
|
|
||||||
|
(defn concat [x y & zs]
|
||||||
|
(case (ludus/type x)
|
||||||
|
:string (string x y ;zs)
|
||||||
|
:list (array/concat @[] x y ;zs)
|
||||||
|
:set (merge x y ;zs)))
|
||||||
|
|
||||||
|
(defn unbox [b] (get b :^value))
|
||||||
|
|
||||||
|
(defn store! [b x] (set (b :^value) x))
|
||||||
|
|
||||||
|
(def ctx {
|
||||||
|
"print!" print!
|
||||||
|
"prn" prn
|
||||||
|
"eq?" deep=
|
||||||
|
"bool" bool
|
||||||
|
"and" ludus/and
|
||||||
|
"or" ludus/or
|
||||||
|
"add" +
|
||||||
|
"sub" -
|
||||||
|
"mult" *
|
||||||
|
"div" /
|
||||||
|
"mod" %
|
||||||
|
"gt" >
|
||||||
|
"gte" >=
|
||||||
|
"lt" <
|
||||||
|
"lte" <=
|
||||||
|
"inc" inc
|
||||||
|
"dec" dec
|
||||||
|
"not" not
|
||||||
|
"type" ludus/type
|
||||||
|
"stringify" stringify
|
||||||
|
"show" show
|
||||||
|
"doc" doc
|
||||||
|
"concat" concat
|
||||||
|
"conj" conj
|
||||||
|
"conj!" conj!
|
||||||
|
"disj" disj
|
||||||
|
"disj!" disj!
|
||||||
|
"push" array/push
|
||||||
|
"assoc" assoc
|
||||||
|
"assoc!" assoc!
|
||||||
|
"dissoc" dissoc
|
||||||
|
"dissoc!" dissoc!
|
||||||
|
"get" ludus/get
|
||||||
|
"nth" ludus/get
|
||||||
|
"first" first
|
||||||
|
"rest" rest
|
||||||
|
"last" last
|
||||||
|
"slice" slice
|
||||||
|
"to_list" to_list
|
||||||
|
"count" length
|
||||||
|
"pi" math/pi
|
||||||
|
"sin" math/sin
|
||||||
|
"cos" math/cos
|
||||||
|
"tan" math/tan
|
||||||
|
"atan_2" math/atan2
|
||||||
|
"sqrt" math/sqrt
|
||||||
|
"random" math/random
|
||||||
|
"floor" math/floor
|
||||||
|
"ceil" math/ceil
|
||||||
|
"round" math/round
|
||||||
|
"range" range
|
||||||
|
"unbox" unbox
|
||||||
|
"store!" store!
|
||||||
|
})
|
||||||
|
|
||||||
|
(def base (let [b @{}]
|
||||||
|
(each [k v] (pairs ctx)
|
||||||
|
(set (b (keyword k)) v))
|
||||||
|
b))
|
||||||
|
|
||||||
|
(set (base :^type) :dict)
|
||||||
|
|
||||||
80
src/errors.janet
Normal file
80
src/errors.janet
Normal file
|
|
@ -0,0 +1,80 @@
|
||||||
|
(import /src/base :as b)
|
||||||
|
|
||||||
|
(defn- get-line [source line]
|
||||||
|
((string/split "\n" source) (dec line)))
|
||||||
|
|
||||||
|
(defn scan-error [e] (pp e) e)
|
||||||
|
|
||||||
|
(defn parse-error [e]
|
||||||
|
(def msg (e :msg))
|
||||||
|
(def {:line line-num :input input :soure source} (e :token))
|
||||||
|
(def source-line (get-line source line-num))
|
||||||
|
(print "Parsing error: " msg)
|
||||||
|
(print "On line " line-num " in " input)
|
||||||
|
(print source-line)
|
||||||
|
e)
|
||||||
|
|
||||||
|
|
||||||
|
(defn validation-error [e]
|
||||||
|
(def msg (e :msg))
|
||||||
|
(def {:line line-num :input input :source source} (get-in e [:node :token]))
|
||||||
|
(def source-line (get-line source line-num))
|
||||||
|
(case msg
|
||||||
|
"unbound name"
|
||||||
|
(do
|
||||||
|
(print "Validation error: " msg " " (get-in e [:node :data]))
|
||||||
|
(print "on line " line-num " in " input)
|
||||||
|
(print source-line))
|
||||||
|
(do
|
||||||
|
(print "Validation error: " msg)
|
||||||
|
(print "on line " line-num)
|
||||||
|
(print source-line)))
|
||||||
|
e)
|
||||||
|
|
||||||
|
(defn- fn-no-match [e]
|
||||||
|
(print "Ludus panicked! no match")
|
||||||
|
(def {:line line-num :source source :input input} (get-in e [:node :token]))
|
||||||
|
(def source-line (get-line source line-num))
|
||||||
|
(print "on line " line-num " in " input)
|
||||||
|
(def called (e :called))
|
||||||
|
(print "calling " (b/show called))
|
||||||
|
(def value (e :value))
|
||||||
|
(print "with " (b/show value))
|
||||||
|
(print "expecting to match one of")
|
||||||
|
(print (b/pretty-patterns called))
|
||||||
|
(print source-line))
|
||||||
|
|
||||||
|
(defn- let-no-match [e]
|
||||||
|
(print "Ludus panicked! no match")
|
||||||
|
(def {:line line-num :source source :input input} (get-in e [:node :token]))
|
||||||
|
(def source-line (get-line source line-num))
|
||||||
|
(print "on line " line-num " in " input)
|
||||||
|
(print "binding " (b/show (e :value)))
|
||||||
|
(def pattern (get-in e [:node :data 0]))
|
||||||
|
(print "to " (b/show-patt pattern))
|
||||||
|
(print source-line))
|
||||||
|
|
||||||
|
(defn- generic-panic [e]
|
||||||
|
(def msg (e :msg))
|
||||||
|
(def {:line line-num :source source :input input} (get-in e [:node :token]))
|
||||||
|
(def source-line (get-line source line-num))
|
||||||
|
(print "Ludus panicked! " msg)
|
||||||
|
(print "on line " line-num " in " input)
|
||||||
|
(print source-line))
|
||||||
|
|
||||||
|
(defn- unbound-name [e]
|
||||||
|
(def {:line line-num :source source :lexeme name :input input} (get-in e [:node :token]))
|
||||||
|
(def source-line (get-line source line-num))
|
||||||
|
(print "Ludus panicked! unbound name " name)
|
||||||
|
(print "on line " line-num " in " input)
|
||||||
|
(print source-line))
|
||||||
|
|
||||||
|
(defn runtime-error [e]
|
||||||
|
(when (= :string (type e)) (print e) (break e))
|
||||||
|
(def msg (e :msg))
|
||||||
|
(case msg
|
||||||
|
"no match: function call" (fn-no-match e)
|
||||||
|
"no match: let binding" (let-no-match e)
|
||||||
|
"unbound name" (unbound-name e)
|
||||||
|
(generic-panic e))
|
||||||
|
e)
|
||||||
651
src/interpreter.janet
Normal file
651
src/interpreter.janet
Normal file
|
|
@ -0,0 +1,651 @@
|
||||||
|
# A tree walk interpreter for ludus
|
||||||
|
|
||||||
|
(import /src/base :as b)
|
||||||
|
|
||||||
|
(var interpret nil)
|
||||||
|
(var match-pattern nil)
|
||||||
|
|
||||||
|
(defn- todo [msg] (error (string "not yet implemented: " msg)))
|
||||||
|
|
||||||
|
(defn- resolve-name [name ctx]
|
||||||
|
# # (print "resolving " name " in:")
|
||||||
|
# # (pp ctx)
|
||||||
|
(when (not ctx) (break :^not-found))
|
||||||
|
(if (has-key? ctx name)
|
||||||
|
(ctx name)
|
||||||
|
(resolve-name name (ctx :^parent))))
|
||||||
|
|
||||||
|
(defn- match-word [word value ctx]
|
||||||
|
(def name (word :data))
|
||||||
|
# # (print "matched " (b/show value) " to " name)
|
||||||
|
(set (ctx name) value)
|
||||||
|
{:success true :ctx ctx})
|
||||||
|
|
||||||
|
(defn- typed [pattern value ctx]
|
||||||
|
(def [type-ast word] (pattern :data))
|
||||||
|
(def type (type-ast :data))
|
||||||
|
(if (= type (b/ludus/type value))
|
||||||
|
(match-word word value ctx)
|
||||||
|
{:success false :miss [pattern value]}))
|
||||||
|
|
||||||
|
(defn- match-tuple [pattern value ctx]
|
||||||
|
(when (not (tuple? value))
|
||||||
|
(break {:success false :miss [pattern value]}))
|
||||||
|
(def val-len (length value))
|
||||||
|
(var members (pattern :data))
|
||||||
|
(when (empty? members)
|
||||||
|
(break (if (empty? value)
|
||||||
|
{:success true :ctx ctx}
|
||||||
|
{:success false :miss [pattern value]})))
|
||||||
|
(def patt-len (length members))
|
||||||
|
(var splat nil)
|
||||||
|
(def splat? (= :splat ((last members) :type)))
|
||||||
|
(when splat?
|
||||||
|
(when (< val-len patt-len)
|
||||||
|
# (print "mismatched splatted tuple lengths")
|
||||||
|
(break {:success false :miss [pattern value]}))
|
||||||
|
# (print "splat!")
|
||||||
|
(set splat (last members))
|
||||||
|
(set members (slice members 0 (dec patt-len))))
|
||||||
|
(when (and (not splat?) (not= val-len patt-len))
|
||||||
|
# (print "mismatched tuple lengths")
|
||||||
|
(break {:success false :miss [pattern value]}))
|
||||||
|
(var curr-mem :^nothing)
|
||||||
|
(var curr-val :^nothing)
|
||||||
|
(var success true)
|
||||||
|
(for i 0 (length members)
|
||||||
|
(set curr-mem (get members i))
|
||||||
|
(set curr-val (get value i))
|
||||||
|
# (print "in tuple, matching " curr-val " with ")
|
||||||
|
# (pp curr-mem)
|
||||||
|
(def match? (match-pattern curr-mem curr-val ctx))
|
||||||
|
# (pp match?)
|
||||||
|
(when (not (match? :success))
|
||||||
|
(set success false)
|
||||||
|
(break)))
|
||||||
|
(when (and splat? (splat :data))
|
||||||
|
(def rest (array/slice value (length members)))
|
||||||
|
(match-word (splat :data) rest ctx))
|
||||||
|
(if success
|
||||||
|
{:success true :ctx ctx}
|
||||||
|
{:success false :miss [pattern value]}))
|
||||||
|
|
||||||
|
(defn- match-list [pattern value ctx]
|
||||||
|
(when (not (array? value))
|
||||||
|
(break {:success false :miss [pattern value]}))
|
||||||
|
(def val-len (length value))
|
||||||
|
(var members (pattern :data))
|
||||||
|
(when (empty? members)
|
||||||
|
(break (if (empty? value)
|
||||||
|
{:success true :ctx ctx}
|
||||||
|
{:success false :miss [pattern value]})))
|
||||||
|
(def patt-len (length members))
|
||||||
|
(var splat nil)
|
||||||
|
(def splat? (= :splat ((last members) :type)))
|
||||||
|
(when splat?
|
||||||
|
(when (< val-len patt-len)
|
||||||
|
# (print "mismatched splatted list lengths")
|
||||||
|
(break {:success false :miss [pattern value]}))
|
||||||
|
# (print "splat!")
|
||||||
|
(set splat (last members))
|
||||||
|
(set members (slice members 0 (dec patt-len))))
|
||||||
|
(when (and (not splat?) (not= val-len patt-len))
|
||||||
|
# (print "mismatched list lengths")
|
||||||
|
(break {:success false :miss [pattern value]}))
|
||||||
|
(var curr-mem :^nothing)
|
||||||
|
(var curr-val :^nothing)
|
||||||
|
(var success true)
|
||||||
|
(for i 0 (length members)
|
||||||
|
(set curr-mem (get members i))
|
||||||
|
(set curr-val (get value i))
|
||||||
|
# (print "in list, matching " curr-val " with ")
|
||||||
|
# (pp curr-mem)
|
||||||
|
(def match? (match-pattern curr-mem curr-val ctx))
|
||||||
|
# (pp match?)
|
||||||
|
(when (not (match? :success))
|
||||||
|
(set success false)
|
||||||
|
(break)))
|
||||||
|
(when (and splat? (splat :data))
|
||||||
|
(def rest (array/slice value (length members)))
|
||||||
|
(match-word (splat :data) rest ctx))
|
||||||
|
(if success
|
||||||
|
{:success true :ctx ctx}
|
||||||
|
{:success false :miss [pattern value]}))
|
||||||
|
|
||||||
|
(defn- match-string [pattern value ctx]
|
||||||
|
(when (not (string? value))
|
||||||
|
(break {:success false :miss [pattern value]}))
|
||||||
|
(def {:compiled compiled :bindings bindings} pattern)
|
||||||
|
# (print "matching " value " with")
|
||||||
|
# (pp (pattern :grammar))
|
||||||
|
(def matches (peg/match compiled value))
|
||||||
|
(when (not matches)
|
||||||
|
(break {:success false :miss [pattern value]}))
|
||||||
|
(when (not= (length matches) (length bindings))
|
||||||
|
(error "oops: different number of matches and bindings"))
|
||||||
|
(for i 0 (length matches)
|
||||||
|
(set (ctx (bindings i)) (matches i)))
|
||||||
|
{:success true :ctx ctx})
|
||||||
|
|
||||||
|
(defn- match-dict [pattern value ctx]
|
||||||
|
(when (not (table? value))
|
||||||
|
(break {:success false :miss [pattern value]}))
|
||||||
|
(def val-size (length value))
|
||||||
|
(var members (pattern :data))
|
||||||
|
(def patt-len (length members))
|
||||||
|
(when (empty? members)
|
||||||
|
(break (if (empty? value)
|
||||||
|
{:success true :ctx ctx}
|
||||||
|
{:success false :miss [pattern value]})))
|
||||||
|
(var splat nil)
|
||||||
|
(def splat? (= :splat ((last members) :type)))
|
||||||
|
(when splat?
|
||||||
|
(when (< val-size patt-len)
|
||||||
|
# (print "mismatched splatted dict lengths")
|
||||||
|
(break {:success false :miss [pattern value]}))
|
||||||
|
# (print "splat!")
|
||||||
|
(set splat (last members))
|
||||||
|
(set members (slice members 0 (dec patt-len))))
|
||||||
|
(when (and (not splat?) (not= val-size patt-len))
|
||||||
|
# (print "mismatched dict lengths")
|
||||||
|
(break {:success false :miss [pattern value]}))
|
||||||
|
(var success true)
|
||||||
|
(def matched-keys @[])
|
||||||
|
(for i 0 (length members)
|
||||||
|
(def curr-pair (get members i))
|
||||||
|
(def [curr-key curr-patt] (curr-pair :data))
|
||||||
|
(def key (interpret curr-key ctx))
|
||||||
|
(def curr-val (value key))
|
||||||
|
(def match? (match-pattern curr-patt curr-val ctx))
|
||||||
|
(array/push matched-keys key)
|
||||||
|
(when (not (match? :success))
|
||||||
|
(set success false)
|
||||||
|
(break)))
|
||||||
|
(when (and splat? (splat :data) success)
|
||||||
|
(def rest (merge value))
|
||||||
|
(each key matched-keys
|
||||||
|
(set (rest key) nil))
|
||||||
|
(match-word (splat :data) rest ctx))
|
||||||
|
(if success
|
||||||
|
{:success true :ctx ctx}
|
||||||
|
{:success false :miss [pattern value]}))
|
||||||
|
|
||||||
|
|
||||||
|
(defn- match-pattern* [pattern value &opt ctx]
|
||||||
|
# (print "in match-pattern, matching " value " with:")
|
||||||
|
# (pp pattern)
|
||||||
|
(default ctx @{})
|
||||||
|
(def data (pattern :data))
|
||||||
|
(case (pattern :type)
|
||||||
|
# always match
|
||||||
|
:placeholder {:success true :ctx ctx}
|
||||||
|
:ignored {:success true :ctx ctx}
|
||||||
|
:word (match-word pattern value ctx)
|
||||||
|
|
||||||
|
# match on equality
|
||||||
|
:nil {:success (nil? value) :ctx ctx}
|
||||||
|
:bool {:success (= data value) :ctx ctx}
|
||||||
|
:number {:success (= data value) :ctx ctx}
|
||||||
|
:string {:success (= data value) :ctx ctx}
|
||||||
|
:keyword {:success (= data value) :ctx ctx}
|
||||||
|
|
||||||
|
# TODO: lists, dicts
|
||||||
|
:tuple (match-tuple pattern value ctx)
|
||||||
|
:list (match-list pattern value ctx)
|
||||||
|
:dict (match-dict pattern value ctx)
|
||||||
|
|
||||||
|
:interpolated (match-string pattern value ctx)
|
||||||
|
|
||||||
|
:typed (typed pattern value ctx)
|
||||||
|
))
|
||||||
|
|
||||||
|
(set match-pattern match-pattern*)
|
||||||
|
|
||||||
|
(defn- lett [ast ctx]
|
||||||
|
# (print "lett!")
|
||||||
|
# (pp ast)
|
||||||
|
(def [patt expr] (ast :data))
|
||||||
|
(def value (interpret expr ctx))
|
||||||
|
(def match? (match-pattern patt value))
|
||||||
|
(if (match? :success)
|
||||||
|
(do
|
||||||
|
(merge-into ctx (match? :ctx))
|
||||||
|
value)
|
||||||
|
(error {:node ast :value value :msg "no match: let binding"})))
|
||||||
|
|
||||||
|
(defn- matchh [ast ctx]
|
||||||
|
(def [to-match clauses] (ast :data))
|
||||||
|
(def value (interpret to-match ctx))
|
||||||
|
(def len (length clauses))
|
||||||
|
(when (ast :match) (break ((ast :match) 0 value ctx)))
|
||||||
|
(defn match-fn [i value ctx]
|
||||||
|
(when (= len i)
|
||||||
|
(error {:node ast :value value :msg "no match: match form"}))
|
||||||
|
(def clause (clauses i))
|
||||||
|
(def [patt guard expr] clause)
|
||||||
|
(def match? (match-pattern patt value @{:^parent ctx}))
|
||||||
|
(when (not (match? :success))
|
||||||
|
(break (match-fn (inc i) value ctx)))
|
||||||
|
(def body-ctx (match? :ctx))
|
||||||
|
(def guard? (if guard
|
||||||
|
(b/bool (interpret guard body-ctx)) true))
|
||||||
|
(when (not guard?)
|
||||||
|
(break (match-fn (inc i) value ctx)))
|
||||||
|
(interpret expr body-ctx))
|
||||||
|
(set (ast :match) match-fn)
|
||||||
|
(match-fn 0 value ctx))
|
||||||
|
|
||||||
|
(defn- script [ast ctx]
|
||||||
|
(def lines (ast :data))
|
||||||
|
(def last-line (last lines))
|
||||||
|
(for i 0 (-> lines length dec)
|
||||||
|
(interpret (lines i) ctx))
|
||||||
|
(interpret last-line ctx))
|
||||||
|
|
||||||
|
(defn- block [ast parent]
|
||||||
|
(def lines (ast :data))
|
||||||
|
(def last-line (last lines))
|
||||||
|
(def ctx @{:^parent parent})
|
||||||
|
(for i 0 (-> lines length dec)
|
||||||
|
(interpret (lines i) ctx))
|
||||||
|
(interpret last-line ctx))
|
||||||
|
|
||||||
|
(defn- to_string [ctx] (fn [x]
|
||||||
|
(b/stringify (interpret x ctx))))
|
||||||
|
|
||||||
|
(defn- interpolated [ast ctx]
|
||||||
|
(def terms (ast :data))
|
||||||
|
(def interpolations (map (to_string ctx) terms))
|
||||||
|
(string/join interpolations))
|
||||||
|
|
||||||
|
(defn- iff [ast ctx]
|
||||||
|
(def [condition then else] (ast :data))
|
||||||
|
(if (b/bool (interpret condition ctx))
|
||||||
|
(interpret then ctx)
|
||||||
|
(interpret else ctx)))
|
||||||
|
|
||||||
|
# TODO: use a tail call here
|
||||||
|
(defn- whenn [ast ctx]
|
||||||
|
(def clauses (ast :data))
|
||||||
|
(var result :^nothing)
|
||||||
|
(each clause clauses
|
||||||
|
(def [lhs rhs] clause)
|
||||||
|
(when (b/bool (interpret lhs ctx))
|
||||||
|
(set result (interpret rhs ctx))
|
||||||
|
(break)))
|
||||||
|
(when (= result :^nothing)
|
||||||
|
(error {:node ast :msg "no match: when form"}))
|
||||||
|
result)
|
||||||
|
|
||||||
|
(defn- word [ast ctx]
|
||||||
|
(def resolved (resolve-name (ast :data) ctx))
|
||||||
|
(if (= :^not-found resolved)
|
||||||
|
(error {:node ast :msg "unbound name"})
|
||||||
|
resolved))
|
||||||
|
|
||||||
|
(defn- tup [ast ctx]
|
||||||
|
(def members (ast :data))
|
||||||
|
(def the-tup @[])
|
||||||
|
(each member members
|
||||||
|
(array/push the-tup (interpret member ctx)))
|
||||||
|
[;the-tup])
|
||||||
|
|
||||||
|
(defn- args [ast ctx]
|
||||||
|
(def members (ast :data))
|
||||||
|
(def the-args @[])
|
||||||
|
(each member members
|
||||||
|
(array/push the-args (interpret member ctx)))
|
||||||
|
(if (ast :partial)
|
||||||
|
{:^type :partial :args the-args}
|
||||||
|
[;the-args]))
|
||||||
|
|
||||||
|
(defn- sett [ast ctx]
|
||||||
|
(def members (ast :data))
|
||||||
|
(def the-set @{:^type :set})
|
||||||
|
(each member members
|
||||||
|
(def value (interpret member ctx))
|
||||||
|
(set (the-set value) true))
|
||||||
|
the-set)
|
||||||
|
|
||||||
|
(defn- list [ast ctx]
|
||||||
|
(def members (ast :data))
|
||||||
|
(def the-list @[])
|
||||||
|
(each member members
|
||||||
|
(if (= :splat (member :type))
|
||||||
|
(do
|
||||||
|
(def splatted (interpret (member :data) ctx))
|
||||||
|
(when (not= :array (type splatted))
|
||||||
|
(error {:node member :msg "cannot splat non-list into list"}))
|
||||||
|
(array/concat the-list splatted))
|
||||||
|
(array/push the-list (interpret member ctx))))
|
||||||
|
the-list)
|
||||||
|
|
||||||
|
(defn- dict [ast ctx]
|
||||||
|
(def members (ast :data))
|
||||||
|
(def the-dict @{})
|
||||||
|
(each member members
|
||||||
|
(if (= :splat (member :type))
|
||||||
|
(do
|
||||||
|
(def splatted (interpret (member :data) ctx))
|
||||||
|
(when (or
|
||||||
|
(not= :table (type splatted))
|
||||||
|
(:^type splatted))
|
||||||
|
(error {:node member :msg "cannot splat non-dict into dict"}))
|
||||||
|
(merge-into the-dict splatted))
|
||||||
|
(do
|
||||||
|
(def [key-ast value-ast] (member :data))
|
||||||
|
# (print "dict key")
|
||||||
|
# (pp key-ast)
|
||||||
|
# (print "dict value")
|
||||||
|
# (pp value-ast)
|
||||||
|
(def key (interpret key-ast ctx))
|
||||||
|
(def value (interpret value-ast ctx))
|
||||||
|
(set (the-dict key) value))))
|
||||||
|
the-dict)
|
||||||
|
|
||||||
|
(defn- ref [ast ctx]
|
||||||
|
(def {:data value-ast :name name} ast)
|
||||||
|
(def value (interpret value-ast ctx))
|
||||||
|
(def box @{:^type :box :^value value :name name})
|
||||||
|
(set (ctx name) box)
|
||||||
|
box)
|
||||||
|
|
||||||
|
(defn- repeatt [ast ctx]
|
||||||
|
(def [times-ast body] (ast :data))
|
||||||
|
(def times (interpret times-ast ctx))
|
||||||
|
(when (not (number? times))
|
||||||
|
(error {:node times-ast :msg (string "repeat needs a `number` of times; you gave me a " (type times))}))
|
||||||
|
(repeat times (interpret body ctx)))
|
||||||
|
|
||||||
|
(defn- panic [ast ctx]
|
||||||
|
(def info (interpret (ast :data) ctx))
|
||||||
|
(error {:node ast :msg info}))
|
||||||
|
|
||||||
|
# TODO: add docstrings & pattern docs to fns
|
||||||
|
# Depends on: good string representation of patterns
|
||||||
|
# For now, this should be enough to tall the thing
|
||||||
|
(defn- fnn [ast ctx]
|
||||||
|
(def {:name name :data clauses :doc doc} ast)
|
||||||
|
# (print "defining fn " name)
|
||||||
|
(def closure (merge ctx))
|
||||||
|
(def the-fn @{:name name :^type :fn :body clauses :ctx closure :doc doc})
|
||||||
|
(when (not= :^not-found (resolve-name name ctx))
|
||||||
|
# (print "fn "name" was forward declared")
|
||||||
|
(def fwd (resolve-name name ctx))
|
||||||
|
(set (fwd :body) clauses)
|
||||||
|
(set (fwd :ctx) closure)
|
||||||
|
(set (fwd :doc) doc)
|
||||||
|
# (print "fn " name " has been defined")
|
||||||
|
# (pp fwd)
|
||||||
|
(break fwd))
|
||||||
|
# (pp the-fn)
|
||||||
|
(set (closure name) the-fn)
|
||||||
|
(set (ctx name) the-fn)
|
||||||
|
the-fn)
|
||||||
|
|
||||||
|
(defn- is_placeholder [x] (= x :_))
|
||||||
|
|
||||||
|
(var call-fn nil)
|
||||||
|
|
||||||
|
(defn- partial [root-ast the-fn partial-args]
|
||||||
|
(when (the-fn :applied)
|
||||||
|
(error {:msg "cannot partially apply a partially applied function"
|
||||||
|
:node root-ast :called the-fn :args partial-args}))
|
||||||
|
# (print "calling partially applied function")
|
||||||
|
(def args (partial-args :args))
|
||||||
|
# (pp args)
|
||||||
|
(def pos (find-index is_placeholder args))
|
||||||
|
(def name (string (the-fn :name) " *partial*"))
|
||||||
|
(defn partial-fn [root-ast missing]
|
||||||
|
# (print "calling function with arg " (b/show missing))
|
||||||
|
# (pp partial-args)
|
||||||
|
(def full-args (array/slice args))
|
||||||
|
(set (full-args pos) missing)
|
||||||
|
# (print "all args: " (b/show full-args))
|
||||||
|
(call-fn root-ast the-fn [;full-args]))
|
||||||
|
{:^type :fn :applied true :name name :body partial-fn})
|
||||||
|
|
||||||
|
(defn- call-fn* [root-ast the-fn args]
|
||||||
|
# (print "on line " (get-in root-ast [:token :line]))
|
||||||
|
# (print "calling " (b/show the-fn))
|
||||||
|
# (print "with args " (b/show args))
|
||||||
|
# (pp args)
|
||||||
|
(when (or
|
||||||
|
(= :function (type the-fn))
|
||||||
|
(= :cfunction (type the-fn)))
|
||||||
|
# (print "Janet function")
|
||||||
|
(break (the-fn ;args)))
|
||||||
|
(def clauses (the-fn :body))
|
||||||
|
(when (= :nothing clauses)
|
||||||
|
(error {:node root-ast :called the-fn :value args :msg "cannot call function before it is defined"}))
|
||||||
|
(when (= :function (type clauses))
|
||||||
|
(break (clauses root-ast ;args)))
|
||||||
|
(def len (length clauses))
|
||||||
|
(when (the-fn :match) (break ((the-fn :match) 0 args)))
|
||||||
|
(defn match-fn [i args]
|
||||||
|
(when (= len i)
|
||||||
|
(error {:node root-ast :called the-fn :value args :msg "no match: function call"}))
|
||||||
|
(def clause (clauses i))
|
||||||
|
(def [patt guard expr] clause)
|
||||||
|
(def match?
|
||||||
|
(match-pattern patt args @{:^parent (the-fn :ctx)}))
|
||||||
|
(when (not (match? :success))
|
||||||
|
(break (match-fn (inc i) args)))
|
||||||
|
# (print "matched!")
|
||||||
|
(def body-ctx (match? :ctx))
|
||||||
|
(def guard? (if guard
|
||||||
|
(b/bool (interpret guard body-ctx)) true))
|
||||||
|
# (print "passed guard")
|
||||||
|
(when (not guard?)
|
||||||
|
(break (match-fn (inc i) args)))
|
||||||
|
(interpret expr body-ctx))
|
||||||
|
(set (the-fn :match) match-fn)
|
||||||
|
(match-fn 0 args))
|
||||||
|
|
||||||
|
(set call-fn call-fn*)
|
||||||
|
|
||||||
|
(defn- call-partial [root-ast the-fn arg] ((the-fn :body) root-ast ;arg))
|
||||||
|
|
||||||
|
(defn- apply-synth-term [root-ast prev curr]
|
||||||
|
# (print "applying " (b/show prev))
|
||||||
|
# (print "to" (b/show curr))
|
||||||
|
(def types [(b/ludus/type prev) (b/ludus/type curr)])
|
||||||
|
# (print "typle:")
|
||||||
|
# (pp types)
|
||||||
|
(match types
|
||||||
|
[:fn :tuple] (call-fn root-ast prev curr)
|
||||||
|
[:fn :partial] (partial root-ast prev curr)
|
||||||
|
[:function :tuple] (call-fn root-ast prev curr)
|
||||||
|
# [:applied :tuple] (call-partial root-ast prev curr)
|
||||||
|
[:keyword :args] (get (first curr) prev :^nil)
|
||||||
|
[:dict :keyword] (get prev curr :^nil)
|
||||||
|
[:nil :keyword] :^nil
|
||||||
|
[:pkg :keyword] (get prev curr :^nil)
|
||||||
|
[:pkg :pkg-kw] (get prev curr :^nil)))
|
||||||
|
|
||||||
|
(defn- synthetic [ast ctx]
|
||||||
|
(def terms (ast :data))
|
||||||
|
# (print "interpreting synthetic")
|
||||||
|
# (pp ast)
|
||||||
|
# (pp terms)
|
||||||
|
(def first-term (first terms))
|
||||||
|
(def last-term (last terms))
|
||||||
|
(var prev (interpret first-term ctx))
|
||||||
|
# (print "root term: ")
|
||||||
|
# (pp prev)
|
||||||
|
(for i 1 (-> terms length dec)
|
||||||
|
(def curr (interpret (terms i) ctx))
|
||||||
|
# (print "term " i ": " curr)
|
||||||
|
(set prev (apply-synth-term first-term prev curr)))
|
||||||
|
# (print "done with inner terms, applying last term")
|
||||||
|
(apply-synth-term first-term prev (interpret last-term ctx)))
|
||||||
|
|
||||||
|
(defn- doo [ast ctx]
|
||||||
|
(def terms (ast :data))
|
||||||
|
(var prev (interpret (first terms) ctx))
|
||||||
|
(def last-term (last terms))
|
||||||
|
(for i 1 (-> terms length dec)
|
||||||
|
(def curr (interpret (terms i) ctx))
|
||||||
|
(set prev (call-fn (first terms) curr [prev])))
|
||||||
|
(def last-fn (interpret last-term ctx))
|
||||||
|
(call-fn (first terms) last-fn [prev]))
|
||||||
|
|
||||||
|
(defn- pkg [ast ctx]
|
||||||
|
(def members (ast :data))
|
||||||
|
(def the-pkg @{:^name (ast :name) :^type :pkg})
|
||||||
|
(each member members
|
||||||
|
(def [key-ast value-ast] (member :data))
|
||||||
|
(def key (interpret key-ast ctx))
|
||||||
|
(def value (interpret value-ast ctx))
|
||||||
|
(set (the-pkg key) value))
|
||||||
|
# (pp the-pkg)
|
||||||
|
(def out (table/to-struct the-pkg))
|
||||||
|
(set (ctx (ast :name)) out)
|
||||||
|
out)
|
||||||
|
|
||||||
|
(defn- loopp [ast ctx]
|
||||||
|
# (print "looping!")
|
||||||
|
(def data (ast :data))
|
||||||
|
(def args (interpret (data 0) ctx))
|
||||||
|
# this doesn't work: context persists between different interpretations
|
||||||
|
# we want functions to work this way, but not loops (I think)
|
||||||
|
# (when (ast :match) (break ((ast :match) 0 args)))
|
||||||
|
(def clauses (data 1))
|
||||||
|
(def len (length clauses))
|
||||||
|
(var loop-ctx @{:^parent ctx})
|
||||||
|
(defn match-fn [i args]
|
||||||
|
(when (= len i)
|
||||||
|
(error {:node ast :value args :msg "no match: loop"}))
|
||||||
|
(def clause (clauses i))
|
||||||
|
(def [patt guard expr] clause)
|
||||||
|
(def match?
|
||||||
|
(match-pattern patt args loop-ctx))
|
||||||
|
(when (not (match? :success))
|
||||||
|
# (print "no match")
|
||||||
|
(break (match-fn (inc i) args)))
|
||||||
|
# (print "matched!")
|
||||||
|
(def body-ctx (match? :ctx))
|
||||||
|
(def guard? (if guard
|
||||||
|
(b/bool (interpret guard body-ctx)) true))
|
||||||
|
# (print "passed guard")
|
||||||
|
(when (not guard?)
|
||||||
|
(break (match-fn (inc i) args)))
|
||||||
|
(interpret expr body-ctx))
|
||||||
|
(set (ast :match) match-fn)
|
||||||
|
(set (loop-ctx :^recur) match-fn)
|
||||||
|
# (print "ATTACHED MATCH-FN")
|
||||||
|
(match-fn 0 args))
|
||||||
|
|
||||||
|
(defn- recur [ast ctx]
|
||||||
|
# (print "recurring!")
|
||||||
|
(def passed (ast :data))
|
||||||
|
(def args (interpret passed ctx))
|
||||||
|
(def match-fn (resolve-name :^recur ctx))
|
||||||
|
# (print "match fn in ctx:")
|
||||||
|
# (pp (ctx :^recur))
|
||||||
|
# (pp match-fn)
|
||||||
|
# (pp ctx)
|
||||||
|
(match-fn 0 args))
|
||||||
|
|
||||||
|
# TODO for 0.1.0
|
||||||
|
(defn- testt [ast ctx] (todo "test"))
|
||||||
|
|
||||||
|
(defn- ns [ast ctx] (todo "nses"))
|
||||||
|
|
||||||
|
(defn- importt [ast ctx] (todo "imports"))
|
||||||
|
|
||||||
|
(defn- withh [ast ctx] (todo "with"))
|
||||||
|
|
||||||
|
(defn- usee [ast ctx] (todo "use"))
|
||||||
|
|
||||||
|
(defn- interpret* [ast ctx]
|
||||||
|
# (print "interpreting node " (ast :type))
|
||||||
|
(case (ast :type)
|
||||||
|
# literals
|
||||||
|
:nil :^nil
|
||||||
|
:number (ast :data)
|
||||||
|
:bool (ast :data)
|
||||||
|
:string (ast :data)
|
||||||
|
:keyword (ast :data)
|
||||||
|
:placeholder :_
|
||||||
|
|
||||||
|
# collections
|
||||||
|
:tuple (tup ast ctx)
|
||||||
|
:args (args ast ctx)
|
||||||
|
:list (list ast ctx)
|
||||||
|
:set (sett ast ctx)
|
||||||
|
:dict (dict ast ctx)
|
||||||
|
|
||||||
|
# composite forms
|
||||||
|
:if (iff ast ctx)
|
||||||
|
:block (block ast ctx)
|
||||||
|
:when (whenn ast ctx)
|
||||||
|
:script (script ast ctx)
|
||||||
|
:panic (panic ast ctx)
|
||||||
|
|
||||||
|
# looping forms
|
||||||
|
:loop (loopp ast ctx)
|
||||||
|
:recur (recur ast ctx)
|
||||||
|
:repeat (repeatt ast ctx)
|
||||||
|
|
||||||
|
# named/naming forms
|
||||||
|
:word (word ast ctx)
|
||||||
|
:interpolated (interpolated ast ctx)
|
||||||
|
:ref (ref ast ctx)
|
||||||
|
:pkg (pkg ast ctx)
|
||||||
|
:pkg-name (word ast ctx)
|
||||||
|
|
||||||
|
# patterned forms
|
||||||
|
:let (lett ast ctx)
|
||||||
|
:match (matchh ast ctx)
|
||||||
|
|
||||||
|
# functions
|
||||||
|
:fn (fnn ast ctx)
|
||||||
|
|
||||||
|
# synthetic
|
||||||
|
:synthetic (synthetic ast ctx)
|
||||||
|
|
||||||
|
# do
|
||||||
|
:do (doo ast ctx)
|
||||||
|
|
||||||
|
# deferred until after computer class
|
||||||
|
# :with (withh ast ctx)
|
||||||
|
# :import (importt ast ctx)
|
||||||
|
# :ns (ns ast ctx)
|
||||||
|
# :use (usee ast ctx)
|
||||||
|
# :test (testt ast ctx)
|
||||||
|
|
||||||
|
))
|
||||||
|
|
||||||
|
(set interpret interpret*)
|
||||||
|
|
||||||
|
# # repl
|
||||||
|
# (import ./scanner :as s)
|
||||||
|
# (import ./parser :as p)
|
||||||
|
# (import ./validate :as v)
|
||||||
|
|
||||||
|
# (var source nil)
|
||||||
|
|
||||||
|
# (defn- has-errors? [{:errors errors}] (and errors (not (empty? errors))))
|
||||||
|
|
||||||
|
# (defn run []
|
||||||
|
# (def scanned (s/scan source))
|
||||||
|
# (when (has-errors? scanned) (break (scanned :errors)))
|
||||||
|
# (def parsed (p/parse scanned))
|
||||||
|
# (when (has-errors? parsed) (break (parsed :errors)))
|
||||||
|
# (def validated (v/valid parsed b/ctx))
|
||||||
|
# # (when (has-errors? validated) (break (validated :errors)))
|
||||||
|
# # (def cleaned (get-in parsed [:ast :data 1]))
|
||||||
|
# # # (pp cleaned)
|
||||||
|
# # (interpret (parsed :ast) @{:^parent b/ctx})
|
||||||
|
# (try (interpret (parsed :ast) @{:^parent b/ctx})
|
||||||
|
# ([e] (if (struct? e) (error (e :msg)) (error e)))))
|
||||||
|
|
||||||
|
# # (do
|
||||||
|
# (comment
|
||||||
|
# (set source `
|
||||||
|
|
||||||
|
# `)
|
||||||
|
# (def result (run))
|
||||||
|
# )
|
||||||
|
|
||||||
9
src/judgy.fish
Executable file
9
src/judgy.fish
Executable file
|
|
@ -0,0 +1,9 @@
|
||||||
|
#!/opt/homebrew/bin/fish
|
||||||
|
|
||||||
|
set FILE $argv[1]
|
||||||
|
set TESTFILE (string join "" $FILE ".tested")
|
||||||
|
judge $FILE
|
||||||
|
if test -e $TESTFILE
|
||||||
|
cp $TESTFILE $FILE
|
||||||
|
rm $TESTFILE
|
||||||
|
end
|
||||||
371
src/language.test.janet
Normal file
371
src/language.test.janet
Normal file
|
|
@ -0,0 +1,371 @@
|
||||||
|
# testing Ludus langauge constructs
|
||||||
|
(try (os/cd "janet") ([_] nil)) # for REPL
|
||||||
|
(import /scanner :as s)
|
||||||
|
(import /parser :as p)
|
||||||
|
(import /validate :as v)
|
||||||
|
(import /interpreter :as i)
|
||||||
|
(import /errors :as e)
|
||||||
|
(import /base :as b)
|
||||||
|
|
||||||
|
(use judge)
|
||||||
|
|
||||||
|
(defn run [source]
|
||||||
|
(def ctx @{})
|
||||||
|
(def scanned (s/scan source :test))
|
||||||
|
(when (any? (scanned :errors))
|
||||||
|
(e/scan-error (scanned :errors)) (error "scanning errors"))
|
||||||
|
(def parsed (p/parse scanned))
|
||||||
|
(when (any? (parsed :errors))
|
||||||
|
(e/parse-error (parsed :errors)) (error "parsing errors"))
|
||||||
|
(def valid (v/valid parsed ctx))
|
||||||
|
(when (any? (valid :errors)) (each err (valid :errors)
|
||||||
|
(e/validation-error err)) (error "validation errors"))
|
||||||
|
(i/interpret (parsed :ast) ctx))
|
||||||
|
|
||||||
|
(deftest "returns bare values from single-line scripts"
|
||||||
|
(test (run "true") true)
|
||||||
|
(test (run "false") false)
|
||||||
|
(test (run "nil") :^nil)
|
||||||
|
(test (run "12.34") 12.34)
|
||||||
|
(test (run "-32") -32)
|
||||||
|
(test (run "0") 0)
|
||||||
|
(test (run ":foo") :foo)
|
||||||
|
(test (run ":bar") :bar)
|
||||||
|
(test (run `"a string, a text, a language"`) "a string, a text, a language"))
|
||||||
|
|
||||||
|
(deftest "returns empty collections from single-line scripts"
|
||||||
|
(test (run "()") [])
|
||||||
|
(test (run "#{}") @{})
|
||||||
|
(test (run "${}") @{:^type :set})
|
||||||
|
(test (run "[]") @[]))
|
||||||
|
|
||||||
|
(deftest "returns populated collections from single-line scripts"
|
||||||
|
(test (run "(1, 2, 3)") [1 2 3])
|
||||||
|
(test (run "[:a, :b, :c]") @[:a :b :c])
|
||||||
|
(test (run "${1, 2, 3, 3}") @{1 true 2 true 3 true :^type :set})
|
||||||
|
(test (run "#{:a 1, :b 2}") @{:a 1 :b 2}))
|
||||||
|
|
||||||
|
(deftest "returns nested collections from single-line scripts"
|
||||||
|
(test (run "((), (1, 2), [:a, (:b)], #{:foo true, :bar false})")
|
||||||
|
[[]
|
||||||
|
[1 2]
|
||||||
|
@[:a [:b]]
|
||||||
|
@{:bar false :foo true}])
|
||||||
|
(test (run `#{:foo #{:bar "thing", :baz (1, :foo, nil)}}`) @{:foo @{:bar "thing" :baz [1 :foo :^nil]}}))
|
||||||
|
|
||||||
|
(deftest "binds names in let bindings with various patterns"
|
||||||
|
(test (run `let foo = :bar; foo`) :bar)
|
||||||
|
(test (run `let 42 = 42`) 42)
|
||||||
|
(test (run `let foo = :bar; let quux = 42; (foo, quux)`) [:bar 42])
|
||||||
|
(test (run `let (:ok, value) = (:ok, 42); value`) 42)
|
||||||
|
(test (run `let #{:a x, ...} = #{:a 1, :b 2}; x`) 1))
|
||||||
|
|
||||||
|
(deftest "executes if/then/else properly"
|
||||||
|
(test (run `if nil then :foo else :bar`) :bar)
|
||||||
|
(test (run `if false then :foo else :bar`) :bar)
|
||||||
|
(test (run `if true then :foo else :bar`) :foo)
|
||||||
|
(test (run `if 42 then :foo else panic! "oops"`) :foo))
|
||||||
|
|
||||||
|
(deftest "panics"
|
||||||
|
(test-error (run `panic! "oops"`)
|
||||||
|
{:msg "oops"
|
||||||
|
:node {:data {:data "oops"
|
||||||
|
:token {:input :test
|
||||||
|
:lexeme "\"oops\""
|
||||||
|
:line 1
|
||||||
|
:literal "oops"
|
||||||
|
:source "panic! \"oops\""
|
||||||
|
:start 7
|
||||||
|
:type :string}
|
||||||
|
:type :string}
|
||||||
|
:token {:input :test
|
||||||
|
:lexeme "panic!"
|
||||||
|
:line 1
|
||||||
|
:literal :none
|
||||||
|
:source "panic! \"oops\""
|
||||||
|
:start 0
|
||||||
|
:type :panic}
|
||||||
|
:type :panic}})
|
||||||
|
)
|
||||||
|
|
||||||
|
(deftest "no match in let panics"
|
||||||
|
(test-error (run "let :foo = :bar")
|
||||||
|
{:msg "no match: let binding"
|
||||||
|
:node {:data @[{:data :foo
|
||||||
|
:token {:input :test
|
||||||
|
:lexeme ":foo"
|
||||||
|
:line 1
|
||||||
|
:literal :foo
|
||||||
|
:source "let :foo = :bar"
|
||||||
|
:start 4
|
||||||
|
:type :keyword}
|
||||||
|
:type :keyword}
|
||||||
|
{:data :bar
|
||||||
|
:token {:input :test
|
||||||
|
:lexeme ":bar"
|
||||||
|
:line 1
|
||||||
|
:literal :bar
|
||||||
|
:source "let :foo = :bar"
|
||||||
|
:start 11
|
||||||
|
:type :keyword}
|
||||||
|
:type :keyword}]
|
||||||
|
:token {:input :test
|
||||||
|
:lexeme "let"
|
||||||
|
:line 1
|
||||||
|
:literal :none
|
||||||
|
:source "let :foo = :bar"
|
||||||
|
:start 0
|
||||||
|
:type :let}
|
||||||
|
:type :let}
|
||||||
|
:value :bar})
|
||||||
|
)
|
||||||
|
|
||||||
|
(deftest "blocks execute code and work"
|
||||||
|
(test (run `
|
||||||
|
let bar = 12
|
||||||
|
let foo = {
|
||||||
|
let bar = 42
|
||||||
|
let baz = :quux
|
||||||
|
:foo
|
||||||
|
}
|
||||||
|
(foo, bar)
|
||||||
|
`)
|
||||||
|
[:foo 12])
|
||||||
|
(test (run `
|
||||||
|
let foo = {
|
||||||
|
let bar = 12
|
||||||
|
{
|
||||||
|
let bar = 15
|
||||||
|
bar
|
||||||
|
}
|
||||||
|
}
|
||||||
|
`)
|
||||||
|
15))
|
||||||
|
|
||||||
|
(deftest "unbound name panics"
|
||||||
|
(test-error (run `foo`) "validation errors"))
|
||||||
|
|
||||||
|
(deftest "rebinding name panics"
|
||||||
|
(test-error (run `let foo = 42; let foo = 23`) "validation errors"))
|
||||||
|
|
||||||
|
(deftest "when forms work as expected"
|
||||||
|
(test (run `
|
||||||
|
when {
|
||||||
|
false -> :nope
|
||||||
|
nil -> :nope
|
||||||
|
12 -> :yes
|
||||||
|
}
|
||||||
|
`)
|
||||||
|
:yes)
|
||||||
|
(test-error (run `
|
||||||
|
when {
|
||||||
|
false -> :nope
|
||||||
|
nil -> :nope
|
||||||
|
}
|
||||||
|
`)
|
||||||
|
{:msg "no match: when form"
|
||||||
|
:node {:data @[[{:data false
|
||||||
|
:token {:input :test
|
||||||
|
:lexeme "false"
|
||||||
|
:line 2
|
||||||
|
:literal false
|
||||||
|
:source " when {\n false -> :nope\n nil -> :nope\n }\n "
|
||||||
|
:start 12
|
||||||
|
:type :false}
|
||||||
|
:type :bool}
|
||||||
|
{:data :nope
|
||||||
|
:token {:input :test
|
||||||
|
:lexeme ":nope"
|
||||||
|
:line 2
|
||||||
|
:literal :nope
|
||||||
|
:source " when {\n false -> :nope\n nil -> :nope\n }\n "
|
||||||
|
:start 21
|
||||||
|
:type :keyword}
|
||||||
|
:type :keyword}]
|
||||||
|
[{:token {:input :test
|
||||||
|
:lexeme "nil"
|
||||||
|
:line 3
|
||||||
|
:literal :none
|
||||||
|
:source " when {\n false -> :nope\n nil -> :nope\n }\n "
|
||||||
|
:start 30
|
||||||
|
:type :nil}
|
||||||
|
:type :nil}
|
||||||
|
{:data :nope
|
||||||
|
:token {:input :test
|
||||||
|
:lexeme ":nope"
|
||||||
|
:line 3
|
||||||
|
:literal :nope
|
||||||
|
:source " when {\n false -> :nope\n nil -> :nope\n }\n "
|
||||||
|
:start 37
|
||||||
|
:type :keyword}
|
||||||
|
:type :keyword}]]
|
||||||
|
:token {:input :test
|
||||||
|
:lexeme "when"
|
||||||
|
:line 1
|
||||||
|
:literal :none
|
||||||
|
:source " when {\n false -> :nope\n nil -> :nope\n }\n "
|
||||||
|
:start 2
|
||||||
|
:type :when}
|
||||||
|
:type :when}})
|
||||||
|
)
|
||||||
|
|
||||||
|
(deftest "match forms work as expected"
|
||||||
|
(test (run `
|
||||||
|
match :foo with {
|
||||||
|
:bar -> :nope
|
||||||
|
:baz -> :nope
|
||||||
|
x -> x
|
||||||
|
}
|
||||||
|
`)
|
||||||
|
:foo)
|
||||||
|
(test (run `
|
||||||
|
let foo = 42
|
||||||
|
match (:ok, foo) with {
|
||||||
|
(:err, _) -> :nope
|
||||||
|
(:ok, :foo) -> :nope
|
||||||
|
(:ok, _) -> :yes
|
||||||
|
}
|
||||||
|
`)
|
||||||
|
:yes)
|
||||||
|
(test-error (run `
|
||||||
|
let foo = "foo"
|
||||||
|
match foo with {
|
||||||
|
"bar" -> :nope
|
||||||
|
"baz" -> :nope
|
||||||
|
12.34 -> :nope
|
||||||
|
}
|
||||||
|
`)
|
||||||
|
{:msg "no match: match form"
|
||||||
|
:node @{:data [{:data "foo"
|
||||||
|
:token {:input :test
|
||||||
|
:lexeme "foo"
|
||||||
|
:line 2
|
||||||
|
:literal :none
|
||||||
|
:source " let foo = \"foo\"\n match foo with {\n \"bar\" -> :nope\n \"baz\" -> :nope\n 12.34 -> :nope \n }\n "
|
||||||
|
:start 26
|
||||||
|
:type :word}
|
||||||
|
:type :word}
|
||||||
|
@[[{:data "bar"
|
||||||
|
:token {:input :test
|
||||||
|
:lexeme "\"bar\""
|
||||||
|
:line 3
|
||||||
|
:literal "bar"
|
||||||
|
:source " let foo = \"foo\"\n match foo with {\n \"bar\" -> :nope\n \"baz\" -> :nope\n 12.34 -> :nope \n }\n "
|
||||||
|
:start 40
|
||||||
|
:type :string}
|
||||||
|
:type :string}
|
||||||
|
nil
|
||||||
|
{:data :nope
|
||||||
|
:token {:input :test
|
||||||
|
:lexeme ":nope"
|
||||||
|
:line 3
|
||||||
|
:literal :nope
|
||||||
|
:source " let foo = \"foo\"\n match foo with {\n \"bar\" -> :nope\n \"baz\" -> :nope\n 12.34 -> :nope \n }\n "
|
||||||
|
:start 49
|
||||||
|
:type :keyword}
|
||||||
|
:type :keyword}]
|
||||||
|
[{:data "baz"
|
||||||
|
:token {:input :test
|
||||||
|
:lexeme "\"baz\""
|
||||||
|
:line 4
|
||||||
|
:literal "baz"
|
||||||
|
:source " let foo = \"foo\"\n match foo with {\n \"bar\" -> :nope\n \"baz\" -> :nope\n 12.34 -> :nope \n }\n "
|
||||||
|
:start 58
|
||||||
|
:type :string}
|
||||||
|
:type :string}
|
||||||
|
nil
|
||||||
|
{:data :nope
|
||||||
|
:token {:input :test
|
||||||
|
:lexeme ":nope"
|
||||||
|
:line 4
|
||||||
|
:literal :nope
|
||||||
|
:source " let foo = \"foo\"\n match foo with {\n \"bar\" -> :nope\n \"baz\" -> :nope\n 12.34 -> :nope \n }\n "
|
||||||
|
:start 67
|
||||||
|
:type :keyword}
|
||||||
|
:type :keyword}]
|
||||||
|
[{:data 12.34
|
||||||
|
:token {:input :test
|
||||||
|
:lexeme "12.34"
|
||||||
|
:line 5
|
||||||
|
:literal 12.34
|
||||||
|
:source " let foo = \"foo\"\n match foo with {\n \"bar\" -> :nope\n \"baz\" -> :nope\n 12.34 -> :nope \n }\n "
|
||||||
|
:start 76
|
||||||
|
:type :number}
|
||||||
|
:type :number}
|
||||||
|
nil
|
||||||
|
{:data :nope
|
||||||
|
:token {:input :test
|
||||||
|
:lexeme ":nope"
|
||||||
|
:line 5
|
||||||
|
:literal :nope
|
||||||
|
:source " let foo = \"foo\"\n match foo with {\n \"bar\" -> :nope\n \"baz\" -> :nope\n 12.34 -> :nope \n }\n "
|
||||||
|
:start 85
|
||||||
|
:type :keyword}
|
||||||
|
:type :keyword}]]]
|
||||||
|
:match @match-fn
|
||||||
|
:token {:input :test
|
||||||
|
:lexeme "match"
|
||||||
|
:line 2
|
||||||
|
:literal :none
|
||||||
|
:source " let foo = \"foo\"\n match foo with {\n \"bar\" -> :nope\n \"baz\" -> :nope\n 12.34 -> :nope \n }\n "
|
||||||
|
:start 20
|
||||||
|
:type :match}
|
||||||
|
:type :match}
|
||||||
|
:value "foo"})
|
||||||
|
)
|
||||||
|
|
||||||
|
(deftest "string patterns work as expected"
|
||||||
|
(test (run `let "I {verb} the {noun}" = "I am the walrus"; (verb, noun)`) ["am" "walrus"])
|
||||||
|
(test (run `let "a {b} c {d}" = "a because I love you c yourself out the door"; (b, d)`)
|
||||||
|
["because I love you"
|
||||||
|
"yourself out the door"])
|
||||||
|
)
|
||||||
|
|
||||||
|
(deftest "lambdas may be defined and called"
|
||||||
|
(test (run `
|
||||||
|
let foo = fn () -> :foo
|
||||||
|
foo ()
|
||||||
|
`)
|
||||||
|
:foo)
|
||||||
|
(test (run `
|
||||||
|
let pair = fn (x, y) -> (x, y)
|
||||||
|
pair (:foo, :bar)
|
||||||
|
`)
|
||||||
|
[:foo :bar])
|
||||||
|
(test-error (run `
|
||||||
|
let foo = fn () -> :foo
|
||||||
|
foo (:bar)
|
||||||
|
`)
|
||||||
|
{:called @{:^type :fn
|
||||||
|
:body [[{:data @[]
|
||||||
|
:token {:input :test
|
||||||
|
:lexeme "("
|
||||||
|
:line 1
|
||||||
|
:source " let foo = fn () -> :foo\n foo (:bar)\n "
|
||||||
|
:start 15
|
||||||
|
:type :lparen}
|
||||||
|
:type :tuple}
|
||||||
|
nil
|
||||||
|
{:data :foo
|
||||||
|
:token {:input :test
|
||||||
|
:lexeme ":foo"
|
||||||
|
:line 1
|
||||||
|
:literal :foo
|
||||||
|
:source " let foo = fn () -> :foo\n foo (:bar)\n "
|
||||||
|
:start 21
|
||||||
|
:type :keyword}
|
||||||
|
:type :keyword}]]
|
||||||
|
:ctx @{}
|
||||||
|
:match @match-fn}
|
||||||
|
:msg "no match: function call"
|
||||||
|
:node {:data "foo"
|
||||||
|
:token {:input :test
|
||||||
|
:lexeme "foo"
|
||||||
|
:line 2
|
||||||
|
:literal :none
|
||||||
|
:source " let foo = fn () -> :foo\n foo (:bar)\n "
|
||||||
|
:start 28
|
||||||
|
:type :word}
|
||||||
|
:type :word}
|
||||||
|
:value [:bar]})
|
||||||
|
)
|
||||||
54
src/ludus.janet
Normal file
54
src/ludus.janet
Normal file
|
|
@ -0,0 +1,54 @@
|
||||||
|
# an integrated Ludus interpreter
|
||||||
|
# devised in order to run under wasm
|
||||||
|
# takes a string, returns a string with a json object
|
||||||
|
# (try (os/cd "janet") ([_] nil)) # for REPL
|
||||||
|
(import /src/scanner :as s)
|
||||||
|
(import /src/parser :as p)
|
||||||
|
(import /src/validate :as v)
|
||||||
|
(import /src/interpreter :as i)
|
||||||
|
(import /src/errors :as e)
|
||||||
|
(import /src/base :as b)
|
||||||
|
(import /src/prelude :as prelude)
|
||||||
|
|
||||||
|
(defn ludus [source]
|
||||||
|
(when (= :error prelude/pkg) (error "could not load prelude"))
|
||||||
|
(def ctx @{:^parent prelude/ctx})
|
||||||
|
(def errors @[])
|
||||||
|
(def draw @[])
|
||||||
|
(var result @"")
|
||||||
|
(def console @"")
|
||||||
|
(def out @{:errors errors :draw draw :result result :console console})
|
||||||
|
(def scanned (s/scan source))
|
||||||
|
(when (any? (scanned :errors))
|
||||||
|
(set (out :errors) (scanned :errors))
|
||||||
|
(each err (scanned :errors)
|
||||||
|
(e/scan-error err))
|
||||||
|
(break out))
|
||||||
|
(def parsed (p/parse scanned))
|
||||||
|
(when (any? (parsed :errors))
|
||||||
|
(set (out :errors) (parsed :errors))
|
||||||
|
(each err (parsed :errors)
|
||||||
|
(e/parse-error err))
|
||||||
|
(break out))
|
||||||
|
(def validated (v/valid parsed ctx))
|
||||||
|
(when (any? (validated :errors))
|
||||||
|
(set (out :errors) (validated :errors))
|
||||||
|
(each err (validated :errors)
|
||||||
|
(e/validation-error err))
|
||||||
|
(break out))
|
||||||
|
(setdyn :out console)
|
||||||
|
(try
|
||||||
|
(set result (i/interpret (parsed :ast) ctx))
|
||||||
|
([err]
|
||||||
|
(e/runtime-error err)
|
||||||
|
(set (out :errors) [err])
|
||||||
|
(break out)))
|
||||||
|
(setdyn :out stdout)
|
||||||
|
(set (out :result) (b/show result))
|
||||||
|
(var post @{})
|
||||||
|
(try
|
||||||
|
(set post (i/interpret prelude/post/ast ctx))
|
||||||
|
([err] (e/runtime-error err)))
|
||||||
|
(set (out :draw) (post :draw))
|
||||||
|
(b/json out))
|
||||||
|
|
||||||
|
|
@ -1,2 +0,0 @@
|
||||||
(ns ludus.ast)
|
|
||||||
|
|
||||||
|
|
@ -1,429 +0,0 @@
|
||||||
(ns ludus.base
|
|
||||||
(:require
|
|
||||||
[ludus.data :as data]
|
|
||||||
[ludus.show :as show]
|
|
||||||
[clojure.math :as math]
|
|
||||||
;[ludus.draw :as d]
|
|
||||||
#?(:cljs [cljs.reader])
|
|
||||||
#?(:cljs [goog.object :as o])
|
|
||||||
))
|
|
||||||
|
|
||||||
;; TODO: make eq, and, or special forms that short-circuit
|
|
||||||
;; Right now, they evaluate all their args
|
|
||||||
(def eq {:name "eq"
|
|
||||||
::data/type ::data/clj
|
|
||||||
:body =})
|
|
||||||
|
|
||||||
(defn- id [x] x)
|
|
||||||
|
|
||||||
(def and- {:name "and"
|
|
||||||
::data/type ::data/clj
|
|
||||||
:body (fn [& args] (every? id args))})
|
|
||||||
|
|
||||||
(def or- {:name "or"
|
|
||||||
::data/type ::data/clj
|
|
||||||
:body (fn [& args] (some id args))})
|
|
||||||
|
|
||||||
(def add {:name "add"
|
|
||||||
::data/type ::data/clj
|
|
||||||
:body +})
|
|
||||||
|
|
||||||
(def sub {:name "sub"
|
|
||||||
::data/type ::data/clj
|
|
||||||
:body -})
|
|
||||||
|
|
||||||
(def mult {:name "mult"
|
|
||||||
::data/type ::data/clj
|
|
||||||
:body *})
|
|
||||||
|
|
||||||
(def div {:name "div"
|
|
||||||
::data/type ::data/clj
|
|
||||||
:body /})
|
|
||||||
|
|
||||||
(def gt {:name "gt"
|
|
||||||
::data/type ::data/clj
|
|
||||||
:body >})
|
|
||||||
|
|
||||||
(def gte {:name "gte"
|
|
||||||
::data/type ::data/clj
|
|
||||||
:body >=})
|
|
||||||
|
|
||||||
(def lt {:name "lt"
|
|
||||||
::data/type ::data/clj
|
|
||||||
:body <})
|
|
||||||
|
|
||||||
(def lte {:name "lte"
|
|
||||||
::data/type ::data/clj
|
|
||||||
:body <=})
|
|
||||||
|
|
||||||
(def inc- {:name "inc"
|
|
||||||
::data/type ::data/clj
|
|
||||||
:body inc})
|
|
||||||
|
|
||||||
(def dec- {:name "dec"
|
|
||||||
::data/type ::data/clj
|
|
||||||
:body dec})
|
|
||||||
|
|
||||||
(def not- {:name "not"
|
|
||||||
::data/type ::data/clj
|
|
||||||
:body not})
|
|
||||||
|
|
||||||
(defn- print-show [lvalue]
|
|
||||||
(if (string? lvalue) lvalue (show/show lvalue)))
|
|
||||||
|
|
||||||
(defn- stringify-args [arglist]
|
|
||||||
(apply str (interpose " " (into [] (map print-show) (rest arglist)))))
|
|
||||||
; (def panic! {:name "panic!"
|
|
||||||
; ::data/type ::data/clj
|
|
||||||
; :body (fn panic-inner
|
|
||||||
; ([] (panic-inner [::data/list]))
|
|
||||||
; ([args] (throw (ex-info (stringify-args args) {}))))})
|
|
||||||
|
|
||||||
(def print- {:name "print"
|
|
||||||
::data/type ::data/clj
|
|
||||||
:body (fn [args]
|
|
||||||
(println (stringify-args args))
|
|
||||||
:ok)})
|
|
||||||
|
|
||||||
(def deref- {:name "deref"
|
|
||||||
::data/type ::data/clj
|
|
||||||
:body (fn [ref]
|
|
||||||
(if (::data/ref ref)
|
|
||||||
(deref (::data/value ref))
|
|
||||||
(throw (ex-info "Cannot deref something that is not a ref" {}))))})
|
|
||||||
|
|
||||||
(def set!- {:name "set!"
|
|
||||||
::data/type ::data/clj
|
|
||||||
:body (fn [ref value]
|
|
||||||
(if (::data/ref ref)
|
|
||||||
(reset! (::data/value ref) value)
|
|
||||||
(throw (ex-info "Cannot set! something that is not a ref" {}))))})
|
|
||||||
|
|
||||||
(def show {:name "show"
|
|
||||||
::data/type ::data/clj
|
|
||||||
:body ludus.show/show})
|
|
||||||
|
|
||||||
(def conj- {:name "conj"
|
|
||||||
::data/type ::data/clj
|
|
||||||
:body conj})
|
|
||||||
|
|
||||||
(def assoc- {:name "assoc"
|
|
||||||
::data/type ::data/clj
|
|
||||||
:body assoc})
|
|
||||||
|
|
||||||
(def dissoc- {name "dissoc"
|
|
||||||
::data/type ::data/clj
|
|
||||||
:body dissoc})
|
|
||||||
|
|
||||||
(def get- {:name "get"
|
|
||||||
::data/type ::data/clj
|
|
||||||
:body (fn
|
|
||||||
([key, map]
|
|
||||||
(if (map? map)
|
|
||||||
(get map key)
|
|
||||||
nil))
|
|
||||||
([key, map, default]
|
|
||||||
(if (map? map)
|
|
||||||
(get map key default)
|
|
||||||
default)))})
|
|
||||||
|
|
||||||
(def rest- {:name "rest"
|
|
||||||
::data/type ::data/clj
|
|
||||||
:body (fn [v]
|
|
||||||
(into [::data/list] (nthrest v 2)))})
|
|
||||||
|
|
||||||
(def nth- {:name "nth"
|
|
||||||
::data/type ::data/clj
|
|
||||||
:body nth})
|
|
||||||
|
|
||||||
(def slice {:name "slice"
|
|
||||||
::data/type ::data/clj
|
|
||||||
:body subvec})
|
|
||||||
|
|
||||||
(def types {
|
|
||||||
:keyword
|
|
||||||
#?(
|
|
||||||
:clj clojure.lang.Keyword
|
|
||||||
:cljs cljs.core/Keyword
|
|
||||||
)
|
|
||||||
|
|
||||||
:long
|
|
||||||
#?(
|
|
||||||
:clj java.lang.Long
|
|
||||||
:cljs js/Number
|
|
||||||
)
|
|
||||||
|
|
||||||
:double
|
|
||||||
#?(
|
|
||||||
:clj java.lang.Double
|
|
||||||
:cljs js/Number
|
|
||||||
)
|
|
||||||
|
|
||||||
:integer
|
|
||||||
#?(
|
|
||||||
:clj java.lang.Integer
|
|
||||||
:cljs js/Number
|
|
||||||
)
|
|
||||||
|
|
||||||
:ratio
|
|
||||||
#?(
|
|
||||||
:clj clojure.lang.Ratio
|
|
||||||
:cljs js/Number
|
|
||||||
)
|
|
||||||
|
|
||||||
:string
|
|
||||||
#?(
|
|
||||||
:clj java.lang.String
|
|
||||||
:cljs js/String
|
|
||||||
)
|
|
||||||
|
|
||||||
:boolean
|
|
||||||
#?(
|
|
||||||
:clj java.lang.Boolean
|
|
||||||
:cljs js/Boolean
|
|
||||||
)
|
|
||||||
|
|
||||||
:set
|
|
||||||
#?(
|
|
||||||
:clj clojure.lang.PersistentHashSet
|
|
||||||
:cljs cljs.core/PersistentHashSet
|
|
||||||
)
|
|
||||||
|
|
||||||
:vector
|
|
||||||
#?(
|
|
||||||
:clj clojure.lang.PersistentVector
|
|
||||||
:cljs cljs.core/PersistentVector
|
|
||||||
)
|
|
||||||
|
|
||||||
:map
|
|
||||||
#?(
|
|
||||||
:clj clojure.lang.PersistentArrayMap
|
|
||||||
:cljs cljs.core/PersistentArrayMap
|
|
||||||
)
|
|
||||||
})
|
|
||||||
|
|
||||||
(defn get-type [value]
|
|
||||||
(let [t (type value)]
|
|
||||||
(cond
|
|
||||||
(nil? value) :nil
|
|
||||||
|
|
||||||
(= (:keyword types) t) :keyword
|
|
||||||
|
|
||||||
(= (:long types) t) :number
|
|
||||||
|
|
||||||
(= (:double types) t) :number
|
|
||||||
|
|
||||||
(= (:integer types) t) :number
|
|
||||||
|
|
||||||
(= (:ratio types) t) :number
|
|
||||||
|
|
||||||
(= (:string types) t) :string
|
|
||||||
|
|
||||||
(= (:boolean types) t) :boolean
|
|
||||||
|
|
||||||
(= (:set types) t) :set
|
|
||||||
|
|
||||||
;; tuples and lists
|
|
||||||
(= (:vector types) t)
|
|
||||||
(if (= ::data/tuple (first value)) :tuple :list)
|
|
||||||
|
|
||||||
;; structs dicts namespaces refs
|
|
||||||
(= (:map types) t)
|
|
||||||
(cond
|
|
||||||
(::data/type value) (case (::data/type value)
|
|
||||||
(::data/fn ::data/clj) :fn
|
|
||||||
::data/ns :ns)
|
|
||||||
(::data/dict value) :dict
|
|
||||||
(::data/struct value) :struct
|
|
||||||
(::data/ref value) :ref
|
|
||||||
:else :none
|
|
||||||
))))
|
|
||||||
|
|
||||||
(def type- {:name "type"
|
|
||||||
::data/type ::data/clj
|
|
||||||
:body get-type})
|
|
||||||
|
|
||||||
(defn- kv->tuple [[k v]] [::data/tuple k v])
|
|
||||||
|
|
||||||
(def to_list {name "to_list"
|
|
||||||
::data/type ::data/clj
|
|
||||||
:body (fn [item]
|
|
||||||
(case (get-type item)
|
|
||||||
(:number :nil :boolean :fn :string :ref :keyword) [::data/list item]
|
|
||||||
:list item
|
|
||||||
:set (into [::data/list] item)
|
|
||||||
:tuple (into [::data/list] (rest item))
|
|
||||||
:dict (into [::data/list] (map kv->tuple) (dissoc item ::data/dict))
|
|
||||||
:struct (into [::data/list] (map kv->tuple) (dissoc item ::data/struct))
|
|
||||||
:ns (into [::data/list] (map kv->tuple) (dissoc item ::data/struct ::data/type ::data/name))
|
|
||||||
))})
|
|
||||||
|
|
||||||
(def to_dict {name "to_dict"
|
|
||||||
::data/type ::data/clj
|
|
||||||
:body (fn [struct] (-> struct (assoc ::data/dict true) (dissoc ::data/struct ::data/type ::data/name)))})
|
|
||||||
|
|
||||||
(defn strpart [kw] (->> kw str rest (apply str)))
|
|
||||||
|
|
||||||
(def readstr
|
|
||||||
#?(
|
|
||||||
:clj read-string
|
|
||||||
:cljs cljs.reader/read-string
|
|
||||||
))
|
|
||||||
|
|
||||||
(defn- resolve-str [str]
|
|
||||||
#?(
|
|
||||||
:clj (eval str)
|
|
||||||
:cljs (.bind (o/get js/window str) js/window)
|
|
||||||
))
|
|
||||||
|
|
||||||
(def extern {:name "extern"
|
|
||||||
::data/type ::data/clj
|
|
||||||
:body (fn [& args]
|
|
||||||
;(println "Args passed: " args)
|
|
||||||
(let [called (-> args first strpart readstr resolve-str)
|
|
||||||
fn-args (rest args)]
|
|
||||||
;(println "Fn: " called)
|
|
||||||
;(println "Args: " (clj->js fn-args))
|
|
||||||
#?(
|
|
||||||
:clj (apply called fn-args)
|
|
||||||
:cljs (.apply called js/window (clj->js fn-args)))))})
|
|
||||||
|
|
||||||
(def count- {:name "count"
|
|
||||||
::data/type ::data/clj
|
|
||||||
:body count})
|
|
||||||
|
|
||||||
(def into- {:name "into"
|
|
||||||
::data/type ::data/clj
|
|
||||||
:body into})
|
|
||||||
|
|
||||||
(def to_vec {:name "to_vec"
|
|
||||||
::data/type ::data/clj
|
|
||||||
:body (fn [xs] (into [] (dissoc xs ::data/type ::data/struct ::data/name)))})
|
|
||||||
|
|
||||||
(def fold {:name "fold"
|
|
||||||
::data/type ::data/clj
|
|
||||||
:body reduce})
|
|
||||||
|
|
||||||
(def map- {:name "map"
|
|
||||||
::data/type ::data/clj
|
|
||||||
:body map})
|
|
||||||
|
|
||||||
(def prn- {:name "raw"
|
|
||||||
::data/type ::data/clj
|
|
||||||
:body println})
|
|
||||||
|
|
||||||
(def concat- {:name "concat"
|
|
||||||
::data/type ::data/clj
|
|
||||||
:body (fn [xs ys]
|
|
||||||
(if (= ::data/list (first xs))
|
|
||||||
(into [::data/list] (concat (rest xs) (rest ys)))
|
|
||||||
(into #{} (concat xs ys))))})
|
|
||||||
|
|
||||||
(def str- {:name "str"
|
|
||||||
::data/type ::data/clj
|
|
||||||
:body str})
|
|
||||||
|
|
||||||
(def doc- {:name "doc"
|
|
||||||
::data/type ::data/clj
|
|
||||||
:body (fn [f]
|
|
||||||
(let [name (:name f)
|
|
||||||
docstring (:doc f)
|
|
||||||
clauses (:clauses f)
|
|
||||||
patterns (map first clauses)
|
|
||||||
pretty-patterns (map show/show-pattern patterns)
|
|
||||||
doc (into [name docstring] pretty-patterns)]
|
|
||||||
(apply str (interpose "\n" doc)))
|
|
||||||
)})
|
|
||||||
|
|
||||||
(def sin {:name "sin"
|
|
||||||
::data/type ::data/clj
|
|
||||||
:body math/sin})
|
|
||||||
|
|
||||||
(def cos {:name "cos"
|
|
||||||
::data/type ::data/clj
|
|
||||||
:body math/cos})
|
|
||||||
|
|
||||||
(def tan {:name "tan"
|
|
||||||
::data/type ::data/clj
|
|
||||||
:body math/tan})
|
|
||||||
|
|
||||||
(def atan_2 {:name "atan_2"
|
|
||||||
::data/type ::data/clj
|
|
||||||
:body math/atan2})
|
|
||||||
|
|
||||||
(def sqrt {:name "sqrt"
|
|
||||||
::data/type ::data/clj
|
|
||||||
:body math/sqrt})
|
|
||||||
|
|
||||||
(def random {:name "random"
|
|
||||||
::data/type ::data/clj
|
|
||||||
:body rand})
|
|
||||||
|
|
||||||
(def floor {:name "floor"
|
|
||||||
::data/type ::data/clj
|
|
||||||
:body math/floor})
|
|
||||||
|
|
||||||
(def ceil {:name "ceil"
|
|
||||||
::data/type ::data/clj
|
|
||||||
:body math/ceil})
|
|
||||||
|
|
||||||
(def round {:name "round"
|
|
||||||
::data/type ::data/clj
|
|
||||||
:body math/round})
|
|
||||||
|
|
||||||
(def range- {:name "range"
|
|
||||||
::data/type ::data/clj
|
|
||||||
:body (fn [start end] (into [::data/list] (range (-> start math/ceil int) end)))})
|
|
||||||
|
|
||||||
(def base {
|
|
||||||
:id id
|
|
||||||
:eq eq
|
|
||||||
:add add
|
|
||||||
:print print-
|
|
||||||
:sub sub
|
|
||||||
:mult mult
|
|
||||||
:div div
|
|
||||||
:gt gt
|
|
||||||
:gte gte
|
|
||||||
:lt lt
|
|
||||||
:lte lte
|
|
||||||
:inc inc-
|
|
||||||
:dec dec-
|
|
||||||
:not not-
|
|
||||||
:show show
|
|
||||||
:deref deref-
|
|
||||||
:set! set!-
|
|
||||||
:and and-
|
|
||||||
:or or-
|
|
||||||
:assoc assoc-
|
|
||||||
:dissoc dissoc-
|
|
||||||
:conj conj-
|
|
||||||
:get get-
|
|
||||||
:type type-
|
|
||||||
:extern extern
|
|
||||||
:rest rest-
|
|
||||||
:nth nth-
|
|
||||||
:slice slice
|
|
||||||
:count count-
|
|
||||||
:into into-
|
|
||||||
:to_vec to_vec
|
|
||||||
:fold fold
|
|
||||||
:map map
|
|
||||||
; :panic! panic!
|
|
||||||
:prn prn-
|
|
||||||
:concat concat-
|
|
||||||
:str str-
|
|
||||||
:to_list to_list
|
|
||||||
:doc doc-
|
|
||||||
:pi math/PI
|
|
||||||
:sin sin
|
|
||||||
:cos cos
|
|
||||||
:tan tan
|
|
||||||
:atan_2 atan_2
|
|
||||||
:sqrt sqrt
|
|
||||||
:random random
|
|
||||||
:ceil ceil
|
|
||||||
:floor floor
|
|
||||||
:round round
|
|
||||||
:range range-
|
|
||||||
})
|
|
||||||
|
|
@ -1 +0,0 @@
|
||||||
(ns ludus.collections)
|
|
||||||
|
|
@ -1,38 +0,0 @@
|
||||||
(ns ludus.core
|
|
||||||
"A tree-walk interpreter for the Ludus language."
|
|
||||||
(:require
|
|
||||||
[ludus.scanner :as scanner]
|
|
||||||
[ludus.parser :as p]
|
|
||||||
[ludus.grammar :as g]
|
|
||||||
[ludus.interpreter :as interpreter]
|
|
||||||
[ludus.show :as show]
|
|
||||||
[clojure.pprint :as pp]
|
|
||||||
[ludus.loader :as loader]
|
|
||||||
[ludus.repl :as repl])
|
|
||||||
(:gen-class))
|
|
||||||
|
|
||||||
(defn- run [file source]
|
|
||||||
(let [scanned (scanner/scan source)]
|
|
||||||
(if (not-empty (:errors scanned))
|
|
||||||
(do
|
|
||||||
(println "I found some scanning errors!")
|
|
||||||
(pp/pprint (:errors scanned))
|
|
||||||
(System/exit 65))
|
|
||||||
(let [parsed (p/apply-parser g/script (:tokens scanned))]
|
|
||||||
(if (p/fail? parsed)
|
|
||||||
(do
|
|
||||||
(println "I found some parsing errors!")
|
|
||||||
(println (p/err-msg parsed))
|
|
||||||
(System/exit 66))
|
|
||||||
(let [interpreted (interpreter/interpret source file parsed)]
|
|
||||||
(println (show/show interpreted))
|
|
||||||
(System/exit 0)))))))
|
|
||||||
|
|
||||||
(defn -main [& args]
|
|
||||||
(cond
|
|
||||||
(= (count args) 1)
|
|
||||||
(let [file (first args)
|
|
||||||
source (loader/load-import file)]
|
|
||||||
(run file source))
|
|
||||||
|
|
||||||
:else (repl/launch)))
|
|
||||||
|
|
@ -1,2 +0,0 @@
|
||||||
(ns ludus.data)
|
|
||||||
|
|
||||||
|
|
@ -1,126 +0,0 @@
|
||||||
(ns ludus.doc
|
|
||||||
(:require [ludus.interpreter :as interpreter]
|
|
||||||
[ludus.base :as base]
|
|
||||||
[ludus.data :as data]
|
|
||||||
[clojure.string :as string]))
|
|
||||||
|
|
||||||
(def prelude interpreter/ludus-prelude)
|
|
||||||
|
|
||||||
(def exports-only (dissoc prelude ::data/type ::data/struct))
|
|
||||||
|
|
||||||
(defn map-values [f] (fn [[k v]] [k (f v)]))
|
|
||||||
|
|
||||||
(def ludus-doc (base/doc- :body))
|
|
||||||
|
|
||||||
(def with-docs (into {} (map (map-values ludus-doc)) exports-only))
|
|
||||||
|
|
||||||
(def sorted-names (-> with-docs keys sort))
|
|
||||||
|
|
||||||
(defn escape-underscores [the-str] (string/replace the-str #"_" "\\_"))
|
|
||||||
|
|
||||||
(defn escape-punctuation [the-str] (string/replace the-str #"[\!\?]" ""))
|
|
||||||
|
|
||||||
(defn toc-entry [name] (let [escaped (escape-underscores name)] (str "[" escaped "](#" (escape-punctuation escaped) ")")))
|
|
||||||
|
|
||||||
(def alphabetical-list (string/join " " (map toc-entry sorted-names)))
|
|
||||||
|
|
||||||
(def topics {
|
|
||||||
"math" ["abs" "add" "angle" "atan/2" "ceil" "cos" "dec" "deg/rad" "deg/turn" "dist" "div"
|
|
||||||
"div/0" "div/safe" "even?" "floor" "gt?" "gte?" "heading/vector" "inc" "lt?" "lte?" "mod"
|
|
||||||
"mult" "neg" "neg?" "odd?" "pi" "pos?" "rad/deg" "rad/turn" "random" "range" "round"
|
|
||||||
"sin" "square" "sub" "sum_of_squares" "tan" "tau" "turn/deg" "turn/rad" "zero?"]
|
|
||||||
"boolean" ["and" "bool" "bool?" "false?" "or" "not"]
|
|
||||||
"dicts" ["assoc" "assoc?" "dict" "diff" "dissoc" "get" "keys" "update" "values"]
|
|
||||||
"lists" ["append" "at" "butlast" "concat" "count" "each!" "first" "fold" "last" "list" "list?" "map" "ordered?" "range"
|
|
||||||
"rest" "second" "slice"]
|
|
||||||
"sets" ["set" "set?"]
|
|
||||||
"strings" ["count" "join" "show" "string" "string?"]
|
|
||||||
"types and values" ["bool?" "coll?" "dict?" "eq?" "fn?" "keyword?" "list?" "neq?" "nil?" "number?" "ordered?" "show" "some" "some?" "type"]
|
|
||||||
"references and state" ["deref" "make!" "update!"]
|
|
||||||
"results" ["err" "err?" "ok" "ok?" "unwrap!" "unwrap_or"]
|
|
||||||
"errors" ["assert!" "panic!"]
|
|
||||||
"turtle graphics" ["back!" "background!" "bk!" "clear!" "fd!" "forward!" "goto!" "heading" "heading/vector" "home!" "left!" "lt!" "pc!" "pd!" "pencolor"
|
|
||||||
"pencolor!" "pendown!" "pendown?" "penup!" "penwidth" "penwidth!" "position" "pu!" "pw!" "render_turtle!" "reset_turtle!"
|
|
||||||
"right!" "rt!" "turtle_state"]
|
|
||||||
"environment and i/o" ["doc!" "flush!" "print!" "prn!" "report!"]
|
|
||||||
})
|
|
||||||
|
|
||||||
(defn topic-entry [topic] (str "### " (string/capitalize topic) "\n"
|
|
||||||
(->> topic (get topics) sort (map toc-entry) (string/join " "))
|
|
||||||
"\n"))
|
|
||||||
|
|
||||||
(def by-topic (let [the-topics (-> topics keys sort)
|
|
||||||
topics-entries (map topic-entry the-topics)]
|
|
||||||
(string/join "\n" topics-entries)))
|
|
||||||
|
|
||||||
(defn compose-entry [name]
|
|
||||||
(let [the-doc (get with-docs name)
|
|
||||||
header (str "### " name "\n")
|
|
||||||
lines (string/split-lines the-doc)]
|
|
||||||
(if (empty? lines) (str header "No documentation available.\n")
|
|
||||||
(let [
|
|
||||||
description (second lines)
|
|
||||||
pattern-lines (subvec lines 2)
|
|
||||||
patterns (string/join "\n" pattern-lines)
|
|
||||||
]
|
|
||||||
(str header description "\n```\n" patterns "\n```")
|
|
||||||
))))
|
|
||||||
|
|
||||||
(def entries (string/join "\n\n" (map compose-entry sorted-names)))
|
|
||||||
|
|
||||||
(def doc-file
|
|
||||||
(str
|
|
||||||
"# Ludus prelude documentation
|
|
||||||
These functions are available in every Ludus script.
|
|
||||||
The documentation for any function can be found within Ludus by passing the function to `doc!`,
|
|
||||||
e.g., running `doc! (add)` will send the documentation for `add` to the console.
|
|
||||||
|
|
||||||
For more information on the syntax & semantics of the Ludus language, see [language.md](./language.md).
|
|
||||||
|
|
||||||
## A few notes
|
|
||||||
**Naming conventions.** Functions whose name ends with a question mark, e.g., `eq?`, return booleans.
|
|
||||||
Functions whose name ends with an exclamation point, e.g., `make!`, change state in some way.
|
|
||||||
In other words, they _do things_ rather than _calculating values_.
|
|
||||||
Functions whose name includes a slash either convert from one value to another, e.g. `deg/rad`,
|
|
||||||
or they are variations on a function, e.g. `div/0` as a variation on `div`.
|
|
||||||
|
|
||||||
**How entries are formatted.** Each entry has a brief (sometimes too brief!) description of what it does.
|
|
||||||
It is followed by the patterns for each of its function clauses.
|
|
||||||
This should be enough to indicate order of arguments, types, and so on.
|
|
||||||
|
|
||||||
**Patterns often, but do not always, indicate types.** Typed patterns are written as `foo as :bar`,
|
|
||||||
where the type is indicated by the keyword.
|
|
||||||
Possible ludus types are: `:nil`, `:boolean`, `:number`, `:keyword` (atomic values);
|
|
||||||
`:string` (strings are their own beast); `:tuple` and `:list` (indexed collections); `:set` (sets are specific),
|
|
||||||
`:dict` and `:ns` (associative collections); and `:ref` (references).
|
|
||||||
|
|
||||||
**Conventional types.** Ludus has two types based on conventions.
|
|
||||||
* _Result tuples._ Results are a way of modeling the result of a calculation that might fail.
|
|
||||||
The two possible values are `(:ok, value)` and `(:err, msg)`.
|
|
||||||
`msg` is usually a string describing what went wrong.
|
|
||||||
To work with result tuples, see [`unwrap!`](#unwrap) and [`unwrap_or`](#unwrap_or).
|
|
||||||
That said, usually you work with these using pattern matching.
|
|
||||||
|
|
||||||
* _Vectors._ Vectors are 2-element tuples of x and y coordinates.
|
|
||||||
The origin is `(0, 0)`.
|
|
||||||
Many math functions take vectors as well as numbers, e.g., `add` and `mult`.
|
|
||||||
You will see vectors indicated in patterns by an `(x, y)` tuple.
|
|
||||||
You can see what this looks like in the last clause of `add`: `((x1, y1), (x2, y2))`.
|
|
||||||
|
|
||||||
## Functions by topic
|
|
||||||
|
|
||||||
"
|
|
||||||
by-topic
|
|
||||||
|
|
||||||
"
|
|
||||||
|
|
||||||
## All functions, alphabetically
|
|
||||||
"
|
|
||||||
alphabetical-list
|
|
||||||
"
|
|
||||||
## Function documentation
|
|
||||||
"
|
|
||||||
entries
|
|
||||||
))
|
|
||||||
|
|
||||||
(spit "prelude.md" doc-file)
|
|
||||||
|
|
@ -1,15 +0,0 @@
|
||||||
(ns ludus.draw)
|
|
||||||
|
|
||||||
(defn background
|
|
||||||
([x] (js/background x))
|
|
||||||
([r g b] (js/background r g b))
|
|
||||||
([r g b a] (js/background r g b a)))
|
|
||||||
|
|
||||||
(defn rect [[x y] [w h]]
|
|
||||||
(js/rect x y w h))
|
|
||||||
|
|
||||||
(defn ellipse [[x y] [w h]])
|
|
||||||
|
|
||||||
(def draw {
|
|
||||||
|
|
||||||
})
|
|
||||||
|
|
@ -1,46 +0,0 @@
|
||||||
(ns ludus.error
|
|
||||||
(:require [clojure.string :as string]))
|
|
||||||
|
|
||||||
(defn get-line [source line]
|
|
||||||
(let [lines (string/split-lines source)
|
|
||||||
the_line (nth lines (dec line))]
|
|
||||||
the_line))
|
|
||||||
|
|
||||||
(string/split-lines "abcd")
|
|
||||||
|
|
||||||
(defn get-underline [source {:keys [line start lexeme]} prefix]
|
|
||||||
(let [lines (string/split-lines source)
|
|
||||||
lines-before (subvec lines 0 (dec line))
|
|
||||||
line-start (reduce (fn [len line] (+ len (count line))) (count lines-before) lines-before)
|
|
||||||
from-start (- start line-start)
|
|
||||||
underline-length (count lexeme)
|
|
||||||
padding (string/join (take (+ prefix from-start) (repeat "-")))
|
|
||||||
underline (string/join (take underline-length (repeat "^")))]
|
|
||||||
(apply str padding underline)
|
|
||||||
))
|
|
||||||
|
|
||||||
(defn scan-error [] :TODO)
|
|
||||||
|
|
||||||
(defn parse-error [{:keys [trace token]}]
|
|
||||||
(let [source (:source token)
|
|
||||||
input (:input token)
|
|
||||||
line-num (:line token)
|
|
||||||
line (get-line source line-num)
|
|
||||||
line-num (:line token)
|
|
||||||
prefix (str line-num ": ")
|
|
||||||
underline (get-underline source token (count prefix))
|
|
||||||
expected (first trace)
|
|
||||||
got (:type token)
|
|
||||||
message (str "Ludus found a parsing error on line " line-num " in " input ".\nExpected: " expected "\nGot: " got "\n")
|
|
||||||
]
|
|
||||||
(str message "\n" prefix line "\n" underline)
|
|
||||||
)
|
|
||||||
)
|
|
||||||
|
|
||||||
(defn run-error [{:keys [message token line]}]
|
|
||||||
(let [source (:source token) input (:input token)]
|
|
||||||
(if line
|
|
||||||
(str "Ludus panicked!: " message "\nOn line " line " in " input "\n" (get-line source line))
|
|
||||||
(str "Ludus panicked!\n" message)
|
|
||||||
)))
|
|
||||||
|
|
||||||
|
|
@ -1,273 +0,0 @@
|
||||||
(ns ludus.grammar
|
|
||||||
(:require
|
|
||||||
#?(
|
|
||||||
:clj [ludus.parser :refer :all]
|
|
||||||
:cljs [ludus.parser
|
|
||||||
:refer [choice quiet one+ zero+ group order-0 order-1 flat maybe weak-order]
|
|
||||||
:refer-macros [defp]
|
|
||||||
]
|
|
||||||
)
|
|
||||||
[ludus.scanner :as s]
|
|
||||||
))
|
|
||||||
|
|
||||||
(declare expression pattern binding-expr non-binding simple)
|
|
||||||
|
|
||||||
(defp separator choice [:comma :newline :break])
|
|
||||||
|
|
||||||
(defp separators quiet one+ separator)
|
|
||||||
|
|
||||||
(defp terminator choice [:newline :semicolon :break])
|
|
||||||
|
|
||||||
(defp terminators quiet one+ terminator)
|
|
||||||
|
|
||||||
(defp nls? quiet zero+ :newline)
|
|
||||||
|
|
||||||
(defp splat group order-1 [(quiet :splat) :word])
|
|
||||||
|
|
||||||
(defp patt-splat-able flat choice [:word :ignored :placeholder])
|
|
||||||
|
|
||||||
(defp splattern group order-1 [(quiet :splat) (maybe patt-splat-able)])
|
|
||||||
|
|
||||||
(defp literal flat choice [:nil :true :false :number :string])
|
|
||||||
|
|
||||||
(defp tuple-pattern-term flat choice [pattern splattern])
|
|
||||||
|
|
||||||
(defp tuple-pattern-entry weak-order [tuple-pattern-term separators])
|
|
||||||
|
|
||||||
(defp tuple-pattern group order-1 [(quiet :lparen)
|
|
||||||
(quiet (zero+ separator))
|
|
||||||
(zero+ tuple-pattern-entry)
|
|
||||||
(quiet :rparen)])
|
|
||||||
|
|
||||||
(defp list-pattern group order-1 [(quiet :lbracket)
|
|
||||||
(quiet (zero+ separator))
|
|
||||||
(zero+ tuple-pattern-entry)
|
|
||||||
(quiet :rbracket)])
|
|
||||||
|
|
||||||
(defp pair-pattern group weak-order [:keyword pattern])
|
|
||||||
|
|
||||||
(defp typed group weak-order [:word (quiet :as) :keyword])
|
|
||||||
|
|
||||||
(defp dict-pattern-term flat choice [pair-pattern typed :word splattern])
|
|
||||||
|
|
||||||
(defp dict-pattern-entry weak-order [dict-pattern-term separators])
|
|
||||||
|
|
||||||
(defp dict-pattern group order-1 [(quiet :startdict)
|
|
||||||
(quiet (zero+ separator))
|
|
||||||
(zero+ dict-pattern-entry)
|
|
||||||
(quiet :rbrace)
|
|
||||||
])
|
|
||||||
|
|
||||||
; (defp struct-pattern group order-1 [(quiet :startstruct)
|
|
||||||
; (quiet (zero+ separator))
|
|
||||||
; (zero+ dict-pattern-entry)
|
|
||||||
; (quiet :rbrace)
|
|
||||||
; ])
|
|
||||||
|
|
||||||
(defp guard order-0 [(quiet :if) simple])
|
|
||||||
|
|
||||||
(defp pattern flat choice [literal
|
|
||||||
:ignored
|
|
||||||
:placeholder
|
|
||||||
typed
|
|
||||||
:word
|
|
||||||
:keyword
|
|
||||||
:else
|
|
||||||
tuple-pattern
|
|
||||||
dict-pattern
|
|
||||||
;struct-pattern
|
|
||||||
list-pattern])
|
|
||||||
|
|
||||||
(defp match-clause group weak-order [pattern (maybe guard) (quiet :rarrow) expression])
|
|
||||||
|
|
||||||
(defp match-entry weak-order [match-clause terminators])
|
|
||||||
|
|
||||||
(defp match group order-1 [(quiet :match) simple nls?
|
|
||||||
(quiet :with) (quiet :lbrace)
|
|
||||||
(quiet (zero+ terminator))
|
|
||||||
(one+ match-entry)
|
|
||||||
(quiet :rbrace)
|
|
||||||
])
|
|
||||||
|
|
||||||
(defp when-lhs flat choice [simple :placeholder :else])
|
|
||||||
|
|
||||||
(defp when-clause group weak-order [when-lhs (quiet :rarrow) expression])
|
|
||||||
|
|
||||||
(defp when-entry weak-order [when-clause terminators])
|
|
||||||
|
|
||||||
(defp when-expr group order-1 [(quiet :when) (quiet :lbrace)
|
|
||||||
(quiet (zero+ terminator))
|
|
||||||
(one+ when-entry)
|
|
||||||
(quiet :rbrace)])
|
|
||||||
|
|
||||||
(defp let-expr group order-1 [(quiet :let)
|
|
||||||
pattern
|
|
||||||
(quiet :equals)
|
|
||||||
nls?
|
|
||||||
non-binding])
|
|
||||||
|
|
||||||
(defp condition flat choice [simple let-expr])
|
|
||||||
|
|
||||||
(defp if-expr group order-1 [(quiet :if)
|
|
||||||
nls?
|
|
||||||
condition
|
|
||||||
nls?
|
|
||||||
(quiet :then)
|
|
||||||
expression
|
|
||||||
nls?
|
|
||||||
(quiet :else)
|
|
||||||
expression])
|
|
||||||
|
|
||||||
(defp tuple-entry weak-order [non-binding separators])
|
|
||||||
|
|
||||||
(defp tuple group order-1 [(quiet :lparen)
|
|
||||||
(quiet (zero+ separator))
|
|
||||||
(zero+ tuple-entry)
|
|
||||||
(quiet :rparen)])
|
|
||||||
|
|
||||||
(defp list-term flat choice [splat non-binding])
|
|
||||||
|
|
||||||
(defp list-entry order-1 [list-term separators])
|
|
||||||
|
|
||||||
(defp list-literal group order-1 [(quiet :lbracket)
|
|
||||||
(quiet (zero+ separator))
|
|
||||||
(zero+ list-entry)
|
|
||||||
(quiet :rbracket)])
|
|
||||||
|
|
||||||
(defp set-literal group order-1 [(quiet :startset)
|
|
||||||
(quiet (zero+ separator))
|
|
||||||
(zero+ list-entry)
|
|
||||||
(quiet :rbrace)])
|
|
||||||
|
|
||||||
(defp pair group order-0 [:keyword non-binding])
|
|
||||||
|
|
||||||
;; "struct-term" and "struct-entry" are necessary for nses
|
|
||||||
(defp struct-term flat choice [:word pair])
|
|
||||||
|
|
||||||
(defp struct-entry order-1 [struct-term separators])
|
|
||||||
|
|
||||||
; (defp struct-literal group order-1 [(quiet :startstruct)
|
|
||||||
; (quiet (zero+ separator))
|
|
||||||
; (zero+ struct-entry)
|
|
||||||
; (quiet :rbrace)])
|
|
||||||
|
|
||||||
(defp dict-term flat choice [splat :word pair])
|
|
||||||
|
|
||||||
(defp dict-entry order-1 [dict-term separators])
|
|
||||||
|
|
||||||
(defp dict group order-1 [(quiet :startdict)
|
|
||||||
(quiet (zero+ separator))
|
|
||||||
(zero+ dict-entry)
|
|
||||||
(quiet :rbrace)])
|
|
||||||
|
|
||||||
(defp arg-expr flat choice [:placeholder non-binding])
|
|
||||||
|
|
||||||
(defp arg-entry weak-order [arg-expr separators])
|
|
||||||
|
|
||||||
(defp args group order-1 [(quiet :lparen)
|
|
||||||
(quiet (zero+ separator))
|
|
||||||
(zero+ arg-entry)
|
|
||||||
(quiet :rparen)])
|
|
||||||
|
|
||||||
(defp recur-call group order-1 [(quiet :recur) tuple])
|
|
||||||
|
|
||||||
(defp synth-root flat choice [:keyword :word])
|
|
||||||
|
|
||||||
(defp synth-term flat choice [args :keyword])
|
|
||||||
|
|
||||||
(defp synthetic group order-1 [synth-root (zero+ synth-term)])
|
|
||||||
|
|
||||||
(defp fn-clause group order-1 [tuple-pattern (maybe guard) (quiet :rarrow) expression])
|
|
||||||
|
|
||||||
(defp fn-entry order-1 [fn-clause terminators])
|
|
||||||
|
|
||||||
(defp fn-compound group order-1 [(quiet :lbrace)
|
|
||||||
nls?
|
|
||||||
(maybe :string)
|
|
||||||
(quiet (zero+ terminator))
|
|
||||||
(one+ fn-entry)
|
|
||||||
(quiet :rbrace)
|
|
||||||
])
|
|
||||||
|
|
||||||
(defp clauses flat choice [fn-clause fn-compound])
|
|
||||||
|
|
||||||
(defp fn-named group order-1 [(quiet :fn) :word clauses])
|
|
||||||
|
|
||||||
(defp lambda group order-1 [(quiet :fn) fn-clause])
|
|
||||||
|
|
||||||
(defp block-line weak-order [expression terminators])
|
|
||||||
|
|
||||||
(defp block group order-1 [(quiet :lbrace)
|
|
||||||
(quiet (zero+ terminator))
|
|
||||||
(one+ block-line)
|
|
||||||
(quiet :rbrace)])
|
|
||||||
|
|
||||||
(defp pipeline quiet order-0 [nls? :pipeline])
|
|
||||||
|
|
||||||
(defp do-entry order-1 [pipeline expression])
|
|
||||||
|
|
||||||
(defp do-expr group order-1 [(quiet :do)
|
|
||||||
expression
|
|
||||||
(one+ do-entry)
|
|
||||||
])
|
|
||||||
|
|
||||||
(defp ref-expr group order-1 [(quiet :ref) :word (quiet :equals) expression])
|
|
||||||
|
|
||||||
; (defp spawn group order-1 [(quiet :spawn) expression])
|
|
||||||
|
|
||||||
; (defp receive group order-1 [(quiet :receive) (quiet :lbrace)
|
|
||||||
; (quiet (zero+ terminator))
|
|
||||||
; (one+ match-entry)
|
|
||||||
; (quiet :rbrace)
|
|
||||||
; ])
|
|
||||||
|
|
||||||
(defp compound-loop group order-0 [(quiet :lbrace)
|
|
||||||
(quiet (zero+ terminator))
|
|
||||||
(one+ fn-entry)
|
|
||||||
(quiet :rbrace)])
|
|
||||||
|
|
||||||
(defp loop-expr group order-1 [(quiet :loop) tuple (quiet :with)
|
|
||||||
(flat (choice :loop-body [fn-clause compound-loop]))])
|
|
||||||
|
|
||||||
(defp repeat-expr group order-1 [(quiet :repeat) (choice :times [:word :number]) non-binding])
|
|
||||||
|
|
||||||
(defp collection flat choice [;struct-literal
|
|
||||||
dict list-literal set-literal tuple])
|
|
||||||
|
|
||||||
(defp panic group order-1 [(quiet :panic) expression])
|
|
||||||
|
|
||||||
(defp simple flat choice [literal collection synthetic recur-call lambda panic])
|
|
||||||
|
|
||||||
(defp compound flat choice [match loop-expr if-expr when-expr do-expr block repeat-expr])
|
|
||||||
|
|
||||||
(defp binding-expr flat choice [fn-named let-expr ref-expr])
|
|
||||||
|
|
||||||
(defp non-binding flat choice [simple compound])
|
|
||||||
|
|
||||||
(defp expression flat choice [binding-expr non-binding])
|
|
||||||
|
|
||||||
(defp test-expr group order-1 [(quiet :test) :string non-binding])
|
|
||||||
|
|
||||||
(defp import-expr group order-1 [(quiet :import) :string (quiet :as) :word])
|
|
||||||
|
|
||||||
(defp ns-expr group order-1 [(quiet :ns)
|
|
||||||
:word
|
|
||||||
(quiet :lbrace)
|
|
||||||
(quiet (zero+ separator))
|
|
||||||
(zero+ struct-entry)
|
|
||||||
(quiet :rbrace)])
|
|
||||||
|
|
||||||
(defp use-expr group order-1 [(quiet :use) :word])
|
|
||||||
|
|
||||||
(defp toplevel flat choice [import-expr
|
|
||||||
ns-expr
|
|
||||||
expression
|
|
||||||
test-expr
|
|
||||||
use-expr])
|
|
||||||
|
|
||||||
(defp script-line weak-order [toplevel terminators])
|
|
||||||
|
|
||||||
(defp script order-0 [nls?
|
|
||||||
(one+ script-line)
|
|
||||||
(quiet :eof)])
|
|
||||||
|
|
||||||
File diff suppressed because it is too large
Load Diff
|
|
@ -1,16 +0,0 @@
|
||||||
(ns ludus.loader
|
|
||||||
(:require [babashka.fs :as fs]))
|
|
||||||
|
|
||||||
(defn cwd [] (fs/cwd))
|
|
||||||
|
|
||||||
(defn load-import
|
|
||||||
([file]
|
|
||||||
(let [path (-> file (fs/canonicalize) (fs/file))]
|
|
||||||
(try (slurp path)
|
|
||||||
(catch java.io.FileNotFoundException _
|
|
||||||
(throw (ex-info (str "File " path " not found") {:path path ::error true}))))))
|
|
||||||
([file from]
|
|
||||||
(load-import
|
|
||||||
(fs/path
|
|
||||||
(if (= from :cwd) (fs/cwd) (fs/parent (fs/canonicalize from)))
|
|
||||||
(fs/path file)))))
|
|
||||||
|
|
@ -1,77 +0,0 @@
|
||||||
(ns ludus.node
|
|
||||||
(:require [ludus.interpreter :as i]
|
|
||||||
[ludus.grammar :as g]
|
|
||||||
[ludus.parser :as p]
|
|
||||||
[ludus.scanner :as s]
|
|
||||||
[ludus.prelude :as pre]
|
|
||||||
[ludus.show :as show]
|
|
||||||
[ludus.base :as base]
|
|
||||||
[ludus.data :as data]
|
|
||||||
[ludus.error :as error]
|
|
||||||
)
|
|
||||||
)
|
|
||||||
|
|
||||||
(declare ld->clj)
|
|
||||||
|
|
||||||
(defn cljify [[k v]] [k (ld->clj v)])
|
|
||||||
|
|
||||||
(defn ld->clj [value]
|
|
||||||
(case (base/get-type value)
|
|
||||||
(:nil :number :string :boolean :keyword :set) value
|
|
||||||
|
|
||||||
(:list :tuple) (into [] (map ld->clj) (rest value))
|
|
||||||
|
|
||||||
(:dict :struct :ns) (into {} (map cljify) (dissoc value ::data/dict ::data/struct ::data/type ::data/name))
|
|
||||||
|
|
||||||
:ref (ld->clj @(::value value))
|
|
||||||
|
|
||||||
:fn (throw (ex-info (str "Cannot export functions from Ludus to Clojure. You tried exporting " (show/show value)) {}))))
|
|
||||||
|
|
||||||
(defn clean-out [value]
|
|
||||||
#?(:clj value :cljs (clj->js value)))
|
|
||||||
|
|
||||||
(defn run
|
|
||||||
([source] (run source false))
|
|
||||||
([source testing?]
|
|
||||||
(let [user_scanned (s/scan source "user input")
|
|
||||||
user_tokens (:tokens user_scanned)
|
|
||||||
user_parsed (p/apply-parser g/script user_tokens)
|
|
||||||
user_result (i/interpret-safe source user_parsed {} testing?)
|
|
||||||
result_str (show/show user_result)
|
|
||||||
test_results @i/test-results
|
|
||||||
post_scanned (s/scan pre/postlude "postlude")
|
|
||||||
post_tokens (:tokens post_scanned)
|
|
||||||
post_parsed (p/apply-parser g/script post_tokens)
|
|
||||||
post_result (i/interpret-safe source post_parsed {} false)
|
|
||||||
ludus_result (assoc post_result :result result_str :test test_results)
|
|
||||||
clj_result (ld->clj ludus_result)
|
|
||||||
]
|
|
||||||
(cond
|
|
||||||
(not-empty (:errors user_tokens))
|
|
||||||
(clean-out {:errors (:errors user_tokens)})
|
|
||||||
|
|
||||||
(= :err (:status user_parsed))
|
|
||||||
(clean-out {:errors [(error/parse-error user_parsed)]})
|
|
||||||
|
|
||||||
(::data/error user_result)
|
|
||||||
(clean-out (assoc (ld->clj post_result) :errors [(error/run-error user_result)]))
|
|
||||||
|
|
||||||
:else
|
|
||||||
(clean-out clj_result)
|
|
||||||
)
|
|
||||||
))
|
|
||||||
)
|
|
||||||
|
|
||||||
(defn doug [source] (run source true))
|
|
||||||
|
|
||||||
(comment
|
|
||||||
|
|
||||||
(def source "
|
|
||||||
|
|
||||||
")
|
|
||||||
|
|
||||||
(-> source run :test println)
|
|
||||||
|
|
||||||
)
|
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -1,316 +0,0 @@
|
||||||
(ns ludus.parser)
|
|
||||||
|
|
||||||
(defn ? [val default] (if (nil? val) default val))
|
|
||||||
|
|
||||||
(defn ok? [{status :status}]
|
|
||||||
(= status :ok))
|
|
||||||
|
|
||||||
(def failing #{:err :none})
|
|
||||||
|
|
||||||
(def passing #{:ok :group :quiet})
|
|
||||||
|
|
||||||
(defn pass? [{status :status}] (contains? passing status))
|
|
||||||
|
|
||||||
(defn fail? [{status :status}] (contains? failing status))
|
|
||||||
|
|
||||||
(defn data [{d :data}] d)
|
|
||||||
|
|
||||||
(defn remaining [{r :remaining}] r)
|
|
||||||
|
|
||||||
(defn pname [parser] (? (:name parser) parser))
|
|
||||||
|
|
||||||
(defn str-part [kw] (apply str (next (str kw))))
|
|
||||||
|
|
||||||
(defn kw+str [kw mystr] (keyword (str (str-part kw) mystr)))
|
|
||||||
|
|
||||||
(defn value [token]
|
|
||||||
(if (= :none (:literal token)) (:lexeme token) (:literal token)))
|
|
||||||
|
|
||||||
(defn apply-kw-parser [kw tokens]
|
|
||||||
(let [token (first tokens)]
|
|
||||||
;(if (= kw (:type token)) (println "Matched " kw))
|
|
||||||
(if (= kw (:type token))
|
|
||||||
{:status :ok
|
|
||||||
:type kw
|
|
||||||
:data (if (some? (value token)) [(value token)] [])
|
|
||||||
:token token
|
|
||||||
:remaining (rest tokens)}
|
|
||||||
{:status :none :token token :trace [kw] :remaining (rest tokens)})))
|
|
||||||
|
|
||||||
(defn apply-fn-parser [parser tokens]
|
|
||||||
(let [rule (:rule parser) name (:name parser) result (rule tokens)]
|
|
||||||
;(if (pass? result) (println "Matched " (:name parser)))
|
|
||||||
result))
|
|
||||||
|
|
||||||
(defn apply-parser [parser tokens]
|
|
||||||
;(println "Applying parser " (? (:name parser) parser))
|
|
||||||
(let [result (cond
|
|
||||||
(keyword? parser) (apply-kw-parser parser tokens)
|
|
||||||
(:rule parser) (apply-fn-parser parser tokens)
|
|
||||||
(fn? parser) (apply-fn-parser (parser) tokens)
|
|
||||||
:else (throw (ex-info "`apply-parser` requires a parser" {})))]
|
|
||||||
;(println "Parser result " (? (:name parser) parser) (:status result))
|
|
||||||
result
|
|
||||||
))
|
|
||||||
|
|
||||||
(defn choice [name parsers]
|
|
||||||
{:name name
|
|
||||||
:rule (fn choice-fn [tokens]
|
|
||||||
(loop [ps parsers]
|
|
||||||
(let [result (apply-parser (first ps) tokens)
|
|
||||||
rem-ts (remaining result)
|
|
||||||
rem-ps (rest ps)]
|
|
||||||
(cond
|
|
||||||
(pass? result)
|
|
||||||
{:status :ok :type name :data [result] :token (first tokens) :remaining rem-ts}
|
|
||||||
|
|
||||||
(= :err (:status result))
|
|
||||||
(update result :trace #(conj % name))
|
|
||||||
|
|
||||||
(empty? rem-ps)
|
|
||||||
{:status :none :token (first tokens) :trace [name] :remaining rem-ts}
|
|
||||||
|
|
||||||
:else (recur rem-ps)))))})
|
|
||||||
|
|
||||||
(defn order-1 [name parsers]
|
|
||||||
{:name name
|
|
||||||
:rule (fn order-fn [tokens]
|
|
||||||
(let [origin (first tokens)
|
|
||||||
first-result (apply-parser (first parsers) tokens)]
|
|
||||||
(case (:status first-result)
|
|
||||||
(:err :none)
|
|
||||||
(assoc (update first-result :trace #(conj % name)) :status :none)
|
|
||||||
|
|
||||||
(:ok :quiet :group)
|
|
||||||
(loop [ps (rest parsers)
|
|
||||||
results (case (:status first-result)
|
|
||||||
:ok [first-result]
|
|
||||||
:quiet []
|
|
||||||
:group (:data first-result))
|
|
||||||
ts (remaining first-result)]
|
|
||||||
(let [result (apply-parser (first ps) ts)
|
|
||||||
res-rem (remaining result)]
|
|
||||||
(if (empty? (rest ps))
|
|
||||||
(case (:status result)
|
|
||||||
:ok {:status :group
|
|
||||||
:type name
|
|
||||||
:data (conj results result)
|
|
||||||
:token origin
|
|
||||||
:remaining res-rem}
|
|
||||||
|
|
||||||
:quiet {:status :group
|
|
||||||
:type name
|
|
||||||
:data results
|
|
||||||
:token origin
|
|
||||||
:remaining res-rem}
|
|
||||||
|
|
||||||
:group {:status :group
|
|
||||||
:type name
|
|
||||||
:data (vec (concat results (:data result)))
|
|
||||||
:token origin
|
|
||||||
:remaining res-rem}
|
|
||||||
|
|
||||||
(:err :none)
|
|
||||||
(assoc (update result :trace #(conj % name)) :status :err))
|
|
||||||
|
|
||||||
(case (:status result)
|
|
||||||
:ok (recur (rest ps) (conj results result) res-rem)
|
|
||||||
:group (recur (rest ps)
|
|
||||||
(vec (concat results (:data result)))
|
|
||||||
res-rem)
|
|
||||||
:quiet (recur (rest ps) results res-rem)
|
|
||||||
|
|
||||||
(:err :none)
|
|
||||||
(assoc (update result :trace #(conj % name)) :status :err))))))))})
|
|
||||||
|
|
||||||
(defn order-0 [name parsers]
|
|
||||||
{:name name
|
|
||||||
:rule (fn order-fn [tokens]
|
|
||||||
(let [origin (first tokens)]
|
|
||||||
(loop [ps parsers
|
|
||||||
results []
|
|
||||||
ts tokens]
|
|
||||||
(let [result (apply-parser (first ps) ts)
|
|
||||||
res-rem (remaining result)]
|
|
||||||
(if (empty? (rest ps))
|
|
||||||
;; Nothing more: return
|
|
||||||
(case (:status result)
|
|
||||||
:ok {:status :group
|
|
||||||
:type name
|
|
||||||
:data (conj results result)
|
|
||||||
:token origin
|
|
||||||
:remaining res-rem}
|
|
||||||
|
|
||||||
:quiet {:status :group
|
|
||||||
:type name
|
|
||||||
:data results
|
|
||||||
:token origin
|
|
||||||
:remaining res-rem}
|
|
||||||
|
|
||||||
:group {:status :group
|
|
||||||
:type name
|
|
||||||
:data (vec (concat results (:data result)))
|
|
||||||
:token origin
|
|
||||||
:remaining res-rem}
|
|
||||||
|
|
||||||
(:err :none)
|
|
||||||
(assoc (update result :trace #(conj % name)) :status :err))
|
|
||||||
|
|
||||||
;; Still parsers left in the vector: recur
|
|
||||||
(case (:status result)
|
|
||||||
:ok (recur (rest ps) (conj results result) res-rem)
|
|
||||||
:group (recur (rest ps)
|
|
||||||
(vec (concat results (:data result)))
|
|
||||||
res-rem)
|
|
||||||
:quiet (recur (rest ps) results res-rem)
|
|
||||||
|
|
||||||
(:err :none)
|
|
||||||
(assoc (update result :trace #(conj % name)) :status :err)
|
|
||||||
|
|
||||||
(throw (ex-info (str "Got bad result: " (:status result)) result))))))))})
|
|
||||||
|
|
||||||
(defn weak-order [name parsers]
|
|
||||||
{:name name
|
|
||||||
:rule (fn order-fn [tokens]
|
|
||||||
(let [origin (first tokens)]
|
|
||||||
(loop [ps parsers
|
|
||||||
results []
|
|
||||||
ts tokens]
|
|
||||||
(let [result (apply-parser (first ps) ts)
|
|
||||||
res-rem (remaining result)]
|
|
||||||
(if (empty? (rest ps))
|
|
||||||
;; Nothing more: return
|
|
||||||
(case (:status result)
|
|
||||||
:ok {:status :group
|
|
||||||
:type name
|
|
||||||
:data (conj results result)
|
|
||||||
:token origin
|
|
||||||
:remaining res-rem}
|
|
||||||
|
|
||||||
:quiet {:status :group
|
|
||||||
:type name
|
|
||||||
:data results
|
|
||||||
:token origin
|
|
||||||
:remaining res-rem}
|
|
||||||
|
|
||||||
:group {:status :group
|
|
||||||
:type name
|
|
||||||
:data (vec (concat results (:data result)))
|
|
||||||
:token origin
|
|
||||||
:remaining res-rem}
|
|
||||||
|
|
||||||
(:err :none)
|
|
||||||
(update result :trace #(conj % name)))
|
|
||||||
|
|
||||||
;; Still parsers left in the vector: recur
|
|
||||||
(case (:status result)
|
|
||||||
:ok (recur (rest ps) (conj results result) res-rem)
|
|
||||||
:group (recur (rest ps)
|
|
||||||
(vec (concat results (:data result)))
|
|
||||||
res-rem)
|
|
||||||
:quiet (recur (rest ps) results res-rem)
|
|
||||||
|
|
||||||
(:err :none)
|
|
||||||
(update result :trace #(conj % name))))))))})
|
|
||||||
|
|
||||||
|
|
||||||
(defn quiet [parser]
|
|
||||||
{:name (kw+str (? (:name parser) parser) "-quiet")
|
|
||||||
:rule (fn quiet-fn [tokens]
|
|
||||||
(let [result (apply-parser parser tokens)]
|
|
||||||
(if (pass? result)
|
|
||||||
(assoc result :status :quiet)
|
|
||||||
result)))})
|
|
||||||
|
|
||||||
(defn zero+
|
|
||||||
([parser] (zero+ (pname parser) parser))
|
|
||||||
([name parser]
|
|
||||||
{:name (kw+str name "-zero+")
|
|
||||||
:rule (fn zero+fn [tokens]
|
|
||||||
(loop [results []
|
|
||||||
ts tokens]
|
|
||||||
(let [result (apply-parser parser ts)]
|
|
||||||
(case (:status result)
|
|
||||||
:ok (recur (conj results result) (remaining result))
|
|
||||||
:group (recur (vec (concat results (:data result))) (remaining result))
|
|
||||||
:quiet (recur results (remaining result))
|
|
||||||
:err (update result :trace #(conj % name))
|
|
||||||
:none {:status :group
|
|
||||||
:type name
|
|
||||||
:data results
|
|
||||||
:token (first tokens)
|
|
||||||
:remaining ts}))))}))
|
|
||||||
|
|
||||||
(defn one+
|
|
||||||
([parser] (one+ (pname parser) parser))
|
|
||||||
([name parser]
|
|
||||||
{:name (kw+str name "-one+")
|
|
||||||
:rule (fn one+fn [tokens]
|
|
||||||
(let [first-result (apply-parser parser tokens)
|
|
||||||
rest-parser (zero+ name parser)]
|
|
||||||
(case (:status first-result)
|
|
||||||
(:ok :group)
|
|
||||||
(let [rest-result (apply-parser rest-parser (remaining first-result))]
|
|
||||||
(case (:status rest-result)
|
|
||||||
|
|
||||||
(:ok :group :quiet)
|
|
||||||
{:status :group
|
|
||||||
:type name
|
|
||||||
:data (vec (concat (:data first-result) (data rest-result)))
|
|
||||||
:token (first tokens)
|
|
||||||
:remaining (remaining rest-result)}
|
|
||||||
|
|
||||||
:none {:status :group :type name
|
|
||||||
:data first-result
|
|
||||||
:token (first tokens)
|
|
||||||
:remaining (remaining rest-result)}
|
|
||||||
|
|
||||||
:err (update rest-result :trace #(conj % name))))
|
|
||||||
|
|
||||||
:quiet
|
|
||||||
(let [rest-result (apply-parser rest-parser (remaining first-result))]
|
|
||||||
{:status :quiet
|
|
||||||
:type name
|
|
||||||
:data []
|
|
||||||
:token (first tokens)
|
|
||||||
:remaining (remaining rest-result)})
|
|
||||||
|
|
||||||
(:err :none) first-result)))}))
|
|
||||||
|
|
||||||
(defn maybe
|
|
||||||
([parser] (maybe (pname parser) parser))
|
|
||||||
([name parser]
|
|
||||||
{:name (kw+str name "-maybe")
|
|
||||||
:rule (fn maybe-fn [tokens]
|
|
||||||
(let [result (apply-parser parser tokens)]
|
|
||||||
(if (pass? result)
|
|
||||||
result
|
|
||||||
{:status :group :type name :data [] :token (first tokens) :remaining tokens}
|
|
||||||
)))}))
|
|
||||||
|
|
||||||
(defn flat
|
|
||||||
([parser] (flat (pname parser) parser))
|
|
||||||
([name parser]
|
|
||||||
{:name (kw+str name "-flat")
|
|
||||||
:rule (fn flat-fn [tokens]
|
|
||||||
(let [result (apply-parser parser tokens)]
|
|
||||||
(if (pass? result) (first (:data result)) result)))}))
|
|
||||||
|
|
||||||
(defn group
|
|
||||||
([parser] (group (pname parser) parser))
|
|
||||||
([name parser]
|
|
||||||
{:name (kw+str name "-group")
|
|
||||||
:rule (fn group-fn [tokens]
|
|
||||||
(let [result (apply-parser parser tokens)]
|
|
||||||
(if (= :group (:status result))
|
|
||||||
(assoc result :status :ok)
|
|
||||||
result)))}))
|
|
||||||
|
|
||||||
(defn err-msg [{token :token trace :trace}]
|
|
||||||
(println "Unexpected token " (:type token) " on line " (:line token))
|
|
||||||
(println "Expected token " (first trace)))
|
|
||||||
|
|
||||||
(defmacro defp [name & items]
|
|
||||||
(let [arg (last items)
|
|
||||||
fns (into [] (butlast items))]
|
|
||||||
`(defn ~name [] ((apply comp ~fns) (keyword '~name) ~arg))))
|
|
||||||
|
|
@ -1,15 +0,0 @@
|
||||||
(ns ludus.prelude
|
|
||||||
#?(:cljs (:require [shadow.resource :as r]))
|
|
||||||
)
|
|
||||||
|
|
||||||
(def prelude
|
|
||||||
#?(
|
|
||||||
:clj (slurp "src/ludus/prelude.ld")
|
|
||||||
:cljs (r/inline "./prelude.ld")
|
|
||||||
))
|
|
||||||
|
|
||||||
(def postlude
|
|
||||||
#?(
|
|
||||||
:clj (slurp "src/ludus/postlude.ld")
|
|
||||||
:cljs (r/inline "./postlude.ld")
|
|
||||||
))
|
|
||||||
|
|
@ -1,118 +0,0 @@
|
||||||
(ns ludus.repl
|
|
||||||
(:require
|
|
||||||
[ludus.scanner :as scanner]
|
|
||||||
[ludus.parser :as p]
|
|
||||||
[ludus.grammar :as g]
|
|
||||||
[ludus.interpreter :as interpreter]
|
|
||||||
[ludus.base :as base]
|
|
||||||
[ludus.show :as show]
|
|
||||||
[ludus.data :as data]
|
|
||||||
;[ludus.process :as process]
|
|
||||||
))
|
|
||||||
|
|
||||||
(declare repl-prelude new-session)
|
|
||||||
|
|
||||||
(def sessions (atom {}))
|
|
||||||
|
|
||||||
(def current-session (atom nil))
|
|
||||||
|
|
||||||
(def prompt "=> ")
|
|
||||||
|
|
||||||
(defn- exit []
|
|
||||||
(println "\nGoodbye!")
|
|
||||||
(System/exit 0))
|
|
||||||
|
|
||||||
(def repl-ctx (merge interpreter/ludus-prelude
|
|
||||||
{::repl true
|
|
||||||
"repl"
|
|
||||||
{::data/struct true
|
|
||||||
::data/type ::data/ns
|
|
||||||
::data/name "repl"
|
|
||||||
|
|
||||||
:flush
|
|
||||||
{:name "flush"
|
|
||||||
::data/type ::data/clj
|
|
||||||
:body (fn
|
|
||||||
([]
|
|
||||||
(let [session @current-session]
|
|
||||||
(swap! session #(assoc % :ctx (volatile! repl-ctx)))
|
|
||||||
:ok))
|
|
||||||
([name]
|
|
||||||
(if-let [session (get @sessions name)]
|
|
||||||
(do
|
|
||||||
(swap! session #(assoc % :ctx (volatile! repl-ctx)))
|
|
||||||
:ok)
|
|
||||||
(do
|
|
||||||
(println "No session named" name)
|
|
||||||
:error))))}
|
|
||||||
|
|
||||||
:new
|
|
||||||
{:name "new"
|
|
||||||
::data/type ::data/clj
|
|
||||||
:body (fn [name]
|
|
||||||
(let [session (new-session name)]
|
|
||||||
(reset! current-session session)
|
|
||||||
:ok))}
|
|
||||||
|
|
||||||
:switch
|
|
||||||
{:name "switch"
|
|
||||||
::data/type ::data/clj
|
|
||||||
:body (fn [name]
|
|
||||||
(if-let [session (get @sessions name)]
|
|
||||||
(do
|
|
||||||
(reset! current-session session)
|
|
||||||
:ok)
|
|
||||||
(do
|
|
||||||
(println "No session named" name)
|
|
||||||
:error)))}
|
|
||||||
|
|
||||||
:quit
|
|
||||||
{:name "quit"
|
|
||||||
::data/type ::data/clj
|
|
||||||
:body (fn [] (exit))}
|
|
||||||
}}))
|
|
||||||
|
|
||||||
(defn- new-session [name]
|
|
||||||
(let [session (atom {:name name
|
|
||||||
:ctx (volatile! repl-ctx)
|
|
||||||
:history []})]
|
|
||||||
(swap! sessions #(assoc % name session))
|
|
||||||
session))
|
|
||||||
|
|
||||||
(defn repl-loop []
|
|
||||||
(let [session-atom @current-session
|
|
||||||
session @session-atom
|
|
||||||
orig-ctx (:ctx session)]
|
|
||||||
(print (str (:name session) prompt))
|
|
||||||
(flush)
|
|
||||||
(let [input (read-line)]
|
|
||||||
(cond
|
|
||||||
(= nil input) (exit)
|
|
||||||
|
|
||||||
(= "" input) (recur)
|
|
||||||
|
|
||||||
:else
|
|
||||||
(let [parsed (->> input
|
|
||||||
(scanner/scan)
|
|
||||||
:tokens
|
|
||||||
(p/apply-parser g/script))]
|
|
||||||
(if (= :err (:status parsed))
|
|
||||||
(do
|
|
||||||
(println (p/err-msg parsed))
|
|
||||||
(recur))
|
|
||||||
(let [{result :result ctx :ctx}
|
|
||||||
(interpreter/interpret-repl parsed orig-ctx true)]
|
|
||||||
(if (= result :error)
|
|
||||||
(recur)
|
|
||||||
(do
|
|
||||||
(println (show/show result))
|
|
||||||
(when (not (= @ctx @orig-ctx))
|
|
||||||
(swap! session-atom #(assoc % :ctx ctx)))
|
|
||||||
(recur))))))))))
|
|
||||||
|
|
||||||
(defn launch []
|
|
||||||
(println "Welcome to Ludus (v. 0.1.0-alpha)")
|
|
||||||
(let [session (new-session :ludus)]
|
|
||||||
(reset! current-session session)
|
|
||||||
(repl-loop)))
|
|
||||||
|
|
||||||
|
|
@ -1,336 +0,0 @@
|
||||||
(ns ludus.scanner
|
|
||||||
(:require
|
|
||||||
[ludus.token :as token]
|
|
||||||
;; [clojure.pprint :as pp]
|
|
||||||
[clojure.edn :as edn]))
|
|
||||||
|
|
||||||
(def reserved-words
|
|
||||||
"List of Ludus reserved words."
|
|
||||||
;; see ludus-spec repo for more info
|
|
||||||
{"as" :as ;; impl for `import`; not yet for patterns
|
|
||||||
;"cond" :cond ;; impl
|
|
||||||
"do" :do ;; impl
|
|
||||||
"else" :else ;; impl
|
|
||||||
"false" :false ;; impl -> literal word
|
|
||||||
"fn" :fn ;; impl
|
|
||||||
"if" :if ;; impl
|
|
||||||
"import" :import ;; impl
|
|
||||||
"let" :let ;; impl
|
|
||||||
"loop" :loop ;; impl
|
|
||||||
"match" :match ;; impl
|
|
||||||
"nil" :nil ;; impl -> literal word
|
|
||||||
"ns" :ns ;; impl
|
|
||||||
"panic!" :panic ;; impl (should _not_ be a function)
|
|
||||||
"recur" :recur ;; impl
|
|
||||||
"ref" :ref ;; impl
|
|
||||||
"then" :then ;; impl
|
|
||||||
"true" :true ;; impl -> literal word
|
|
||||||
"use" :use ;; wip
|
|
||||||
"with" :with ;; impl
|
|
||||||
"when" :when ;; impl, replaces cond
|
|
||||||
|
|
||||||
;; actor model/concurrency
|
|
||||||
;"receive" :receive
|
|
||||||
;;"self" :self ;; maybe not necessary?: self() is a function
|
|
||||||
;;"send" :send ;; not necessary: send(pid, message) is a function
|
|
||||||
;"spawn" :spawn
|
|
||||||
;;"to" :to ;; not necessary if send is a function
|
|
||||||
;; type system
|
|
||||||
;; "data" :data ;; we are going to tear out datatypes for now: see if dynamism works for us
|
|
||||||
;; others
|
|
||||||
"repeat" :repeat ;; syntax sugar over "loop": still unclear what this syntax could be
|
|
||||||
"test" :test
|
|
||||||
;; "module" :module ;; not necessary if we don't have datatypes
|
|
||||||
})
|
|
||||||
|
|
||||||
(def literal-words {
|
|
||||||
"true" true
|
|
||||||
"false" false
|
|
||||||
"nil" nil
|
|
||||||
})
|
|
||||||
|
|
||||||
(defn- new-scanner
|
|
||||||
"Creates a new scanner."
|
|
||||||
[source input]
|
|
||||||
{:source source
|
|
||||||
:input input
|
|
||||||
:length (count source)
|
|
||||||
:errors []
|
|
||||||
:start 0
|
|
||||||
:current 0
|
|
||||||
:line 1
|
|
||||||
:tokens []})
|
|
||||||
|
|
||||||
(defn- at-end?
|
|
||||||
"Tests if a scanner is at end of input."
|
|
||||||
[scanner]
|
|
||||||
(>= (:current scanner) (:length scanner)))
|
|
||||||
|
|
||||||
(defn- current-char
|
|
||||||
"Gets the current character of the scanner."
|
|
||||||
[scanner]
|
|
||||||
(nth (:source scanner) (:current scanner) nil))
|
|
||||||
|
|
||||||
(defn- advance
|
|
||||||
"Advances the scanner by a single character."
|
|
||||||
[scanner]
|
|
||||||
(update scanner :current inc))
|
|
||||||
|
|
||||||
(defn- next-char
|
|
||||||
"Gets the next character from the scanner."
|
|
||||||
[scanner]
|
|
||||||
(current-char (advance scanner)))
|
|
||||||
|
|
||||||
(defn- current-lexeme
|
|
||||||
[scanner]
|
|
||||||
(subs (:source scanner) (:start scanner) (:current scanner)))
|
|
||||||
|
|
||||||
(defn- char-code [char]
|
|
||||||
#?(
|
|
||||||
:clj (int char)
|
|
||||||
:cljs (.charCodeAt char 0)
|
|
||||||
))
|
|
||||||
|
|
||||||
(defn- char-in-range? [start end char]
|
|
||||||
(and char
|
|
||||||
(>= (char-code char) (char-code start))
|
|
||||||
(<= (char-code char) (char-code end))))
|
|
||||||
|
|
||||||
(defn- digit? [c]
|
|
||||||
(char-in-range? \0 \9 c))
|
|
||||||
|
|
||||||
(defn- nonzero-digit? [c]
|
|
||||||
(char-in-range? \1 \9 c))
|
|
||||||
|
|
||||||
;; for now, use very basic ASCII charset in words
|
|
||||||
;; TODO: research the implications of using the whole
|
|
||||||
;; (defn- alpha? [c] (boolean (re-find #"\p{L}" (str c))))
|
|
||||||
(defn- alpha? [c]
|
|
||||||
(or (char-in-range? \a \z c) (char-in-range? \A \Z c)))
|
|
||||||
|
|
||||||
(defn- lower? [c] (char-in-range? \a \z c))
|
|
||||||
|
|
||||||
(defn- upper? [c] (char-in-range? \A \Z c))
|
|
||||||
|
|
||||||
;; legal characters in words
|
|
||||||
(def word-chars #{\_ \? \! \* \/})
|
|
||||||
|
|
||||||
(defn- word-char? [c]
|
|
||||||
(or (alpha? c) (digit? c) (contains? word-chars c)))
|
|
||||||
|
|
||||||
(defn- whitespace? [c]
|
|
||||||
(or (= c \space) (= c \tab)))
|
|
||||||
|
|
||||||
(def terminators #{\: \; \newline \{ \} \( \) \[ \] \$ \# \- \= \& \, \> nil \\})
|
|
||||||
|
|
||||||
(defn- terminates? [c]
|
|
||||||
(or (whitespace? c) (contains? terminators c)))
|
|
||||||
|
|
||||||
(defn- add-token
|
|
||||||
([scanner token-type]
|
|
||||||
(add-token scanner token-type nil))
|
|
||||||
([scanner token-type literal]
|
|
||||||
(update scanner :tokens conj
|
|
||||||
(token/token
|
|
||||||
token-type
|
|
||||||
(current-lexeme scanner)
|
|
||||||
literal
|
|
||||||
(:line scanner)
|
|
||||||
(:start scanner)
|
|
||||||
(:source scanner)
|
|
||||||
(:input scanner)))))
|
|
||||||
|
|
||||||
;; TODO: errors should also be in the vector of tokens
|
|
||||||
;; The goal is to be able to be able to hand this to an LSP?
|
|
||||||
;; Do we need a different structure
|
|
||||||
(defn- add-error [scanner msg]
|
|
||||||
(let [token (token/token
|
|
||||||
:error
|
|
||||||
(current-lexeme scanner)
|
|
||||||
nil
|
|
||||||
(:line scanner)
|
|
||||||
(:start scanner)
|
|
||||||
(:source scanner)
|
|
||||||
(:input scanner))
|
|
||||||
err-token (assoc token :message msg)]
|
|
||||||
(-> scanner
|
|
||||||
(update :errors conj err-token)
|
|
||||||
(update :tokens conj err-token))))
|
|
||||||
|
|
||||||
(defn- add-keyword
|
|
||||||
[scanner]
|
|
||||||
(loop [scanner scanner
|
|
||||||
key ""]
|
|
||||||
(let [char (current-char scanner)]
|
|
||||||
(cond
|
|
||||||
(terminates? char) (add-token scanner :keyword (keyword key))
|
|
||||||
(word-char? char) (recur (advance scanner) (str key char))
|
|
||||||
:else (add-error scanner (str "Unexpected " char "after keyword :" key))))))
|
|
||||||
|
|
||||||
;; TODO: improve number parsing?
|
|
||||||
;; Currently this uses Clojure's number formatting rules (since we use the EDN reader)
|
|
||||||
;; These rules are here: https://cljs.github.io/api/syntax/number
|
|
||||||
(defn- add-number [char scanner]
|
|
||||||
(loop [scanner scanner
|
|
||||||
num (str char)
|
|
||||||
float? false]
|
|
||||||
(let [curr (current-char scanner)]
|
|
||||||
(cond
|
|
||||||
(= curr \_) (recur (advance scanner) num float?) ;; consume underscores unharmed
|
|
||||||
(= curr \.) (if float?
|
|
||||||
(add-error scanner (str "Unexpected second decimal point after " num "."))
|
|
||||||
(recur (advance scanner) (str num curr) true))
|
|
||||||
(terminates? curr) (add-token scanner :number (edn/read-string num))
|
|
||||||
(digit? curr) (recur (advance scanner) (str num curr) float?)
|
|
||||||
:else (add-error scanner (str "Unexpected " curr " after number " num "."))))))
|
|
||||||
|
|
||||||
;; TODO: activate string interpolation
|
|
||||||
(defn- add-string
|
|
||||||
[scanner]
|
|
||||||
(loop [scanner scanner
|
|
||||||
string ""
|
|
||||||
interpolate? false]
|
|
||||||
(let [char (current-char scanner)]
|
|
||||||
(case char
|
|
||||||
\{ (recur (advance scanner) (str string char) true)
|
|
||||||
; allow multiline strings
|
|
||||||
\newline (recur (update (advance scanner) :line inc) (str string char) interpolate?)
|
|
||||||
\" (if interpolate?
|
|
||||||
;(add-token (advance scanner) :interpolated string)
|
|
||||||
(add-token (advance scanner) :string string)
|
|
||||||
(add-token (advance scanner) :string string))
|
|
||||||
\\ (let [next (next-char scanner)
|
|
||||||
scanner (if (= next \newline)
|
|
||||||
(update scanner :line inc)
|
|
||||||
scanner)]
|
|
||||||
(recur (advance (advance scanner)) (str string next) interpolate?))
|
|
||||||
(if (at-end? scanner)
|
|
||||||
(add-error scanner "Unterminated string.")
|
|
||||||
(recur (advance scanner) (str string char) interpolate?))))))
|
|
||||||
|
|
||||||
(defn- add-word
|
|
||||||
[char scanner]
|
|
||||||
(loop [scanner scanner
|
|
||||||
word (str char)]
|
|
||||||
(let [curr (current-char scanner)]
|
|
||||||
(cond
|
|
||||||
(terminates? curr) (add-token scanner
|
|
||||||
(get reserved-words word :word)
|
|
||||||
(get literal-words word :none))
|
|
||||||
(word-char? curr) (recur (advance scanner) (str word curr))
|
|
||||||
:else (add-error scanner (str "Unexpected " curr " after word " word "."))))))
|
|
||||||
|
|
||||||
(defn- add-data
|
|
||||||
[char scanner]
|
|
||||||
(loop [scanner scanner
|
|
||||||
word (str char)]
|
|
||||||
(let [curr (current-char scanner)]
|
|
||||||
(cond
|
|
||||||
(terminates? curr) (add-token scanner :datatype)
|
|
||||||
(word-char? curr) (recur (advance scanner) (str word curr))
|
|
||||||
:else (add-error scanner (str "Unexpected " curr " after datatype " word "."))))))
|
|
||||||
|
|
||||||
(defn- add-ignored
|
|
||||||
[scanner]
|
|
||||||
(loop [scanner scanner
|
|
||||||
ignored "_"]
|
|
||||||
(let [char (current-char scanner)]
|
|
||||||
(cond
|
|
||||||
(terminates? char) (add-token scanner :ignored)
|
|
||||||
(word-char? char) (recur (advance scanner) (str ignored char))
|
|
||||||
:else (add-error scanner (str "Unexpected " char " after word " ignored "."))))))
|
|
||||||
|
|
||||||
(defn- add-comment [char scanner]
|
|
||||||
(loop [scanner scanner
|
|
||||||
comm (str char)]
|
|
||||||
(let [char (current-char scanner)]
|
|
||||||
(if (= \newline char)
|
|
||||||
scanner
|
|
||||||
(recur (advance scanner) (str comm char))))))
|
|
||||||
|
|
||||||
(defn- scan-token [scanner]
|
|
||||||
(let [char (current-char scanner)
|
|
||||||
scanner (advance scanner)
|
|
||||||
next (current-char scanner)]
|
|
||||||
(case char
|
|
||||||
;; one-character tokens
|
|
||||||
\( (add-token scanner :lparen)
|
|
||||||
;; :break is a special zero-char token before closing braces
|
|
||||||
;; it makes parsing much simpler
|
|
||||||
\) (add-token (add-token scanner :break) :rparen)
|
|
||||||
\{ (add-token scanner :lbrace)
|
|
||||||
\} (add-token (add-token scanner :break) :rbrace)
|
|
||||||
\[ (add-token scanner :lbracket)
|
|
||||||
\] (add-token (add-token scanner :break) :rbracket)
|
|
||||||
\; (add-token scanner :semicolon)
|
|
||||||
\, (add-token scanner :comma)
|
|
||||||
\newline (add-token (update scanner :line inc) :newline)
|
|
||||||
\\ (add-token scanner :backslash)
|
|
||||||
\= (add-token scanner :equals)
|
|
||||||
\> (add-token scanner :pipeline)
|
|
||||||
|
|
||||||
;; two-character tokens
|
|
||||||
;; ->
|
|
||||||
\- (cond
|
|
||||||
(= next \>) (add-token (advance scanner) :rarrow)
|
|
||||||
(digit? next) (add-number char scanner)
|
|
||||||
:else (add-error scanner (str "Expected -> or negative number after `-`. Got `" char next "`")))
|
|
||||||
|
|
||||||
;; dict #{
|
|
||||||
\# (if (= next \{)
|
|
||||||
(add-token (advance scanner) :startdict)
|
|
||||||
(add-error scanner (str "Expected beginning of dict: #{. Got " char next)))
|
|
||||||
|
|
||||||
;; set ${
|
|
||||||
\$ (if (= next \{)
|
|
||||||
(add-token (advance scanner) :startset)
|
|
||||||
(add-error scanner (str "Expected beginning of set: ${. Got " char next)))
|
|
||||||
|
|
||||||
;; struct @{: Deleted from the language in December 2023
|
|
||||||
; \@ (if (= next \{)
|
|
||||||
; (add-token (advance scanner) :startstruct)
|
|
||||||
; (add-error scanner (str "Expected beginning of struct: @{. Got " char next)))
|
|
||||||
|
|
||||||
;; placeholders
|
|
||||||
;; there's a flat _, and then ignored words
|
|
||||||
\_ (cond
|
|
||||||
(terminates? next) (add-token scanner :placeholder)
|
|
||||||
(alpha? next) (add-ignored scanner)
|
|
||||||
:else (add-error scanner (str "Expected placeholder: _. Got " char next)))
|
|
||||||
|
|
||||||
;; comments
|
|
||||||
;; & starts an inline comment
|
|
||||||
\& (add-comment char scanner)
|
|
||||||
|
|
||||||
;; keywords
|
|
||||||
\: (cond
|
|
||||||
(alpha? next) (add-keyword scanner)
|
|
||||||
:else (add-error scanner (str "Expected keyword. Got " char next)))
|
|
||||||
|
|
||||||
;; splats
|
|
||||||
\. (let [after_next (current-char (advance scanner))]
|
|
||||||
(if (= ".." (str next after_next))
|
|
||||||
(add-token (advance (advance scanner)) :splat)
|
|
||||||
(add-error scanner (str "Expected splat: ... . Got " (str "." next after_next)))))
|
|
||||||
|
|
||||||
;; strings
|
|
||||||
\" (add-string scanner)
|
|
||||||
|
|
||||||
;; word matches
|
|
||||||
(cond
|
|
||||||
(whitespace? char) scanner ;; for now just skip whitespace characters
|
|
||||||
(digit? char) (add-number char scanner)
|
|
||||||
(upper? char) (add-word char scanner) ;; no datatypes for now
|
|
||||||
(lower? char) (add-word char scanner)
|
|
||||||
:else (add-error scanner (str "Unexpected character: " char))))))
|
|
||||||
|
|
||||||
(defn- next-token [scanner]
|
|
||||||
(assoc scanner :start (:current scanner)))
|
|
||||||
|
|
||||||
(defn scan [source input]
|
|
||||||
(loop [scanner (new-scanner source input)]
|
|
||||||
(if (at-end? scanner)
|
|
||||||
(let [scanner (add-token (add-token scanner :break) :eof)]
|
|
||||||
{:tokens (:tokens scanner)
|
|
||||||
:errors (:errors scanner)})
|
|
||||||
(recur (-> scanner (scan-token) (next-token))))))
|
|
||||||
|
|
@ -1,122 +0,0 @@
|
||||||
(ns ludus.show
|
|
||||||
(:require
|
|
||||||
[ludus.data :as data]
|
|
||||||
; [ludus.scanner :as s]
|
|
||||||
; [ludus.parser :as p]
|
|
||||||
; [ludus.grammar :as g]
|
|
||||||
; [ludus.interpreter :as i]
|
|
||||||
[clojure.pprint :as pp]))
|
|
||||||
|
|
||||||
(declare show show-linear show-keyed)
|
|
||||||
|
|
||||||
(defn- show-vector [v]
|
|
||||||
(if (= (first v) ::data/tuple)
|
|
||||||
(str "(" (apply str (into [] show-linear (next v))) ")")
|
|
||||||
(str "[" (apply str (into [] show-linear (next v))) "]")))
|
|
||||||
|
|
||||||
(defn- show-map [v]
|
|
||||||
(cond
|
|
||||||
(or (= (::data/type v) ::data/fn)
|
|
||||||
(= (::data/type v) ::data/clj))
|
|
||||||
(str "fn " (:name v))
|
|
||||||
|
|
||||||
(= (::data/type v) ::data/ns)
|
|
||||||
(str "ns " (::data/name v) " {"
|
|
||||||
(apply str (into [] show-keyed (dissoc v ::data/struct ::data/type ::data/name)))
|
|
||||||
"}")
|
|
||||||
|
|
||||||
(::data/struct v)
|
|
||||||
(str "@{" (apply str (into [] show-keyed (dissoc v ::data/struct))) "}")
|
|
||||||
|
|
||||||
(::data/ref v) ;; TODO: reconsider this
|
|
||||||
(str "ref: " (::data/name v) " {" (-> v ::data/value deref show) "}")
|
|
||||||
|
|
||||||
(::data/dict v)
|
|
||||||
(str "#{" (apply str (into [] show-keyed (dissoc v ::data/dict))) "}")
|
|
||||||
|
|
||||||
:else
|
|
||||||
(with-out-str (pp/pprint v))))
|
|
||||||
|
|
||||||
(defn- show-set [v]
|
|
||||||
(str "${" (apply str (into [] show-linear v)) "}"))
|
|
||||||
|
|
||||||
(defn show
|
|
||||||
([v]
|
|
||||||
(cond
|
|
||||||
(string? v) (str "\"" v "\"")
|
|
||||||
(number? v) (str v)
|
|
||||||
(keyword? v) (str v)
|
|
||||||
(boolean? v) (str v)
|
|
||||||
(nil? v) "nil"
|
|
||||||
(vector? v) (show-vector v)
|
|
||||||
(set? v) (show-set v)
|
|
||||||
(map? v) (show-map v)
|
|
||||||
:else
|
|
||||||
(with-out-str (pp/pprint v))
|
|
||||||
))
|
|
||||||
([v & vs] (apply str (into [] (comp (map show) (interpose " ")) (concat [v] vs))))
|
|
||||||
)
|
|
||||||
|
|
||||||
(def show-linear (comp (map show) (interpose ", ")))
|
|
||||||
|
|
||||||
(def show-keyed (comp
|
|
||||||
(map #(str (show (first %)) " " (show (second %))))
|
|
||||||
(interpose ", ")))
|
|
||||||
|
|
||||||
(declare show-pattern)
|
|
||||||
|
|
||||||
(defn show-coll-pattern [pattern [start end]]
|
|
||||||
(let [data (:data pattern)
|
|
||||||
members (map show-pattern data)
|
|
||||||
output (apply str (interpose ", " members))]
|
|
||||||
(str start output end)))
|
|
||||||
|
|
||||||
(defn show-pattern [pattern]
|
|
||||||
(case (:type pattern)
|
|
||||||
nil ""
|
|
||||||
|
|
||||||
:placeholder "_"
|
|
||||||
|
|
||||||
:else "else"
|
|
||||||
|
|
||||||
:true "true"
|
|
||||||
|
|
||||||
:false "false"
|
|
||||||
|
|
||||||
:nil "nil"
|
|
||||||
|
|
||||||
:string (-> pattern :data first show)
|
|
||||||
|
|
||||||
(:word :number :keyword) (-> pattern :data first str)
|
|
||||||
|
|
||||||
:typed
|
|
||||||
(let [word (-> pattern :data first :data first)
|
|
||||||
type (-> pattern :data second :data first)]
|
|
||||||
(str word " as " type))
|
|
||||||
|
|
||||||
:splattern
|
|
||||||
(let [splatted (-> pattern :data first show-pattern)]
|
|
||||||
(str "..." splatted))
|
|
||||||
|
|
||||||
:pair-pattern
|
|
||||||
(let [key (-> pattern :data first)
|
|
||||||
value (-> pattern :data second)]
|
|
||||||
(str (show-pattern key) " " (show-pattern value)))
|
|
||||||
|
|
||||||
:tuple-pattern (show-coll-pattern pattern ["(" ")"])
|
|
||||||
|
|
||||||
:list-pattern (show-coll-pattern pattern ["[" "]"])
|
|
||||||
|
|
||||||
:dict-pattern (show-coll-pattern pattern ["#{" "}"])
|
|
||||||
|
|
||||||
:struct-pattern (show-coll-pattern pattern ["@{" "}"])
|
|
||||||
|
|
||||||
))
|
|
||||||
|
|
||||||
(comment
|
|
||||||
(def source "let 1 = 0")
|
|
||||||
(def tokens (-> source s/scan :tokens))
|
|
||||||
(def ast (p/apply-parser g/script tokens))
|
|
||||||
(println (i/prettify-ast ast))
|
|
||||||
(println (-> ast :data first :data first show-pattern))
|
|
||||||
)
|
|
||||||
|
|
@ -1,11 +0,0 @@
|
||||||
(ns ludus.token)
|
|
||||||
|
|
||||||
(defn token
|
|
||||||
[type text literal line start source input]
|
|
||||||
{:type type
|
|
||||||
:lexeme text
|
|
||||||
:literal literal
|
|
||||||
:line line
|
|
||||||
:source source
|
|
||||||
:input input
|
|
||||||
:start start})
|
|
||||||
|
|
@ -1,44 +0,0 @@
|
||||||
(ns ludus.web
|
|
||||||
(:require
|
|
||||||
[ludus.core :as core]
|
|
||||||
[goog.object :as o]
|
|
||||||
)
|
|
||||||
)
|
|
||||||
|
|
||||||
(defn get-element [id]
|
|
||||||
(.getElementById (.-document js/window) id))
|
|
||||||
|
|
||||||
(def canv (get-element "canv"))
|
|
||||||
|
|
||||||
(def code (get-element "code"))
|
|
||||||
|
|
||||||
(def out (get-element "output"))
|
|
||||||
|
|
||||||
(def play (get-element "play"))
|
|
||||||
|
|
||||||
(defn run-code []
|
|
||||||
(let [source (.-value code)
|
|
||||||
result (core/run source)]
|
|
||||||
(println "Running code:" source)
|
|
||||||
(o/set out "value" result)))
|
|
||||||
|
|
||||||
(.addEventListener play "click" run-code)
|
|
||||||
|
|
||||||
(defn setup []
|
|
||||||
(js/createCanvas 640 240 canv)
|
|
||||||
(js/background 235)
|
|
||||||
)
|
|
||||||
|
|
||||||
(defn draw []
|
|
||||||
(if js/mouseIsPressed
|
|
||||||
(js/fill 255)
|
|
||||||
(js/fill 155))
|
|
||||||
(js/ellipse js/mouseX js/mouseY 80 80))
|
|
||||||
|
|
||||||
(defn init []
|
|
||||||
(doto js/window
|
|
||||||
(o/set "setup" setup)
|
|
||||||
(o/set "draw" draw)))
|
|
||||||
|
|
||||||
(o/set js/window "ludus_init" init)
|
|
||||||
|
|
||||||
1125
src/parser.janet
Normal file
1125
src/parser.janet
Normal file
File diff suppressed because it is too large
Load Diff
41
src/prelude.janet
Normal file
41
src/prelude.janet
Normal file
|
|
@ -0,0 +1,41 @@
|
||||||
|
(import /src/base :as b)
|
||||||
|
(import /src/scanner :as s)
|
||||||
|
(import /src/parser :as p)
|
||||||
|
(import /src/validate :as v)
|
||||||
|
(import /src/interpreter :as i)
|
||||||
|
(import /src/errors :as e)
|
||||||
|
|
||||||
|
(def pkg (do
|
||||||
|
(def pre-ctx @{:^parent {"base" b/base}})
|
||||||
|
(def pre-src (slurp "prelude.ld"))
|
||||||
|
(def pre-scanned (s/scan pre-src :prelude))
|
||||||
|
(def pre-parsed (p/parse pre-scanned))
|
||||||
|
(def parse-errors (pre-parsed :errors))
|
||||||
|
(when (any? parse-errors) (each err parse-errors (e/parse-error err)) (break :error))
|
||||||
|
(def pre-validated (v/valid pre-parsed pre-ctx))
|
||||||
|
(def validation-errors (pre-validated :errors))
|
||||||
|
(when (any? validation-errors) (each err validation-errors (e/validation-error err)) (break :error))
|
||||||
|
(try
|
||||||
|
(i/interpret (pre-parsed :ast) pre-ctx)
|
||||||
|
([err] (e/runtime-error err) :error))))
|
||||||
|
|
||||||
|
(def ctx (do
|
||||||
|
(def ctx @{})
|
||||||
|
(each [k v] (pairs pkg)
|
||||||
|
(set (ctx (string k)) v))
|
||||||
|
(set (ctx "^name") nil)
|
||||||
|
(set (ctx "^type") nil)
|
||||||
|
ctx))
|
||||||
|
|
||||||
|
(def post/src (slurp "postlude.ld"))
|
||||||
|
|
||||||
|
(def post/ast (do
|
||||||
|
(def post-ctx @{:^parent ctx})
|
||||||
|
(def post-scanned (s/scan post/src :postlude))
|
||||||
|
(def post-parsed (p/parse post-scanned))
|
||||||
|
(def parse-errors (post-parsed :errors))
|
||||||
|
(when (any? parse-errors) (each err parse-errors (e/parse-error err)) (break :error))
|
||||||
|
(def post-validated (v/valid post-parsed post-ctx))
|
||||||
|
(def validation-errors (post-validated :errors))
|
||||||
|
(when (any? validation-errors) (each err validation-errors (e/validation-error err)) (break :error))
|
||||||
|
(post-parsed :ast)))
|
||||||
34
src/prelude.test.janet
Normal file
34
src/prelude.test.janet
Normal file
|
|
@ -0,0 +1,34 @@
|
||||||
|
# testing the prelude
|
||||||
|
(try (os/cd "janet") ([_] nil))
|
||||||
|
(import /scanner :as s)
|
||||||
|
(import /parser :as p)
|
||||||
|
(import /validate :as v)
|
||||||
|
(import /interpreter :as i)
|
||||||
|
(import /errors :as e)
|
||||||
|
(import /base :as b)
|
||||||
|
(import /load-prelude :as pre)
|
||||||
|
(use judge)
|
||||||
|
|
||||||
|
(defn run [source]
|
||||||
|
(when (= :error pre/pkg) (error "could not load prelude"))
|
||||||
|
(def ctx @{:^parent pre/ctx})
|
||||||
|
(def scanned (s/scan source :test))
|
||||||
|
(when (any? (scanned :errors))
|
||||||
|
(e/scan-error (scanned :errors)) (error "scanning errors"))
|
||||||
|
(def parsed (p/parse scanned))
|
||||||
|
(when (any? (parsed :errors))
|
||||||
|
(e/parse-error (parsed :errors)) (error "parsing errors"))
|
||||||
|
(def valid (v/valid parsed ctx))
|
||||||
|
(when (any? (valid :errors)) (each err (valid :errors)
|
||||||
|
(e/validation-error err)) (error "validation errors"))
|
||||||
|
(i/interpret (parsed :ast) ctx))
|
||||||
|
|
||||||
|
(deftest "debug add_msg"
|
||||||
|
(test (run `
|
||||||
|
let msgs = [1, :foo, nil]
|
||||||
|
let msg = do msgs > map (string, _)
|
||||||
|
msg
|
||||||
|
`)
|
||||||
|
@["1" ":foo" ":^nil"])
|
||||||
|
# (test (run `print! ("foo", "bar")`) :ok)
|
||||||
|
)
|
||||||
9
src/project.janet
Normal file
9
src/project.janet
Normal file
|
|
@ -0,0 +1,9 @@
|
||||||
|
(declare-project
|
||||||
|
:dependencies [
|
||||||
|
{:url "https://github.com/ianthehenry/judge.git"
|
||||||
|
:tag "v2.8.1"}
|
||||||
|
{:url "https://github.com/janet-lang/spork"}
|
||||||
|
])
|
||||||
|
|
||||||
|
(declare-source
|
||||||
|
:source ["ludus.janet"])
|
||||||
343
src/scanner.janet
Normal file
343
src/scanner.janet
Normal file
|
|
@ -0,0 +1,343 @@
|
||||||
|
(def reserved-words
|
||||||
|
"List of Ludus reserved words."
|
||||||
|
## see ludus-spec repo for more info
|
||||||
|
{"as" :as ## impl
|
||||||
|
"box" :ref
|
||||||
|
"do" :do ## impl
|
||||||
|
"else" :else ## impl
|
||||||
|
"false" :false ## impl -> literal word
|
||||||
|
"fn" :fn ## impl
|
||||||
|
"if" :if ## impl
|
||||||
|
"import" :import ## impl
|
||||||
|
"let" :let ## impl
|
||||||
|
"loop" :loop ## impl
|
||||||
|
"match" :match ## impl
|
||||||
|
"nil" :nil ## impl -> literal word
|
||||||
|
"ns" :ns ## impl
|
||||||
|
"panic!" :panic ## impl (should _not_ be a function)
|
||||||
|
"pkg" :pkg
|
||||||
|
"recur" :recur ## impl
|
||||||
|
"then" :then ## impl
|
||||||
|
"true" :true ## impl -> literal word
|
||||||
|
"use" :use ## wip
|
||||||
|
"with" :with ## impl
|
||||||
|
"when" :when ## impl, replaces cond
|
||||||
|
"repeat" :repeat ## syntax sugar over "loop": still unclear what this syntax could be
|
||||||
|
"test" :test
|
||||||
|
})
|
||||||
|
|
||||||
|
(def literal-words {"true" true
|
||||||
|
"false" false
|
||||||
|
"nil" nil
|
||||||
|
})
|
||||||
|
|
||||||
|
(defn- new-scanner
|
||||||
|
"Creates a new scanner."
|
||||||
|
[source input]
|
||||||
|
@{:source source
|
||||||
|
:input input
|
||||||
|
:length (length source)
|
||||||
|
:errors @[]
|
||||||
|
:start 0
|
||||||
|
:current 0
|
||||||
|
:line 1
|
||||||
|
:tokens @[]})
|
||||||
|
|
||||||
|
(defn- at-end?
|
||||||
|
"Tests if a scanner is at end of input."
|
||||||
|
[scanner]
|
||||||
|
(>= (get scanner :current) (get scanner :length)))
|
||||||
|
|
||||||
|
(defn- current-char
|
||||||
|
"Gets the current character of the scanner."
|
||||||
|
[scanner]
|
||||||
|
(let [source (get scanner :source)
|
||||||
|
current (get scanner :current)
|
||||||
|
length (length source)]
|
||||||
|
(if (>= current length)
|
||||||
|
nil
|
||||||
|
(string/from-bytes (get source current)))))
|
||||||
|
|
||||||
|
(defn- advance
|
||||||
|
"Advances the scanner by a single character."
|
||||||
|
[scanner]
|
||||||
|
(update scanner :current inc))
|
||||||
|
|
||||||
|
(defn- next-char
|
||||||
|
"Gets the next character from the scanner."
|
||||||
|
[scanner]
|
||||||
|
(let [source (get scanner :source)
|
||||||
|
current (get scanner :current)
|
||||||
|
next (inc current)
|
||||||
|
length (length source)]
|
||||||
|
(if (>= next length)
|
||||||
|
nil
|
||||||
|
(string/from-bytes (get source next)))))
|
||||||
|
|
||||||
|
(defn- current-lexeme
|
||||||
|
[scanner]
|
||||||
|
(slice (get scanner :source) (get scanner :start) (get scanner :current)))
|
||||||
|
|
||||||
|
(defn- char-code [char] (get char 0))
|
||||||
|
|
||||||
|
(defn- char-in-range? [start end char]
|
||||||
|
(and char
|
||||||
|
(>= (char-code char) (char-code start))
|
||||||
|
(<= (char-code char) (char-code end))))
|
||||||
|
|
||||||
|
(defn- digit? [c]
|
||||||
|
(char-in-range? "0" "9" c))
|
||||||
|
|
||||||
|
(defn- nonzero-digit? [c]
|
||||||
|
(char-in-range? "1" "9" c))
|
||||||
|
|
||||||
|
## for now, use very basic ASCII charset in words
|
||||||
|
## TODO: research the implications of using the whole
|
||||||
|
## (defn- alpha? [c] (boolean (re-find #"\p{L}" (string c))))
|
||||||
|
(defn- alpha? [c]
|
||||||
|
(or (char-in-range? "a" "z" c) (char-in-range? "A" "Z" c)))
|
||||||
|
|
||||||
|
(defn- lower? [c] (char-in-range? "a" "z" c))
|
||||||
|
|
||||||
|
(defn- upper? [c] (char-in-range? "A" "Z" c))
|
||||||
|
|
||||||
|
## legal characters in words
|
||||||
|
(def word-chars {"_" true "?" true "!" true "*" true "/" true})
|
||||||
|
|
||||||
|
(defn- word-char? [c]
|
||||||
|
(or (alpha? c) (digit? c) (get word-chars c)))
|
||||||
|
|
||||||
|
(defn- whitespace? [c]
|
||||||
|
(or (= c " ") (= c "\t")))
|
||||||
|
|
||||||
|
(def terminators {
|
||||||
|
":" true
|
||||||
|
";" true
|
||||||
|
"\n" true
|
||||||
|
"{" true
|
||||||
|
"}" true
|
||||||
|
"(" true
|
||||||
|
")" true
|
||||||
|
"[" true
|
||||||
|
"]" true
|
||||||
|
"$" true
|
||||||
|
"#" true
|
||||||
|
"-" true
|
||||||
|
"=" true
|
||||||
|
"&" true
|
||||||
|
"," true
|
||||||
|
">" true
|
||||||
|
"\"" true})
|
||||||
|
|
||||||
|
(defn- terminates? [c]
|
||||||
|
(or (nil? c) (whitespace? c) (get terminators c)))
|
||||||
|
|
||||||
|
(defn- add-token
|
||||||
|
[scanner token-type &opt literal]
|
||||||
|
(update scanner :tokens array/push
|
||||||
|
{:type token-type
|
||||||
|
:lexeme (current-lexeme scanner)
|
||||||
|
:literal literal
|
||||||
|
:line (get scanner :line)
|
||||||
|
:start (get scanner :start)
|
||||||
|
:source (get scanner :source)
|
||||||
|
:input (get scanner :input)}))
|
||||||
|
|
||||||
|
## TODO: errors should also be in the vector of tokens
|
||||||
|
## The goal is to be able to be able to hand this to an LSP?
|
||||||
|
## Do we need a different structure
|
||||||
|
(defn- add-error [scanner msg]
|
||||||
|
(let [token {:type :error
|
||||||
|
:lexeme (current-lexeme scanner)
|
||||||
|
:literal nil
|
||||||
|
:line (get scanner :line)
|
||||||
|
:start (get scanner :start)
|
||||||
|
:source (get scanner :source)
|
||||||
|
:input (get scanner :input)
|
||||||
|
:message msg}]
|
||||||
|
(-> scanner
|
||||||
|
(update :errors array/push token)
|
||||||
|
(update :tokens array/push token))))
|
||||||
|
|
||||||
|
(defn- add-keyword
|
||||||
|
[scanner]
|
||||||
|
(defn recur [scanner key]
|
||||||
|
(let [char (current-char scanner)]
|
||||||
|
(cond
|
||||||
|
(terminates? char) (add-token scanner :keyword (keyword key))
|
||||||
|
(word-char? char) (recur (advance scanner) (string key char))
|
||||||
|
:else (add-error scanner (string "Unexpected " char "after keyword :" key)))))
|
||||||
|
(recur scanner ""))
|
||||||
|
|
||||||
|
(defn- add-pkg-kw [scanner]
|
||||||
|
(defn recur [scanner key]
|
||||||
|
(let [char (current-char scanner)]
|
||||||
|
(cond
|
||||||
|
(terminates? char) (add-token scanner :pkg-kw (keyword key))
|
||||||
|
(word-char? char) (recur (advance scanner) (string key char))
|
||||||
|
:else (add-error scanner (string "Unexpected " char " after pkg keyword :" key)))))
|
||||||
|
(recur scanner ""))
|
||||||
|
|
||||||
|
(defn- read-literal [lit] (-> lit parse-all first))
|
||||||
|
|
||||||
|
### TODO: consider whether Janet's number rules are right for Ludus
|
||||||
|
(defn- add-number [char scanner]
|
||||||
|
(defn recur [scanner num float?]
|
||||||
|
(let [curr (current-char scanner)]
|
||||||
|
(cond
|
||||||
|
(= curr "_") (recur (advance scanner) num float?) ## consume underscores unharmed
|
||||||
|
(= curr ".") (if float?
|
||||||
|
(add-error scanner (string "Unexpected second decimal point after " num "."))
|
||||||
|
(recur (advance scanner) (buffer/push num curr) true))
|
||||||
|
(terminates? curr) (add-token scanner :number (read-literal num))
|
||||||
|
(digit? curr) (recur (advance scanner) (buffer/push num curr) float?)
|
||||||
|
:else (add-error scanner (string "Unexpected " curr " after number " num ".")))))
|
||||||
|
(recur scanner (buffer char) false))
|
||||||
|
|
||||||
|
(defn- add-string
|
||||||
|
[scanner]
|
||||||
|
(defn recur [scanner buff interpolate?]
|
||||||
|
(let [char (current-char scanner)]
|
||||||
|
(case char
|
||||||
|
"{" (recur (advance scanner) (buffer/push buff char) true)
|
||||||
|
# allow multiline strings
|
||||||
|
"\n" (recur (update (advance scanner) :line inc) (buffer/push buff char) interpolate?)
|
||||||
|
"\"" (add-token (advance scanner) (if interpolate? :interpolated :string)(string buff))
|
||||||
|
"\\" (let [next (next-char scanner)]
|
||||||
|
(if (= next "{")
|
||||||
|
(do
|
||||||
|
(buffer/push buff char)
|
||||||
|
(buffer/push buff next)
|
||||||
|
(recur (advance (advance scanner)) buff interpolate?))
|
||||||
|
(recur (advance scanner) (buffer/push buff char) interpolate?)))
|
||||||
|
(if (at-end? scanner)
|
||||||
|
(add-error scanner "Unterminated string.")
|
||||||
|
(recur (advance scanner) (buffer/push buff char) interpolate?)))))
|
||||||
|
(recur scanner @"" false))
|
||||||
|
|
||||||
|
(defn- add-word
|
||||||
|
[char scanner]
|
||||||
|
(defn recur [scanner word]
|
||||||
|
(let [curr (current-char scanner)]
|
||||||
|
(cond
|
||||||
|
(terminates? curr) (add-token scanner
|
||||||
|
(get reserved-words (string word) :word)
|
||||||
|
(get literal-words (string word) :none))
|
||||||
|
(word-char? curr) (recur (advance scanner) (buffer/push word curr))
|
||||||
|
:else (add-error scanner (string "Unexpected " curr " after word " word ".")))))
|
||||||
|
(recur scanner (buffer char)))
|
||||||
|
|
||||||
|
(defn- add-pkg
|
||||||
|
[char scanner]
|
||||||
|
(defn recur [scanner pkg]
|
||||||
|
(let [curr (current-char scanner)]
|
||||||
|
(cond
|
||||||
|
(terminates? curr) (add-token scanner :pkg-name :none)
|
||||||
|
(word-char? curr) (recur (advance scanner) (buffer/push pkg curr))
|
||||||
|
:else (add-error scanner (string "unexpected " curr " after pkg name " pkg)))))
|
||||||
|
(recur scanner (buffer char)))
|
||||||
|
|
||||||
|
(defn- add-ignored
|
||||||
|
[scanner]
|
||||||
|
(defn recur [scanner ignored]
|
||||||
|
(let [char (current-char scanner)]
|
||||||
|
(cond
|
||||||
|
(terminates? char) (add-token scanner :ignored)
|
||||||
|
(word-char? char) (recur (advance scanner) (buffer/push ignored char))
|
||||||
|
:else (add-error scanner (string "Unexpected " char " after word " ignored ".")))))
|
||||||
|
(recur scanner @"_"))
|
||||||
|
|
||||||
|
(defn- add-comment [char scanner]
|
||||||
|
(defn recur [scanner comm]
|
||||||
|
(let [char (current-char scanner)]
|
||||||
|
(if (or (= "\n" char) (at-end? scanner))
|
||||||
|
scanner # for now, we don't do anything with comments; can be added later
|
||||||
|
(recur (advance scanner) (buffer/push comm char)))))
|
||||||
|
(recur scanner (buffer char)))
|
||||||
|
|
||||||
|
(defn- scan-token [scanner]
|
||||||
|
(let [char (current-char scanner)
|
||||||
|
scanner (advance scanner)
|
||||||
|
next (current-char scanner)]
|
||||||
|
(case char
|
||||||
|
## one-character tokens
|
||||||
|
## :break is a special zero-char token before closing braces
|
||||||
|
## it makes parsing much simpler
|
||||||
|
"(" (add-token scanner :lparen)
|
||||||
|
")" (add-token (add-token scanner :break) :rparen)
|
||||||
|
"{" (add-token scanner :lbrace)
|
||||||
|
"}" (add-token (add-token scanner :break) :rbrace)
|
||||||
|
"[" (add-token scanner :lbracket)
|
||||||
|
"]" (add-token (add-token scanner :break) :rbracket)
|
||||||
|
";" (add-token scanner :semicolon)
|
||||||
|
"," (add-token scanner :comma)
|
||||||
|
"\n" (add-token (update scanner :line inc) :newline)
|
||||||
|
"\\" (add-token scanner :backslash)
|
||||||
|
"=" (add-token scanner :equals)
|
||||||
|
">" (add-token scanner :pipeline)
|
||||||
|
|
||||||
|
## two-character tokens
|
||||||
|
## ->
|
||||||
|
"-" (cond
|
||||||
|
(= next ">") (add-token (advance scanner) :arrow)
|
||||||
|
(digit? next) (add-number char scanner)
|
||||||
|
:else (add-error scanner (string "Expected > or negative number after `-`. Got `" char next "`")))
|
||||||
|
|
||||||
|
## dict #{
|
||||||
|
"#" (if (= next "{")
|
||||||
|
(add-token (advance scanner) :startdict)
|
||||||
|
(add-error scanner (string "Expected beginning of dict: #{. Got " char next)))
|
||||||
|
|
||||||
|
## set ${
|
||||||
|
"$" (if (= next "{")
|
||||||
|
(add-token (advance scanner) :startset)
|
||||||
|
(add-error scanner (string "Expected beginning of set: ${. Got " char next)))
|
||||||
|
|
||||||
|
## placeholders
|
||||||
|
## there's a flat _, and then ignored words
|
||||||
|
"_" (cond
|
||||||
|
(terminates? next) (add-token scanner :placeholder)
|
||||||
|
(alpha? next) (add-ignored scanner)
|
||||||
|
:else (add-error scanner (string "Expected placeholder: _. Got " char next)))
|
||||||
|
|
||||||
|
## comments
|
||||||
|
## & starts an inline comment
|
||||||
|
"&" (add-comment char scanner)
|
||||||
|
|
||||||
|
## keywords
|
||||||
|
# XXX: make sure we want only lower-only keywords
|
||||||
|
":" (cond
|
||||||
|
(lower? next) (add-keyword scanner)
|
||||||
|
(upper? next) (add-pkg-kw scanner)
|
||||||
|
:else (add-error scanner (string "Expected keyword or pkg keyword. Got " char next)))
|
||||||
|
|
||||||
|
## splats
|
||||||
|
"." (let [after_next (current-char (advance scanner))]
|
||||||
|
(if (= ".." (string next after_next))
|
||||||
|
(add-token (advance scanner) :splat)
|
||||||
|
(add-error scanner (string "Expected splat: ... . Got " (string "." next after_next)))))
|
||||||
|
|
||||||
|
## strings
|
||||||
|
"\"" (add-string scanner)
|
||||||
|
|
||||||
|
## word matches
|
||||||
|
(cond
|
||||||
|
(whitespace? char) scanner ## for now just skip whitespace characters
|
||||||
|
(digit? char) (add-number char scanner)
|
||||||
|
(upper? char) (add-pkg char scanner)
|
||||||
|
(lower? char) (add-word char scanner)
|
||||||
|
:else (add-error scanner (string "Unexpected character: " char))))))
|
||||||
|
|
||||||
|
(defn- next-token [scanner]
|
||||||
|
(put scanner :start (get scanner :current)))
|
||||||
|
|
||||||
|
(defn scan [source &opt input]
|
||||||
|
(default input :input)
|
||||||
|
(defn recur [scanner]
|
||||||
|
(if (at-end? scanner)
|
||||||
|
(let [scanner (add-token (add-token scanner :break) :eof)]
|
||||||
|
{:tokens (get scanner :tokens)
|
||||||
|
:errors (get scanner :errors [])})
|
||||||
|
(recur (-> scanner (scan-token) (next-token)))))
|
||||||
|
(recur (new-scanner source input)))
|
||||||
|
|
||||||
781
src/validate.janet
Normal file
781
src/validate.janet
Normal file
|
|
@ -0,0 +1,781 @@
|
||||||
|
### A validator for a Ludus AST
|
||||||
|
|
||||||
|
(comment
|
||||||
|
|
||||||
|
Tracking here, before I start writing this code, the kinds of validation we're hoping to accomplish:
|
||||||
|
|
||||||
|
* [x] ensure called keywords are only called w/ one arg
|
||||||
|
* [x] first-level property access with pkg, e.g. `Foo :bar`--bar must be on Foo
|
||||||
|
- [x] accept pkg-kws
|
||||||
|
* [x] validate dict patterns
|
||||||
|
* [x] compile string-patterns
|
||||||
|
* [x] `loop` form arity checking
|
||||||
|
* [x] arity checking of explicit named function calls
|
||||||
|
* [x] flag tail calls
|
||||||
|
* [x] no re-bound names
|
||||||
|
* [x] no unbound names
|
||||||
|
* [x] no unbound names with `use` forms
|
||||||
|
* [x] recur in tail position in `loop` forms
|
||||||
|
* [x] recur not called outside of `loop` forms
|
||||||
|
* [x] splats come at the end of list, tuple, and dict patterns
|
||||||
|
|
||||||
|
Deferred until a later iteration of Ludus:
|
||||||
|
* [ ] no circular imports DEFERRED
|
||||||
|
* [ ] correct imports DEFERRED
|
||||||
|
* [ ] validate `with` forms
|
||||||
|
)
|
||||||
|
|
||||||
|
(def- package-registry @{})
|
||||||
|
|
||||||
|
# (try (os/cd "janet") ([_] nil))
|
||||||
|
(import ./scanner :as s)
|
||||||
|
(import ./parser :as p)
|
||||||
|
|
||||||
|
(defn- new-validator [parser]
|
||||||
|
(def ast (parser :ast))
|
||||||
|
@{:ast ast
|
||||||
|
:errors @[]
|
||||||
|
:ctx @{}
|
||||||
|
:status @{}}
|
||||||
|
)
|
||||||
|
|
||||||
|
(var validate nil)
|
||||||
|
|
||||||
|
(def terminals [:number :string :bool :nil :placeholder])
|
||||||
|
|
||||||
|
(def simple-colls [:list :tuple :set :args])
|
||||||
|
|
||||||
|
(defn- simple-coll [validator]
|
||||||
|
(def ast (validator :ast))
|
||||||
|
(def data (ast :data))
|
||||||
|
(each node data
|
||||||
|
(set (validator :ast) node)
|
||||||
|
(validate validator))
|
||||||
|
validator)
|
||||||
|
|
||||||
|
(defn- iff [validator]
|
||||||
|
(def ast (validator :ast))
|
||||||
|
(def data (ast :data))
|
||||||
|
(each node data
|
||||||
|
(set (validator :ast) node)
|
||||||
|
(validate validator))
|
||||||
|
validator)
|
||||||
|
|
||||||
|
(defn- script [validator]
|
||||||
|
(def ast (validator :ast))
|
||||||
|
(def data (ast :data))
|
||||||
|
(def status (validator :status))
|
||||||
|
(set (status :toplevel) true)
|
||||||
|
(each node data
|
||||||
|
(set (validator :ast) node)
|
||||||
|
(validate validator))
|
||||||
|
validator)
|
||||||
|
|
||||||
|
(defn- block [validator]
|
||||||
|
(def ast (validator :ast))
|
||||||
|
(def data (ast :data))
|
||||||
|
(def status (validator :status))
|
||||||
|
(set (status :toplevel) nil)
|
||||||
|
(def tail? (status :tail))
|
||||||
|
(set (status :tail) false)
|
||||||
|
(def parent (validator :ctx))
|
||||||
|
(def ctx @{:^parent parent})
|
||||||
|
(set (validator :ctx) ctx)
|
||||||
|
(for i 0 (-> data length dec)
|
||||||
|
(set (validator :ast) (data i))
|
||||||
|
(validate validator))
|
||||||
|
(set (status :tail) tail?)
|
||||||
|
(set (validator :ast) (last data))
|
||||||
|
(validate validator)
|
||||||
|
(set (validator :ctx) parent)
|
||||||
|
validator)
|
||||||
|
|
||||||
|
(defn- resolve-local [ctx name]
|
||||||
|
(get ctx name))
|
||||||
|
|
||||||
|
(defn- resolve-name [ctx name]
|
||||||
|
(when (nil? ctx) (break nil))
|
||||||
|
(def node (get ctx name))
|
||||||
|
(if node node (resolve-name (get ctx :^parent) name)))
|
||||||
|
|
||||||
|
(defn- word [validator]
|
||||||
|
(def ast (validator :ast))
|
||||||
|
(def name (ast :data))
|
||||||
|
(def ctx (validator :ctx))
|
||||||
|
(def resolved (resolve-name ctx name))
|
||||||
|
(when (not resolved)
|
||||||
|
(array/push (validator :errors)
|
||||||
|
{:node ast :msg "unbound name"}))
|
||||||
|
validator)
|
||||||
|
|
||||||
|
|
||||||
|
### patterns
|
||||||
|
(var pattern nil)
|
||||||
|
|
||||||
|
(defn- lett [validator]
|
||||||
|
(def ast (validator :ast))
|
||||||
|
(def [lhs rhs] (ast :data))
|
||||||
|
# evaluate the expression first
|
||||||
|
# otherwise lhs names will appear bound
|
||||||
|
(set (validator :ast) rhs)
|
||||||
|
(validate validator)
|
||||||
|
(set (validator :ast) lhs)
|
||||||
|
(pattern validator)
|
||||||
|
validator)
|
||||||
|
|
||||||
|
(defn- splattern [validator]
|
||||||
|
(def ast (validator :ast))
|
||||||
|
(def status (validator :status))
|
||||||
|
(when (not (status :last))
|
||||||
|
(array/push (validator :errors)
|
||||||
|
{:node ast :msg "splats may only come last in collection patterns"}))
|
||||||
|
(def data (ast :data))
|
||||||
|
(when data
|
||||||
|
(set (validator :ast) data)
|
||||||
|
(pattern validator))
|
||||||
|
validator)
|
||||||
|
|
||||||
|
(defn- simple-coll-pattern [validator]
|
||||||
|
(def ast (validator :ast))
|
||||||
|
(def data (ast :data))
|
||||||
|
(when (empty? data) (break validator))
|
||||||
|
(def status (validator :status))
|
||||||
|
(for i 0 (-> data length dec)
|
||||||
|
(set (validator :ast) (get data i))
|
||||||
|
(pattern validator))
|
||||||
|
(set (status :last) true)
|
||||||
|
(set (validator :ast) (last data))
|
||||||
|
(pattern validator)
|
||||||
|
(set (status :last) nil)
|
||||||
|
validator)
|
||||||
|
|
||||||
|
(defn- word-pattern [validator]
|
||||||
|
(def ast (validator :ast))
|
||||||
|
(def name (ast :data))
|
||||||
|
(def ctx (validator :ctx))
|
||||||
|
(when (has-key? ctx name)
|
||||||
|
(def {:line line :input input} (get-in ctx [name :token]))
|
||||||
|
(array/push (validator :errors)
|
||||||
|
{:node ast :msg (string "name is already bound on line "
|
||||||
|
line " of " input)}))
|
||||||
|
(set (ctx name) ast)
|
||||||
|
# (pp ctx)
|
||||||
|
validator)
|
||||||
|
|
||||||
|
(def types [
|
||||||
|
:nil
|
||||||
|
:bool
|
||||||
|
:number
|
||||||
|
:keyword
|
||||||
|
:string
|
||||||
|
:set
|
||||||
|
:tuple
|
||||||
|
:dict
|
||||||
|
:list
|
||||||
|
:fn
|
||||||
|
:box
|
||||||
|
:pkg
|
||||||
|
])
|
||||||
|
|
||||||
|
(defn typed [validator]
|
||||||
|
(def ast (validator :ast))
|
||||||
|
(def [kw-type word] (ast :data))
|
||||||
|
(def type (kw-type :data))
|
||||||
|
(when (not (has-value? types type))
|
||||||
|
(array/push (validator :errors)
|
||||||
|
{:node kw-type :msg "unknown type"}))
|
||||||
|
(set (validator :ast) word)
|
||||||
|
(pattern validator))
|
||||||
|
|
||||||
|
(defn- str-pattern [validator]
|
||||||
|
(def ast (validator :ast))
|
||||||
|
(def data (ast :data))
|
||||||
|
(def last-term (-> data array/pop string))
|
||||||
|
(def grammar @{})
|
||||||
|
(def bindings @[])
|
||||||
|
(var current 0)
|
||||||
|
(each node data
|
||||||
|
(when (not (buffer? node))
|
||||||
|
(set (validator :ast) node)
|
||||||
|
(pattern validator))
|
||||||
|
(if (buffer? node)
|
||||||
|
(set (grammar (keyword current)) (string node))
|
||||||
|
(do
|
||||||
|
(set (grammar (keyword current))
|
||||||
|
~(<- (to ,(keyword (inc current)))))
|
||||||
|
(array/push bindings (node :data))))
|
||||||
|
(set current (inc current)))
|
||||||
|
(set (grammar (keyword current)) ~(* ,last-term -1))
|
||||||
|
(def rules (map keyword (range (length grammar))))
|
||||||
|
(set (grammar :main) ~(* ,;rules))
|
||||||
|
(set (ast :grammar) grammar)
|
||||||
|
(set (ast :compiled) (peg/compile grammar))
|
||||||
|
(set (ast :bindings) bindings))
|
||||||
|
|
||||||
|
(defn- pair [validator]
|
||||||
|
(def ast (validator :ast))
|
||||||
|
(def [_ patt] (ast :data))
|
||||||
|
(set (validator :ast) patt)
|
||||||
|
(pattern validator))
|
||||||
|
|
||||||
|
(defn- pattern* [validator]
|
||||||
|
# (print "PATTERN*")
|
||||||
|
(def ast (validator :ast))
|
||||||
|
(def type (ast :type))
|
||||||
|
# (print "validating pattern " type)
|
||||||
|
(cond
|
||||||
|
(has-value? terminals type) validator
|
||||||
|
(case type
|
||||||
|
:word (word-pattern validator)
|
||||||
|
:placeholder validator
|
||||||
|
:ignored validator
|
||||||
|
:word (word-pattern validator)
|
||||||
|
:list (simple-coll-pattern validator)
|
||||||
|
:tuple (simple-coll-pattern validator)
|
||||||
|
:dict (simple-coll-pattern validator)
|
||||||
|
:splat (splattern validator)
|
||||||
|
:typed (typed validator)
|
||||||
|
:interpolated (str-pattern validator)
|
||||||
|
:pair (pair validator)
|
||||||
|
)))
|
||||||
|
|
||||||
|
(set pattern pattern*)
|
||||||
|
|
||||||
|
# XXX: ensure guard includes only allowable names
|
||||||
|
# XXX: what to include here? (cf Elixir)
|
||||||
|
(defn- guard [validator])
|
||||||
|
|
||||||
|
(defn- match-clauses [validator clauses]
|
||||||
|
# (print "validating clauses in match-clauses")
|
||||||
|
(each clause clauses
|
||||||
|
(def parent (validator :ctx))
|
||||||
|
(def ctx @{:^parent parent})
|
||||||
|
(set (validator :ctx) ctx)
|
||||||
|
(def [lhs guard rhs] clause)
|
||||||
|
(set (validator :ast) lhs)
|
||||||
|
(pattern validator)
|
||||||
|
# (pp (validator :ctx))
|
||||||
|
# (pp (validator :ctx))
|
||||||
|
(when guard
|
||||||
|
(set (validator :ast) guard)
|
||||||
|
(validate validator))
|
||||||
|
(set (validator :ast) rhs)
|
||||||
|
(validate validator)
|
||||||
|
(set (validator :ctx) parent)))
|
||||||
|
|
||||||
|
(defn- matchh [validator]
|
||||||
|
# (print "validating in matchh")
|
||||||
|
(def ast (validator :ast))
|
||||||
|
(def [to-match clauses] (ast :data))
|
||||||
|
# (print "validating expression:")
|
||||||
|
# (pp to-match)
|
||||||
|
(set (validator :ast) to-match)
|
||||||
|
(validate validator)
|
||||||
|
# (print "validating clauses")
|
||||||
|
(match-clauses validator clauses)
|
||||||
|
validator)
|
||||||
|
|
||||||
|
(defn- declare [validator fnn]
|
||||||
|
(def status (validator :status))
|
||||||
|
(def declared (get status :declared @{}))
|
||||||
|
(set (declared fnn) true)
|
||||||
|
(set (status :declared) declared)
|
||||||
|
# (print "declared function " (fnn :name))
|
||||||
|
# (pp declared)
|
||||||
|
validator)
|
||||||
|
|
||||||
|
(defn- define [validator fnn]
|
||||||
|
(def status (validator :status))
|
||||||
|
(def declared (get status :declared @{}))
|
||||||
|
(set (declared fnn) nil)
|
||||||
|
(set (status :declared) declared)
|
||||||
|
# (print "defined function " (fnn :name))
|
||||||
|
# (pp declared)
|
||||||
|
validator)
|
||||||
|
|
||||||
|
(defn- fnn [validator]
|
||||||
|
(def ast (validator :ast))
|
||||||
|
(def name (ast :name))
|
||||||
|
# (print "function name: " name)
|
||||||
|
(def status (validator :status))
|
||||||
|
(def tail? (status :tail))
|
||||||
|
(set (status :tail) true)
|
||||||
|
(when name
|
||||||
|
(def ctx (validator :ctx))
|
||||||
|
(def resolved (ctx name))
|
||||||
|
(when (and resolved (not= :nothing (resolved :data)))
|
||||||
|
(def {:line line :input input} (get-in ctx [name :token]))
|
||||||
|
(array/push (validator :errors)
|
||||||
|
{:node ast :msg (string "name is already bound on line " line " of " input)}))
|
||||||
|
(when (and resolved (= :nothing (resolved :data)))
|
||||||
|
(define validator resolved))
|
||||||
|
(set (ctx name) ast))
|
||||||
|
(def data (ast :data))
|
||||||
|
(when (= data :nothing)
|
||||||
|
(break (declare validator ast)))
|
||||||
|
(match-clauses validator data)
|
||||||
|
(set (status :tail) tail?)
|
||||||
|
(def rest-arities @{})
|
||||||
|
(def arities @{:rest rest-arities})
|
||||||
|
(each clause data
|
||||||
|
# (print "CLAUSE:")
|
||||||
|
# (pp clause)
|
||||||
|
(def patt (first clause))
|
||||||
|
(def params (patt :data))
|
||||||
|
(def arity (length params))
|
||||||
|
# (print "checking clause with arity " arity)
|
||||||
|
(def rest-param? (and (> arity 0) (= :splat ((last params) :type))))
|
||||||
|
(if rest-param?
|
||||||
|
(set (rest-arities arity) true)
|
||||||
|
(set (arities arity) true)))
|
||||||
|
# (pp arities)
|
||||||
|
(set (ast :arities) arities)
|
||||||
|
validator)
|
||||||
|
|
||||||
|
(defn- ref [validator]
|
||||||
|
(def ast (validator :ast))
|
||||||
|
(def ctx (validator :ctx))
|
||||||
|
(def expr (ast :data))
|
||||||
|
(set (validator :ast) expr)
|
||||||
|
(validate validator)
|
||||||
|
(def name (ast :name))
|
||||||
|
(def resolved (ctx name))
|
||||||
|
(when resolved
|
||||||
|
(def {:line line :input input} (get-in ctx [name :token]))
|
||||||
|
(array/push (validator :errors)
|
||||||
|
{:node ast :msg (string "name is already bound on line " line " of " input)}))
|
||||||
|
(set (ctx name) ast)
|
||||||
|
validator)
|
||||||
|
|
||||||
|
(defn- interpolated [validator]
|
||||||
|
(def ast (validator :ast))
|
||||||
|
(def data (ast :data))
|
||||||
|
(each node data
|
||||||
|
(when (not (buffer? node))
|
||||||
|
(set (validator :ast) node)
|
||||||
|
(validate validator))))
|
||||||
|
|
||||||
|
### TODO:
|
||||||
|
# * [ ] ensure properties are on pkgs (if *only* pkgs from root)
|
||||||
|
|
||||||
|
(defn- pkg-root [validator]
|
||||||
|
# (print "validating pkg-root access")
|
||||||
|
(def ast (validator :ast))
|
||||||
|
(def ctx (validator :ctx))
|
||||||
|
(def terms (ast :data))
|
||||||
|
(def pkg-name ((first terms) :data))
|
||||||
|
(def the-pkg (resolve-name ctx pkg-name))
|
||||||
|
(when (not the-pkg)
|
||||||
|
(array/push (validator :errors)
|
||||||
|
{:node ast :msg "unbound pkg name"})
|
||||||
|
(break validator))
|
||||||
|
(def member (get terms 1))
|
||||||
|
(def accessed (case (member :type)
|
||||||
|
:keyword (get-in the-pkg [:pkg (member :data)])
|
||||||
|
:pkg-kw (get-in the-pkg [:pkg (member :data)])
|
||||||
|
:args (do
|
||||||
|
(array/push (validator :errors)
|
||||||
|
{:node member :msg "cannot call a pkg"}
|
||||||
|
(break validator)))))
|
||||||
|
(when (not accessed)
|
||||||
|
# (print "no member " (member :data) " on " pkg-name)
|
||||||
|
(array/push (validator :errors)
|
||||||
|
{:node member :msg "invalid pkg access"})
|
||||||
|
(break validator))
|
||||||
|
# TODO: validate nested pkg access
|
||||||
|
)
|
||||||
|
|
||||||
|
# (defn- tail-call [validator]
|
||||||
|
# (def ast (validator :ast))
|
||||||
|
# (when (ast :partial) (break validator))
|
||||||
|
# (def status (validator :status))
|
||||||
|
# (when (not (status :tail)) (break validator))
|
||||||
|
# (def data (ast :data))
|
||||||
|
# (def args (last data))
|
||||||
|
# (set (args :tail-call) true))
|
||||||
|
|
||||||
|
(defn- check-arity [validator]
|
||||||
|
# (print "CHECKING ARITY")
|
||||||
|
(def ast (validator :ast))
|
||||||
|
# (when (ast :partial) (break validator))
|
||||||
|
(def ctx (validator :ctx))
|
||||||
|
(def data (ast :data))
|
||||||
|
(def fn-word (first data))
|
||||||
|
# (pp fn-word)
|
||||||
|
(def the-fn (resolve-name ctx (fn-word :data)))
|
||||||
|
# (print "the called function: " the-fn)
|
||||||
|
# (pp the-fn)
|
||||||
|
(when (not the-fn) (break validator))
|
||||||
|
# (print "the function is not nil")
|
||||||
|
# (print "the function type is " (type the-fn))
|
||||||
|
(when (= :function (type the-fn)) (break validator))
|
||||||
|
(when (= :cfunction (type the-fn)) (break validator))
|
||||||
|
# (print "the function is not a janet fn")
|
||||||
|
# (print "fn type: " (the-fn :type))
|
||||||
|
(when (not= :fn (the-fn :type)) (break validator))
|
||||||
|
# (print "fn name: " (the-fn :name))
|
||||||
|
(def arities (the-fn :arities))
|
||||||
|
# when there aren't arities yet, break, since that means we're making a recursive function call
|
||||||
|
# TODO: enahnce this so that we can determine arities *before* all function bodies; this ensures arity-checking for self-recursive calls
|
||||||
|
(when (not arities) (break validator))
|
||||||
|
# (print "arities: ")
|
||||||
|
# (pp arities)
|
||||||
|
(def args (get data 1))
|
||||||
|
(def num-args (length (args :data)))
|
||||||
|
# (print "called with #args " num-args)
|
||||||
|
# (pp (get (validator :ctx) "bar"))
|
||||||
|
(when (has-key? arities num-args) (break validator))
|
||||||
|
# (print "arities: ")
|
||||||
|
# (pp arities)
|
||||||
|
(when (not arities) (break validator))
|
||||||
|
(def rest-arities (keys (arities :rest)))
|
||||||
|
(when (empty? rest-arities)
|
||||||
|
(array/push (validator :errors)
|
||||||
|
{:node ast :msg "mismatched arity"})
|
||||||
|
(break validator))
|
||||||
|
(def rest-min (min ;rest-arities))
|
||||||
|
(when (< num-args rest-min)
|
||||||
|
(array/push (validator :errors)
|
||||||
|
{:node ast :msg "mismatched arity"}))
|
||||||
|
validator)
|
||||||
|
|
||||||
|
(defn- kw-root [validator]
|
||||||
|
(def ast (validator :ast))
|
||||||
|
(def data (ast :data))
|
||||||
|
(def [_ args] data)
|
||||||
|
(when (not= :args (args :type))
|
||||||
|
(break (array/push (validator :errors)
|
||||||
|
{:node args :msg "called keyword expects an argument"})))
|
||||||
|
(when (not= 1 (length (args :data)))
|
||||||
|
(array/push (validator :errors)
|
||||||
|
{:node args :msg "called keywords take one argument"})))
|
||||||
|
|
||||||
|
(defn- synthetic [validator]
|
||||||
|
(def ast (validator :ast))
|
||||||
|
(def data (ast :data))
|
||||||
|
(def status (validator :status))
|
||||||
|
(def ftype ((first data) :type))
|
||||||
|
(def stype ((get data 1) :type))
|
||||||
|
(def ltype ((last data) :type))
|
||||||
|
(set (status :pkg-access?) nil)
|
||||||
|
(when (= ftype :pkg-name)
|
||||||
|
(set (status :pkg-access?) true))
|
||||||
|
(each node data
|
||||||
|
(set (validator :ast) node)
|
||||||
|
(validate validator))
|
||||||
|
(set (validator :ast) ast)
|
||||||
|
# (print "ftype " ftype)
|
||||||
|
# (print "stype " stype)
|
||||||
|
# (print "ltype " ltype)
|
||||||
|
(when (= ftype :pkg-name) (pkg-root validator))
|
||||||
|
(when (= ftype :keyword) (kw-root validator))
|
||||||
|
# (when (= ltype :args) (tail-call validator))
|
||||||
|
(when (and (= ftype :word) (= stype :args))
|
||||||
|
(check-arity validator))
|
||||||
|
validator)
|
||||||
|
|
||||||
|
(defn- pair [validator]
|
||||||
|
(def ast (validator :ast))
|
||||||
|
(def [k v] (ast :data))
|
||||||
|
(set (validator :ast) k)
|
||||||
|
(validate validator)
|
||||||
|
(set (validator :ast) v)
|
||||||
|
(validate validator))
|
||||||
|
|
||||||
|
(defn- splat [validator]
|
||||||
|
(def ast (validator :ast))
|
||||||
|
(when (get-in validator [:status :pkg])
|
||||||
|
(array/push (validator :errors)
|
||||||
|
{:node ast :msg "splats are not allowed in pkgs"})
|
||||||
|
(break validator))
|
||||||
|
(def data (ast :data))
|
||||||
|
(when data
|
||||||
|
(set (validator :ast) data)
|
||||||
|
(validate validator))
|
||||||
|
validator)
|
||||||
|
|
||||||
|
(defn- dict [validator]
|
||||||
|
(def ast (validator :ast))
|
||||||
|
(def data (ast :data))
|
||||||
|
(each node data
|
||||||
|
(set (validator :ast) node)
|
||||||
|
(validate validator))
|
||||||
|
validator)
|
||||||
|
|
||||||
|
(defn- whenn [validator]
|
||||||
|
(def ast (validator :ast))
|
||||||
|
(def data (ast :data))
|
||||||
|
(each node data
|
||||||
|
(def [lhs rhs] node)
|
||||||
|
(set (validator :ast) lhs)
|
||||||
|
(validate validator)
|
||||||
|
(set (validator :ast) rhs)
|
||||||
|
(validate validator))
|
||||||
|
validator)
|
||||||
|
|
||||||
|
# XXX: do this!
|
||||||
|
(defn- withh [validator])
|
||||||
|
|
||||||
|
# XXX: tail calls in last position
|
||||||
|
(defn- doo [validator]
|
||||||
|
(def ast (validator :ast))
|
||||||
|
(def data (ast :data))
|
||||||
|
(each node data
|
||||||
|
(set (validator :ast) node)
|
||||||
|
(validate validator))
|
||||||
|
validator)
|
||||||
|
|
||||||
|
(defn- usee [validator]
|
||||||
|
(def ast (validator :ast))
|
||||||
|
(def data (ast :data))
|
||||||
|
(set (validator :ast) data)
|
||||||
|
(validate validator)
|
||||||
|
(def name (data :data))
|
||||||
|
(def ctx (validator :ctx))
|
||||||
|
(def pkg (get-in ctx [name :pkg] @{}))
|
||||||
|
(loop [[k v] :pairs pkg]
|
||||||
|
(set (ctx (string k)) v))
|
||||||
|
validator)
|
||||||
|
|
||||||
|
(defn- pkg-entry [validator pkg]
|
||||||
|
(def ast (validator :ast))
|
||||||
|
(def status (validator :status))
|
||||||
|
(when (= :pkg-pair (ast :type))
|
||||||
|
(set (status :pkg-access?) true))
|
||||||
|
(def data (ast :data))
|
||||||
|
(def [key value] (ast :data))
|
||||||
|
# (print "PKG ENTRY***")
|
||||||
|
# (pp key)
|
||||||
|
# (pp value)
|
||||||
|
(set (validator :ast) key)
|
||||||
|
(validate validator)
|
||||||
|
(set (validator :ast) value)
|
||||||
|
(validate validator)
|
||||||
|
(def entry (if (= :pkg-name (value :type))
|
||||||
|
(resolve-name (validator :ctx) (string (value :data)))
|
||||||
|
value))
|
||||||
|
# (print "entry at " (key :data))
|
||||||
|
# (pp entry)
|
||||||
|
(set (status :pkg-access?) nil)
|
||||||
|
(def kw (key :data))
|
||||||
|
# (pp kw)
|
||||||
|
(set (pkg kw) entry)
|
||||||
|
# (pp pkg)
|
||||||
|
validator)
|
||||||
|
|
||||||
|
(defn- pkg [validator]
|
||||||
|
(def ast (validator :ast))
|
||||||
|
(def data (ast :data))
|
||||||
|
(def name (ast :name))
|
||||||
|
(def pkg @{})
|
||||||
|
(each node data
|
||||||
|
(set (validator :ast) node)
|
||||||
|
(pkg-entry validator pkg))
|
||||||
|
(set (ast :pkg) pkg)
|
||||||
|
# (print "THE PACKAGE")
|
||||||
|
# (pp pkg)
|
||||||
|
(def ctx (validator :ctx))
|
||||||
|
(set (ctx name) ast)
|
||||||
|
validator)
|
||||||
|
|
||||||
|
(defn- ns [validator]
|
||||||
|
(def ast (validator :ast))
|
||||||
|
(def data (ast :data))
|
||||||
|
(def name (ast :name))
|
||||||
|
(def parent (validator :ctx))
|
||||||
|
(def ctx @{:^parent parent})
|
||||||
|
(def block (data :data))
|
||||||
|
(each node block
|
||||||
|
(set (validator :ast) node)
|
||||||
|
(validate validator))
|
||||||
|
(set (ast :pkg) ctx)
|
||||||
|
(set (parent name) ast)
|
||||||
|
validator)
|
||||||
|
|
||||||
|
(defn- loopp [validator]
|
||||||
|
(def ast (validator :ast))
|
||||||
|
(def status (validator :status))
|
||||||
|
(def data (ast :data))
|
||||||
|
(def input (first data))
|
||||||
|
# (print "LOOP INPUT")
|
||||||
|
# (pp input)
|
||||||
|
(def clauses (get data 1))
|
||||||
|
(def input-arity (length (input :data)))
|
||||||
|
(set (ast :arity) input-arity)
|
||||||
|
# (print "input arity to loop " input-arity)
|
||||||
|
(set (validator :ast) input)
|
||||||
|
(validate validator)
|
||||||
|
# harmonize arities
|
||||||
|
(def rest-arities @{})
|
||||||
|
(each clause clauses
|
||||||
|
# (print "CLAUSE:")
|
||||||
|
# (pp clause)
|
||||||
|
(def patt (first clause))
|
||||||
|
(def params (patt :data))
|
||||||
|
(def clause-arity (length params))
|
||||||
|
# (print "checking clause with arity " clause-arity)
|
||||||
|
(def rest-param? (= :splat (get (last params) :type)))
|
||||||
|
(when (and
|
||||||
|
(not rest-param?) (not= clause-arity input-arity))
|
||||||
|
(array/push (validator :errors)
|
||||||
|
{:node patt :msg "arity mismatch"}))
|
||||||
|
(when rest-param?
|
||||||
|
(set (rest-arities clause-arity) patt)))
|
||||||
|
# (pp rest-arities)
|
||||||
|
(loop [[arity patt] :pairs rest-arities]
|
||||||
|
(when (< input-arity arity)
|
||||||
|
(array/push (validator :errors)
|
||||||
|
{:node patt :msg "arity mismatch"})))
|
||||||
|
(def loop? (status :loop))
|
||||||
|
(set (status :loop) input-arity)
|
||||||
|
(def tail? (status :tail))
|
||||||
|
(set (status :tail) true)
|
||||||
|
(match-clauses validator clauses)
|
||||||
|
(set (status :loop) loop?)
|
||||||
|
(set (status :tail) tail?)
|
||||||
|
validator)
|
||||||
|
|
||||||
|
(defn- recur [validator]
|
||||||
|
(def ast (validator :ast))
|
||||||
|
(def status (validator :status))
|
||||||
|
(def loop-arity (status :loop))
|
||||||
|
(when (not loop-arity)
|
||||||
|
(array/push (validator :errors)
|
||||||
|
{:node ast :msg "recur may only be used inside a loop"})
|
||||||
|
(break validator))
|
||||||
|
(def called-with (get-in ast [:data :data]))
|
||||||
|
(def recur-arity (length called-with))
|
||||||
|
# (print "loop arity " loop-arity)
|
||||||
|
# (print "recur arity" recur-arity)
|
||||||
|
(when (not= recur-arity loop-arity)
|
||||||
|
(array/push (validator :errors)
|
||||||
|
{:node ast :msg "recur must have the same number of args as its loop"}))
|
||||||
|
(when (not (status :tail))
|
||||||
|
(array/push (validator :errors)
|
||||||
|
{:node ast :msg "recur must be in tail position"}))
|
||||||
|
(set (validator :ast) (ast :data))
|
||||||
|
(validate validator))
|
||||||
|
|
||||||
|
(defn- repeatt [validator]
|
||||||
|
(def ast (validator :ast))
|
||||||
|
(def [times body] (ast :data))
|
||||||
|
(set (validator :ast) times)
|
||||||
|
(validate validator)
|
||||||
|
(set (validator :ast) body)
|
||||||
|
(validate validator))
|
||||||
|
|
||||||
|
(defn- panic [validator]
|
||||||
|
(def ast (validator :ast))
|
||||||
|
(def data (ast :data))
|
||||||
|
(set (validator :ast) data)
|
||||||
|
(validate validator))
|
||||||
|
|
||||||
|
(defn- testt [validator]
|
||||||
|
(def ast (validator :ast))
|
||||||
|
(def [_ body] (ast :data))
|
||||||
|
(set (validator :ast) body)
|
||||||
|
(validate validator))
|
||||||
|
|
||||||
|
(defn- pkg-name [validator]
|
||||||
|
(def ast (validator :ast))
|
||||||
|
(def name (ast :data))
|
||||||
|
(def ctx (validator :ctx))
|
||||||
|
(def pkg (resolve-name ctx name))
|
||||||
|
(when (not pkg)
|
||||||
|
(array/push (validator :errors)
|
||||||
|
{:node ast :msg "unbound name"}))
|
||||||
|
validator)
|
||||||
|
|
||||||
|
(defn- pkg-kw [validator]
|
||||||
|
# (print "validating pkg-kw")
|
||||||
|
(def ast (validator :ast))
|
||||||
|
(def pkg-access? (get-in validator [:status :pkg-access?]))
|
||||||
|
# (print "pkg-access? " pkg-access?)
|
||||||
|
(when (not pkg-access?)
|
||||||
|
(array/push (validator :errors)
|
||||||
|
{:node ast :msg "cannot use pkg-kw here"}))
|
||||||
|
validator)
|
||||||
|
|
||||||
|
(defn- pkg-pair [validator]
|
||||||
|
# (print "validating pkg-pair")
|
||||||
|
(def ast (validator :ast))
|
||||||
|
(def status (validator :status))
|
||||||
|
(def [_ pkg] (ast :data))
|
||||||
|
(set (status :pkg-access?) true)
|
||||||
|
(set (validator :ast) pkg)
|
||||||
|
(validate validator)
|
||||||
|
(set (status :pkg-access?) nil)
|
||||||
|
validator)
|
||||||
|
|
||||||
|
(defn- kw [validator]
|
||||||
|
(def status (validator :status))
|
||||||
|
(set (status :pkg-access?) nil)
|
||||||
|
validator)
|
||||||
|
|
||||||
|
(defn- validate* [validator]
|
||||||
|
(def ast (validator :ast))
|
||||||
|
(def type (ast :type))
|
||||||
|
# (print "validating node " type)
|
||||||
|
(cond
|
||||||
|
(has-value? terminals type) validator
|
||||||
|
(has-value? simple-colls type) (simple-coll validator)
|
||||||
|
(case type
|
||||||
|
:keyword (kw validator)
|
||||||
|
:if (iff validator)
|
||||||
|
:let (lett validator)
|
||||||
|
:script (script validator)
|
||||||
|
:block (block validator)
|
||||||
|
:word (word validator)
|
||||||
|
:fn (fnn validator)
|
||||||
|
:match (matchh validator)
|
||||||
|
:interpolated (interpolated validator)
|
||||||
|
:synthetic (synthetic validator)
|
||||||
|
:do (doo validator)
|
||||||
|
:dict (dict validator)
|
||||||
|
:test (testt validator)
|
||||||
|
:panic (panic validator)
|
||||||
|
:repeat (repeatt validator)
|
||||||
|
:when (whenn validator)
|
||||||
|
:splat (splat validator)
|
||||||
|
:pair (pair validator)
|
||||||
|
:pkg-pair (pkg-pair validator)
|
||||||
|
:ns (ns validator)
|
||||||
|
:pkg (pkg validator)
|
||||||
|
:pkg-name (pkg-name validator)
|
||||||
|
:pkg-kw (pkg-kw validator)
|
||||||
|
:use (usee validator)
|
||||||
|
:loop (loopp validator)
|
||||||
|
:recur (recur validator)
|
||||||
|
:ref (ref validator)
|
||||||
|
(error (string "unknown node type " type)))))
|
||||||
|
|
||||||
|
(set validate validate*)
|
||||||
|
|
||||||
|
(defn- cleanup [validator]
|
||||||
|
(def declared (get-in validator [:status :declared] {}))
|
||||||
|
(when (any? declared)
|
||||||
|
(each declaration declared
|
||||||
|
(array/push (validator :errors) {:node declaration :msg "declared fn, but not defined"})))
|
||||||
|
validator)
|
||||||
|
|
||||||
|
(defn valid [ast &opt ctx]
|
||||||
|
(default ctx @{})
|
||||||
|
(def validator (new-validator ast))
|
||||||
|
(def base-ctx @{:^parent ctx})
|
||||||
|
(set (validator :ctx) base-ctx)
|
||||||
|
(validate validator)
|
||||||
|
(cleanup validator))
|
||||||
|
|
||||||
|
(import ./base :as b)
|
||||||
|
|
||||||
|
# (do
|
||||||
|
(comment
|
||||||
|
(def source `
|
||||||
|
dec (12)
|
||||||
|
`)
|
||||||
|
(def scanned (s/scan source))
|
||||||
|
(def parsed (p/parse scanned))
|
||||||
|
(def validated (valid parsed b/ctx))
|
||||||
|
# (get-in validated [:status :declared])
|
||||||
|
# (validated :ctx)
|
||||||
|
)
|
||||||
5
src/watchy.fish
Executable file
5
src/watchy.fish
Executable file
|
|
@ -0,0 +1,5 @@
|
||||||
|
#!/opt/homebrew/bin/fish
|
||||||
|
|
||||||
|
set FILE $argv[1]
|
||||||
|
|
||||||
|
fd $FILE | entr ./judgy.fish /_
|
||||||
|
|
@ -1,7 +0,0 @@
|
||||||
& EXPECT (:true, :false, :true, :false)
|
|
||||||
let true_literal = if true then :true else :false
|
|
||||||
let false_literal = if false then :true else :false
|
|
||||||
let truthy = if :truthy then :true else :false
|
|
||||||
let falsy = if nil then :true else :false
|
|
||||||
|
|
||||||
(true_literal, false_literal, truthy, falsy)
|
|
||||||
|
|
@ -1,2 +0,0 @@
|
||||||
& EXPECT [:one, 2, "three"]
|
|
||||||
[:one, 2, "three"]
|
|
||||||
|
|
@ -1,2 +0,0 @@
|
||||||
& EXPECT 12.123
|
|
||||||
12.123
|
|
||||||
|
|
@ -1,2 +0,0 @@
|
||||||
& EXPECT 42
|
|
||||||
42
|
|
||||||
|
|
@ -1,2 +0,0 @@
|
||||||
& EXPECT "foo"
|
|
||||||
"foo"
|
|
||||||
|
|
@ -1,2 +0,0 @@
|
||||||
& EXPECT (true, false, nil)
|
|
||||||
(true, false, nil)
|
|
||||||
|
|
@ -1,7 +0,0 @@
|
||||||
(ns ludus.core-test
|
|
||||||
(:require [clojure.test :refer :all]
|
|
||||||
[cludus.core :refer :all]))
|
|
||||||
|
|
||||||
(deftest a-test
|
|
||||||
(testing "FIXME, I fail."
|
|
||||||
(is (= 0 1))))
|
|
||||||
|
|
@ -1,30 +0,0 @@
|
||||||
import {run} from "../target/js/ludus.js"
|
|
||||||
import * as fs from "node:fs/promises"
|
|
||||||
import t from "tap"
|
|
||||||
|
|
||||||
const case_path = "./cases"
|
|
||||||
const files = await fs.readdir(case_path)
|
|
||||||
|
|
||||||
for (const file of files) {
|
|
||||||
const source = await fs.readFile(`${case_path}/${file}`, {encoding: "utf8"})
|
|
||||||
const first_line = source.split("\n")[0]
|
|
||||||
const expected = first_line.split("EXPECT")[1].trim()
|
|
||||||
if (expected === "PANIC") expect_panic(file, source)
|
|
||||||
else expect_result(file, source, expected)
|
|
||||||
}
|
|
||||||
|
|
||||||
function expect_panic(file, source) {
|
|
||||||
const result = run(source).errors[0]
|
|
||||||
t.test(`testing ${file}: EXPECT PANIC`, t => {
|
|
||||||
t.ok(result)
|
|
||||||
t.end()
|
|
||||||
})
|
|
||||||
}
|
|
||||||
|
|
||||||
function expect_result(file, source, expected) {
|
|
||||||
const result = run(source).result
|
|
||||||
t.test(`testing ${file}: EXPECT ${expected}, GOT ${result}`, t => {
|
|
||||||
t.equal(expected, result)
|
|
||||||
t.end()
|
|
||||||
})
|
|
||||||
}
|
|
||||||
47
tokens
47
tokens
|
|
@ -1,47 +0,0 @@
|
||||||
TOKENS:
|
|
||||||
|
|
||||||
:nil
|
|
||||||
:true
|
|
||||||
:false
|
|
||||||
:word
|
|
||||||
:keyword
|
|
||||||
:number
|
|
||||||
:string
|
|
||||||
|
|
||||||
:as
|
|
||||||
:cond
|
|
||||||
:do
|
|
||||||
:else
|
|
||||||
:fn
|
|
||||||
:if
|
|
||||||
:import
|
|
||||||
:let
|
|
||||||
:loop
|
|
||||||
:ref
|
|
||||||
:then
|
|
||||||
:with
|
|
||||||
|
|
||||||
:receive
|
|
||||||
:spawn
|
|
||||||
:repeat
|
|
||||||
:test
|
|
||||||
:when
|
|
||||||
|
|
||||||
:lparen
|
|
||||||
:rparen
|
|
||||||
:lbrace
|
|
||||||
:rbrace
|
|
||||||
:lbracket
|
|
||||||
:rbracket
|
|
||||||
:semicolon
|
|
||||||
:comma
|
|
||||||
:newline
|
|
||||||
:backslash
|
|
||||||
:equals
|
|
||||||
:pipeline
|
|
||||||
:rarrow
|
|
||||||
:startdict
|
|
||||||
:startstruct
|
|
||||||
:startset
|
|
||||||
:splat
|
|
||||||
:eof
|
|
||||||
Loading…
Reference in New Issue
Block a user