complete fucking draft of janet/wasm interpreter
This commit is contained in:
parent
baba0f4977
commit
cc33a2fb3d
2
.gitignore
vendored
2
.gitignore
vendored
|
@ -32,4 +32,4 @@ target/repl-port
|
|||
.repl-buffer
|
||||
.repl-buffer.janet
|
||||
.env
|
||||
janet/jpm_tree
|
||||
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)
|
|
@ -1,42 +0,0 @@
|
|||
# From Clojure to Janet
|
||||
## How to convert files
|
||||
|
||||
### Comments
|
||||
`% s ; r # <esc>`
|
||||
|
||||
|
||||
### called keyword property access
|
||||
Use a macro:
|
||||
- Select `\ \( : ret <esc>`
|
||||
- Record the macro: `Q n <esc> v e c get <esc> e e a <space> <esc> p <esc> Q`
|
||||
- Then just `q` until you've changed everything
|
||||
|
||||
### Chars don't exist
|
||||
- \char -> "char", e.g.
|
||||
- \newline -> "\n", etc.
|
||||
- \a -> "a"
|
||||
|
||||
### Use mutable arrays and tables
|
||||
Where data structures are mutable, add `@`s.
|
||||
|
||||
### Sets & tables
|
||||
Sets don't exist in Janet. Use tables with values set to `true`.
|
||||
|
||||
### Strings -> number literals
|
||||
- Clj uses `edn/read-string`; Janet uses `parse-all`
|
||||
|
||||
### `loop` -> `defn recur`
|
||||
- Clj's `loop` is very different from Janet's `loop`
|
||||
- As a quick and dirty workaround, change it to an interior recursive function
|
||||
- Janet has tail calls, so this is nearly as efficient (paying the overhead for creating the function)
|
||||
- An optimization is to pull out these functions and declare them at the toplevel
|
||||
|
||||
### current-char
|
||||
|
||||
|
||||
### Straight replacements:
|
||||
- nth -> get
|
||||
- assoc -> put
|
||||
- conj -> array/push
|
||||
- str -> string
|
||||
- substr -> slice
|
|
@ -1,10 +0,0 @@
|
|||
# TODO for Computer Class
|
||||
|
||||
* Devise graphics protocol
|
||||
- Untether from p5
|
||||
- Devise SVG situation
|
||||
- Save code to SVG
|
||||
- Load code from SVG
|
||||
* Find interfaces for stdin, out, err
|
||||
* Coroutines
|
||||
* State w/ refs
|
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
|
4
justfile
4
justfile
|
@ -1,7 +1,3 @@
|
|||
# build clojurescript release
|
||||
build:
|
||||
shadow-cljs release module
|
||||
|
||||
# open a janet repl in a different os window
|
||||
repl:
|
||||
kitten @ launch --type=os-window --allow-remote-control --cwd=current --title=hx_repl:ludus --keep-focus
|
||||
|
|
|
@ -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,16 +1,16 @@
|
|||
{
|
||||
"name": "@ludus/ludus-js-pure",
|
||||
"version": "0.1.0-alpha.8",
|
||||
"version": "0.1.0-alpha.10",
|
||||
"description": "A Ludus interpreter in a pure JS function.",
|
||||
"main": "target/js/ludus.js",
|
||||
"type": "module",
|
||||
"main": "build/ludus.mjs",
|
||||
"directories": {},
|
||||
"keywords": [],
|
||||
"author": "Scott Richmond",
|
||||
"license": "GPL-3.0",
|
||||
"files": ["target/js/*"],
|
||||
"devDependencies": {
|
||||
"shadow-cljs": "^2.26.0",
|
||||
"tap": "^18.6.1"
|
||||
}
|
||||
"files": [
|
||||
"build/out.wasm",
|
||||
"build/out.mjs",
|
||||
"build/ludus.mjs"],
|
||||
"devDependencies": {}
|
||||
}
|
||||
|
|
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/run-test}}}
|
||||
}
|
||||
:browser {:target :browser
|
||||
:output-dir "target/js"
|
||||
:asset-path "target"
|
||||
:modules {:main {:init-fn ludus.web/init}}}}}
|
|
@ -71,6 +71,30 @@
|
|||
: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"
|
|
@ -1,6 +1,4 @@
|
|||
(import spork/json :as j)
|
||||
(try (os/cd "janet") ([_] nil))
|
||||
(import /base :as b)
|
||||
(import /src/base :as b)
|
||||
|
||||
(defn- get-line [source line]
|
||||
((string/split "\n" source) (dec line)))
|
|
@ -1,9 +1,6 @@
|
|||
# A tree walk interpreter for ludus
|
||||
|
||||
# for repl imports
|
||||
(try (os/cd "janet") ([_] nil))
|
||||
|
||||
(import ./base :as b)
|
||||
(import /src/base :as b)
|
||||
|
||||
(var interpret nil)
|
||||
(var match-pattern nil)
|
||||
|
@ -622,33 +619,33 @@
|
|||
|
||||
(set interpret interpret*)
|
||||
|
||||
# repl
|
||||
(import ./scanner :as s)
|
||||
(import ./parser :as p)
|
||||
(import ./validate :as v)
|
||||
# # repl
|
||||
# (import ./scanner :as s)
|
||||
# (import ./parser :as p)
|
||||
# (import ./validate :as v)
|
||||
|
||||
(var source nil)
|
||||
# (var source nil)
|
||||
|
||||
(defn- has-errors? [{:errors errors}] (and errors (not (empty? errors))))
|
||||
# (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)))))
|
||||
# (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 `
|
||||
# # (do
|
||||
# (comment
|
||||
# (set source `
|
||||
|
||||
`)
|
||||
(def result (run))
|
||||
)
|
||||
# `)
|
||||
# (def result (run))
|
||||
# )
|
||||
|
|
@ -1,17 +1,16 @@
|
|||
# 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 /scanner :as s)
|
||||
(import /parser :as p)
|
||||
(import /validate :as v)
|
||||
(import /interpreter :as i)
|
||||
(import /errors :as e)
|
||||
(import /base :as b)
|
||||
(import /prelude :as prelude)
|
||||
(import spork/json :as j)
|
||||
# (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 run [source]
|
||||
(defn ludus [source]
|
||||
(when (= :error prelude/pkg) (error "could not load prelude"))
|
||||
(def ctx @{:^parent prelude/ctx})
|
||||
(def errors @[])
|
||||
|
@ -45,11 +44,13 @@
|
|||
(set (out :errors) [err])
|
||||
(break out)))
|
||||
(setdyn :out stdout)
|
||||
(set (out :result) result)
|
||||
(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))
|
||||
(j/encode out))
|
||||
(b/json out))
|
||||
|
||||
(defn hello [] (print "hello"))
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
(ns ludus.ast)
|
||||
|
|
@ -1,434 +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 refs (atom {})) ;; atom not volatile!, maybe we'll be multithreaded someday
|
||||
|
||||
(def deref- {:name "deref"
|
||||
::data/type ::data/clj
|
||||
:body (fn [ref]
|
||||
(if (::data/ref ref)
|
||||
(get @refs (::data/name 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)
|
||||
(do
|
||||
(swap! refs assoc (::data/name ref) value)
|
||||
(reset! (::data/value ref) value)
|
||||
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)])
|
||||
|
|
@ -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,79 +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
|
||||
state @base/refs
|
||||
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 :state state)
|
||||
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 test-run [source] (run source true))
|
||||
|
||||
(do
|
||||
|
||||
(def source "
|
||||
|
||||
add (1, 2)
|
||||
|
||||
")
|
||||
(-> source run :result)
|
||||
|
||||
)
|
||||
|
||||
(+ 1 2)
|
|
@ -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,25 +0,0 @@
|
|||
& this file runs after any given interpretation
|
||||
& even if the original interpretation panics
|
||||
& 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
|
||||
|
||||
if turtle_state() :visible? then render_turtle! () else nil
|
||||
|
||||
reset_turtle! ()
|
||||
|
||||
let console_msgs = flush! ()
|
||||
|
||||
let (r, g, b, a) = deref (bgcolor)
|
||||
make! (bgcolor, colors :black)
|
||||
|
||||
let draw_calls = deref (p5_calls)
|
||||
make! (p5_calls, [])
|
||||
|
||||
#{
|
||||
& :result result is provided elsewhere
|
||||
& :errors [] & if we get here there are no errors
|
||||
:console console_msgs
|
||||
:draw concat (
|
||||
[(:background, r, g, b, a), (:stroke, 255, 255, 255, 255)]
|
||||
draw_calls)
|
||||
}
|
|
@ -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")
|
||||
))
|
1303
src/ludus/prelude.ld
1303
src/ludus/prelude.ld
File diff suppressed because it is too large
Load Diff
|
@ -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)
|
||||
|
|
@ -1,8 +1,7 @@
|
|||
### A recursive descent parser for Ludus
|
||||
|
||||
### We still need to scan some things
|
||||
(try (os/cd "janet") ([_] nil)) # when in repl to do relative imports
|
||||
(import ./scanner :as s)
|
||||
(import /src/scanner :as s)
|
||||
|
||||
(defmacro declare
|
||||
"Forward-declares a function name, so that it can be called in a mutually recursive manner."
|
|
@ -1,10 +1,9 @@
|
|||
(try (os/cd "janet") ([_] nil))
|
||||
(import /base :as b)
|
||||
(import /scanner :as s)
|
||||
(import /parser :as p)
|
||||
(import /validate :as v)
|
||||
(import /interpreter :as i)
|
||||
(import /errors :as e)
|
||||
(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}})
|
|
@ -2,4 +2,8 @@
|
|||
:dependencies [
|
||||
{:url "https://github.com/ianthehenry/judge.git"
|
||||
:tag "v2.8.1"}
|
||||
{:url "https://github.com/janet-lang/spork"}
|
||||
])
|
||||
|
||||
(declare-source
|
||||
:source ["ludus.janet"])
|
|
@ -341,9 +341,3 @@
|
|||
(recur (-> scanner (scan-token) (next-token)))))
|
||||
(recur (new-scanner source input)))
|
||||
|
||||
# (def source `
|
||||
# a :b "c"
|
||||
# & thing
|
||||
# `)
|
||||
|
||||
# (pp ((scan source) :tokens))
|
|
@ -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