Compare commits

..

9 Commits

Author SHA1 Message Date
Scott Richmond
f5b34e3bc6 release build 2025-07-07 00:12:36 -04:00
Scott Richmond
3946e5d6fa locate new prelude 2025-07-07 00:12:01 -04:00
Scott Richmond
2c10c5bf07 actually add doc 2025-07-07 00:10:58 -04:00
Scott Richmond
49bb50ada1 build a doc file, bring in some other documentation 2025-07-07 00:10:37 -04:00
Scott Richmond
79720ba833 moar cleanup 2025-07-06 23:31:12 -04:00
Scott Richmond
f9ff565db1 clean up files 2025-07-06 23:30:14 -04:00
Scott Richmond
2353b6eb9a bring in old janet interpreter for doc purposes 2025-07-06 23:14:32 -04:00
Scott Richmond
d20c453180 old->new prelude 2025-07-06 23:14:01 -04:00
Scott Richmond
a444f789f3 add new actor functions 2025-07-06 19:40:55 -04:00
36 changed files with 7638 additions and 5048 deletions

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

459
doc/introduction.md Normal file
View File

@ -0,0 +1,459 @@
# Ludus for programmers
## A brief introduction
Ludus is mostly understood by its research and design team as a language for _learners_.
It is a _pedagogical_ language, whose primary purpose is to lead students to critical encounters with the history and present of computing.
The design principles, then, lead with learnability as well as making certain key examples in the history of computing easy.
Because of that, Ludus has some weird features.
It will likely not feel especially familiar, particularly if you have not written funtional code before.
We encourage you to feel disoriented by it, and to lean into that disorientation.
Instead of trying to write code like you have in the past, write code like Ludus wants you to.
There are two big influences on Ludus.
In terms of historical languages, Ludus draws a lot from Logo and Scheme.
In terms of contemporary languages, Ludus has deep affinities with Elixir and Clojure.
To put it in an abstraction cluster, Ludus is a dynamically typed, extremely strict functional programming language with persistent data structures, deep immutability, and pattern matching.
None of these are especially mainstream.
It is not "batteries included," but rather offers a quite minimalistic set of capabilities.
These are devised, as I noted above, to make encountering key concepts from the history of comptuing easy.
But beyond that, Ludus is extremely minimal, in the tradition of Scheme and Logo.
The profound pedagogical perspective behind Scheme and Logo is that building the things you want is an important motivator for learning how to make computers do things.
Ludus follows in this path.
If you've mostly written object-oriented code, Ludus will, frankly, feel weird.
And that's awesome.
### Ludus is expression based
Ludus has no statements, only expressions.
Every expression returns a value, including conditional forms like `if`, `when`, and `match`.
In Ludus, different types of expressions are called _forms_, riffing on the grand Lisp tradition.
### Ludus is dynamically typed
Like its inspirations, Elixir and Clojure and the whole family of Lisps, Ludus is dynamically typed.
It is _strictly_ typed, however.
Unlike Javascript, Ludus will never convert between values of one type or another.
Ludus has the following types:
* `:nil`: The type of `nil`, Ludus's name for nothing.
* `:bool`: Boolean--`true` or `false`.
* `:number`: IEEE-754 64-bit floating point numbers. Ludus does not have an integer type. That said, Ludus avoids `NaN` as much as possible.
* `:string`: UTF-8 strings.
* `:keyword`: Keywords are self-identical atoms, evaluating only to themselves. The equivalent of a `Symbol` in Javascript (or a keyword in Clojure or Elixir). (The types in this list--and in Ludus--are represented as keywords.)
* `:tuple`: Fixed-length, fully immutable collections of zero or more values. Tuples are comma-or-newline separated values, surrounded by parentheses: `(1, 2, 3)`.
* `:list`: Persistent, immutable ordered list of any number of Ludus values. Lists are comma-or-newline separated values, surrounded by square brackets: `[:foo, :bar, :baz]`.
* `:dict`: Persistent, immutable associative collection of keyword keys and any Ludus values. Dicts are comma-or-newline separated keyword-and-value pairs, introduced by `#{` and closed with a curly brace: `#{:a 1, :b 2}`.
* `:fn`: Functions!
* `:box`: A holder for any value, which can change over time. A cognate of Clojure's atom. This is the only place in Ludus you will find mutable state.
At current, three other types are planned but not implemented: `:set`, `:pkg`, `:process`.
Ludus does not allow creating new types.
### Ludus has a weird comment character
It uses the ampersand--`&`--to introduce comments.
It does not have mulitline comments.
### Ludus does not have variables, it has bindings
The basic form of assignment in Ludus looks very familiar:
```
let foo = 42
let bar = :quux
let baz = "hello, world"
```
These are _let bindings_.
#### Let bindings are extremely immutable
They may not change.
In addition, you may not shadow let bindings.
You may not shadow a binding, like in Rust, where you can re-use the name and discard the old binding.
You may also not bind the same name in a nested scope (e.g., inside a function).
Once you bind a name, it is forever bound to that value.
The value in this is that language learners need (almost) never wonder what value a name is bound to, since it can never change.
Except, of course, with function calls.
#### The left-hand side of a let binding is a _pattern_
Ludus makes extensive use of pattern matching.
The left-hand side of a let binding need not be a simple name.
A simple name is only one kind of pattern.
For example, this is valid Ludus:
```
let foo = 42
let 42 = foo
let nil = nil
```
The second line does nothing _except_ match the value on the left hand side to the value on the right hand side.
If a let binding does not match, e.g., `let 1 = 2`, then Ludus will panic.
Patterns can also be used to destructure all Ludus collections:
```
let (:ok, x) = (:ok, 42) & tuple pattern: x is now 42
let [l, m, ...] = [1, 2, 3] & list pattern: l = 1, m = 2
let #{a, b} = #{:a 1, :b 2} & dict pattern: a = 1, b = 2
```
#### Collection patterns are exact & complete, unless otherwise specified
In the second line in the example above, the pattern `[l, m, ...]` includes a splat pattern (or splattern).
If we had written `let [l, m] = [1, 2, 3]`, Ludus would have panicked with `no match`.
There are three list members on the right, only two on the left.
The splat, `...` (or ellipsis) matches "anything else in the list."
You may also include a name after the splat, which will be bound to "anything else in the list," e.g.
```
let [head, ...tail] = [1, 2, 3, 4, 5]
head &=> 1
tail &=> [2, 3, 4, 5]
```
#### The placeholder is a special pattern
A placholder pattern, `_`, matches against anything but does not bind a name.
Also, you may name your placholders, e.g., `_ignored`, but that is for the programmer only.
Named or unnamed placeholder patterns are strictly equivalent.
### Ludus panics
Ludus has exactly one type of runtime error: a panic.
Panics will always crash the program.
You cannot `catch` a panic.
You can raise a panic thusly:
```
panic! "oh shit"
```
`panic!` may only take a single value, but that value can be a collection.
**Eventually** (not long from now!), Ludus will have actor-style concurrency, and a panic will only bring down a process.
But this is not yet implemented.
### Almost everything is a function
Ludus does not have operators.
In the grand Lisp tradition, all operations look like (and, for the most part, substantively are) function calls.
* To add two numbers in Ludus: `add (1, 2) &=> 3`.
* To subtract one number from another: `sub (2, 1) &=> 1`
* To determine, are two things equal?: `eq? (3, "three") &=> false`
### The Prelude is loaded before every evaluation
The Ludus Prelude is its standard library, and all functions in the Prelude are available in every Ludus script.
Consult the [Prelude documentation](./prelude.md) for information for all functions in Prelude.
Everything you'll want to do with Ludus involves the Prelude in some way.
Note that most Prelude function names can, in fact, be shadowed by local bindings in a script.
That said, there are several functions that, for optimization reasons, are "builtin," whose names may never be used, e.g., `add`, `sub`, `eq?`, `inc`, `dec`, and so on.
#### Boolean functions are "special forms"
`and` and `or` are special, in that they are compiled differently than other functions.
Their arguments are evaluated lazily, rather than eagerly, so they can short-circuit (and prevent panics).
### Ludus lists and dicts are persistent
Dicts and lists are persistent.
This means you cannot mutate them.
However, you can still add things to a list--you just get back a _new_ list with the value added:
```
let foo = [1, 2, 3]
let bar = append (foo, 4) &=> [1, 2, 3, 4]
let baz = #{:a 1, :b 2}
let quux = assoc (baz, :c, 3) &=> #{:a 1, :b 2, :c 3}
foo &=> [1, 2, 3]
baz &=> #{:a 1, :b 2}
```
Persistent data structures are wonderful, and use a lot of computer science magic to make them competitive in terms of performance: they use "structural sharing" and attempt "opportunistic mutation."
### Ludus has three conditional forms
The three conditional forms in Ludus are `if`, `when`, and `match`.
#### The `if` form
Ludus's base conditional form is `if`:
```
if foo then bar else baz
```
Does what you'd expect!
But with two caveats.
(Before the caveats: you can put newlines before `then` and `else`.)
#### Falsy falues: `nil` and `false`
The condition (`foo` in the example above) is evaluated not strictly as `true` or `false`.
Ludus "falsy" values are `nil` and `false`.
Everything else is truthy, including `0` and `()` (the empty tuple), and `""` (the empty string).
This holds across anywhere in the language you are dealing with notions of truth and falsity: `if` and `when` forms, `guard` expressions in `match` forms, `and` and `or`, etc.
#### Both `then` and `else` are obligatory
`if` forms in Ludus _must_ have both `then` and `else` branches.
This is because every expression in Ludus must return a value.
If you want to throw away a value, you can do that, but you'll need something like `else nil` or `else :nothing`.
#### The `when` form
If you have multiple conditions you'd like to chain together, `when` forms are what you want.
(Ludus does not have an `else if` form.)
`when` puts multiple clauses together, each of which has a left-hand condition expression and a right-hand body expression: `<condition expr> -> <body expr>`
Ludus will evaluate the left-hand expression, and, if it's truthy, evaluate and return the corresponding right-hand expression:
```
when {
eq? (1, 2) -> :nope
eq? (3, 4) -> :not_this_either
eq? (0, 0) -> :this!
} &=> :this!
```
If no clause in a when form has a truthy left-hand side, Ludus panics.
Any truthy value will do if you want the equivalent of an `else` branch.
By convention, `:else` is used as the catch-all at the end of a match form.
#### The `match` form
A `match` form is the equivalent of a `switch` statement in C-family languages.
It is much more powerful, however.
`match` is much beloved by functional programmers.
`match` forms are similar to `when` forms, but they require a value--a "scrutinee."
And, in place of expressions on the left-hand side of their clauses, they have patterns: `<pattern> -> <expr>`.
They attempt to match the value against each pattern until there is a match.
If no clause matches, then Ludus panics.
This is an extremely common pattern in Ludus:
```
let might_fail = (:ok, 42)
match might_fail with {
(:ok, value) -> print! ("got {value}!")
(:err, _) -> print! ("the thing failed")
} &=> :ok, prints "got 42!"
```
##### Match clauses may have a guard expression
A match clause may also have a guard expression.
Afer the pattern and before the arrow, you may put `if <expr>`.
(Here you may not use `then` or `else`.)
Bindings made in the pattern are valid in that expression.
If the expression is truthy, then that's a match.
If it's falsy, no match:
```
let foo = 42
let bar = 23
match bar with {
x if even? (x) -> :even
x if eq? (foo, x) -> :foo
_ -> :odd_not_foo
} &=> :odd_not_foo
```
### Ludus groups expressions together with blocks
A block groups expressions together.
Ludus blocks must have at least one expression (because everything in Ludus must return a value).
A block evaluates to its last expression.
Expressions are separated by one or more terminators--newlines or semicolons.
Use curly braces to form a block:
```
if true
then {
:first; :second & these are two different expressions
:third
}
else {
:nothing
} &=> :third
```
Blocks can go most anywhere expressions can go.
### Ludus has synthetic expressions
We have already seen function calls, e.g., `add (1, 2)`.
This is a _synthetic_ expression, which is a chained combination of bound names, tuples, and keywords.
The root of a synthetic expression may be either a name or a keyword.
Subsequent terms must either be tuples or keywords.
They are evaluated by applying the second term to the first, then applying the third term to the result of that first application, and applying the fourth to the second result, and so on.
Applying a tuple will call something as a function: `add (1, 2)`.
Applying a keyword will access the value stored at that key in a dict: `foo :bar`.
These may be chained arbitrarily.
Take, for example, `foo :bar (1, 2) :baz`.
This accesses `:bar` on `foo`, applies the arguments `(1, 2)` to that value (presumably a function), and then access `:baz` on value returned by that function.
#### Keywords may be called as functions
Following Clojure's example, you may call a keyword as a function: `foo :bar` and `:bar (foo)` are strictly equivalent.
### Ludus has function pipelines
In addition to normal function application, Ludus also has function pipelines, equivalent to Elixir's pipelines or Clojure's thread macros.
In these, the first term is applied, as a single argument, to the second. The result of that is then applied, as a single argument, to the third, and so on.
Function pipelines are introduced by the reserved word, `do`.
These two expressions are exactly equivalent:
```
do foo > bar >
baz > quux
quux (baz (bar (foo)))
```
Newlines may be inserted _after_ the `>` pipeline symbol, not before.
Note that a line ending with the pipeline symbol will "eat" the line after it, even if separated by many terminators, so be careful.
Because keywords can be called like functions, bare keywords may be used in function pipelines.
### Ludus has partial function application
Any function in Ludus may be partially applied by using the placholder, `_`, in place of an argument.
Doing so returns a function that takes a single argument.
When that function is called, it calls the original function with that argument put in the placeholder's position.
Here's a simple example:
```
let double = mult (2, _)
double (3) &=> 6
double (12) &=> 24
```
Partially applied functions play very nicely with pipelines:
```
let double = mult (2, _)
let mynums = [1, 2, 3, 4, 5, 6]
do mynums >
filter (even?, _) > &-> [2, 4, 6]
map (double, _) &=> [4, 8, 12]
```
### Ludus function definitions
Functions come in three flavours, all of which have a concept of a function clause.
A function clause is a special case of a match clause: it has a _tuple_ pattern on its left hand side (since we call functions with tuples).
Otherwise,
#### Anonymous lambdas
An anonymous lambda is the `fn` reserved word, followed by a function clause:
```
let double = fn (x) -> mult (x, 2)
double &=> fn anon.
double (13) &=> 26
```
#### Named functions
Named functions are exactly the same as anonyomous lambdas, but they have a name between `fn` and the clause:
```
fn double (x) -> mult (x, 2)
double &=> fn double
double (-4) &=> -8
```
#### Compound functions
Compound functions have multiple clauses, separated off by curly braces:
```
fn foo? {
("foo") -> true
(:foo) -> true
(_) -> false
}
foo? (:bar) &=> false
```
There's a very close relationship between match forms and function definitions.
##### docstrings
A compound function may, optionally, take a string before any of its clauses, that serves as documentation for the function:
```
fn foo? {
"Tells if its argument is a `foo`."
("foo") -> true
(:foo) -> true
(_) -> false
}
```
Ludus will print the documentation for a function by means of the `doc!` function.
### Ludus has a convention of "commands": they end with a bang
By convention, Ludus functions that end in an exclamation point have side effects.
These are called _commands_.
`doc!` is a command; so is `print!`.
Ludus commands typically return the keyword `:ok` rather than `nil`.
Much of Ludus involves manipulating turtle graphics commands, `forward!`, and so on.
### Ludus has loops, but you should probably use recursion
Ludus, in the grand Lisp (and Logo) tradition, eschews looping constructs in favour of functional recursion.
Ludus is tail-call optimized, which means that recursion, even mutual recursion, is as fast as looping.
The `loop` form, anyway, isn't anything like you're expecting; it's basically function calls.
Two examples of factorial, looping and recurisve:
```
loop (6, 1) with {
(0, acc) -> acc
(n, acc) -> recur (dec (n), mult (n, acc))
} &=> 720
fn fact {
(n) -> fact (n, 1)
(0, acc) -> acc
(n, acc) -> fact (dec (n), mult (n, acc))
}
fact (6) &=> 720
```
The difference between these is that Ludus will throw a compile error if `recur` isn't in tail position.
In addition, all clauses in a loop form, and all invocations of `recur` must have the same arity, whereas functions may have clauses of arbitrary arity.
### Ludus has multiple "levels" of expressions
Not all Ludus expressions can appear anywhere you need an expression.
Ludus has four levels of expressions that restrict where they may go: simple, nonbinding, expressions, and toplevel.
* _Simple_ expressions include all literals as well as bare names and synthetic expressions. They may go anywhere you expect an expression, e.g. in the condition position in if or when forms. But in these positions, you may not use, say, another conditional form, nor bind a name.
* _Nonbinding_ forms include all expressions _except_ those that bind a name. These include all simple expressions, as well as conditional expressions (`if`, `when`, `match`), anonymous lambdas, and `do` pipelines.
* _Expressions_ (tout court) include all Ludus expressions, including those that bind names: `let`, named `fn`s, and `box`.
* _Toplevel_ expressions may only go at the root scope of a script. At current, the are not yet implemented (`pkg`, `use`, `test`). These are statically checked.
### Ludus has carefully managed state
At some point, you need state.
(You need far less than you think!)
For that, you need a `box`.
A box holds a value that can change over time.
It can hold any other Ludus value, including a box.
Getting a value out of a box isn't as simple, however, as using its name.
The name is bound to the _box_, not its value.
To get the value out of a box, you use the `unbox` function:
```
box foo = 42
foo &=> box [42]
unbox (foo) &=> 42
```
To change the value in a box, you use either the `store!` command, or the `update!` command.
`store!` takes a box and a value, and simply puts the new value in the box.
`update!` (not to be confused with the function `update`) takes a box and a function, and updates the value in the box by applying the function to the value in the box:
```
box foo = 42 &=> box [42]
store! (foo, 23) &=> box [23]
update! (foo, add(13, _)) &=> box [36]
unbox (foo) &=> 36
```
#### Boxes are not variables
We have put the section on boxes last in this introduction because boxes are _not_ variables.
Most state can actually be, and within Ludus, absolutely ought to be, modeled not with boxes but with recursive functions.
Consider the factorial example from earlier.
A straightforward Javascript implementation might look like this:
```javascript
function fact (n) {
let acc = 1;
while n > 1 {
acc = n * acc;
n--;
}
return acc;
}
```
You'll note that the `while` statement doesn't have an easy equivalent in Ludus.
But if you were really stubborn about wanting to twised boxes into variables, you could do something like this:
```
fn fact (n) -> {
box acc = 1
loop (n) with (m) -> if lt? (m, 1)
then unbox (acc)
else {
store! (acc, mult (m, unbox (acc)))
recur (dec (m))
}
}
```
Let me tell you, this is _wild_ Ludus.
The `loop` there is very weird indeed.
The short version is, if you can possibly avoid it--and you probably can--don't use boxes.
The more complex version is this:
The functional and immutable nature of Ludus will change your ideas about programming.
This is part of the point.
(More to come...)

513
doc/language.md Normal file
View File

@ -0,0 +1,513 @@
# Ludus language reference
This is not intended for beginners, but to be a language overview for experienced programmers. That said, it may help beginners orient themselves in the language.
## Comments
Ludus's comment character is `&`. Anything after an ampersand on a line is ignored. There are no multiline comments.
## Atomic values
Ludus has four types of atomic values.
### `nil`
`nil` is Ludus's representation of nothing. In the grand Lisp tradition, Ludus can, and occasionally does, use `nil`-punning. Its type is `:nil`.
### Booleans
`true` and `false`. That said, in all conditional constructs, `nil` and `false` are "falsy," and everything else is "truthy." Their type is `:boolean`.
### Numbers
Ludus has numbers, which are IEEE-754 64-bit floats. Numbers are more complicated than you think, probably.
Number literals in Ludus are either integers or decimal floating point numbers, e.g. `32.34`, `42`, `-0.23`. Underscores in numbers are ignored, and can be used to separate long numbers, e.g. `1_234_567_890`.
Numbers' type is `:number`.
### Keywords
Ludus keywords begin with a colon and a letter, e.g. `:keyword`. Types are represented as keywords. Some functions take an optional units argument as a keyword, e.g. `:radians`. Keywords are also used as keys for associative collections. Keywords' type is `:keyword`.
Keywords must begin with an ASCII upper- or lower-case letter, and can then include any letter character, as well as `_`, `/`, `!`, `?`, and `*`.
## Strings
Ludus strings are UTF-8 strings, and only use double quotes. Strings may be multiline. For example, this is a string: `"foo"`. So is this:
```
"foo
bar baz"
```
Strings use backslashes for escapes, including `\n` for newline, `\t` for tab, `\"` for a double quote, and `\{` for an open curly brace (see below on interpolation).
Strings' type is `:string`.
### String interpolation
Strings may also insert a string representation of any Ludus value that is bound to a name, by inserting that name in curly braces. To wit,
```
let foo = :foo
let bar = 42
let baz = [1, 2, 3]
"{foo} {bar} {baz}" &=> ":foo 42 1, 2, 3"
```
Interpolations may _not_ be arbitrary expressions: only bound names may be used in interpolations.
## Collections
Ludus has a few different types of collections, in increasing order of complexity: tuples, lists, sets, dicts, and packages. All collections are immutable.
#### Separators
In all collection literals, members are written with a separator between them. On the same line, use a comma; or a newline will also separate elements. You may use as many separators as you wish at any point inside a collection or pattern. `(,,,,,,,3,,4,,,,,,)` and `(3, 4)` are the same value.
#### Efficiency
At the current moment, Ludus collections are all copy-on-write; this means that Ludus is _not_ performant with large collections. Eventually, Ludus will have Clojure-style persistent, immutable collections.
### Tuples
Tuples are fully-immutable, ordered collections of any kinds of values, delimited by parentheses, e.g. `(1, :a, "foo")`. At current, they have no length limit (although they eventually will). Unlike in some languages, tuples can be empty or contain a single element: `()` and `(:foo)` are both just fine. Tuples largely cannot be manipulated functionally; they must be written as literals and unpacked using pattern matching. They can, however, be converted to lists, either through pattern matching or the `list` function. Their type is `:tuple`.
### Lists
Lists are persistent and immutable ordered collections of any kinds of values, delimited by square braces, e.g. `[1, :a, "foo"]`. Their type is `:list`.
Lists may be combined using splats, written with ellipses, e.g., `[...foo, ...bar]`.
### Sets
Sets are persistent and immutable unordered collections of any kinds of values, which can only contain one instance of any given value. They are written similarly to ordered collections: `${1, :a, "foo"}`. Their type is `:set`.
### Dictionaries, or dicts
Dicts are persistent and immutable associative collections of any kinds of values. Dicts use keywords as keys (and cannot use any other kind of Ludus value as a key, not even strings), but can store any values. Dict literals are written as keyword-value pairs: `#{:a 1, :b false}`. Single words may be used as a shorthand for a key-value pair. Accessing a key that holds no value returns `nil`. Their type is `:dict`.
### Packages
Packages are immutable collections of bindings. They may only be described at the top level of a script, and their names must begin with a capital letter. Accessing a key that has no value on a package results in a validation error. They may not be accessed using functions, but only direct keyword access. Their type is `:pkg`.
They are written with the form `pkg`, then a package name, beginning with a capital letter, that will be bound as their name, and then an associative structure (pairs or word shorthands), delimited by `{}`, e.g.:
```
pkg Foo {
:bar "bar"
:baz 42
quux
}
```
### Working with collections
Ludus names are bound permanently and immutably. Collections are immutable. How do you add something to a list or a dict? How do you get things out of them?
Ludus provides functions that allow working with persistent collections. They're detailed in [the Prelude](prelude.md). That said, all functions that modify collections take a collection and produce the modified collection _as a return value_, without changing the original collection. E.g., `append ([1, 2, 3], 4)` will produce `[1, 2, 3, 4]`, but the original list is unchanged. (For dicts, the equivalent is `assoc`.)
## Expressions
Ludus is an expression-based language: all forms in the language are expressions and return values, except `panic!`. That said, not all expressions may be used everywhere.
### Terminating expressions
Expressions in scripts and blocks are terminated by a newline or a semicolon. In compound forms, like, `if`, the terminator comes after the `else` expression.
In forms with multiple clauses surrounded by curly braces (i.e., function bodies, `match`, `when`, etc.), you may separate clauses with semicolons as well as newlines.
### Toplevel expressions
Some expressions may only be used in the "top level" of a script. Because they are the toplevel, they are assured to be statically knowable. These include: `pkg`, `ns`, `use`, `import`, and `test`. (NB: not all of these are yet implemented.)
### Non-binding expressions
Some forms may take any expression that does _not_ [bind a name](#words-and-bindings), for example, any entry in a collection, or the right-hand side of a `let` binding. This is because binding a name in some positions is ambiguous, or nonsensical, or leads to unwarranted complications.
### Simple expressions
Many compound forms will only accept "simple" expressions. Formally, simple expressions are either literal (atomic, string, or collection literals) or synthetic expressions. They are expressions which do not take sub-expressions: no `if`, `when`, `match`, etc. (`do` expressions are currently not simple, but that may be revised.)
## Words and bindings
Ludus uses _words_ to bind values to names. Words must start with a lower case ASCII letter, and can subsequently include any letter character (modulo backing character encoding), as well as , `_`, `/`, `?`, `!`, and `*`.
Ludus binds values to names immutably and permanently: no name in the same scope may ever be re-bound to a different value. (Although see [boxes](#boxes-and-state), below.
Attempting to use an unbound name (a word that has not had a value bound to it) will result in a validation error, and the script will not run.
### `let` bindings: a very short introduction
Ludus's basic binding form is `let`:
```
let foo = :bar & `foo` is now bound to `bar` for the rest of the scope.
let foo = :baz & Validation error: name foo was bound in line 1
```
`let` bindings are more complex; we will return to these below.
## Patterns
Ludus makes extensive use of pattern-matching. Patterns do two jobs at once: they match values (or don't); and they bind names. The left-hand side of the examples just above in the `let` binding is not just a word: it is a pattern. Patterns also arise in conditional forms and function declarations.
### The placeholder: `_`
The simplest pattern is the placeholder: it matches against anything, and does not bind a name. It is written as a single underscore: `_`, e.g., `let _ = :foo`.
#### Ignored names
If you wish to be a bit more explict than using a placeholder, you can use an ignored name, which is a name that starts with an underscore: `_foo`. This is not bound, is not a valid name, and can be used however much you wish, even multiple times in the same pattern. It is, in fact, a placeholder, plus a reader-facing description.
### Literal patterns
Patterns can be literal atomic values or strings: `0`, `false`, `nil`, `:foo`, etc. That means you can write `let 0 = 0` or `let :foo = :foo`, and, while nothing will happen, everything will be just fine.
Literals match against, well, literal values: if the pattern and the value are the same, they match! If not, they don't match.
Literal values do not bind anything.
### Word patterns
Word patterns match against any value, and bind that value to the word as a name. The scope of that binding depends on the form the pattern is in. `let foo = :bar` binds `:bar` to `foo` for the rest of the scope.
#### Typed patterns
Word patterns can, optionally, take a type, using the `as` reserved word, and the keyword representing the desired type: `let foo as :number = 42`.
### String patterns
Ludus has a simple but powerful form of string pattern matching that mirrors string interpolation. Any word inside curly braces in a string will match against a substring of a string passed into a pattern.
```
let i_am = "I am the walrus"
let "I {verb} the {noun}" = i_am
(verb, noun) &=> ("am", "walrus")
```
Note that such names may well be bound to empty strings: a match does not guarantee that there will be anything in the string. This is particularly relevant at the beginning and end of string patterns:
```
let we_are = "We are the eggmen"
let "{first}We {what}" = we_are
(first, what) &=> ("", "are the eggmen")
```
### Collection patterns
Tuples, lists, and dicts can be destructured using patterns. They are written nearly identically to their literal counterparts. Collection patterns are composed of any number of simpler patterns or other collection patterns. They bind any names nested in them, match literals in them, etc.
#### Tuple patterns
Tuple patterns are delimited using parens, using commas or newlines to separate any number of other patterns. Consider `let (x, y, z) = (1, 2, 3)`. `x`, `y`, and `z` are now bound to 1, 2, and 3, respectively.
The last item in a tuple pattern can be a splat--`...`--which either discards any remaining unenumerated values in a tuple, or binds them to a list. Without a splat, tuples patterns only match against tuples of the same length.
```
let mytup = (1, 2, 3)
let (x, _, y) = mytup & x is now 1, y is now 3
let (a, ...) = mytup & a is now 1; a bare splat (without a name) is just fine
let (_, ...cs) = mytup & cs is now [2, 3]
let (p, q) = mytup & panic! no match
let () = () & empty tuples are also patterns
```
#### List patterns
List patterns are identical to tuple patterns, but they are written using square braces. They also match against a specific number of members, and may take a splat in the last position, e.g. `let [first, ...rest] = [1, 2, 3]`.
Note that list patterns, like tuple patterns, match on explicit length. That means that if you are matching only the first items of a list, you must explicitly include a splat pattern, e.g. `let [first, second, ...] = [1, 2, 3, 4]`.
#### Dict patterns
Dict patterns are written either with shorthand words, or keyword-pattern pairs. Consider: `let #{:a foo, :b 12, c} = #{:a 1, :b 12, :c 4}`. `foo` is now 1; `b` is now 12, `c` is now 4. If a dict does not hold a value at a particular key, there is no match.
Dict patterns may also use a splat as their last member: `let #{:a 1, ...b} = #{:a 1, :b 2, :c 3}` will bind `b` to `#{:b 2, :c 3}`.
Like tuple and list patterns, dict patterns without a splat at the end match only on exact equivalence on all keys.
## `let` bindings
`let` bindings are the basic form of matching and binding in Ludus. It is written `let {pattern} = {non-binding expression}`. The pattern can be arbitrarily complex. If the left-hand side of a `let` binding does not match, Ludus will raise a panic, halting evaluation of the script.
## Scope and blocks
Ludus is lexically scoped. Bindings are valid for the remainder of the scope they act on. To introduce a new scope, Ludus uses a block, a collection of expressions delimited by curly braces and separated by semicolons or newlines. The value of a block, as well as the value of a script, is the last expression in it. In `let foo = {:this; :set; :of; :expressions; "is actually"; :ignored }`, `foo` will be bound to `:ignored`.
That said, you can use bindings in blocks, which will not be available outside that block--but blocks can use bidnings from their parent scope:
```
let outer = 42
let first = {
let inner = 23
add (outer, inner)
} & first is now bound to 65
inner & Validation error: unbound name inner
```
### Shadowing
Even though names are bound permanently in Ludus, it is perfectly possible (and occasionally quite useful) to "shadow" names from an enclosing scope.
```
let x = 42
let y = {
let first = x
let x = 23 & this is fine
let second = x
add (first, second)
} & y is now 65
```
## Conditional forms
Ludus has a robust set of conditional forms, all of which are expressions and resolve to a single value.
### `if`
`if` evaluates a condition; if the result of the condition is truthy, it evaluates is `then` branch; if the condition is falsy, it evaluates its `else` branch. Both branches must always be present. Newlines may come before `then` and `else`.
`if {simple expression} then {non-binding expression} else {non-binding expression}`
### `when`
`when` is like Lisp's `cond`: it takes a series of clauses, separated by semicolons or newlines, delimited by curly braces. Clauses are written `lhs -> rhs`. `when` expressions are extremely useful for avoiding nested `if`s.
The left hand of a clause is a simple expression; the right hand of a clause is any expression. When the left hand is truthy, the right hand is evaluated, and the result of that evaluation is returned; no further clauses are evaluated. If no clause has a truthy left-hand value, then a panic is raised. In the example below, not the use of literal `true` as an always-matching clause.
```
when {
maybe () -> :something
mabye_not () -> :something_else
true -> :always
}
```
### `match`
A `match` form is the most powerful conditional form in Ludus. It consists of a test expression, and a series of clauses. The test expression must be a simple expression, followed by `with`, and then a series of clauses separated by a semicolon or newline, delimited by curly braces.
```
match may_fail () with {
(:ok, value) -> calculate_result (value)
(:err, msg) -> { log! (msg); recover_somehow () }
}
```
The left hand of a match clause is a pattern; the right hand is an expression: `pattern -> expression`. If the pattern matches the test expression of a clause, the expression is evaluated with any bindings from the pattern, and `match` form evaluates to the result of that expression.
If a test expression does not match against any clause's pattern, a panic is raised.
Ludus does not attempt to do any exhaustiveness checking on match forms; match errors are always runtime errors.
#### Guards
`match` clauses may have a _guard expression_, which allows a clause only to match if the expression's result is truthy. In the previous example, consider that we might want different behaviour depending on the value of the number:
```
match may_fail () with {
(:ok, value) if pos? (value) -> calculate_positive_result (value)
(:ok, value) if neg? (value) -> calculate_negative_result (value)
(:ok, 0) -> do_something_with_zero ()
(:err, msg) -> { log! (msg); recover_somehow () }
}
```
## Functions
Ludus is an emphatically functional language. Almost everything in Ludus is accomplished by applying functions to values, or calling functions with arguments. (These are precise synonyms.)
Functions have the type `:fn`.
### Calling functions
Functions are called by placing a tuple with arguments immediately after a function name, e.g. `add (1, 2)` adds `1` and `2`. Because they are represented as tuples, arguments must be explicitly written; splats cannot be used to pass an arbitrary number of arguments to a function.
### Defining functions
Functions have three increasingly complex forms to define them. All of them include the concept of a function clause, which is just a match clause whose left hand side must be a _tuple_ pattern.
#### Anonymous lambda
An anonymous lambda is written `fn {tuple pattern} -> {expression}`, `fn (x, y) -> if gt? (x, y) then x else add (x, y)`. Lambdas may only have one clause.
#### Named functions
A named function is identical to a lambda, with the one change that a word follows the `fn` reserved word: `fn {name} {tuple pattern} -> {expression}`. E.g., `fn add_1 (x) -> add (x, 1)`. The name of the function is bound for the remainder of the scope.
#### Compound functions
Compound functions are functions that have multiple clauses. They must be named, and in place of a single clause after a name, they consist in one or more clauses, separated by semicolons or newlines, delimited by curly braces. Optionally, compound functions may have a docstring as their first element after the opening curly brace. The docstring explains the function's purpose and use, before any of the function clauses.
An example from Ludus's Prelude:
```
fn some {
"Takes a possibly `nil` value and a default value. Returns the value if it's not `nil`, returns the default if it's `nil`."
(nil, default) -> default
(value, _) -> value
}
```
### Closures
Functions in Ludus are closures: function bodies have access not only to their specific scope, but any enclosing scope. That said, functions only have access to names bound _before_ they are defined; nothing is hoisted in Ludus.
### Mutual recursion and forward declaration
If you try the following, you'll get a validation error:
```
fn stupid_odd? {
(0) -> false
(x) -> supid_even? (dec (x)) & Validation error: unbound name stupid_even?
}
fn stupid_even? {
(0) -> true
(x) -> stupid_odd? (dec (x))
}
```
To allow for mutual recursion, Ludus allows forward declarations, which are written `fn name` without any clauses. In the example above, we would simply put `fn stupid_even?` before we define `stupid_odd?`.
If you declare a function without defining it, however, Ludus will raise a validation error.
### The Prelude
The Prelude is a substantial set of functions that is available in any given Ludus script. (It is, itself, just a Ludus file that has special access to host functions.) Because of that, a large number of functions are always available. The prelude documentation is [here](prelude.md).
### Partial application
Functions in Ludus can be partially applied by using a placeholder in the arguments. Partial application may only use a single placeholder (partially applied functions are always unary), but it can be anywhere in the arguments: `let add_1 = add(1, _)` or `let double = mult(_, 2)`.
Unary functions and called keywords may _not_ be partially applied: it is redundant.
Because of "partial application," Ludus has a concept of an "argument tuple" (which may include a single placeholder) in addition to a tuple literal (which may not include a placeholder).
### Function pipelines, or `do` forms
In place of nesting function calls inside other function calls, Ludus allows for a more streamlined version of function application: the `do` form or function pipeline. `do` is followed by an initial expression. `do` expressions use `>` as an operator: whatever is on the left hand side of the `>` is passed in as a single argument to whatever is on its right hand side. For example:
```
let silly_result = do 23 >
mult (_, 2) > add (1, _) >
sub (_, 2) > div (_, 9) & silly_result is 5
```
Newlines may appear after any instance of `>` in a `do` expression. That does, however, mean that you must be careful not to accidentally include any trailing `>`s.
### Called keywords
Keywords may be called as functions, in which case they extract the value stored at that key in the value passed in:
```
let foo = #{:a 1, :b 2}
let bar = :a (foo) & `bar` is now 1
```
Called keywords can be used in pipelines.
In addition, keywords may be called when they are bound to names:
```
let foo = #{:a 1, :b 2}
let bar = :a
bar (foo) & => 1
```
## Synthetic expressions
Synthetic expressions are valid combinations of words, keywords, package names, and argument tuples which allow for calling functions and extracting values from associative collections. The root--first term--of a synthetic expression must be a word or a keyword; subsequent terms must be either argument tuples or keywords.
```
let foo = #{:a 1, :b #{:c "bar" :d "baz"}}
let bar = foo :b :c & `bar` is now "bar"
let baz = :b (foo) :d & `baz` is now "baz"
```
## Looping forms
Ludus has optimized tail calls--the most straightforward way to accomplish repeating behaviour is function recursion. There are two additional looping forms, `repeat` and `loop`.
### `repeat`
`repeat` is a help to learners, and is useful for executing side effects multiple times. It is written `repeat {number|word} { {exprs} }`. From turtle graphics:
```
repeat 4 {
forward! (100)
right! (0.25)
}
```
Note that `repeat` does two interesting things:
1. It never returns a value other than `nil`. If it's in the block, it disappears. This is a unique (and frankly, undesirable) property in Ludus.
2. Unlike everything else in Ludus, repeate _requires_ a block, and not simply an expression. You cannot write `repeat 4 forward! (100)`.
### `loop`/`recur`
`loop` and `recur` are largely identical to recursive functions for repetition, but use a special form to allow an anonymous construction and a few guard rails.
The syntax here is `loop <tuple> with { <function clauses> }`. (Or, you can have a single function clause instead of a set of clauses.) The tuple is passed in as the first set of arguments.
```
let xs = [1, 2, 3, 4]
loop (xs, 0) with {
([x], sum) -> add (x, sum) & matches against the last element of the list
([x, ...xs], sum) -> recur (xs, add (x, sum)) & recurs with the tail
} &=> 10
```
`recur` is the recursive call. It must be in tail position--`recur` must be the root of a synthetic expression, in return position. If `recur` is not in tail position, a validation error will be raised.
In addition, `recur` calls must have the same number of arguments as the original tuple passed to `loop`. While Ludus will allow you to write clauses in `loop` forms with a different arity than the original tuple, those will never match.
`recur` calls return to the nearest `loop`. Nested `loop`s are probably a bad idea and should be avoided when possible.
## Environment and context: the toplevel
The "toplevel" of a script are the expressions that are not embedded in other expressions or forms: not inside a block, not a member of a collection, not on the right hand side of a binding, not inside a function body. The toplevel-only forms:
### `import`
`import` allows for the evaluation of other Ludus scripts: `import "path/to/file" as name`. `import` just evaluates that file, and then binds a name to the result of evaluating that script. This, right now, is quite basic: circular imports are currently allowed but will lead to endless recursion; results are not cached, so each `import` in a chain re-evaluates the file; and so on.
Status: not yet implemented.
### `use`
`use` loads the contents of a namespace into a script's context. To ensure that this is statically checkable, this must be at the toplevel.
Status: not yet implemented.
### `pkg`
Packages, `pkg`es, may only be described at the toplevel of a script. This is to ensure they can be statically evaluatable.
### `test`
A `test` expression is a way of ensuring things behave the way you want them to. Run the script in test mode, and these are evaluated. If the expression under `test` returns a truthy value, you're all good! If the expression under `test` returns a falsy value or raises a panic, then Ludus will report which test(s) failed.
```
test "something goes right" eq? (:foo, :foo)
test "something goes wrong" {
let foo = :foo
let bar = :bar
eq? (foo, bar)
} &=> test failed: "something goes wrong" on line 3
```
`test`s must be at the toplevel--or embedded within other tests in _their_ highest level.
Formally: `test <string> <expression>`.
Status: not yet implemented.
## Changing things: `box`es
Ludus does not let you re-bind names. It does, however, have a type that allows for changing values over time: `box`. A box is a place to put things, it has its own identity, it can store whatever you put in it, but to get what's in it, you have to `unbox` it.
Syntactically and semantically, `box`es are straightforward, but do require a bit more overhead than `let` bindings. The idea is that Ludus makes it obvious where mutable state is in a program, as well as where that mutable state may change. It does so elegantly, but with some guardrails that may take a little getting used to.
The type of a `box` is, predictably, `:box`.
```
box foo = 42 & foo is now bound to a _box that contains 42_
add (1, foo) & panic! no match: foo is _not_ a number
store! (foo, 23) & foo is now a box containing 23
update! (foo, inc) & foo is now a ref containing 24
unbox (foo) &=> 23; use unbox to get the value contained in a box
```
### Ending with a bang!
Ludus has a strong naming convention that functions that change state or could cause an explicit panic end in an exclamation point (or, in computer nerd parlance, a "bang"). So anything function that mutates the value held in a reference ends with a bang: `store!` and `update!` take bangs; `unbox` does not.
This convention also includes anything that prints to the console: `print!`, `report!`, `doc!`, `update!`, `store!`, etc.
(Note that there are a few counter-examples to this: math functions that could cause a panic [in place of returning NaN] do not end with bangs: `div`, `inv`, and `mod`; each of these has variants that allow for more graceful error handling).
### Ending with a whimper?
Relatedly, just about any function that returns a boolean value is a predicate function--and has a name that ends with a question mark: `eq?` tests for equality; `box?` tells you if something is a ref or not; `lte?` is less-than-or-equal.
## Errors: panic! in the Ludus script
A special form, `panic!`, halts script execution with the expression that follows as an error message.
```
panic! :oops
if true then :ok else panic! "It's false!"
```
Panics also happen in the following cases:
* a `let` binding pattern has no match against the value of its expression
* a `match` or `when` form has no matching clause
* a function is called with arguments that do not match any of its clauses
* something that is not a function or keyword is called as a function
* a called keyword is partially applied
* `div`, `inv`, or `mod` divides by zero
* `sqrt` takes the square root of a negative number
* certain error handling functions, like `unwrap!` or `assert!`, are invoked on values that cause them to panic
In fact, the only functions in the Prelude which explicitly cause panics are, at current, `div`, `inv`, `mod`, `sqrt`, `unwrap!`, and `assert!`.
### `nil`s, not errors
Ludus, however, tries to return `nil` instead of panicking where it seems prudent. So, for example, attempting to get access a value at a keyword off a number or `nil`, while nonsensical, will return `nil` rather than panicking:
```
let a = true
a :b :c :d :e &=> nil
let b = [1, 2, 3]
at (b, 12) &=> nil
```
### Result tuples
Operations that could fail--especially when you want some information about why--don't always return `nil` on failures. Instead of exceptions or special error values, recoverable errors in Ludus are handled instead by result tuples: `(:ok, value)` and `(:err, msg)`. So, for example, `unwrap!` takes a result tuple and either returns the value in the `:ok` case, or panics in the `:err` case.
Variants of some functions that may have undesirably inexplicit behaviour are written as `{name}/safe`. So, for example, you can get a variant of `div` that returns a result tuple in `div/safe`, which returns `(:ok, result)` when everything's good; and `(:err, "division by zero")` when the divisor is 0.

1751
doc/prelude.md Normal file

File diff suppressed because one or more lines are too long

338
janet/base.janet Normal file
View File

@ -0,0 +1,338 @@
# A base library for Ludus
# Only loaded in the prelude
(import /janet/scanner :as s)
(defn bool [x] (if (= :^nil x) nil x))
(defn ludus/and [& args] (every? (map bool args)))
(defn ludus/or [& args] (some bool args))
(defn ludus/type [value]
(when (= :^nil value) (break :nil))
(def typed? (when (dictionary? value) (value :^type)))
(def the-type (if typed? typed? (type value)))
(case the-type
:buffer :string
:boolean :bool
:array :list
:table :dict
:cfunction :function
the-type))
(var stringify nil)
(defn- dict-str [dict]
(string/join
(map
(fn [[k v]] (string (stringify k) " " (stringify v)))
(pairs dict))
", "))
(defn- stringish? [x] (or (string? x) (buffer? x)))
(defn- stringify* [value]
(when (stringish? value) (break value))
(def type (ludus/type value))
(case type
:nil ""
:number (string value)
:bool (string value)
:keyword (string ":" value)
:tuple
(string/join (map stringify value) ", ")
:list
(string/join (map stringify value) ", ")
:dict (dict-str value)
:set
(string/join (map stringify (keys value)) ", ")
:box (stringify (value :^value))
:fn (string "fn " (value :name))
:function (string "builtin " (string value))
:pkg (dict-str value)
))
(set stringify stringify*)
(var show nil)
(defn- show-pkg [x]
(def tab (struct/to-table x))
(set (tab :^name) nil)
(set (tab :^type) nil)
(string "pkg " (x :^name) " {" (stringify tab) "}")
)
(defn- dict-show [dict]
(string/join
(map
(fn [[k v]] (string (show k) " " (show v)))
(pairs dict))
", "))
(defn- set-show [sett]
(def prepped (merge sett))
(set (prepped :^type) nil)
(def shown (map show (keys prepped)))
(string/join shown ", ")
)
(defn- show* [x]
(case (ludus/type x)
:nil "nil"
:string (string "\"" x "\"")
:tuple (string "(" (string/join (map show x) ", ") ")")
:list (string "[" (string/join (map show x) ", ") "]")
:dict (string "#{" (dict-show x) "}")
:set (string "${" (set-show x) "}")
:box (string "box " (x :name) " [ " (show (x :^value)) " ]")
:pkg (show-pkg x)
(stringify x)))
(set show show*)
# (var json nil)
# (defn- dict-json [dict]
# (string/join
# (map
# (fn [[k v]] (string (json k) ": " (json v)))
# (pairs dict))
# ", "))
# (defn- json* [x]
# (case (ludus/type x)
# :nil "\"null\""
# :number (string x)
# :bool (if true "\"true\"" "\"false\"")
# :string (string "\"" x "\"")
# :keyword (string "\"" x "\"")
# :tuple (string "[" (string/join (map json x) ", ") "]")
# :list (string "[" (string/join (map json x) ", ")"]")
# :dict (string "{" (dict-json x) "}")
# :set (string "[" (string/join (map json (keys x)) ", ") "]")
# (show x)))
# (set json json*)
(defn show-patt [x]
(case (x :type)
:nil "nil"
:bool (string (x :data))
:number (string (x :data))
:keyword (string ":" (x :data))
:word (x :data)
:placeholder (get-in x [:token :lexeme])
:tuple (string "(" (string/join (map show-patt (x :data)) ", ") ")")
:list (string "[" (string/join (map show-patt (x :data)) ", ")"]")
:dict (string "#{" (string/join (map show-patt (x :data)) ", ") "}")
:pair (string (show-patt (get-in x [:data 0])) " " (show-patt (get-in x [:data 1])))
:typed (string (show-patt (get-in x [:data 1])) " as " (show-patt (get-in x [:data 0])))
:interpolated (get-in x [:token :lexeme])
:string (get-in x [:token :lexeme])
:splat (string "..." (when (x :data) (show-patt (x :data))))
(error (string "cannot show pattern of unknown type " (x :type)))))
(defn pretty-patterns [fnn]
(def {:body clauses} fnn)
(string/join (map (fn [x] (-> x first show-patt)) clauses) "\n"))
(defn doc [fnn]
(when (not= :fn (ludus/type fnn)) (break "No documentation available."))
(def {:name name :doc docstring} fnn)
(string/join [name
(pretty-patterns fnn)
(if docstring docstring "No docstring available.")]
"\n"))
(defn- conj!-set [sett value]
(set (sett value) true)
sett)
(defn- conj-set [sett value]
(def new (merge sett))
(conj!-set new value))
(defn- conj!-list [list value]
(array/push list value))
(defn- conj-list [list value]
(def new (array/slice list))
(conj!-list new value))
(defn conj! [x value]
(case (ludus/type x)
:list (conj!-list x value)
:set (conj!-set x value)))
(defn conj [x value]
(case (ludus/type x)
:list (conj-list x value)
:set (conj-set x value)
(error (string "cannot conj onto " (show x)))))
(defn disj! [sett value]
(set (sett value) nil)
sett)
(defn disj [sett value]
(def new (merge sett))
(set (new value) nil)
new)
(defn assoc! [dict key value]
(set (dict key) value)
dict)
(defn assoc [dict key value]
(merge dict {key value}))
(defn dissoc! [dict key]
(set (dict key) nil)
dict)
(defn dissoc [dict key]
(def new (merge dict))
(set (new key) nil)
new)
(defn ludus/get [key dict &opt def]
(default def :^nil)
(get dict key def))
(defn rest [indexed]
(array/slice indexed 1))
(defn to_list [x]
(case (ludus/type x)
:list x
:tuple @[;x]
:dict (pairs x)
:set (-> x (dissoc :^type) keys)
@[x]))
(defn showprint [x]
(if (= :string (ludus/type x))
x
(show x)))
(defn print! [args]
(print ;(map showprint args)))
(defn prn [x]
(pp x)
x)
(defn concat [x y & zs]
(case (ludus/type x)
:string (string x y ;zs)
:list (array/concat @[] x y ;zs)
:set (merge x y ;zs)))
(defn unbox [b] (get b :^value))
(defn store! [b x] (set (b :^value) x))
(defn mod [x y]
(% x y))
(defn- byte->ascii [c i]
(if (< c 128)
(string/from-bytes c)
(error (string "non-ASCII character at index" i))))
(defn chars [str]
(def out @[])
(try
(for i 0 (length str)
(array/push out (byte->ascii (str i) i)))
([e] (break [:err e])))
[:ok out])
(defn to_number [str]
(when (string/find "&" str)
(break [:err (string "Could not parse `" str "` as a number")]))
(def scanned (s/scan (string/trim str)))
(when (< 0 (length (scanned :errors)))
(break [:err (string "Could not parse `" str "` as a number")]))
(def tokens (scanned :tokens))
(when (< 3 (length tokens))
(break [:err (string "Could not parse `" str "` as a number")]))
(def fst (first tokens))
(when (not= :number (fst :type))
(break [:err (string "Could not parse `" str "` as a number")]))
[:ok (fst :literal)])
(def ctx {
"add" +
"and" ludus/and
"assoc!" assoc!
"assoc" assoc
"atan_2" math/atan2
"bool" bool
"ceil" math/ceil
"chars" chars
"concat" concat
"conj!" conj!
"conj" conj
"cos" math/cos
"count" length
"dec" dec
"disj!" disj!
"disj" disj
"dissoc!" dissoc!
"dissoc" dissoc
"div" /
"doc" doc
"downcase" string/ascii-lower
"e" math/e
"eq?" deep=
"first" first
"floor" math/floor
"get" ludus/get
"gt" >
"gte" >=
"inc" inc
"last" last
"lt" <
"lte" <=
"mod" mod
"mult" *
"not" not
"nth" ludus/get
"or" ludus/or
"pi" math/pi
"pow" math/pow
"print!" print!
"prn" prn
"push" array/push
"random" math/random
"range" range
"rest" rest
"round" math/round
"show" show
"sin" math/sin
"slice" array/slice
"split" string/split
"sqrt" math/sqrt
"store!" store!
"str_slice" string/slice
"stringify" stringify
"sub" -
"tan" math/tan
"to_list" to_list
"to_number" to_number
"trim" string/trim
"triml" string/triml
"trimr" string/trimr
"type" ludus/type
"unbox" unbox
"upcase" string/ascii-upper
})
(def base (let [b @{:^type :dict}]
(each [k v] (pairs ctx)
(set (b (keyword k)) v))
b))

133
janet/doc.janet Normal file
View File

@ -0,0 +1,133 @@
(import /janet/base :as base)
(import /janet/prelude :as prelude)
(defn map-values [f dict]
(from-pairs (map (fn [[k v]] [k (f v)]) (pairs dict))))
(def with-docs (map-values base/doc prelude/ctx))
(def sorted-names (-> with-docs keys sort))
(defn escape-underscores [str] (string/replace "_" "\\_" str))
(defn escape-punctuation [str] (->> str
(string/replace "?" "")
(string/replace "!" "")
(string/replace "/" "")))
(defn toc-entry [name]
(def escaped (escape-underscores name))
(string "[" escaped "](#" (escape-punctuation escaped) ")"))
(def alphabetical-list
(string/join (map toc-entry sorted-names) "&nbsp;&nbsp;&nbsp; "))
(def topics {
"math" ["abs" "add" "angle" "atan/2" "between?" "ceil" "cos" "dec" "deg/rad" "deg/turn" "dist" "div" "div/0" "div/safe" "even?" "floor" "gt?" "gte?" "heading/vector" "inc" "inv" "inv/0" "inv/safe" "lt?" "lte?" "max" "min" "mod" "mod/0" "mod/safe" "mult" "neg" "neg?" "odd?" "pi" "pos?" "pow" "rad/deg" "rad/turn" "random" "random_int" "range" "round" "sin" "sqrt" "sqrt/safe" "square" "sub" "sum_of_squares" "tan" "tau" "to_number" "turn/deg" "turn/rad" "zero?"]
"bools" ["and" "bool" "bool?" "false?" "not" "or" "true?"]
"dicts" ["any?" "assoc" "coll?" "count" "dict" "dict?" "diff" "dissoc" "empty?" "get" "has?" "keys" "random" "update" "values"]
"lists" ["any?" "append" "at" "butlast" "coll?" "concat" "count" "each!" "empty?" "filter" "first" "fold" "index_of" "indexed?" "indices_of" "join" "keep" "last" "list" "list?" "map" "random" "range" "rest" "second" "sentence" "slice"]
"llists" ["car" "cdr" "cons" "llist"]
# "sets" ["any?" "append" "coll?" "concat" "contains?" "count" "empty?" "omit" "random" "set" "set?"]
"tuples" ["any?" "at" "coll?" "count" "empty?" "first" "last" "ordered?" "rest" "second" "tuple?"]
"strings" ["any?" "at" "chars" "chars/safe" "concat" "count" "downcase" "empty?" "join" "sentence" "show" "slice" "slice_n" "split" "string" "string?" "strip" "to_number" "trim" "upcase" "words"]
"types and values" ["bool?" "box?" "coll?" "dict?" "eq?" "fn?" "indexed?" "keyword?" "list?" "nil?" "number?" "set?" "show" "some" "some?" "string?" "tuple?" "type"]
"boxes" ["box?" "unbox" "store!" "update!"]
"results" ["err" "err?" "ok" "ok?" "unwrap!" "unwrap_or"]
"errors" ["assert!"]
"turtle graphics" ["back!" "background!" "bk!" "clear!" "colors" "fd!" "forward!" "goto!" "heading" "heading/vector" "hideturtle!" "home!" "left!" "loadstate!" "lt!" "pc!" "pd!" "pencolor" "pencolour" "pencolor!" "pencolour!" "pendown!" "pendown?" "penup!" "penwidth" "penwidth!" "position" "pu!" "pw!" "render_turtle!" "reset_turtle!" "right!" "rt!" "setheading!" "showturtle!" "spawn_turtle" "turtle_state"]
"environment and i/o" ["console" "doc!" "fetch_inbox" "fetch_outbox" "input" "key_down?" "keys_down" "print!" "read_input" "report!"]
"processes" ["alive?" "await" "fledge" "flush" "heed" "hibernate!" "monitor" "self" "send!" "sleep!" "spawn" "unlink!" "yield!"]
})
(defn capitalize [str]
(def fst (slice str 0 1))
(def rest (slice str 1))
(def init_cap (string/ascii-upper fst))
(def lower_rest (string/ascii-lower rest))
(string init_cap lower_rest))
(defn topic-entry [topic]
(string "### " (capitalize topic) "\n"
(as-> topic _ (topics _) (array/slice _) (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 topics-entries "\n")))
(defn compose-entry [name]
(def header (string "\n### " name "\n"))
(def the-doc (get with-docs name))
(when (= "No documentation available." the-doc)
(break (string header the-doc "\n")))
(def lines (string/split "\n" the-doc))
(def description (last lines))
(def patterns (string/join (slice lines 1 (-> lines length dec)) "\n"))
(def backto "[Back to top.](#ludus-prelude-documentation)\n")
(string header description "\n```\n" patterns "\n```\n" backto))
(compose-entry "update")
(def entries (string/join (map compose-entry sorted-names) "\n---"))
(def doc-file (string
```
# 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).
The prelude itself is just a Ludus file, which you can see at [prelude.ld](./prelude.ld).
## 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` (ordered collections), `:set`s, and `:dict`ionaries (the other collection types); `:pkg` (packages, which are quasi-collections); `:fn` (functions); and `:box`es.
**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)

140
janet/errors.janet Normal file
View File

@ -0,0 +1,140 @@
(import /janet/base :as b)
(defn- get-line [source line]
((string/split "\n" source) (dec line)))
(defn- caret [source line start]
(def lines (string/split "\n" source))
(def the-line (lines (dec line)))
(def prev-lines (slice lines 0 (dec line)))
(def char-counts (map (fn [x] (-> x length inc)) prev-lines))
(def prev-line-chars (sum char-counts))
(def offset (- start prev-line-chars))
(def indent (string/repeat "." (+ 6 offset)))
(string indent "^")
)
(defn scan-error [e]
(def {:line line-num :input input :source source :start start :msg msg} e)
(print "Syntax error: " msg)
(print " on line " line-num " in " input ":")
(def source-line (get-line source line-num))
(print " >>> " source-line)
(print (caret source line-num start))
e)
(defn parse-error [e]
(def msg (e :msg))
(def {:line line-num :input input :source source :start start} (e :token))
(def source-line (get-line source line-num))
(print "Syntax error: " msg)
(print " on line " line-num " in " input ":")
(print " >>> " source-line)
(print (caret source line-num start))
e)
(defn validation-error [e]
(def msg (e :msg))
(def {:line line-num :input input :source source :start start} (get-in e [:node :token]))
(def source-line (get-line source line-num))
(case msg
"unbound name"
(do
(print "Validation error: " msg " " (get-in e [:node :data]))
(print " on line " line-num " in " input ":")
(print " >>> " source-line)
(print (caret source line-num start)))
(do
(print "Validation error: " msg)
(print " on line " line-num " in " input ":")
(print " >>> " source-line)
(print (caret source line-num start))))
e)
(defn- fn-no-match [e]
(print "Ludus panicked! no match")
(def {:line line-num :source source :input input :start start} (get-in e [:node :token]))
(def source-line (get-line source line-num))
(print " on line " line-num " in " input ", ")
(def called (e :called))
(print " calling: " (slice (b/show called) 3))
(def value (e :value))
(print " with arguments: " (b/show value))
(print " expected match with one of:")
(def patterns (b/pretty-patterns called))
(def fmt-patt (do
(def lines (string/split "\n" patterns))
(def indented (map (fn [x] (string " " x)) lines))
(string/join indented "\n")
))
(print fmt-patt)
(print " >>> " source-line)
(print (caret source line-num start))
)
(defn- let-no-match [e]
(print "Ludus panicked! no match")
(def {:line line-num :source source :input input :start start} (get-in e [:node :token]))
(def source-line (get-line source line-num))
(print " on line " line-num " in " input ", ")
(print " matching: " (b/show (e :value)))
(def pattern (get-in e [:node :data 0]))
(print " with pattern: " (b/show-patt pattern))
(print " >>> " source-line)
(print (caret source line-num start))
e)
(defn- match-no-match [e]
(print "Ludus panicked! no match")
(def {:line line-num :source source :input input :start start} (get-in e [:node :token]))
(print " on line " line-num " in " input ", ")
(def value (e :value))
(print " matching: " (b/show value))
(print " with patterns:")
(def clauses (get-in e [:node :data 1]))
(def patterns (b/pretty-patterns {:body clauses}))
(def fmt-patt (do
(def lines (string/split "\n" patterns))
(def indented (map (fn [x] (string " " x)) lines))
(string/join indented "\n")
))
(print fmt-patt)
(def source-line (get-line source line-num))
(print " >>> " source-line)
(print (caret source line-num start))
e)
(defn- generic-panic [e]
(def msg (e :msg))
(def {:line line-num :source source :input input :start start} (get-in e [:node :token]))
(def source-line (get-line source line-num))
(print "Ludus panicked! " msg)
(print " on line " line-num " in " input ":")
(print " >>> " source-line)
(print (caret source line-num start))
e)
(defn- unbound-name [e]
(def {:line line-num :source source :lexeme name :input input :start start} (get-in e [:node :token]))
(def source-line (get-line source line-num))
(print "Ludus panicked! unbound name " name)
(print " on line " line-num " in " input ":")
(print " >>> " source-line)
(print (caret source line-num start))
e)
(defn runtime-error [e]
(when (= :string (type e))
(print (string "Internal Ludus error: " e))
(print "Please file an issue at https://alea.ludus.dev/twc/ludus/issues")
(break e))
(def msg (e :msg))
(case msg
"no match: function call" (fn-no-match e)
"no match: let binding" (let-no-match e)
"no match: match form" (match-no-match e)
"no match: when form" (generic-panic e)
"unbound name" (unbound-name e)
(generic-panic e))
e)

657
janet/interpreter.janet Normal file
View File

@ -0,0 +1,657 @@
# A tree walk interpreter for ludus
(import /janet/base :as b)
(var interpret nil)
(var match-pattern nil)
(defn- todo [msg] (error (string "not yet implemented: " msg)))
(defn- resolve-name [name ctx]
# # (print "resolving " name " in:")
# # (pp ctx)
(when (not ctx) (break :^not-found))
(if (has-key? ctx name)
(ctx name)
(resolve-name name (ctx :^parent))))
(defn- match-word [word value ctx]
(def name (word :data))
# # (print "matched " (b/show value) " to " name)
(set (ctx name) value)
{:success true :ctx ctx})
(defn- typed [pattern value ctx]
(def [type-ast word] (pattern :data))
(def type (type-ast :data))
(if (= type (b/ludus/type value))
(match-word word value ctx)
{:success false :miss [pattern value]}))
(defn- match-tuple [pattern value ctx]
(when (not (tuple? value))
(break {:success false :miss [pattern value]}))
(def val-len (length value))
(var members (pattern :data))
(when (empty? members)
(break (if (empty? value)
{:success true :ctx ctx}
{:success false :miss [pattern value]})))
(def patt-len (length members))
(var splat nil)
(def splat? (= :splat ((last members) :type)))
(when splat?
(when (< val-len patt-len)
# (print "mismatched splatted tuple lengths")
(break {:success false :miss [pattern value]}))
# (print "splat!")
(set splat (last members))
(set members (slice members 0 (dec patt-len))))
(when (and (not splat?) (not= val-len patt-len))
# (print "mismatched tuple lengths")
(break {:success false :miss [pattern value]}))
(var curr-mem :^nothing)
(var curr-val :^nothing)
(var success true)
(for i 0 (length members)
(set curr-mem (get members i))
(set curr-val (get value i))
# (print "in tuple, matching " curr-val " with ")
# (pp curr-mem)
(def match? (match-pattern curr-mem curr-val ctx))
# (pp match?)
(when (not (match? :success))
(set success false)
(break)))
(when (and splat? (splat :data))
(def rest (array/slice value (length members)))
(match-word (splat :data) rest ctx))
(if success
{:success true :ctx ctx}
{:success false :miss [pattern value]}))
(defn- match-list [pattern value ctx]
(when (not (array? value))
(break {:success false :miss [pattern value]}))
(def val-len (length value))
(var members (pattern :data))
(when (empty? members)
(break (if (empty? value)
{:success true :ctx ctx}
{:success false :miss [pattern value]})))
(def patt-len (length members))
(var splat nil)
(def splat? (= :splat ((last members) :type)))
(when splat?
(when (< val-len patt-len)
# (print "mismatched splatted list lengths")
(break {:success false :miss [pattern value]}))
# (print "splat!")
(set splat (last members))
(set members (slice members 0 (dec patt-len))))
(when (and (not splat?) (not= val-len patt-len))
# (print "mismatched list lengths")
(break {:success false :miss [pattern value]}))
(var curr-mem :^nothing)
(var curr-val :^nothing)
(var success true)
(for i 0 (length members)
(set curr-mem (get members i))
(set curr-val (get value i))
# (print "in list, matching " curr-val " with ")
# (pp curr-mem)
(def match? (match-pattern curr-mem curr-val ctx))
# (pp match?)
(when (not (match? :success))
(set success false)
(break)))
(when (and splat? (splat :data))
(def rest (array/slice value (length members)))
(match-word (splat :data) rest ctx))
(if success
{:success true :ctx ctx}
{:success false :miss [pattern value]}))
(defn- match-string [pattern value ctx]
(when (not (string? value))
(break {:success false :miss [pattern value]}))
(def {:compiled compiled :bindings bindings} pattern)
# (print "matching " value " with")
# (pp (pattern :grammar))
(def matches (peg/match compiled value))
(when (not matches)
(break {:success false :miss [pattern value]}))
(when (not= (length matches) (length bindings))
(error "oops: different number of matches and bindings"))
(for i 0 (length matches)
(set (ctx (bindings i)) (matches i)))
{:success true :ctx ctx})
(defn- match-dict [pattern value ctx]
(when (not (table? value))
(break {:success false :miss [pattern value]}))
(def val-size (length value))
(var members (pattern :data))
(def patt-len (length members))
(when (empty? members)
(break (if (empty? value)
{:success true :ctx ctx}
{:success false :miss [pattern value]})))
(var splat nil)
(def splat? (= :splat ((last members) :type)))
(when splat?
(when (< val-size patt-len)
# (print "mismatched splatted dict lengths")
(break {:success false :miss [pattern value]}))
# (print "splat!")
(set splat (last members))
(set members (slice members 0 (dec patt-len))))
(when (and (not splat?) (not= val-size patt-len))
# (print "mismatched dict lengths")
(break {:success false :miss [pattern value]}))
(var success true)
(def matched-keys @[])
(for i 0 (length members)
(def curr-pair (get members i))
(def [curr-key curr-patt] (curr-pair :data))
(def key (interpret curr-key ctx))
(def curr-val (value key))
(def match? (match-pattern curr-patt curr-val ctx))
(array/push matched-keys key)
(when (not (match? :success))
(set success false)
(break)))
(when (and splat? (splat :data) success)
(def rest (merge value))
(each key matched-keys
(set (rest key) nil))
(match-word (splat :data) rest ctx))
(if success
{:success true :ctx ctx}
{:success false :miss [pattern value]}))
(defn- match-pattern* [pattern value &opt ctx]
# (print "in match-pattern, matching " value " with:")
# (pp pattern)
(default ctx @{})
(def data (pattern :data))
(case (pattern :type)
# always match
:placeholder {:success true :ctx ctx}
:ignored {:success true :ctx ctx}
:word (match-word pattern value ctx)
# match on equality
:nil {:success (= :^nil value) :ctx ctx}
:bool {:success (= data value) :ctx ctx}
:number {:success (= data value) :ctx ctx}
:string {:success (= data value) :ctx ctx}
:keyword {:success (= data value) :ctx ctx}
# TODO: lists, dicts
:tuple (match-tuple pattern value ctx)
:list (match-list pattern value ctx)
:dict (match-dict pattern value ctx)
:interpolated (match-string pattern value ctx)
:typed (typed pattern value ctx)
))
(set match-pattern match-pattern*)
(defn- lett [ast ctx]
# (print "lett!")
# (pp ast)
(def [patt expr] (ast :data))
(def value (interpret expr ctx))
(def match? (match-pattern patt value))
(if (match? :success)
(do
(merge-into ctx (match? :ctx))
value)
(error {:node ast :value value :msg "no match: let binding"})))
(defn- matchh [ast ctx]
(def [to-match clauses] (ast :data))
(def value (interpret to-match ctx))
(def len (length clauses))
(when (ast :match) (break ((ast :match) 0 value ctx)))
(defn match-fn [i value ctx]
(when (= len i)
(error {:node ast :value value :msg "no match: match form"}))
(def clause (clauses i))
(def [patt guard expr] clause)
(def match? (match-pattern patt value @{:^parent ctx}))
(when (not (match? :success))
(break (match-fn (inc i) value ctx)))
(def body-ctx (match? :ctx))
(def guard? (if guard
(b/bool (interpret guard body-ctx)) true))
(when (not guard?)
(break (match-fn (inc i) value ctx)))
(interpret expr body-ctx))
(set (ast :match) match-fn)
(match-fn 0 value ctx))
(defn- script [ast ctx]
(def lines (ast :data))
(def last-line (last lines))
(for i 0 (-> lines length dec)
(interpret (lines i) ctx))
(interpret last-line ctx))
(defn- block [ast parent]
(def lines (ast :data))
(def last-line (last lines))
(def ctx @{:^parent parent})
(for i 0 (-> lines length dec)
(interpret (lines i) ctx))
(interpret last-line ctx))
(defn- to_string [ctx] (fn [x]
(if (buffer? x)
(string x)
(b/stringify (interpret x ctx)))))
(defn- interpolated [ast ctx]
(def terms (ast :data))
(def interpolations (map (to_string ctx) terms))
(string/join interpolations))
(defn- iff [ast ctx]
(def [condition then else] (ast :data))
(if (b/bool (interpret condition ctx))
(interpret then ctx)
(interpret else ctx)))
# TODO: use a tail call here
(defn- whenn [ast ctx]
(def clauses (ast :data))
(var result :^nothing)
(each clause clauses
(def [lhs rhs] clause)
(when (b/bool (interpret lhs ctx))
(set result (interpret rhs ctx))
(break)))
(when (= result :^nothing)
(error {:node ast :msg "no match: when form"}))
result)
(defn- word [ast ctx]
(def resolved (resolve-name (ast :data) ctx))
(if (= :^not-found resolved)
(error {:node ast :msg "unbound name"})
resolved))
(defn- tup [ast ctx]
(def members (ast :data))
(def the-tup @[])
(each member members
(array/push the-tup (interpret member ctx)))
[;the-tup])
(defn- args [ast ctx]
(def members (ast :data))
(def the-args @[])
(each member members
(array/push the-args (interpret member ctx)))
(if (ast :partial)
{:^type :partial :args the-args}
[;the-args]))
(defn- sett [ast ctx]
(def members (ast :data))
(def the-set @{:^type :set})
(each member members
(def value (interpret member ctx))
(set (the-set value) true))
the-set)
(defn- list [ast ctx]
(def members (ast :data))
(def the-list @[])
(each member members
(if (= :splat (member :type))
(do
(def splatted (interpret (member :data) ctx))
(when (not= :array (type splatted))
(error {:node member :msg "cannot splat non-list into list"}))
(array/concat the-list splatted))
(array/push the-list (interpret member ctx))))
the-list)
(defn- dict [ast ctx]
(def members (ast :data))
(def the-dict @{})
(each member members
(if (= :splat (member :type))
(do
(def splatted (interpret (member :data) ctx))
(when (or
(not= :table (type splatted))
(:^type splatted))
(error {:node member :msg "cannot splat non-dict into dict"}))
(merge-into the-dict splatted))
(do
(def [key-ast value-ast] (member :data))
# (print "dict key")
# (pp key-ast)
# (print "dict value")
# (pp value-ast)
(def key (interpret key-ast ctx))
(def value (interpret value-ast ctx))
(set (the-dict key) value))))
the-dict)
(defn- box [ast ctx]
(def {:data value-ast :name name} ast)
(def value (interpret value-ast ctx))
(def box @{:^type :box :^value value :name name})
(set (ctx name) box)
box)
(defn- repeatt [ast ctx]
(def [times-ast body] (ast :data))
(def times (interpret times-ast ctx))
(when (not (number? times))
(error {:node times-ast :msg (string "repeat needs a `number` of times; you gave me a " (type times))}))
(repeat times (interpret body ctx)))
(defn- panic [ast ctx]
(def info (interpret (ast :data) ctx))
(error {:node ast :msg info}))
# TODO: add docstrings & pattern docs to fns
# Depends on: good string representation of patterns
# For now, this should be enough to tall the thing
(defn- fnn [ast ctx]
(def {:name name :data clauses :doc doc} ast)
# (print "defining fn " name)
(def closure (merge ctx))
(def the-fn @{:name name :^type :fn :body clauses :ctx closure :doc doc})
(when (not= :^not-found (resolve-name name ctx))
# (print "fn "name" was forward declared")
(def fwd (resolve-name name ctx))
(set (fwd :body) clauses)
(set (fwd :ctx) closure)
(set (fwd :doc) doc)
# (print "fn " name " has been defined")
# (pp fwd)
(break fwd))
# (pp the-fn)
(set (closure name) the-fn)
(set (ctx name) the-fn)
the-fn)
(defn- is_placeholder [x] (= x :_))
(var call-fn nil)
(defn- partial [root-ast the-fn partial-args]
(when (the-fn :applied)
(error {:msg "cannot partially apply a partially applied function"
:node root-ast :called the-fn :args partial-args}))
# (print "calling partially applied function")
(def args (partial-args :args))
# (pp args)
(def pos (find-index is_placeholder args))
(def name (string (the-fn :name) " *partial*"))
(defn partial-fn [root-ast missing]
# (print "calling function with arg " (b/show missing))
# (pp partial-args)
(def full-args (array/slice args))
(set (full-args pos) missing)
# (print "all args: " (b/show full-args))
(call-fn root-ast the-fn [;full-args]))
{:^type :fn :applied true :name name :body partial-fn})
(defn- call-fn* [root-ast the-fn args]
# (print "on line " (get-in root-ast [:token :line]))
# (print "calling " (b/show the-fn))
# (print "with args " (b/show args))
# (pp args)
(when (or
(= :function (type the-fn))
(= :cfunction (type the-fn)))
# (print "Janet function")
(break (the-fn ;args)))
(def clauses (the-fn :body))
(when (= :nothing clauses)
(error {:node root-ast :called the-fn :value args :msg "cannot call function before it is defined"}))
(when (= :function (type clauses))
(break (clauses root-ast ;args)))
(def len (length clauses))
(when (the-fn :match) (break ((the-fn :match) root-ast 0 args)))
(defn match-fn [root-ast i args]
(when (= len i)
(error {:node root-ast :called the-fn :value args :msg "no match: function call"}))
(def clause (clauses i))
(def [patt guard expr] clause)
(def match?
(match-pattern patt args @{:^parent (the-fn :ctx)}))
(when (not (match? :success))
(break (match-fn root-ast (inc i) args)))
# (print "matched!")
(def body-ctx (match? :ctx))
(def guard? (if guard
(b/bool (interpret guard body-ctx)) true))
# (print "passed guard")
(when (not guard?)
(break (match-fn root-ast (inc i) args)))
(interpret expr body-ctx))
(set (the-fn :match) match-fn)
(match-fn root-ast 0 args))
(set call-fn call-fn*)
(defn- call-partial [root-ast the-fn arg] ((the-fn :body) root-ast ;arg))
(defn- apply-synth-term [root-ast prev curr]
# (print "applying " (b/show prev))
# (print "to" (b/show curr))
(def types [(b/ludus/type prev) (b/ludus/type curr)])
# (print "typle:")
# (pp types)
(match types
[:fn :tuple] (call-fn root-ast prev curr)
[:fn :partial] (partial root-ast prev curr)
[:function :tuple] (call-fn root-ast prev curr)
# [:applied :tuple] (call-partial root-ast prev curr)
[:keyword :args] (get (first curr) prev :^nil)
[:keyword :tuple] (get (first curr) prev :^nil)
[:dict :keyword] (get prev curr :^nil)
[:nil :keyword] :^nil
[:pkg :keyword] (get prev curr :^nil)
[:pkg :pkg-kw] (get prev curr :^nil)
(error (string "cannot call " (b/ludus/type prev) " `" (b/show prev) "`"))))
(defn- synthetic [ast ctx]
(def terms (ast :data))
# (print "interpreting synthetic")
# (pp ast)
# (pp terms)
(def first-term (first terms))
(def last-term (last terms))
(var prev (interpret first-term ctx))
# (print "root term: ")
# (pp prev)
(for i 1 (-> terms length dec)
(def curr (interpret (terms i) ctx))
# (print "term " i ": " curr)
(set prev (apply-synth-term first-term prev curr)))
# (print "done with inner terms, applying last term")
(apply-synth-term first-term prev (interpret last-term ctx)))
(defn- doo [ast ctx]
(def terms (ast :data))
(var prev (interpret (first terms) ctx))
(def last-term (last terms))
(for i 1 (-> terms length dec)
(def curr (interpret (terms i) ctx))
(set prev (apply-synth-term (first terms) curr [prev])))
(def last-fn (interpret last-term ctx))
(apply-synth-term (first terms) last-fn [prev]))
(defn- pkg [ast ctx]
(def members (ast :data))
(def the-pkg @{:^name (ast :name) :^type :pkg})
(each member members
(def [key-ast value-ast] (member :data))
(def key (interpret key-ast ctx))
(def value (interpret value-ast ctx))
(set (the-pkg key) value))
# (pp the-pkg)
(def out (table/to-struct the-pkg))
(set (ctx (ast :name)) out)
out)
(defn- loopp [ast ctx]
# (print "looping!")
(def data (ast :data))
(def args (interpret (data 0) ctx))
# this doesn't work: context persists between different interpretations
# we want functions to work this way, but not loops (I think)
# (when (ast :match) (break ((ast :match) 0 args)))
(def clauses (data 1))
(def len (length clauses))
(var loop-ctx @{:^parent ctx})
(defn match-fn [i args]
(when (= len i)
(error {:node ast :value args :msg "no match: loop"}))
(def clause (clauses i))
(def [patt guard expr] clause)
(def match?
(match-pattern patt args loop-ctx))
(when (not (match? :success))
# (print "no match")
(break (match-fn (inc i) args)))
# (print "matched!")
(def body-ctx (match? :ctx))
(def guard? (if guard
(b/bool (interpret guard body-ctx)) true))
# (print "passed guard")
(when (not guard?)
(break (match-fn (inc i) args)))
(interpret expr body-ctx))
(set (ast :match) match-fn)
(set (loop-ctx :^recur) match-fn)
# (print "ATTACHED MATCH-FN")
(match-fn 0 args))
(defn- recur [ast ctx]
# (print "recurring!")
(def passed (ast :data))
(def args (interpret passed ctx))
(def match-fn (resolve-name :^recur ctx))
# (print "match fn in ctx:")
# (pp (ctx :^recur))
# (pp match-fn)
# (pp ctx)
(match-fn 0 args))
# TODO for 0.1.0
(defn- testt [ast ctx] (todo "test"))
(defn- ns [ast ctx] (todo "nses"))
(defn- importt [ast ctx] (todo "imports"))
(defn- withh [ast ctx] (todo "with"))
(defn- usee [ast ctx] (todo "use"))
(defn- interpret* [ast ctx]
# (print "interpreting node " (ast :type))
(case (ast :type)
# literals
:nil :^nil
:number (ast :data)
:bool (ast :data)
:string (ast :data)
:keyword (ast :data)
:placeholder :_
# collections
:tuple (tup ast ctx)
:args (args ast ctx)
:list (list ast ctx)
:set (sett ast ctx)
:dict (dict ast ctx)
# composite forms
:if (iff ast ctx)
:block (block ast ctx)
:when (whenn ast ctx)
:script (script ast ctx)
:panic (panic ast ctx)
# looping forms
:loop (loopp ast ctx)
:recur (recur ast ctx)
:repeat (repeatt ast ctx)
# named/naming forms
:word (word ast ctx)
:interpolated (interpolated ast ctx)
:box (box ast ctx)
:pkg (pkg ast ctx)
:pkg-name (word ast ctx)
# patterned forms
:let (lett ast ctx)
:match (matchh ast ctx)
# functions
:fn (fnn ast ctx)
# synthetic
:synthetic (synthetic ast ctx)
# do
:do (doo ast ctx)
# deferred until after computer class
# :with (withh ast ctx)
# :import (importt ast ctx)
# :ns (ns ast ctx)
# :use (usee ast ctx)
# :test (testt ast ctx)
))
(set interpret interpret*)
# # repl
# (import /src/scanner :as s)
# (import /src/parser :as p)
# (import /src/validate :as v)
# (var source nil)
# (defn- has-errors? [{:errors errors}] (and errors (not (empty? errors))))
# (defn run []
# (def scanned (s/scan source))
# (when (has-errors? scanned) (break (scanned :errors)))
# (def parsed (p/parse scanned))
# (when (has-errors? parsed) (break (parsed :errors)))
# (def validated (v/valid parsed b/ctx))
# # (when (has-errors? validated) (break (validated :errors)))
# # (def cleaned (get-in parsed [:ast :data 1]))
# # # (pp cleaned)
# (interpret (parsed :ast) @{:^parent b/lett})
# # (try (interpret (parsed :ast) @{:^parent b/ctx})
# # ([e] (if (struct? e) (error (e :msg)) (error e))))
# )
# # (do
# (comment
# (set source `
# let foo = 42
# "{foo} bar baz"
# `)
# (def result (run))
# )

131
janet/json.janet Normal file
View File

@ -0,0 +1,131 @@
# pulled from cfiggers/jayson
(defmacro- letv [bindings & body]
~(do ,;(seq [[k v] :in (partition 2 bindings)] ['var k v]) ,;body))
(defn- read-hex [n]
(scan-number (string "0x" n)))
(defn- check-utf-16 [capture]
(let [u (read-hex capture)]
(if (and (>= u 0xD800)
(<= u 0xDBFF))
capture
false)))
(def- utf-8->bytes
(peg/compile
~{:double-u-esc (/ (* "\\u" (cmt (<- 4) ,|(check-utf-16 $)) "\\u" (<- 4))
,|(+ (blshift (- (read-hex $0) 0xD800) 10)
(- (read-hex $1) 0xDC00) 0x10000))
:single-u-esc (/ (* "\\u" (<- 4)) ,|(read-hex $))
:unicode-esc (/ (+ :double-u-esc :single-u-esc)
,|(string/from-bytes
;(cond
(<= $ 0x7f) [$]
(<= $ 0x7ff)
[(bor (band (brshift $ 6) 0x1F) 0xC0)
(bor (band (brshift $ 0) 0x3F) 0x80)]
(<= $ 0xffff)
[(bor (band (brshift $ 12) 0x0F) 0xE0)
(bor (band (brshift $ 6) 0x3F) 0x80)
(bor (band (brshift $ 0) 0x3F) 0x80)]
# Otherwise
[(bor (band (brshift $ 18) 0x07) 0xF0)
(bor (band (brshift $ 12) 0x3F) 0x80)
(bor (band (brshift $ 6) 0x3F) 0x80)
(bor (band (brshift $ 0) 0x3F) 0x80)])))
:escape (/ (* "\\" (<- (set "avbnfrt\"\\/")))
,|(get {"a" "\a" "v" "\v" "b" "\b"
"n" "\n" "f" "\f" "r" "\r"
"t" "\t"} $ $))
:main (+ (some (+ :unicode-esc :escape (<- 1))) -1)}))
(defn decode
``
Returns a janet object after parsing JSON. If `keywords` is truthy,
string keys will be converted to keywords. If `nils` is truthy, `null`
will become `nil` instead of the keyword `:json/null`.
``
[json-source &opt keywords nils]
(def json-parser
{:null (if nils
~(/ (<- (+ "null" "Null")) nil)
~(/ (<- (+ "null" "Null")) :json/null))
:bool-t ~(/ (<- (+ "true")) true)
:bool-f ~(/ (<- (+ "false")) false)
:number ~(/ (<- (* (? "-") :d+ (? (* "." :d+)))) ,|(scan-number $))
:string ~(/ (* "\"" (<- (to (* (> -1 (not "\\")) "\"")))
(* (> -1 (not "\\")) "\""))
,|(string/join (peg/match utf-8->bytes $)))
:array ~(/ (* "[" :s* (? (* :value (any (* :s* "," :value)))) "]") ,|(array ;$&))
:key-value (if keywords
~(* :s* (/ :string ,|(keyword $)) :s* ":" :value)
~(* :s* :string :s* ":" :value))
:object ~(/ (* "{" :s* (? (* :key-value (any (* :s* "," :key-value)))) "}")
,|(from-pairs (partition 2 $&)))
:value ~(* :s* (+ :null :bool-t :bool-f :number :string :array :object) :s*)
:unmatched ~(/ (<- (to (+ :value -1))) ,|[:unmatched $])
:main ~(some (+ :value "\n" :unmatched))})
(first (peg/match (peg/compile json-parser) json-source)))
(def- bytes->utf-8
(peg/compile
~{:four-byte (/ (* (<- (range "\xf0\xff")) (<- 1) (<- 1) (<- 1))
,|(bor (blshift (band (first $0) 0x07) 18)
(blshift (band (first $1) 0x3F) 12)
(blshift (band (first $2) 0x3F) 6)
(blshift (band (first $3) 0x3F) 0)))
:three-byte (/ (* (<- (range "\xe0\xef")) (<- 1) (<- 1))
,|(bor (blshift (band (first $0) 0x0F) 12)
(blshift (band (first $1) 0x3F) 6)
(blshift (band (first $2) 0x3F) 0)))
:two-byte (/ (* (<- (range "\x80\xdf")) (<- 1))
,|(bor (blshift (band (first $0) 0x1F) 6)
(blshift (band (first $1) 0x3F) 0)))
:multi-byte (/ (+ :two-byte :three-byte :four-byte)
,|(if (< $ 0x10000)
(string/format "\\u%04X" $)
(string/format "\\u%04X\\u%04X"
(+ (brshift (- $ 0x10000) 10) 0xD800)
(+ (band (- $ 0x10000) 0x3FF) 0xDC00))))
:one-byte (<- (range "\x20\x7f"))
:0to31 (/ (<- (range "\0\x1F"))
,|(or ({"\a" "\\u0007" "\b" "\\u0008"
"\t" "\\u0009" "\n" "\\u000A"
"\v" "\\u000B" "\f" "\\u000C"
"\r" "\\u000D"} $)
(string/format "\\u%04X" (first $))))
:backslash (/ (<- "\\") "\\\\")
:quote (/ (<- "\"") "\\\"")
:main (+ (some (+ :0to31 :backslash :quote :one-byte :multi-byte)) -1)}))
(defn- encodeone [x depth]
(if (> depth 1024) (error "recurred too deeply"))
(cond
(= x :json/null) "null"
(= x nil) "null"
(bytes? x) (string "\"" (string/join (peg/match bytes->utf-8 x)) "\"")
(indexed? x) (string "[" (string/join (map |(encodeone $ (inc depth)) x) ",") "]")
(dictionary? x) (string "{" (string/join
(seq [[k v] :in (pairs x)]
(string "\"" (string/join (peg/match bytes->utf-8 k)) "\"" ":" (encodeone v (inc depth)))) ",") "}")
(case (type x)
:nil "null"
:boolean (string x)
:number (string x)
(error "type not supported"))))
(defn encode
``
Encodes a janet value in JSON (utf-8). If `buf` is provided, the formated
JSON is append to `buf` instead of a new buffer. Returns the modifed buffer.
``
[x &opt buf]
(letv [ret (encodeone x 0)]
(if (and buf (buffer? buf))
(buffer/push ret)
(thaw ret))))

110
janet/ludus.janet Normal file
View File

@ -0,0 +1,110 @@
# 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 /janet/scanner :as s)
(import /janet/parser :as p)
(import /janet/validate :as v)
(import /janet/interpreter :as i)
(import /janet/errors :as e)
(import /janet/base :as b)
(import /janet/prelude :as prelude)
(import /janet/json :as j)
(defn ludus [source]
# if we can't load prelude, bail
(when (= :error prelude/pkg) (error "could not load prelude"))
# get us a clean working slate
(def ctx @{:^parent prelude/ctx})
(def errors @[])
(var result @"")
(def console @"")
# capture all `print`s
(setdyn :out console)
# an output table
# this will change: the shape of our output
# at the moment, there's only one stack of turtle graphics
# we will be getting more
(def out @{:errors errors :result result
:io @{
:stdout @{:proto [:text-stream "0.1.0"] :data console}
:turtle @{:proto [:turtle-graphics "0.1.0"] :data @[]}}})
### start the program
# first, scanning
(def scanned (s/scan source))
(when (any? (scanned :errors))
(each err (scanned :errors)
(e/scan-error err))
(break (-> out j/encode string)))
# then, parsing
(def parsed (p/parse scanned))
(when (any? (parsed :errors))
(each err (parsed :errors)
(e/parse-error err))
(break (-> out j/encode string)))
# then, validation
(def validated (v/valid parsed ctx))
(when (any? (validated :errors))
(each err (validated :errors)
(e/validation-error err))
(break (-> out j/encode string)))
# and, finally, try interpreting the program
(try (do
# we need to do this every run or we get the very same sequence of "random" numbers every time we run a program
(math/seedrandom (os/cryptorand 8))
(set result (i/interpret (parsed :ast) ctx)))
([err]
(e/runtime-error err)
(break (-> out j/encode string))))
# stop capturing output
(setdyn :out stdout)
# update our output table with our output
(set (out :result) (b/show result))
(set (((out :io) :turtle) :data) (get-in prelude/pkg [:turtle_commands :^value]))
# run the "postlude": any Ludus code that needs to run after each program
# right now this is just resetting the boxes that hold turtle commands and state
(try
(i/interpret prelude/post/ast ctx)
([err] (e/runtime-error err)))
# json-encode our output table, and convert it from a buffer to a string (which we require for playing nice with WASM/C)
(-> out j/encode string))
#### REPL
(comment
# (do
(def start (os/clock))
(def source `
fn fib {
(1) -> 1
(2) -> 1
(n) -> add (
fib (sub (n, 1))
fib (sub (n, 2))
)
}
fib (30)
`)
(def out (-> source
ludus
j/decode
))
(def end (os/clock))
(setdyn :out stdout)
(pp out)
(def console (out "console"))
(print console)
(def result (out "result"))
(print result)
(print (- end start))
)

1203
janet/parser.janet Normal file

File diff suppressed because it is too large Load Diff

42
janet/prelude.janet Normal file
View File

@ -0,0 +1,42 @@
(import /janet/base :as b)
(import /janet/scanner :as s)
(import /janet/parser :as p)
(import /janet/validate :as v)
(import /janet/interpreter :as i)
(import /janet/errors :as e)
(def pkg (do
(def pre-ctx @{:^parent {"base" b/base}})
(def pre-src (slurp "./assets/prelude.ld"))
(def pre-scanned (s/scan pre-src :prelude))
(def pre-parsed (p/parse pre-scanned))
(def parse-errors (pre-parsed :errors))
(when (any? parse-errors) (each err parse-errors (e/parse-error err)) (break :error))
# (def pre-validated (v/valid pre-parsed pre-ctx))
# (def validation-errors (pre-validated :errors))
# (when (any? validation-errors) (each err validation-errors (e/validation-error err)) (break :error))
(try
(i/interpret (pre-parsed :ast) pre-ctx)
([err] (e/runtime-error err) :error))))
(def ctx (do
(def ctx @{})
(each [k v] (pairs pkg)
(set (ctx (string k)) v))
(set (ctx "^name") nil)
(set (ctx "^type") nil)
ctx))
# (def post/src (slurp "postlude.ld"))
# (def post/ast (do
# (def post-ctx @{:^parent ctx})
# (def post-scanned (s/scan post/src :postlude))
# (def post-parsed (p/parse post-scanned))
# (def parse-errors (post-parsed :errors))
# (when (any? parse-errors) (each err parse-errors (e/parse-error err)) (break :error))
# # (def post-validated (v/valid post-parsed post-ctx))
# # (def validation-errors (post-validated :errors))
# # (when (any? validation-errors) (each err validation-errors (e/validation-error err)) (break :error))
# (post-parsed :ast)))

9
janet/project.janet Normal file
View File

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

356
janet/scanner.janet Normal file
View File

@ -0,0 +1,356 @@
(def reserved-words
"List of Ludus reserved words."
## see ludus-spec repo for more info
{
"as" :as ## impl
"box" :box
"do" :do ## impl
"else" :else ## impl
"false" :false ## impl -> literal word
"fn" :fn ## impl
"if" :if ## impl
# "import" :import ## impl
"let" :let ## impl
"loop" :loop ## impl
"match" :match ## impl
"nil" :nil ## impl -> literal word
# "ns" :ns ## impl
"panic!" :panic ## impl (should _not_ be a function)
# "pkg" :pkg
"receive" :receive
"recur" :recur ## impl
"repeat" :repeat ## impl
# "test" :test
"then" :then ## impl
"true" :true ## impl -> literal word
# "use" :use ## wip
"when" :when ## impl, replaces cond
"with" :with ## impl
})
(def literal-words {"true" true
"false" false
"nil" nil
})
(defn- new-scanner
"Creates a new scanner."
[source input]
@{:source source
:input input
:length (length source)
:errors @[]
:start 0
:current 0
:line 1
:tokens @[]})
(defn- at-end?
"Tests if a scanner is at end of input."
[scanner]
(>= (get scanner :current) (get scanner :length)))
(defn- current-char
"Gets the current character of the scanner."
[scanner]
(let [source (get scanner :source)
current (get scanner :current)
length (length source)]
(if (>= current length)
nil
(string/from-bytes (get source current)))))
(defn- advance
"Advances the scanner by a single character."
[scanner]
(update scanner :current inc))
(defn- next-char
"Gets the next character from the scanner."
[scanner]
(let [source (get scanner :source)
current (get scanner :current)
next (inc current)
length (length source)]
(if (>= next length)
nil
(string/from-bytes (get source next)))))
(defn- current-lexeme
[scanner]
(slice (get scanner :source) (get scanner :start) (get scanner :current)))
(defn- char-code [char] (get char 0))
(defn- char-in-range? [start end char]
(and char
(>= (char-code char) (char-code start))
(<= (char-code char) (char-code end))))
(defn- digit? [c]
(char-in-range? "0" "9" c))
(defn- nonzero-digit? [c]
(char-in-range? "1" "9" c))
## for now, use very basic ASCII charset in words
## TODO: research the implications of using the whole
## (defn- alpha? [c] (boolean (re-find #"\p{L}" (string c))))
(defn- alpha? [c]
(or (char-in-range? "a" "z" c) (char-in-range? "A" "Z" c)))
(defn- lower? [c] (char-in-range? "a" "z" c))
(defn- upper? [c] (char-in-range? "A" "Z" c))
## legal characters in words
(def word-chars {"_" true "?" true "!" true "*" true "/" true})
(defn- word-char? [c]
(or (alpha? c) (digit? c) (get word-chars c)))
(defn- whitespace? [c]
(or (= c " ") (= c "\t")))
(def terminators {
":" true
";" true
"\n" true
"{" true
"}" true
"(" true
")" true
"[" true
"]" true
"$" true
"#" true
"-" true
"=" true
"&" true
"," true
">" true
"\"" true})
(defn- terminates? [c]
(or (nil? c) (whitespace? c) (get terminators c)))
(defn- add-token
[scanner token-type &opt literal]
(update scanner :tokens array/push
{:type token-type
:lexeme (current-lexeme scanner)
:literal literal
:line (get scanner :line)
:start (get scanner :start)
:source (get scanner :source)
:input (get scanner :input)}))
## TODO: errors should also be in the vector of tokens
## The goal is to be able to be able to hand this to an LSP?
## Do we need a different structure
(defn- add-error [scanner msg]
(let [token {:type :error
:lexeme (current-lexeme scanner)
:literal nil
:line (get scanner :line)
:start (get scanner :start)
:source (get scanner :source)
:input (get scanner :input)
:msg msg}]
(-> scanner
(update :errors array/push token)
(update :tokens array/push token))))
(defn- add-keyword
[scanner]
(defn recur [scanner key]
(let [char (current-char scanner)]
(cond
(terminates? char) (add-token scanner :keyword (keyword key))
(word-char? char) (recur (advance scanner) (string key char))
:else (add-error scanner (string "Unexpected " char "after keyword :" key)))))
(recur scanner ""))
(defn- add-pkg-kw [scanner]
(defn recur [scanner key]
(let [char (current-char scanner)]
(cond
(terminates? char) (add-token scanner :pkg-kw (keyword key))
(word-char? char) (recur (advance scanner) (string key char))
:else (add-error scanner (string "Unexpected " char " after pkg keyword :" key)))))
(recur scanner ""))
(defn- read-literal [lit] (-> lit parse-all first))
### TODO: consider whether Janet's number rules are right for Ludus
(defn- add-number [char scanner]
(defn recur [scanner num float?]
(let [curr (current-char scanner)]
(cond
(= curr "_") (recur (advance scanner) num float?) ## consume underscores unharmed
(= curr ".") (if float?
(add-error scanner (string "Unexpected second decimal point after " num "."))
(recur (advance scanner) (buffer/push num curr) true))
(terminates? curr) (add-token scanner :number (read-literal num))
(digit? curr) (recur (advance scanner) (buffer/push num curr) float?)
:else (add-error scanner (string "Unexpected " curr " after number " num ".")))))
(recur scanner (buffer char) false))
(def escape {
"\"" "\""
"n" "\n"
"{" "{"
"t" "\t"
"r" "\r"
"\\" "\\"
})
(defn- add-string
[scanner]
(defn recur [scanner buff interpolate?]
(let [char (current-char scanner)]
(case char
"{" (recur (advance scanner) (buffer/push buff char) true)
# allow multiline strings
"\n" (recur (update (advance scanner) :line inc) (buffer/push buff char) interpolate?)
"\"" (add-token (advance scanner) (if interpolate? :interpolated :string) (string buff))
"\\" (let [next (next-char scanner)]
(recur
(advance (advance scanner))
(buffer/push buff (get escape next next))
interpolate?))
(if (at-end? scanner)
(add-error scanner "Unterminated string.")
(recur (advance scanner) (buffer/push buff char) interpolate?)))))
(recur scanner @"" false))
(defn- add-word
[char scanner]
(defn recur [scanner word]
(let [curr (current-char scanner)]
(cond
(terminates? curr) (add-token scanner
(get reserved-words (string word) :word)
(get literal-words (string word) :none))
(word-char? curr) (recur (advance scanner) (buffer/push word curr))
:else (add-error scanner (string "Unexpected " curr " after word " word ".")))))
(recur scanner (buffer char)))
(defn- add-pkg
[char scanner]
(defn recur [scanner pkg]
(let [curr (current-char scanner)]
(cond
(terminates? curr) (add-token scanner :pkg-name :none)
(word-char? curr) (recur (advance scanner) (buffer/push pkg curr))
:else (add-error scanner (string "unexpected " curr " after pkg name " pkg)))))
(recur scanner (buffer char)))
(defn- add-ignored
[scanner]
(defn recur [scanner ignored]
(let [char (current-char scanner)]
(cond
(terminates? char) (add-token scanner :ignored)
(word-char? char) (recur (advance scanner) (buffer/push ignored char))
:else (add-error scanner (string "Unexpected " char " after word " ignored ".")))))
(recur scanner @"_"))
(defn- add-comment [char scanner]
(defn recur [scanner comm]
(let [char (current-char scanner)]
(if (or (= "\n" char) (at-end? scanner))
scanner # for now, we don't do anything with comments; can be added later
(recur (advance scanner) (buffer/push comm char)))))
(recur scanner (buffer char)))
(defn- scan-token [scanner]
(let [char (current-char scanner)
scanner (advance scanner)
next (current-char scanner)]
(case char
## one-character tokens
## :break is a special zero-char token before closing braces
## it makes parsing much simpler
"(" (add-token scanner :lparen)
")" (add-token (add-token scanner :break) :rparen)
"{" (add-token scanner :lbrace)
"}" (add-token (add-token scanner :break) :rbrace)
"[" (add-token scanner :lbracket)
"]" (add-token (add-token scanner :break) :rbracket)
";" (add-token scanner :semicolon)
"," (add-token scanner :comma)
"\n" (add-token (update scanner :line inc) :newline)
"\\" (add-token scanner :backslash)
"=" (add-token scanner :equals)
">" (add-token scanner :pipeline)
## two-character tokens
## ->
"-" (cond
(= next ">") (add-token (advance scanner) :arrow)
(digit? next) (add-number char scanner)
:else (add-error scanner (string "Expected > or negative number after `-`. Got `" char next "`")))
## dict #{
"#" (if (= next "{")
(add-token (advance scanner) :startdict)
(add-error scanner (string "Expected beginning of dict: #{. Got " char next)))
## set ${
"$" (if (= next "{")
(add-token (advance scanner) :startset)
(add-error scanner (string "Expected beginning of set: ${. Got " char next)))
## placeholders
## there's a flat _, and then ignored words
"_" (cond
(terminates? next) (add-token scanner :placeholder)
(alpha? next) (add-ignored scanner)
:else (add-error scanner (string "Expected placeholder: _. Got " char next)))
## comments
## & starts an inline comment
"&" (add-comment char scanner)
## keywords
# XXX: make sure we want only lower-only keywords
":" (cond
(lower? next) (add-keyword scanner)
(upper? next) (add-pkg-kw scanner)
:else (add-error scanner (string "Expected keyword or pkg keyword. Got " char next)))
## splats
"." (let [after_next (current-char (advance scanner))]
(if (= ".." (string next after_next))
(add-token (advance scanner) :splat)
(add-error scanner (string "Expected splat: ... . Got " (string "." next after_next)))))
## strings
"\"" (add-string scanner)
## word matches
(cond
(whitespace? char) scanner ## for now just skip whitespace characters
(digit? char) (add-number char scanner)
(upper? char) (add-pkg char scanner)
(lower? char) (add-word char scanner)
:else (add-error scanner (string "Unexpected character: " char))))))
(defn- next-token [scanner]
(put scanner :start (get scanner :current)))
(defn scan [source &opt input]
(default input :input)
(defn recur [scanner]
(if (at-end? scanner)
(let [scanner (add-token (add-token scanner :break) :eof)]
{:tokens (get scanner :tokens)
:errors (get scanner :errors [])})
(recur (-> scanner (scan-token) (next-token)))))
(recur (new-scanner source input)))
# (comment
(do
(def source " -123 ")
(length ((scan source) :tokens)))

801
janet/validate.janet Normal file
View File

@ -0,0 +1,801 @@
### A validator for a Ludus AST
(comment
Tracking here, before I start writing this code, the kinds of validation we're hoping to accomplish:
* [x] ensure called keywords are only called w/ one arg
* [x] first-level property access with pkg, e.g. `Foo :bar`--bar must be on Foo
- [x] accept pkg-kws
* [x] validate dict patterns
* [x] compile string-patterns
* [x] `loop` form arity checking
* [x] arity checking of explicit named function calls
* [x] flag tail calls
* [x] no re-bound names
* [x] no unbound names
* [x] no unbound names with `use` forms
* [x] recur in tail position in `loop` forms
* [x] recur not called outside of `loop` forms
* [x] splats come at the end of list, tuple, and dict patterns
Deferred until a later iteration of Ludus:
* [ ] no circular imports DEFERRED
* [ ] correct imports DEFERRED
* [ ] validate `with` forms
)
(def- package-registry @{})
# (try (os/cd "janet") ([_] nil))
(import ./scanner :as s)
(import ./parser :as p)
(defn- new-validator [parser]
(def ast (parser :ast))
@{:ast ast
:errors @[]
:ctx @{}
:status @{}}
)
(var validate nil)
(def terminals [:number :string :bool :nil :placeholder])
(def simple-colls [:list :tuple :set :args])
(defn- simple-coll [validator]
(def ast (validator :ast))
(def data (ast :data))
(each node data
(set (validator :ast) node)
(validate validator))
validator)
(defn- iff [validator]
(def ast (validator :ast))
(def data (ast :data))
(each node data
(set (validator :ast) node)
(validate validator))
validator)
(defn- script [validator]
(def ast (validator :ast))
(def data (ast :data))
(def status (validator :status))
(set (status :toplevel) true)
(each node data
(set (validator :ast) node)
(validate validator))
validator)
(defn- block [validator]
(def ast (validator :ast))
(def data (ast :data))
(when (= 0 (length data))
(array/push (validator :errors)
{:node ast :msg "blocks may not be empty"})
(break validator))
(def status (validator :status))
(set (status :toplevel) nil)
(def tail? (status :tail))
(set (status :tail) false)
(def parent (validator :ctx))
(def ctx @{:^parent parent})
(set (validator :ctx) ctx)
(for i 0 (-> data length dec)
(set (validator :ast) (data i))
(validate validator))
(set (status :tail) tail?)
(set (validator :ast) (last data))
(validate validator)
(set (validator :ctx) parent)
validator)
(defn- resolve-local [ctx name]
(get ctx name))
(defn- resolve-name [ctx name]
(when (nil? ctx) (break nil))
(def node (get ctx name))
(if node node (resolve-name (get ctx :^parent) name)))
(defn- resolve-name-in-script [ctx name]
(when (ctx :^toplevel) (break nil))
(def node (ctx name))
(if node node (resolve-name-in-script (ctx :^parent) name)))
(defn- word [validator]
(def ast (validator :ast))
(def name (ast :data))
(def ctx (validator :ctx))
(def resolved (resolve-name ctx name))
(when (not resolved)
(array/push (validator :errors)
{:node ast :msg "unbound name"}))
validator)
### patterns
(var pattern nil)
(defn- lett [validator]
(def ast (validator :ast))
(def [lhs rhs] (ast :data))
# evaluate the expression first
# otherwise lhs names will appear bound
(set (validator :ast) rhs)
(validate validator)
(set (validator :ast) lhs)
(pattern validator)
validator)
(defn- splattern [validator]
(def ast (validator :ast))
(def status (validator :status))
(when (not (status :last))
(array/push (validator :errors)
{:node ast :msg "splats may only come last in collection patterns"}))
(def data (ast :data))
(when data
(set (validator :ast) data)
(pattern validator))
validator)
(defn- simple-coll-pattern [validator]
(def ast (validator :ast))
(def data (ast :data))
(when (empty? data) (break validator))
(def status (validator :status))
(for i 0 (-> data length dec)
(set (validator :ast) (get data i))
(pattern validator))
(set (status :last) true)
(set (validator :ast) (last data))
(pattern validator)
(set (status :last) nil)
validator)
(defn- word-pattern [validator]
(def ast (validator :ast))
(def name (ast :data))
(def ctx (validator :ctx))
### XXX TODO: this resolution should ONLY be for userspace, NOT prelude
(def resolved (resolve-name-in-script ctx name))
(when resolved
(def {:line line :input input} resolved)
(array/push (validator :errors)
{:node ast :msg (string "name " name " is already bound on line "
line " of " input)}))
(set (ctx name) ast)
# (pp ctx)
validator)
(def types [
:nil
:bool
:number
:keyword
:string
:set
:tuple
:dict
:list
:fn
:box
:pkg
])
(defn typed [validator]
(def ast (validator :ast))
(def [kw-type word] (ast :data))
(def type (kw-type :data))
(when (not (has-value? types type))
(array/push (validator :errors)
{:node kw-type :msg "unknown type"}))
(set (validator :ast) word)
(pattern validator))
(defn- str-pattern [validator]
(def ast (validator :ast))
(def data (ast :data))
(def last-term (-> data array/pop string))
(def grammar @{})
(def bindings @[])
(var current 0)
(each node data
(when (not (buffer? node))
(set (validator :ast) node)
(pattern validator))
(if (buffer? node)
(set (grammar (keyword current)) (string node))
(do
(set (grammar (keyword current))
~(<- (to ,(keyword (inc current)))))
(array/push bindings (node :data))))
(set current (inc current)))
(set (grammar (keyword current)) ~(* ,last-term -1))
(def rules (map keyword (range (length grammar))))
(set (grammar :main) ~(* ,;rules))
(set (ast :grammar) grammar)
(set (ast :compiled) (peg/compile grammar))
(set (ast :bindings) bindings))
(defn- pair [validator]
(def ast (validator :ast))
(def [_ patt] (ast :data))
(set (validator :ast) patt)
(pattern validator))
(defn- pattern* [validator]
# (print "PATTERN*")
(def ast (validator :ast))
(def type (ast :type))
# (print "validating pattern " type)
(cond
(has-value? terminals type) validator
(case type
:word (word-pattern validator)
:placeholder validator
:ignored validator
:word (word-pattern validator)
:list (simple-coll-pattern validator)
:tuple (simple-coll-pattern validator)
:dict (simple-coll-pattern validator)
:splat (splattern validator)
:typed (typed validator)
:interpolated (str-pattern validator)
:pair (pair validator)
)))
(set pattern pattern*)
# XXX: ensure guard includes only allowable names
# XXX: what to include here? (cf Elixir)
(defn- guard [validator])
(defn- match-clauses [validator clauses]
# (print "validating clauses in match-clauses")
(each clause clauses
(def parent (validator :ctx))
(def ctx @{:^parent parent})
(set (validator :ctx) ctx)
(def [lhs guard rhs] clause)
(set (validator :ast) lhs)
(pattern validator)
# (pp (validator :ctx))
# (pp (validator :ctx))
(when guard
(set (validator :ast) guard)
(validate validator))
(set (validator :ast) rhs)
(validate validator)
(set (validator :ctx) parent)))
(defn- matchh [validator]
# (print "validating in matchh")
(def ast (validator :ast))
(def [to-match clauses] (ast :data))
# (print "validating expression:")
# (pp to-match)
(set (validator :ast) to-match)
(validate validator)
# (print "validating clauses")
(match-clauses validator clauses)
validator)
(defn- receive [validator]
(def ast (validator :ast))
(def [clauses] (ast :data))
(match-clauses validator clauses)
validator)
(defn- declare [validator fnn]
(def status (validator :status))
(def declared (get status :declared @{}))
(set (declared fnn) true)
(set (status :declared) declared)
# (print "declared function " (fnn :name))
# (pp declared)
validator)
(defn- define [validator fnn]
(def status (validator :status))
(def declared (get status :declared @{}))
(set (declared fnn) nil)
(set (status :declared) declared)
# (print "defined function " (fnn :name))
# (pp declared)
validator)
(defn- fnn [validator]
(def ast (validator :ast))
(def name (ast :name))
# (print "function name: " name)
(def status (validator :status))
(def tail? (status :tail))
(set (status :tail) true)
(when name
(def ctx (validator :ctx))
(def resolved (ctx name))
(when (and resolved (not= :nothing (resolved :data)))
(def {:line line :input input} (get-in ctx [name :token]))
(array/push (validator :errors)
{:node ast :msg (string "name is already bound on line " line " of " input)}))
(when (and resolved (= :nothing (resolved :data)))
(define validator resolved))
(set (ctx name) ast))
(def data (ast :data))
(when (= data :nothing)
(break (declare validator ast)))
(match-clauses validator data)
(set (status :tail) tail?)
(def rest-arities @{})
(def arities @{:rest rest-arities})
(each clause data
# (print "CLAUSE:")
# (pp clause)
(def patt (first clause))
(def params (patt :data))
(def arity (length params))
# (print "checking clause with arity " arity)
(def rest-param? (and (> arity 0) (= :splat ((last params) :type))))
(if rest-param?
(set (rest-arities arity) true)
(set (arities arity) true)))
# (pp arities)
(set (ast :arities) arities)
validator)
(defn- box [validator]
(def ast (validator :ast))
(def ctx (validator :ctx))
(def expr (ast :data))
(set (validator :ast) expr)
(validate validator)
(def name (ast :name))
(def resolved (ctx name))
(when resolved
(def {:line line :input input} (get-in ctx [name :token]))
(array/push (validator :errors)
{:node ast :msg (string "name is already bound on line " line " of " input)}))
(set (ctx name) ast)
validator)
(defn- interpolated [validator]
(def ast (validator :ast))
(def data (ast :data))
(each node data
(when (not (buffer? node))
(set (validator :ast) node)
(validate validator))))
### TODO:
# * [ ] ensure properties are on pkgs (if *only* pkgs from root)
(defn- pkg-root [validator]
# (print "validating pkg-root access")
(def ast (validator :ast))
(def ctx (validator :ctx))
(def terms (ast :data))
(def pkg-name ((first terms) :data))
(def the-pkg (resolve-name ctx pkg-name))
(when (not the-pkg)
(array/push (validator :errors)
{:node ast :msg "unbound pkg name"})
(break validator))
(def member (get terms 1))
(def accessed (case (member :type)
:keyword (get-in the-pkg [:pkg (member :data)])
:pkg-kw (get-in the-pkg [:pkg (member :data)])
:args (do
(array/push (validator :errors)
{:node member :msg "cannot call a pkg"}
(break validator)))))
(when (not accessed)
# (print "no member " (member :data) " on " pkg-name)
(array/push (validator :errors)
{:node member :msg "invalid pkg access"})
(break validator))
# TODO: validate nested pkg access
)
# (defn- tail-call [validator]
# (def ast (validator :ast))
# (when (ast :partial) (break validator))
# (def status (validator :status))
# (when (not (status :tail)) (break validator))
# (def data (ast :data))
# (def args (last data))
# (set (args :tail-call) true))
(defn- check-arity [validator]
# (print "CHECKING ARITY")
(def ast (validator :ast))
# (when (ast :partial) (break validator))
(def ctx (validator :ctx))
(def data (ast :data))
(def fn-word (first data))
# (pp fn-word)
(def the-fn (resolve-name ctx (fn-word :data)))
# (print "the called function: " the-fn)
# (pp the-fn)
(when (not the-fn) (break validator))
# (print "the function is not nil")
# (print "the function type is " (type the-fn))
(when (= :function (type the-fn)) (break validator))
(when (= :cfunction (type the-fn)) (break validator))
# (print "the function is not a janet fn")
# (print "fn type: " (the-fn :type))
(when (not= :fn (the-fn :type)) (break validator))
# (print "fn name: " (the-fn :name))
(def arities (the-fn :arities))
# when there aren't arities yet, break, since that means we're making a recursive function call
# TODO: enahnce this so that we can determine arities *before* all function bodies; this ensures arity-checking for self-recursive calls
(when (not arities) (break validator))
# (print "arities: ")
# (pp arities)
(def args (get data 1))
(def num-args (length (args :data)))
# (print "called with #args " num-args)
# (pp (get (validator :ctx) "bar"))
(when (has-key? arities num-args) (break validator))
# (print "arities: ")
# (pp arities)
(when (not arities) (break validator))
(def rest-arities (keys (arities :rest)))
(when (empty? rest-arities)
(array/push (validator :errors)
{:node ast :msg "wrong number of arguments"})
(break validator))
(def rest-min (min ;rest-arities))
(when (< num-args rest-min)
(array/push (validator :errors)
{:node ast :msg "wrong number of arguments"}))
validator)
(defn- kw-root [validator]
(def ast (validator :ast))
(def data (ast :data))
(def [_ args] data)
(when (not= :args (args :type))
(break (array/push (validator :errors)
{:node args :msg "called keyword expects an argument"})))
(when (not= 1 (length (args :data)))
(array/push (validator :errors)
{:node args :msg "called keywords take one argument"})))
(defn- synthetic [validator]
(def ast (validator :ast))
(def data (ast :data))
(def status (validator :status))
(def ftype ((first data) :type))
(def stype ((get data 1) :type))
(def ltype ((last data) :type))
(set (status :pkg-access?) nil)
(when (= ftype :pkg-name)
(set (status :pkg-access?) true))
(each node data
(set (validator :ast) node)
(validate validator))
(set (validator :ast) ast)
# (print "ftype " ftype)
# (print "stype " stype)
# (print "ltype " ltype)
(when (= ftype :pkg-name) (pkg-root validator))
(when (= ftype :keyword) (kw-root validator))
# (when (= ltype :args) (tail-call validator))
(when (and (= ftype :word) (= stype :args))
(check-arity validator))
validator)
(defn- pair [validator]
(def ast (validator :ast))
(def [k v] (ast :data))
(set (validator :ast) k)
(validate validator)
(set (validator :ast) v)
(validate validator))
(defn- splat [validator]
(def ast (validator :ast))
(when (get-in validator [:status :pkg])
(array/push (validator :errors)
{:node ast :msg "splats are not allowed in pkgs"})
(break validator))
(def data (ast :data))
(when data
(set (validator :ast) data)
(validate validator))
validator)
(defn- dict [validator]
(def ast (validator :ast))
(def data (ast :data))
(each node data
(set (validator :ast) node)
(validate validator))
validator)
(defn- whenn [validator]
(def ast (validator :ast))
(def data (ast :data))
(each node data
(def [lhs rhs] node)
(set (validator :ast) lhs)
(validate validator)
(set (validator :ast) rhs)
(validate validator))
validator)
# XXX: do this!
(defn- withh [validator])
# XXX: tail calls in last position
(defn- doo [validator]
(def ast (validator :ast))
(def data (ast :data))
(each node data
(set (validator :ast) node)
(validate validator))
validator)
(defn- usee [validator]
(def ast (validator :ast))
(def data (ast :data))
(set (validator :ast) data)
(validate validator)
(def name (data :data))
(def ctx (validator :ctx))
(def pkg (get-in ctx [name :pkg] @{}))
(loop [[k v] :pairs pkg]
(set (ctx (string k)) v))
validator)
(defn- pkg-entry [validator pkg]
(def ast (validator :ast))
(def status (validator :status))
(when (= :pkg-pair (ast :type))
(set (status :pkg-access?) true))
(def data (ast :data))
(def [key value] (ast :data))
# (print "PKG ENTRY***")
# (pp key)
# (pp value)
(set (validator :ast) key)
(validate validator)
(set (validator :ast) value)
(validate validator)
(def entry (if (= :pkg-name (value :type))
(resolve-name (validator :ctx) (string (value :data)))
value))
# (print "entry at " (key :data))
# (pp entry)
(set (status :pkg-access?) nil)
(def kw (key :data))
# (pp kw)
(set (pkg kw) entry)
# (pp pkg)
validator)
(defn- pkg [validator]
(def ast (validator :ast))
(def data (ast :data))
(def name (ast :name))
(def pkg @{})
(each node data
(set (validator :ast) node)
(pkg-entry validator pkg))
(set (ast :pkg) pkg)
# (print "THE PACKAGE")
# (pp pkg)
(def ctx (validator :ctx))
(set (ctx name) ast)
validator)
(defn- ns [validator]
(def ast (validator :ast))
(def data (ast :data))
(def name (ast :name))
(def parent (validator :ctx))
(def ctx @{:^parent parent})
(def block (data :data))
(each node block
(set (validator :ast) node)
(validate validator))
(set (ast :pkg) ctx)
(set (parent name) ast)
validator)
(defn- loopp [validator]
(def ast (validator :ast))
(def status (validator :status))
(def data (ast :data))
(def input (first data))
# (print "LOOP INPUT")
# (pp input)
(def clauses (get data 1))
(def input-arity (length (input :data)))
(set (ast :arity) input-arity)
# (print "input arity to loop " input-arity)
(set (validator :ast) input)
(validate validator)
# harmonize arities
(def rest-arities @{})
(each clause clauses
# (print "CLAUSE:")
# (pp clause)
(def patt (first clause))
(def params (patt :data))
(def clause-arity (length params))
# (print "checking clause with arity " clause-arity)
(def rest-param? (= :splat (get (last params) :type)))
(when (and
(not rest-param?) (not= clause-arity input-arity))
(array/push (validator :errors)
{:node patt :msg "arity mismatch"}))
(when rest-param?
(set (rest-arities clause-arity) patt)))
# (pp rest-arities)
(loop [[arity patt] :pairs rest-arities]
(when (< input-arity arity)
(array/push (validator :errors)
{:node patt :msg "arity mismatch"})))
(def loop? (status :loop))
(set (status :loop) input-arity)
(def tail? (status :tail))
(set (status :tail) true)
(match-clauses validator clauses)
(set (status :loop) loop?)
(set (status :tail) tail?)
validator)
(defn- recur [validator]
(def ast (validator :ast))
(def status (validator :status))
(def loop-arity (status :loop))
(when (not loop-arity)
(array/push (validator :errors)
{:node ast :msg "recur may only be used inside a loop"})
(break validator))
(def called-with (get-in ast [:data :data]))
(def recur-arity (length called-with))
# (print "loop arity " loop-arity)
# (print "recur arity" recur-arity)
(when (not= recur-arity loop-arity)
(array/push (validator :errors)
{:node ast :msg "recur must have the same number of args as its loop"}))
(when (not (status :tail))
(array/push (validator :errors)
{:node ast :msg "recur must be in tail position"}))
(set (validator :ast) (ast :data))
(validate validator))
(defn- repeatt [validator]
(def ast (validator :ast))
(def [times body] (ast :data))
(set (validator :ast) times)
(validate validator)
(set (validator :ast) body)
(validate validator))
(defn- panic [validator]
(def ast (validator :ast))
(def data (ast :data))
(set (validator :ast) data)
(validate validator))
(defn- testt [validator]
(def ast (validator :ast))
(def [_ body] (ast :data))
(set (validator :ast) body)
(validate validator))
(defn- pkg-name [validator]
(def ast (validator :ast))
(def name (ast :data))
(def ctx (validator :ctx))
(def pkg (resolve-name ctx name))
(when (not pkg)
(array/push (validator :errors)
{:node ast :msg "unbound name"}))
validator)
(defn- pkg-kw [validator]
# (print "validating pkg-kw")
(def ast (validator :ast))
(def pkg-access? (get-in validator [:status :pkg-access?]))
# (print "pkg-access? " pkg-access?)
(when (not pkg-access?)
(array/push (validator :errors)
{:node ast :msg "cannot use pkg-kw here"}))
validator)
(defn- pkg-pair [validator]
# (print "validating pkg-pair")
(def ast (validator :ast))
(def status (validator :status))
(def [_ pkg] (ast :data))
(set (status :pkg-access?) true)
(set (validator :ast) pkg)
(validate validator)
(set (status :pkg-access?) nil)
validator)
(defn- kw [validator]
(def status (validator :status))
(set (status :pkg-access?) nil)
validator)
(defn- validate* [validator]
(def ast (validator :ast))
(def type (ast :type))
# (print "validating node " type)
(cond
(has-value? terminals type) validator
(has-value? simple-colls type) (simple-coll validator)
(case type
:keyword (kw validator)
:if (iff validator)
:let (lett validator)
:script (script validator)
:block (block validator)
:word (word validator)
:fn (fnn validator)
:match (matchh validator)
:interpolated (interpolated validator)
:synthetic (synthetic validator)
:do (doo validator)
:dict (dict validator)
:test (testt validator)
:panic (panic validator)
:repeat (repeatt validator)
:when (whenn validator)
:splat (splat validator)
:pair (pair validator)
:pkg-pair (pkg-pair validator)
:ns (ns validator)
:pkg (pkg validator)
:pkg-name (pkg-name validator)
:pkg-kw (pkg-kw validator)
:use (usee validator)
:loop (loopp validator)
:recur (recur validator)
:box (box validator)
:receive (receive validator)
(error (string "unknown node type " type)))))
(set validate validate*)
(defn- cleanup [validator]
(def declared (get-in validator [:status :declared] {}))
(when (any? declared)
(each declaration (keys declared)
(array/push (validator :errors) {:node declaration :msg "declared fn, but not defined"})))
validator)
(defn valid [ast &opt ctx]
(default ctx @{})
(set (ctx :^toplevel) true)
(def validator (new-validator ast))
(def base-ctx @{:^parent ctx})
(set (validator :ctx) base-ctx)
(validate validator)
(cleanup validator))
(import ./base :as b)
# (do
(comment
(def source `
dec (12)
`)
(def scanned (s/scan source))
(def parsed (p/parse scanned))
(def validated (valid parsed b/ctx))
# (get-in validated [:status :declared])
# (validated :ctx)
)

View File

@ -38,3 +38,8 @@ release:
serve:
live-server pkg
# build the documentation
doc:
janet janet/doc.janet
-rm doc/prelude.md
mv prelude.md doc/

1594
package-lock.json generated

File diff suppressed because it is too large Load Diff

View File

@ -1,20 +0,0 @@
{
"name": "@ludus/rudus",
"version": "0.1.3",
"description": "A Rust-based Ludus bytecode interpreter.",
"type": "module",
"main": "pkg/ludus.js",
"directories": {},
"keywords": [],
"author": "Scott Richmond",
"license": "GPL-3.0",
"files": [
"pkg/rudus.js",
"pkg/ludus.js",
"pkg/rudus_bg.wasm",
"pkg/rudus_bg.wasm.d.ts",
"pkg/rudus.d.ts"
],
"devDependencies": {
}
}

4
pkg/rudus.d.ts vendored
View File

@ -14,8 +14,8 @@ export interface InitOutput {
readonly __wbindgen_malloc: (a: number, b: number) => number;
readonly __wbindgen_realloc: (a: number, b: number, c: number, d: number) => number;
readonly __wbindgen_export_6: WebAssembly.Table;
readonly closure355_externref_shim: (a: number, b: number, c: any) => void;
readonly closure368_externref_shim: (a: number, b: number, c: any, d: any) => void;
readonly closure351_externref_shim: (a: number, b: number, c: any) => void;
readonly closure364_externref_shim: (a: number, b: number, c: any, d: any) => void;
readonly __wbindgen_start: () => void;
}

View File

@ -146,11 +146,11 @@ export function ludus(src) {
}
function __wbg_adapter_18(arg0, arg1, arg2) {
wasm.closure355_externref_shim(arg0, arg1, arg2);
wasm.closure351_externref_shim(arg0, arg1, arg2);
}
function __wbg_adapter_44(arg0, arg1, arg2, arg3) {
wasm.closure368_externref_shim(arg0, arg1, arg2, arg3);
wasm.closure364_externref_shim(arg0, arg1, arg2, arg3);
}
async function __wbg_load(module, imports) {
@ -306,8 +306,8 @@ function __wbg_get_imports() {
const ret = false;
return ret;
};
imports.wbg.__wbindgen_closure_wrapper1088 = function(arg0, arg1, arg2) {
const ret = makeMutClosure(arg0, arg1, 356, __wbg_adapter_18);
imports.wbg.__wbindgen_closure_wrapper1087 = function(arg0, arg1, arg2) {
const ret = makeMutClosure(arg0, arg1, 352, __wbg_adapter_18);
return ret;
};
imports.wbg.__wbindgen_init_externref_table = function() {

Binary file not shown.

View File

@ -9,6 +9,6 @@ export const __wbindgen_free: (a: number, b: number, c: number) => void;
export const __wbindgen_malloc: (a: number, b: number) => number;
export const __wbindgen_realloc: (a: number, b: number, c: number, d: number) => number;
export const __wbindgen_export_6: WebAssembly.Table;
export const closure355_externref_shim: (a: number, b: number, c: any) => void;
export const closure368_externref_shim: (a: number, b: number, c: any, d: any) => void;
export const closure351_externref_shim: (a: number, b: number, c: any) => void;
export const closure364_externref_shim: (a: number, b: number, c: any, d: any) => void;
export const __wbindgen_start: () => void;

View File

@ -1,34 +0,0 @@
fn inputter () -> {
if do input > unbox > empty?
then {
yield! ()
inputter ()
}
else receive {
(:get, pid) -> send (pid, (:reply, unbox (input)))
(:flush, pid) -> {
send (pid, (:reply, unbox (input)))
store! (input, "")
}
(:clear) -> store! (input, "")
}
}
fn clear_input () -> store! (input, "")
fn read_input () -> {
let reader = spawn! (inputter)
send (reader, (:get, self ()))
receive {
(:reply, msg) -> msg
}
}
fn flush_input () -> {
let reader = spawn! (inputter)
send (reader, (:flush, self ()))
receive {
(:reply, msg) -> msg
}
}

View File

@ -1,444 +0,0 @@
entering world loop; active process is axolotl_0
closing over in type at 1: #{:sin fn sin/base, ...
closing over in eq? at 1: #{:sin fn sin/base, ...
closing over in eq? at 2: fn eq?
closing over in first at 1: #{:sin fn sin/base, ...
closing over in rest at 1: #{:sin fn sin/base, ...
closing over in inc at 1: #{:sin fn sin/base, ...
closing over in dec at 1: #{:sin fn sin/base, ...
closing over in count at 1: #{:sin fn sin/base, ...
closing over in any? at 1: fn empty?
closing over in any? at 2: fn not
closing over in list at 1: #{:sin fn sin/base, ...
closing over in append at 1: #{:sin fn sin/base, ...
closing over in fold at 1: fn fold
closing over in fold at 2: fn first
closing over in fold at 3: fn rest
closing over in foldr at 1: fn foldr
closing over in foldr at 2: fn first
closing over in foldr at 3: fn rest
closing over in map at 1: fn map
closing over in map at 2: fn append
closing over in map at 3: fn fold
closing over in filter at 1: fn filter
closing over in filter at 2: fn append
closing over in filter at 3: fn fold
closing over in keep at 1: fn some?
closing over in keep at 2: fn filter
closing over in concat at 1: #{:sin fn sin/base, ...
closing over in concat at 2: fn concat
closing over in concat at 3: fn fold
closing over in contains? at 1: fn first
closing over in contains? at 2: fn eq?
closing over in contains? at 3: fn rest
closing over in unbox at 1: #{:sin fn sin/base, ...
closing over in store! at 1: #{:sin fn sin/base, ...
closing over in update! at 1: fn unbox
closing over in update! at 2: fn store!
closing over in show at 1: #{:sin fn sin/base, ...
closing over in string at 1: fn show
closing over in string at 2: fn string
closing over in string at 3: fn concat
closing over in join at 1: fn join
closing over in join at 2: fn concat
closing over in join at 3: fn fold
closing over in split at 1: #{:sin fn sin/base, ...
closing over in trim at 1: #{:sin fn sin/base, ...
closing over in upcase at 1: #{:sin fn sin/base, ...
closing over in downcase at 1: #{:sin fn sin/base, ...
closing over in chars at 1: #{:sin fn sin/base, ...
closing over in chars/safe at 1: #{:sin fn sin/base, ...
closing over in strip at 1: fn strip
closing over in words at 1: fn strip
closing over in words at 2: fn split
closing over in words at 3: fn empty?
closing over in words at 4: fn append
closing over in words at 5: fn fold
closing over in sentence at 1: fn join
closing over in to_number at 1: #{:sin fn sin/base, ...
closing over in print! at 1: fn string
closing over in print! at 2: fn map
closing over in print! at 3: fn join
closing over in print! at 4: #{:sin fn sin/base, ...
closing over in print! at 5: box { [] }
closing over in print! at 6: fn append
closing over in print! at 7: fn update!
closing over in report! at 1: fn print!
closing over in report! at 2: fn show
closing over in report! at 3: fn concat
closing over in doc! at 1: #{:sin fn sin/base, ...
closing over in doc! at 2: fn print!
closing over in add at 1: #{:sin fn sin/base, ...
closing over in add at 2: fn add
closing over in add at 3: fn fold
closing over in sub at 1: #{:sin fn sin/base, ...
closing over in sub at 2: fn sub
closing over in sub at 3: fn fold
closing over in mult at 1: #{:sin fn sin/base, ...
closing over in mult at 2: fn mult
closing over in mult at 3: fn fold
closing over in div at 1: #{:sin fn sin/base, ...
closing over in div at 2: fn mult
closing over in div at 3: fn fold
closing over in div at 4: fn div
closing over in div/0 at 1: #{:sin fn sin/base, ...
closing over in div/0 at 2: fn mult
closing over in div/0 at 3: fn fold
closing over in div/0 at 4: fn div/0
closing over in div/safe at 1: fn div
closing over in div/safe at 2: fn mult
closing over in div/safe at 3: fn fold
closing over in div/safe at 4: fn div/safe
closing over in inv at 1: fn div
closing over in inv/0 at 1: fn div/0
closing over in inv/safe at 1: fn div/safe
closing over in neg at 1: fn mult
closing over in gt? at 1: #{:sin fn sin/base, ...
closing over in gte? at 1: #{:sin fn sin/base, ...
closing over in lt? at 1: #{:sin fn sin/base, ...
closing over in lte? at 1: #{:sin fn sin/base, ...
closing over in between? at 1: fn gte?
closing over in between? at 2: fn lt?
closing over in neg? at 1: fn lt?
closing over in pos? at 1: fn gt?
closing over in abs at 1: fn neg?
closing over in abs at 2: fn mult
closing over in turn/deg at 1: fn mult
closing over in deg/turn at 1: fn div
closing over in turn/rad at 1: 6.283185307179586
closing over in turn/rad at 2: fn mult
closing over in rad/turn at 1: 6.283185307179586
closing over in rad/turn at 2: fn div
closing over in deg/rad at 1: 6.283185307179586
closing over in deg/rad at 2: fn div
closing over in deg/rad at 3: fn mult
closing over in rad/deg at 1: 6.283185307179586
closing over in rad/deg at 2: fn div
closing over in rad/deg at 3: fn mult
closing over in sin at 1: fn turn/rad
closing over in sin at 2: #{:sin fn sin/base, ...
closing over in sin at 3: fn deg/rad
closing over in cos at 1: fn turn/rad
closing over in cos at 2: #{:sin fn sin/base, ...
closing over in cos at 3: fn deg/rad
closing over in tan at 1: fn turn/rad
closing over in tan at 2: #{:sin fn sin/base, ...
closing over in tan at 3: fn deg/rad
closing over in rotate at 1: fn rotate
closing over in rotate at 2: fn cos
closing over in rotate at 3: fn mult
closing over in rotate at 4: fn sin
closing over in rotate at 5: fn sub
closing over in rotate at 6: fn add
closing over in atan/2 at 1: #{:sin fn sin/base, ...
closing over in atan/2 at 2: fn rad/turn
closing over in atan/2 at 3: fn atan/2
closing over in atan/2 at 4: fn rad/deg
closing over in angle at 1: fn atan/2
closing over in angle at 2: fn sub
closing over in mod at 1: #{:sin fn sin/base, ...
closing over in mod/0 at 1: #{:sin fn sin/base, ...
closing over in mod/safe at 1: #{:sin fn sin/base, ...
closing over in even? at 1: fn mod
closing over in even? at 2: fn eq?
closing over in odd? at 1: fn mod
closing over in odd? at 2: fn eq?
closing over in square at 1: fn mult
closing over in sqrt at 1: fn neg?
closing over in sqrt at 2: fn not
closing over in sqrt at 3: #{:sin fn sin/base, ...
closing over in sqrt/safe at 1: fn neg?
closing over in sqrt/safe at 2: fn not
closing over in sqrt/safe at 3: #{:sin fn sin/base, ...
closing over in sum_of_squares at 1: fn square
closing over in sum_of_squares at 2: fn add
closing over in sum_of_squares at 3: fn sum_of_squares
closing over in sum_of_squares at 4: fn fold
closing over in dist at 1: fn sum_of_squares
closing over in dist at 2: fn sqrt
closing over in dist at 3: fn dist
closing over in heading/vector at 1: fn neg
closing over in heading/vector at 2: fn add
closing over in heading/vector at 3: fn cos
closing over in heading/vector at 4: fn sin
closing over in floor at 1: #{:sin fn sin/base, ...
closing over in ceil at 1: #{:sin fn sin/base, ...
closing over in round at 1: #{:sin fn sin/base, ...
closing over in range at 1: #{:sin fn sin/base, ...
closing over in at at 1: #{:sin fn sin/base, ...
closing over in second at 1: fn ordered?
closing over in second at 2: fn at
closing over in last at 1: fn ordered?
closing over in last at 2: fn count
closing over in last at 3: fn dec
closing over in last at 4: fn at
closing over in slice at 1: fn slice
closing over in slice at 2: fn gte?
closing over in slice at 3: fn count
closing over in slice at 4: fn gt?
closing over in slice at 5: fn neg?
closing over in slice at 6: #{:sin fn sin/base, ...
closing over in butlast at 1: fn count
closing over in butlast at 2: fn dec
closing over in butlast at 3: fn slice
closing over in assoc at 1: #{:sin fn sin/base, ...
closing over in dissoc at 1: #{:sin fn sin/base, ...
closing over in get at 1: fn get
closing over in get at 2: #{:sin fn sin/base, ...
closing over in update at 1: fn get
closing over in update at 2: fn assoc
closing over in keys at 1: fn list
closing over in keys at 2: fn first
closing over in keys at 3: fn map
closing over in values at 1: fn list
closing over in values at 2: fn second
closing over in values at 3: fn map
closing over in has? at 1: fn has?
closing over in has? at 2: fn get
closing over in has? at 3: fn some?
closing over in dict at 1: fn assoc
closing over in dict at 2: fn fold
closing over in dict at 3: fn list
closing over in dict at 4: fn dict
closing over in each! at 1: fn each!
closing over in random at 1: #{:sin fn sin/base, ...
closing over in random at 2: fn random
closing over in random at 3: fn mult
closing over in random at 4: fn sub
closing over in random at 5: fn add
closing over in random at 6: fn count
closing over in random at 7: fn floor
closing over in random at 8: fn at
closing over in random at 9: fn keys
closing over in random at 10: fn get
closing over in random_int at 1: fn random
closing over in random_int at 2: fn floor
closing over in add_command! at 1: box { [] }
closing over in add_command! at 2: fn append
closing over in add_command! at 3: fn update!
closing over in add_command! at 4: box { #{:penwidth 1,...
closing over in add_command! at 5: fn unbox
closing over in add_command! at 6: fn apply_command
closing over in add_command! at 7: fn store!
closing over in forward! at 1: fn add_command!
closing over in back! at 1: fn add_command!
closing over in left! at 1: fn add_command!
closing over in right! at 1: fn add_command!
closing over in penup! at 1: fn add_command!
closing over in pendown! at 1: fn add_command!
closing over in pencolor! at 1: fn add_command!
closing over in penwidth! at 1: fn add_command!
closing over in background! at 1: fn add_command!
closing over in home! at 1: fn add_command!
closing over in clear! at 1: fn add_command!
closing over in goto! at 1: fn add_command!
closing over in goto! at 2: fn goto!
closing over in setheading! at 1: fn add_command!
closing over in showturtle! at 1: fn add_command!
closing over in hideturtle! at 1: fn add_command!
closing over in loadstate! at 1: fn add_command!
closing over in apply_command at 1: fn assoc
closing over in apply_command at 2: fn add
closing over in apply_command at 3: fn update
closing over in apply_command at 4: fn sub
closing over in apply_command at 5: fn heading/vector
closing over in apply_command at 6: fn mult
closing over in position at 1: box { #{:penwidth 1,...
closing over in position at 2: fn unbox
closing over in heading at 1: box { #{:penwidth 1,...
closing over in heading at 2: fn unbox
closing over in pendown? at 1: box { #{:penwidth 1,...
closing over in pendown? at 2: fn unbox
closing over in pencolor at 1: box { #{:penwidth 1,...
closing over in pencolor at 2: fn unbox
closing over in penwidth at 1: box { #{:penwidth 1,...
closing over in penwidth at 2: fn unbox
closing over in self at 1: #{:sin fn sin/base, ...
closing over in send at 1: #{:sin fn sin/base, ...
closing over in spawn! at 1: #{:sin fn sin/base, ...
closing over in yield! at 1: #{:sin fn sin/base, ...
closing over in alive? at 1: #{:sin fn sin/base, ...
closing over in link! at 1: fn link!
closing over in link! at 2: #{:sin fn sin/base, ...
closing over in msgs at 1: #{:sin fn sin/base, ...
closing over in flush! at 1: #{:sin fn sin/base, ...
closing over in flush_i! at 1: #{:sin fn sin/base, ...
closing over in sleep! at 1: #{:sin fn sin/base, ...
yielded from axolotl_0
***match clause: : (:set, x)
binding `x` in sandbox
stack depth: 3; match depth: 0
at stack index: 2
new locals: x@2//1
resolving binding `x` in sandbox
locals: x@2//1
at locals position 2
leaving scope 1
releasing binding x@2//1
leaving scope 0
***leaving block before pop stack depth: 1
popping back from 1 to 0
=== source code ===
& fn receive (receiver) -> {
& fn looper {
& ([], _) -> yield! ()
& (xs, i) -> {
& print!("looping through messages:", xs)
& match receiver (first (xs), i) with {
& :does_not_understand -> looper (rest (xs), inc (i))
& x -> x
& }}
& }
& print! ("receiving in", self (), "with messages", msgs())
& looper (msgs (), 0)
& }
& fn agent (x) -> receive (fn (msg, i) -> {
& print!("received msg in agent: ", msg)
& match msg with {
& (:get, pid) -> {
& flush_i! (i)
& print!("getted from {pid}")
& send (pid, (:response, x))
& agent (x)
& }
& (:set, y) -> {flush_i!(i); print!("setted! {y}"); agent (y)}
& (:update, f) -> {flush_i!(i);print!("updated: {f}"); agent (f (x))}
& y -> {print!("no agent reception match!!!! {y}");:does_not_understand}
& }
& })
& fn agent/get (pid) -> {
& send (pid, (:get, self ()))
& yield! ()
& receive (fn (msg, i) -> match msg with {
& (:response, x) -> {flush_i! (i); x}
& })
& }
& fn agent/set (pid, val) -> send (pid, (:set, val))
& fn agent/update (pid, f) -> send (pid, (:update, f))
& let counter = spawn! (fn () -> agent (0))
& agent/set (counter, 12)
match (:set, 12) with {
(:set, x) -> x
}
=== chunk: sandbox ===
IDX | CODE | INFO
0000: constant 00000: :set
0003: constant 00001: 12
0006: push_tuple 002
0008: ***match clause: : (:set, x)
0010: match_tuple 002
0012: jump_if_no_match 00028
0015: load_tuple
0016: match_depth 001
0018: match_constant 00000: :set
0021: jump_if_no_match 00017
0024: match_depth 000
0026: match
0027: binding `x` in sandbox
0029: stack depth: 3; match depth: 0
0031: at stack index: 2
0033: new locals: x@2//1
0035: jump_if_no_match 00003
0038: jump 00002
0041: pop_n 002
0043: jump_if_no_match 00016
0046: resolving binding `x` in sandbox
locals: x@2//1
0048: at locals position 2
0050: push_binding 002
0052: store
0053: leaving scope 1
0055: releasing binding x@2//1
0057: pop_n 002
0059: jump 00001
0062: panic_no_match
0063: load
0064: store
0065: leaving scope 0
0067: ***leaving block before pop stack depth: 1
0069: popping back from 1 to 0
0071: pop
0072: load
=== vm run ===
entering world loop; active process is cormorant_0
0000: [] (_,_,_,_,_,_,_,_) cormorant_0 {}
0000: constant 00000: :set
0003: [->:set<-] (_,_,_,_,_,_,_,_) cormorant_0 {}
0003: constant 00001: 12
0006: [->:set<-|12] (_,_,_,_,_,_,_,_) cormorant_0 {}
0006: push_tuple 002
0008: [->(:set, 12)<-] (_,_,_,_,_,_,_,_) cormorant_0 {}
0008: ***match clause: : (:set, x)
0010: [->(:set, 12)<-] (_,_,_,_,_,_,_,_) cormorant_0 {}
0010: match_tuple 002
0012: [->(:set, 12)<-] (_,_,_,_,_,_,_,_) cormorant_0 {}
0012: jump_if_no_match 00028
0015: [->(:set, 12)<-] (_,_,_,_,_,_,_,_) cormorant_0 {}
0015: load_tuple
0016: [->(:set, 12)<-|:set|12] (_,_,_,_,_,_,_,_) cormorant_0 {}
0016: match_depth 001
0018: [->(:set, 12)<-|:set|12] (_,_,_,_,_,_,_,_) cormorant_0 {}
0018: match_constant 00000: :set
0021: [->(:set, 12)<-|:set|12] (_,_,_,_,_,_,_,_) cormorant_0 {}
0021: jump_if_no_match 00017
0024: [->(:set, 12)<-|:set|12] (_,_,_,_,_,_,_,_) cormorant_0 {}
0024: match_depth 000
0026: [->(:set, 12)<-|:set|12] (_,_,_,_,_,_,_,_) cormorant_0 {}
0026: match
0027: [->(:set, 12)<-|:set|12] (_,_,_,_,_,_,_,_) cormorant_0 {}
0027: binding `x` in sandbox
0029: [->(:set, 12)<-|:set|12] (_,_,_,_,_,_,_,_) cormorant_0 {}
0029: stack depth: 3; match depth: 0
0031: [->(:set, 12)<-|:set|12] (_,_,_,_,_,_,_,_) cormorant_0 {}
0031: at stack index: 2
0033: [->(:set, 12)<-|:set|12] (_,_,_,_,_,_,_,_) cormorant_0 {}
0033: new locals: x@2//1
0035: [->(:set, 12)<-|:set|12] (_,_,_,_,_,_,_,_) cormorant_0 {}
0035: jump_if_no_match 00003
0038: [->(:set, 12)<-|:set|12] (_,_,_,_,_,_,_,_) cormorant_0 {}
0038: jump 00002
0043: [->(:set, 12)<-|:set|12] (_,_,_,_,_,_,_,_) cormorant_0 {}
0043: jump_if_no_match 00016
0046: [->(:set, 12)<-|:set|12] (_,_,_,_,_,_,_,_) cormorant_0 {}
0046: resolving binding `x` in sandbox
locals: x@2//1
0048: [->(:set, 12)<-|:set|12] (_,_,_,_,_,_,_,_) cormorant_0 {}
0048: at locals position 2
0050: [->(:set, 12)<-|:set|12] (_,_,_,_,_,_,_,_) cormorant_0 {}
0050: push_binding 002
0052: [->(:set, 12)<-|:set|12|12] (_,_,_,_,_,_,_,_) cormorant_0 {}
0052: store
0053: [->(:set, 12)<-|:set|12] (12,_,_,_,_,_,_,_) cormorant_0 {}
0053: leaving scope 1
0055: [->(:set, 12)<-|:set|12] (12,_,_,_,_,_,_,_) cormorant_0 {}
0055: releasing binding x@2//1
0057: [->(:set, 12)<-|:set|12] (12,_,_,_,_,_,_,_) cormorant_0 {}
0057: pop_n 002
0059: [->(:set, 12)<-] (12,_,_,_,_,_,_,_) cormorant_0 {}
0059: jump 00001
0063: [->(:set, 12)<-] (12,_,_,_,_,_,_,_) cormorant_0 {}
0063: load
0064: [->(:set, 12)<-|12] (_,_,_,_,_,_,_,_) cormorant_0 {}
0064: store
0065: [->(:set, 12)<-] (12,_,_,_,_,_,_,_) cormorant_0 {}
0065: leaving scope 0
0067: [->(:set, 12)<-] (12,_,_,_,_,_,_,_) cormorant_0 {}
0067: ***leaving block before pop stack depth: 1
0069: [->(:set, 12)<-] (12,_,_,_,_,_,_,_) cormorant_0 {}
0069: popping back from 1 to 0
0071: [->(:set, 12)<-] (12,_,_,_,_,_,_,_) cormorant_0 {}
0071: pop
0072: [] (12,_,_,_,_,_,_,_) cormorant_0 {}
0072: load
yielded from cormorant_0
{"result":"12","io":{"stdout":{"proto":["text-stream","0.1.0"],"data":""},"turtle":{"proto":["turtle-graphics","0.1.0"],"data":[]}}}

View File

@ -1,249 +0,0 @@
=== vm run: test ===
0000: [] (_,_,_,_,_,_,_,_)
0000: reset_match
0001: [] (_,_,_,_,_,_,_,_)
0001: constant 00000: 2
0004: [->2<-] (_,_,_,_,_,_,_,_)
0004: match
0005: [->2<-] (_,_,_,_,_,_,_,_)
0005: panic_if_no_match
0006: [->2<-] (_,_,_,_,_,_,_,_)
0006: push_list
0007: [->2<-|[]] (_,_,_,_,_,_,_,_)
0007: constant 00001: 1
0010: [->2<-|[]|1] (_,_,_,_,_,_,_,_)
0010: append_list
0011: [->2<-|[1]] (_,_,_,_,_,_,_,_)
0011: constant 00000: 2
0014: [->2<-|[1]|2] (_,_,_,_,_,_,_,_)
0014: append_list
0015: [->2<-|[1, 2]] (_,_,_,_,_,_,_,_)
0015: constant 00002: 3
0018: [->2<-|[1, 2]|3] (_,_,_,_,_,_,_,_)
0018: append_list
0019: [->2<-|[1, 2, 3]] (_,_,_,_,_,_,_,_)
0019: ***entering loop with stack depth of 2
0021: [->2<-|[1, 2, 3]] (_,_,_,_,_,_,_,_)
0021: store_n 001
0023: [->2<-] ([1, 2, 3],_,_,_,_,_,_,_)
0023: ***after store, stack depth is now 2
0025: [->2<-] ([1, 2, 3],_,_,_,_,_,_,_)
0025: load
0026: [->2<-|[1, 2, 3]] (_,_,_,_,_,_,_,_)
0026: ***after load, stack depth is now 2
0028: [->2<-|[1, 2, 3]] (_,_,_,_,_,_,_,_)
0028: reset_match
0029: [->2<-|[1, 2, 3]] (_,_,_,_,_,_,_,_)
0029: match_depth 000
0031: [->2<-|[1, 2, 3]] (_,_,_,_,_,_,_,_)
0031: match_list 000
0033: [->2<-|[1, 2, 3]] (_,_,_,_,_,_,_,_)
0033: jump_if_no_match 00006
0042: [->2<-|[1, 2, 3]] (_,_,_,_,_,_,_,_)
0042: jump_if_no_match 00010
0055: [->2<-|[1, 2, 3]] (_,_,_,_,_,_,_,_)
0055: reset_match
0056: [->2<-|[1, 2, 3]] (_,_,_,_,_,_,_,_)
0056: match_depth 000
0058: [->2<-|[1, 2, 3]] (_,_,_,_,_,_,_,_)
0058: match_list 001
0060: [->2<-|[1, 2, 3]] (_,_,_,_,_,_,_,_)
0060: jump_if_no_match 00012
0075: [->2<-|[1, 2, 3]] (_,_,_,_,_,_,_,_)
0075: jump_if_no_match 00030
0108: [->2<-|[1, 2, 3]] (_,_,_,_,_,_,_,_)
0108: reset_match
0109: [->2<-|[1, 2, 3]] (_,_,_,_,_,_,_,_)
0109: match_depth 000
0111: [->2<-|[1, 2, 3]] (_,_,_,_,_,_,_,_)
0111: match_splatted_list 002
0113: [->2<-|[1, 2, 3]] (_,_,_,_,_,_,_,_)
0113: jump_if_no_match 00019
0116: [->2<-|[1, 2, 3]] (_,_,_,_,_,_,_,_)
0116: load_splatted_list 002
0118: [->2<-|[1, 2, 3]|1|[2, 3]] (_,_,_,_,_,_,_,_)
0118: match_depth 001
0120: [->2<-|[1, 2, 3]|1|[2, 3]] (_,_,_,_,_,_,_,_)
0120: match
0121: [->2<-|[1, 2, 3]|1|[2, 3]] (_,_,_,_,_,_,_,_)
0121: jump_if_no_match 00010
0124: [->2<-|[1, 2, 3]|1|[2, 3]] (_,_,_,_,_,_,_,_)
0124: match_depth 000
0126: [->2<-|[1, 2, 3]|1|[2, 3]] (_,_,_,_,_,_,_,_)
0126: match
0127: [->2<-|[1, 2, 3]|1|[2, 3]] (_,_,_,_,_,_,_,_)
0127: jump_if_no_match 00004
0130: [->2<-|[1, 2, 3]|1|[2, 3]] (_,_,_,_,_,_,_,_)
0130: jump 00002
0135: [->2<-|[1, 2, 3]|1|[2, 3]] (_,_,_,_,_,_,_,_)
0135: jump_if_no_match 00068
0138: [->2<-|[1, 2, 3]|1|[2, 3]] (_,_,_,_,_,_,_,_)
0138: ***before visiting body, the stack depth is 4
0140: [->2<-|[1, 2, 3]|1|[2, 3]] (_,_,_,_,_,_,_,_)
0140: ***calling function eq? stack depth: 4
0142: [->2<-|[1, 2, 3]|1|[2, 3]] (_,_,_,_,_,_,_,_)
0142: ***calling function first stack depth: 4
0144: [->2<-|[1, 2, 3]|1|[2, 3]] (_,_,_,_,_,_,_,_)
0144: resolving binding `xs` in test
0146: [->2<-|[1, 2, 3]|1|[2, 3]] (_,_,_,_,_,_,_,_)
0146: push_binding 003
0148: [->2<-|[1, 2, 3]|1|[2, 3]|[2, 3]] (_,_,_,_,_,_,_,_)
0148: resolving binding `first` in test
0150: [->2<-|[1, 2, 3]|1|[2, 3]|[2, 3]] (_,_,_,_,_,_,_,_)
0150: constant 00004: :first
0153: [->2<-|[1, 2, 3]|1|[2, 3]|[2, 3]|:first] (_,_,_,_,_,_,_,_)
0153: push_global
0154: [->2<-|[1, 2, 3]|1|[2, 3]|[2, 3]|fn first] (_,_,_,_,_,_,_,_)
0154: ***after 1 args stack depth: 6
0156: [->2<-|[1, 2, 3]|1|[2, 3]|[2, 3]|fn first] (_,_,_,_,_,_,_,_)
0156: call 001
=== calling into fn first/1 ===
0000: [2|[1, 2, 3]|1|[2, 3]|->[2, 3]<-] (_,_,_,_,_,_,_,_)
0000: reset_match
0001: [2|[1, 2, 3]|1|[2, 3]|->[2, 3]<-] (_,_,_,_,_,_,_,_)
0001: match_depth 000
0003: [2|[1, 2, 3]|1|[2, 3]|->[2, 3]<-] (_,_,_,_,_,_,_,_)
0003: match_list 000
0005: [2|[1, 2, 3]|1|[2, 3]|->[2, 3]<-] (_,_,_,_,_,_,_,_)
0005: jump_if_no_match 00006
0014: [2|[1, 2, 3]|1|[2, 3]|->[2, 3]<-] (_,_,_,_,_,_,_,_)
0014: jump_if_no_match 00003
0020: [2|[1, 2, 3]|1|[2, 3]|->[2, 3]<-] (_,_,_,_,_,_,_,_)
0020: jump_if_no_match 00005
0028: [2|[1, 2, 3]|1|[2, 3]|->[2, 3]<-] (_,_,_,_,_,_,_,_)
0028: match_depth 000
0030: [2|[1, 2, 3]|1|[2, 3]|->[2, 3]<-] (_,_,_,_,_,_,_,_)
0030: constant 00000: :list
0033: [2|[1, 2, 3]|1|[2, 3]|->[2, 3]<-|:list] (_,_,_,_,_,_,_,_)
0033: match_type
0034: [2|[1, 2, 3]|1|[2, 3]|->[2, 3]<-] (_,_,_,_,_,_,_,_)
0034: jump_if_no_match 00003
0037: [2|[1, 2, 3]|1|[2, 3]|->[2, 3]<-] (_,_,_,_,_,_,_,_)
0037: jump 00000
0040: [2|[1, 2, 3]|1|[2, 3]|->[2, 3]<-] (_,_,_,_,_,_,_,_)
0040: jump_if_no_match 00024
0043: [2|[1, 2, 3]|1|[2, 3]|->[2, 3]<-] (_,_,_,_,_,_,_,_)
0043: ***accessing keyword: base :first stack depth: 1
0045: [2|[1, 2, 3]|1|[2, 3]|->[2, 3]<-] (_,_,_,_,_,_,_,_)
0045: resolving binding `base` in first
0047: [2|[1, 2, 3]|1|[2, 3]|->[2, 3]<-] (_,_,_,_,_,_,_,_)
0047: get_upvalue 000
0049: [2|[1, 2, 3]|1|[2, 3]|->[2, 3]<-|#{:rest fn rest/base...] (_,_,_,_,_,_,_,_)
0049: constant 00001: :first
0052: [2|[1, 2, 3]|1|[2, 3]|->[2, 3]<-|#{:rest fn rest/base...|:first] (_,_,_,_,_,_,_,_)
0052: get_key
0053: [2|[1, 2, 3]|1|[2, 3]|->[2, 3]<-|fn first/base] (_,_,_,_,_,_,_,_)
0053: ***after keyword access stack depth: 2
0055: [2|[1, 2, 3]|1|[2, 3]|->[2, 3]<-|fn first/base] (_,_,_,_,_,_,_,_)
0055: stash
0056: [2|[1, 2, 3]|1|[2, 3]|->[2, 3]<-|fn first/base] (fn first/base,_,_,_,_,_,_,_)
0056: pop
0057: [2|[1, 2, 3]|1|[2, 3]|->[2, 3]<-] (fn first/base,_,_,_,_,_,_,_)
0057: resolving binding `xs` in first
0059: [2|[1, 2, 3]|1|[2, 3]|->[2, 3]<-] (fn first/base,_,_,_,_,_,_,_)
0059: push_binding 000
0061: [2|[1, 2, 3]|1|[2, 3]|->[2, 3]<-|[2, 3]] (fn first/base,_,_,_,_,_,_,_)
0061: load
0062: [2|[1, 2, 3]|1|[2, 3]|->[2, 3]<-|[2, 3]|fn first/base] (_,_,_,_,_,_,_,_)
0062: tail_call 001
=== tail call into fn first/base/1 from first ===
0158: [->2<-|[1, 2, 3]|1|[2, 3]|2] (_,_,_,_,_,_,_,_)
0158: resolving binding `test` in test
0160: [->2<-|[1, 2, 3]|1|[2, 3]|2] (_,_,_,_,_,_,_,_)
0160: push_binding 000
0162: [->2<-|[1, 2, 3]|1|[2, 3]|2|2] (_,_,_,_,_,_,_,_)
0162: resolving binding `eq?` in test
0164: [->2<-|[1, 2, 3]|1|[2, 3]|2|2] (_,_,_,_,_,_,_,_)
0164: constant 00003: :eq?
0167: [->2<-|[1, 2, 3]|1|[2, 3]|2|2|:eq?] (_,_,_,_,_,_,_,_)
0167: push_global
0168: [->2<-|[1, 2, 3]|1|[2, 3]|2|2|fn eq?] (_,_,_,_,_,_,_,_)
0168: ***after 2 args stack depth: 7
0170: [->2<-|[1, 2, 3]|1|[2, 3]|2|2|fn eq?] (_,_,_,_,_,_,_,_)
0170: call 002
=== calling into fn eq?/2 ===
0000: [2|[1, 2, 3]|1|[2, 3]|->2<-|2] (_,_,_,_,_,_,_,_)
0000: reset_match
0001: [2|[1, 2, 3]|1|[2, 3]|->2<-|2] (_,_,_,_,_,_,_,_)
0001: match_depth 001
0003: [2|[1, 2, 3]|1|[2, 3]|->2<-|2] (_,_,_,_,_,_,_,_)
0003: match
0004: [2|[1, 2, 3]|1|[2, 3]|->2<-|2] (_,_,_,_,_,_,_,_)
0004: jump_if_no_match 00009
0007: [2|[1, 2, 3]|1|[2, 3]|->2<-|2] (_,_,_,_,_,_,_,_)
0007: match_depth 000
0009: [2|[1, 2, 3]|1|[2, 3]|->2<-|2] (_,_,_,_,_,_,_,_)
0009: match
0010: [2|[1, 2, 3]|1|[2, 3]|->2<-|2] (_,_,_,_,_,_,_,_)
0010: jump_if_no_match 00003
0013: [2|[1, 2, 3]|1|[2, 3]|->2<-|2] (_,_,_,_,_,_,_,_)
0013: jump 00000
0016: [2|[1, 2, 3]|1|[2, 3]|->2<-|2] (_,_,_,_,_,_,_,_)
0016: jump_if_no_match 00029
0019: [2|[1, 2, 3]|1|[2, 3]|->2<-|2] (_,_,_,_,_,_,_,_)
0019: ***accessing keyword: base :eq? stack depth: 2
0021: [2|[1, 2, 3]|1|[2, 3]|->2<-|2] (_,_,_,_,_,_,_,_)
0021: resolving binding `base` in eq?
0023: [2|[1, 2, 3]|1|[2, 3]|->2<-|2] (_,_,_,_,_,_,_,_)
0023: get_upvalue 000
0025: [2|[1, 2, 3]|1|[2, 3]|->2<-|2|#{:rest fn rest/base...] (_,_,_,_,_,_,_,_)
0025: constant 00000: :eq?
0028: [2|[1, 2, 3]|1|[2, 3]|->2<-|2|#{:rest fn rest/base...|:eq?] (_,_,_,_,_,_,_,_)
0028: get_key
0029: [2|[1, 2, 3]|1|[2, 3]|->2<-|2|fn eq?/base] (_,_,_,_,_,_,_,_)
0029: ***after keyword access stack depth: 3
0031: [2|[1, 2, 3]|1|[2, 3]|->2<-|2|fn eq?/base] (_,_,_,_,_,_,_,_)
0031: stash
0032: [2|[1, 2, 3]|1|[2, 3]|->2<-|2|fn eq?/base] (fn eq?/base,_,_,_,_,_,_,_)
0032: pop
0033: [2|[1, 2, 3]|1|[2, 3]|->2<-|2] (fn eq?/base,_,_,_,_,_,_,_)
0033: resolving binding `x` in eq?
0035: [2|[1, 2, 3]|1|[2, 3]|->2<-|2] (fn eq?/base,_,_,_,_,_,_,_)
0035: push_binding 000
0037: [2|[1, 2, 3]|1|[2, 3]|->2<-|2|2] (fn eq?/base,_,_,_,_,_,_,_)
0037: resolving binding `y` in eq?
0039: [2|[1, 2, 3]|1|[2, 3]|->2<-|2|2] (fn eq?/base,_,_,_,_,_,_,_)
0039: push_binding 001
0041: [2|[1, 2, 3]|1|[2, 3]|->2<-|2|2|2] (fn eq?/base,_,_,_,_,_,_,_)
0041: load
0042: [2|[1, 2, 3]|1|[2, 3]|->2<-|2|2|2|fn eq?/base] (_,_,_,_,_,_,_,_)
0042: tail_call 002
=== tail call into fn eq?/base/2 from eq? ===
0172: [->2<-|[1, 2, 3]|1|[2, 3]|true] (_,_,_,_,_,_,_,_)
0172: jump_if_false 00004
0175: [->2<-|[1, 2, 3]|1|[2, 3]] (_,_,_,_,_,_,_,_)
0175: true
0176: [->2<-|[1, 2, 3]|1|[2, 3]|true] (_,_,_,_,_,_,_,_)
0176: jump 00018
0197: [->2<-|[1, 2, 3]|1|[2, 3]|true] (_,_,_,_,_,_,_,_)
0197: ***after visiting loop body, the stack depth is 5
0199: [->2<-|[1, 2, 3]|1|[2, 3]|true] (_,_,_,_,_,_,_,_)
0199: store
0200: [->2<-|[1, 2, 3]|1|[2, 3]|_] (true,_,_,_,_,_,_,_)
0200: pop
0201: [->2<-|[1, 2, 3]|1|[2, 3]] (true,_,_,_,_,_,_,_)
0201: pop
0202: [->2<-|[1, 2, 3]|1] (true,_,_,_,_,_,_,_)
0202: pop
0203: [->2<-|[1, 2, 3]] (true,_,_,_,_,_,_,_)
0203: jump 00001
0207: [->2<-|[1, 2, 3]] (true,_,_,_,_,_,_,_)
0207: load
0208: [->2<-|[1, 2, 3]|true] (_,_,_,_,_,_,_,_)
0208: store
0209: [->2<-|[1, 2, 3]|_] (true,_,_,_,_,_,_,_)
0209: pop_n 002
0211: [->2<-] (true,_,_,_,_,_,_,_)
0211: load
0212: [->2<-] (_,_,_,_,_,_,_,_)
true
**********
**********

View File

@ -1,291 +0,0 @@
=== vm run: test ===
0000: [] (_,_,_,_,_,_,_,_)
0000: reset_match
0001: [] (_,_,_,_,_,_,_,_)
0001: constant 00000: 4
0004: [->4<-] (_,_,_,_,_,_,_,_)
0004: match
0005: [->4<-] (_,_,_,_,_,_,_,_)
0005: panic_if_no_match
0006: [->4<-] (_,_,_,_,_,_,_,_)
0006: push_list
0007: [->4<-|[]] (_,_,_,_,_,_,_,_)
0007: constant 00001: 1
0010: [->4<-|[]|1] (_,_,_,_,_,_,_,_)
0010: append_list
0011: [->4<-|[1]] (_,_,_,_,_,_,_,_)
0011: constant 00002: 2
0014: [->4<-|[1]|2] (_,_,_,_,_,_,_,_)
0014: append_list
0015: [->4<-|[1, 2]] (_,_,_,_,_,_,_,_)
0015: constant 00003: 3
0018: [->4<-|[1, 2]|3] (_,_,_,_,_,_,_,_)
0018: append_list
0019: [->4<-|[1, 2, 3]] (_,_,_,_,_,_,_,_)
0019: ***entering loop with stack depth of 2
0021: [->4<-|[1, 2, 3]] (_,_,_,_,_,_,_,_)
0021: store_n 001
0023: [->4<-] ([1, 2, 3],_,_,_,_,_,_,_)
0023: ***after store, stack depth is now 2
0025: [->4<-] ([1, 2, 3],_,_,_,_,_,_,_)
0025: load
0026: [->4<-|[1, 2, 3]] (_,_,_,_,_,_,_,_)
0026: ***after load, stack depth is now 2
0028: [->4<-|[1, 2, 3]] (_,_,_,_,_,_,_,_)
0028: reset_match
0029: [->4<-|[1, 2, 3]] (_,_,_,_,_,_,_,_)
0029: match_depth 000
0031: [->4<-|[1, 2, 3]] (_,_,_,_,_,_,_,_)
0031: match_list 000
0033: [->4<-|[1, 2, 3]] (_,_,_,_,_,_,_,_)
0033: jump_if_no_match 00006
0042: [->4<-|[1, 2, 3]] (_,_,_,_,_,_,_,_)
0042: jump_if_no_match 00010
0055: [->4<-|[1, 2, 3]] (_,_,_,_,_,_,_,_)
0055: reset_match
0056: [->4<-|[1, 2, 3]] (_,_,_,_,_,_,_,_)
0056: match_depth 000
0058: [->4<-|[1, 2, 3]] (_,_,_,_,_,_,_,_)
0058: match_list 001
0060: [->4<-|[1, 2, 3]] (_,_,_,_,_,_,_,_)
0060: jump_if_no_match 00012
0075: [->4<-|[1, 2, 3]] (_,_,_,_,_,_,_,_)
0075: jump_if_no_match 00030
0108: [->4<-|[1, 2, 3]] (_,_,_,_,_,_,_,_)
0108: reset_match
0109: [->4<-|[1, 2, 3]] (_,_,_,_,_,_,_,_)
0109: match_depth 000
0111: [->4<-|[1, 2, 3]] (_,_,_,_,_,_,_,_)
0111: match_splatted_list 002
0113: [->4<-|[1, 2, 3]] (_,_,_,_,_,_,_,_)
0113: jump_if_no_match 00019
0116: [->4<-|[1, 2, 3]] (_,_,_,_,_,_,_,_)
0116: load_splatted_list 002
0118: [->4<-|[1, 2, 3]|1|[2, 3]] (_,_,_,_,_,_,_,_)
0118: match_depth 001
0120: [->4<-|[1, 2, 3]|1|[2, 3]] (_,_,_,_,_,_,_,_)
0120: match
0121: [->4<-|[1, 2, 3]|1|[2, 3]] (_,_,_,_,_,_,_,_)
0121: jump_if_no_match 00010
0124: [->4<-|[1, 2, 3]|1|[2, 3]] (_,_,_,_,_,_,_,_)
0124: match_depth 000
0126: [->4<-|[1, 2, 3]|1|[2, 3]] (_,_,_,_,_,_,_,_)
0126: match
0127: [->4<-|[1, 2, 3]|1|[2, 3]] (_,_,_,_,_,_,_,_)
0127: jump_if_no_match 00004
0130: [->4<-|[1, 2, 3]|1|[2, 3]] (_,_,_,_,_,_,_,_)
0130: jump 00002
0135: [->4<-|[1, 2, 3]|1|[2, 3]] (_,_,_,_,_,_,_,_)
0135: jump_if_no_match 00068
0138: [->4<-|[1, 2, 3]|1|[2, 3]] (_,_,_,_,_,_,_,_)
0138: ***before visiting body, the stack depth is 4
0140: [->4<-|[1, 2, 3]|1|[2, 3]] (_,_,_,_,_,_,_,_)
0140: ***calling function eq? stack depth: 4
0142: [->4<-|[1, 2, 3]|1|[2, 3]] (_,_,_,_,_,_,_,_)
0142: ***calling function first stack depth: 4
0144: [->4<-|[1, 2, 3]|1|[2, 3]] (_,_,_,_,_,_,_,_)
0144: resolving binding `xs` in test
0146: [->4<-|[1, 2, 3]|1|[2, 3]] (_,_,_,_,_,_,_,_)
0146: push_binding 003
0148: [->4<-|[1, 2, 3]|1|[2, 3]|[2, 3]] (_,_,_,_,_,_,_,_)
0148: resolving binding `first` in test
0150: [->4<-|[1, 2, 3]|1|[2, 3]|[2, 3]] (_,_,_,_,_,_,_,_)
0150: constant 00005: :first
0153: [->4<-|[1, 2, 3]|1|[2, 3]|[2, 3]|:first] (_,_,_,_,_,_,_,_)
0153: push_global
0154: [->4<-|[1, 2, 3]|1|[2, 3]|[2, 3]|fn first] (_,_,_,_,_,_,_,_)
0154: ***after 1 args stack depth: 6
0156: [->4<-|[1, 2, 3]|1|[2, 3]|[2, 3]|fn first] (_,_,_,_,_,_,_,_)
0156: call 001
=== calling into fn first/1 ===
0000: [4|[1, 2, 3]|1|[2, 3]|->[2, 3]<-] (_,_,_,_,_,_,_,_)
0000: reset_match
0001: [4|[1, 2, 3]|1|[2, 3]|->[2, 3]<-] (_,_,_,_,_,_,_,_)
0001: match_depth 000
0003: [4|[1, 2, 3]|1|[2, 3]|->[2, 3]<-] (_,_,_,_,_,_,_,_)
0003: match_list 000
0005: [4|[1, 2, 3]|1|[2, 3]|->[2, 3]<-] (_,_,_,_,_,_,_,_)
0005: jump_if_no_match 00006
0014: [4|[1, 2, 3]|1|[2, 3]|->[2, 3]<-] (_,_,_,_,_,_,_,_)
0014: jump_if_no_match 00003
0020: [4|[1, 2, 3]|1|[2, 3]|->[2, 3]<-] (_,_,_,_,_,_,_,_)
0020: jump_if_no_match 00005
0028: [4|[1, 2, 3]|1|[2, 3]|->[2, 3]<-] (_,_,_,_,_,_,_,_)
0028: match_depth 000
0030: [4|[1, 2, 3]|1|[2, 3]|->[2, 3]<-] (_,_,_,_,_,_,_,_)
0030: constant 00000: :list
0033: [4|[1, 2, 3]|1|[2, 3]|->[2, 3]<-|:list] (_,_,_,_,_,_,_,_)
0033: match_type
0034: [4|[1, 2, 3]|1|[2, 3]|->[2, 3]<-] (_,_,_,_,_,_,_,_)
0034: jump_if_no_match 00003
0037: [4|[1, 2, 3]|1|[2, 3]|->[2, 3]<-] (_,_,_,_,_,_,_,_)
0037: jump 00000
0040: [4|[1, 2, 3]|1|[2, 3]|->[2, 3]<-] (_,_,_,_,_,_,_,_)
0040: jump_if_no_match 00024
0043: [4|[1, 2, 3]|1|[2, 3]|->[2, 3]<-] (_,_,_,_,_,_,_,_)
0043: ***accessing keyword: base :first stack depth: 1
0045: [4|[1, 2, 3]|1|[2, 3]|->[2, 3]<-] (_,_,_,_,_,_,_,_)
0045: resolving binding `base` in first
0047: [4|[1, 2, 3]|1|[2, 3]|->[2, 3]<-] (_,_,_,_,_,_,_,_)
0047: get_upvalue 000
0049: [4|[1, 2, 3]|1|[2, 3]|->[2, 3]<-|#{:append fn append/...] (_,_,_,_,_,_,_,_)
0049: constant 00001: :first
0052: [4|[1, 2, 3]|1|[2, 3]|->[2, 3]<-|#{:append fn append/...|:first] (_,_,_,_,_,_,_,_)
0052: get_key?
0053: [4|[1, 2, 3]|1|[2, 3]|->[2, 3]<-|fn first/base] (_,_,_,_,_,_,_,_)
0053: ***after keyword access stack depth: 2
0055: [4|[1, 2, 3]|1|[2, 3]|->[2, 3]<-|fn first/base] (_,_,_,_,_,_,_,_)
0055: stash
0056: [4|[1, 2, 3]|1|[2, 3]|->[2, 3]<-|fn first/base] (fn first/base,_,_,_,_,_,_,_)
0056: pop
0057: [4|[1, 2, 3]|1|[2, 3]|->[2, 3]<-] (fn first/base,_,_,_,_,_,_,_)
0057: resolving binding `xs` in first
0059: [4|[1, 2, 3]|1|[2, 3]|->[2, 3]<-] (fn first/base,_,_,_,_,_,_,_)
0059: push_binding 000
0061: [4|[1, 2, 3]|1|[2, 3]|->[2, 3]<-|[2, 3]] (fn first/base,_,_,_,_,_,_,_)
0061: load
0062: [4|[1, 2, 3]|1|[2, 3]|->[2, 3]<-|[2, 3]|fn first/base] (_,_,_,_,_,_,_,_)
0062: tail_call 001
=== tail call into fn first/base/1 from first ===
0158: [->4<-|[1, 2, 3]|1|[2, 3]|2] (_,_,_,_,_,_,_,_)
0158: resolving binding `test` in test
0160: [->4<-|[1, 2, 3]|1|[2, 3]|2] (_,_,_,_,_,_,_,_)
0160: push_binding 000
0162: [->4<-|[1, 2, 3]|1|[2, 3]|2|4] (_,_,_,_,_,_,_,_)
0162: resolving binding `eq?` in test
0164: [->4<-|[1, 2, 3]|1|[2, 3]|2|4] (_,_,_,_,_,_,_,_)
0164: constant 00004: :eq?
0167: [->4<-|[1, 2, 3]|1|[2, 3]|2|4|:eq?] (_,_,_,_,_,_,_,_)
0167: push_global
0168: [->4<-|[1, 2, 3]|1|[2, 3]|2|4|fn eq?] (_,_,_,_,_,_,_,_)
0168: ***after 2 args stack depth: 7
0170: [->4<-|[1, 2, 3]|1|[2, 3]|2|4|fn eq?] (_,_,_,_,_,_,_,_)
0170: call 002
=== calling into fn eq?/2 ===
0000: [4|[1, 2, 3]|1|[2, 3]|->2<-|4] (_,_,_,_,_,_,_,_)
0000: reset_match
0001: [4|[1, 2, 3]|1|[2, 3]|->2<-|4] (_,_,_,_,_,_,_,_)
0001: match_depth 001
0003: [4|[1, 2, 3]|1|[2, 3]|->2<-|4] (_,_,_,_,_,_,_,_)
0003: match
0004: [4|[1, 2, 3]|1|[2, 3]|->2<-|4] (_,_,_,_,_,_,_,_)
0004: jump_if_no_match 00009
0007: [4|[1, 2, 3]|1|[2, 3]|->2<-|4] (_,_,_,_,_,_,_,_)
0007: match_depth 000
0009: [4|[1, 2, 3]|1|[2, 3]|->2<-|4] (_,_,_,_,_,_,_,_)
0009: match
0010: [4|[1, 2, 3]|1|[2, 3]|->2<-|4] (_,_,_,_,_,_,_,_)
0010: jump_if_no_match 00003
0013: [4|[1, 2, 3]|1|[2, 3]|->2<-|4] (_,_,_,_,_,_,_,_)
0013: jump 00000
0016: [4|[1, 2, 3]|1|[2, 3]|->2<-|4] (_,_,_,_,_,_,_,_)
0016: jump_if_no_match 00029
0019: [4|[1, 2, 3]|1|[2, 3]|->2<-|4] (_,_,_,_,_,_,_,_)
0019: ***accessing keyword: base :eq? stack depth: 2
0021: [4|[1, 2, 3]|1|[2, 3]|->2<-|4] (_,_,_,_,_,_,_,_)
0021: resolving binding `base` in eq?
0023: [4|[1, 2, 3]|1|[2, 3]|->2<-|4] (_,_,_,_,_,_,_,_)
0023: get_upvalue 000
0025: [4|[1, 2, 3]|1|[2, 3]|->2<-|4|#{:append fn append/...] (_,_,_,_,_,_,_,_)
0025: constant 00000: :eq?
0028: [4|[1, 2, 3]|1|[2, 3]|->2<-|4|#{:append fn append/...|:eq?] (_,_,_,_,_,_,_,_)
0028: get_key
0029: [4|[1, 2, 3]|1|[2, 3]|->2<-|4|fn eq?/base] (_,_,_,_,_,_,_,_)
0029: ***after keyword access stack depth: 3
0031: [4|[1, 2, 3]|1|[2, 3]|->2<-|4|fn eq?/base] (_,_,_,_,_,_,_,_)
0031: stash
0032: [4|[1, 2, 3]|1|[2, 3]|->2<-|4|fn eq?/base] (fn eq?/base,_,_,_,_,_,_,_)
0032: pop
0033: [4|[1, 2, 3]|1|[2, 3]|->2<-|4] (fn eq?/base,_,_,_,_,_,_,_)
0033: resolving binding `x` in eq?
0035: [4|[1, 2, 3]|1|[2, 3]|->2<-|4] (fn eq?/base,_,_,_,_,_,_,_)
0035: push_binding 000
0037: [4|[1, 2, 3]|1|[2, 3]|->2<-|4|2] (fn eq?/base,_,_,_,_,_,_,_)
0037: resolving binding `y` in eq?
0039: [4|[1, 2, 3]|1|[2, 3]|->2<-|4|2] (fn eq?/base,_,_,_,_,_,_,_)
0039: push_binding 001
0041: [4|[1, 2, 3]|1|[2, 3]|->2<-|4|2|4] (fn eq?/base,_,_,_,_,_,_,_)
0041: load
0042: [4|[1, 2, 3]|1|[2, 3]|->2<-|4|2|4|fn eq?/base] (_,_,_,_,_,_,_,_)
0042: tail_call 002
=== tail call into fn eq?/base/2 from eq? ===
0172: [->4<-|[1, 2, 3]|1|[2, 3]|false] (_,_,_,_,_,_,_,_)
0172: jump_if_false 00004
0179: [->4<-|[1, 2, 3]|1|[2, 3]] (_,_,_,_,_,_,_,_)
0179: before visiting recur args the compiler thinks the stack depth is 5
0181: [->4<-|[1, 2, 3]|1|[2, 3]] (_,_,_,_,_,_,_,_)
0181: recur arg: 0
0183: [->4<-|[1, 2, 3]|1|[2, 3]] (_,_,_,_,_,_,_,_)
0183: resolving binding `xs` in test
0185: [->4<-|[1, 2, 3]|1|[2, 3]] (_,_,_,_,_,_,_,_)
0185: push_binding 003
0187: [->4<-|[1, 2, 3]|1|[2, 3]|[2, 3]] (_,_,_,_,_,_,_,_)
0187: after visiting recur args the compiler thinks the stack depth is 6
0189: [->4<-|[1, 2, 3]|1|[2, 3]|[2, 3]] (_,_,_,_,_,_,_,_)
0189: store_n 001
0191: [->4<-|[1, 2, 3]|1|[2, 3]] ([2, 3],_,_,_,_,_,_,_)
0191: pop_n 004
0193: [] ([2, 3],_,_,_,_,_,_,_)
0193: load
0194: [->[2, 3]<-] (_,_,_,_,_,_,_,_)
0194: jump_back 00168
0026: [->[2, 3]<-] (_,_,_,_,_,_,_,_)
0026: ***after load, stack depth is now 2
0028: [->[2, 3]<-] (_,_,_,_,_,_,_,_)
0028: reset_match
0029: [->[2, 3]<-] (_,_,_,_,_,_,_,_)
0029: match_depth 000
0031: [->[2, 3]<-] (_,_,_,_,_,_,_,_)
0031: match_list 000
0033: [->[2, 3]<-] (_,_,_,_,_,_,_,_)
0033: jump_if_no_match 00006
0042: [->[2, 3]<-] (_,_,_,_,_,_,_,_)
0042: jump_if_no_match 00010
0055: [->[2, 3]<-] (_,_,_,_,_,_,_,_)
0055: reset_match
0056: [->[2, 3]<-] (_,_,_,_,_,_,_,_)
0056: match_depth 000
0058: [->[2, 3]<-] (_,_,_,_,_,_,_,_)
0058: match_list 001
0060: [->[2, 3]<-] (_,_,_,_,_,_,_,_)
0060: jump_if_no_match 00012
0075: [->[2, 3]<-] (_,_,_,_,_,_,_,_)
0075: jump_if_no_match 00030
0108: [->[2, 3]<-] (_,_,_,_,_,_,_,_)
0108: reset_match
0109: [->[2, 3]<-] (_,_,_,_,_,_,_,_)
0109: match_depth 000
0111: [->[2, 3]<-] (_,_,_,_,_,_,_,_)
0111: match_splatted_list 002
0113: [->[2, 3]<-] (_,_,_,_,_,_,_,_)
0113: jump_if_no_match 00019
0116: [->[2, 3]<-] (_,_,_,_,_,_,_,_)
0116: load_splatted_list 002
0118: [->[2, 3]<-|2|[3]] (_,_,_,_,_,_,_,_)
0118: match_depth 001
0120: [->[2, 3]<-|2|[3]] (_,_,_,_,_,_,_,_)
0120: match
0121: [->[2, 3]<-|2|[3]] (_,_,_,_,_,_,_,_)
0121: jump_if_no_match 00010
0124: [->[2, 3]<-|2|[3]] (_,_,_,_,_,_,_,_)
0124: match_depth 000
0126: [->[2, 3]<-|2|[3]] (_,_,_,_,_,_,_,_)
0126: match
0127: [->[2, 3]<-|2|[3]] (_,_,_,_,_,_,_,_)
0127: jump_if_no_match 00004
0130: [->[2, 3]<-|2|[3]] (_,_,_,_,_,_,_,_)
0130: jump 00002
0135: [->[2, 3]<-|2|[3]] (_,_,_,_,_,_,_,_)
0135: jump_if_no_match 00068
0138: [->[2, 3]<-|2|[3]] (_,_,_,_,_,_,_,_)
0138: ***before visiting body, the stack depth is 4
0140: [->[2, 3]<-|2|[3]] (_,_,_,_,_,_,_,_)
0140: ***calling function eq? stack depth: 4
0142: [->[2, 3]<-|2|[3]] (_,_,_,_,_,_,_,_)
0142: ***calling function first stack depth: 4
0144: [->[2, 3]<-|2|[3]] (_,_,_,_,_,_,_,_)
0144: resolving binding `xs` in test
0146: [->[2, 3]<-|2|[3]] (_,_,_,_,_,_,_,_)
0146: push_binding 003
thread 'main' panicked at src/vm.rs:313:51:
index out of bounds: the len is 3 but the index is 3

View File

@ -117,7 +117,7 @@ pub fn words(str: &Value) -> Value {
let mut words = Vector::new();
let mut word = String::new();
for char in str.chars() {
if char.is_alphanumeric() {
if char.is_alphanumeric() || char == '\'' {
word.push(char)
} else if !word.is_empty() {
words.push_back(Value::from_string(word));

View File

@ -1,6 +1,5 @@
use crate::ast::{Ast, StringPart};
use crate::chunk::{Chunk, StrPattern};
use crate::errors::line_number;
use crate::op::Op;
use crate::spans::Spanned;
use crate::value::*;
@ -1115,6 +1114,7 @@ impl Compiler {
self.emit_op(Op::Spawn);
}
Receive(clauses) => {
self.msg("********starting receive".to_string());
let tail_pos = self.tail_pos;
self.emit_op(Op::ClearMessage);
let receive_begin = self.len();
@ -1158,7 +1158,8 @@ impl Compiler {
}
self.pop_n(self.stack_depth - stack_depth);
self.emit_op(Op::Load);
self.stack_depth += 1;
// self.stack_depth += 1;
self.msg("********receive completed".to_string());
}
MatchClause(..) => unreachable!(),
Fn(name, body, doc) => {

View File

@ -52,7 +52,7 @@ use value::{Value, Key};
mod vm;
use vm::Creature;
const PRELUDE: &str = include_str!("../assets/test_prelude.ld");
const PRELUDE: &str = include_str!("../assets/prelude.ld");
fn prelude() -> HashMap<Key, Value> {
let tokens = lexer().parse(PRELUDE).into_output_errors().0.unwrap();

View File

@ -1,12 +1,6 @@
use phf::phf_map;
use rudus::value::Value;
use std::env;
const KEYWORDS: phf::Map<&'static str, Value> = phf_map! {
"ok" => Value::keyword("ok"),
"err" => Value::keyword("err"),
}
pub fn main() {
env::set_var("RUST_BACKTRACE", "1");
println!("Hello, world.")

View File

@ -103,10 +103,16 @@ impl<'a> Validator<'a> {
}
fn declare_fn(&mut self, name: String) {
if name.is_empty() {
return;
}
self.locals.push((name, self.span, FnInfo::Declared));
}
fn define_fn(&mut self, name: String, info: FnInfo) {
if name.is_empty() {
return;
}
let i = self.locals.iter().position(|(n, ..)| *n == name).unwrap();
let new_binding = (name, self.locals[i].1, info);
self.locals[i] = new_binding;

View File

@ -292,9 +292,10 @@ impl Creature {
// console_log!("sending exit signal {exit_signal}");
self.send_msg(Value::Keyword(pid), exit_signal);
}
for pid in self.siblings.clone() {
self.zoo.borrow_mut().kill(pid);
}
// returns no longer kill siblings
// for pid in self.siblings.clone() {
// self.zoo.borrow_mut().kill(pid);
// }
}
// TODO: fix these based on what I decide about `link` & `monitor`
@ -304,6 +305,7 @@ impl Creature {
unreachable!("expected keyword pid in monitor");
};
if other != self.pid {
self.do_unlink(Value::Keyword(other));
let mut other = self.zoo.borrow_mut().catch(other);
other.parents.push(self.pid);
self.zoo.borrow_mut().release(other);
@ -312,6 +314,30 @@ impl Creature {
self.push(Value::Keyword("ok"));
}
fn delete_from_siblings(&mut self, other: &'static str) {
let idx = self.siblings.iter().position(|pid| other == *pid);
if let Some(idx) = idx {
self.siblings.swap_remove(idx);
}
}
fn unlink(&mut self, other: Value) {
self.do_unlink(other);
self.push(Value::Keyword("ok"))
}
fn do_unlink(&mut self, other: Value) {
let Value::Keyword(other) = other else {
unreachable!("expected keyword pid in unlink")
};
if other != self.pid {
self.delete_from_siblings(other);
let mut other = self.zoo.borrow_mut().catch(other);
other.delete_from_siblings(self.pid);
self.zoo.borrow_mut().release(other);
}
}
fn link(&mut self, other: Value) {
let Value::Keyword(other) = other else {
unreachable!("expected keyword pid in link");
@ -359,6 +385,7 @@ impl Creature {
}
"link" => self.link(args[1].clone()),
"monitor" => self.monitor(args[1].clone()),
"unlink" => self.unlink(args[1].clone()),
"flush" => {
let msgs = self.mbx.iter().cloned().collect::<Vec<_>>();
let msgs = Vector::from(msgs);
@ -1301,7 +1328,12 @@ impl Creature {
}
Return => {
if self.debug {
console_log!("== returning from {} ==", self.frame.function.show())
console_log!("== returning from {} ==", self.frame.function.show());
let destination = match self.call_stack.last() {
Some(frame) => frame.function.as_fn().name(),
None => "toplevel",
};
console_log!("== returning to {destination} ==");
}
let mut value = Value::Nothing;
swap(&mut self.register[0], &mut value);