twc/ludus
4
0
Fork 0
Code Issues 32 Pull Requests Packages Projects 8 Releases Wiki Activity

complete fucking draft of janet/wasm interpreter

Browse Source
This commit is contained in:
Scott Richmond 2024-06-06 18:47:04 -04:00
parent baba0f4977
commit cc33a2fb3d
71 changed files with 61269 additions and 5165 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitignore vendored
View File

@ -32,4 +32,4 @@ target/repl-port
.repl-buffer .repl-buffer
.repl-buffer.janet .repl-buffer.janet
.env .env
janet/jpm_tree src/jpm_tree

24
CHANGELOG.md
View File

@ -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
View File

@ -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

8
assets/index.html
View File

@ -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
View 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
View File

File diff suppressed because it is too large Load Diff

2277
build/janet.h Normal file
View File

File diff suppressed because it is too large Load Diff

15
build/justfile Normal file
View 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
View File

Binary file not shown.

8
build/ludus.mjs Normal file
View 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
View File

File diff suppressed because it is too large Load Diff

BIN
build/out.wasm Executable file
View File

Binary file not shown.

11
build/test.mjs Normal file
View 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)

42
clj_to_janet.md
View File

@ -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

10
computer_class.md
View File

@ -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
View File

@ -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}}}}

2
foo.ld
View File

@ -1,2 +0,0 @@
& EXPECT "foo"
"foo"

7
graal-compile.sh
View File

@ -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
View File

@ -1,7 +1,3 @@
# build clojurescript release
build:
shadow-cljs release module
# open a janet repl in a different os window # open a janet repl in a different os window
repl: repl:
kitten @ launch --type=os-window --allow-remote-control --cwd=current --title=hx_repl:ludus --keep-focus kitten @ launch --type=os-window --allow-remote-control --cwd=current --title=hx_repl:ludus --keep-focus

19
ludus.sublime-project
View File

@ -1,19 +0,0 @@
{
"folders":
[
{
"path": "."
}
],
"settings": {
"on_post_save_project": [
{
"command": "exec",
"args": {
"shell_cmd": "lein cljfmt fix"
},
"scope": "window"
}
]
}
}

14
package.json
View File

@ -1,16 +1,16 @@
{ {
"name": "@ludus/ludus-js-pure", "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.", "description": "A Ludus interpreter in a pure JS function.",
"main": "target/js/ludus.js",
"type": "module", "type": "module",
"main": "build/ludus.mjs",
"directories": {}, "directories": {},
"keywords": [], "keywords": [],
"author": "Scott Richmond", "author": "Scott Richmond",
"license": "GPL-3.0", "license": "GPL-3.0",
"files": ["target/js/*"], "files": [
"devDependencies": { "build/out.wasm",
"shadow-cljs": "^2.26.0", "build/out.mjs",
"tap": "^18.6.1" "build/ludus.mjs"],
} "devDependencies": {}
} }

0
janet/postlude.ld → postlude.ld
View File

0
janet/prelude.ld → prelude.ld
View File

14
project.clj
View File

@ -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
View File

@ -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)

18
shadow-cljs.edn
View File

@ -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}}}}}

24
janet/base.janet → src/base.janet
View File

@ -71,6 +71,30 @@
:pkg (show-pkg x) :pkg (show-pkg x)
(stringify 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] (defn show-patt [x]
(case (x :type) (case (x :type)
:nil "nil" :nil "nil"

4
janet/errors.janet → src/errors.janet
View File

@ -1,6 +1,4 @@
(import spork/json :as j) (import /src/base :as b)
(try (os/cd "janet") ([_] nil))
(import /base :as b)
(defn- get-line [source line] (defn- get-line [source line]
((string/split "\n" source) (dec line))) ((string/split "\n" source) (dec line)))

53
janet/interpreter.janet → src/interpreter.janet
View File

@ -1,9 +1,6 @@
# A tree walk interpreter for ludus # A tree walk interpreter for ludus
# for repl imports (import /src/base :as b)
(try (os/cd "janet") ([_] nil))
(import ./base :as b)
(var interpret nil) (var interpret nil)
(var match-pattern nil) (var match-pattern nil)
@ -622,33 +619,33 @@
(set interpret interpret*) (set interpret interpret*)
# repl # # repl
(import ./scanner :as s) # (import ./scanner :as s)
(import ./parser :as p) # (import ./parser :as p)
(import ./validate :as v) # (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 [] # (defn run []
(def scanned (s/scan source)) # (def scanned (s/scan source))
(when (has-errors? scanned) (break (scanned :errors))) # (when (has-errors? scanned) (break (scanned :errors)))
(def parsed (p/parse scanned)) # (def parsed (p/parse scanned))
(when (has-errors? parsed) (break (parsed :errors))) # (when (has-errors? parsed) (break (parsed :errors)))
(def validated (v/valid parsed b/ctx)) # (def validated (v/valid parsed b/ctx))
# (when (has-errors? validated) (break (validated :errors))) # # (when (has-errors? validated) (break (validated :errors)))
# (def cleaned (get-in parsed [:ast :data 1])) # # (def cleaned (get-in parsed [:ast :data 1]))
# # (pp cleaned) # # # (pp cleaned)
# (interpret (parsed :ast) @{:^parent b/ctx}) # # (interpret (parsed :ast) @{:^parent b/ctx})
(try (interpret (parsed :ast) @{:^parent b/ctx}) # (try (interpret (parsed :ast) @{:^parent b/ctx})
([e] (if (struct? e) (error (e :msg)) (error e))))) # ([e] (if (struct? e) (error (e :msg)) (error e)))))
# (do # # (do
(comment # (comment
(set source ` # (set source `
`) # `)
(def result (run)) # (def result (run))
) # )

0
janet/judge → src/judge
View File

0
janet/judgy.fish → src/judgy.fish
View File

0
janet/language.test.janet → src/language.test.janet
View File

25
janet/ludus.janet → src/ludus.janet
View File

@ -1,17 +1,16 @@
# an integrated Ludus interpreter # an integrated Ludus interpreter
# devised in order to run under wasm # devised in order to run under wasm
# takes a string, returns a string with a json object # takes a string, returns a string with a json object
(try (os/cd "janet") ([_] nil)) # for REPL # (try (os/cd "janet") ([_] nil)) # for REPL
(import /scanner :as s) (import /src/scanner :as s)
(import /parser :as p) (import /src/parser :as p)
(import /validate :as v) (import /src/validate :as v)
(import /interpreter :as i) (import /src/interpreter :as i)
(import /errors :as e) (import /src/errors :as e)
(import /base :as b) (import /src/base :as b)
(import /prelude :as prelude) (import /src/prelude :as prelude)
(import spork/json :as j)
(defn run [source] (defn ludus [source]
(when (= :error prelude/pkg) (error "could not load prelude")) (when (= :error prelude/pkg) (error "could not load prelude"))
(def ctx @{:^parent prelude/ctx}) (def ctx @{:^parent prelude/ctx})
(def errors @[]) (def errors @[])
@ -45,11 +44,13 @@
(set (out :errors) [err]) (set (out :errors) [err])
(break out))) (break out)))
(setdyn :out stdout) (setdyn :out stdout)
(set (out :result) result) (set (out :result) (b/show result))
(var post @{}) (var post @{})
(try (try
(set post (i/interpret prelude/post/ast ctx)) (set post (i/interpret prelude/post/ast ctx))
([err] (e/runtime-error err))) ([err] (e/runtime-error err)))
(set (out :draw) (post :draw)) (set (out :draw) (post :draw))
(j/encode out)) (b/json out))
(defn hello [] (print "hello"))

2
src/ludus/ast.cljc
View File

@ -1,2 +0,0 @@
(ns ludus.ast)

434
src/ludus/base.cljc
View File

@ -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
src/ludus/collections.cljc
View File

@ -1 +0,0 @@
(ns ludus.collections)

38
src/ludus/core.clj
View File

@ -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)))

2
src/ludus/data.cljc
View File

@ -1,2 +0,0 @@
(ns ludus.data)

126
src/ludus/doc.cljc
View File

@ -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 "&nbsp;&nbsp;&nbsp; " (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 "&nbsp;&nbsp;&nbsp; "))
"\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)

15
src/ludus/draw.cljs
View 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 {
})

46
src/ludus/error.cljc
View File

@ -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)
)))

273
src/ludus/grammar.cljc
View File

@ -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)])

273
src/ludus/grammar.janet
View File

@ -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)])

1072
src/ludus/interpreter.cljc
View File

File diff suppressed because it is too large Load Diff

16
src/ludus/loader.clj
View File

@ -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)))))

79
src/ludus/node.cljc
View 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)

316
src/ludus/parser.cljc
View File

@ -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))))

25
src/ludus/postlude.ld
View File

@ -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)
}

15
src/ludus/prelude.cljc
View File

@ -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
View File

File diff suppressed because it is too large Load Diff

118
src/ludus/repl.clj
View File

@ -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)))

336
src/ludus/scanner.cljc
View File

@ -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))))))

122
src/ludus/show.cljc
View File

@ -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))
)

11
src/ludus/token.cljc
View File

@ -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})

44
src/ludus/web.cljs
View File

@ -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)

3
janet/parser.janet → src/parser.janet
View File

@ -1,8 +1,7 @@
### A recursive descent parser for Ludus ### A recursive descent parser for Ludus
### We still need to scan some things ### We still need to scan some things
(try (os/cd "janet") ([_] nil)) # when in repl to do relative imports (import /src/scanner :as s)
(import ./scanner :as s)
(defmacro declare (defmacro declare
"Forward-declares a function name, so that it can be called in a mutually recursive manner." "Forward-declares a function name, so that it can be called in a mutually recursive manner."

13
janet/prelude.janet → src/prelude.janet
View File

@ -1,10 +1,9 @@
(try (os/cd "janet") ([_] nil)) (import /src/base :as b)
(import /base :as b) (import /src/scanner :as s)
(import /scanner :as s) (import /src/parser :as p)
(import /parser :as p) (import /src/validate :as v)
(import /validate :as v) (import /src/interpreter :as i)
(import /interpreter :as i) (import /src/errors :as e)
(import /errors :as e)
(def pkg (do (def pkg (do
(def pre-ctx @{:^parent {"base" b/base}}) (def pre-ctx @{:^parent {"base" b/base}})

0
janet/prelude.test.janet → src/prelude.test.janet
View File

4
janet/project.janet → src/project.janet
View File

@ -2,4 +2,8 @@
:dependencies [ :dependencies [
{:url "https://github.com/ianthehenry/judge.git" {:url "https://github.com/ianthehenry/judge.git"
:tag "v2.8.1"} :tag "v2.8.1"}
{:url "https://github.com/janet-lang/spork"}
]) ])
(declare-source
:source ["ludus.janet"])

6
janet/scanner.janet → src/scanner.janet
View File

@ -341,9 +341,3 @@
(recur (-> scanner (scan-token) (next-token))))) (recur (-> scanner (scan-token) (next-token)))))
(recur (new-scanner source input))) (recur (new-scanner source input)))
# (def source `
# a :b "c"
# & thing
# `)
# (pp ((scan source) :tokens))

0
janet/validate.janet → src/validate.janet
View File

0
janet/watchy.fish → src/watchy.fish
View File

7
test/cases/if.ld
View File

@ -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)

2
test/cases/list_atoms.ld
View File

@ -1,2 +0,0 @@
& EXPECT [:one, 2, "three"]
[:one, 2, "three"]

2
test/cases/single_float.ld
View File

@ -1,2 +0,0 @@
& EXPECT 12.123
12.123

2
test/cases/single_int.ld
View File

@ -1,2 +0,0 @@
& EXPECT 42
42

2
test/cases/single_string.ld
View File

@ -1,2 +0,0 @@
& EXPECT "foo"
"foo"

2
test/cases/tuple_keywords.ld
View File

@ -1,2 +0,0 @@
& EXPECT (true, false, nil)
(true, false, nil)

7
test/ludus/core_test.clj
View File

@ -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))))

30
test/run_tests.js
View File

@ -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
View File

@ -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