mirror of
https://github.com/janet-lang/janet
synced 2026-04-08 16:01:27 +00:00
Compare commits
62 Commits
no-int
...
keyword-oo
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
d5bab72620 | ||
|
|
aa079e3145 | ||
|
|
d64a57297d | ||
|
|
be85196de8 | ||
|
|
eae4e0dede | ||
|
|
92e9e64945 | ||
|
|
63dd6d03f4 | ||
|
|
2a79d2e749 | ||
|
|
6f3bc3d577 | ||
|
|
ef5eed2c21 | ||
|
|
5865692401 | ||
|
|
b626e73d19 | ||
|
|
b535c91ee1 | ||
|
|
7b28032f5c | ||
|
|
0fdd404a71 | ||
|
|
1f98eff33a | ||
|
|
338b31f5a2 | ||
|
|
b60e3e302a | ||
|
|
5b62c8e6db | ||
|
|
cd6a7793e8 | ||
|
|
5afb00859a | ||
|
|
001917f8d9 | ||
|
|
b9c0fc8201 | ||
|
|
d8b0a5ed01 | ||
|
|
5fa96a6f8c | ||
|
|
dd3fc24a1e | ||
|
|
ddba0010b0 | ||
|
|
337a498edb | ||
|
|
5fff36d047 | ||
|
|
a679f60e07 | ||
|
|
58d480539c | ||
|
|
6afaacf2af | ||
|
|
e9c94598e6 | ||
|
|
29ec30c79f | ||
|
|
122312dbf6 | ||
|
|
618f8d6818 | ||
|
|
0d4ab7dee0 | ||
|
|
6b4824c2ab | ||
|
|
8dde89126e | ||
|
|
56927e1b81 | ||
|
|
9e6254bf56 | ||
|
|
fe22a8db39 | ||
|
|
d724c5b959 | ||
|
|
ca9c017ec4 | ||
|
|
65be318306 | ||
|
|
7c4671d98f | ||
|
|
7880d73201 | ||
|
|
00f0f628e8 | ||
|
|
21b7583a7c | ||
|
|
42c6aca526 | ||
|
|
52b8781684 | ||
|
|
5d39570ec9 | ||
|
|
28331ad6ab | ||
|
|
129ec1e3c5 | ||
|
|
bdcd3a3dbf | ||
|
|
6c8f49206d | ||
|
|
b06f7226c4 | ||
|
|
2bcedd5920 | ||
|
|
5c84f0f5d9 | ||
|
|
424073bbb8 | ||
|
|
e9a80d4e4a | ||
|
|
1ec7f04642 |
1
.gitignore
vendored
1
.gitignore
vendored
@@ -39,6 +39,7 @@ tags
|
||||
|
||||
# Valgrind files
|
||||
vgcore.*
|
||||
*.out.*
|
||||
|
||||
# Created by https://www.gitignore.io/api/c
|
||||
|
||||
|
||||
@@ -33,6 +33,29 @@ may require changes before being merged.
|
||||
For janet code, the use lisp indentation with 2 spaces. One can use janet.vim to
|
||||
do this indentation, or approximate as close as possible.
|
||||
|
||||
## C style
|
||||
|
||||
For changes to the VM and Core code, you will probably need to know C. Janet is programmed with
|
||||
a subset of C99 that works with Microsoft Visual C++. This means most of C99 but with the following
|
||||
omissions.
|
||||
|
||||
* No Variable Length Arrays (yes these may work in newer MSVC compilers)
|
||||
* No `restrict`
|
||||
* Certain functions in the standard library are not always available
|
||||
|
||||
In practice, this means programming for both MSVC on one hand and everything else on the other.
|
||||
The code must also build with emscripten, even if some features are not available, although
|
||||
this is not a priority.
|
||||
|
||||
Code should compile warning free and run valgrind clean. I find that these two criteria are some
|
||||
of the easiest ways to protect against a large number of bugs in an unsafe language like C. To check for
|
||||
valgrind errors, run `make valtest` and check the output for undefined or flagged behavior.
|
||||
|
||||
## Janet style
|
||||
|
||||
All janet code in the project should be formatted similar to the code in core.janet.
|
||||
The auto formatting from janet.vim will work well.
|
||||
|
||||
## Suggesting Changes
|
||||
|
||||
To suggest changes, open an issue on GitHub. Check GitHub for other issues
|
||||
|
||||
2
LICENSE
2
LICENSE
@@ -1,4 +1,4 @@
|
||||
Copyright (c) 2018 Calvin Rose
|
||||
Copyright (c) 2019 Calvin Rose
|
||||
|
||||
Permission is hereby granted, free of charge, to any person obtaining a copy of
|
||||
this software and associated documentation files (the "Software"), to deal in
|
||||
|
||||
11
Makefile
11
Makefile
@@ -136,19 +136,22 @@ repl: $(JANET_TARGET)
|
||||
debug: $(JANET_TARGET)
|
||||
$(DEBUGGER) ./$(JANET_TARGET)
|
||||
|
||||
VALGRIND_COMMAND=valgrind --leak-check=full
|
||||
|
||||
valgrind: $(JANET_TARGET)
|
||||
valgrind --leak-check=full -v ./$(JANET_TARGET)
|
||||
$(VALGRIND_COMMAND) ./$(JANET_TARGET)
|
||||
|
||||
test: $(JANET_TARGET) $(TEST_PROGRAMS)
|
||||
for f in build/*.out; do "$$f" || exit; done
|
||||
for f in test/*.janet; do ./$(JANET_TARGET) "$$f" || exit; done
|
||||
|
||||
VALGRIND_COMMAND=valgrind --leak-check=full -v
|
||||
|
||||
valtest: $(JANET_TARGET) $(TEST_PROGRAMS)
|
||||
for f in build/*.out; do $(VALGRIND_COMMAND) "$$f" || exit; done
|
||||
for f in test/*.janet; do $(VALGRIND_COMMAND) ./$(JANET_TARGET) "$$f" || exit; done
|
||||
|
||||
callgrind: $(JANET_TARGET)
|
||||
for f in test/*.janet; do valgrind --tool=callgrind ./$(JANET_TARGET) "$$f" || exit; done
|
||||
|
||||
########################
|
||||
##### Distribution #####
|
||||
########################
|
||||
@@ -174,7 +177,7 @@ build/doc.html: $(JANET_TARGET) tools/gendoc.janet
|
||||
#################
|
||||
|
||||
clean:
|
||||
-rm -rf build
|
||||
-rm -rf build vgcore.* callgrind.*
|
||||
|
||||
install: $(JANET_TARGET)
|
||||
mkdir -p $(BINDIR)
|
||||
|
||||
14
README.md
14
README.md
@@ -1,7 +1,7 @@
|
||||
[](https://travis-ci.org/janet-lang/janet)
|
||||
[](https://ci.appveyor.com/project/janet-lang/janet)
|
||||
|
||||
<img src="https://raw.githubusercontent.com/honix/janet/master/assets/janet-w200.png" alt="Janet logo" width=200 align="left">
|
||||
<img src="https://raw.githubusercontent.com/janet-lang/janet/master/assets/janet-w200.png" alt="Janet logo" width=200 align="left">
|
||||
|
||||
**Janet** is a functional and imperative programming language and bytecode interpreter. It is a
|
||||
modern lisp, but lists are replaced
|
||||
@@ -10,7 +10,7 @@ The language also bridging bridging to native code written in C, meta-programmin
|
||||
|
||||
There is a repl for trying out the language, as well as the ability
|
||||
to run script files. This client program is separate from the core runtime, so
|
||||
janet could be embedded into other programs. Try janet in your browser at
|
||||
janet could be embedded into other programs. Try janet in your browser at
|
||||
[https://janet-lang.org](https://janet-lang.org).
|
||||
|
||||
#
|
||||
@@ -51,7 +51,7 @@ Janet makes a good system scripting language, or a language to embed in other pr
|
||||
|
||||
## Documentation
|
||||
|
||||
Documentation can be found in the doc directory of
|
||||
Documentation can be found in the doc directory of
|
||||
the repository. There is an introduction
|
||||
section contains a good overview of the language.
|
||||
|
||||
@@ -66,7 +66,7 @@ documentation for the core library. For example,
|
||||
(doc doc)
|
||||
```
|
||||
Shows documentation for the doc macro.
|
||||
|
||||
|
||||
To get a list of all bindings in the default
|
||||
environment, use the `(all-symbols)` function.
|
||||
|
||||
@@ -159,3 +159,9 @@ Building with emscripten on windows is currently unsupported.
|
||||
## Examples
|
||||
|
||||
See the examples directory for some example janet code.
|
||||
|
||||
## Why Janet
|
||||
|
||||
Janet is named after the almost omniscient and friendly artificial being in [The Good Place](https://en.wikipedia.org/wiki/The_Good_Place).
|
||||
|
||||
<img src="https://raw.githubusercontent.com/janet-lang/janet/master/assets/janet-the-good-place.gif" alt="Janet logo" width="115px" align="left">
|
||||
|
||||
BIN
assets/janet-the-good-place.gif
Normal file
BIN
assets/janet-the-good-place.gif
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 109 KiB |
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2018 Calvin Rose
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -24,7 +24,7 @@
|
||||
#include <assert.h>
|
||||
|
||||
int main() {
|
||||
|
||||
|
||||
int i;
|
||||
JanetArray *array1, *array2;
|
||||
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2018 Calvin Rose
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -24,7 +24,7 @@
|
||||
#include <assert.h>
|
||||
|
||||
int main() {
|
||||
|
||||
|
||||
int i;
|
||||
JanetBuffer *buffer1, *buffer2;
|
||||
|
||||
|
||||
69
ctest/number_test.c
Normal file
69
ctest/number_test.c
Normal file
@@ -0,0 +1,69 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
* deal in the Software without restriction, including without limitation the
|
||||
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
||||
* sell copies of the Software, and to permit persons to whom the Software is
|
||||
* furnished to do so, subject to the following conditions:
|
||||
*
|
||||
* The above copyright notice and this permission notice shall be included in
|
||||
* all copies or substantial portions of the Software.
|
||||
*
|
||||
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
#include <janet/janet.h>
|
||||
#include <stdio.h>
|
||||
#include <string.h>
|
||||
#include <assert.h>
|
||||
|
||||
/* Check a subset of numbers against system implementation.
|
||||
* Note that this depends on the system implementation being correct,
|
||||
* which may not be the case for old or non compliant systems. Also,
|
||||
* we cannot check against bases other 10. */
|
||||
|
||||
/* Compare valid c numbers to system implementation. */
|
||||
static void test_valid_str(const char *str) {
|
||||
int err;
|
||||
double cnum, jnum;
|
||||
jnum = 0.0;
|
||||
cnum = atof(str);
|
||||
err = janet_scan_number((const uint8_t *) str, strlen(str), &jnum);
|
||||
assert(!err);
|
||||
assert(cnum == jnum);
|
||||
}
|
||||
|
||||
int main() {
|
||||
|
||||
janet_init();
|
||||
|
||||
test_valid_str("1.0");
|
||||
test_valid_str("1");
|
||||
test_valid_str("2.1");
|
||||
test_valid_str("1e10");
|
||||
test_valid_str("2e10");
|
||||
test_valid_str("1e-10");
|
||||
test_valid_str("2e-10");
|
||||
test_valid_str("1.123123e10");
|
||||
test_valid_str("1.123123e-10");
|
||||
test_valid_str("-1.23e2");
|
||||
test_valid_str("-4.5e15");
|
||||
test_valid_str("-4.5e151");
|
||||
test_valid_str("-4.5e200");
|
||||
test_valid_str("-4.5e123");
|
||||
test_valid_str("123123123123123123132123");
|
||||
test_valid_str("0000000011111111111111111111111111");
|
||||
test_valid_str(".112312333333323123123123123123123");
|
||||
|
||||
janet_deinit();
|
||||
|
||||
return 0;
|
||||
}
|
||||
@@ -1,4 +1,3 @@
|
||||
|
||||
/*
|
||||
* Copyright (c) 2018 Calvin Rose
|
||||
*
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2018 Calvin Rose
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -24,7 +24,7 @@
|
||||
#include <assert.h>
|
||||
|
||||
int main() {
|
||||
|
||||
|
||||
JanetTable *t1, *t2;
|
||||
|
||||
janet_init();
|
||||
@@ -39,7 +39,7 @@ int main() {
|
||||
|
||||
assert(t1->count == 4);
|
||||
assert(t1->capacity >= t1->count);
|
||||
|
||||
|
||||
assert(janet_equals(janet_table_get(t1, janet_cstringv("hello")), janet_wrap_integer(2)));
|
||||
assert(janet_equals(janet_table_get(t1, janet_cstringv("akey")), janet_wrap_integer(5)));
|
||||
assert(janet_equals(janet_table_get(t1, janet_cstringv("box")), janet_wrap_boolean(0)));
|
||||
|
||||
@@ -2,5 +2,5 @@ Janet is a dynamic, lightweight programming language with strong functional
|
||||
capabilities as well as support for imperative programming. It to be used
|
||||
for short lived scripts as well as for building real programs. It can also
|
||||
be extended with native code (C modules) for better performance and interfacing with
|
||||
existing software. Janet takes ideas from Lua, Scheme, Racket, Clojure, Smalltalk, Erlang, Arc, and
|
||||
existing software. Janet takes ideas from Lua, Scheme, Racket, Clojure, Smalltalk, Erlang, Arc, and
|
||||
a whole bunch of other dynamic languages.
|
||||
|
||||
@@ -63,11 +63,11 @@ notation with a radix besides 10, use the `&` symbol to indicate the exponent ra
|
||||
## Arithmetic Functions
|
||||
|
||||
Besides the 5 main arithmetic functions, janet also supports a number of math functions
|
||||
taken from the C library `<math.h>`, as well as bitwise operators that behave like they
|
||||
taken from the C library `<math.h>`, as well as bit-wise operators that behave like they
|
||||
do in C or Java. Functions like `math/sin`, `math/cos`, `math/log`, and `math/exp` will
|
||||
behave as expected to a C programmer. They all take either 1 or 2 numeric arguments and
|
||||
return a real number (never an integer!) Bitwise functions are all prefixed with b.
|
||||
Thet are `bnot`, `bor`, `bxor`, `band`, `blshift`, `brshift`, and `brushift`. Bitwise
|
||||
return a real number (never an integer!) Bit-wise functions are all prefixed with b.
|
||||
They are `bnot`, `bor`, `bxor`, `band`, `blshift`, `brshift`, and `brushift`. Bit-wise
|
||||
functions only work on integers.
|
||||
|
||||
# Strings, Keywords and Symbols
|
||||
@@ -76,8 +76,11 @@ Janet supports several varieties of types that can be used as labels for things
|
||||
your program. The most useful type for this purpose is the keyword type. A keyword
|
||||
begins with a semicolon, and then contains 0 or more alphanumeric or a few other common
|
||||
characters. For example, `:hello`, `:my-name`, `::`, and `:ABC123_-*&^%$` are all keywords.
|
||||
Keywords are actually just special cases of symbols, which are similar but don't start with
|
||||
a semicolon. The difference between symbols and keywords is that keywords evaluate to themselves, while
|
||||
|
||||
Keywords, symbols, and strings all behave similarly and can be used as keys for tables and structs.
|
||||
Symbols and keywords are optimized for fast equality checks, so are preferred for table keys.
|
||||
|
||||
The difference between symbols and keywords is that keywords evaluate to themselves, while
|
||||
symbols evaluate to whatever they are bound to. To have a symbol evaluate to itself, it must be
|
||||
quoted.
|
||||
|
||||
@@ -178,7 +181,7 @@ a function call are evaluated in order, from first argument to last argument).
|
||||
Because functions are first-class values like numbers or strings, they can be passed
|
||||
as arguments to other functions as well.
|
||||
|
||||
```
|
||||
```lisp
|
||||
(print triangle-area)
|
||||
```
|
||||
|
||||
@@ -187,7 +190,7 @@ This prints the location in memory of the function triangle area.
|
||||
Functions don't need to have names. The `fn` keyword can be used to introduce function
|
||||
literals without binding them to a symbol.
|
||||
|
||||
```
|
||||
```lisp
|
||||
# Evaluates to 40
|
||||
((fn [x y] (+ x x y)) 10 20)
|
||||
# Also evaluates to 40
|
||||
@@ -230,7 +233,7 @@ and transform it into some other source code, usually automating some repetitive
|
||||
Values can be bound to symbols for later use using the keyword `def`. Using undefined
|
||||
symbols will raise an error.
|
||||
|
||||
```
|
||||
```lisp
|
||||
(def a 100)
|
||||
(def b (+ 1 a))
|
||||
(def c (+ b b))
|
||||
@@ -242,7 +245,7 @@ cannot be changed after definition. For mutable bindings, like variables in othe
|
||||
languages, use the `var` keyword. The assignment special form `set` can then be used to update
|
||||
a var.
|
||||
|
||||
```
|
||||
```lisp
|
||||
(var myvar 1)
|
||||
(print myvar)
|
||||
(set myvar 10)
|
||||
@@ -318,16 +321,16 @@ there relationship to each other.
|
||||
| ---------- | ------- | --------------- |
|
||||
| Indexed | Array | Tuple |
|
||||
| Dictionary | Table | Struct |
|
||||
| Byteseq | Buffer | String (Symbol) |
|
||||
| Bytes | Buffer | String |
|
||||
|
||||
Indexed types are linear lists of elements than can be accessed in constant time with an integer index.
|
||||
Indexed types are backed by a single chunk of memory for fast access, and are indexed from 0 as in C.
|
||||
Dictionary types associate keys with values. The difference between dictionaries and indexed types
|
||||
is that dictionaries are not limited to integer keys. They are backed by a hashtable and also offer
|
||||
constant time lookup (and insertion for the mutable case).
|
||||
Finally, the 'byteseq' abstraction is any type that contains a sequence of bytes. A byteseq associates
|
||||
Finally, the 'bytes' abstraction is any type that contains a sequence of bytes. A 'bytes' value or byteseq associates
|
||||
integer keys (the indices) with integer values between 0 and 255 (the byte values). In this way,
|
||||
they behave much like Arrays and Tuples. However, one cannot put non integer values into a byteseq.
|
||||
they behave much like Arrays and Tuples. However, one cannot put non integer values into a byteseq
|
||||
|
||||
```lisp
|
||||
(def mytuple (tuple 1 2 3))
|
||||
@@ -434,7 +437,7 @@ every iteration of the loop. If it is nil or false, the while loop ends and eval
|
||||
the rest of the parameters will be evaluated sequentially and then the program will return to the beginning
|
||||
of the loop.
|
||||
|
||||
```
|
||||
```lisp
|
||||
# Loop from 100 down to 1 and print each time
|
||||
(var i 100)
|
||||
(while (pos? i)
|
||||
@@ -541,7 +544,7 @@ control is returned to the calling fiber. The parent fiber must then check what
|
||||
fiber is in to differentiate errors from return values from user defined signals.
|
||||
|
||||
To create a fiber, user the `fiber/new` function. The fiber constructor take one or two arguments.
|
||||
the first, necessary argument is the function that the fiber will execute. This function must accept
|
||||
The first, necessary argument is the function that the fiber will execute. This function must accept
|
||||
an arity of zero. The next optional argument is a collection of flags checking what kinds of
|
||||
signals to trap and return via `resume`. This is useful so
|
||||
the programmer does not need to handle all different kinds of signals from a fiber. Any un-trapped signals
|
||||
@@ -632,11 +635,11 @@ using janet's builtin quasiquoting facilities.
|
||||
(defmacro defn3
|
||||
"Defines a new function."
|
||||
[name args & body]
|
||||
`(def ,name (fn ,name ,args ,;body)))
|
||||
~(def ,name (fn ,name ,args ,;body)))
|
||||
```
|
||||
|
||||
This is functionally identical to our previous version `defn2`, but written in such
|
||||
a way that the macro output is more clear. The leading backtick is shorthand for the
|
||||
a way that the macro output is more clear. The leading tilde `~` is shorthand for the
|
||||
`(quasiquote x)` special form, which is like `(quote x)` except we can unquote
|
||||
expressions inside it. The comma in front of `name` and `args` is an unquote, which
|
||||
allows us to put a value in the quasiquote. Without the unquote, the symbol \'name\'
|
||||
@@ -651,7 +654,7 @@ See what happens if we use a normal unquote for body as well.
|
||||
(def args '[x y z])
|
||||
(defn body '[(print x) (print y) (print z)])
|
||||
|
||||
`(def ,name (fn ,name ,args ,body))
|
||||
~(def ,name (fn ,name ,args ,body))
|
||||
# -> (def myfunction (fn myfunction (x y z) ((print x) (print y) (print z))))
|
||||
```
|
||||
|
||||
@@ -662,7 +665,7 @@ and a shorthand for it, the ; character.
|
||||
When combined with the unquote special, we get the desired output.
|
||||
|
||||
```lisp
|
||||
`(def ,name (fn ,name ,args ,;body))
|
||||
~(def ,name (fn ,name ,args ,;body))
|
||||
# -> (def myfunction (fn myfunction (x y z) (print x) (print y) (print z)))
|
||||
```
|
||||
|
||||
@@ -676,7 +679,7 @@ the following macro
|
||||
(defmacro max1
|
||||
"Get the max of two values."
|
||||
[x y]
|
||||
`(if (> ,x ,y) ,x ,y))
|
||||
~(if (> ,x ,y) ,x ,y))
|
||||
```
|
||||
|
||||
This almost works, but will evaluate both x and y twice. This is because both show up
|
||||
@@ -689,7 +692,7 @@ We can do better:
|
||||
(defmacro max2
|
||||
"Get the max of two values."
|
||||
[x y]
|
||||
`(let [x ,x
|
||||
~(let [x ,x
|
||||
y ,y]
|
||||
(if (> x y) x y)))
|
||||
```
|
||||
@@ -717,7 +720,7 @@ to be 10. The problem is the reuse of the symbol x inside the macro, which overs
|
||||
binding.
|
||||
|
||||
Janet provides a general solution to this problem in terms of the `(gensym)` function, which returns
|
||||
a symbol which is guarenteed to be unique and not collide with any symbols defined previously. We can define
|
||||
a symbol which is guaranteed to be unique and not collide with any symbols defined previously. We can define
|
||||
our macro once more for a fully correct macro.
|
||||
|
||||
```lisp
|
||||
@@ -726,7 +729,7 @@ our macro once more for a fully correct macro.
|
||||
[x y]
|
||||
(def $x (gensym))
|
||||
(def $y (gensym))
|
||||
`(let [,$x ,x
|
||||
~(let [,$x ,x
|
||||
,$y ,y]
|
||||
(if (> ,$x ,$y) ,$x ,$y)))
|
||||
```
|
||||
|
||||
174
doc/Loop.md
Normal file
174
doc/Loop.md
Normal file
@@ -0,0 +1,174 @@
|
||||
# Loops in Janet
|
||||
|
||||
A very common and essential operation in all programming is looping. Most
|
||||
languages support looping of some kind, either with explicit loops or recursion.
|
||||
Janet supports both recursion and a primitive `while` loop. While recursion is
|
||||
useful in many cases, sometimes is more convenient to use a explicit loop to
|
||||
iterate over a collection like an array.
|
||||
|
||||
## An Example - Iterating a Range
|
||||
|
||||
Suppose you want to calculate the sum of the first 10 natural numbers
|
||||
0 through 9. There are many ways to carry out this explicit calculation
|
||||
even with taking shortcuts. A succinct way in janet is
|
||||
|
||||
```
|
||||
(+ ;(range 10))
|
||||
```
|
||||
|
||||
We will limit ourselves however to using explicit looping and no functions
|
||||
like `(range n)` which generate a list of natural numbers for us.
|
||||
|
||||
For our first version, we will use only the while macro to iterate, similar
|
||||
to how one might sum natural numbers in a language such as C.
|
||||
|
||||
```
|
||||
(var sum 0)
|
||||
(var i 0)
|
||||
(while (< i 10)
|
||||
(+= sum i)
|
||||
(++ i))
|
||||
(print sum) # prints 45
|
||||
```
|
||||
This is a very imperative style program which can grow very large very quickly.
|
||||
We are manually updating a counter `i` in a loop. Using the macros `+=` and `++`, this
|
||||
style code is similar in density to C code.
|
||||
It is recommended to use either macros (such as the loop macro) or a functional
|
||||
style in janet.
|
||||
|
||||
Since this is such a common pattern, Janet has a macro for this exact purpose. The
|
||||
`(for x start end body)` captures exactly this behavior of incrementing a counter
|
||||
in a loop.
|
||||
|
||||
```
|
||||
(var sum 0)
|
||||
(for i 0 10 (+= sum i))
|
||||
(print sum) # prints 45
|
||||
```
|
||||
|
||||
We have completely wrapped the imperative counter in a macro. The for macro, while not
|
||||
very flexible, is very terse and covers a common case of iteration, iterating over an integer range. The for macro will be expanded to something very similar to our original
|
||||
version with a while loop.
|
||||
|
||||
We can do something similar with the more flexible `loop` macro.
|
||||
|
||||
```
|
||||
(var sum 0)
|
||||
(loop [i :range [0 10]] (+= sum i))
|
||||
(print sum) # prints 45
|
||||
```
|
||||
|
||||
This is slightly more verbose than the for macro, but can be more easily extended.
|
||||
Let's say that we wanted to only count even numbers towards the sum. We can do this
|
||||
easily with the loop macro.
|
||||
|
||||
```
|
||||
(var sum 0)
|
||||
(loop [i :range [0 10] :when (even? i)] (+= sum i))
|
||||
(print sum) # prints 20
|
||||
```
|
||||
|
||||
The loop macro has several verbs (:range) and modifiers (:when) that let
|
||||
the programmer more easily generate common looping idioms. The loop macro
|
||||
is similar to the Common Lips loop macro, but smaller in scope and with a much
|
||||
simpler syntax. As with the `for` macro, the loop macro expands to similar
|
||||
code as our original while expression.
|
||||
|
||||
## Another Example - Iterating an Indexed Data Structure
|
||||
|
||||
Another common usage for iteration in any language is iterating over the items in
|
||||
some data structure, like items in an array, characters in a string, or key value
|
||||
pairs in a table.
|
||||
|
||||
Say we have an array of names that we want to print out. We will
|
||||
again start with a simple while loop which we will refine into
|
||||
more idiomatic expressions.
|
||||
|
||||
First, we will define our array of names
|
||||
```
|
||||
(def names @["Jean-Paul Sartre" "Bob Dylan" "Augusta Ada King" "Frida Kahlo" "Harriet Tubman")
|
||||
```
|
||||
|
||||
With our array of names, we can use a while loop to iterate through the indices of names, get the
|
||||
values, and the print them.
|
||||
|
||||
```
|
||||
(var i 0)
|
||||
(def len (length names))
|
||||
(while (< i len)
|
||||
(print (get names i))
|
||||
(++ i))
|
||||
```
|
||||
|
||||
This is rather verbose. janet provides the `each` macro for iterating through the items in a tuple or
|
||||
array, or the bytes in a buffer, symbol, or string.
|
||||
|
||||
```
|
||||
(each name names (print name))
|
||||
```
|
||||
|
||||
We can also use the `loop` macro for this case as well using the `:in` verb.
|
||||
|
||||
```
|
||||
(loop [name :in names] (print name))
|
||||
```
|
||||
|
||||
## Iterating a Dictionary
|
||||
|
||||
In the previous example, we iterated over the values in an array. Another common
|
||||
use of looping in a Janet program is iterating over the keys or values in a table.
|
||||
We cannot use the same method as iterating over an array because a table or struct does
|
||||
not contain a known integer range of keys. Instead we rely on a function `next`, which allows
|
||||
us to visit each of the keys in a struct or table. Note that iterating over a table will not
|
||||
visit the prototype table.
|
||||
|
||||
As an example, lets iterate over a table of letters to a word that starts with that letter. We
|
||||
will print out the words to our simple children's book.
|
||||
|
||||
```
|
||||
(def alphabook
|
||||
@{"A" "Apple"
|
||||
"B" "Banana"
|
||||
"C" "Cat"
|
||||
"D" "Dog"
|
||||
"E" "Elephant" })
|
||||
```
|
||||
|
||||
As before, we can evaluate this loop using only a while loop and the `next` function.
|
||||
|
||||
```
|
||||
(var key (next alphabook nil))
|
||||
(while (not= nil key)
|
||||
(print key " is for " (get alphabook key))
|
||||
(set key (next alphabook key))
|
||||
```
|
||||
|
||||
However, we can do better than this with the loop macro using the `:pairs` or `:keys` verbs.
|
||||
|
||||
```
|
||||
(loop [[letter word] :pairs alphabook]
|
||||
(print letter " is for " word))
|
||||
```
|
||||
|
||||
Using the `:keys` verb and the dot syntax for indexing
|
||||
|
||||
```
|
||||
(loop [letter :keys alphabook]
|
||||
(print letter " is for " alphabook.letter))
|
||||
```
|
||||
|
||||
The symbol `alphabook.letter` is shorthand for `(get alphabook letter)`.
|
||||
Note that the dot syntax of `alphabook.letter` is different than in many languages. In C or
|
||||
ALGOL like languages, it is more akin to the indexing operator, and would be written `alphabook[letter]`.
|
||||
The `.` character is part of the symbol and is recognized by the compiler.
|
||||
|
||||
We can also use the core library functions `keys` and `pairs` to get arrays of the keys and
|
||||
pairs respectively of the alphabook.
|
||||
|
||||
```
|
||||
(loop [[letter word] :in (pairs alphabook)]
|
||||
(print letter " is for " word))
|
||||
|
||||
(loop [letter :in (keys alphabook)]
|
||||
(print letter " is for " alphabook.letter))
|
||||
```
|
||||
@@ -31,9 +31,9 @@ false
|
||||
## Symbols
|
||||
|
||||
Janet symbols are represented a sequence of alphanumeric characters
|
||||
not starting with a digit. They can also contain the characters
|
||||
not starting with a digit or a colon. They can also contain the characters
|
||||
\!, @, $, \%, \^, \&, \*, -, \_, +, =, \|, \~, :, \<, \>, ., \?, \\, /, as
|
||||
well as any Unicode codepoint not in the ascii range.
|
||||
well as any Unicode codepoint not in the ASCII range.
|
||||
|
||||
By convention, most symbols should be all lower case and use dashes to connect words
|
||||
(sometimes called kebab case).
|
||||
@@ -54,7 +54,7 @@ my-module/my-fuction
|
||||
|
||||
## Keywords
|
||||
|
||||
Janet keywords are really just symbols that begin with the character :. However, they
|
||||
Janet keywords are like symbols that begin with the character :. However, they
|
||||
are used differently and treated by the compiler as a constant rather than a name for
|
||||
something. Keywords are used mostly for keys in tables and structs, or pieces of syntax
|
||||
in macros.
|
||||
@@ -120,7 +120,7 @@ delimited string. A string can also be define to start with a certain number of
|
||||
backquotes, and will end the same number of backquotes. Long strings
|
||||
do not contain escape sequences; all bytes will be parsed literally until
|
||||
ending delimiter is found. This is useful
|
||||
for definining multiline strings with literal newline characters, unprintable
|
||||
for defining multi-line strings with literal newline characters, unprintable
|
||||
characters, or strings that would otherwise require many escape sequences.
|
||||
|
||||
```
|
||||
@@ -155,7 +155,7 @@ the buffer must be prefixed with the '@' character.
|
||||
|
||||
Tuples are a sequence of white space separated values surrounded by either parentheses
|
||||
or brackets. The parser considers any of the characters ASCII 32, \\0, \\f, \\n, \\r or \\t
|
||||
to be whitespace.
|
||||
to be white-space.
|
||||
|
||||
```
|
||||
(do 1 2 3)
|
||||
@@ -173,7 +173,7 @@ Arrays are the same as tuples, but have a leading @ to indicate mutability.
|
||||
|
||||
## Structs
|
||||
|
||||
Structs are represented by a sequence of whitespace delimited key value pairs
|
||||
Structs are represented by a sequence of white-space delimited key value pairs
|
||||
surrounded by curly braces. The sequence is defined as key1, value1, key2, value2, etc.
|
||||
There must be an even number of items between curly braces or the parser will
|
||||
signal a parse error. Any value can be a key or value. Using nil as a key or
|
||||
@@ -202,10 +202,9 @@ that they are mutable.
|
||||
## Comments
|
||||
|
||||
Comments begin with a \# character and continue until the end of the line.
|
||||
There are no multiline comments. For ricm multiline comments, use a
|
||||
string literal.
|
||||
There are no multi-line comments.
|
||||
|
||||
## Shorthands
|
||||
## Shorthand
|
||||
|
||||
Often called reader macros in other lisps, Janet provides several shorthand
|
||||
notations for some forms.
|
||||
|
||||
206
doc/Specials.md
Normal file
206
doc/Specials.md
Normal file
@@ -0,0 +1,206 @@
|
||||
# Special Forms
|
||||
|
||||
Janet is a lisp and so is defined in terms of mostly S-expressions, or
|
||||
in terms of Janet, tuples. Tuples are used to represent function calls, macros,
|
||||
and special forms. Most functionality is exposed through functions, some
|
||||
through macros, and a minimal amount through special forms. Special forms
|
||||
are neither functions nor macros -- they are used by the compiler to directly
|
||||
express a low level construct that can not be expressed through macros or functions.
|
||||
Special forms can be thought of as forming the real 'core' language of janet.
|
||||
|
||||
Below is a reference for all of the special forms in Janet.
|
||||
|
||||
## (def name meta... value)
|
||||
|
||||
This special form binds a value to a symbol. The symbol can the be substituted
|
||||
for the value in subsequent expression for the same result. A binding made by def
|
||||
is a constant and cannot be updated. A symbol can be redefined to a new value, but previous
|
||||
uses of the binding will refer to the previous value of the binding.
|
||||
|
||||
```lisp
|
||||
(def anumber (+ 1 2 3 4 5))
|
||||
|
||||
(print anumber) # prints 15
|
||||
```
|
||||
|
||||
Def can also take a tuple, array, table or struct to perform destructuring
|
||||
on the value. This allows us to do multiple assignments in one def.
|
||||
|
||||
```lisp
|
||||
(def [a b c] (range 10))
|
||||
(print a " " b " " c) # prints 0 1 2
|
||||
|
||||
(def {:x x} @{:x (+ 1 2)})
|
||||
(print x) # prints 3
|
||||
|
||||
(def [y {:x x}] @[:hi @{:x (+ 1 2)}])
|
||||
(print y x) # prints hi3
|
||||
```
|
||||
|
||||
Def can also append metadata and a docstring to the symbol when in the global scope.
|
||||
If not in the global scope, the extra metadata will be ignored.
|
||||
|
||||
```lisp
|
||||
(def mydef :private 3) # Adds the :private key to the metadata table.
|
||||
(def mydef2 :private "A docstring" 4) # Add a docstring
|
||||
|
||||
# The metadata will be ignored here because mydef is
|
||||
# accessible outside of the do form.
|
||||
(do
|
||||
(def mydef :private 3)
|
||||
(+ mydef 1))
|
||||
```
|
||||
|
||||
## (var name meta... value)
|
||||
|
||||
Similar to def, but bindings set in this manner can be updated using set. In all other respects is the
|
||||
same as def.
|
||||
|
||||
```lisp
|
||||
(var a 1)
|
||||
(defn printa [] (print a))
|
||||
|
||||
(printa) # prints 1
|
||||
(++ a)
|
||||
(printa) # prints 2
|
||||
(set a :hi)
|
||||
(printa) # prints hi
|
||||
```
|
||||
|
||||
## (fn name? args body...)
|
||||
|
||||
Compile a function literal (closure). A function literal consists of an optional name, an
|
||||
argument list, and a function body. The optional name is allowed so that functions can
|
||||
more easily be recursive. The argument list is a tuple of named parameters, and the body
|
||||
is 0 or more forms. The function will evaluate to the last form in the body. The other forms
|
||||
will only be evaluated for side effects.
|
||||
|
||||
Functions also introduced a new lexical scope, meaning the defs and vars inside a function
|
||||
body will not escape outside the body.
|
||||
|
||||
```lisp
|
||||
(fn []) # The simplest function literal. Takes no arguments and returns nil.
|
||||
(fn [x] x) # The identity function
|
||||
(fn identity [x] x) # The identity function - the name will also make stacktraces nicer.
|
||||
(fn [] 1 2 3 4 5) # A function that returns 5
|
||||
(fn [x y] (+ x y)) # A function that adds its two arguments.
|
||||
|
||||
(fn [& args] (length args)) # A variadic function that counts its arguments.
|
||||
|
||||
# A function that doesn't strictly check the number of arguments.
|
||||
# Extra arguments are ignored, and arguments not passed are nil.
|
||||
(fn [w x y z &] (tuple w w x x y y z z))
|
||||
```
|
||||
|
||||
## (do body...)
|
||||
|
||||
Execute a series of forms for side effects and evaluates to the final form. Also
|
||||
introduces a new lexical scope without creating or calling a function.
|
||||
|
||||
```lisp
|
||||
(do 1 2 3 4) # Evaluates to 4
|
||||
|
||||
# Prints 1, 2 and 3, then evaluates to (print 3), which is nil
|
||||
(do (print 1) (print 2) (print 3))
|
||||
|
||||
# Prints 1
|
||||
(do
|
||||
(def a 1)
|
||||
(print a))
|
||||
|
||||
# a is not defined here, so fails
|
||||
a
|
||||
```
|
||||
|
||||
## (quote x)
|
||||
|
||||
Evaluates to the literal value of the first argument. The argument is not compiled
|
||||
and is simply used as a constant value in the compiled code. Preceding a form with a
|
||||
single quote is shorthand for `(quote expression)`.
|
||||
|
||||
```lisp
|
||||
(quote 1) # evaluates to 1
|
||||
(quote hi) # evaluates to the symbol hi
|
||||
(quote quote) # evaluates to the symbol quote
|
||||
|
||||
`(1 2 3) # Evaluates to a tuple (1 2 3)
|
||||
`(print 1 2 3) # Evaluates to a tuple (print 1 2 3)
|
||||
```
|
||||
|
||||
## (if condition when-true when-false?)
|
||||
|
||||
Introduce a branching construct. The first form is the condition, the second
|
||||
form is the form to evaluate when the condition is true, and the optional
|
||||
third form is the form to evaluate when the condition is false. If no third
|
||||
form is provided it defaults to nil.
|
||||
|
||||
The if special form will not evaluate the when-true or when-false forms unless
|
||||
it needs to - it is a lazy form, which is why it cannot be a function or macro.
|
||||
|
||||
The condition is considered false only if it evaluates to nil or false - all other values
|
||||
are considered true.
|
||||
|
||||
```lisp
|
||||
(if true 10) # evaluates to 10
|
||||
(if false 10) # evaluates to nil
|
||||
(if true (print 1) (print 2)) # prints 1 but not 2
|
||||
```
|
||||
|
||||
## (splice x)
|
||||
|
||||
The splice special form is an interesting form that doesn't have an analog in most lisps.
|
||||
It only has an effect in two places - as an argument in a function call, or as the argument
|
||||
to the unquote form. Outside of these two settings, the splice special form simply evaluates
|
||||
directly to it's argument x. The shorthand for splice is prefixing a form with a semicolon.
|
||||
|
||||
In the context of a function call, splice will insert *the contents* of x in the parameter list.
|
||||
|
||||
```lisp
|
||||
(+ 1 2 3) # evaluates to 6
|
||||
|
||||
(+ @[1 2 3]) # bad
|
||||
|
||||
(+ (splice @[1 2 3])) # also evaluates to 6
|
||||
|
||||
(+ ;@[1 2 3]) # Same as above
|
||||
|
||||
(+ ;(range 100)) # Sum the first 100 natural numbers
|
||||
|
||||
(+ ;(range 100) 1000) # Sum the first 100 natural numbers and 1000
|
||||
```
|
||||
|
||||
Notice that this means we rarely will need the `apply` function, as the splice operator is more flexible.
|
||||
|
||||
The splice operator can also be used inside an unquote form, where it will behave like
|
||||
an `unquote-splicing` special in other lisps.
|
||||
|
||||
## (while condition body...)
|
||||
|
||||
The while special form compiles to a C-like while loop. The body of the form will be continuously evaluated
|
||||
until the condition is false or nil. Therefor, it is expected that the body will contain some side effects
|
||||
of the loop will go on for ever. The while loop always evaluates to nil.
|
||||
|
||||
```lisp
|
||||
(var i 0)
|
||||
(while (< i 10)
|
||||
(print i)
|
||||
(++ i))
|
||||
```
|
||||
|
||||
## (set l-value r-value)
|
||||
|
||||
Update the value of a var l-value to a new value r-value. The set special form will then evaluate to r-value.
|
||||
|
||||
The r-value can be any expression, and the l-value should be a bound var.
|
||||
|
||||
## (quasiquote x)
|
||||
|
||||
Similar to `(quote x)`, but allows for unquoting within x. This makes quasiquote useful for
|
||||
writing macros, as a macro definition often generates a lot of templated code with a
|
||||
few custom values. The shorthand for quasiquote is a leading tilde `~` before a form. With
|
||||
that form, `(unquote x)` will evaluate and insert x into the unquote form. The shorthand for
|
||||
`(unquote x)` is `,x`.
|
||||
|
||||
## (unquote x)
|
||||
|
||||
Unquote a form within a quasiquote. Outside of a quasiquote, unquote is invalid.
|
||||
@@ -9,7 +9,7 @@ features.
|
||||
A Janet Fiber is the type used to represent multiple concurrent processes
|
||||
in janet. It is basically a wrapper around the idea of a stack. The stack is
|
||||
divided into a number of stack frames (`JanetStackFrame *` in C), each of which
|
||||
contains information such as the function that created the stack frame,
|
||||
contains information such as the function that created the stack frame,
|
||||
the program counter for the stack frame, a pointer to the previous frame,
|
||||
and the size of the frame. Each stack frame also is paired with a number
|
||||
registers.
|
||||
@@ -49,7 +49,7 @@ Frame -2
|
||||
...
|
||||
...
|
||||
...
|
||||
-----
|
||||
-----
|
||||
Bottom of stack
|
||||
```
|
||||
|
||||
@@ -137,7 +137,7 @@ by their short names as presented to the assembler rather than their numerical v
|
||||
Each instruction is also listed with a signature, which are the arguments the instruction
|
||||
expects. There are a handful of instruction signatures, which combine the arity and type
|
||||
of the instruction. The assembler does not
|
||||
do any typechecking per closure, but does prevent jumping to invalid instructions and
|
||||
do any type-checking per closure, but does prevent jumping to invalid instructions and
|
||||
failure to return or error.
|
||||
|
||||
### Notation
|
||||
@@ -148,7 +148,7 @@ failure to return or error.
|
||||
|
||||
* Some operators in the description have the suffix 'i' or 'r'. These indicate
|
||||
that these operators correspond to integers or real numbers only, respectively. All
|
||||
bitwise operators and bit shifts only work with integers.
|
||||
bit-wise operators and bit shifts only work with integers.
|
||||
|
||||
* The `>>>` indicates unsigned right shift, as in Java. Because all integers in janet are
|
||||
signed, we differentiate the two kinds of right bit shift.
|
||||
@@ -159,7 +159,7 @@ failure to return or error.
|
||||
|
||||
| Instruction | Signature | Description |
|
||||
| ----------- | --------------------------- | --------------------------------- |
|
||||
| `add` | `(add dest lhs rhs)` | $dest = $lhs + $rhs |
|
||||
| `add` | `(add dest lhs rhs)` | $dest = $lhs + $rhs |
|
||||
| `addim` | `(addim dest lhs im)` | $dest = $lhs + im |
|
||||
| `band` | `(band dest lhs rhs)` | $dest = $lhs & $rhs |
|
||||
| `bnot` | `(bnot dest operand)` | $dest = ~$operand |
|
||||
|
||||
@@ -5,10 +5,10 @@
|
||||
(def solutions @{})
|
||||
(def len (length s))
|
||||
(for k 0 len
|
||||
(put tab s.k k))
|
||||
(put tab (s k) k))
|
||||
(for i 0 len
|
||||
(for j 0 len
|
||||
(def k (get tab (- 0 s.i s.j)))
|
||||
(def k (get tab (- 0 (s i) (s j))))
|
||||
(when (and k (not= k i) (not= k j) (not= i j))
|
||||
(put solutions {i true j true k true} true))))
|
||||
(map keys (keys solutions)))
|
||||
|
||||
@@ -18,3 +18,11 @@
|
||||
(ret 0) # return $0
|
||||
]
|
||||
}))
|
||||
|
||||
# Test it
|
||||
|
||||
(defn testn
|
||||
[n]
|
||||
(print "fibasm(" n ") = " (fibasm n)))
|
||||
|
||||
(for i 0 10 (testn i))
|
||||
|
||||
@@ -35,7 +35,13 @@
|
||||
:bright-white 97
|
||||
:bg-bright-white 107})
|
||||
|
||||
(loop [[name color] :in (pairs colormap)]
|
||||
(defglobal (string/slice name 1)
|
||||
(fn color-wrapper [& pieces]
|
||||
(string "\e[" color "m" ;pieces "\e[0m"))))
|
||||
(defn color
|
||||
"Take a string made by concatenating xs and colorize it for an ANSI terminal."
|
||||
[c & xs]
|
||||
(def code (get colormap c))
|
||||
(if (not code) (error (string "color " c " unknown")))
|
||||
(string "\e[" code "m" ;xs "\e[0m"))
|
||||
|
||||
# Print all colors
|
||||
|
||||
(loop [c :keys colormap] (print (color c c)))
|
||||
|
||||
@@ -16,7 +16,7 @@
|
||||
(def cell-set (frequencies state))
|
||||
(def neighbor-set (frequencies (mapcat neighbors state)))
|
||||
(seq [coord :keys neighbor-set
|
||||
:let [count neighbor-set.coord]
|
||||
:let [count (get neighbor-set coord)]
|
||||
:when (or (= count 3) (and (get cell-set coord) (= count 2)))]
|
||||
coord))
|
||||
|
||||
@@ -24,7 +24,7 @@
|
||||
"Draw cells in the game of life from (x1, y1) to (x2, y2)"
|
||||
[state x1 y1 x2 y2]
|
||||
(def cellset @{})
|
||||
(each cell state (set cellset.cell true))
|
||||
(each cell state (put cellset cell true))
|
||||
(loop [x :range [x1 (+ 1 x2)]
|
||||
:after (print)
|
||||
y :range [y1 (+ 1 y2)]]
|
||||
|
||||
@@ -216,7 +216,7 @@
|
||||
<key>corelib</key>
|
||||
<dict>
|
||||
<key>match</key>
|
||||
<string>(?<![\.:\w_\-=!@\$%^&?|\\/<>*])(%|%=|\*|\*=|\*doc\-width\*|\*env\*|\+|\+\+|\+=|\-|\-\-|\-=|\->|\->>|\-\?>|\-\?>>|/|/=|<|<=|=|==|>|>=|_env|abstract\?|all|all\-symbols|allsyms|and|apply|array|array/concat|array/ensure|array/insert|array/new|array/peek|array/pop|array/push|array/slice|array\?|as\->|as\?\->|asm|band|blshift|bnot|boolean\?|bor|brshift|brushift|buffer|buffer/clear|buffer/new|buffer/popn|buffer/push\-byte|buffer/push\-integer|buffer/push\-string|buffer/slice|buffer\?|bxor|bytes\?|callable\?|case|cfunction\?|comment|comp|compile|complement|cond|coro|count|debug|debug/arg\-stack|debug/break|debug/fbreak|debug/lineage|debug/stack|debug/unbreak|debug/unfbreak|dec|deep\-not=|deep=|def\-|default|defglobal|defmacro|defmacro\-|defn|defn\-|describe|dictionary\?|disasm|distinct|doc|doc\*|doc\-format|drop\-until|drop\-while|each|empty\?|env\-lookup|error|eval|eval\-string|even\?|every\?|extreme|false\?|fiber/current|fiber/maxstack|fiber/new|fiber/setmaxstack|fiber/status|fiber\?|file/close|file/flush|file/open|file/popen|file/read|file/seek|file/write|filter|find|find\-index|first|flatten|flatten\-into|for|frequencies|function\?|gccollect|gcinterval|gcsetinterval|generate|gensym|get|getline|hash|idempotent\?|identity|if\-let|if\-not|import|import\*|inc|indexed\?|int|integer\?|interleave|interpose|invert|janet/build|janet/version|juxt|juxt\*|keep|keys|keyword\?|kvs|last|length|let|loop|macex|macex1|make\-env|map|mapcat|marshal|match|match\-1|math/acos|math/asin|math/atan|math/ceil|math/cos|math/e|math/exp|math/floor|math/inf|math/log|math/log10|math/pi|math/pow|math/random|math/seedrandom|math/sin|math/sqrt|math/tan|max|max\-order|merge|merge\-into|min|min\-order|module/find|module/native\-paths|module/paths|native|neg\?|next|nil\?|not|not=|not==|number\?|odd\?|one\?|or|order<|order<=|order>|order>=|os/clock|os/cwd|os/execute|os/exit|os/getenv|os/setenv|os/shell|os/sleep|os/time|os/which|pairs|parser/byte|parser/consume|parser/error|parser/flush|parser/new|parser/produce|parser/state|parser/status|parser/where|partial|pos\?|post\-walk|pre\-walk|print|process/args|product|put|range|real|real\?|reduce|repl|require|resume|reverse|run\-context|scan\-integer|scan\-number|scan\-real|sentinel|seq|some|sort|sorted|status\-pp|stderr|stdin|stdout|string|string/ascii\-lower|string/ascii\-upper|string/bytes|string/check\-set|string/find|string/find\-all|string/from\-bytes|string/join|string/number|string/pretty|string/repeat|string/replace|string/replace\-all|string/reverse|string/slice|string/split|string\?|struct|struct\?|sum|symbol|symbol\?|table|table/getproto|table/new|table/rawget|table/setproto|table/to\-struct|table\?|take\-until|take\-while|true\?|tuple|tuple/append|tuple/prepend|tuple/slice|tuple\?|type|unless|unmarshal|update|values|varglobal|walk|when|when\-let|with\-idemp|yield|zero\?|zipcoll)(?![\.:\w_\-=!@\$%^&?|\\/<>*])</string>
|
||||
<string>(?<![\.:\w_\-=!@\$%^&?|\\/<>*])(%|%=|\*|\*=|\*doc\-width\*|\*env\*|\+|\+\+|\+=|\-|\-\-|\-=|\->|\->>|\-\?>|\-\?>>|/|/=|<|<=|=|==|>|>=|_env|abstract\?|all|all\-symbols|allsyms|and|apply|array|array/concat|array/ensure|array/insert|array/new|array/peek|array/pop|array/push|array/slice|array\?|as\->|as\?\->|asm|band|blshift|bnot|boolean\?|bor|brshift|brushift|buffer|buffer/clear|buffer/new|buffer/popn|buffer/push\-byte|buffer/push\-string|buffer/push\-word|buffer/slice|buffer\?|bxor|bytes\?|callable\?|case|cfunction\?|comment|comp|compile|complement|cond|coro|count|debug|debug/arg\-stack|debug/break|debug/fbreak|debug/lineage|debug/stack|debug/unbreak|debug/unfbreak|dec|deep\-not=|deep=|def\-|default|defglobal|defmacro|defmacro\-|defn|defn\-|describe|dictionary\?|disasm|distinct|doc|doc\*|doc\-format|drop\-until|drop\-while|each|empty\?|env\-lookup|error|eval|eval\-string|even\?|every\?|extreme|false\?|fiber/current|fiber/maxstack|fiber/new|fiber/setmaxstack|fiber/status|fiber\?|file/close|file/flush|file/open|file/popen|file/read|file/seek|file/write|filter|find|find\-index|first|flatten|flatten\-into|for|frequencies|function\?|gccollect|gcinterval|gcsetinterval|generate|gensym|get|getline|hash|idempotent\?|identity|if\-let|if\-not|import|import\*|inc|indexed\?|interleave|interpose|invert|janet/build|janet/version|juxt|juxt\*|keep|keys|keyword|keyword\?|kvs|last|length|let|loop|macex|macex1|make\-env|map|mapcat|marshal|match|match\-1|math/acos|math/asin|math/atan|math/ceil|math/cos|math/e|math/exp|math/floor|math/inf|math/log|math/log10|math/pi|math/pow|math/random|math/seedrandom|math/sin|math/sqrt|math/tan|max|max\-order|merge|merge\-into|min|min\-order|module/find|module/native\-paths|module/paths|native|neg\?|next|nil\?|not|not=|not==|number\?|odd\?|one\?|or|order<|order<=|order>|order>=|os/clock|os/cwd|os/execute|os/exit|os/getenv|os/setenv|os/shell|os/sleep|os/time|os/which|pairs|parser/byte|parser/consume|parser/error|parser/flush|parser/has\-more|parser/new|parser/produce|parser/state|parser/status|parser/where|partial|pos\?|postwalk|prewalk|print|process/args|product|put|range|reduce|repl|require|resume|reverse|run\-context|scan\-number|sentinel|seq|some|sort|sorted|status\-pp|stderr|stdin|stdout|string|string/ascii\-lower|string/ascii\-upper|string/bytes|string/check\-set|string/find|string/find\-all|string/from\-bytes|string/join|string/number|string/pretty|string/repeat|string/replace|string/replace\-all|string/reverse|string/slice|string/split|string\?|struct|struct\?|sum|symbol|symbol\?|table|table/getproto|table/new|table/rawget|table/setproto|table/to\-struct|table\?|take\-until|take\-while|true\?|try|tuple|tuple/append|tuple/prepend|tuple/slice|tuple\?|type|unless|unmarshal|update|values|varglobal|walk|when|when\-let|with\-idemp|yield|zero\?|zipcoll)(?![\.:\w_\-=!@\$%^&?|\\/<>*])</string>
|
||||
<key>name</key>
|
||||
<string>keyword.control.janet</string>
|
||||
</dict>
|
||||
|
||||
4
janet.1
4
janet.1
@@ -8,7 +8,7 @@ janet \- run the janet language abstract machine
|
||||
[\fB\-\-\fR]
|
||||
.IR files ...
|
||||
.SH DESCRIPTION
|
||||
Janet is a functional and imperative programming language and bytecode interpreter.
|
||||
Janet is a functional and imperative programming language and bytecode interpreter.
|
||||
It is a modern lisp, but lists are replaced by other data structures with better utility
|
||||
and performance (arrays, tables, structs, tuples). The language also bridging bridging
|
||||
to native code written in C, meta-programming with macros, and bytecode assembly.
|
||||
@@ -19,7 +19,7 @@ into other programs. Try janet in your browser at https://janet-lang.org.
|
||||
|
||||
Implemented in mostly standard C99, janet runs on Windows, Linux and macOS.
|
||||
The few features that are not standard C99 (dynamic library loading, compiler
|
||||
specific optimizations), are fairly straight forward. Janet can be easily ported to
|
||||
specific optimizations), are fairly straight forward. Janet can be easily ported to
|
||||
most new platforms.
|
||||
.SH DOCUMENTATION
|
||||
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2018 Calvin Rose
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
211
src/core/array.c
211
src/core/array.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2018 Calvin Rose
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -22,6 +22,7 @@
|
||||
|
||||
#include <janet/janet.h>
|
||||
#include "gc.h"
|
||||
#include "util.h"
|
||||
#include <string.h>
|
||||
|
||||
/* Initializes an array */
|
||||
@@ -118,190 +119,150 @@ Janet janet_array_peek(JanetArray *array) {
|
||||
|
||||
/* C Functions */
|
||||
|
||||
static int cfun_new(JanetArgs args) {
|
||||
int32_t cap;
|
||||
JanetArray *array;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_ARG_INTEGER(cap, args, 0);
|
||||
array = janet_array(cap);
|
||||
JANET_RETURN_ARRAY(args, array);
|
||||
static Janet cfun_new(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
int32_t cap = janet_getinteger(argv, 0);
|
||||
JanetArray *array = janet_array(cap);
|
||||
return janet_wrap_array(array);
|
||||
}
|
||||
|
||||
static int cfun_pop(JanetArgs args) {
|
||||
JanetArray *array;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_ARG_ARRAY(array, args, 0);
|
||||
JANET_RETURN(args, janet_array_pop(array));
|
||||
static Janet cfun_pop(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetArray *array = janet_getarray(argv, 0);
|
||||
return janet_array_pop(array);
|
||||
}
|
||||
|
||||
static int cfun_peek(JanetArgs args) {
|
||||
JanetArray *array;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_ARG_ARRAY(array, args, 0);
|
||||
JANET_RETURN(args, janet_array_peek(array));
|
||||
static Janet cfun_peek(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetArray *array = janet_getarray(argv, 0);
|
||||
return janet_array_peek(array);
|
||||
}
|
||||
|
||||
static int cfun_push(JanetArgs args) {
|
||||
JanetArray *array;
|
||||
int32_t newcount;
|
||||
JANET_MINARITY(args, 1);
|
||||
JANET_ARG_ARRAY(array, args, 0);
|
||||
newcount = array->count - 1 + args.n;
|
||||
static Janet cfun_push(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, -1);
|
||||
JanetArray *array = janet_getarray(argv, 0);
|
||||
int32_t newcount = array->count - 1 + argc;
|
||||
janet_array_ensure(array, newcount, 2);
|
||||
if (args.n > 1) memcpy(array->data + array->count, args.v + 1, (args.n - 1) * sizeof(Janet));
|
||||
if (argc > 1) memcpy(array->data + array->count, argv + 1, (argc - 1) * sizeof(Janet));
|
||||
array->count = newcount;
|
||||
JANET_RETURN(args, args.v[0]);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static int cfun_ensure(JanetArgs args) {
|
||||
JanetArray *array;
|
||||
int32_t newcount;
|
||||
int32_t growth;
|
||||
JANET_FIXARITY(args, 3);
|
||||
JANET_ARG_ARRAY(array, args, 0);
|
||||
JANET_ARG_INTEGER(newcount, args, 1);
|
||||
JANET_ARG_INTEGER(growth, args, 2);
|
||||
if (newcount < 0) JANET_THROW(args, "expected positive integer");
|
||||
static Janet cfun_ensure(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 3);
|
||||
JanetArray *array = janet_getarray(argv, 0);
|
||||
int32_t newcount = janet_getinteger(argv, 1);
|
||||
int32_t growth = janet_getinteger(argv, 2);
|
||||
if (newcount < 1) janet_panic("expected positive integer");
|
||||
janet_array_ensure(array, newcount, growth);
|
||||
JANET_RETURN(args, args.v[0]);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static int cfun_slice(JanetArgs args) {
|
||||
const Janet *vals;
|
||||
int32_t len;
|
||||
JanetArray *ret;
|
||||
int32_t start, end;
|
||||
JANET_MINARITY(args, 1);
|
||||
JANET_MAXARITY(args, 3);
|
||||
if (!janet_indexed_view(args.v[0], &vals, &len))
|
||||
JANET_THROW(args, "expected array|tuple");
|
||||
/* Get start */
|
||||
if (args.n < 2) {
|
||||
start = 0;
|
||||
} else {
|
||||
JANET_ARG_INTEGER(start, args, 1);
|
||||
}
|
||||
/* Get end */
|
||||
if (args.n < 3) {
|
||||
end = -1;
|
||||
} else {
|
||||
JANET_ARG_INTEGER(end, args, 2);
|
||||
}
|
||||
if (start < 0) start = len + start;
|
||||
if (end < 0) end = len + end + 1;
|
||||
if (end < 0 || start < 0 || end > len || start > len)
|
||||
JANET_THROW(args, "slice range out of bounds");
|
||||
if (end >= start) {
|
||||
ret = janet_array(end - start);
|
||||
memcpy(ret->data, vals + start, sizeof(Janet) * (end - start));
|
||||
ret->count = end - start;
|
||||
} else {
|
||||
ret = janet_array(0);
|
||||
}
|
||||
JANET_RETURN_ARRAY(args, ret);
|
||||
static Janet cfun_slice(int32_t argc, Janet *argv) {
|
||||
JanetRange range = janet_getslice(argc, argv);
|
||||
JanetView view = janet_getindexed(argv, 0);
|
||||
JanetArray *array = janet_array(range.end - range.start);
|
||||
memcpy(array->data, view.items + range.start, sizeof(Janet) * (range.end - range.start));
|
||||
array->count = range.end - range.start;
|
||||
return janet_wrap_array(array);
|
||||
}
|
||||
|
||||
static int cfun_concat(JanetArgs args) {
|
||||
static Janet cfun_concat(int32_t argc, Janet *argv) {
|
||||
int32_t i;
|
||||
JanetArray *array;
|
||||
JANET_MINARITY(args, 1);
|
||||
JANET_ARG_ARRAY(array, args, 0);
|
||||
for (i = 1; i < args.n; i++) {
|
||||
switch (janet_type(args.v[i])) {
|
||||
janet_arity(argc, 1, -1);
|
||||
JanetArray *array = janet_getarray(argv, 0);
|
||||
for (i = 1; i < argc; i++) {
|
||||
switch (janet_type(argv[i])) {
|
||||
default:
|
||||
janet_array_push(array, args.v[i]);
|
||||
janet_array_push(array, argv[i]);
|
||||
break;
|
||||
case JANET_ARRAY:
|
||||
case JANET_TUPLE:
|
||||
{
|
||||
int32_t j, len;
|
||||
const Janet *vals;
|
||||
janet_indexed_view(args.v[i], &vals, &len);
|
||||
janet_indexed_view(argv[i], &vals, &len);
|
||||
for (j = 0; j < len; j++)
|
||||
janet_array_push(array, vals[j]);
|
||||
}
|
||||
break;
|
||||
}
|
||||
}
|
||||
JANET_RETURN_ARRAY(args, array);
|
||||
return janet_wrap_array(array);
|
||||
}
|
||||
|
||||
static int cfun_insert(JanetArgs args) {
|
||||
int32_t at;
|
||||
static Janet cfun_insert(int32_t argc, Janet *argv) {
|
||||
size_t chunksize, restsize;
|
||||
JanetArray *array;
|
||||
JANET_MINARITY(args, 2);
|
||||
JANET_ARG_ARRAY(array, args, 0);
|
||||
JANET_ARG_INTEGER(at, args, 1);
|
||||
janet_arity(argc, 2, -1);
|
||||
JanetArray *array = janet_getarray(argv, 0);
|
||||
int32_t at = janet_getinteger(argv, 1);
|
||||
if (at < 0) {
|
||||
at = array->count + at + 1;
|
||||
at = array->count + at + 1;
|
||||
}
|
||||
if (at < 0 || at > array->count)
|
||||
JANET_THROW(args, "insertion index out of bounds");
|
||||
chunksize = (args.n - 2) * sizeof(Janet);
|
||||
janet_panicf("insertion index %d out of range [0,%d]", at, array->count);
|
||||
chunksize = (argc - 2) * sizeof(Janet);
|
||||
restsize = (array->count - at) * sizeof(Janet);
|
||||
janet_array_ensure(array, array->count + args.n - 2, 2);
|
||||
memmove(array->data + at + args.n - 2,
|
||||
janet_array_ensure(array, array->count + argc - 2, 2);
|
||||
memmove(array->data + at + argc - 2,
|
||||
array->data + at,
|
||||
restsize);
|
||||
memcpy(array->data + at, args.v + 2, chunksize);
|
||||
array->count += (args.n - 2);
|
||||
JANET_RETURN_ARRAY(args, array);
|
||||
memcpy(array->data + at, argv + 2, chunksize);
|
||||
array->count += (argc - 2);
|
||||
return janet_wrap_array(array);
|
||||
}
|
||||
|
||||
static const JanetReg cfuns[] = {
|
||||
{"array/new", cfun_new,
|
||||
"(array/new capacity)\n\n"
|
||||
"Creates a new empty array with a preallocated capacity. The same as "
|
||||
"(array) but can be more efficient if the maximum size of an array is known."
|
||||
JDOC("(array/new capacity)\n\n"
|
||||
"Creates a new empty array with a pre-allocated capacity. The same as "
|
||||
"(array) but can be more efficient if the maximum size of an array is known.")
|
||||
},
|
||||
{"array/pop", cfun_pop,
|
||||
"(array/pop arr)\n\n"
|
||||
"Remove the last element of the array and return it. If the array is empty, will return nil. Modifies "
|
||||
"the input array."
|
||||
JDOC("(array/pop arr)\n\n"
|
||||
"Remove the last element of the array and return it. If the array is empty, will return nil. Modifies "
|
||||
"the input array.")
|
||||
},
|
||||
{"array/peek", cfun_peek,
|
||||
"(array/peek arr)\n\n"
|
||||
"Returns the last element of the array. Does not modify the array."
|
||||
JDOC("(array/peek arr)\n\n"
|
||||
"Returns the last element of the array. Does not modify the array.")
|
||||
},
|
||||
{"array/push", cfun_push,
|
||||
"(array/push arr x)\n\n"
|
||||
"Insert an element in the end of an array. Modifies the input array and returns it."
|
||||
JDOC("(array/push arr x)\n\n"
|
||||
"Insert an element in the end of an array. Modifies the input array and returns it.")
|
||||
},
|
||||
{"array/ensure", cfun_ensure,
|
||||
"(array/ensure arr capacity)\n\n"
|
||||
"Ensures that the memory backing the array has enough memory for capacity "
|
||||
"items. Capacity must be an integer. If the backing capacity is already enough, "
|
||||
"then this function does nothing. Otherwise, the backing memory will be reallocated "
|
||||
"so that there is enough space."
|
||||
JDOC("(array/ensure arr capacity)\n\n"
|
||||
"Ensures that the memory backing the array has enough memory for capacity "
|
||||
"items. Capacity must be an integer. If the backing capacity is already enough, "
|
||||
"then this function does nothing. Otherwise, the backing memory will be reallocated "
|
||||
"so that there is enough space.")
|
||||
},
|
||||
{"array/slice", cfun_slice,
|
||||
"(array/slice arrtup [, start=0 [, end=(length arrtup)]])\n\n"
|
||||
"Takes a slice of array or tuple from start to end. The range is half open, "
|
||||
"[start, end). Indexes can also be negative, indicating indexing from the end of the "
|
||||
"end of the array. By default, start is 0 and end is the length of the array. "
|
||||
"Returns a new array."
|
||||
JDOC("(array/slice arrtup [, start=0 [, end=(length arrtup)]])\n\n"
|
||||
"Takes a slice of array or tuple from start to end. The range is half open, "
|
||||
"[start, end). Indexes can also be negative, indicating indexing from the end of the "
|
||||
"end of the array. By default, start is 0 and end is the length of the array. "
|
||||
"Returns a new array.")
|
||||
},
|
||||
{"array/concat", cfun_concat,
|
||||
"(array/concat arr & parts)\n\n"
|
||||
"Concatenates a variadic number of arrays (and tuples) into the first argument "
|
||||
"which must an array. If any of the parts are arrays or tuples, their elements will "
|
||||
"be inserted into the array. Otherwise, each part in parts will be appended to arr in order. "
|
||||
"Return the modified array arr."
|
||||
JDOC("(array/concat arr & parts)\n\n"
|
||||
"Concatenates a variadic number of arrays (and tuples) into the first argument "
|
||||
"which must an array. If any of the parts are arrays or tuples, their elements will "
|
||||
"be inserted into the array. Otherwise, each part in parts will be appended to arr in order. "
|
||||
"Return the modified array arr.")
|
||||
},
|
||||
{"array/insert", cfun_insert,
|
||||
"(array/insert arr at & xs)\n\n"
|
||||
"Insert all of xs into array arr at index at. at should be an integer "
|
||||
"0 and the length of the array. A negative value for at will index from "
|
||||
"the end of the array, such that inserting at -1 appends to the array. "
|
||||
"Returns the array."
|
||||
JDOC("(array/insert arr at & xs)\n\n"
|
||||
"Insert all of xs into array arr at index at. at should be an integer "
|
||||
"0 and the length of the array. A negative value for at will index from "
|
||||
"the end of the array, such that inserting at -1 appends to the array. "
|
||||
"Returns the array.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
/* Load the array module */
|
||||
int janet_lib_array(JanetArgs args) {
|
||||
JanetTable *env = janet_env(args);
|
||||
void janet_lib_array(JanetTable *env) {
|
||||
janet_cfuns(env, NULL, cfuns);
|
||||
return 0;
|
||||
}
|
||||
|
||||
127
src/core/asm.c
127
src/core/asm.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2018 Calvin Rose
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -48,14 +48,14 @@ struct JanetAssembler {
|
||||
int32_t bytecode_count; /* Used for calculating labels */
|
||||
|
||||
Janet name;
|
||||
JanetTable labels; /* symbol -> bytecode index */
|
||||
JanetTable labels; /* keyword -> bytecode index */
|
||||
JanetTable constants; /* symbol -> constant index */
|
||||
JanetTable slots; /* symbol -> slot index */
|
||||
JanetTable envs; /* symbol -> environment index */
|
||||
JanetTable defs; /* symbol -> funcdefs index */
|
||||
};
|
||||
|
||||
/* Janet opcode descriptions in lexographic order. This
|
||||
/* Janet opcode descriptions in lexicographic order. This
|
||||
* allows a binary search over the elements to find the
|
||||
* correct opcode given a name. This works in reasonable
|
||||
* time and is easier to setup statically than a hash table or
|
||||
@@ -137,25 +137,26 @@ typedef struct TypeAlias {
|
||||
} TypeAlias;
|
||||
|
||||
static const TypeAlias type_aliases[] = {
|
||||
{":abstract", JANET_TFLAG_ABSTRACT},
|
||||
{":array", JANET_TFLAG_ARRAY},
|
||||
{":boolean", JANET_TFLAG_BOOLEAN},
|
||||
{":buffer", JANET_TFLAG_BUFFER},
|
||||
{":callable", JANET_TFLAG_CALLABLE},
|
||||
{":cfunction", JANET_TFLAG_CFUNCTION},
|
||||
{":dictionary", JANET_TFLAG_DICTIONARY},
|
||||
{":false", JANET_TFLAG_FALSE},
|
||||
{":fiber", JANET_TFLAG_FIBER},
|
||||
{":function", JANET_TFLAG_FUNCTION},
|
||||
{":indexed", JANET_TFLAG_INDEXED},
|
||||
{":nil", JANET_TFLAG_NIL},
|
||||
{":number", JANET_TFLAG_NUMBER},
|
||||
{":string", JANET_TFLAG_STRING},
|
||||
{":struct", JANET_TFLAG_STRUCT},
|
||||
{":symbol", JANET_TFLAG_SYMBOL},
|
||||
{":table", JANET_TFLAG_BOOLEAN},
|
||||
{":true", JANET_TFLAG_TRUE},
|
||||
{":tuple", JANET_TFLAG_BOOLEAN}
|
||||
{"abstract", JANET_TFLAG_ABSTRACT},
|
||||
{"array", JANET_TFLAG_ARRAY},
|
||||
{"boolean", JANET_TFLAG_BOOLEAN},
|
||||
{"buffer", JANET_TFLAG_BUFFER},
|
||||
{"callable", JANET_TFLAG_CALLABLE},
|
||||
{"cfunction", JANET_TFLAG_CFUNCTION},
|
||||
{"dictionary", JANET_TFLAG_DICTIONARY},
|
||||
{"false", JANET_TFLAG_FALSE},
|
||||
{"fiber", JANET_TFLAG_FIBER},
|
||||
{"function", JANET_TFLAG_FUNCTION},
|
||||
{"indexed", JANET_TFLAG_INDEXED},
|
||||
{"nil", JANET_TFLAG_NIL},
|
||||
{"number", JANET_TFLAG_NUMBER},
|
||||
{"string", JANET_TFLAG_STRING},
|
||||
{"struct", JANET_TFLAG_STRUCT},
|
||||
{"symbol", JANET_TFLAG_SYMBOL},
|
||||
{"keyword", JANET_TFLAG_KEYWORD},
|
||||
{"table", JANET_TFLAG_BOOLEAN},
|
||||
{"true", JANET_TFLAG_TRUE},
|
||||
{"tuple", JANET_TFLAG_BOOLEAN}
|
||||
};
|
||||
|
||||
/* Deinitialize an Assembler. Does not deinitialize the parents. */
|
||||
@@ -252,8 +253,8 @@ static int32_t doarg_1(
|
||||
case JANET_NUMBER:
|
||||
{
|
||||
double y = janet_unwrap_number(x);
|
||||
if (y >= INT32_MIN && y <= INT32_MAX) {
|
||||
ret = y;
|
||||
if (janet_checkintrange(y)) {
|
||||
ret = (int32_t) y;
|
||||
} else {
|
||||
goto error;
|
||||
}
|
||||
@@ -273,25 +274,21 @@ static int32_t doarg_1(
|
||||
}
|
||||
break;
|
||||
}
|
||||
case JANET_SYMBOL:
|
||||
case JANET_KEYWORD:
|
||||
{
|
||||
if (NULL != c) {
|
||||
if (NULL != c && argtype == JANET_OAT_LABEL) {
|
||||
Janet result = janet_table_get(c, x);
|
||||
if (janet_checktype(result, JANET_NUMBER)) {
|
||||
if (argtype == JANET_OAT_LABEL) {
|
||||
ret = janet_unwrap_integer(result) - a->bytecode_count;
|
||||
} else {
|
||||
ret = (int32_t) janet_unwrap_number(result);
|
||||
}
|
||||
ret = janet_unwrap_integer(result) - a->bytecode_count;
|
||||
} else {
|
||||
janet_asm_errorv(a, janet_formatc("unknown name %v", x));
|
||||
goto error;
|
||||
}
|
||||
} else if (argtype == JANET_OAT_TYPE || argtype == JANET_OAT_SIMPLETYPE) {
|
||||
const TypeAlias *alias = janet_strbinsearch(
|
||||
&type_aliases,
|
||||
sizeof(type_aliases)/sizeof(TypeAlias),
|
||||
sizeof(TypeAlias),
|
||||
janet_unwrap_symbol(x));
|
||||
janet_unwrap_keyword(x));
|
||||
if (alias) {
|
||||
ret = alias->mask;
|
||||
} else {
|
||||
@@ -300,6 +297,20 @@ static int32_t doarg_1(
|
||||
} else {
|
||||
goto error;
|
||||
}
|
||||
break;
|
||||
}
|
||||
case JANET_SYMBOL:
|
||||
{
|
||||
if (NULL != c) {
|
||||
Janet result = janet_table_get(c, x);
|
||||
if (janet_checktype(result, JANET_NUMBER)) {
|
||||
ret = (int32_t) janet_unwrap_number(result);
|
||||
} else {
|
||||
janet_asm_errorv(a, janet_formatc("unknown name %v", x));
|
||||
}
|
||||
} else {
|
||||
goto error;
|
||||
}
|
||||
if (argtype == JANET_OAT_ENVIRONMENT && ret == -1) {
|
||||
/* Add a new env */
|
||||
ret = janet_asm_addenv(a, x);
|
||||
@@ -633,7 +644,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
int32_t blength = 0;
|
||||
for (i = 0; i < count; ++i) {
|
||||
Janet instr = arr[i];
|
||||
if (janet_checktype(instr, JANET_SYMBOL)) {
|
||||
if (janet_checktype(instr, JANET_KEYWORD)) {
|
||||
janet_table_put(&a.labels, instr, janet_wrap_integer(blength));
|
||||
} else if (janet_checktype(instr, JANET_TUPLE)) {
|
||||
blength++;
|
||||
@@ -651,7 +662,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
/* Do bytecode */
|
||||
for (i = 0; i < count; ++i) {
|
||||
Janet instr = arr[i];
|
||||
if (janet_checktype(instr, JANET_SYMBOL)) {
|
||||
if (janet_checktype(instr, JANET_KEYWORD)) {
|
||||
continue;
|
||||
} else {
|
||||
uint32_t op;
|
||||
@@ -731,7 +742,7 @@ JanetAssembleResult janet_asm(Janet source, int flags) {
|
||||
|
||||
/* Disassembly */
|
||||
|
||||
/* Find the deinfintion of an instruction given the instruction word. Return
|
||||
/* Find the definition of an instruction given the instruction word. Return
|
||||
* NULL if not found. */
|
||||
static const JanetInstructionDef *janet_asm_reverse_lookup(uint32_t instr) {
|
||||
size_t i;
|
||||
@@ -772,7 +783,7 @@ static Janet tup4(Janet w, Janet x, Janet y, Janet z) {
|
||||
return janet_wrap_tuple(janet_tuple_end(tup));
|
||||
}
|
||||
|
||||
/* Given an argument, convert it to the appriate integer or symbol */
|
||||
/* Given an argument, convert it to the appropriate integer or symbol */
|
||||
Janet janet_asm_decode_instruction(uint32_t instr) {
|
||||
const JanetInstructionDef *def = janet_asm_reverse_lookup(instr);
|
||||
Janet name;
|
||||
@@ -903,45 +914,41 @@ Janet janet_disasm(JanetFuncDef *def) {
|
||||
}
|
||||
|
||||
/* C Function for assembly */
|
||||
static int cfun_asm(JanetArgs args) {
|
||||
static Janet cfun_asm(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 1);
|
||||
JanetAssembleResult res;
|
||||
JANET_FIXARITY(args, 1);
|
||||
res = janet_asm(args.v[0], 0);
|
||||
if (res.status == JANET_ASSEMBLE_OK) {
|
||||
JANET_RETURN_FUNCTION(args, janet_thunk(res.funcdef));
|
||||
} else {
|
||||
JANET_THROWV(args, janet_wrap_string(res.error));
|
||||
res = janet_asm(argv[0], 0);
|
||||
if (res.status != JANET_ASSEMBLE_OK) {
|
||||
janet_panics(res.error);
|
||||
}
|
||||
return janet_wrap_function(janet_thunk(res.funcdef));
|
||||
}
|
||||
|
||||
static int cfun_disasm(JanetArgs args) {
|
||||
JanetFunction *f;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_ARG_FUNCTION(f, args, 0);
|
||||
JANET_RETURN(args, janet_disasm(f->def));
|
||||
static Janet cfun_disasm(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 1);
|
||||
JanetFunction *f = janet_getfunction(argv, 0);
|
||||
return janet_disasm(f->def);
|
||||
}
|
||||
|
||||
static const JanetReg cfuns[] = {
|
||||
{"asm", cfun_asm,
|
||||
"(asm assembly)\n\n"
|
||||
"Returns a new function that is the compiled result of the assembly.\n"
|
||||
"The syntax for the assembly can be found on the janet wiki. Will throw an\n"
|
||||
"error on invalid assembly."
|
||||
JDOC("(asm assembly)\n\n"
|
||||
"Returns a new function that is the compiled result of the assembly.\n"
|
||||
"The syntax for the assembly can be found on the janet wiki. Will throw an\n"
|
||||
"error on invalid assembly.")
|
||||
},
|
||||
{"disasm", cfun_disasm,
|
||||
"(disasm func)\n\n"
|
||||
"Returns assembly that could be used be compile the given function.\n"
|
||||
"func must be a function, not a c function. Will throw on error on a badly\n"
|
||||
"typed argument."
|
||||
JDOC("(disasm func)\n\n"
|
||||
"Returns assembly that could be used be compile the given function.\n"
|
||||
"func must be a function, not a c function. Will throw on error on a badly\n"
|
||||
"typed argument.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
/* Load the library */
|
||||
int janet_lib_asm(JanetArgs args) {
|
||||
JanetTable *env = janet_env(args);
|
||||
void janet_lib_asm(JanetTable *env) {
|
||||
janet_cfuns(env, NULL, cfuns);
|
||||
return 0;
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2018 Calvin Rose
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -22,6 +22,7 @@
|
||||
|
||||
#include <janet/janet.h>
|
||||
#include "gc.h"
|
||||
#include "util.h"
|
||||
|
||||
/* Initialize a buffer */
|
||||
JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity) {
|
||||
@@ -77,10 +78,10 @@ void janet_buffer_setcount(JanetBuffer *buffer, int32_t count) {
|
||||
|
||||
/* Adds capacity for enough extra bytes to the buffer. Ensures that the
|
||||
* next n bytes pushed to the buffer will not cause a reallocation */
|
||||
int janet_buffer_extra(JanetBuffer *buffer, int32_t n) {
|
||||
void janet_buffer_extra(JanetBuffer *buffer, int32_t n) {
|
||||
/* Check for buffer overflow */
|
||||
if ((int64_t)n + buffer->count > INT32_MAX) {
|
||||
return -1;
|
||||
janet_panic("buffer overflow");
|
||||
}
|
||||
int32_t new_size = buffer->count + n;
|
||||
if (new_size > buffer->capacity) {
|
||||
@@ -92,59 +93,54 @@ int janet_buffer_extra(JanetBuffer *buffer, int32_t n) {
|
||||
buffer->data = new_data;
|
||||
buffer->capacity = new_capacity;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* Push a cstring to buffer */
|
||||
int janet_buffer_push_cstring(JanetBuffer *buffer, const char *cstring) {
|
||||
void janet_buffer_push_cstring(JanetBuffer *buffer, const char *cstring) {
|
||||
int32_t len = 0;
|
||||
while (cstring[len]) ++len;
|
||||
return janet_buffer_push_bytes(buffer, (const uint8_t *) cstring, len);
|
||||
janet_buffer_push_bytes(buffer, (const uint8_t *) cstring, len);
|
||||
}
|
||||
|
||||
/* Push multiple bytes into the buffer */
|
||||
int janet_buffer_push_bytes(JanetBuffer *buffer, const uint8_t *string, int32_t length) {
|
||||
if (janet_buffer_extra(buffer, length)) return -1;
|
||||
void janet_buffer_push_bytes(JanetBuffer *buffer, const uint8_t *string, int32_t length) {
|
||||
janet_buffer_extra(buffer, length);
|
||||
memcpy(buffer->data + buffer->count, string, length);
|
||||
buffer->count += length;
|
||||
return 0;
|
||||
}
|
||||
|
||||
int janet_buffer_push_string(JanetBuffer *buffer, const uint8_t *string) {
|
||||
return janet_buffer_push_bytes(buffer, string, janet_string_length(string));
|
||||
void janet_buffer_push_string(JanetBuffer *buffer, const uint8_t *string) {
|
||||
janet_buffer_push_bytes(buffer, string, janet_string_length(string));
|
||||
}
|
||||
|
||||
/* Push a single byte to the buffer */
|
||||
int janet_buffer_push_u8(JanetBuffer *buffer, uint8_t byte) {
|
||||
if (janet_buffer_extra(buffer, 1)) return -1;
|
||||
void janet_buffer_push_u8(JanetBuffer *buffer, uint8_t byte) {
|
||||
janet_buffer_extra(buffer, 1);
|
||||
buffer->data[buffer->count] = byte;
|
||||
buffer->count++;
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* Push a 16 bit unsigned integer to the buffer */
|
||||
int janet_buffer_push_u16(JanetBuffer *buffer, uint16_t x) {
|
||||
if (janet_buffer_extra(buffer, 2)) return -1;
|
||||
void janet_buffer_push_u16(JanetBuffer *buffer, uint16_t x) {
|
||||
janet_buffer_extra(buffer, 2);
|
||||
buffer->data[buffer->count] = x & 0xFF;
|
||||
buffer->data[buffer->count + 1] = (x >> 8) & 0xFF;
|
||||
buffer->count += 2;
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* Push a 32 bit unsigned integer to the buffer */
|
||||
int janet_buffer_push_u32(JanetBuffer *buffer, uint32_t x) {
|
||||
if (janet_buffer_extra(buffer, 4)) return -1;
|
||||
void janet_buffer_push_u32(JanetBuffer *buffer, uint32_t x) {
|
||||
janet_buffer_extra(buffer, 4);
|
||||
buffer->data[buffer->count] = x & 0xFF;
|
||||
buffer->data[buffer->count + 1] = (x >> 8) & 0xFF;
|
||||
buffer->data[buffer->count + 2] = (x >> 16) & 0xFF;
|
||||
buffer->data[buffer->count + 3] = (x >> 24) & 0xFF;
|
||||
buffer->count += 4;
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* Push a 64 bit unsigned integer to the buffer */
|
||||
int janet_buffer_push_u64(JanetBuffer *buffer, uint64_t x) {
|
||||
if (janet_buffer_extra(buffer, 8)) return -1;
|
||||
void janet_buffer_push_u64(JanetBuffer *buffer, uint64_t x) {
|
||||
janet_buffer_extra(buffer, 8);
|
||||
buffer->data[buffer->count] = x & 0xFF;
|
||||
buffer->data[buffer->count + 1] = (x >> 8) & 0xFF;
|
||||
buffer->data[buffer->count + 2] = (x >> 16) & 0xFF;
|
||||
@@ -154,161 +150,123 @@ int janet_buffer_push_u64(JanetBuffer *buffer, uint64_t x) {
|
||||
buffer->data[buffer->count + 6] = (x >> 48) & 0xFF;
|
||||
buffer->data[buffer->count + 7] = (x >> 56) & 0xFF;
|
||||
buffer->count += 8;
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* C functions */
|
||||
|
||||
static int cfun_new(JanetArgs args) {
|
||||
int32_t cap;
|
||||
JanetBuffer *buffer;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_ARG_INTEGER(cap, args, 0);
|
||||
buffer = janet_buffer(cap);
|
||||
JANET_RETURN_BUFFER(args, buffer);
|
||||
static Janet cfun_new(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
int32_t cap = janet_getinteger(argv, 0);
|
||||
JanetBuffer *buffer = janet_buffer(cap);
|
||||
return janet_wrap_buffer(buffer);
|
||||
}
|
||||
|
||||
static int cfun_u8(JanetArgs args) {
|
||||
static Janet cfun_u8(int32_t argc, Janet *argv) {
|
||||
int32_t i;
|
||||
JanetBuffer *buffer;
|
||||
JANET_MINARITY(args, 1);
|
||||
JANET_ARG_BUFFER(buffer, args, 0);
|
||||
for (i = 1; i < args.n; i++) {
|
||||
int32_t integer;
|
||||
JANET_ARG_INTEGER(integer, args, i);
|
||||
if (janet_buffer_push_u8(buffer, (uint8_t) (integer & 0xFF)))
|
||||
JANET_THROW(args, "buffer overflow");
|
||||
janet_arity(argc, 1, -1);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
for (i = 1; i < argc; i++) {
|
||||
janet_buffer_push_u8(buffer, (uint8_t) (janet_getinteger(argv, i) & 0xFF));
|
||||
}
|
||||
JANET_RETURN(args, args.v[0]);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static int cfun_int(JanetArgs args) {
|
||||
static Janet cfun_word(int32_t argc, Janet *argv) {
|
||||
int32_t i;
|
||||
JanetBuffer *buffer;
|
||||
JANET_MINARITY(args, 1);
|
||||
JANET_ARG_BUFFER(buffer, args, 0);
|
||||
for (i = 1; i < args.n; i++) {
|
||||
int32_t integer;
|
||||
JANET_ARG_INTEGER(integer, args, i);
|
||||
if (janet_buffer_push_u32(buffer, (uint32_t) integer))
|
||||
JANET_THROW(args, "buffer overflow");
|
||||
janet_arity(argc, 1, -1);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
for (i = 1; i < argc; i++) {
|
||||
double number = janet_getnumber(argv, 0);
|
||||
uint32_t word = (uint32_t) number;
|
||||
if (word != number)
|
||||
janet_panicf("cannot convert %v to machine word", argv[0]);
|
||||
janet_buffer_push_u32(buffer, word);
|
||||
}
|
||||
JANET_RETURN(args, args.v[0]);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static int cfun_chars(JanetArgs args) {
|
||||
static Janet cfun_chars(int32_t argc, Janet *argv) {
|
||||
int32_t i;
|
||||
JanetBuffer *buffer;
|
||||
JANET_MINARITY(args, 1);
|
||||
JANET_ARG_BUFFER(buffer, args, 0);
|
||||
for (i = 1; i < args.n; i++) {
|
||||
int32_t len;
|
||||
const uint8_t *str;
|
||||
JANET_ARG_BYTES(str, len, args, i);
|
||||
if (janet_buffer_push_bytes(buffer, str, len))
|
||||
JANET_THROW(args, "buffer overflow");
|
||||
janet_arity(argc, 1, -1);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
for (i = 1; i < argc; i++) {
|
||||
JanetByteView view = janet_getbytes(argv, i);
|
||||
janet_buffer_push_bytes(buffer, view.bytes, view.len);
|
||||
}
|
||||
JANET_RETURN(args, args.v[0]);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static int cfun_clear(JanetArgs args) {
|
||||
JanetBuffer *buffer;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_ARG_BUFFER(buffer, args, 0);
|
||||
static Janet cfun_clear(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
buffer->count = 0;
|
||||
JANET_RETURN(args, args.v[0]);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static int cfun_popn(JanetArgs args) {
|
||||
JanetBuffer *buffer;
|
||||
int32_t n;
|
||||
JANET_FIXARITY(args, 2);
|
||||
JANET_ARG_BUFFER(buffer, args, 0);
|
||||
JANET_ARG_INTEGER(n, args, 1);
|
||||
if (n < 0) JANET_THROW(args, "n must be non-negative");
|
||||
static Janet cfun_popn(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
int32_t n = janet_getinteger(argv, 1);
|
||||
if (n < 0) janet_panic("n must be non-negative");
|
||||
if (buffer->count < n) {
|
||||
buffer->count = 0;
|
||||
} else {
|
||||
buffer->count -= n;
|
||||
}
|
||||
JANET_RETURN(args, args.v[0]);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static int cfun_slice(JanetArgs args) {
|
||||
const uint8_t *data;
|
||||
int32_t len, start, end;
|
||||
JanetBuffer *ret;
|
||||
JANET_ARG_BYTES(data, len, args, 0);
|
||||
/* Get start */
|
||||
if (args.n < 2) {
|
||||
start = 0;
|
||||
} else {
|
||||
JANET_ARG_INTEGER(start, args, 1);
|
||||
}
|
||||
/* Get end */
|
||||
if (args.n < 3) {
|
||||
end = -1;
|
||||
} else {
|
||||
JANET_ARG_INTEGER(end, args, 2);
|
||||
}
|
||||
if (start < 0) start = len + start;
|
||||
if (end < 0) end = len + end + 1;
|
||||
if (end < 0 || start < 0 || end > len || start > len)
|
||||
JANET_THROW(args, "slice range out of bounds");
|
||||
if (end >= start) {
|
||||
ret = janet_buffer(end - start);
|
||||
memcpy(ret->data, data + start, end - start);
|
||||
ret->count = end - start;
|
||||
} else {
|
||||
ret = janet_buffer(0);
|
||||
}
|
||||
JANET_RETURN_BUFFER(args, ret);
|
||||
static Janet cfun_slice(int32_t argc, Janet *argv) {
|
||||
JanetRange range = janet_getslice(argc, argv);
|
||||
JanetByteView view = janet_getbytes(argv, 0);
|
||||
JanetBuffer *buffer = janet_buffer(range.end - range.start);
|
||||
memcpy(buffer->data, view.bytes + range.start, range.end - range.start);
|
||||
buffer->count = range.end - range.start;
|
||||
return janet_wrap_buffer(buffer);
|
||||
}
|
||||
|
||||
static const JanetReg cfuns[] = {
|
||||
{"buffer/new", cfun_new,
|
||||
"(buffer/new capacity)\n\n"
|
||||
"Creates a new, empty buffer with enough memory for capacity bytes. "
|
||||
"Returns a new buffer."
|
||||
JDOC("(buffer/new capacity)\n\n"
|
||||
"Creates a new, empty buffer with enough memory for capacity bytes. "
|
||||
"Returns a new buffer.")
|
||||
},
|
||||
{"buffer/push-byte", cfun_u8,
|
||||
"(buffer/push-byte buffer x)\n\n"
|
||||
"Append a byte to a buffer. Will expand the buffer as necessary. "
|
||||
"Returns the modified buffer. Will throw an error if the buffer overflows."
|
||||
JDOC("(buffer/push-byte buffer x)\n\n"
|
||||
"Append a byte to a buffer. Will expand the buffer as necessary. "
|
||||
"Returns the modified buffer. Will throw an error if the buffer overflows.")
|
||||
},
|
||||
{"buffer/push-integer", cfun_int,
|
||||
"(buffer/push-integer buffer x)\n\n"
|
||||
"Append an integer to a buffer. The 4 bytes of the integer are appended "
|
||||
"in twos complement, big endian order. Returns the modified buffer. Will "
|
||||
"throw an error if the buffer overflows."
|
||||
{"buffer/push-word", cfun_word,
|
||||
JDOC("(buffer/push-word buffer x)\n\n"
|
||||
"Append a machine word to a buffer. The 4 bytes of the integer are appended "
|
||||
"in twos complement, big endian order, unsigned. Returns the modified buffer. Will "
|
||||
"throw an error if the buffer overflows.")
|
||||
},
|
||||
{"buffer/push-string", cfun_chars,
|
||||
"(buffer/push-string buffer str)\n\n"
|
||||
"Push a string onto the end of a buffer. Non string values will be converted "
|
||||
"to strings before being pushed. Returns the modified buffer. "
|
||||
"Will throw an error if the buffer overflows."
|
||||
JDOC("(buffer/push-string buffer str)\n\n"
|
||||
"Push a string onto the end of a buffer. Non string values will be converted "
|
||||
"to strings before being pushed. Returns the modified buffer. "
|
||||
"Will throw an error if the buffer overflows.")
|
||||
},
|
||||
{"buffer/popn", cfun_popn,
|
||||
"(buffer/popn buffer n)\n\n"
|
||||
"Removes the last n bytes from the buffer. Returns the modified buffer."
|
||||
JDOC("(buffer/popn buffer n)\n\n"
|
||||
"Removes the last n bytes from the buffer. Returns the modified buffer.")
|
||||
},
|
||||
{"buffer/clear", cfun_clear,
|
||||
"(buffer/clear buffer)\n\n"
|
||||
"Sets the size of a buffer to 0 and empties it. The buffer retains "
|
||||
"its memory so it can be efficiently refilled. Returns the modified buffer."
|
||||
JDOC("(buffer/clear buffer)\n\n"
|
||||
"Sets the size of a buffer to 0 and empties it. The buffer retains "
|
||||
"its memory so it can be efficiently refilled. Returns the modified buffer.")
|
||||
},
|
||||
{"buffer/slice", cfun_slice,
|
||||
"(buffer/slice bytes [, start=0 [, end=(length bytes)]])\n\n"
|
||||
"Takes a slice of a byte sequence from start to end. The range is half open, "
|
||||
"[start, end). Indexes can also be negative, indicating indexing from the end of the "
|
||||
"end of the array. By default, start is 0 and end is the length of the buffer. "
|
||||
"Returns a new buffer."
|
||||
JDOC("(buffer/slice bytes [, start=0 [, end=(length bytes)]])\n\n"
|
||||
"Takes a slice of a byte sequence from start to end. The range is half open, "
|
||||
"[start, end). Indexes can also be negative, indicating indexing from the end of the "
|
||||
"end of the array. By default, start is 0 and end is the length of the buffer. "
|
||||
"Returns a new buffer.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
int janet_lib_buffer(JanetArgs args) {
|
||||
JanetTable *env = janet_env(args);
|
||||
void janet_lib_buffer(JanetTable *env) {
|
||||
janet_cfuns(env, NULL, cfuns);
|
||||
return 0;
|
||||
}
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2018 Calvin Rose
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
188
src/core/capi.c
Normal file
188
src/core/capi.c
Normal file
@@ -0,0 +1,188 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
* deal in the Software without restriction, including without limitation the
|
||||
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
||||
* sell copies of the Software, and to permit persons to whom the Software is
|
||||
* furnished to do so, subject to the following conditions:
|
||||
*
|
||||
* The above copyright notice and this permission notice shall be included in
|
||||
* all copies or substantial portions of the Software.
|
||||
*
|
||||
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
#include <janet/janet.h>
|
||||
#include "state.h"
|
||||
#include "fiber.h"
|
||||
|
||||
void janet_panicv(Janet message) {
|
||||
if (janet_vm_fiber != NULL) {
|
||||
janet_fiber_push(janet_vm_fiber, message);
|
||||
longjmp(janet_vm_fiber->buf, 1);
|
||||
} else {
|
||||
fputs((const char *)janet_formatc("janet top level panic - %v\n", message), stdout);
|
||||
exit(1);
|
||||
}
|
||||
}
|
||||
|
||||
void janet_panic(const char *message) {
|
||||
janet_panicv(janet_cstringv(message));
|
||||
}
|
||||
|
||||
void janet_panics(const uint8_t *message) {
|
||||
janet_panicv(janet_wrap_string(message));
|
||||
}
|
||||
|
||||
void janet_panic_type(Janet x, int32_t n, int expected) {
|
||||
janet_panicf("bad slot #%d, expected %T, got %v", n, expected, x);
|
||||
}
|
||||
|
||||
void janet_panic_abstract(Janet x, int32_t n, const JanetAbstractType *at) {
|
||||
janet_panicf("bad slot #%d, expected %s, got %v", n, at->name, x);
|
||||
}
|
||||
|
||||
void janet_fixarity(int32_t arity, int32_t fix) {
|
||||
if (arity != fix)
|
||||
janet_panicf("arity mismatch, expected %d, got %d", fix, arity);
|
||||
}
|
||||
|
||||
void janet_arity(int32_t arity, int32_t min, int32_t max) {
|
||||
if (min >= 0 && arity < min)
|
||||
janet_panicf("arity mismatch, expected at least %d, got %d", min, arity);
|
||||
if (max >= 0 && arity > max)
|
||||
janet_panicf("arity mismatch, expected at most %d, got %d", max, arity);
|
||||
}
|
||||
|
||||
#define DEFINE_GETTER(name, NAME, type) \
|
||||
type janet_get##name(const Janet *argv, int32_t n) { \
|
||||
Janet x = argv[n]; \
|
||||
if (!janet_checktype(x, JANET_##NAME)) { \
|
||||
janet_panic_type(x, n, JANET_TFLAG_##NAME); \
|
||||
} \
|
||||
return janet_unwrap_##name(x); \
|
||||
}
|
||||
|
||||
DEFINE_GETTER(number, NUMBER, double)
|
||||
DEFINE_GETTER(array, ARRAY, JanetArray *)
|
||||
DEFINE_GETTER(tuple, TUPLE, const Janet *)
|
||||
DEFINE_GETTER(table, TABLE, JanetTable *)
|
||||
DEFINE_GETTER(struct, STRUCT, const JanetKV *)
|
||||
DEFINE_GETTER(string, STRING, const uint8_t *)
|
||||
DEFINE_GETTER(keyword, KEYWORD, const uint8_t *)
|
||||
DEFINE_GETTER(symbol, SYMBOL, const uint8_t *)
|
||||
DEFINE_GETTER(buffer, BUFFER, JanetBuffer *)
|
||||
DEFINE_GETTER(fiber, FIBER, JanetFiber *)
|
||||
DEFINE_GETTER(function, FUNCTION, JanetFunction *)
|
||||
DEFINE_GETTER(cfunction, CFUNCTION, JanetCFunction)
|
||||
|
||||
int janet_getboolean(const Janet *argv, int32_t n) {
|
||||
Janet x = argv[n];
|
||||
if (janet_checktype(x, JANET_TRUE)) {
|
||||
return 1;
|
||||
} else if (!janet_checktype(x, JANET_FALSE)) {
|
||||
janet_panicf("bad slot #%d, expected boolean, got %v", n, x);
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
int32_t janet_getinteger(const Janet *argv, int32_t n) {
|
||||
Janet x = argv[n];
|
||||
if (!janet_checkint(x)) {
|
||||
janet_panicf("bad slot #%d, expected integer, got %v", n, x);
|
||||
}
|
||||
return janet_unwrap_integer(x);
|
||||
}
|
||||
|
||||
int64_t janet_getinteger64(const Janet *argv, int32_t n) {
|
||||
Janet x = argv[n];
|
||||
if (!janet_checkint64(x)) {
|
||||
janet_panicf("bad slot #%d, expected 64 bit integer, got %v", n, x);
|
||||
}
|
||||
return (int64_t) janet_unwrap_number(x);
|
||||
}
|
||||
|
||||
JanetView janet_getindexed(const Janet *argv, int32_t n) {
|
||||
Janet x = argv[n];
|
||||
JanetView view;
|
||||
if (!janet_indexed_view(x, &view.items, &view.len)) {
|
||||
janet_panic_type(x, n, JANET_TFLAG_INDEXED);
|
||||
}
|
||||
return view;
|
||||
}
|
||||
|
||||
JanetByteView janet_getbytes(const Janet *argv, int32_t n) {
|
||||
Janet x = argv[n];
|
||||
JanetByteView view;
|
||||
if (!janet_bytes_view(x, &view.bytes, &view.len)) {
|
||||
janet_panic_type(x, n, JANET_TFLAG_BYTES);
|
||||
}
|
||||
return view;
|
||||
}
|
||||
|
||||
JanetDictView janet_getdictionary(const Janet *argv, int32_t n) {
|
||||
Janet x = argv[n];
|
||||
JanetDictView view;
|
||||
if (!janet_dictionary_view(x, &view.kvs, &view.len, &view.cap)) {
|
||||
janet_panic_type(x, n, JANET_TFLAG_DICTIONARY);
|
||||
}
|
||||
return view;
|
||||
}
|
||||
|
||||
void *janet_getabstract(const Janet *argv, int32_t n, const JanetAbstractType *at) {
|
||||
Janet x = argv[n];
|
||||
if (!janet_checktype(x, JANET_ABSTRACT)) {
|
||||
janet_panic_abstract(x, n, at);
|
||||
}
|
||||
void *abstractx = janet_unwrap_abstract(x);
|
||||
if (janet_abstract_type(abstractx) != at) {
|
||||
janet_panic_abstract(x, n, at);
|
||||
}
|
||||
return abstractx;
|
||||
}
|
||||
|
||||
JanetRange janet_getslice(int32_t argc, const Janet *argv) {
|
||||
janet_arity(argc, 1, 3);
|
||||
JanetRange range;
|
||||
int32_t length = janet_length(argv[0]);
|
||||
if (argc == 1) {
|
||||
range.start = 0;
|
||||
range.end = length;
|
||||
} else if (argc == 2) {
|
||||
range.start = janet_getinteger(argv, 1);
|
||||
range.end = length;
|
||||
if (range.start < 0) {
|
||||
range.start += length + 1;
|
||||
}
|
||||
if (range.start < 0 || range.start > length) {
|
||||
janet_panicf("slice start: index %d out of range [0,%d]", range.start, length);
|
||||
}
|
||||
} else {
|
||||
range.start = janet_getinteger(argv, 1);
|
||||
range.end = janet_getinteger(argv, 2);
|
||||
if (range.start < 0) {
|
||||
range.start += length + 1;
|
||||
}
|
||||
if (range.end < 0) {
|
||||
range.end += length + 1;
|
||||
}
|
||||
if (range.start < 0 || range.start > length) {
|
||||
janet_panicf("slice start: index %d out of range [0,%d]", range.start, length);
|
||||
}
|
||||
if (range.end < 0 || range.end > length) {
|
||||
janet_panicf("slice end: index %d out of range [0,%d]", range.end, length);
|
||||
}
|
||||
if (range.end < range.start) {
|
||||
range.end = range.start;
|
||||
}
|
||||
}
|
||||
return range;
|
||||
}
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2017 Calvin Rose
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -46,14 +46,14 @@ static int fixarity3(JanetFopts opts, JanetSlot *args) {
|
||||
return janet_v_count(args) == 3;
|
||||
}
|
||||
|
||||
/* Generic hanldling for $A = op $B */
|
||||
/* Generic handling for $A = op $B */
|
||||
static JanetSlot genericSS(JanetFopts opts, int op, JanetSlot s) {
|
||||
JanetSlot target = janetc_gettarget(opts);
|
||||
janetc_emit_ss(opts.compiler, op, target, s, 1);
|
||||
return target;
|
||||
}
|
||||
|
||||
/* Generic hanldling for $A = $B op I */
|
||||
/* Generic handling for $A = $B op I */
|
||||
static JanetSlot genericSSI(JanetFopts opts, int op, JanetSlot s, int32_t imm) {
|
||||
JanetSlot target = janetc_gettarget(opts);
|
||||
janetc_emit_ssi(opts.compiler, op, target, s, imm, 1);
|
||||
@@ -136,7 +136,7 @@ static JanetSlot do_apply(JanetFopts opts, JanetSlot *args) {
|
||||
return target;
|
||||
}
|
||||
|
||||
/* Varidadic operators specialization */
|
||||
/* Variadic operators specialization */
|
||||
|
||||
static JanetSlot do_add(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_ADD, janet_wrap_integer(0));
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2018 Calvin Rose
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -24,6 +24,7 @@
|
||||
#include "compile.h"
|
||||
#include "emit.h"
|
||||
#include "vector.h"
|
||||
#include "util.h"
|
||||
|
||||
JanetFopts janetc_fopts_default(JanetCompiler *c) {
|
||||
JanetFopts ret;
|
||||
@@ -235,7 +236,7 @@ JanetSlot janetc_resolve(
|
||||
scope->flags |= JANET_SCOPE_ENV;
|
||||
scope = scope->child;
|
||||
|
||||
/* Propogate env up to current scope */
|
||||
/* Propagate env up to current scope */
|
||||
int32_t envindex = -1;
|
||||
while (scope) {
|
||||
if (scope->flags & JANET_SCOPE_FUNCTION) {
|
||||
@@ -480,7 +481,6 @@ static int macroexpand1(
|
||||
!janet_checktype(macroval, JANET_FUNCTION))
|
||||
return 0;
|
||||
|
||||
|
||||
/* Evaluate macro */
|
||||
JanetFiber *fiberp;
|
||||
JanetFunction *macro = janet_unwrap_function(macroval);
|
||||
@@ -553,7 +553,7 @@ JanetSlot janetc_value(JanetFopts opts, Janet x) {
|
||||
}
|
||||
break;
|
||||
case JANET_SYMBOL:
|
||||
ret = janetc_sym_rvalue(opts, janet_unwrap_symbol(x));
|
||||
ret = janetc_resolve(opts.compiler, janet_unwrap_symbol(x));
|
||||
break;
|
||||
case JANET_ARRAY:
|
||||
ret = janetc_array(opts, x);
|
||||
@@ -700,45 +700,39 @@ JanetCompileResult janet_compile(Janet source, JanetTable *env, const uint8_t *w
|
||||
}
|
||||
|
||||
/* C Function for compiling */
|
||||
static int cfun(JanetArgs args) {
|
||||
JanetCompileResult res;
|
||||
JanetTable *t;
|
||||
JanetTable *env;
|
||||
JANET_MINARITY(args, 2);
|
||||
JANET_MAXARITY(args, 3);
|
||||
JANET_ARG_TABLE(env, args, 1);
|
||||
static Janet cfun(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 3);
|
||||
JanetTable *env = janet_gettable(argv, 1);
|
||||
const uint8_t *source = NULL;
|
||||
if (args.n == 3) {
|
||||
JANET_ARG_STRING(source, args, 2);
|
||||
if (argc == 3) {
|
||||
source = janet_getstring(argv, 2);
|
||||
}
|
||||
res = janet_compile(args.v[0], env, source);
|
||||
JanetCompileResult res = janet_compile(argv[0], env, source);
|
||||
if (res.status == JANET_COMPILE_OK) {
|
||||
JANET_RETURN_FUNCTION(args, janet_thunk(res.funcdef));
|
||||
return janet_wrap_function(janet_thunk(res.funcdef));
|
||||
} else {
|
||||
t = janet_table(4);
|
||||
janet_table_put(t, janet_csymbolv(":error"), janet_wrap_string(res.error));
|
||||
janet_table_put(t, janet_csymbolv(":start"), janet_wrap_integer(res.error_mapping.start));
|
||||
janet_table_put(t, janet_csymbolv(":end"), janet_wrap_integer(res.error_mapping.end));
|
||||
JanetTable *t = janet_table(4);
|
||||
janet_table_put(t, janet_ckeywordv("error"), janet_wrap_string(res.error));
|
||||
janet_table_put(t, janet_ckeywordv("start"), janet_wrap_integer(res.error_mapping.start));
|
||||
janet_table_put(t, janet_ckeywordv("end"), janet_wrap_integer(res.error_mapping.end));
|
||||
if (res.macrofiber) {
|
||||
janet_table_put(t, janet_csymbolv(":fiber"), janet_wrap_fiber(res.macrofiber));
|
||||
janet_table_put(t, janet_ckeywordv("fiber"), janet_wrap_fiber(res.macrofiber));
|
||||
}
|
||||
JANET_RETURN_TABLE(args, t);
|
||||
return janet_wrap_table(t);
|
||||
}
|
||||
}
|
||||
|
||||
static const JanetReg cfuns[] = {
|
||||
{"compile", cfun,
|
||||
"(compile ast env [, source])\n\n"
|
||||
"Compiles an Abstract Sytnax Tree (ast) into a janet function. "
|
||||
"Pair the compile function with parsing functionality to implement "
|
||||
"eval. Returns a janet function and does not modify ast. Throws an "
|
||||
"error if the ast cannot be compiled."
|
||||
JDOC("(compile ast env [, source])\n\n"
|
||||
"Compiles an Abstract Syntax Tree (ast) into a janet function. "
|
||||
"Pair the compile function with parsing functionality to implement "
|
||||
"eval. Returns a janet function and does not modify ast. Throws an "
|
||||
"error if the ast cannot be compiled.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
int janet_lib_compile(JanetArgs args) {
|
||||
JanetTable *env = janet_env(args);
|
||||
void janet_lib_compile(JanetTable *env) {
|
||||
janet_cfuns(env, NULL, cfuns);
|
||||
return 0;
|
||||
}
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2017 Calvin Rose
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -240,10 +240,4 @@ JanetSlot janetc_cslot(Janet x);
|
||||
/* Search for a symbol */
|
||||
JanetSlot janetc_resolve(JanetCompiler *c, const uint8_t *sym);
|
||||
|
||||
/* Compile a symbol (or mutltisym) when used as an rvalue. */
|
||||
JanetSlot janetc_sym_rvalue(JanetFopts opts, const uint8_t *sym);
|
||||
|
||||
/* Compile an assignment to a symbol (or multisym) */
|
||||
JanetSlot janetc_sym_lvalue(JanetFopts opts, const uint8_t *sym, Janet value);
|
||||
|
||||
#endif
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
# The core janet library
|
||||
# Copyright 2018 (C) Calvin Rose
|
||||
# Copyright 2019 (C) Calvin Rose
|
||||
|
||||
###
|
||||
###
|
||||
@@ -29,14 +29,14 @@
|
||||
(array/push modifiers ith))
|
||||
(if (< i len) (recur (+ i 1)))))))
|
||||
(def start (fstart 0))
|
||||
(def args more.start)
|
||||
(def args (get more start))
|
||||
# Add function signature to docstring
|
||||
(var index 0)
|
||||
(def arglen (length args))
|
||||
(def buf (buffer "(" name))
|
||||
(while (< index arglen)
|
||||
(buffer/push-string buf " ")
|
||||
(string/pretty args.index 4 buf)
|
||||
(string/pretty (get args index) 4 buf)
|
||||
(set index (+ index 1)))
|
||||
(array/push modifiers (string buf ")\n\n" docstr))
|
||||
# Build return value
|
||||
@@ -87,8 +87,7 @@
|
||||
(defn fiber? "Check if x is a fiber." [x] (= (type x) :fiber))
|
||||
(defn string? "Check if x is a string." [x] (= (type x) :string))
|
||||
(defn symbol? "Check if x is a symbol." [x] (= (type x) :symbol))
|
||||
(defn keyword? "Check if x is a keyword style symbol." [x]
|
||||
(if (not= (type x) :symbol) nil (= 58 x.0)))
|
||||
(defn keyword? "Check if x is a keyword." [x] (= (type x) :keyword))
|
||||
(defn buffer? "Check if x is a buffer." [x] (= (type x) :buffer))
|
||||
(defn function? "Check if x is a function (not a cfunction)." [x]
|
||||
(= (type x) :function))
|
||||
@@ -100,7 +99,7 @@
|
||||
(defn boolean? "Check if x is a boolean." [x] (= (type x) :boolean))
|
||||
(defn bytes? "Check if x is a string, symbol, or buffer." [x]
|
||||
(def t (type x))
|
||||
(if (= t :string) true (if (= t :symbol) true (= t :buffer))))
|
||||
(if (= t :string) true (if (= t :symbol) true (if (= t :keyword) true (= t :buffer)))))
|
||||
(defn dictionary? "Check if x a table or struct." [x]
|
||||
(def t (type x))
|
||||
(if (= t :table) true (= t :struct)))
|
||||
@@ -165,7 +164,7 @@
|
||||
|
||||
(defmacro if-not
|
||||
"Shorthand for (if (not ... "
|
||||
[condition exp-1 exp-2]
|
||||
[condition exp-1 exp-2 &]
|
||||
~(if ,condition ,exp-2 ,exp-1))
|
||||
|
||||
(defmacro when
|
||||
@@ -187,8 +186,8 @@
|
||||
(defn aux [i]
|
||||
(def restlen (- (length pairs) i))
|
||||
(if (= restlen 0) nil
|
||||
(if (= restlen 1) pairs.i
|
||||
(tuple 'if pairs.i
|
||||
(if (= restlen 1) (get pairs i)
|
||||
(tuple 'if (get pairs i)
|
||||
(get pairs (+ i 1))
|
||||
(aux (+ i 2))))))
|
||||
(aux 0))
|
||||
@@ -203,8 +202,8 @@
|
||||
(defn aux [i]
|
||||
(def restlen (- (length pairs) i))
|
||||
(if (= restlen 0) nil
|
||||
(if (= restlen 1) pairs.i
|
||||
(tuple 'if (tuple = sym pairs.i)
|
||||
(if (= restlen 1) (get pairs i)
|
||||
(tuple 'if (tuple = sym (get pairs i))
|
||||
(get pairs (+ i 1))
|
||||
(aux (+ i 2))))))
|
||||
(if atm
|
||||
@@ -255,8 +254,8 @@
|
||||
(while (> i 0)
|
||||
(-- i)
|
||||
(set ret (if (= ret true)
|
||||
forms.i
|
||||
(tuple 'if forms.i ret))))
|
||||
(get forms i)
|
||||
(tuple 'if (get forms i) ret))))
|
||||
ret)
|
||||
|
||||
(defmacro or
|
||||
@@ -268,7 +267,7 @@
|
||||
(var i len)
|
||||
(while (> i 0)
|
||||
(-- i)
|
||||
(def fi forms.i)
|
||||
(def fi (get forms i))
|
||||
(set ret (if (idempotent? fi)
|
||||
(tuple 'if fi fi ret)
|
||||
(do
|
||||
@@ -290,6 +289,7 @@
|
||||
\t:range - loop over a range. The object should be two element tuple with a start
|
||||
and end value. The range is half open, [start, end).\n
|
||||
\t:keys - Iterate over the keys in a data structure.\n
|
||||
\t:pairs - Iterate over the keys value pairs in a data structure.\n
|
||||
\t:in - Iterate over the values in an indexed data structure or byte sequence.\n
|
||||
\t:generate - Iterate over values yielded from a fiber. Can be paired with the generator
|
||||
function for the producer/consumer pattern.\n\n
|
||||
@@ -376,6 +376,22 @@
|
||||
(tuple 'def bindings $iter)
|
||||
subloop
|
||||
(tuple 'set $iter (tuple next $dict $iter)))))
|
||||
:pairs (do
|
||||
(def sym? (symbol? bindings))
|
||||
(def $dict (gensym))
|
||||
(def $iter (gensym))
|
||||
(def preds @['and (tuple not= nil $iter)])
|
||||
(def subloop (doone (+ i 3) preds))
|
||||
(tuple 'do
|
||||
(tuple 'def $dict object)
|
||||
(tuple 'var $iter (tuple next $dict nil))
|
||||
(tuple 'while (tuple/slice preds)
|
||||
(if sym?
|
||||
(tuple 'def bindings (tuple tuple $iter (tuple get $dict $iter))))
|
||||
(if-not sym? (tuple 'def (get bindings 0) $iter))
|
||||
(if-not sym? (tuple 'def (get bindings 1) (tuple get $dict $iter)))
|
||||
subloop
|
||||
(tuple 'set $iter (tuple next $dict $iter)))))
|
||||
:in (do
|
||||
(def $len (gensym))
|
||||
(def $i (gensym))
|
||||
@@ -453,7 +469,7 @@
|
||||
accum)
|
||||
|
||||
(defmacro if-let
|
||||
"Make mutliple bindings, anf if all are truthy,
|
||||
"Make multiple bindings, and if all are truthy,
|
||||
evaluate the tru form. If any are false or nil, evaluate
|
||||
the fal form. Bindings have the same syntax as the let macro."
|
||||
[bindings tru fal &]
|
||||
@@ -461,7 +477,7 @@
|
||||
(if (zero? len) (error "expected at least 1 binding"))
|
||||
(if (odd? len) (error "expected an even number of bindings"))
|
||||
(defn aux [i]
|
||||
(def bl bindings.i)
|
||||
(def bl (get bindings i))
|
||||
(def br (get bindings (+ 1 i)))
|
||||
(if (>= i len)
|
||||
tru
|
||||
@@ -494,7 +510,7 @@
|
||||
[& functions]
|
||||
(case (length functions)
|
||||
0 nil
|
||||
1 functions.0
|
||||
1 (get functions 0)
|
||||
2 (let [[f g] functions] (fn [x] (f (g x))))
|
||||
3 (let [[f g h] functions] (fn [x] (f (g (h x)))))
|
||||
4 (let [[f g h i] functions] (fn [x] (f (g (h (i x))))))
|
||||
@@ -519,9 +535,9 @@
|
||||
[order args]
|
||||
(def len (length args))
|
||||
(when (pos? len)
|
||||
(var ret args.0)
|
||||
(var [ret] args)
|
||||
(loop [i :range [0 len]]
|
||||
(def v args.i)
|
||||
(def v (get args i))
|
||||
(if (order v ret) (set ret v)))
|
||||
ret))
|
||||
|
||||
@@ -546,7 +562,7 @@
|
||||
(defn first
|
||||
"Get the first element from an indexed data structure."
|
||||
[xs]
|
||||
xs.0)
|
||||
(get xs 0))
|
||||
|
||||
(defn last
|
||||
"Get the last element from an indexed data structure."
|
||||
@@ -560,22 +576,22 @@
|
||||
###
|
||||
|
||||
(def sort
|
||||
"(sort xs [, by])\n\nSort an array in-place. Uses quicksort and is not a stable sort."
|
||||
"(sort xs [, by])\n\nSort an array in-place. Uses quick-sort and is not a stable sort."
|
||||
(do
|
||||
|
||||
(defn partition
|
||||
[a lo hi by]
|
||||
(def pivot a.hi)
|
||||
(def pivot (get a hi))
|
||||
(var i lo)
|
||||
(loop [j :range [lo hi]]
|
||||
(def aj a.j)
|
||||
(def aj (get a j))
|
||||
(when (by aj pivot)
|
||||
(def ai a.i)
|
||||
(set a.i aj)
|
||||
(set a.j ai)
|
||||
(def ai (get a i))
|
||||
(set (a i) aj)
|
||||
(set (a j) ai)
|
||||
(++ i)))
|
||||
(set a.hi a.i)
|
||||
(set a.i pivot)
|
||||
(set (a hi) (get a i))
|
||||
(set (a i) pivot)
|
||||
i)
|
||||
|
||||
(defn sort-help
|
||||
@@ -609,21 +625,21 @@
|
||||
[f & inds]
|
||||
(def ninds (length inds))
|
||||
(if (= 0 ninds) (error "expected at least 1 indexed collection"))
|
||||
(var limit (length inds.0))
|
||||
(var limit (length (get inds 0)))
|
||||
(loop [i :range [0 ninds]]
|
||||
(def l (length inds.i))
|
||||
(def l (length (get inds i)))
|
||||
(if (< l limit) (set limit l)))
|
||||
(def [i1 i2 i3 i4] inds)
|
||||
(def res (array/new limit))
|
||||
(case ninds
|
||||
1 (loop [i :range [0 limit]] (set res.i (f i1.i)))
|
||||
2 (loop [i :range [0 limit]] (set res.i (f i1.i i2.i)))
|
||||
3 (loop [i :range [0 limit]] (set res.i (f i1.i i2.i i3.i)))
|
||||
4 (loop [i :range [0 limit]] (set res.i (f i1.i i2.i i3.i i4.i)))
|
||||
1 (loop [i :range [0 limit]] (set (res i) (f (get i1 i))))
|
||||
2 (loop [i :range [0 limit]] (set (res i) (f (get i1 i) (get i2 i))))
|
||||
3 (loop [i :range [0 limit]] (set (res i) (f (get i1 i) (get i2 i) (get i3 i))))
|
||||
4 (loop [i :range [0 limit]] (set (res i) (f (get i1 i) (get i2 i) (get i3 i) (get i4 i))))
|
||||
(loop [i :range [0 limit]]
|
||||
(def args (array/new ninds))
|
||||
(loop [j :range [0 ninds]] (set args.j inds.j.i))
|
||||
(set res.i (f ;args))))
|
||||
(loop [j :range [0 ninds]] (set (args j) (get (get inds j) i)))
|
||||
(set (res i) (f ;args))))
|
||||
res)
|
||||
|
||||
(defn mapcat
|
||||
@@ -635,6 +651,11 @@
|
||||
(array/concat res (f x)))
|
||||
res)
|
||||
|
||||
(defmacro with-syms
|
||||
"Evaluates body with each symbol in syms bound to a generated, unique symbol."
|
||||
[syms & body]
|
||||
~(let ,(mapcat (fn [s] @[s (tuple gensym)]) syms) ,;body))
|
||||
|
||||
(defn filter
|
||||
"Given a predicate, take only elements from an array or tuple for
|
||||
which (pred element) is truthy. Returns a new array."
|
||||
@@ -695,7 +716,7 @@
|
||||
(var i 0)
|
||||
(var going true)
|
||||
(while (if (< i len) going)
|
||||
(def item ind.i)
|
||||
(def item (get ind i))
|
||||
(if (pred item) (set going false) (++ i)))
|
||||
(if going nil i))
|
||||
|
||||
@@ -758,7 +779,7 @@
|
||||
[x & forms]
|
||||
(defn fop [last n]
|
||||
(def [h t] (if (= :tuple (type n))
|
||||
[tuple n.0 (array/slice n 1)]
|
||||
[tuple (get n 0) (array/slice n 1)]
|
||||
[tuple n @[]]))
|
||||
(def parts (array/concat @[h last] t))
|
||||
(tuple/slice parts 0))
|
||||
@@ -771,7 +792,7 @@
|
||||
[x & forms]
|
||||
(defn fop [last n]
|
||||
(def [h t] (if (= :tuple (type n))
|
||||
[tuple n.0 (array/slice n 1)]
|
||||
[tuple (get n 0) (array/slice n 1)]
|
||||
[tuple n @[]]))
|
||||
(def parts (array/concat @[h] t @[last]))
|
||||
(tuple/slice parts 0))
|
||||
@@ -786,7 +807,7 @@
|
||||
[x & forms]
|
||||
(defn fop [last n]
|
||||
(def [h t] (if (= :tuple (type n))
|
||||
[tuple n.0 (array/slice n 1)]
|
||||
[tuple (get n 0) (array/slice n 1)]
|
||||
[tuple n @[]]))
|
||||
(def sym (gensym))
|
||||
(def parts (array/concat @[h sym] t))
|
||||
@@ -802,45 +823,51 @@
|
||||
[x & forms]
|
||||
(defn fop [last n]
|
||||
(def [h t] (if (= :tuple (type n))
|
||||
[tuple n.0 (array/slice n 1)]
|
||||
[tuple (get n 0) (array/slice n 1)]
|
||||
[tuple n @[]]))
|
||||
(def sym (gensym))
|
||||
(def parts (array/concat @[h] t @[sym]))
|
||||
~(let [,sym ,last] (if ,sym ,(tuple/slice parts 0))))
|
||||
(reduce fop x forms))
|
||||
|
||||
(defn walk-ind [f form]
|
||||
(def len (length form))
|
||||
(def ret (array/new len))
|
||||
(each x form (array/push ret (f x)))
|
||||
ret)
|
||||
|
||||
(defn walk-dict [f form]
|
||||
(def ret @{})
|
||||
(loop [k :keys form]
|
||||
(put ret (f k) (f (get form k))))
|
||||
ret)
|
||||
|
||||
(defn walk
|
||||
"Iterate over the values in ast and apply f
|
||||
to them. Collect the results in a data structure . If ast is not a
|
||||
table, struct, array, or tuple,
|
||||
behaves as the identity function."
|
||||
returns form."
|
||||
[f form]
|
||||
(defn walk-ind []
|
||||
(def ret @[])
|
||||
(each x form (array/push ret (f x)))
|
||||
ret)
|
||||
(defn walk-dict []
|
||||
(def ret @[])
|
||||
(loop [k :keys form]
|
||||
(array/push ret (f k) (f form.k)))
|
||||
ret)
|
||||
(case (type form)
|
||||
:table (table ;(walk-dict))
|
||||
:struct (struct ;(walk-dict))
|
||||
:array (walk-ind)
|
||||
:tuple (tuple ;(walk-ind))
|
||||
:table (walk-dict f form)
|
||||
:struct (table/to-struct (walk-dict f form))
|
||||
:array (walk-ind f form)
|
||||
:tuple (tuple/slice (walk-ind f form))
|
||||
form))
|
||||
|
||||
(defn post-walk
|
||||
"Do a post-order traversal of a data sructure and call (f x)
|
||||
(put _env 'walk-ind nil)
|
||||
(put _env 'walk-dict nil)
|
||||
|
||||
(defn postwalk
|
||||
"Do a post-order traversal of a data structure and call (f x)
|
||||
on every visitation."
|
||||
[f form]
|
||||
(f (walk (fn [x] (post-walk f x)) form)))
|
||||
(f (walk (fn [x] (postwalk f x)) form)))
|
||||
|
||||
(defn pre-walk
|
||||
"Similar to post-walk, but do pre-order traversal."
|
||||
(defn prewalk
|
||||
"Similar to postwalk, but do pre-order traversal."
|
||||
[f form]
|
||||
(walk (fn [x] (pre-walk f x)) (f form)))
|
||||
(walk (fn [x] (prewalk f x)) (f form)))
|
||||
|
||||
(defmacro as->
|
||||
"Thread forms together, replacing as in forms with the value
|
||||
@@ -850,7 +877,7 @@
|
||||
(var prev x)
|
||||
(loop [form :in forms]
|
||||
(def sym (gensym))
|
||||
(def next-prev (post-walk (fn [y] (if (= y as) sym y)) form))
|
||||
(def next-prev (postwalk (fn [y] (if (= y as) sym y)) form))
|
||||
(set prev ~(let [,sym ,prev] ,next-prev)))
|
||||
prev)
|
||||
|
||||
@@ -863,7 +890,7 @@
|
||||
(var prev x)
|
||||
(loop [form :in forms]
|
||||
(def sym (gensym))
|
||||
(def next-prev (post-walk (fn [y] (if (= y as) sym y)) form))
|
||||
(def next-prev (postwalk (fn [y] (if (= y as) sym y)) form))
|
||||
(set prev ~(if-let [,sym ,prev] ,next-prev)))
|
||||
prev)
|
||||
|
||||
@@ -889,7 +916,7 @@
|
||||
(var n (dec len))
|
||||
(def reversed (array/new len))
|
||||
(while (>= n 0)
|
||||
(array/push reversed t.n)
|
||||
(array/push reversed (get t n))
|
||||
(-- n))
|
||||
reversed)
|
||||
|
||||
@@ -900,7 +927,7 @@ value, one key will be ignored."
|
||||
[ds]
|
||||
(def ret @{})
|
||||
(loop [k :keys ds]
|
||||
(put ret ds.k k))
|
||||
(put ret (get ds k) k))
|
||||
ret)
|
||||
|
||||
(defn zipcoll
|
||||
@@ -912,15 +939,15 @@ value, one key will be ignored."
|
||||
(def lv (length vals))
|
||||
(def len (if (< lk lv) lk lv))
|
||||
(loop [i :range [0 len]]
|
||||
(put res keys.i vals.i))
|
||||
(put res (get keys i) (get vals i)))
|
||||
res)
|
||||
|
||||
(defn update
|
||||
"Accepts a key argument and passes its' associated value to a function.
|
||||
The key then, is associated to the function's return value"
|
||||
[coll a-key a-function & args]
|
||||
(def old-value coll.a-key)
|
||||
(set coll.a-key (a-function old-value ;args)))
|
||||
[ds key func & args]
|
||||
(def old (get ds key))
|
||||
(set (ds key) (func old ;args)))
|
||||
|
||||
(defn merge-into
|
||||
"Merges multiple tables/structs into a table. If a key appears in more than one
|
||||
@@ -929,7 +956,7 @@ value, one key will be ignored."
|
||||
[tab & colls]
|
||||
(loop [c :in colls
|
||||
key :keys c]
|
||||
(set tab.key c.key))
|
||||
(set (tab key) (get c key)))
|
||||
tab)
|
||||
|
||||
(defn merge
|
||||
@@ -940,7 +967,7 @@ value, one key will be ignored."
|
||||
(def container @{})
|
||||
(loop [c :in colls
|
||||
key :keys c]
|
||||
(set container.key c.key))
|
||||
(set (container key) (get c key)))
|
||||
container)
|
||||
|
||||
(defn keys
|
||||
@@ -959,7 +986,7 @@ value, one key will be ignored."
|
||||
(def arr (array/new (length x)))
|
||||
(var k (next x nil))
|
||||
(while (not= nil k)
|
||||
(array/push arr x.k)
|
||||
(array/push arr (get x k))
|
||||
(set k (next x k)))
|
||||
arr)
|
||||
|
||||
@@ -969,7 +996,7 @@ value, one key will be ignored."
|
||||
(def arr (array/new (length x)))
|
||||
(var k (next x nil))
|
||||
(while (not= nil k)
|
||||
(array/push arr (tuple k x.k))
|
||||
(array/push arr (tuple k (get x k)))
|
||||
(set k (next x k)))
|
||||
arr)
|
||||
|
||||
@@ -979,8 +1006,8 @@ value, one key will be ignored."
|
||||
(def freqs @{})
|
||||
(loop
|
||||
[x :in ind]
|
||||
(def n freqs.x)
|
||||
(set freqs.x (if n (+ 1 n) 1)))
|
||||
(def n (get freqs x))
|
||||
(set (freqs x) (if n (+ 1 n) 1)))
|
||||
freqs)
|
||||
|
||||
(defn interleave
|
||||
@@ -993,15 +1020,15 @@ value, one key will be ignored."
|
||||
(def len (min ;(map length cols)))
|
||||
(loop [i :range [0 len]
|
||||
ci :range [0 ncol]]
|
||||
(array/push res cols.ci.i)))
|
||||
(array/push res (get (get cols ci) i))))
|
||||
res)
|
||||
|
||||
(defn distinct
|
||||
"Returns an array of the the deduplicated values in xs."
|
||||
"Returns an array of the deduplicated values in xs."
|
||||
[xs]
|
||||
(def ret @[])
|
||||
(def seen @{})
|
||||
(loop [x :in xs] (if seen.x nil (do (set seen.x true) (array/push ret x))))
|
||||
(loop [x :in xs] (if (get seen x) nil (do (put seen x true) (array/push ret x))))
|
||||
ret)
|
||||
|
||||
(defn flatten-into
|
||||
@@ -1025,7 +1052,7 @@ value, one key will be ignored."
|
||||
like @[k v k v ...]. Returns a new array."
|
||||
[dict]
|
||||
(def ret (array/new (* 2 (length dict))))
|
||||
(loop [k :keys dict] (array/push ret k dict.k))
|
||||
(loop [k :keys dict] (array/push ret k (get dict k)))
|
||||
ret)
|
||||
|
||||
(defn interpose
|
||||
@@ -1034,10 +1061,10 @@ value, one key will be ignored."
|
||||
[sep ind]
|
||||
(def len (length ind))
|
||||
(def ret (array/new (- (* 2 len) 1)))
|
||||
(if (> len 0) (set ret.0 ind.0))
|
||||
(if (> len 0) (put ret 0 (get ind 0)))
|
||||
(var i 1)
|
||||
(while (< i len)
|
||||
(array/push ret sep ind.i)
|
||||
(array/push ret sep (get ind i))
|
||||
(++ i))
|
||||
ret)
|
||||
|
||||
@@ -1062,8 +1089,10 @@ value, one key will be ignored."
|
||||
~(if (= nil (def ,pattern ,expr)) ,sentinel ,(onmatch))))
|
||||
|
||||
(tuple? pattern)
|
||||
(match-1 pattern.0 expr (fn []
|
||||
~(if (and ,;(tuple/slice pattern 1)) ,(onmatch) ,sentinel)) seen)
|
||||
(match-1
|
||||
(get pattern 0) expr
|
||||
(fn []
|
||||
~(if (and ,;(tuple/slice pattern 1)) ,(onmatch) ,sentinel)) seen)
|
||||
|
||||
(array? pattern)
|
||||
(do
|
||||
@@ -1076,7 +1105,7 @@ value, one key will be ignored."
|
||||
(++ i)
|
||||
(if (= i len)
|
||||
(onmatch)
|
||||
(match-1 pattern.i (tuple get $arr i) aux seen))))
|
||||
(match-1 (get pattern i) (tuple get $arr i) aux seen))))
|
||||
,sentinel)))
|
||||
|
||||
(dictionary? pattern)
|
||||
@@ -1113,7 +1142,7 @@ value, one key will be ignored."
|
||||
(= i len-1) (get cases i)
|
||||
(< i len-1) (do
|
||||
(def $res (gensym))
|
||||
~(if (= ,sentinel (def ,$res ,(match-1 cases.i $x (fn [] (get cases (inc i))) @{})))
|
||||
~(if (= ,sentinel (def ,$res ,(match-1 (get cases i) $x (fn [] (get cases (inc i))) @{})))
|
||||
,(aux (+ 2 i))
|
||||
,$res)))) 0)))
|
||||
|
||||
@@ -1171,20 +1200,23 @@ value, one key will be ignored."
|
||||
(defn doc*
|
||||
"Get the documentation for a symbol in a given environment."
|
||||
[env sym]
|
||||
(def x env.sym)
|
||||
(def x (get env sym))
|
||||
(if (not x)
|
||||
(print "symbol " sym " not found.")
|
||||
(do
|
||||
(def bind-type
|
||||
(string " "
|
||||
(cond
|
||||
x:ref (string :var " (" (type (get x:ref 0)) ")")
|
||||
x:macro :macro
|
||||
(type x:value))
|
||||
(x :ref) (string :var " (" (type (get (x :ref) 0)) ")")
|
||||
(x :macro) :macro
|
||||
(type (x :value)))
|
||||
"\n"))
|
||||
(def d x:doc)
|
||||
(def sm (x :source-map))
|
||||
(def d (x :doc))
|
||||
(print "\n\n"
|
||||
(if d bind-type "")
|
||||
(if-let [[path start end] sm] (string " " path " (" start ":" end ")\n") "")
|
||||
(if (or d sm) "\n" "")
|
||||
(if d (doc-format d) "no documentation found.")
|
||||
"\n\n"))))
|
||||
|
||||
@@ -1207,7 +1239,7 @@ value, one key will be ignored."
|
||||
(def newt @{})
|
||||
(var key (next t nil))
|
||||
(while (not= nil key)
|
||||
(put newt (macex1 key) (on-value t.key))
|
||||
(put newt (macex1 key) (on-value (get t key)))
|
||||
(set key (next t key)))
|
||||
newt)
|
||||
|
||||
@@ -1221,39 +1253,40 @@ value, one key will be ignored."
|
||||
|
||||
(defn expanddef [t]
|
||||
(def last (get t (- (length t) 1)))
|
||||
(def bound t.1)
|
||||
(def bound (get t 1))
|
||||
(tuple/slice
|
||||
(array/concat
|
||||
@[t.0 (expand-bindings bound)]
|
||||
@[(get t 0) (expand-bindings bound)]
|
||||
(tuple/slice t 2 -2)
|
||||
@[(macex1 last)])))
|
||||
|
||||
(defn expandall [t]
|
||||
(def args (map macex1 (tuple/slice t 1)))
|
||||
(tuple t.0 ;args))
|
||||
(tuple (get t 0) ;args))
|
||||
|
||||
(defn expandfn [t]
|
||||
(if (symbol? t.1)
|
||||
(def t1 (get t 1))
|
||||
(if (symbol? t1)
|
||||
(do
|
||||
(def args (map macex1 (tuple/slice t 3)))
|
||||
(tuple 'fn t.1 t.2 ;args))
|
||||
(tuple 'fn t1 (get t 2) ;args))
|
||||
(do
|
||||
(def args (map macex1 (tuple/slice t 2)))
|
||||
(tuple 'fn t.1 ;args))))
|
||||
(tuple 'fn t1 ;args))))
|
||||
|
||||
(defn expandqq [t]
|
||||
(defn qq [x]
|
||||
(case (type x)
|
||||
:tuple (do
|
||||
(def x0 x.0)
|
||||
(def x0 (get x 0))
|
||||
(if (or (= 'unquote x0) (= 'unquote-splicing x0))
|
||||
(tuple x0 (macex1 x.1))
|
||||
(tuple x0 (macex1 (get x 1)))
|
||||
(tuple/slice (map qq x))))
|
||||
:array (map qq x)
|
||||
:table (table (map qq (kvs x)))
|
||||
:struct (struct (map qq (kvs x)))
|
||||
x))
|
||||
(tuple t.0 (qq t.1)))
|
||||
(tuple (get t 0) (qq (get t 1))))
|
||||
|
||||
(def specs
|
||||
{'set expanddef
|
||||
@@ -1267,11 +1300,11 @@ value, one key will be ignored."
|
||||
'while expandall})
|
||||
|
||||
(defn dotup [t]
|
||||
(def h t.0)
|
||||
(def s specs.h)
|
||||
(def entry (or *env*.h {}))
|
||||
(def m entry:value)
|
||||
(def m? entry:macro)
|
||||
(def h (get t 0))
|
||||
(def s (get specs h))
|
||||
(def entry (or (get *env* h) {}))
|
||||
(def m (entry :value))
|
||||
(def m? (entry :macro))
|
||||
(cond
|
||||
s (s t)
|
||||
m? (m ;(tuple/slice t 1))
|
||||
@@ -1407,9 +1440,9 @@ value, one key will be ignored."
|
||||
(if (= len 0) (set going false))
|
||||
(while (> len pindex)
|
||||
(+= pindex (parser/consume p buf pindex))
|
||||
(while (= (set pstatus (parser/status p)) :full)
|
||||
(while (parser/has-more p)
|
||||
(eval1 (parser/produce p)))
|
||||
(when (= pstatus :error)
|
||||
(when (= (parser/status p) :error)
|
||||
(onstatus :parse
|
||||
(string (parser/error p)
|
||||
" around byte " (parser/where p))
|
||||
@@ -1421,7 +1454,7 @@ value, one key will be ignored."
|
||||
env)
|
||||
|
||||
(defn status-pp
|
||||
"Pretty print a signal and asscoaited state. Can be used as the
|
||||
"Pretty print a signal and associated state. Can be used as the
|
||||
onsignal argument to run-context."
|
||||
[sig x f source]
|
||||
(def title
|
||||
@@ -1494,7 +1527,7 @@ value, one key will be ignored."
|
||||
(def res (compile form *env* "eval"))
|
||||
(if (= (type res) :function)
|
||||
(res)
|
||||
(error res:error)))
|
||||
(error (res :error))))
|
||||
|
||||
(do
|
||||
(def syspath (or (os/getenv "JANET_PATH") "/usr/local/lib/janet/"))
|
||||
@@ -1538,7 +1571,7 @@ value, one key will be ignored."
|
||||
path))
|
||||
|
||||
(def require
|
||||
"(require module)\n\n
|
||||
"(require module & args)\n\n
|
||||
Require a module with the given name. Will search all of the paths in
|
||||
module/paths, then the path as a raw file path. Returns the new environment
|
||||
returned from compiling and running the file."
|
||||
@@ -1566,56 +1599,47 @@ value, one key will be ignored."
|
||||
|
||||
(def cache @{})
|
||||
(def loading @{})
|
||||
(fn require [path args &]
|
||||
(when loading.path
|
||||
(fn require [path & args]
|
||||
(when (get loading path)
|
||||
(error (string "circular dependency: module " path " is loading")))
|
||||
(def {:exit exit-on-error} (or args {}))
|
||||
(def check cache.path)
|
||||
(if check
|
||||
(def {:exit exit-on-error} (table ;args))
|
||||
(if-let [check (get cache path)]
|
||||
check
|
||||
(do
|
||||
(def newenv (make-env))
|
||||
(set cache.path newenv)
|
||||
(set loading.path true)
|
||||
(def f (find-mod path))
|
||||
(if f
|
||||
(do
|
||||
# Normal janet module
|
||||
(defn chunks [buf _] (file/read f 1024 buf))
|
||||
(run-context newenv chunks
|
||||
(fn [sig x f source]
|
||||
(when (not= sig :dead)
|
||||
(status-pp sig x f source)
|
||||
(if exit-on-error (os/exit 1))))
|
||||
path)
|
||||
(file/close f))
|
||||
(do
|
||||
# Try native module
|
||||
(def n (find-native path))
|
||||
(if (not n)
|
||||
(error (string "could not open file for module " path)))
|
||||
((native n) newenv)))
|
||||
(set loading.path false)
|
||||
newenv)))))
|
||||
(if-let [f (find-mod path)]
|
||||
(do
|
||||
# Normal janet module
|
||||
(def newenv (make-env))
|
||||
(put cache path newenv)
|
||||
(put loading path true)
|
||||
(defn chunks [buf _] (file/read f 1024 buf))
|
||||
(run-context newenv chunks
|
||||
(fn [sig x f source]
|
||||
(when (not= sig :dead)
|
||||
(status-pp sig x f source)
|
||||
(if exit-on-error (os/exit 1))))
|
||||
path)
|
||||
(file/close f)
|
||||
(put loading path false)
|
||||
newenv)
|
||||
(do
|
||||
# Try native module
|
||||
(def n (find-native path))
|
||||
(if (not n)
|
||||
(error (string "could not open file for module " path)))
|
||||
(native n (make-env))))))))
|
||||
|
||||
(defn import*
|
||||
"Import a module into a given environment table. This is the
|
||||
functional form of (import ...) that expects and explicit environment
|
||||
table."
|
||||
[env path & args]
|
||||
(def targs (table ;args))
|
||||
(def {:as as
|
||||
:prefix prefix} targs)
|
||||
(def newenv (require path targs))
|
||||
(var k (next newenv nil))
|
||||
(def {:meta meta} newenv)
|
||||
:prefix prefix} (table ;args))
|
||||
(def newenv (require path ;args))
|
||||
(def prefix (or (and as (string as "/")) prefix (string path "/")))
|
||||
(while k
|
||||
(def v newenv.k)
|
||||
(when (not v:private)
|
||||
(def newv (table/setproto @{:private true} v))
|
||||
(put env (symbol prefix k) newv))
|
||||
(set k (next newenv k))))
|
||||
(loop [[k v] :pairs newenv :when (not (v :private))]
|
||||
(def newv (table/setproto @{:private true} v))
|
||||
(put env (symbol prefix k) newv)))
|
||||
|
||||
(defmacro import
|
||||
"Import a module. First requires the module, and then merges its
|
||||
@@ -1656,5 +1680,5 @@ value, one key will be ignored."
|
||||
(def symbol-set @{})
|
||||
(loop [envi :in envs
|
||||
k :keys envi]
|
||||
(set symbol-set.k true))
|
||||
(put symbol-set k true))
|
||||
(sort (keys symbol-set)))
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2018 Calvin Rose
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -50,14 +50,14 @@ typedef void *Clib;
|
||||
#define error_clib() dlerror()
|
||||
#endif
|
||||
|
||||
JanetCFunction janet_native(const char *name, const uint8_t **error) {
|
||||
JanetModule janet_native(const char *name, const uint8_t **error) {
|
||||
Clib lib = load_clib(name);
|
||||
JanetCFunction init;
|
||||
JanetModule init;
|
||||
if (!lib) {
|
||||
*error = janet_cstring(error_clib());
|
||||
return NULL;
|
||||
}
|
||||
init = (JanetCFunction) symbol_clib(lib, "_janet_init");
|
||||
init = (JanetModule) symbol_clib(lib, "_janet_init");
|
||||
if (!init) {
|
||||
*error = janet_cstring("could not find _janet_init symbol");
|
||||
return NULL;
|
||||
@@ -65,332 +65,324 @@ JanetCFunction janet_native(const char *name, const uint8_t **error) {
|
||||
return init;
|
||||
}
|
||||
|
||||
static int janet_core_native(JanetArgs args) {
|
||||
JanetCFunction init;
|
||||
static Janet janet_core_native(int32_t argc, Janet *argv) {
|
||||
JanetModule init;
|
||||
janet_arity(argc, 1, 2);
|
||||
const uint8_t *path = janet_getstring(argv, 0);
|
||||
const uint8_t *error = NULL;
|
||||
const uint8_t *path = NULL;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_ARG_STRING(path, args, 0);
|
||||
JanetTable *env;
|
||||
if (argc == 2) {
|
||||
env = janet_gettable(argv, 1);
|
||||
} else {
|
||||
env = janet_table(0);
|
||||
}
|
||||
init = janet_native((const char *)path, &error);
|
||||
if (!init) {
|
||||
JANET_THROWV(args, janet_wrap_string(error));
|
||||
janet_panicf("could not load native %S: %S", path, error);
|
||||
}
|
||||
JANET_RETURN_CFUNCTION(args, init);
|
||||
init(env);
|
||||
return janet_wrap_table(env);
|
||||
}
|
||||
|
||||
static int janet_core_print(JanetArgs args) {
|
||||
int32_t i;
|
||||
for (i = 0; i < args.n; ++i) {
|
||||
static Janet janet_core_print(int32_t argc, Janet *argv) {
|
||||
for (int32_t i = 0; i < argc; ++i) {
|
||||
int32_t j, len;
|
||||
const uint8_t *vstr = janet_to_string(args.v[i]);
|
||||
const uint8_t *vstr = janet_to_string(argv[i]);
|
||||
len = janet_string_length(vstr);
|
||||
for (j = 0; j < len; ++j) {
|
||||
putc(vstr[j], stdout);
|
||||
}
|
||||
}
|
||||
putc('\n', stdout);
|
||||
JANET_RETURN_NIL(args);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static int janet_core_describe(JanetArgs args) {
|
||||
int32_t i;
|
||||
static Janet janet_core_describe(int32_t argc, Janet *argv) {
|
||||
JanetBuffer b;
|
||||
janet_buffer_init(&b, 0);
|
||||
for (i = 0; i < args.n; ++i) {
|
||||
int32_t len;
|
||||
const uint8_t *str = janet_description(args.v[i]);
|
||||
len = janet_string_length(str);
|
||||
janet_buffer_push_bytes(&b, str, len);
|
||||
}
|
||||
*args.ret = janet_stringv(b.data, b.count);
|
||||
for (int32_t i = 0; i < argc; ++i)
|
||||
janet_description_b(&b, argv[i]);
|
||||
Janet ret = janet_stringv(b.data, b.count);
|
||||
janet_buffer_deinit(&b);
|
||||
return 0;
|
||||
return ret;
|
||||
}
|
||||
|
||||
static int janet_core_string(JanetArgs args) {
|
||||
int32_t i;
|
||||
static Janet janet_core_string(int32_t argc, Janet *argv) {
|
||||
JanetBuffer b;
|
||||
janet_buffer_init(&b, 0);
|
||||
for (i = 0; i < args.n; ++i) {
|
||||
int32_t len;
|
||||
const uint8_t *str = janet_to_string(args.v[i]);
|
||||
len = janet_string_length(str);
|
||||
janet_buffer_push_bytes(&b, str, len);
|
||||
}
|
||||
*args.ret = janet_stringv(b.data, b.count);
|
||||
for (int32_t i = 0; i < argc; ++i)
|
||||
janet_to_string_b(&b, argv[i]);
|
||||
Janet ret = janet_stringv(b.data, b.count);
|
||||
janet_buffer_deinit(&b);
|
||||
return 0;
|
||||
return ret;
|
||||
}
|
||||
|
||||
static int janet_core_symbol(JanetArgs args) {
|
||||
int32_t i;
|
||||
static Janet janet_core_symbol(int32_t argc, Janet *argv) {
|
||||
JanetBuffer b;
|
||||
janet_buffer_init(&b, 0);
|
||||
for (i = 0; i < args.n; ++i) {
|
||||
int32_t len;
|
||||
const uint8_t *str = janet_to_string(args.v[i]);
|
||||
len = janet_string_length(str);
|
||||
janet_buffer_push_bytes(&b, str, len);
|
||||
}
|
||||
*args.ret = janet_symbolv(b.data, b.count);
|
||||
for (int32_t i = 0; i < argc; ++i)
|
||||
janet_to_string_b(&b, argv[i]);
|
||||
Janet ret = janet_symbolv(b.data, b.count);
|
||||
janet_buffer_deinit(&b);
|
||||
return 0;
|
||||
return ret;
|
||||
}
|
||||
|
||||
static int janet_core_buffer(JanetArgs args) {
|
||||
int32_t i;
|
||||
static Janet janet_core_keyword(int32_t argc, Janet *argv) {
|
||||
JanetBuffer b;
|
||||
janet_buffer_init(&b, 0);
|
||||
for (int32_t i = 0; i < argc; ++i)
|
||||
janet_to_string_b(&b, argv[i]);
|
||||
Janet ret = janet_keywordv(b.data, b.count);
|
||||
janet_buffer_deinit(&b);
|
||||
return ret;
|
||||
}
|
||||
|
||||
static Janet janet_core_buffer(int32_t argc, Janet *argv) {
|
||||
JanetBuffer *b = janet_buffer(0);
|
||||
for (i = 0; i < args.n; ++i) {
|
||||
int32_t len;
|
||||
const uint8_t *str = janet_to_string(args.v[i]);
|
||||
len = janet_string_length(str);
|
||||
janet_buffer_push_bytes(b, str, len);
|
||||
}
|
||||
JANET_RETURN_BUFFER(args, b);
|
||||
for (int32_t i = 0; i < argc; ++i)
|
||||
janet_to_string_b(b, argv[i]);
|
||||
return janet_wrap_buffer(b);
|
||||
}
|
||||
|
||||
static int janet_core_is_abstract(JanetArgs args) {
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_RETURN_BOOLEAN(args, janet_checktype(args.v[0], JANET_ABSTRACT));
|
||||
static Janet janet_core_is_abstract(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
return janet_wrap_boolean(janet_checktype(argv[0], JANET_ABSTRACT));
|
||||
}
|
||||
|
||||
static int janet_core_scannumber(JanetArgs args) {
|
||||
const uint8_t *data;
|
||||
double val;
|
||||
int status = 0;
|
||||
int32_t len;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_ARG_BYTES(data, len, args, 0);
|
||||
val = janet_scan_number(data, len, &status);
|
||||
if (status)
|
||||
JANET_THROW(args, "failed to scan number");
|
||||
JANET_RETURN_NUMBER(args, val);
|
||||
static Janet janet_core_scannumber(int32_t argc, Janet *argv) {
|
||||
double number;
|
||||
janet_fixarity(argc, 1);
|
||||
JanetByteView view = janet_getbytes(argv, 1);
|
||||
if (janet_scan_number(view.bytes, view.len, &number))
|
||||
return janet_wrap_nil();
|
||||
return janet_wrap_number(number);
|
||||
}
|
||||
|
||||
static int janet_core_tuple(JanetArgs args) {
|
||||
JANET_RETURN_TUPLE(args, janet_tuple_n(args.v, args.n));
|
||||
static Janet janet_core_tuple(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_tuple(janet_tuple_n(argv, argc));
|
||||
}
|
||||
|
||||
static int janet_core_array(JanetArgs args) {
|
||||
JanetArray *array = janet_array(args.n);
|
||||
array->count = args.n;
|
||||
memcpy(array->data, args.v, args.n * sizeof(Janet));
|
||||
JANET_RETURN_ARRAY(args, array);
|
||||
static Janet janet_core_array(int32_t argc, Janet *argv) {
|
||||
JanetArray *array = janet_array(argc);
|
||||
array->count = argc;
|
||||
memcpy(array->data, argv, argc * sizeof(Janet));
|
||||
return janet_wrap_array(array);
|
||||
}
|
||||
|
||||
static int janet_core_table(JanetArgs args) {
|
||||
static Janet janet_core_table(int32_t argc, Janet *argv) {
|
||||
int32_t i;
|
||||
JanetTable *table = janet_table(args.n >> 1);
|
||||
if (args.n & 1)
|
||||
JANET_THROW(args, "expected even number of arguments");
|
||||
for (i = 0; i < args.n; i += 2) {
|
||||
janet_table_put(table, args.v[i], args.v[i + 1]);
|
||||
if (argc & 1)
|
||||
janet_panic("expected even number of arguments");
|
||||
JanetTable *table = janet_table(argc >> 1);
|
||||
for (i = 0; i < argc; i += 2) {
|
||||
janet_table_put(table, argv[i], argv[i + 1]);
|
||||
}
|
||||
JANET_RETURN_TABLE(args, table);
|
||||
return janet_wrap_table(table);
|
||||
}
|
||||
|
||||
static int janet_core_struct(JanetArgs args) {
|
||||
static Janet janet_core_struct(int32_t argc, Janet *argv) {
|
||||
int32_t i;
|
||||
JanetKV *st = janet_struct_begin(args.n >> 1);
|
||||
if (args.n & 1)
|
||||
JANET_THROW(args, "expected even number of arguments");
|
||||
for (i = 0; i < args.n; i += 2) {
|
||||
janet_struct_put(st, args.v[i], args.v[i + 1]);
|
||||
if (argc & 1)
|
||||
janet_panic("expected even number of arguments");
|
||||
JanetKV *st = janet_struct_begin(argc >> 1);
|
||||
for (i = 0; i < argc; i += 2) {
|
||||
janet_struct_put(st, argv[i], argv[i + 1]);
|
||||
}
|
||||
JANET_RETURN_STRUCT(args, janet_struct_end(st));
|
||||
return janet_wrap_struct(janet_struct_end(st));
|
||||
}
|
||||
|
||||
static int janet_core_gensym(JanetArgs args) {
|
||||
JANET_FIXARITY(args, 0);
|
||||
JANET_RETURN_SYMBOL(args, janet_symbol_gen());
|
||||
static Janet janet_core_gensym(int32_t argc, Janet *argv) {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
return janet_wrap_symbol(janet_symbol_gen());
|
||||
}
|
||||
|
||||
static int janet_core_gccollect(JanetArgs args) {
|
||||
(void) args;
|
||||
static Janet janet_core_gccollect(int32_t argc, Janet *argv) {
|
||||
(void) argv;
|
||||
(void) argc;
|
||||
janet_collect();
|
||||
return 0;
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static int janet_core_gcsetinterval(JanetArgs args) {
|
||||
int32_t val;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_ARG_INTEGER(val, args, 0);
|
||||
static Janet janet_core_gcsetinterval(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
int32_t val = janet_getinteger(argv, 0);
|
||||
if (val < 0)
|
||||
JANET_THROW(args, "expected non-negative integer");
|
||||
janet_panic("expected non-negative integer");
|
||||
janet_vm_gc_interval = val;
|
||||
JANET_RETURN_NIL(args);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static int janet_core_gcinterval(JanetArgs args) {
|
||||
JANET_FIXARITY(args, 0);
|
||||
JANET_RETURN_INTEGER(args, janet_vm_gc_interval);
|
||||
static Janet janet_core_gcinterval(int32_t argc, Janet *argv) {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
return janet_wrap_number(janet_vm_gc_interval);
|
||||
}
|
||||
|
||||
static int janet_core_type(JanetArgs args) {
|
||||
JANET_FIXARITY(args, 1);
|
||||
JanetType t = janet_type(args.v[0]);
|
||||
static Janet janet_core_type(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetType t = janet_type(argv[0]);
|
||||
if (t == JANET_ABSTRACT) {
|
||||
JANET_RETURN(args, janet_csymbolv(janet_abstract_type(janet_unwrap_abstract(args.v[0]))->name));
|
||||
return janet_ckeywordv(janet_abstract_type(janet_unwrap_abstract(argv[0]))->name);
|
||||
} else {
|
||||
JANET_RETURN(args, janet_csymbolv(janet_type_names[t]));
|
||||
return janet_ckeywordv(janet_type_names[t]);
|
||||
}
|
||||
}
|
||||
|
||||
static int janet_core_next(JanetArgs args) {
|
||||
Janet ds;
|
||||
const JanetKV *kv;
|
||||
JANET_FIXARITY(args, 2);
|
||||
JANET_CHECKMANY(args, 0, JANET_TFLAG_DICTIONARY);
|
||||
ds = args.v[0];
|
||||
if (janet_checktype(ds, JANET_TABLE)) {
|
||||
JanetTable *t = janet_unwrap_table(ds);
|
||||
kv = janet_checktype(args.v[1], JANET_NIL)
|
||||
? NULL
|
||||
: janet_table_find(t, args.v[1]);
|
||||
kv = janet_table_next(t, kv);
|
||||
} else {
|
||||
const JanetKV *st = janet_unwrap_struct(ds);
|
||||
kv = janet_checktype(args.v[1], JANET_NIL)
|
||||
? NULL
|
||||
: janet_struct_find(st, args.v[1]);
|
||||
kv = janet_struct_next(st, kv);
|
||||
static Janet janet_core_next(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetDictView view = janet_getdictionary(argv, 0);
|
||||
const JanetKV *end = view.kvs + view.cap;
|
||||
const JanetKV *kv = janet_checktype(argv[1], JANET_NIL)
|
||||
? view.kvs
|
||||
: janet_dict_find(view.kvs, view.cap, argv[1]) + 1;
|
||||
while (kv < end) {
|
||||
if (!janet_checktype(kv->key, JANET_NIL)) return kv->key;
|
||||
kv++;
|
||||
}
|
||||
if (kv)
|
||||
JANET_RETURN(args, kv->key);
|
||||
JANET_RETURN_NIL(args);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static int janet_core_hash(JanetArgs args) {
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_RETURN_INTEGER(args, janet_hash(args.v[0]));
|
||||
static Janet janet_core_hash(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
return janet_wrap_number(janet_hash(argv[0]));
|
||||
}
|
||||
|
||||
static const JanetReg cfuns[] = {
|
||||
{"native", janet_core_native,
|
||||
"(native path)\n\n"
|
||||
"Load a native module from the given path. The path "
|
||||
"must be an absolute or relative path on the file system, and is "
|
||||
"usually a .so file on Unix systems, and a .dll file on Windows. "
|
||||
"Returns an environment table that contains functions and other values "
|
||||
"from the native module."
|
||||
JDOC("(native path [,env])\n\n"
|
||||
"Load a native module from the given path. The path "
|
||||
"must be an absolute or relative path on the file system, and is "
|
||||
"usually a .so file on Unix systems, and a .dll file on Windows. "
|
||||
"Returns an environment table that contains functions and other values "
|
||||
"from the native module.")
|
||||
},
|
||||
{"print", janet_core_print,
|
||||
"(print & xs)\n\n"
|
||||
"Print values to the console (standard out). Value are converted "
|
||||
"to strings if they are not already. After printing all values, a "
|
||||
"newline character is printed. Returns nil."
|
||||
JDOC("(print & xs)\n\n"
|
||||
"Print values to the console (standard out). Value are converted "
|
||||
"to strings if they are not already. After printing all values, a "
|
||||
"newline character is printed. Returns nil.")
|
||||
},
|
||||
{"describe", janet_core_describe,
|
||||
"(describe x)\n\n"
|
||||
"Returns a string that is a human readable description of a value x."
|
||||
JDOC("(describe x)\n\n"
|
||||
"Returns a string that is a human readable description of a value x.")
|
||||
},
|
||||
{"string", janet_core_string,
|
||||
"(string & parts)\n\n"
|
||||
"Creates a string by concatenating values together. Values are "
|
||||
"converted to bytes via describe if they are not byte sequences. "
|
||||
"Returns the new string."
|
||||
JDOC("(string & parts)\n\n"
|
||||
"Creates a string by concatenating values together. Values are "
|
||||
"converted to bytes via describe if they are not byte sequences. "
|
||||
"Returns the new string.")
|
||||
},
|
||||
{"symbol", janet_core_symbol,
|
||||
"(symbol & xs)\n\n"
|
||||
"Creates a symbol by concatenating values together. Values are "
|
||||
"converted to bytes via describe if they are not byte sequences. Returns "
|
||||
"the new symbol."
|
||||
JDOC("(symbol & xs)\n\n"
|
||||
"Creates a symbol by concatenating values together. Values are "
|
||||
"converted to bytes via describe if they are not byte sequences. Returns "
|
||||
"the new symbol.")
|
||||
},
|
||||
{"keyword", janet_core_keyword,
|
||||
JDOC("(keyword & xs)\n\n"
|
||||
"Creates a keyword by concatenating values together. Values are "
|
||||
"converted to bytes via describe if they are not byte sequences. Returns "
|
||||
"the new keyword.")
|
||||
},
|
||||
{"buffer", janet_core_buffer,
|
||||
"(buffer & xs)\n\n"
|
||||
"Creates a new buffer by concatenating values together. Values are "
|
||||
"converted to bytes via describe if they are not byte sequences. Returns "
|
||||
"the new buffer."
|
||||
JDOC("(buffer & xs)\n\n"
|
||||
"Creates a new buffer by concatenating values together. Values are "
|
||||
"converted to bytes via describe if they are not byte sequences. Returns "
|
||||
"the new buffer.")
|
||||
},
|
||||
{"abstract?", janet_core_is_abstract,
|
||||
"(abstract? x)\n\n"
|
||||
"Check if x is an abstract type."
|
||||
JDOC("(abstract? x)\n\n"
|
||||
"Check if x is an abstract type.")
|
||||
},
|
||||
{"table", janet_core_table,
|
||||
"(table & kvs)\n\n"
|
||||
"Creates a new table from a variadic number of keys and values. "
|
||||
"kvs is a sequence k1, v1, k2, v2, k3, v3, ... If kvs has "
|
||||
"an odd number of elements, an error will be thrown. Returns the "
|
||||
"new table."
|
||||
JDOC("(table & kvs)\n\n"
|
||||
"Creates a new table from a variadic number of keys and values. "
|
||||
"kvs is a sequence k1, v1, k2, v2, k3, v3, ... If kvs has "
|
||||
"an odd number of elements, an error will be thrown. Returns the "
|
||||
"new table.")
|
||||
},
|
||||
{"array", janet_core_array,
|
||||
"(array & items)\n\n"
|
||||
"Create a new array that contains items. Returns the new array."
|
||||
JDOC("(array & items)\n\n"
|
||||
"Create a new array that contains items. Returns the new array.")
|
||||
},
|
||||
{"scan-number", janet_core_scannumber,
|
||||
"(scan-number str)\n\n"
|
||||
"Parse a number from a byte sequence an return that number, either and integer "
|
||||
"or a real. The number "
|
||||
"must be in the same format as numbers in janet source code. Will return nil "
|
||||
"on an invalid number."
|
||||
JDOC("(scan-number str)\n\n"
|
||||
"Parse a number from a byte sequence an return that number, either and integer "
|
||||
"or a real. The number "
|
||||
"must be in the same format as numbers in janet source code. Will return nil "
|
||||
"on an invalid number.")
|
||||
},
|
||||
{"tuple", janet_core_tuple,
|
||||
"(tuple & items)\n\n"
|
||||
"Creates a new tuple that contains items. Returns the new tuple."
|
||||
JDOC("(tuple & items)\n\n"
|
||||
"Creates a new tuple that contains items. Returns the new tuple.")
|
||||
},
|
||||
{"struct", janet_core_struct,
|
||||
"(struct & kvs)\n\n"
|
||||
"Create a new struct from a sequence of key value pairs. "
|
||||
"kvs is a sequence k1, v1, k2, v2, k3, v3, ... If kvs has "
|
||||
"an odd number of elements, an error will be thrown. Returns the "
|
||||
"new struct."
|
||||
JDOC("(struct & kvs)\n\n"
|
||||
"Create a new struct from a sequence of key value pairs. "
|
||||
"kvs is a sequence k1, v1, k2, v2, k3, v3, ... If kvs has "
|
||||
"an odd number of elements, an error will be thrown. Returns the "
|
||||
"new struct.")
|
||||
},
|
||||
{"gensym", janet_core_gensym,
|
||||
"(gensym)\n\n"
|
||||
"Returns a new symbol that is unique across the runtime. This means it "
|
||||
"will not collide with any already created symbols during compilation, so "
|
||||
"it can be used in macros to generate automatic bindings."
|
||||
JDOC("(gensym)\n\n"
|
||||
"Returns a new symbol that is unique across the runtime. This means it "
|
||||
"will not collide with any already created symbols during compilation, so "
|
||||
"it can be used in macros to generate automatic bindings.")
|
||||
},
|
||||
{"gccollect", janet_core_gccollect,
|
||||
"(gccollect)\n\n"
|
||||
"Run garbage collection. You should probably not call this manually."
|
||||
JDOC("(gccollect)\n\n"
|
||||
"Run garbage collection. You should probably not call this manually.")
|
||||
},
|
||||
{"gcsetinterval", janet_core_gcsetinterval,
|
||||
"(gcsetinterval interval)\n\n"
|
||||
"Set an integer number of bytes to allocate before running garbage collection. "
|
||||
"Low valuesi for interval will be slower but use less memory. "
|
||||
"High values will be faster but use more memory."
|
||||
JDOC("(gcsetinterval interval)\n\n"
|
||||
"Set an integer number of bytes to allocate before running garbage collection. "
|
||||
"Low valuesi for interval will be slower but use less memory. "
|
||||
"High values will be faster but use more memory.")
|
||||
},
|
||||
{"gcinterval", janet_core_gcinterval,
|
||||
"(gcinterval)\n\n"
|
||||
"Returns the integer number of bytes to allocate before running an iteration "
|
||||
"of garbage collection."
|
||||
JDOC("(gcinterval)\n\n"
|
||||
"Returns the integer number of bytes to allocate before running an iteration "
|
||||
"of garbage collection.")
|
||||
},
|
||||
{"type", janet_core_type,
|
||||
"(type x)\n\n"
|
||||
"Returns the type of x as a keyword symbol. x is one of\n"
|
||||
"\t:nil\n"
|
||||
"\t:boolean\n"
|
||||
"\t:integer\n"
|
||||
"\t:real\n"
|
||||
"\t:array\n"
|
||||
"\t:tuple\n"
|
||||
"\t:table\n"
|
||||
"\t:struct\n"
|
||||
"\t:string\n"
|
||||
"\t:buffer\n"
|
||||
"\t:symbol\n"
|
||||
"\t:function\n"
|
||||
"\t:cfunction\n\n"
|
||||
"or another symbol for an abstract type."
|
||||
JDOC("(type x)\n\n"
|
||||
"Returns the type of x as a keyword symbol. x is one of\n"
|
||||
"\t:nil\n"
|
||||
"\t:boolean\n"
|
||||
"\t:integer\n"
|
||||
"\t:real\n"
|
||||
"\t:array\n"
|
||||
"\t:tuple\n"
|
||||
"\t:table\n"
|
||||
"\t:struct\n"
|
||||
"\t:string\n"
|
||||
"\t:buffer\n"
|
||||
"\t:symbol\n"
|
||||
"\t:keyword\n"
|
||||
"\t:function\n"
|
||||
"\t:cfunction\n\n"
|
||||
"or another symbol for an abstract type.")
|
||||
},
|
||||
{"next", janet_core_next,
|
||||
"(next dict key)\n\n"
|
||||
"Gets the next key in a struct or table. Can be used to iterate through "
|
||||
"the keys of a data structure in an unspecified order. Keys are guaranteed "
|
||||
"to be seen only once per iteration if they data structure is not mutated "
|
||||
"during iteration. If key is nil, next returns the first key. If next "
|
||||
"returns nil, there are no more keys to iterate through. "
|
||||
JDOC("(next dict key)\n\n"
|
||||
"Gets the next key in a struct or table. Can be used to iterate through "
|
||||
"the keys of a data structure in an unspecified order. Keys are guaranteed "
|
||||
"to be seen only once per iteration if they data structure is not mutated "
|
||||
"during iteration. If key is nil, next returns the first key. If next "
|
||||
"returns nil, there are no more keys to iterate through. ")
|
||||
},
|
||||
{"hash", janet_core_hash,
|
||||
"(hash value)\n\n"
|
||||
"Gets a hash value for any janet value. The hash is an integer can be used "
|
||||
"as a cheap hash function for all janet objects. If two values are strictly equal, "
|
||||
"then they will have the same hash value."
|
||||
JDOC("(hash value)\n\n"
|
||||
"Gets a hash value for any janet value. The hash is an integer can be used "
|
||||
"as a cheap hash function for all janet objects. If two values are strictly equal, "
|
||||
"then they will have the same hash value.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
#ifndef JANET_NO_BOOTSTRAP
|
||||
|
||||
/* Utility for inline assembly */
|
||||
static void janet_quick_asm(
|
||||
JanetTable *env,
|
||||
@@ -569,215 +561,214 @@ static void make_apply(JanetTable *env) {
|
||||
};
|
||||
janet_quick_asm(env, JANET_FUN_APPLY | JANET_FUNCDEF_FLAG_VARARG,
|
||||
"apply", 1, 6, apply_asm, sizeof(apply_asm),
|
||||
"(apply f & args)\n\n"
|
||||
"Applies a function to a variable number of arguments. Each element in args "
|
||||
"is used as an argument to f, except the last element in args, which is expected to "
|
||||
"be an array-like. Each element in this last argument is then also pushed as an argument to "
|
||||
"f. For example:\n\n"
|
||||
"\t(apply + 1000 (range 10))\n\n"
|
||||
"sums the first 10 integers and 1000.)");
|
||||
JDOC("(apply f & args)\n\n"
|
||||
"Applies a function to a variable number of arguments. Each element in args "
|
||||
"is used as an argument to f, except the last element in args, which is expected to "
|
||||
"be an array-like. Each element in this last argument is then also pushed as an argument to "
|
||||
"f. For example:\n\n"
|
||||
"\t(apply + 1000 (range 10))\n\n"
|
||||
"sums the first 10 integers and 1000.)"));
|
||||
}
|
||||
|
||||
JanetTable *janet_core_env(void) {
|
||||
static const uint32_t error_asm[] = {
|
||||
JOP_ERROR
|
||||
};
|
||||
static const uint32_t debug_asm[] = {
|
||||
JOP_SIGNAL | (2 << 24),
|
||||
JOP_RETURN_NIL
|
||||
};
|
||||
static const uint32_t yield_asm[] = {
|
||||
JOP_SIGNAL | (3 << 24),
|
||||
JOP_RETURN
|
||||
};
|
||||
static const uint32_t resume_asm[] = {
|
||||
JOP_RESUME | (1 << 24),
|
||||
JOP_RETURN
|
||||
};
|
||||
static const uint32_t get_asm[] = {
|
||||
JOP_GET | (1 << 24),
|
||||
JOP_RETURN
|
||||
};
|
||||
static const uint32_t put_asm[] = {
|
||||
JOP_PUT | (1 << 16) | (2 << 24),
|
||||
JOP_RETURN
|
||||
};
|
||||
static const uint32_t length_asm[] = {
|
||||
JOP_LENGTH,
|
||||
JOP_RETURN
|
||||
};
|
||||
static const uint32_t bnot_asm[] = {
|
||||
JOP_BNOT,
|
||||
JOP_RETURN
|
||||
};
|
||||
static const uint32_t error_asm[] = {
|
||||
JOP_ERROR
|
||||
};
|
||||
static const uint32_t debug_asm[] = {
|
||||
JOP_SIGNAL | (2 << 24),
|
||||
JOP_RETURN_NIL
|
||||
};
|
||||
static const uint32_t yield_asm[] = {
|
||||
JOP_SIGNAL | (3 << 24),
|
||||
JOP_RETURN
|
||||
};
|
||||
static const uint32_t resume_asm[] = {
|
||||
JOP_RESUME | (1 << 24),
|
||||
JOP_RETURN
|
||||
};
|
||||
static const uint32_t get_asm[] = {
|
||||
JOP_GET | (1 << 24),
|
||||
JOP_RETURN
|
||||
};
|
||||
static const uint32_t put_asm[] = {
|
||||
JOP_PUT | (1 << 16) | (2 << 24),
|
||||
JOP_RETURN
|
||||
};
|
||||
static const uint32_t length_asm[] = {
|
||||
JOP_LENGTH,
|
||||
JOP_RETURN
|
||||
};
|
||||
static const uint32_t bnot_asm[] = {
|
||||
JOP_BNOT,
|
||||
JOP_RETURN
|
||||
};
|
||||
#endif /* ifndef JANET_NO_BOOTSTRAP */
|
||||
|
||||
JanetTable *janet_core_env(void) {
|
||||
JanetTable *env = janet_table(0);
|
||||
Janet ret = janet_wrap_table(env);
|
||||
|
||||
/* Load main functions */
|
||||
janet_cfuns(env, NULL, cfuns);
|
||||
|
||||
#ifndef JANET_NO_BOOTSTRAP
|
||||
janet_quick_asm(env, JANET_FUN_YIELD, "debug", 0, 1, debug_asm, sizeof(debug_asm),
|
||||
"(debug)\n\n"
|
||||
"Throws a debug signal that can be caught by a parent fiber and used to inspect "
|
||||
"the running state of the current fiber. Returns nil.");
|
||||
JDOC("(debug)\n\n"
|
||||
"Throws a debug signal that can be caught by a parent fiber and used to inspect "
|
||||
"the running state of the current fiber. Returns nil."));
|
||||
janet_quick_asm(env, JANET_FUN_ERROR, "error", 1, 1, error_asm, sizeof(error_asm),
|
||||
"(error e)\n\n"
|
||||
"Throws an error e that can be caught and handled by a parent fiber.");
|
||||
JDOC("(error e)\n\n"
|
||||
"Throws an error e that can be caught and handled by a parent fiber."));
|
||||
janet_quick_asm(env, JANET_FUN_YIELD, "yield", 1, 2, yield_asm, sizeof(yield_asm),
|
||||
"(yield x)\n\n"
|
||||
"Yield a value to a parent fiber. When a fiber yields, its execution is paused until "
|
||||
"another thread resumes it. The fiber will then resume, and the last yield call will "
|
||||
"return the value that was passed to resume.");
|
||||
JDOC("(yield x)\n\n"
|
||||
"Yield a value to a parent fiber. When a fiber yields, its execution is paused until "
|
||||
"another thread resumes it. The fiber will then resume, and the last yield call will "
|
||||
"return the value that was passed to resume."));
|
||||
janet_quick_asm(env, JANET_FUN_RESUME, "resume", 2, 2, resume_asm, sizeof(resume_asm),
|
||||
"(resume fiber [,x])\n\n"
|
||||
"Resume a new or suspended fiber and optionally pass in a value to the fiber that "
|
||||
"will be returned to the last yield in the case of a pending fiber, or the argument to "
|
||||
"the dispatch function in the case of a new fiber. Returns either the return result of "
|
||||
"the fiber's dispatch function, or the value from the next yield call in fiber.");
|
||||
JDOC("(resume fiber [,x])\n\n"
|
||||
"Resume a new or suspended fiber and optionally pass in a value to the fiber that "
|
||||
"will be returned to the last yield in the case of a pending fiber, or the argument to "
|
||||
"the dispatch function in the case of a new fiber. Returns either the return result of "
|
||||
"the fiber's dispatch function, or the value from the next yield call in fiber."));
|
||||
janet_quick_asm(env, JANET_FUN_GET, "get", 2, 2, get_asm, sizeof(get_asm),
|
||||
"(get ds key)\n\n"
|
||||
"Get a value from any associative data structure. Arrays, tuples, tables, structs, strings, "
|
||||
"symbols, and buffers are all associative and can be used with get. Order structures, name "
|
||||
"arrays, tuples, strings, buffers, and symbols must use integer keys. Structs and tables can "
|
||||
"take any value as a key except nil and return a value except nil. Byte sequences will return "
|
||||
"integer representations of bytes as result of a get call.");
|
||||
JDOC("(get ds key)\n\n"
|
||||
"Get a value from any associative data structure. Arrays, tuples, tables, structs, strings, "
|
||||
"symbols, and buffers are all associative and can be used with get. Order structures, name "
|
||||
"arrays, tuples, strings, buffers, and symbols must use integer keys. Structs and tables can "
|
||||
"take any value as a key except nil and return a value except nil. Byte sequences will return "
|
||||
"integer representations of bytes as result of a get call."));
|
||||
janet_quick_asm(env, JANET_FUN_PUT, "put", 3, 3, put_asm, sizeof(put_asm),
|
||||
"(put ds key value)\n\n"
|
||||
"Associate a key with a value in any mutable associative data structure. Indexed data structures "
|
||||
"(arrays and buffers) only accept non-negative integer keys, and will expand if an out of bounds "
|
||||
"value is provided. In an array, extra space will be filled with nils, and in a buffer, extra "
|
||||
"space will be filled with 0 bytes. In a table, putting a key that is contained in the table prototype "
|
||||
"will hide the association defined by the prototype, but will not mutate the prototype table. Putting "
|
||||
"a value nil into a table will remove the key from the table. Returns the data structure ds.");
|
||||
JDOC("(put ds key value)\n\n"
|
||||
"Associate a key with a value in any mutable associative data structure. Indexed data structures "
|
||||
"(arrays and buffers) only accept non-negative integer keys, and will expand if an out of bounds "
|
||||
"value is provided. In an array, extra space will be filled with nils, and in a buffer, extra "
|
||||
"space will be filled with 0 bytes. In a table, putting a key that is contained in the table prototype "
|
||||
"will hide the association defined by the prototype, but will not mutate the prototype table. Putting "
|
||||
"a value nil into a table will remove the key from the table. Returns the data structure ds."));
|
||||
janet_quick_asm(env, JANET_FUN_LENGTH, "length", 1, 1, length_asm, sizeof(length_asm),
|
||||
"(length ds)\n\n"
|
||||
"Returns the length or count of a data structure in constant time as an integer. For "
|
||||
"structs and tables, returns the number of key-value pairs in the data structure.");
|
||||
JDOC("(length ds)\n\n"
|
||||
"Returns the length or count of a data structure in constant time as an integer. For "
|
||||
"structs and tables, returns the number of key-value pairs in the data structure."));
|
||||
janet_quick_asm(env, JANET_FUN_BNOT, "bnot", 1, 1, bnot_asm, sizeof(bnot_asm),
|
||||
"(bnot x)\n\nReturns the bitwise inverse of integer x.");
|
||||
JDOC("(bnot x)\n\nReturns the bit-wise inverse of integer x."));
|
||||
make_apply(env);
|
||||
|
||||
/* Variadic ops */
|
||||
templatize_varop(env, JANET_FUN_ADD, "+", 0, 0, JOP_ADD,
|
||||
"(+ & xs)\n\n"
|
||||
"Returns the sum of all xs. xs must be integers or real numbers only. If xs is empty, return 0.");
|
||||
JDOC("(+ & xs)\n\n"
|
||||
"Returns the sum of all xs. xs must be integers or real numbers only. If xs is empty, return 0."));
|
||||
templatize_varop(env, JANET_FUN_SUBTRACT, "-", 0, 0, JOP_SUBTRACT,
|
||||
"(- & xs)\n\n"
|
||||
JDOC("(- & xs)\n\n"
|
||||
"Returns the difference of xs. If xs is empty, returns 0. If xs has one element, returns the "
|
||||
"negative value of that element. Otherwise, returns the first element in xs minus the sum of "
|
||||
"the rest of the elements.");
|
||||
"the rest of the elements."));
|
||||
templatize_varop(env, JANET_FUN_MULTIPLY, "*", 1, 1, JOP_MULTIPLY,
|
||||
"(* & xs)\n\n"
|
||||
"Returns the product of all elements in xs. If xs is empty, returns 1.");
|
||||
JDOC("(* & xs)\n\n"
|
||||
"Returns the product of all elements in xs. If xs is empty, returns 1."));
|
||||
templatize_varop(env, JANET_FUN_DIVIDE, "/", 1, 1, JOP_DIVIDE,
|
||||
"(/ & xs)\n\n"
|
||||
JDOC("(/ & xs)\n\n"
|
||||
"Returns the quotient of xs. If xs is empty, returns 1. If xs has one value x, returns "
|
||||
"the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining "
|
||||
"values. Division by two integers uses truncating division.");
|
||||
"values. Division by two integers uses truncating division."));
|
||||
templatize_varop(env, JANET_FUN_BAND, "band", -1, -1, JOP_BAND,
|
||||
"(band & xs)\n\n"
|
||||
"Returns the bitwise and of all values in xs. Each x in xs must be an integer.");
|
||||
JDOC("(band & xs)\n\n"
|
||||
"Returns the bit-wise and of all values in xs. Each x in xs must be an integer."));
|
||||
templatize_varop(env, JANET_FUN_BOR, "bor", 0, 0, JOP_BOR,
|
||||
"(bor & xs)\n\n"
|
||||
"Returns the bitwise or of all values in xs. Each x in xs must be an integer.");
|
||||
JDOC("(bor & xs)\n\n"
|
||||
"Returns the bit-wise or of all values in xs. Each x in xs must be an integer."));
|
||||
templatize_varop(env, JANET_FUN_BXOR, "bxor", 0, 0, JOP_BXOR,
|
||||
"(bxor & xs)\n\n"
|
||||
"Returns the bitwise xor of all values in xs. Each in xs must be an integer.");
|
||||
JDOC("(bxor & xs)\n\n"
|
||||
"Returns the bit-wise xor of all values in xs. Each in xs must be an integer."));
|
||||
templatize_varop(env, JANET_FUN_LSHIFT, "blshift", 1, 1, JOP_SHIFT_LEFT,
|
||||
"(blshift x & shifts)\n\n"
|
||||
JDOC("(blshift x & shifts)\n\n"
|
||||
"Returns the value of x bit shifted left by the sum of all values in shifts. x "
|
||||
"and each element in shift must be an integer.");
|
||||
"and each element in shift must be an integer."));
|
||||
templatize_varop(env, JANET_FUN_RSHIFT, "brshift", 1, 1, JOP_SHIFT_RIGHT,
|
||||
"(brshift x & shifts)\n\n"
|
||||
JDOC("(brshift x & shifts)\n\n"
|
||||
"Returns the value of x bit shifted right by the sum of all values in shifts. x "
|
||||
"and each element in shift must be an integer.");
|
||||
"and each element in shift must be an integer."));
|
||||
templatize_varop(env, JANET_FUN_RSHIFTU, "brushift", 1, 1, JOP_SHIFT_RIGHT_UNSIGNED,
|
||||
"(brushift x & shifts)\n\n"
|
||||
JDOC("(brushift x & shifts)\n\n"
|
||||
"Returns the value of x bit shifted right by the sum of all values in shifts. x "
|
||||
"and each element in shift must be an integer. The sign of x is not preserved, so "
|
||||
"for positive shifts the return value will always be positive.");
|
||||
"for positive shifts the return value will always be positive."));
|
||||
|
||||
/* Variadic comparators */
|
||||
templatize_comparator(env, JANET_FUN_ORDER_GT, "order>", 0, JOP_GREATER_THAN,
|
||||
"(order> & xs)\n\n"
|
||||
"Check if xs is strictly descending according to a total order "
|
||||
"over all values. Returns a boolean.");
|
||||
JDOC("(order> & xs)\n\n"
|
||||
"Check if xs is strictly descending according to a total order "
|
||||
"over all values. Returns a boolean."));
|
||||
templatize_comparator(env, JANET_FUN_ORDER_LT, "order<", 0, JOP_LESS_THAN,
|
||||
"(order< & xs)\n\n"
|
||||
"Check if xs is strictly increasing according to a total order "
|
||||
"over all values. Returns a boolean.");
|
||||
JDOC("(order< & xs)\n\n"
|
||||
"Check if xs is strictly increasing according to a total order "
|
||||
"over all values. Returns a boolean."));
|
||||
templatize_comparator(env, JANET_FUN_ORDER_GTE, "order>=", 1, JOP_LESS_THAN,
|
||||
"(order>= & xs)\n\n"
|
||||
"Check if xs is not increasing according to a total order "
|
||||
"over all values. Returns a boolean.");
|
||||
JDOC("(order>= & xs)\n\n"
|
||||
"Check if xs is not increasing according to a total order "
|
||||
"over all values. Returns a boolean."));
|
||||
templatize_comparator(env, JANET_FUN_ORDER_LTE, "order<=", 1, JOP_GREATER_THAN,
|
||||
"(order<= & xs)\n\n"
|
||||
"Check if xs is not decreasing according to a total order "
|
||||
"over all values. Returns a boolean.");
|
||||
JDOC("(order<= & xs)\n\n"
|
||||
"Check if xs is not decreasing according to a total order "
|
||||
"over all values. Returns a boolean."));
|
||||
templatize_comparator(env, JANET_FUN_ORDER_EQ, "=", 0, JOP_EQUALS,
|
||||
"(= & xs)\n\n"
|
||||
"Returns true if all values in xs are the same, false otherwise.");
|
||||
JDOC("(= & xs)\n\n"
|
||||
"Returns true if all values in xs are the same, false otherwise."));
|
||||
templatize_comparator(env, JANET_FUN_ORDER_NEQ, "not=", 1, JOP_EQUALS,
|
||||
"(not= & xs)\n\n"
|
||||
"Return true if any values in xs are not equal, otherwise false.");
|
||||
JDOC("(not= & xs)\n\n"
|
||||
"Return true if any values in xs are not equal, otherwise false."));
|
||||
templatize_comparator(env, JANET_FUN_GT, ">", 0, JOP_NUMERIC_GREATER_THAN,
|
||||
"(> & xs)\n\n"
|
||||
"Check if xs is in numerically descending order. Returns a boolean.");
|
||||
JDOC("(> & xs)\n\n"
|
||||
"Check if xs is in numerically descending order. Returns a boolean."));
|
||||
templatize_comparator(env, JANET_FUN_LT, "<", 0, JOP_NUMERIC_LESS_THAN,
|
||||
"(< & xs)\n\n"
|
||||
"Check if xs is in numerically ascending order. Returns a boolean.");
|
||||
JDOC("(< & xs)\n\n"
|
||||
"Check if xs is in numerically ascending order. Returns a boolean."));
|
||||
templatize_comparator(env, JANET_FUN_GTE, ">=", 0, JOP_NUMERIC_GREATER_THAN_EQUAL,
|
||||
"(>= & xs)\n\n"
|
||||
"Check if xs is in numerically non-ascending order. Returns a boolean.");
|
||||
JDOC("(>= & xs)\n\n"
|
||||
"Check if xs is in numerically non-ascending order. Returns a boolean."));
|
||||
templatize_comparator(env, JANET_FUN_LTE, "<=", 0, JOP_NUMERIC_LESS_THAN_EQUAL,
|
||||
"(<= & xs)\n\n"
|
||||
"Check if xs is in numerically non-descending order. Returns a boolean.");
|
||||
JDOC("(<= & xs)\n\n"
|
||||
"Check if xs is in numerically non-descending order. Returns a boolean."));
|
||||
templatize_comparator(env, JANET_FUN_EQ, "==", 0, JOP_NUMERIC_EQUAL,
|
||||
"(== & xs)\n\n"
|
||||
"Check if all values in xs are numerically equal (4.0 == 4). Returns a boolean.");
|
||||
JDOC("(== & xs)\n\n"
|
||||
"Check if all values in xs are numerically equal (4.0 == 4). Returns a boolean."));
|
||||
templatize_comparator(env, JANET_FUN_NEQ, "not==", 1, JOP_NUMERIC_EQUAL,
|
||||
"(not== & xs)\n\n"
|
||||
"Check if any values in xs are not numerically equal (3.0 not== 4). Returns a boolean.");
|
||||
JDOC("(not== & xs)\n\n"
|
||||
"Check if any values in xs are not numerically equal (3.0 not== 4). Returns a boolean."));
|
||||
|
||||
/* Platform detection */
|
||||
janet_def(env, "janet/version", janet_cstringv(JANET_VERSION),
|
||||
"The version number of the running janet program.");
|
||||
JDOC("The version number of the running janet program."));
|
||||
janet_def(env, "janet/build", janet_cstringv(JANET_BUILD),
|
||||
"The build identifier of the running janet program.");
|
||||
JDOC("The build identifier of the running janet program."));
|
||||
|
||||
/* Allow references to the environment */
|
||||
janet_def(env, "_env", ret, JDOC("The environment table for the current scope."));
|
||||
#endif
|
||||
|
||||
/* Set as gc root */
|
||||
janet_gcroot(janet_wrap_table(env));
|
||||
|
||||
/* Load auxiliary envs */
|
||||
{
|
||||
JanetArgs args;
|
||||
args.n = 1;
|
||||
args.v = &ret;
|
||||
args.ret = &ret;
|
||||
janet_lib_io(args);
|
||||
janet_lib_math(args);
|
||||
janet_lib_array(args);
|
||||
janet_lib_tuple(args);
|
||||
janet_lib_buffer(args);
|
||||
janet_lib_table(args);
|
||||
janet_lib_fiber(args);
|
||||
janet_lib_os(args);
|
||||
janet_lib_parse(args);
|
||||
janet_lib_compile(args);
|
||||
janet_lib_debug(args);
|
||||
janet_lib_string(args);
|
||||
janet_lib_marsh(args);
|
||||
janet_lib_io(env);
|
||||
janet_lib_math(env);
|
||||
janet_lib_array(env);
|
||||
janet_lib_tuple(env);
|
||||
janet_lib_buffer(env);
|
||||
janet_lib_table(env);
|
||||
janet_lib_fiber(env);
|
||||
janet_lib_os(env);
|
||||
janet_lib_parse(env);
|
||||
janet_lib_compile(env);
|
||||
janet_lib_debug(env);
|
||||
janet_lib_string(env);
|
||||
janet_lib_marsh(env);
|
||||
#ifdef JANET_ASSEMBLER
|
||||
janet_lib_asm(args);
|
||||
janet_lib_asm(env);
|
||||
#endif
|
||||
}
|
||||
|
||||
/* Allow references to the environment */
|
||||
janet_def(env, "_env", ret, "The environment table for the current scope.");
|
||||
|
||||
#ifndef JANET_NO_BOOTSTRAP
|
||||
/* Run bootstrap source */
|
||||
janet_dobytes(env, janet_gen_core, janet_gen_core_size, "core.janet", NULL);
|
||||
#endif
|
||||
|
||||
return env;
|
||||
}
|
||||
|
||||
252
src/core/debug.c
252
src/core/debug.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2018 Calvin Rose
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -23,32 +23,31 @@
|
||||
#include <janet/janet.h>
|
||||
#include "gc.h"
|
||||
#include "state.h"
|
||||
#include "util.h"
|
||||
|
||||
/* Implements functionality to build a debugger from within janet.
|
||||
* The repl should also be able to serve as pretty featured debugger
|
||||
* out of the box. */
|
||||
|
||||
/* Add a break point to a function */
|
||||
int janet_debug_break(JanetFuncDef *def, int32_t pc) {
|
||||
void janet_debug_break(JanetFuncDef *def, int32_t pc) {
|
||||
if (pc >= def->bytecode_length || pc < 0)
|
||||
return 1;
|
||||
janet_panic("invalid bytecode offset");
|
||||
def->bytecode[pc] |= 0x80;
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* Remove a break point from a function */
|
||||
int janet_debug_unbreak(JanetFuncDef *def, int32_t pc) {
|
||||
void janet_debug_unbreak(JanetFuncDef *def, int32_t pc) {
|
||||
if (pc >= def->bytecode_length || pc < 0)
|
||||
return 1;
|
||||
janet_panic("invalid bytecode offset");
|
||||
def->bytecode[pc] &= ~((uint32_t)0x80);
|
||||
return 0;
|
||||
}
|
||||
|
||||
/*
|
||||
* Find a location for a breakpoint given a source file an
|
||||
* location.
|
||||
*/
|
||||
int janet_debug_find(
|
||||
void janet_debug_find(
|
||||
JanetFuncDef **def_out, int32_t *pc_out,
|
||||
const uint8_t *source, int32_t offset) {
|
||||
/* Scan the heap for right func def */
|
||||
@@ -84,9 +83,8 @@ int janet_debug_find(
|
||||
if (best_def) {
|
||||
*def_out = best_def;
|
||||
*pc_out = besti;
|
||||
return 0;
|
||||
} else {
|
||||
return 1;
|
||||
janet_panic("could not find breakpoint");
|
||||
}
|
||||
}
|
||||
|
||||
@@ -96,86 +94,64 @@ int janet_debug_find(
|
||||
|
||||
/* Helper to find funcdef and bytecode offset to insert or remove breakpoints.
|
||||
* Takes a source file name and byte offset. */
|
||||
static int helper_find(JanetArgs args, JanetFuncDef **def, int32_t *bytecode_offset) {
|
||||
const uint8_t *source;
|
||||
int32_t source_offset;
|
||||
JANET_FIXARITY(args, 2);
|
||||
JANET_ARG_STRING(source, args, 0);
|
||||
JANET_ARG_INTEGER(source_offset, args, 1);
|
||||
if (janet_debug_find(
|
||||
def, bytecode_offset, source, source_offset)) {
|
||||
JANET_THROW(args, "could not find breakpoint");
|
||||
}
|
||||
JANET_RETURN_NIL(args);
|
||||
static void helper_find(int32_t argc, Janet *argv, JanetFuncDef **def, int32_t *bytecode_offset) {
|
||||
janet_fixarity(argc, 2);
|
||||
const uint8_t *source = janet_getstring(argv, 0);
|
||||
int32_t source_offset = janet_getinteger(argv, 1);
|
||||
janet_debug_find(def, bytecode_offset, source, source_offset);
|
||||
}
|
||||
|
||||
/* Helper to find funcdef and bytecode offset to insert or remove breakpoints.
|
||||
* Takes a function and byte offset*/
|
||||
static int helper_find_fun(JanetArgs args, JanetFuncDef **def, int32_t *bytecode_offset) {
|
||||
JanetFunction *func;
|
||||
int32_t offset = 0;
|
||||
JANET_MINARITY(args, 1);
|
||||
JANET_MAXARITY(args, 2);
|
||||
JANET_ARG_FUNCTION(func, args, 0);
|
||||
if (args.n == 2) {
|
||||
JANET_ARG_INTEGER(offset, args, 1);
|
||||
}
|
||||
static void helper_find_fun(int32_t argc, Janet *argv, JanetFuncDef **def, int32_t *bytecode_offset) {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetFunction *func = janet_getfunction(argv, 0);
|
||||
int32_t offset = (argc == 2) ? janet_getinteger(argv, 1) : 0;
|
||||
*def = func->def;
|
||||
*bytecode_offset = offset;
|
||||
JANET_RETURN_NIL(args);
|
||||
}
|
||||
|
||||
static int cfun_break(JanetArgs args) {
|
||||
static Janet cfun_break(int32_t argc, Janet *argv) {
|
||||
JanetFuncDef *def;
|
||||
int32_t offset;
|
||||
int status = helper_find(args, &def, &offset);
|
||||
if (status == 0) janet_debug_break(def, offset);
|
||||
return status;
|
||||
helper_find(argc, argv, &def, &offset);
|
||||
janet_debug_break(def, offset);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static int cfun_unbreak(JanetArgs args) {
|
||||
static Janet cfun_unbreak(int32_t argc, Janet *argv) {
|
||||
JanetFuncDef *def;
|
||||
int32_t offset;
|
||||
int status = helper_find(args, &def, &offset);
|
||||
if (status == 0) janet_debug_unbreak(def, offset);
|
||||
return status;
|
||||
helper_find(argc, argv, &def, &offset);
|
||||
janet_debug_unbreak(def, offset);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static int cfun_fbreak(JanetArgs args) {
|
||||
static Janet cfun_fbreak(int32_t argc, Janet *argv) {
|
||||
JanetFuncDef *def;
|
||||
int32_t offset;
|
||||
int status = helper_find_fun(args, &def, &offset);
|
||||
if (status == 0) {
|
||||
if (janet_debug_break(def, offset)) {
|
||||
JANET_THROW(args, "could not find breakpoint");
|
||||
}
|
||||
}
|
||||
return status;
|
||||
helper_find_fun(argc, argv, &def, &offset);
|
||||
janet_debug_break(def, offset);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static int cfun_unfbreak(JanetArgs args) {
|
||||
static Janet cfun_unfbreak(int32_t argc, Janet *argv) {
|
||||
JanetFuncDef *def;
|
||||
int32_t offset;
|
||||
int status = helper_find_fun(args, &def, &offset);
|
||||
if (status == 0) {
|
||||
if (janet_debug_unbreak(def, offset)) {
|
||||
JANET_THROW(args, "could not find breakpoint");
|
||||
}
|
||||
}
|
||||
return status;
|
||||
helper_find_fun(argc, argv, &def, &offset);
|
||||
janet_debug_unbreak(def, offset);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static int cfun_lineage(JanetArgs args) {
|
||||
JanetFiber *fiber;
|
||||
JanetArray *array;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_ARG_FIBER(fiber, args, 0);
|
||||
array = janet_array(0);
|
||||
static Janet cfun_lineage(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
JanetArray *array = janet_array(0);
|
||||
while (fiber) {
|
||||
janet_array_push(array, janet_wrap_fiber(fiber));
|
||||
fiber = fiber->child;
|
||||
}
|
||||
JANET_RETURN_ARRAY(args, array);
|
||||
return janet_wrap_array(array);
|
||||
}
|
||||
|
||||
/* Extract info from one stack frame */
|
||||
@@ -184,52 +160,50 @@ static Janet doframe(JanetStackFrame *frame) {
|
||||
JanetTable *t = janet_table(3);
|
||||
JanetFuncDef *def = NULL;
|
||||
if (frame->func) {
|
||||
janet_table_put(t, janet_csymbolv(":function"), janet_wrap_function(frame->func));
|
||||
janet_table_put(t, janet_ckeywordv("function"), janet_wrap_function(frame->func));
|
||||
def = frame->func->def;
|
||||
if (def->name) {
|
||||
janet_table_put(t, janet_csymbolv(":name"), janet_wrap_string(def->name));
|
||||
janet_table_put(t, janet_ckeywordv("name"), janet_wrap_string(def->name));
|
||||
}
|
||||
} else {
|
||||
JanetCFunction cfun = (JanetCFunction)(frame->pc);
|
||||
if (cfun) {
|
||||
Janet name = janet_table_get(janet_vm_registry, janet_wrap_cfunction(cfun));
|
||||
if (!janet_checktype(name, JANET_NIL)) {
|
||||
janet_table_put(t, janet_csymbolv(":name"), name);
|
||||
janet_table_put(t, janet_ckeywordv("name"), name);
|
||||
}
|
||||
}
|
||||
janet_table_put(t, janet_csymbolv(":c"), janet_wrap_true());
|
||||
janet_table_put(t, janet_ckeywordv("c"), janet_wrap_true());
|
||||
}
|
||||
if (frame->flags & JANET_STACKFRAME_TAILCALL) {
|
||||
janet_table_put(t, janet_csymbolv(":tail"), janet_wrap_true());
|
||||
janet_table_put(t, janet_ckeywordv("tail"), janet_wrap_true());
|
||||
}
|
||||
if (frame->func && frame->pc) {
|
||||
Janet *stack = (Janet *)frame + JANET_FRAME_SIZE;
|
||||
JanetArray *slots;
|
||||
off = (int32_t) (frame->pc - def->bytecode);
|
||||
janet_table_put(t, janet_csymbolv(":pc"), janet_wrap_integer(off));
|
||||
janet_table_put(t, janet_ckeywordv("pc"), janet_wrap_integer(off));
|
||||
if (def->sourcemap) {
|
||||
JanetSourceMapping mapping = def->sourcemap[off];
|
||||
janet_table_put(t, janet_csymbolv(":source-start"), janet_wrap_integer(mapping.start));
|
||||
janet_table_put(t, janet_csymbolv(":source-end"), janet_wrap_integer(mapping.end));
|
||||
janet_table_put(t, janet_ckeywordv("source-start"), janet_wrap_integer(mapping.start));
|
||||
janet_table_put(t, janet_ckeywordv("source-end"), janet_wrap_integer(mapping.end));
|
||||
}
|
||||
if (def->source) {
|
||||
janet_table_put(t, janet_csymbolv(":source"), janet_wrap_string(def->source));
|
||||
janet_table_put(t, janet_ckeywordv("source"), janet_wrap_string(def->source));
|
||||
}
|
||||
/* Add stack arguments */
|
||||
slots = janet_array(def->slotcount);
|
||||
memcpy(slots->data, stack, sizeof(Janet) * def->slotcount);
|
||||
slots->count = def->slotcount;
|
||||
janet_table_put(t, janet_csymbolv(":slots"), janet_wrap_array(slots));
|
||||
janet_table_put(t, janet_ckeywordv("slots"), janet_wrap_array(slots));
|
||||
}
|
||||
return janet_wrap_table(t);
|
||||
}
|
||||
|
||||
static int cfun_stack(JanetArgs args) {
|
||||
JanetFiber *fiber;
|
||||
JanetArray *array;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_ARG_FIBER(fiber, args, 0);
|
||||
array = janet_array(0);
|
||||
static Janet cfun_stack(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
JanetArray *array = janet_array(0);
|
||||
{
|
||||
int32_t i = fiber->frame;
|
||||
JanetStackFrame *frame;
|
||||
@@ -239,75 +213,83 @@ static int cfun_stack(JanetArgs args) {
|
||||
i = frame->prevframe;
|
||||
}
|
||||
}
|
||||
JANET_RETURN_ARRAY(args, array);
|
||||
return janet_wrap_array(array);
|
||||
}
|
||||
|
||||
static int cfun_argstack(JanetArgs args) {
|
||||
JanetFiber *fiber;
|
||||
JanetArray *array;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_ARG_FIBER(fiber, args, 0);
|
||||
array = janet_array(fiber->stacktop - fiber->stackstart);
|
||||
static Janet cfun_argstack(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
JanetArray *array = janet_array(fiber->stacktop - fiber->stackstart);
|
||||
memcpy(array->data, fiber->data + fiber->stackstart, array->capacity * sizeof(Janet));
|
||||
array->count = array->capacity;
|
||||
JANET_RETURN_ARRAY(args, array);
|
||||
return janet_wrap_array(array);
|
||||
}
|
||||
|
||||
static const JanetReg cfuns[] = {
|
||||
{"debug/break", cfun_break,
|
||||
"(debug/break source byte-offset)\n\n"
|
||||
"Sets a breakpoint with source a key at a given byte offset. An offset "
|
||||
"of 0 is the first byte in a file. Will throw an error if the breakpoint location "
|
||||
"cannot be found. For example\n\n"
|
||||
"\t(debug/break \"core.janet\" 1000)\n\n"
|
||||
"wil set a breakpoint at the 1000th byte of the file core.janet."},
|
||||
{"debug/unbreak", cfun_unbreak,
|
||||
"(debug/unbreak source byte-offset)\n\n"
|
||||
"Remove a breakpoint with a source key at a given byte offset. An offset "
|
||||
"of 0 is the first byte in a file. Will throw an error if the breakpoint "
|
||||
"cannot be found."},
|
||||
{"debug/fbreak", cfun_fbreak,
|
||||
"(debug/fbreak fun [,pc=0])\n\n"
|
||||
"Set a breakpoint in a given function. pc is an optional offset, which "
|
||||
"is in bytecode instructions. fun is a function value. Will throw an error "
|
||||
"if the offset is too large or negative."},
|
||||
{"debug/unfbreak", cfun_unfbreak,
|
||||
"(debug/unfbreak fun [,pc=0])\n\n"
|
||||
"Unset a breakpoint set with debug/fbreak."},
|
||||
{"debug/arg-stack", cfun_argstack,
|
||||
"(debug/arg-stack fiber)\n\n"
|
||||
"Gets all values currently on the fiber's argument stack. Normally, "
|
||||
"this should be empty unless the fiber signals while pushing arguments "
|
||||
"to make a function call. Returns a new array."},
|
||||
{"debug/stack", cfun_stack,
|
||||
"(debug/stack fib)\n\n"
|
||||
"Gets information about the stack as an array of tables. Each table "
|
||||
"in the array contains information about a stack frame. The top most, current "
|
||||
"stack frame is the first table in the array, and the bottom most stack frame "
|
||||
"is the last value. Each stack frame contains some of the following attributes:\n\n"
|
||||
"\t:c - true if the stack frame is a c function invocation\n"
|
||||
"\t:column - the current source column of the stack frame\n"
|
||||
"\t:function - the function that the stack frame represents\n"
|
||||
"\t:line - the current source line of the stack frame\n"
|
||||
"\t:name - the human friendly name of the function\n"
|
||||
"\t:pc - integer indicating the location of the program counter\n"
|
||||
"\t:source - string with filename or other identifier for the source code\n"
|
||||
"\t:slots - array of all values in each slot\n"
|
||||
"\t:tail - boolean indicating a tail call"
|
||||
{
|
||||
"debug/break", cfun_break,
|
||||
JDOC("(debug/break source byte-offset)\n\n"
|
||||
"Sets a breakpoint with source a key at a given byte offset. An offset "
|
||||
"of 0 is the first byte in a file. Will throw an error if the breakpoint location "
|
||||
"cannot be found. For example\n\n"
|
||||
"\t(debug/break \"core.janet\" 1000)\n\n"
|
||||
"wil set a breakpoint at the 1000th byte of the file core.janet.")
|
||||
},
|
||||
{"debug/lineage", cfun_lineage,
|
||||
"(debug/lineage fib)\n\n"
|
||||
"Returns an array of all child fibers from a root fiber. This function "
|
||||
"is useful when a fiber signals or errors to an ancestor fiber. Using this function, "
|
||||
"the fiber handling the error can see which fiber raised the signal. This function should "
|
||||
"be used mostly for debugging purposes."
|
||||
{
|
||||
"debug/unbreak", cfun_unbreak,
|
||||
JDOC("(debug/unbreak source byte-offset)\n\n"
|
||||
"Remove a breakpoint with a source key at a given byte offset. An offset "
|
||||
"of 0 is the first byte in a file. Will throw an error if the breakpoint "
|
||||
"cannot be found.")
|
||||
},
|
||||
{
|
||||
"debug/fbreak", cfun_fbreak,
|
||||
JDOC("(debug/fbreak fun [,pc=0])\n\n"
|
||||
"Set a breakpoint in a given function. pc is an optional offset, which "
|
||||
"is in bytecode instructions. fun is a function value. Will throw an error "
|
||||
"if the offset is too large or negative.")
|
||||
},
|
||||
{
|
||||
"debug/unfbreak", cfun_unfbreak,
|
||||
JDOC("(debug/unfbreak fun [,pc=0])\n\n"
|
||||
"Unset a breakpoint set with debug/fbreak.")
|
||||
},
|
||||
{
|
||||
"debug/arg-stack", cfun_argstack,
|
||||
JDOC("(debug/arg-stack fiber)\n\n"
|
||||
"Gets all values currently on the fiber's argument stack. Normally, "
|
||||
"this should be empty unless the fiber signals while pushing arguments "
|
||||
"to make a function call. Returns a new array.")
|
||||
},
|
||||
{
|
||||
"debug/stack", cfun_stack,
|
||||
JDOC("(debug/stack fib)\n\n"
|
||||
"Gets information about the stack as an array of tables. Each table "
|
||||
"in the array contains information about a stack frame. The top most, current "
|
||||
"stack frame is the first table in the array, and the bottom most stack frame "
|
||||
"is the last value. Each stack frame contains some of the following attributes:\n\n"
|
||||
"\t:c - true if the stack frame is a c function invocation\n"
|
||||
"\t:column - the current source column of the stack frame\n"
|
||||
"\t:function - the function that the stack frame represents\n"
|
||||
"\t:line - the current source line of the stack frame\n"
|
||||
"\t:name - the human friendly name of the function\n"
|
||||
"\t:pc - integer indicating the location of the program counter\n"
|
||||
"\t:source - string with the file path or other identifier for the source code\n"
|
||||
"\t:slots - array of all values in each slot\n"
|
||||
"\t:tail - boolean indicating a tail call")
|
||||
},
|
||||
{
|
||||
"debug/lineage", cfun_lineage,
|
||||
JDOC("(debug/lineage fib)\n\n"
|
||||
"Returns an array of all child fibers from a root fiber. This function "
|
||||
"is useful when a fiber signals or errors to an ancestor fiber. Using this function, "
|
||||
"the fiber handling the error can see which fiber raised the signal. This function should "
|
||||
"be used mostly for debugging purposes.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
/* Module entry point */
|
||||
int janet_lib_debug(JanetArgs args) {
|
||||
JanetTable *env = janet_env(args);
|
||||
void janet_lib_debug(JanetTable *env) {
|
||||
janet_cfuns(env, NULL, cfuns);
|
||||
return 0;
|
||||
}
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2018 Calvin Rose
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -61,7 +61,7 @@ static int32_t janetc_const(JanetCompiler *c, Janet x) {
|
||||
if (janet_equals(x, scope->consts[i]))
|
||||
return i;
|
||||
}
|
||||
/* Ensure not too many constsants. */
|
||||
/* Ensure not too many constants. */
|
||||
if (len >= 0xFFFF) {
|
||||
janetc_cerror(c, "too many constants");
|
||||
return 0;
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2018 Calvin Rose
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
193
src/core/fiber.c
193
src/core/fiber.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2018 Calvin Rose
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -24,6 +24,7 @@
|
||||
#include "fiber.h"
|
||||
#include "state.h"
|
||||
#include "gc.h"
|
||||
#include "util.h"
|
||||
|
||||
static JanetFiber *make_fiber(int32_t capacity) {
|
||||
Janet *data;
|
||||
@@ -50,8 +51,7 @@ static JanetFiber *make_fiber(int32_t capacity) {
|
||||
/* Initialize a new fiber */
|
||||
JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity) {
|
||||
JanetFiber *fiber = make_fiber(capacity);
|
||||
if (janet_fiber_funcframe(fiber, callee))
|
||||
janet_fiber_set_status(fiber, JANET_STATUS_ERROR);
|
||||
if (janet_fiber_funcframe(fiber, callee)) return NULL;
|
||||
return fiber;
|
||||
}
|
||||
|
||||
@@ -65,8 +65,7 @@ JanetFiber *janet_fiber_n(JanetFunction *callee, int32_t capacity, const Janet *
|
||||
}
|
||||
memcpy(fiber->data + fiber->stacktop, argv, argn * sizeof(Janet));
|
||||
fiber->stacktop = newstacktop;
|
||||
if (janet_fiber_funcframe(fiber, callee))
|
||||
janet_fiber_set_status(fiber, JANET_STATUS_ERROR);
|
||||
if (janet_fiber_funcframe(fiber, callee)) return NULL;
|
||||
return fiber;
|
||||
}
|
||||
|
||||
@@ -132,6 +131,13 @@ int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func) {
|
||||
int32_t nextstacktop = nextframe + func->def->slotcount + JANET_FRAME_SIZE;
|
||||
int32_t next_arity = fiber->stacktop - fiber->stackstart;
|
||||
|
||||
/* Check strict arity before messing with state */
|
||||
if (func->def->flags & JANET_FUNCDEF_FLAG_FIXARITY) {
|
||||
if (func->def->arity != next_arity) {
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
||||
if (fiber->capacity < nextstacktop) {
|
||||
janet_fiber_setcapacity(fiber, 2 * nextstacktop);
|
||||
}
|
||||
@@ -163,13 +169,6 @@ int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func) {
|
||||
}
|
||||
}
|
||||
|
||||
/* Check strict arity AFTER getting fiber to valid state. */
|
||||
if (func->def->flags & JANET_FUNCDEF_FLAG_FIXARITY) {
|
||||
if (func->def->arity != next_arity) {
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
||||
/* Good return */
|
||||
return 0;
|
||||
}
|
||||
@@ -198,6 +197,13 @@ int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func) {
|
||||
int32_t next_arity = fiber->stacktop - fiber->stackstart;
|
||||
int32_t stacksize;
|
||||
|
||||
/* Check strict arity before messing with state */
|
||||
if (func->def->flags & JANET_FUNCDEF_FLAG_FIXARITY) {
|
||||
if (func->def->arity != next_arity) {
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
||||
if (fiber->capacity < nextstacktop) {
|
||||
janet_fiber_setcapacity(fiber, 2 * nextstacktop);
|
||||
}
|
||||
@@ -205,7 +211,7 @@ int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func) {
|
||||
Janet *stack = fiber->data + fiber->frame;
|
||||
Janet *args = fiber->data + fiber->stackstart;
|
||||
|
||||
/* Detatch old function */
|
||||
/* Detach old function */
|
||||
if (NULL != janet_fiber_frame(fiber)->func)
|
||||
janet_env_detach(janet_fiber_frame(fiber)->env);
|
||||
janet_fiber_frame(fiber)->env = NULL;
|
||||
@@ -241,13 +247,6 @@ int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func) {
|
||||
janet_fiber_frame(fiber)->pc = func->def->bytecode;
|
||||
janet_fiber_frame(fiber)->flags |= JANET_STACKFRAME_TAILCALL;
|
||||
|
||||
/* Check strict arity AFTER getting fiber to valid state. */
|
||||
if (func->def->flags & JANET_FUNCDEF_FLAG_FIXARITY) {
|
||||
if (func->def->arity != next_arity) {
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
||||
/* Good return */
|
||||
return 0;
|
||||
}
|
||||
@@ -294,32 +293,28 @@ void janet_fiber_popframe(JanetFiber *fiber) {
|
||||
|
||||
/* CFuns */
|
||||
|
||||
static int cfun_new(JanetArgs args) {
|
||||
static Janet cfun_new(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetFunction *func = janet_getfunction(argv, 0);
|
||||
JanetFiber *fiber;
|
||||
JanetFunction *func;
|
||||
JANET_MINARITY(args, 1);
|
||||
JANET_MAXARITY(args, 2);
|
||||
JANET_ARG_FUNCTION(func, args, 0);
|
||||
if (func->def->flags & JANET_FUNCDEF_FLAG_FIXARITY) {
|
||||
if (func->def->arity != 0) {
|
||||
JANET_THROW(args, "expected nullary function in fiber constructor");
|
||||
janet_panic("expected nullary function in fiber constructor");
|
||||
}
|
||||
}
|
||||
fiber = janet_fiber(func, 64);
|
||||
if (args.n == 2) {
|
||||
const uint8_t *flags;
|
||||
int32_t len, i;
|
||||
JANET_ARG_BYTES(flags, len, args, 1);
|
||||
if (argc == 2) {
|
||||
int32_t i;
|
||||
JanetByteView view = janet_getbytes(argv, 1);
|
||||
fiber->flags = 0;
|
||||
janet_fiber_set_status(fiber, JANET_STATUS_NEW);
|
||||
for (i = 0; i < len; i++) {
|
||||
if (flags[i] >= '0' && flags[i] <= '9') {
|
||||
fiber->flags |= JANET_FIBER_MASK_USERN(flags[i] - '0');
|
||||
for (i = 0; i < view.len; i++) {
|
||||
if (view.bytes[i] >= '0' && view.bytes[i] <= '9') {
|
||||
fiber->flags |= JANET_FIBER_MASK_USERN(view.bytes[i] - '0');
|
||||
} else {
|
||||
switch (flags[i]) {
|
||||
switch (view.bytes[i]) {
|
||||
default:
|
||||
JANET_THROW(args, "invalid flag, expected a, d, e, u, or y");
|
||||
case ':':
|
||||
janet_panicf("invalid flag %c, expected a, d, e, u, or y", view.bytes[i]);
|
||||
break;
|
||||
case 'a':
|
||||
fiber->flags |=
|
||||
@@ -344,93 +339,93 @@ static int cfun_new(JanetArgs args) {
|
||||
}
|
||||
}
|
||||
}
|
||||
JANET_RETURN_FIBER(args, fiber);
|
||||
return janet_wrap_fiber(fiber);
|
||||
}
|
||||
|
||||
static int cfun_status(JanetArgs args) {
|
||||
JanetFiber *fiber;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_ARG_FIBER(fiber, args, 0);
|
||||
static Janet cfun_status(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
uint32_t s = (fiber->flags & JANET_FIBER_STATUS_MASK) >>
|
||||
JANET_FIBER_STATUS_OFFSET;
|
||||
JANET_RETURN_CSYMBOL(args, janet_status_names[s]);
|
||||
return janet_ckeywordv(janet_status_names[s]);
|
||||
}
|
||||
|
||||
static int cfun_current(JanetArgs args) {
|
||||
JANET_FIXARITY(args, 0);
|
||||
JANET_RETURN_FIBER(args, janet_vm_fiber);
|
||||
static Janet cfun_current(int32_t argc, Janet *argv) {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
return janet_wrap_fiber(janet_vm_fiber);
|
||||
}
|
||||
|
||||
static int cfun_maxstack(JanetArgs args) {
|
||||
JanetFiber *fiber;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_ARG_FIBER(fiber, args, 0);
|
||||
JANET_RETURN_INTEGER(args, fiber->maxstack);
|
||||
static Janet cfun_maxstack(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
return janet_wrap_integer(fiber->maxstack);
|
||||
}
|
||||
|
||||
static int cfun_setmaxstack(JanetArgs args) {
|
||||
JanetFiber *fiber;
|
||||
int32_t maxs;
|
||||
JANET_FIXARITY(args, 2);
|
||||
JANET_ARG_FIBER(fiber, args, 0);
|
||||
JANET_ARG_INTEGER(maxs, args, 1);
|
||||
static Janet cfun_setmaxstack(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
int32_t maxs = janet_getinteger(argv, 1);
|
||||
if (maxs < 0) {
|
||||
JANET_THROW(args, "expected positive integer");
|
||||
janet_panic("expected positive integer");
|
||||
}
|
||||
fiber->maxstack = maxs;
|
||||
JANET_RETURN_FIBER(args, fiber);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static const JanetReg cfuns[] = {
|
||||
{"fiber/new", cfun_new,
|
||||
"(fiber/new func [,sigmask])\n\n"
|
||||
"Create a new fiber with function body func. Can optionally "
|
||||
"take a set of signals to block from the current parent fiber "
|
||||
"when called. The mask is specified as a symbol where each character "
|
||||
"is used to indicate a signal to block. The default sigmask is :y. "
|
||||
"For example, \n\n"
|
||||
"\t(fiber/new myfun :e123)\n\n"
|
||||
"blocks error signals and user signals 1, 2 and 3. The signals are "
|
||||
"as follows: \n\n"
|
||||
"\ta - block all signals\n"
|
||||
"\td - block debug signals\n"
|
||||
"\te - block error signals\n"
|
||||
"\tu - block user signals\n"
|
||||
"\ty - block yield signals\n"
|
||||
"\t0-9 - block a specific user signal"
|
||||
{
|
||||
"fiber/new", cfun_new,
|
||||
JDOC("(fiber/new func [,sigmask])\n\n"
|
||||
"Create a new fiber with function body func. Can optionally "
|
||||
"take a set of signals to block from the current parent fiber "
|
||||
"when called. The mask is specified as a keyword where each character "
|
||||
"is used to indicate a signal to block. The default sigmask is :y. "
|
||||
"For example, \n\n"
|
||||
"\t(fiber/new myfun :e123)\n\n"
|
||||
"blocks error signals and user signals 1, 2 and 3. The signals are "
|
||||
"as follows: \n\n"
|
||||
"\ta - block all signals\n"
|
||||
"\td - block debug signals\n"
|
||||
"\te - block error signals\n"
|
||||
"\tu - block user signals\n"
|
||||
"\ty - block yield signals\n"
|
||||
"\t0-9 - block a specific user signal")
|
||||
},
|
||||
{"fiber/status", cfun_status,
|
||||
"(fiber/status fib)\n\n"
|
||||
"Get the status of a fiber. The status will be one of:\n\n"
|
||||
"\t:dead - the fiber has finished\n"
|
||||
"\t:error - the fiber has errored out\n"
|
||||
"\t:debug - the fiber is suspended in debug mode\n"
|
||||
"\t:pending - the fiber has been yielded\n"
|
||||
"\t:user(0-9) - the fiber is suspended by a user signal\n"
|
||||
"\t:alive - the fiber is currently running and cannot be resumed\n"
|
||||
"\t:new - the fiber has just been created and not yet run"
|
||||
{
|
||||
"fiber/status", cfun_status,
|
||||
JDOC("(fiber/status fib)\n\n"
|
||||
"Get the status of a fiber. The status will be one of:\n\n"
|
||||
"\t:dead - the fiber has finished\n"
|
||||
"\t:error - the fiber has errored out\n"
|
||||
"\t:debug - the fiber is suspended in debug mode\n"
|
||||
"\t:pending - the fiber has been yielded\n"
|
||||
"\t:user(0-9) - the fiber is suspended by a user signal\n"
|
||||
"\t:alive - the fiber is currently running and cannot be resumed\n"
|
||||
"\t:new - the fiber has just been created and not yet run")
|
||||
},
|
||||
{"fiber/current", cfun_current,
|
||||
"(fiber/current)\n\n"
|
||||
"Returns the currently running fiber."
|
||||
{
|
||||
"fiber/current", cfun_current,
|
||||
JDOC("(fiber/current)\n\n"
|
||||
"Returns the currently running fiber.")
|
||||
},
|
||||
{"fiber/maxstack", cfun_maxstack,
|
||||
"(fiber/maxstack fib)\n\n"
|
||||
"Gets the maximum stack size in janet values allowed for a fiber. While memory for "
|
||||
"the fiber's stack is not allocated up front, the fiber will not allocated more "
|
||||
"than this amount and will throw a stackoverflow error if more memory is needed. "
|
||||
{
|
||||
"fiber/maxstack", cfun_maxstack,
|
||||
JDOC("(fiber/maxstack fib)\n\n"
|
||||
"Gets the maximum stack size in janet values allowed for a fiber. While memory for "
|
||||
"the fiber's stack is not allocated up front, the fiber will not allocated more "
|
||||
"than this amount and will throw a stack-overflow error if more memory is needed. ")
|
||||
},
|
||||
{"fiber/setmaxstack", cfun_setmaxstack,
|
||||
"(fiber/setmaxstack fib maxstack)\n\n"
|
||||
"Sets the maximum stack size in janet values for a fiber. By default, the "
|
||||
"maximum stacksize is usually 8192."
|
||||
{
|
||||
"fiber/setmaxstack", cfun_setmaxstack,
|
||||
JDOC("(fiber/setmaxstack fib maxstack)\n\n"
|
||||
"Sets the maximum stack size in janet values for a fiber. By default, the "
|
||||
"maximum stack size is usually 8192.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
/* Module entry point */
|
||||
int janet_lib_fiber(JanetArgs args) {
|
||||
JanetTable *env = janet_env(args);
|
||||
void janet_lib_fiber(JanetTable *env) {
|
||||
janet_cfuns(env, NULL, cfuns);
|
||||
return 0;
|
||||
}
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2018 Calvin Rose
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2018 Calvin Rose
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -60,6 +60,7 @@ void janet_mark(Janet x) {
|
||||
switch (janet_type(x)) {
|
||||
default: break;
|
||||
case JANET_STRING:
|
||||
case JANET_KEYWORD:
|
||||
case JANET_SYMBOL: janet_mark_string(janet_unwrap_string(x)); break;
|
||||
case JANET_FUNCTION: janet_mark_function(janet_unwrap_function(x)); break;
|
||||
case JANET_ARRAY: janet_mark_array(janet_unwrap_array(x)); break;
|
||||
@@ -195,6 +196,11 @@ recur:
|
||||
if (janet_gc_reachable(fiber))
|
||||
return;
|
||||
janet_gc_mark(fiber);
|
||||
|
||||
/* Mark values on the argument stack */
|
||||
janet_mark_many(fiber->data + fiber->stackstart,
|
||||
fiber->stacktop - fiber->stackstart);
|
||||
|
||||
i = fiber->frame;
|
||||
j = fiber->stackstart - JANET_FRAME_SIZE;
|
||||
while (i > 0) {
|
||||
@@ -358,7 +364,7 @@ static int janet_gc_idequals(Janet lhs, Janet rhs) {
|
||||
case JANET_FALSE:
|
||||
case JANET_NIL:
|
||||
case JANET_NUMBER:
|
||||
/* These values don't really matter to the gc so returning 1 al the time is fine. */
|
||||
/* These values don't really matter to the gc so returning 1 all the time is fine. */
|
||||
return 1;
|
||||
default:
|
||||
return janet_unwrap_pointer(lhs) == janet_unwrap_pointer(rhs);
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2018 Calvin Rose
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
433
src/core/io.c
433
src/core/io.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2018 Calvin Rose
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -27,6 +27,7 @@
|
||||
#include <stdio.h>
|
||||
#include <janet/janet.h>
|
||||
#include <errno.h>
|
||||
#include "util.h"
|
||||
|
||||
#define IO_WRITE 1
|
||||
#define IO_READ 2
|
||||
@@ -47,19 +48,22 @@ struct IOFile {
|
||||
static int janet_io_gc(void *p, size_t len);
|
||||
|
||||
JanetAbstractType janet_io_filetype = {
|
||||
":core/file",
|
||||
"core/file",
|
||||
janet_io_gc,
|
||||
NULL
|
||||
};
|
||||
|
||||
/* Check argupments to fopen */
|
||||
static int checkflags(const uint8_t *str, int32_t len) {
|
||||
/* Check arguments to fopen */
|
||||
static int checkflags(const uint8_t *str) {
|
||||
int flags = 0;
|
||||
int32_t i;
|
||||
if (!len || len > 3) return -1;
|
||||
int32_t len = janet_string_length(str);
|
||||
if (!len || len > 3)
|
||||
janet_panic("file mode must have a length between 1 and 3");
|
||||
switch (*str) {
|
||||
default:
|
||||
return -1;
|
||||
janet_panicf("invalid flag %c, expected w, a, or r", *str);
|
||||
break;
|
||||
case 'w':
|
||||
flags |= IO_WRITE;
|
||||
break;
|
||||
@@ -73,7 +77,8 @@ static int checkflags(const uint8_t *str, int32_t len) {
|
||||
for (i = 1; i < len; i++) {
|
||||
switch (str[i]) {
|
||||
default:
|
||||
return -1;
|
||||
janet_panicf("invalid flag %c, expected + or b", str[i]);
|
||||
break;
|
||||
case '+':
|
||||
if (flags & IO_UPDATE) return -1;
|
||||
flags |= IO_UPDATE;
|
||||
@@ -87,41 +92,6 @@ static int checkflags(const uint8_t *str, int32_t len) {
|
||||
return flags;
|
||||
}
|
||||
|
||||
/* Check file argument */
|
||||
static IOFile *checkfile(JanetArgs args, int32_t n) {
|
||||
IOFile *iof;
|
||||
if (n >= args.n) {
|
||||
*args.ret = janet_cstringv("expected core.file");
|
||||
return NULL;
|
||||
}
|
||||
if (!janet_checktype(args.v[n], JANET_ABSTRACT)) {
|
||||
*args.ret = janet_cstringv("expected core.file");
|
||||
return NULL;
|
||||
}
|
||||
iof = (IOFile *) janet_unwrap_abstract(args.v[n]);
|
||||
if (janet_abstract_type(iof) != &janet_io_filetype) {
|
||||
*args.ret = janet_cstringv("expected core.file");
|
||||
return NULL;
|
||||
}
|
||||
return iof;
|
||||
}
|
||||
|
||||
/* Check buffer argument */
|
||||
static JanetBuffer *checkbuffer(JanetArgs args, int32_t n, int optional) {
|
||||
if (optional && n == args.n) {
|
||||
return janet_buffer(0);
|
||||
}
|
||||
if (n >= args.n) {
|
||||
*args.ret = janet_cstringv("expected buffer");
|
||||
return NULL;
|
||||
}
|
||||
if (!janet_checktype(args.v[n], JANET_BUFFER)) {
|
||||
*args.ret = janet_cstringv("expected buffer");
|
||||
return NULL;
|
||||
}
|
||||
return janet_unwrap_abstract(args.v[n]);
|
||||
}
|
||||
|
||||
static Janet makef(FILE *f, int flags) {
|
||||
IOFile *iof = (IOFile *) janet_abstract(&janet_io_filetype, sizeof(IOFile));
|
||||
iof->file = f;
|
||||
@@ -130,176 +100,147 @@ static Janet makef(FILE *f, int flags) {
|
||||
}
|
||||
|
||||
/* Open a process */
|
||||
static int janet_io_popen(JanetArgs args) {
|
||||
const uint8_t *fname, *fmode;
|
||||
int32_t modelen;
|
||||
FILE *f;
|
||||
int flags;
|
||||
JANET_MINARITY(args, 1);
|
||||
JANET_MAXARITY(args, 2);
|
||||
JANET_ARG_STRING(fname, args, 0);
|
||||
if (args.n == 2) {
|
||||
if (!janet_checktype(args.v[1], JANET_STRING) &&
|
||||
!janet_checktype(args.v[1], JANET_SYMBOL))
|
||||
JANET_THROW(args, "expected string mode");
|
||||
fmode = janet_unwrap_string(args.v[1]);
|
||||
modelen = janet_string_length(fmode);
|
||||
} else {
|
||||
fmode = (const uint8_t *)"r";
|
||||
modelen = 1;
|
||||
#ifdef __EMSCRIPTEN__
|
||||
static Janet janet_io_popen(int32_t argc, Janet *argv) {
|
||||
(void) argc;
|
||||
(void) argv;
|
||||
janet_panic("not implemented on this platform");
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
#else
|
||||
static Janet janet_io_popen(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
const uint8_t *fname = janet_getstring(argv, 0);
|
||||
const uint8_t *fmode = NULL;
|
||||
if (argc == 2) {
|
||||
fmode = janet_getkeyword(argv, 1);
|
||||
if (janet_string_length(fmode) != 1 ||
|
||||
!(fmode[0] == 'r' || fmode[0] == 'w')) {
|
||||
janet_panicf("invalid file mode :%S, expected :r or :w", fmode);
|
||||
}
|
||||
}
|
||||
if (fmode[0] == ':') {
|
||||
fmode++;
|
||||
modelen--;
|
||||
}
|
||||
if (modelen != 1 || !(fmode[0] == 'r' || fmode[0] == 'w')) {
|
||||
JANET_THROW(args, "invalid file mode");
|
||||
}
|
||||
flags = (fmode[0] == 'r') ? IO_PIPED | IO_READ : IO_PIPED | IO_WRITE;
|
||||
int flags = (fmode && fmode[0] == '2')
|
||||
? IO_PIPED | IO_WRITE
|
||||
: IO_PIPED | IO_READ;
|
||||
#ifdef JANET_WINDOWS
|
||||
#define popen _popen
|
||||
#endif
|
||||
#ifdef __EMSCRIPTEN__
|
||||
#define popen(A, B) (errno = 0, NULL)
|
||||
#endif
|
||||
f = popen((const char *)fname, (const char *)fmode);
|
||||
FILE *f = popen((const char *)fname, (const char *)fmode);
|
||||
if (!f) {
|
||||
if (errno == EMFILE) {
|
||||
JANET_THROW(args, "too many streams are open");
|
||||
}
|
||||
JANET_THROW(args, "could not open file");
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
JANET_RETURN(args, makef(f, flags));
|
||||
return makef(f, flags);
|
||||
}
|
||||
#endif
|
||||
|
||||
/* Open a a file and return a userdata wrapper around the C file API. */
|
||||
static int janet_io_fopen(JanetArgs args) {
|
||||
const uint8_t *fname, *fmode;
|
||||
int32_t modelen;
|
||||
FILE *f;
|
||||
static Janet janet_io_fopen(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
const uint8_t *fname = janet_getstring(argv, 0);
|
||||
const uint8_t *fmode;
|
||||
int flags;
|
||||
JANET_MINARITY(args, 1);
|
||||
JANET_MAXARITY(args, 2);
|
||||
JANET_ARG_STRING(fname, args, 0);
|
||||
if (args.n == 2) {
|
||||
if (!janet_checktype(args.v[1], JANET_STRING) &&
|
||||
!janet_checktype(args.v[1], JANET_SYMBOL))
|
||||
JANET_THROW(args, "expected string mode");
|
||||
fmode = janet_unwrap_string(args.v[1]);
|
||||
modelen = janet_string_length(fmode);
|
||||
if (argc == 2) {
|
||||
fmode = janet_getkeyword(argv, 1);
|
||||
flags = checkflags(fmode);
|
||||
} else {
|
||||
fmode = (const uint8_t *)"r";
|
||||
modelen = 1;
|
||||
flags = IO_READ;
|
||||
}
|
||||
if (fmode[0] == ':') {
|
||||
fmode++;
|
||||
modelen--;
|
||||
}
|
||||
if ((flags = checkflags(fmode, modelen)) < 0) {
|
||||
JANET_THROW(args, "invalid file mode");
|
||||
}
|
||||
f = fopen((const char *)fname, (const char *)fmode);
|
||||
JANET_RETURN(args, f ? makef(f, flags) : janet_wrap_nil());
|
||||
FILE *f = fopen((const char *)fname, (const char *)fmode);
|
||||
return f ? makef(f, flags) : janet_wrap_nil();
|
||||
}
|
||||
|
||||
/* Read up to n bytes into buffer. Return error string if error. */
|
||||
static const char *read_chunk(IOFile *iof, JanetBuffer *buffer, int32_t nBytesMax) {
|
||||
static void read_chunk(IOFile *iof, JanetBuffer *buffer, int32_t nBytesMax) {
|
||||
if (!(iof->flags & (IO_READ | IO_UPDATE)))
|
||||
return "file is not readable";
|
||||
/* Ensure buffer size */
|
||||
if (janet_buffer_extra(buffer, nBytesMax))
|
||||
return "buffer overflow";
|
||||
janet_panic("file is not readable");
|
||||
janet_buffer_extra(buffer, nBytesMax);
|
||||
size_t ntoread = nBytesMax;
|
||||
size_t nread = fread((char *)(buffer->data + buffer->count), 1, ntoread, iof->file);
|
||||
if (nread != ntoread && ferror(iof->file))
|
||||
return "could not read file";
|
||||
janet_panic("could not read file");
|
||||
buffer->count += (int32_t) nread;
|
||||
return NULL;
|
||||
}
|
||||
|
||||
/* Read a certain number of bytes into memory */
|
||||
static int janet_io_fread(JanetArgs args) {
|
||||
JanetBuffer *b;
|
||||
IOFile *iof = checkfile(args, 0);
|
||||
if (!iof) return 1;
|
||||
if (iof->flags & IO_CLOSED)
|
||||
JANET_THROW(args, "file is closed");
|
||||
b = checkbuffer(args, 2, 1);
|
||||
if (!b) return 1;
|
||||
if (janet_checktype(args.v[1], JANET_SYMBOL)) {
|
||||
const uint8_t *sym = janet_unwrap_symbol(args.v[1]);
|
||||
if (!janet_cstrcmp(sym, ":all")) {
|
||||
static Janet janet_io_fread(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 3);
|
||||
IOFile *iof = janet_getabstract(argv, 0, &janet_io_filetype);
|
||||
if (iof->flags & IO_CLOSED) janet_panic("file is closed");
|
||||
JanetBuffer *buffer;
|
||||
if (argc == 2) {
|
||||
buffer = janet_buffer(0);
|
||||
} else {
|
||||
buffer = janet_getbuffer(argv, 2);
|
||||
}
|
||||
if (janet_checktype(argv[1], JANET_KEYWORD)) {
|
||||
const uint8_t *sym = janet_unwrap_keyword(argv[1]);
|
||||
if (!janet_cstrcmp(sym, "all")) {
|
||||
/* Read whole file */
|
||||
int status = fseek(iof->file, 0, SEEK_SET);
|
||||
if (status) {
|
||||
/* backwards fseek did not work (stream like popen) */
|
||||
int32_t sizeBefore;
|
||||
do {
|
||||
sizeBefore = b->count;
|
||||
const char *maybeErr = read_chunk(iof, b, 1024);
|
||||
if (maybeErr) JANET_THROW(args, maybeErr);
|
||||
} while (sizeBefore < b->count);
|
||||
sizeBefore = buffer->count;
|
||||
read_chunk(iof, buffer, 1024);
|
||||
} while (sizeBefore < buffer->count);
|
||||
} else {
|
||||
fseek(iof->file, 0, SEEK_END);
|
||||
long fsize = ftell(iof->file);
|
||||
fseek(iof->file, 0, SEEK_SET);
|
||||
if (fsize > INT32_MAX) JANET_THROW(args, "buffer overflow");
|
||||
const char *maybeErr = read_chunk(iof, b, (int32_t) fsize);;
|
||||
if (maybeErr) JANET_THROW(args, maybeErr);
|
||||
read_chunk(iof, buffer, (int32_t) fsize);
|
||||
}
|
||||
} else if (!janet_cstrcmp(sym, ":line")) {
|
||||
} else if (!janet_cstrcmp(sym, "line")) {
|
||||
for (;;) {
|
||||
int x = fgetc(iof->file);
|
||||
if (x != EOF && janet_buffer_push_u8(b, (uint8_t)x))
|
||||
JANET_THROW(args, "buffer overflow");
|
||||
if (x != EOF) janet_buffer_push_u8(buffer, (uint8_t)x);
|
||||
if (x == EOF || x == '\n') break;
|
||||
}
|
||||
} else {
|
||||
JANET_THROW(args, "expected one of :all, :line");
|
||||
janet_panicf("expected one of :all, :line, got %v", argv[1]);
|
||||
}
|
||||
} else if (!janet_checkint(args.v[1])) {
|
||||
JANET_THROW(args, "expected positive integer");
|
||||
} else {
|
||||
int32_t len = janet_unwrap_integer(args.v[1]);
|
||||
if (len < 0) JANET_THROW(args, "expected positive integer");
|
||||
const char *maybeErr = read_chunk(iof, b, len);
|
||||
if (maybeErr) JANET_THROW(args, maybeErr);
|
||||
int32_t len = janet_getinteger(argv, 1);
|
||||
if (len < 0) janet_panic("expected positive integer");
|
||||
read_chunk(iof, buffer, len);
|
||||
}
|
||||
JANET_RETURN(args, janet_wrap_buffer(b));
|
||||
return janet_wrap_buffer(buffer);
|
||||
}
|
||||
|
||||
/* Write bytes to a file */
|
||||
static int janet_io_fwrite(JanetArgs args) {
|
||||
int32_t len, i;
|
||||
const uint8_t *str;
|
||||
IOFile *iof = checkfile(args, 0);
|
||||
if (!iof) return 1;
|
||||
static Janet janet_io_fwrite(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, -1);
|
||||
IOFile *iof = janet_getabstract(argv, 0, &janet_io_filetype);
|
||||
if (iof->flags & IO_CLOSED)
|
||||
JANET_THROW(args, "file is closed");
|
||||
janet_panic("file is closed");
|
||||
if (!(iof->flags & (IO_WRITE | IO_APPEND | IO_UPDATE)))
|
||||
JANET_THROW(args, "file is not writeable");
|
||||
for (i = 1; i < args.n; i++) {
|
||||
JANET_CHECKMANY(args, i, JANET_TFLAG_BYTES);
|
||||
}
|
||||
for (i = 1; i < args.n; i++) {
|
||||
JANET_ARG_BYTES(str, len, args, i);
|
||||
if (len) {
|
||||
if (!fwrite(str, len, 1, iof->file)) JANET_THROW(args, "error writing to file");
|
||||
janet_panic("file is not writeable");
|
||||
int32_t i;
|
||||
/* Verify all arguments before writing to file */
|
||||
for (i = 1; i < argc; i++)
|
||||
janet_getbytes(argv, i);
|
||||
for (i = 1; i < argc; i++) {
|
||||
JanetByteView view = janet_getbytes(argv, i);
|
||||
if (view.len) {
|
||||
if (!fwrite(view.bytes, view.len, 1, iof->file)) {
|
||||
janet_panic("error writing to file");
|
||||
}
|
||||
}
|
||||
}
|
||||
JANET_RETURN(args, janet_wrap_abstract(iof));
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
/* Flush the bytes in the file */
|
||||
static int janet_io_fflush(JanetArgs args) {
|
||||
IOFile *iof = checkfile(args, 0);
|
||||
if (!iof) return 1;
|
||||
static Janet janet_io_fflush(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
IOFile *iof = janet_getabstract(argv, 0, &janet_io_filetype);
|
||||
if (iof->flags & IO_CLOSED)
|
||||
JANET_THROW(args, "file is closed");
|
||||
janet_panic("file is closed");
|
||||
if (!(iof->flags & (IO_WRITE | IO_APPEND | IO_UPDATE)))
|
||||
JANET_THROW(args, "file is not flushable");
|
||||
if (fflush(iof->file)) JANET_THROW(args, "could not flush file");
|
||||
JANET_RETURN(args, janet_wrap_abstract(iof));
|
||||
janet_panic("file is not writeable");
|
||||
if (fflush(iof->file))
|
||||
janet_panic("could not flush file");
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
/* Cleanup a file */
|
||||
@@ -313,139 +254,133 @@ static int janet_io_gc(void *p, size_t len) {
|
||||
}
|
||||
|
||||
/* Close a file */
|
||||
static int janet_io_fclose(JanetArgs args) {
|
||||
IOFile *iof = checkfile(args, 0);
|
||||
if (!iof) return 1;
|
||||
if (iof->flags & (IO_CLOSED))
|
||||
JANET_THROW(args, "file already closed");
|
||||
static Janet janet_io_fclose(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
IOFile *iof = janet_getabstract(argv, 0, &janet_io_filetype);
|
||||
if (iof->flags & IO_CLOSED)
|
||||
janet_panic("file is closed");
|
||||
if (iof->flags & (IO_NOT_CLOSEABLE))
|
||||
JANET_THROW(args, "file not closable");
|
||||
janet_panic("file not closable");
|
||||
if (iof->flags & IO_PIPED) {
|
||||
#ifdef JANET_WINDOWS
|
||||
#define pclose _pclose
|
||||
#endif
|
||||
if (pclose(iof->file)) JANET_THROW(args, "could not close file");
|
||||
if (pclose(iof->file)) janet_panic("could not close file");
|
||||
} else {
|
||||
if (fclose(iof->file)) JANET_THROW(args, "could not close file");
|
||||
if (fclose(iof->file)) janet_panic("could not close file");
|
||||
}
|
||||
iof->flags |= IO_CLOSED;
|
||||
JANET_RETURN(args, janet_wrap_abstract(iof));
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
/* Seek a file */
|
||||
static int janet_io_fseek(JanetArgs args) {
|
||||
static Janet janet_io_fseek(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 3);
|
||||
IOFile *iof = janet_getabstract(argv, 0, &janet_io_filetype);
|
||||
if (iof->flags & IO_CLOSED)
|
||||
janet_panic("file is closed");
|
||||
long int offset = 0;
|
||||
int whence = SEEK_CUR;
|
||||
IOFile *iof = checkfile(args, 0);
|
||||
if (!iof) return 1;
|
||||
if (iof->flags & IO_CLOSED)
|
||||
JANET_THROW(args, "file is closed");
|
||||
if (args.n >= 2) {
|
||||
const uint8_t *whence_sym;
|
||||
if (!janet_checktype(args.v[1], JANET_SYMBOL))
|
||||
JANET_THROW(args, "expected symbol");
|
||||
whence_sym = janet_unwrap_symbol(args.v[1]);
|
||||
if (!janet_cstrcmp(whence_sym, ":cur")) {
|
||||
if (argc >= 2) {
|
||||
const uint8_t *whence_sym = janet_getkeyword(argv, 1);
|
||||
if (!janet_cstrcmp(whence_sym, "cur")) {
|
||||
whence = SEEK_CUR;
|
||||
} else if (!janet_cstrcmp(whence_sym, ":set")) {
|
||||
} else if (!janet_cstrcmp(whence_sym, "set")) {
|
||||
whence = SEEK_SET;
|
||||
} else if (!janet_cstrcmp(whence_sym, ":end")) {
|
||||
} else if (!janet_cstrcmp(whence_sym, "end")) {
|
||||
whence = SEEK_END;
|
||||
} else {
|
||||
JANET_THROW(args, "expected one of :cur, :set, :end");
|
||||
janet_panicf("expected one of :cur, :set, :end, got %v", argv[1]);
|
||||
}
|
||||
if (args.n >= 3) {
|
||||
double doffset;
|
||||
JANET_ARG_NUMBER(doffset, args, 2);
|
||||
offset = (long int)doffset;
|
||||
if (argc == 3) {
|
||||
offset = (long) janet_getinteger64(argv, 2);
|
||||
}
|
||||
}
|
||||
if (fseek(iof->file, offset, whence))
|
||||
JANET_THROW(args, "error seeking file");
|
||||
JANET_RETURN(args, args.v[0]);
|
||||
if (fseek(iof->file, offset, whence)) janet_panic("error seeking file");
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static const JanetReg cfuns[] = {
|
||||
{"file/open", janet_io_fopen,
|
||||
"(file/open path [,mode])\n\n"
|
||||
"Open a file. path is files absolute or relative path, and "
|
||||
"mode is a set of flags indicating the mode to open the file in. "
|
||||
"mode is a keyword where each character represents a flag. If the file "
|
||||
"cannot be opened, returns nil, otherwise returns the new file handle. "
|
||||
"Mode flags:\n\n"
|
||||
"\tr - allow reading from the file\n"
|
||||
"\tw - allow witing to the file\n"
|
||||
"\ta - append to the file\n"
|
||||
"\tb - open the file in binary mode (rather than text mode)\n"
|
||||
"\t+ - append to the file instead of overwriting it"
|
||||
{
|
||||
"file/open", janet_io_fopen,
|
||||
JDOC("(file/open path [,mode])\n\n"
|
||||
"Open a file. path is an absolute or relative path, and "
|
||||
"mode is a set of flags indicating the mode to open the file in. "
|
||||
"mode is a keyword where each character represents a flag. If the file "
|
||||
"cannot be opened, returns nil, otherwise returns the new file handle. "
|
||||
"Mode flags:\n\n"
|
||||
"\tr - allow reading from the file\n"
|
||||
"\tw - allow writing to the file\n"
|
||||
"\ta - append to the file\n"
|
||||
"\tb - open the file in binary mode (rather than text mode)\n"
|
||||
"\t+ - append to the file instead of overwriting it")
|
||||
},
|
||||
{"file/close", janet_io_fclose,
|
||||
"(file/close f)\n\n"
|
||||
"Close a file and release all related resources. When you are "
|
||||
"done reading a file, close it to prevent a resource leak and let "
|
||||
"other processes read the file."
|
||||
{
|
||||
"file/close", janet_io_fclose,
|
||||
JDOC("(file/close f)\n\n"
|
||||
"Close a file and release all related resources. When you are "
|
||||
"done reading a file, close it to prevent a resource leak and let "
|
||||
"other processes read the file.")
|
||||
},
|
||||
{"file/read", janet_io_fread,
|
||||
"(file/read f what [,buf])\n\n"
|
||||
"Read a number of bytes from a file into a buffer. A buffer can "
|
||||
"be provided as an optional fourth argument. otherwise a new buffer "
|
||||
"is created. 'what' can either be an integer or a keyword. Returns the "
|
||||
"buffer with file contents. "
|
||||
"Values for 'what':\n\n"
|
||||
"\t:all - read the whole file\n"
|
||||
"\t:line - read up to and including the next newline character\n"
|
||||
"\tn (integer) - read up to n bytes from the file"
|
||||
{
|
||||
"file/read", janet_io_fread,
|
||||
JDOC("(file/read f what [,buf])\n\n"
|
||||
"Read a number of bytes from a file into a buffer. A buffer can "
|
||||
"be provided as an optional fourth argument, otherwise a new buffer "
|
||||
"is created. 'what' can either be an integer or a keyword. Returns the "
|
||||
"buffer with file contents. "
|
||||
"Values for 'what':\n\n"
|
||||
"\t:all - read the whole file\n"
|
||||
"\t:line - read up to and including the next newline character\n"
|
||||
"\tn (integer) - read up to n bytes from the file")
|
||||
},
|
||||
{"file/write", janet_io_fwrite,
|
||||
"(file/write f bytes)\n\n"
|
||||
"Writes to a file. 'bytes' must be string, buffer, or symbol. Returns the "
|
||||
"file"
|
||||
{
|
||||
"file/write", janet_io_fwrite,
|
||||
JDOC("(file/write f bytes)\n\n"
|
||||
"Writes to a file. 'bytes' must be string, buffer, or symbol. Returns the "
|
||||
"file.")
|
||||
},
|
||||
{"file/flush", janet_io_fflush,
|
||||
"(file/flush f)\n\n"
|
||||
"Flush any buffered bytes to the filesystem. In most files, writes are "
|
||||
"buffered for efficiency reasons. Returns the file handle."
|
||||
{
|
||||
"file/flush", janet_io_fflush,
|
||||
JDOC("(file/flush f)\n\n"
|
||||
"Flush any buffered bytes to the file system. In most files, writes are "
|
||||
"buffered for efficiency reasons. Returns the file handle.")
|
||||
},
|
||||
{"file/seek", janet_io_fseek,
|
||||
"(file/seek f [,whence [,n]])\n\n"
|
||||
"Jump to a relative location in the file. 'whence' must be one of\n\n"
|
||||
"\t:cur - jump relative to the current file location\n"
|
||||
"\t:set - jump relative to the beginning of the file\n"
|
||||
"\t:end - jump relative to the end of the file\n\n"
|
||||
"By default, 'whence' is :cur. Optionally a value n may be passed "
|
||||
"for the relative number of bytes to seek in the file. n may be a real "
|
||||
"number to handle large files of more the 4GB. Returns the file handle."
|
||||
{
|
||||
"file/seek", janet_io_fseek,
|
||||
JDOC("(file/seek f [,whence [,n]])\n\n"
|
||||
"Jump to a relative location in the file. 'whence' must be one of\n\n"
|
||||
"\t:cur - jump relative to the current file location\n"
|
||||
"\t:set - jump relative to the beginning of the file\n"
|
||||
"\t:end - jump relative to the end of the file\n\n"
|
||||
"By default, 'whence' is :cur. Optionally a value n may be passed "
|
||||
"for the relative number of bytes to seek in the file. n may be a real "
|
||||
"number to handle large files of more the 4GB. Returns the file handle.")
|
||||
},
|
||||
{"file/popen", janet_io_popen,
|
||||
"(file/popen path [,mode])\n\n"
|
||||
"Open a file that is backed by a process. The file must be opened in either "
|
||||
"the :r (read) or the :w (write) mode. In :r mode, the stdout of the "
|
||||
"process can be read from the file. In :w mode, the stdin of the process "
|
||||
"can be written to. Returns the new file."
|
||||
{
|
||||
"file/popen", janet_io_popen,
|
||||
JDOC("(file/popen path [,mode])\n\n"
|
||||
"Open a file that is backed by a process. The file must be opened in either "
|
||||
"the :r (read) or the :w (write) mode. In :r mode, the stdout of the "
|
||||
"process can be read from the file. In :w mode, the stdin of the process "
|
||||
"can be written to. Returns the new file.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
/* Module entry point */
|
||||
int janet_lib_io(JanetArgs args) {
|
||||
JanetTable *env = janet_env(args);
|
||||
void janet_lib_io(JanetTable *env) {
|
||||
janet_cfuns(env, NULL, cfuns);
|
||||
|
||||
/* stdout */
|
||||
janet_def(env, "stdout",
|
||||
makef(stdout, IO_APPEND | IO_NOT_CLOSEABLE | IO_SERIALIZABLE),
|
||||
"The standard output file.");
|
||||
|
||||
|
||||
JDOC("The standard output file."));
|
||||
/* stderr */
|
||||
janet_def(env, "stderr",
|
||||
makef(stderr, IO_APPEND | IO_NOT_CLOSEABLE | IO_SERIALIZABLE),
|
||||
"The standard error file.");
|
||||
|
||||
JDOC("The standard error file."));
|
||||
/* stdin */
|
||||
janet_def(env, "stdin",
|
||||
makef(stdin, IO_READ | IO_NOT_CLOSEABLE | IO_SERIALIZABLE),
|
||||
"The standard input file.");
|
||||
|
||||
return 0;
|
||||
JDOC("The standard input file."));
|
||||
}
|
||||
|
||||
168
src/core/marsh.c
168
src/core/marsh.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2018 Calvin Rose
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -21,12 +21,12 @@
|
||||
*/
|
||||
|
||||
#include <janet/janet.h>
|
||||
#include <setjmp.h>
|
||||
|
||||
#include "state.h"
|
||||
#include "vector.h"
|
||||
#include "gc.h"
|
||||
#include "fiber.h"
|
||||
#include "util.h"
|
||||
|
||||
typedef struct {
|
||||
jmp_buf err;
|
||||
@@ -61,14 +61,15 @@ const char *mr_strings[] = {
|
||||
|
||||
/* Lead bytes in marshaling protocol */
|
||||
enum {
|
||||
LB_NIL = 200,
|
||||
LB_REAL = 200,
|
||||
LB_NIL,
|
||||
LB_FALSE,
|
||||
LB_TRUE,
|
||||
LB_FIBER,
|
||||
LB_INTEGER,
|
||||
LB_REAL,
|
||||
LB_STRING,
|
||||
LB_SYMBOL,
|
||||
LB_KEYWORD,
|
||||
LB_ARRAY,
|
||||
LB_TUPLE,
|
||||
LB_TABLE,
|
||||
@@ -87,16 +88,16 @@ enum {
|
||||
static Janet entry_getval(Janet env_entry) {
|
||||
if (janet_checktype(env_entry, JANET_TABLE)) {
|
||||
JanetTable *entry = janet_unwrap_table(env_entry);
|
||||
Janet checkval = janet_table_get(entry, janet_csymbolv(":value"));
|
||||
Janet checkval = janet_table_get(entry, janet_ckeywordv("value"));
|
||||
if (janet_checktype(checkval, JANET_NIL)) {
|
||||
checkval = janet_table_get(entry, janet_csymbolv(":ref"));
|
||||
checkval = janet_table_get(entry, janet_ckeywordv("ref"));
|
||||
}
|
||||
return checkval;
|
||||
} else if (janet_checktype(env_entry, JANET_STRUCT)) {
|
||||
const JanetKV *entry = janet_unwrap_struct(env_entry);
|
||||
Janet checkval = janet_struct_get(entry, janet_csymbolv(":value"));
|
||||
Janet checkval = janet_struct_get(entry, janet_ckeywordv("value"));
|
||||
if (janet_checktype(checkval, JANET_NIL)) {
|
||||
checkval = janet_struct_get(entry, janet_csymbolv(":ref"));
|
||||
checkval = janet_struct_get(entry, janet_ckeywordv("ref"));
|
||||
}
|
||||
return checkval;
|
||||
} else {
|
||||
@@ -123,7 +124,7 @@ JanetTable *janet_env_lookup(JanetTable *env) {
|
||||
/* Marshal an integer onto the buffer */
|
||||
static void pushint(MarshalState *st, int32_t x) {
|
||||
if (x >= 0 && x < 200) {
|
||||
if (janet_buffer_push_u8(st->buf, x)) longjmp(st->err, MR_OVERFLOW);
|
||||
janet_buffer_push_u8(st->buf, x);
|
||||
} else {
|
||||
uint8_t intbuf[5];
|
||||
intbuf[0] = LB_INTEGER;
|
||||
@@ -131,16 +132,16 @@ static void pushint(MarshalState *st, int32_t x) {
|
||||
intbuf[2] = (x >> 8) & 0xFF;
|
||||
intbuf[3] = (x >> 16) & 0xFF;
|
||||
intbuf[4] = (x >> 24) & 0xFF;
|
||||
if (janet_buffer_push_bytes(st->buf, intbuf, 5)) longjmp(st->err, MR_OVERFLOW);
|
||||
janet_buffer_push_bytes(st->buf, intbuf, 5);
|
||||
}
|
||||
}
|
||||
|
||||
static void pushbyte(MarshalState *st, uint8_t b) {
|
||||
if (janet_buffer_push_u8(st->buf, b)) longjmp(st->err, MR_OVERFLOW);
|
||||
janet_buffer_push_u8(st->buf, b);
|
||||
}
|
||||
|
||||
static void pushbytes(MarshalState *st, const uint8_t *bytes, int32_t len) {
|
||||
if (janet_buffer_push_bytes(st->buf, bytes, len)) longjmp(st->err, MR_OVERFLOW);
|
||||
janet_buffer_push_bytes(st->buf, bytes, len);
|
||||
}
|
||||
|
||||
/* Forward declaration to enable mutual recursion. */
|
||||
@@ -356,12 +357,15 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
|
||||
goto done;
|
||||
case JANET_STRING:
|
||||
case JANET_SYMBOL:
|
||||
case JANET_KEYWORD:
|
||||
{
|
||||
const uint8_t *str = janet_unwrap_string(x);
|
||||
int32_t length = janet_string_length(str);
|
||||
/* Record reference */
|
||||
MARK_SEEN();
|
||||
uint8_t lb = (type == JANET_STRING) ? LB_STRING : LB_SYMBOL;
|
||||
uint8_t lb = (type == JANET_STRING) ? LB_STRING :
|
||||
(type == JANET_SYMBOL) ? LB_SYMBOL :
|
||||
LB_KEYWORD;
|
||||
pushbyte(st, lb);
|
||||
pushint(st, length);
|
||||
pushbytes(st, str, length);
|
||||
@@ -403,30 +407,32 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
|
||||
goto done;
|
||||
case JANET_TABLE:
|
||||
{
|
||||
const JanetKV *kv = NULL;
|
||||
JanetTable *t = janet_unwrap_table(x);
|
||||
MARK_SEEN();
|
||||
pushbyte(st, t->proto ? LB_TABLE_PROTO : LB_TABLE);
|
||||
pushint(st, t->count);
|
||||
if (t->proto)
|
||||
marshal_one(st, janet_wrap_table(t->proto), flags + 1);
|
||||
while ((kv = janet_table_next(t, kv))) {
|
||||
marshal_one(st, kv->key, flags + 1);
|
||||
marshal_one(st, kv->value, flags + 1);
|
||||
for (int32_t i = 0; i < t->capacity; i++) {
|
||||
if (janet_checktype(t->data[i].key, JANET_NIL))
|
||||
continue;
|
||||
marshal_one(st, t->data[i].key, flags + 1);
|
||||
marshal_one(st, t->data[i].value, flags + 1);
|
||||
}
|
||||
}
|
||||
goto done;
|
||||
case JANET_STRUCT:
|
||||
{
|
||||
int32_t count;
|
||||
const JanetKV *kv = NULL;
|
||||
const JanetKV *struct_ = janet_unwrap_struct(x);
|
||||
count = janet_struct_length(struct_);
|
||||
pushbyte(st, LB_STRUCT);
|
||||
pushint(st, count);
|
||||
while ((kv = janet_struct_next(struct_, kv))) {
|
||||
marshal_one(st, kv->key, flags + 1);
|
||||
marshal_one(st, kv->value, flags + 1);
|
||||
for (int32_t i = 0; i < janet_struct_capacity(struct_); i++) {
|
||||
if (janet_checktype(struct_[i].key, JANET_NIL))
|
||||
continue;
|
||||
marshal_one(st, struct_[i].key, flags + 1);
|
||||
marshal_one(st, struct_[i].value, flags + 1);
|
||||
}
|
||||
/* Mark as seen AFTER marshaling */
|
||||
MARK_SEEN();
|
||||
@@ -604,7 +610,7 @@ static const uint8_t *unmarshal_one_env(
|
||||
data = unmarshal_one(st, data, &fiberv, flags);
|
||||
if (!janet_checktype(fiberv, JANET_FIBER)) longjmp(st->err, UMR_EXPECTED_FIBER);
|
||||
env->as.fiber = janet_unwrap_fiber(fiberv);
|
||||
/* Unmarshaling fiber may set values */
|
||||
/* Unmarshalling fiber may set values */
|
||||
if (env->offset != 0 && env->offset != offset) longjmp(st->err, UMR_UNKNOWN);
|
||||
if (env->length != 0 && env->length != length) longjmp(st->err, UMR_UNKNOWN);
|
||||
} else {
|
||||
@@ -639,7 +645,7 @@ static const uint8_t *unmarshal_one_def(
|
||||
*out = st->lookup_defs[index];
|
||||
} else {
|
||||
/* Initialize with values that will not break garbage collection
|
||||
* if unmarshaling fails. */
|
||||
* if unmarshalling fails. */
|
||||
JanetFuncDef *def = janet_gcalloc(JANET_MEMORY_FUNCDEF, sizeof(JanetFuncDef));
|
||||
def->environments_length = 0;
|
||||
def->defs_length = 0;
|
||||
@@ -780,7 +786,7 @@ static const uint8_t *unmarshal_one_fiber(
|
||||
fiber->data = NULL;
|
||||
fiber->child = NULL;
|
||||
|
||||
/* Set frame later so fiber can be GCed at anytime if unmarshaling fails */
|
||||
/* Set frame later so fiber can be GCed at anytime if unmarshalling fails */
|
||||
int32_t frame = 0;
|
||||
int32_t stack = 0;
|
||||
int32_t stacktop = 0;
|
||||
@@ -796,7 +802,6 @@ static const uint8_t *unmarshal_one_fiber(
|
||||
if ((int32_t)(frame + JANET_FRAME_SIZE) > fiber->stackstart ||
|
||||
fiber->stackstart > fiber->stacktop ||
|
||||
fiber->stacktop > fiber->maxstack) {
|
||||
/* printf("bad flags and ints.\n"); */
|
||||
goto error;
|
||||
}
|
||||
|
||||
@@ -826,7 +831,6 @@ static const uint8_t *unmarshal_one_fiber(
|
||||
Janet funcv;
|
||||
data = unmarshal_one(st, data, &funcv, flags + 1);
|
||||
if (!janet_checktype(funcv, JANET_FUNCTION)) {
|
||||
/* printf("bad root func.\n"); */
|
||||
goto error;
|
||||
}
|
||||
func = janet_unwrap_function(funcv);
|
||||
@@ -949,6 +953,7 @@ static const uint8_t *unmarshal_one(
|
||||
case LB_STRING:
|
||||
case LB_SYMBOL:
|
||||
case LB_BUFFER:
|
||||
case LB_KEYWORD:
|
||||
case LB_REGISTRY:
|
||||
{
|
||||
data++;
|
||||
@@ -960,6 +965,9 @@ static const uint8_t *unmarshal_one(
|
||||
} else if (lead == LB_SYMBOL) {
|
||||
const uint8_t *str = janet_symbol(data, len);
|
||||
*out = janet_wrap_symbol(str);
|
||||
} else if (lead == LB_KEYWORD) {
|
||||
const uint8_t *str = janet_keyword(data, len);
|
||||
*out = janet_wrap_keyword(str);
|
||||
} else if (lead == LB_REGISTRY) {
|
||||
if (st->reg) {
|
||||
Janet regkey = janet_symbolv(data, len);
|
||||
@@ -1094,91 +1102,77 @@ int janet_unmarshal(
|
||||
|
||||
/* C functions */
|
||||
|
||||
static int cfun_env_lookup(JanetArgs args) {
|
||||
JanetTable *env;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_ARG_TABLE(env, args, 0);
|
||||
JANET_RETURN_TABLE(args, janet_env_lookup(env));
|
||||
static Janet cfun_env_lookup(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetTable *env = janet_gettable(argv, 0);
|
||||
return janet_wrap_table(janet_env_lookup(env));
|
||||
}
|
||||
|
||||
static int cfun_marshal(JanetArgs args) {
|
||||
static Janet cfun_marshal(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetBuffer *buffer;
|
||||
JanetTable *rreg;
|
||||
JanetTable *rreg = NULL;
|
||||
Janet err_param = janet_wrap_nil();
|
||||
int status;
|
||||
JANET_MINARITY(args, 1);
|
||||
JANET_MAXARITY(args, 3);
|
||||
if (args.n > 1) {
|
||||
/* Reverse Registry provided */
|
||||
JANET_ARG_TABLE(rreg, args, 1);
|
||||
} else {
|
||||
rreg = NULL;
|
||||
if (argc > 1) {
|
||||
rreg = janet_gettable(argv, 1);
|
||||
}
|
||||
if (args.n > 2) {
|
||||
/* Buffer provided */
|
||||
JANET_ARG_BUFFER(buffer, args, 2);
|
||||
if (argc > 2) {
|
||||
buffer = janet_getbuffer(argv, 2);
|
||||
} else {
|
||||
buffer = janet_buffer(10);
|
||||
}
|
||||
status = janet_marshal(buffer, args.v[0], &err_param, rreg, 0);
|
||||
if (status) {
|
||||
const uint8_t *errstr = janet_formatc(
|
||||
"%s for %V",
|
||||
mr_strings[status],
|
||||
err_param);
|
||||
JANET_THROWV(args, janet_wrap_string(errstr));
|
||||
}
|
||||
JANET_RETURN_BUFFER(args, buffer);
|
||||
status = janet_marshal(buffer, argv[0], &err_param, rreg, 0);
|
||||
if (status)
|
||||
janet_panicf("%s for %V", mr_strings[status], err_param);
|
||||
return janet_wrap_buffer(buffer);
|
||||
}
|
||||
|
||||
static int cfun_unmarshal(JanetArgs args) {
|
||||
const uint8_t *bytes;
|
||||
JanetTable *reg;
|
||||
int32_t len;
|
||||
static Janet cfun_unmarshal(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetByteView view = janet_getbytes(argv, 0);
|
||||
JanetTable *reg = NULL;
|
||||
Janet ret;
|
||||
int status;
|
||||
JANET_MINARITY(args, 1);
|
||||
JANET_MAXARITY(args, 2);
|
||||
JANET_ARG_BYTES(bytes, len, args, 0);
|
||||
if (args.n > 1) {
|
||||
JANET_ARG_TABLE(reg, args, 1);
|
||||
} else {
|
||||
reg = NULL;
|
||||
if (argc > 1) {
|
||||
reg = janet_gettable(argv, 1);
|
||||
}
|
||||
status = janet_unmarshal(bytes, (size_t) len, 0, args.ret, reg, NULL);
|
||||
status = janet_unmarshal(view.bytes, (size_t) view.len, 0, &ret, reg, NULL);
|
||||
if (status) {
|
||||
JANET_THROW(args, umr_strings[status]);
|
||||
janet_panic(umr_strings[status]);
|
||||
}
|
||||
return JANET_SIGNAL_OK;
|
||||
return ret;
|
||||
}
|
||||
|
||||
static const JanetReg cfuns[] = {
|
||||
{"marshal", cfun_marshal,
|
||||
"(marshal x [,reverse-lookup [,buffer]])\n\n"
|
||||
"Marshal a janet value into a buffer and return the buffer. The buffer "
|
||||
"can the later be unmarshalled to reconstruct the initial value. "
|
||||
"Optionally, one can pass in a reverse lookup table to not marshal "
|
||||
"aliased values that are found in the table. Then a forward"
|
||||
"lookup table can be used to recover the origrinal janet value when "
|
||||
"unmarshaling."
|
||||
{
|
||||
"marshal", cfun_marshal,
|
||||
JDOC("(marshal x [,reverse-lookup [,buffer]])\n\n"
|
||||
"Marshal a janet value into a buffer and return the buffer. The buffer "
|
||||
"can the later be unmarshalled to reconstruct the initial value. "
|
||||
"Optionally, one can pass in a reverse lookup table to not marshal "
|
||||
"aliased values that are found in the table. Then a forward"
|
||||
"lookup table can be used to recover the original janet value when "
|
||||
"unmarshalling.")
|
||||
},
|
||||
{"unmarshal", cfun_unmarshal,
|
||||
"(unmarshal buffer [,lookup])\n\n"
|
||||
"Unmarshal a janet value from a buffer. An optional lookup table "
|
||||
"can be provided to allow for aliases to be resolved. Returns the value "
|
||||
"unmarshaled from the buffer."
|
||||
{
|
||||
"unmarshal", cfun_unmarshal,
|
||||
JDOC("(unmarshal buffer [,lookup])\n\n"
|
||||
"Unmarshal a janet value from a buffer. An optional lookup table "
|
||||
"can be provided to allow for aliases to be resolved. Returns the value "
|
||||
"unmarshalled from the buffer.")
|
||||
},
|
||||
{"env-lookup", cfun_env_lookup,
|
||||
"(env-lookup env)\n\n"
|
||||
"Creates a forward lookup table for unmarshaling from an environment. "
|
||||
"To create a reverse lookup table, use the invert function to swap keys "
|
||||
"and values in the returned table."
|
||||
{
|
||||
"env-lookup", cfun_env_lookup,
|
||||
JDOC("(env-lookup env)\n\n"
|
||||
"Creates a forward lookup table for unmarshalling from an environment. "
|
||||
"To create a reverse lookup table, use the invert function to swap keys "
|
||||
"and values in the returned table.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
/* Module entry point */
|
||||
int janet_lib_marsh(JanetArgs args) {
|
||||
JanetTable *env = janet_env(args);
|
||||
void janet_lib_marsh(JanetTable *env) {
|
||||
janet_cfuns(env, NULL, cfuns);
|
||||
return 0;
|
||||
}
|
||||
|
||||
188
src/core/math.c
188
src/core/math.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2018 Calvin Rose
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -22,37 +22,36 @@
|
||||
|
||||
#include <janet/janet.h>
|
||||
#include <math.h>
|
||||
#include "util.h"
|
||||
|
||||
/* Get a random number */
|
||||
int janet_rand(JanetArgs args) {
|
||||
JANET_FIXARITY(args, 0);
|
||||
Janet janet_rand(int32_t argc, Janet *argv) {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
double r = (rand() % RAND_MAX) / ((double) RAND_MAX);
|
||||
JANET_RETURN_NUMBER(args, r);
|
||||
return janet_wrap_number(r);
|
||||
}
|
||||
|
||||
/* Seed the random number generator */
|
||||
int janet_srand(JanetArgs args) {
|
||||
int32_t x = 0;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_ARG_INTEGER(x, args, 0);
|
||||
Janet janet_srand(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
int32_t x = janet_getinteger(argv, 0);
|
||||
srand((unsigned) x);
|
||||
return 0;
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
int janet_remainder(JanetArgs args) {
|
||||
JANET_FIXARITY(args, 2);
|
||||
double x, y;
|
||||
JANET_ARG_NUMBER(x, args, 0);
|
||||
JANET_ARG_NUMBER(y, args, 1);
|
||||
JANET_RETURN_NUMBER(args, fmod(x, y));
|
||||
Janet janet_remainder(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
double x = janet_getnumber(argv, 0);
|
||||
double y = janet_getnumber(argv, 1);
|
||||
return janet_wrap_number(fmod(x, y));
|
||||
}
|
||||
|
||||
#define JANET_DEFINE_MATHOP(name, fop)\
|
||||
int janet_##name(JanetArgs args) {\
|
||||
double x;\
|
||||
JANET_FIXARITY(args, 1);\
|
||||
JANET_ARG_NUMBER(x, args, 0);\
|
||||
JANET_RETURN_NUMBER(args, fop(x));\
|
||||
Janet janet_##name(int32_t argc, Janet *argv) {\
|
||||
janet_fixarity(argc, 1); \
|
||||
double x = janet_getnumber(argv, 0); \
|
||||
return janet_wrap_number(fop(x)); \
|
||||
}
|
||||
|
||||
JANET_DEFINE_MATHOP(acos, acos)
|
||||
@@ -73,104 +72,119 @@ JANET_DEFINE_MATHOP(fabs, fabs)
|
||||
JANET_DEFINE_MATHOP(floor, floor)
|
||||
|
||||
#define JANET_DEFINE_MATH2OP(name, fop)\
|
||||
int janet_##name(JanetArgs args) {\
|
||||
double lhs, rhs;\
|
||||
JANET_FIXARITY(args, 2);\
|
||||
JANET_ARG_NUMBER(lhs, args, 0);\
|
||||
JANET_ARG_NUMBER(rhs, args, 1);\
|
||||
JANET_RETURN_NUMBER(args, fop(lhs, rhs));\
|
||||
Janet janet_##name(int32_t argc, Janet *argv) {\
|
||||
janet_fixarity(argc, 2); \
|
||||
double lhs = janet_getnumber(argv, 0); \
|
||||
double rhs = janet_getnumber(argv, 1); \
|
||||
return janet_wrap_number(fop(lhs, rhs)); \
|
||||
}\
|
||||
|
||||
JANET_DEFINE_MATH2OP(atan2, atan2)
|
||||
JANET_DEFINE_MATH2OP(pow, pow)
|
||||
|
||||
static int janet_not(JanetArgs args) {
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_RETURN_BOOLEAN(args, !janet_truthy(args.v[0]));
|
||||
static Janet janet_not(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
return janet_wrap_boolean(!janet_truthy(argv[0]));
|
||||
}
|
||||
|
||||
static const JanetReg cfuns[] = {
|
||||
{"%", janet_remainder,
|
||||
"(% dividend divisor)\n\n"
|
||||
"Returns the remainder of dividend / divisor."
|
||||
{
|
||||
"%", janet_remainder,
|
||||
JDOC("(% dividend divisor)\n\n"
|
||||
"Returns the remainder of dividend / divisor.")
|
||||
},
|
||||
{"not", janet_not,
|
||||
"(not x)\n\nReturns the boolen inverse of x."
|
||||
{
|
||||
"not", janet_not,
|
||||
JDOC("(not x)\n\nReturns the boolean inverse of x.")
|
||||
},
|
||||
{"math/random", janet_rand,
|
||||
"(math/random)\n\n"
|
||||
"Returns a uniformly distrbuted random number number between 0 and 1."
|
||||
{
|
||||
"math/random", janet_rand,
|
||||
JDOC("(math/random)\n\n"
|
||||
"Returns a uniformly distributed random number between 0 and 1.")
|
||||
},
|
||||
{"math/seedrandom", janet_srand,
|
||||
"(math/seedrandom seed)\n\n"
|
||||
"Set the seed for the random number generator. 'seed' should be an "
|
||||
"an integer."
|
||||
{
|
||||
"math/seedrandom", janet_srand,
|
||||
JDOC("(math/seedrandom seed)\n\n"
|
||||
"Set the seed for the random number generator. 'seed' should be an "
|
||||
"an integer.")
|
||||
},
|
||||
{"math/cos", janet_cos,
|
||||
"(math/cos x)\n\n"
|
||||
"Returns the cosine of x."
|
||||
{
|
||||
"math/cos", janet_cos,
|
||||
JDOC("(math/cos x)\n\n"
|
||||
"Returns the cosine of x.")
|
||||
},
|
||||
{"math/sin", janet_sin,
|
||||
"(math/sin x)\n\n"
|
||||
"Returns the sine of x."
|
||||
{
|
||||
"math/sin", janet_sin,
|
||||
JDOC("(math/sin x)\n\n"
|
||||
"Returns the sine of x.")
|
||||
},
|
||||
{"math/tan", janet_tan,
|
||||
"(math/tan x)\n\n"
|
||||
"Returns the tangent of x."
|
||||
{
|
||||
"math/tan", janet_tan,
|
||||
JDOC("(math/tan x)\n\n"
|
||||
"Returns the tangent of x.")
|
||||
},
|
||||
{"math/acos", janet_acos,
|
||||
"(math/acos x)\n\n"
|
||||
"Returns the arccosine of x."
|
||||
{
|
||||
"math/acos", janet_acos,
|
||||
JDOC("(math/acos x)\n\n"
|
||||
"Returns the arccosine of x.")
|
||||
},
|
||||
{"math/asin", janet_asin,
|
||||
"(math/asin x)\n\n"
|
||||
"Returns the arcsine of x."
|
||||
{
|
||||
"math/asin", janet_asin,
|
||||
JDOC("(math/asin x)\n\n"
|
||||
"Returns the arcsine of x.")
|
||||
},
|
||||
{"math/atan", janet_atan,
|
||||
"(math/atan x)\n\n"
|
||||
"Returns the arctangent of x."
|
||||
{
|
||||
"math/atan", janet_atan,
|
||||
JDOC("(math/atan x)\n\n"
|
||||
"Returns the arctangent of x.")
|
||||
},
|
||||
{"math/exp", janet_exp,
|
||||
"(math/exp x)\n\n"
|
||||
"Returns e to the power of x."
|
||||
{
|
||||
"math/exp", janet_exp,
|
||||
JDOC("(math/exp x)\n\n"
|
||||
"Returns e to the power of x.")
|
||||
},
|
||||
{"math/log", janet_log,
|
||||
"(math/log x)\n\n"
|
||||
"Returns log base 2 of x."
|
||||
{
|
||||
"math/log", janet_log,
|
||||
JDOC("(math/log x)\n\n"
|
||||
"Returns log base 2 of x.")
|
||||
},
|
||||
{"math/log10", janet_log10,
|
||||
"(math/log10 x)\n\n"
|
||||
"Returns log base 10 of x."
|
||||
{
|
||||
"math/log10", janet_log10,
|
||||
JDOC("(math/log10 x)\n\n"
|
||||
"Returns log base 10 of x.")
|
||||
},
|
||||
{"math/sqrt", janet_sqrt,
|
||||
"(math/sqrt x)\n\n"
|
||||
"Returns the square root of x."
|
||||
{
|
||||
"math/sqrt", janet_sqrt,
|
||||
JDOC("(math/sqrt x)\n\n"
|
||||
"Returns the square root of x.")
|
||||
},
|
||||
{"math/floor", janet_floor,
|
||||
"(math/floor x)\n\n"
|
||||
"Returns the largest integer value number number that is not greater than x."
|
||||
{
|
||||
"math/floor", janet_floor,
|
||||
JDOC("(math/floor x)\n\n"
|
||||
"Returns the largest integer value number that is not greater than x.")
|
||||
},
|
||||
{"math/ceil", janet_ceil,
|
||||
"(math/ceil x)\n\n"
|
||||
"Returns the smallest integer value number number that is not less than x."
|
||||
{
|
||||
"math/ceil", janet_ceil,
|
||||
JDOC("(math/ceil x)\n\n"
|
||||
"Returns the smallest integer value number that is not less than x.")
|
||||
},
|
||||
{"math/pow", janet_pow,
|
||||
"(math/pow a x)\n\n"
|
||||
"Return a to the power of x."
|
||||
{
|
||||
"math/pow", janet_pow,
|
||||
JDOC("(math/pow a x)\n\n"
|
||||
"Return a to the power of x.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
/* Module entry point */
|
||||
int janet_lib_math(JanetArgs args) {
|
||||
JanetTable *env = janet_env(args);
|
||||
void janet_lib_math(JanetTable *env) {
|
||||
janet_cfuns(env, NULL, cfuns);
|
||||
|
||||
#ifndef JANET_NO_BOOTSTRAP
|
||||
janet_def(env, "math/pi", janet_wrap_number(3.1415926535897931),
|
||||
"The value pi.");
|
||||
JDOC("The value pi."));
|
||||
janet_def(env, "math/e", janet_wrap_number(2.7182818284590451),
|
||||
"The base of the natural log.");
|
||||
JDOC("The base of the natural log."));
|
||||
janet_def(env, "math/inf", janet_wrap_number(INFINITY),
|
||||
"The number representing positive infinity");
|
||||
return 0;
|
||||
JDOC("The number representing positive infinity"));
|
||||
#endif
|
||||
}
|
||||
|
||||
@@ -1,111 +0,0 @@
|
||||
/*
|
||||
* Copyright (c) 2018 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
* deal in the Software without restriction, including without limitation the
|
||||
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
||||
* sell copies of the Software, and to permit persons to whom the Software is
|
||||
* furnished to do so, subject to the following conditions:
|
||||
*
|
||||
* The above copyright notice and this permission notice shall be included in
|
||||
* all copies or substantial portions of the Software.
|
||||
*
|
||||
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
#include <janet/janet.h>
|
||||
#include "compile.h"
|
||||
#include "emit.h"
|
||||
#include "vector.h"
|
||||
|
||||
/* Parse a part of a symbol that can be used for building up code. */
|
||||
static JanetSlot multisym_parse_part(JanetCompiler *c, const uint8_t *sympart, int32_t len) {
|
||||
if (sympart[0] == ':') {
|
||||
return janetc_cslot(janet_symbolv(sympart, len));
|
||||
} else {
|
||||
int err = 0;
|
||||
int32_t num = janet_scan_integer(sympart + 1, len - 1, &err);
|
||||
if (err) {
|
||||
return janetc_resolve(c, janet_symbol(sympart + 1, len - 1));
|
||||
} else {
|
||||
return janetc_cslot(janet_wrap_integer(num));
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
static JanetSlot multisym_do_parts(JanetFopts opts, int put, const uint8_t *sym, Janet rvalue) {
|
||||
JanetSlot slot;
|
||||
JanetFopts subopts = janetc_fopts_default(opts.compiler);
|
||||
int i, j;
|
||||
for (i = 1, j = 0; sym[i]; i++) {
|
||||
if (sym[i] == ':' || sym[i] == '.') {
|
||||
if (j) {
|
||||
JanetSlot target = janetc_gettarget(subopts);
|
||||
JanetSlot value = multisym_parse_part(opts.compiler, sym + j, i - j);
|
||||
janetc_emit_sss(opts.compiler, JOP_GET, target, slot, value, 1);
|
||||
slot = target;
|
||||
} else {
|
||||
const uint8_t *nextsym = janet_symbol(sym + j, i - j);
|
||||
slot = janetc_resolve(opts.compiler, nextsym);
|
||||
}
|
||||
j = i;
|
||||
}
|
||||
}
|
||||
|
||||
if (j) {
|
||||
/* multisym (outermost get or put) */
|
||||
JanetSlot target = janetc_gettarget(opts);
|
||||
JanetSlot key = multisym_parse_part(opts.compiler, sym + j, i - j);
|
||||
if (put) {
|
||||
subopts.flags = JANET_FOPTS_HINT;
|
||||
subopts.hint = target;
|
||||
JanetSlot r_slot = janetc_value(subopts, rvalue);
|
||||
janetc_emit_sss(opts.compiler, JOP_PUT, slot, key, r_slot, 0);
|
||||
janetc_copy(opts.compiler, target, r_slot);
|
||||
} else {
|
||||
janetc_emit_sss(opts.compiler, JOP_GET, target, slot, key, 1);
|
||||
}
|
||||
return target;
|
||||
} else {
|
||||
/* normal symbol */
|
||||
if (put) {
|
||||
JanetSlot ret, dest;
|
||||
dest = janetc_resolve(opts.compiler, sym);
|
||||
if (!(dest.flags & JANET_SLOT_MUTABLE)) {
|
||||
janetc_cerror(opts.compiler, "cannot set constant");
|
||||
return janetc_cslot(janet_wrap_nil());
|
||||
}
|
||||
subopts.flags = JANET_FOPTS_HINT;
|
||||
subopts.hint = dest;
|
||||
ret = janetc_value(subopts, rvalue);
|
||||
janetc_copy(opts.compiler, dest, ret);
|
||||
return ret;
|
||||
}
|
||||
return janetc_resolve(opts.compiler, sym);
|
||||
}
|
||||
}
|
||||
|
||||
/* Check if a symbol is a multisym, and if so, transform
|
||||
* it and emit the code for treating it as a bunch of nested
|
||||
* gets. */
|
||||
JanetSlot janetc_sym_rvalue(JanetFopts opts, const uint8_t *sym) {
|
||||
if (janet_string_length(sym) && sym[0] != ':') {
|
||||
return multisym_do_parts(opts, 0, sym, janet_wrap_nil());
|
||||
} else {
|
||||
/* keyword */
|
||||
return janetc_cslot(janet_wrap_symbol(sym));
|
||||
}
|
||||
}
|
||||
|
||||
/* Check if a symbol is a multisym, and if so, transform
|
||||
* it into the correct 'put' expression. */
|
||||
JanetSlot janetc_sym_lvalue(JanetFopts opts, const uint8_t *sym, Janet value) {
|
||||
return multisym_do_parts(opts, 1, sym, value);
|
||||
}
|
||||
248
src/core/os.c
248
src/core/os.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2018 Calvin Rose
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -23,6 +23,7 @@
|
||||
#include <janet/janet.h>
|
||||
#include <stdlib.h>
|
||||
#include <time.h>
|
||||
#include "util.h"
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
#include <Windows.h>
|
||||
@@ -40,27 +41,28 @@
|
||||
#include <mach/mach.h>
|
||||
#endif
|
||||
|
||||
static int os_which(JanetArgs args) {
|
||||
static Janet os_which(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 0);
|
||||
(void) argv;
|
||||
#ifdef JANET_WINDOWS
|
||||
JANET_RETURN_CSYMBOL(args, ":windows");
|
||||
return janet_ckeywordv("windows");
|
||||
#elif __APPLE__
|
||||
JANET_RETURN_CSYMBOL(args, ":macos");
|
||||
return janet_ckeywordv("macos");
|
||||
#elif defined(__EMSCRIPTEN__)
|
||||
JANET_RETURN_CSYMBOL(args, ":web");
|
||||
return janet_ckeywordv("web");
|
||||
#else
|
||||
JANET_RETURN_CSYMBOL(args, ":posix");
|
||||
return janet_ckeywordv("posix");
|
||||
#endif
|
||||
}
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
static int os_execute(JanetArgs args) {
|
||||
JANET_MINARITY(args, 1);
|
||||
static Janet os_execute(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, -1);
|
||||
JanetBuffer *buffer = janet_buffer(10);
|
||||
for (int32_t i = 0; i < args.n; i++) {
|
||||
const uint8_t *argstring;
|
||||
JANET_ARG_STRING(argstring, args, i);
|
||||
for (int32_t i = 0; i < argc; i++) {
|
||||
const uint8_t *argstring = janet_getstring(argv, i);
|
||||
janet_buffer_push_bytes(buffer, argstring, janet_string_length(argstring));
|
||||
if (i != args.n - 1) {
|
||||
if (i != argc - 1) {
|
||||
janet_buffer_push_u8(buffer, ' ');
|
||||
}
|
||||
}
|
||||
@@ -80,7 +82,7 @@ static int os_execute(JanetArgs args) {
|
||||
buffer->count);
|
||||
if (nwritten == 0) {
|
||||
free(sys_str);
|
||||
JANET_THROW(args, "could not create process");
|
||||
janet_panic("could not create process");
|
||||
}
|
||||
|
||||
STARTUPINFO si;
|
||||
@@ -102,7 +104,7 @@ static int os_execute(JanetArgs args) {
|
||||
&si,
|
||||
&pi)) {
|
||||
free(sys_str);
|
||||
JANET_THROW(args, "could not create process");
|
||||
janet_panic("could not create process");
|
||||
}
|
||||
free(sys_str);
|
||||
|
||||
@@ -114,61 +116,57 @@ static int os_execute(JanetArgs args) {
|
||||
GetExitCodeProcess(pi.hProcess, (LPDWORD)&status);
|
||||
CloseHandle(pi.hProcess);
|
||||
CloseHandle(pi.hThread);
|
||||
JANET_RETURN_INTEGER(args, (int32_t)status);
|
||||
return janet_wrap_integer(status);
|
||||
}
|
||||
#else
|
||||
static int os_execute(JanetArgs args) {
|
||||
JANET_MINARITY(args, 1);
|
||||
const uint8_t **argv = malloc(sizeof(uint8_t *) * (args.n + 1));
|
||||
if (NULL == argv) {
|
||||
static Janet os_execute(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, -1);
|
||||
const uint8_t **child_argv = malloc(sizeof(uint8_t *) * (argc + 1));
|
||||
if (NULL == child_argv) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
for (int32_t i = 0; i < args.n; i++) {
|
||||
JANET_ARG_STRING(argv[i], args, i);
|
||||
for (int32_t i = 0; i < argc; i++) {
|
||||
child_argv[i] = janet_getstring(argv, i);
|
||||
}
|
||||
argv[args.n] = NULL;
|
||||
child_argv[argc] = NULL;
|
||||
|
||||
/* Fork child process */
|
||||
pid_t pid = fork();
|
||||
if (pid < 0) {
|
||||
JANET_THROW(args, "failed to execute");
|
||||
janet_panic("failed to execute");
|
||||
} else if (pid == 0) {
|
||||
if (-1 == execve((const char *)argv[0], (char **)argv, NULL)) {
|
||||
if (-1 == execve((const char *)child_argv[0], (char **)child_argv, NULL)) {
|
||||
exit(1);
|
||||
}
|
||||
}
|
||||
int status;
|
||||
waitpid(pid, &status, 0);
|
||||
JANET_RETURN_INTEGER(args, status);
|
||||
return janet_wrap_integer(status);
|
||||
}
|
||||
#endif
|
||||
|
||||
static int os_shell(JanetArgs args) {
|
||||
int nofirstarg = (args.n < 1 || !janet_checktype(args.v[0], JANET_STRING));
|
||||
const char *cmd = nofirstarg
|
||||
? NULL
|
||||
: (const char *) janet_unwrap_string(args.v[0]);
|
||||
static Janet os_shell(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 0, 1);
|
||||
const char *cmd = argc
|
||||
? (const char *)janet_getstring(argv, 0)
|
||||
: NULL;
|
||||
int stat = system(cmd);
|
||||
JANET_RETURN(args, cmd
|
||||
? janet_wrap_integer(stat)
|
||||
: janet_wrap_boolean(stat));
|
||||
return argc
|
||||
? janet_wrap_integer(stat)
|
||||
: janet_wrap_boolean(stat);
|
||||
}
|
||||
|
||||
static int os_getenv(JanetArgs args) {
|
||||
const uint8_t *k;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_ARG_STRING(k, args, 0);
|
||||
static Janet os_getenv(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
const uint8_t *k = janet_getstring(argv, 0);
|
||||
const char *cstr = (const char *) k;
|
||||
const char *res = getenv(cstr);
|
||||
if (!res) {
|
||||
JANET_RETURN_NIL(args);
|
||||
}
|
||||
JANET_RETURN(args, cstr
|
||||
? janet_cstringv(res)
|
||||
: janet_wrap_nil());
|
||||
return (res && cstr)
|
||||
? janet_cstringv(res)
|
||||
: janet_wrap_nil();
|
||||
}
|
||||
|
||||
static int os_setenv(JanetArgs args) {
|
||||
static Janet os_setenv(int32_t argc, Janet *argv) {
|
||||
#ifdef JANET_WINDOWS
|
||||
#define SETENV(K,V) _putenv_s(K, V)
|
||||
#define UNSETENV(K) _putenv_s(K, "")
|
||||
@@ -176,39 +174,35 @@ static int os_setenv(JanetArgs args) {
|
||||
#define SETENV(K,V) setenv(K, V, 1)
|
||||
#define UNSETENV(K) unsetenv(K)
|
||||
#endif
|
||||
const uint8_t *k;
|
||||
const char *ks;
|
||||
JANET_MAXARITY(args, 2);
|
||||
JANET_MINARITY(args, 1);
|
||||
JANET_ARG_STRING(k, args, 0);
|
||||
ks = (const char *) k;
|
||||
if (args.n == 1 || janet_checktype(args.v[1], JANET_NIL)) {
|
||||
janet_arity(argc, 1, 2);
|
||||
const uint8_t *k = janet_getstring(argv, 0);
|
||||
const char *ks = (const char *) k;
|
||||
if (argc == 1 || janet_checktype(argv[1], JANET_NIL)) {
|
||||
UNSETENV(ks);
|
||||
} else {
|
||||
const uint8_t *v;
|
||||
JANET_ARG_STRING(v, args, 1);
|
||||
const char *vc = (const char *) v;
|
||||
SETENV(ks, vc);
|
||||
const uint8_t *v = janet_getstring(argv, 1);
|
||||
SETENV(ks, (const char *)v);
|
||||
}
|
||||
return 0;
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static int os_exit(JanetArgs args) {
|
||||
JANET_MAXARITY(args, 1);
|
||||
if (args.n == 0) {
|
||||
static Janet os_exit(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 0, 1);
|
||||
if (argc == 0) {
|
||||
exit(EXIT_SUCCESS);
|
||||
} else if (janet_checkint(args.v[0])) {
|
||||
exit(janet_unwrap_integer(args.v[0]));
|
||||
} else if (janet_checkint(argv[0])) {
|
||||
exit(janet_unwrap_integer(argv[0]));
|
||||
} else {
|
||||
exit(EXIT_FAILURE);
|
||||
}
|
||||
return 0;
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static int os_time(JanetArgs args) {
|
||||
JANET_FIXARITY(args, 0);
|
||||
static Janet os_time(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 0);
|
||||
(void) argv;
|
||||
double dtime = (double)(time(NULL));
|
||||
JANET_RETURN_NUMBER(args, dtime);
|
||||
return janet_wrap_number(dtime);
|
||||
}
|
||||
|
||||
/* Clock shims */
|
||||
@@ -238,22 +232,19 @@ static int gettime(struct timespec *spec) {
|
||||
#define gettime(TV) clock_gettime(CLOCK_MONOTONIC, (TV))
|
||||
#endif
|
||||
|
||||
static int os_clock(JanetArgs args) {
|
||||
JANET_FIXARITY(args, 0);
|
||||
static Janet os_clock(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 0);
|
||||
(void) argv;
|
||||
struct timespec tv;
|
||||
if (gettime(&tv))
|
||||
JANET_THROW(args, "could not get time");
|
||||
if (gettime(&tv)) janet_panic("could not get time");
|
||||
double dtime = tv.tv_sec + (tv.tv_nsec / 1E9);
|
||||
JANET_RETURN_NUMBER(args, dtime);
|
||||
return janet_wrap_number(dtime);
|
||||
}
|
||||
|
||||
static int os_sleep(JanetArgs args) {
|
||||
double delay;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_ARG_NUMBER(delay, args, 0);
|
||||
if (delay < 0) {
|
||||
JANET_THROW(args, "invalid argument to sleep");
|
||||
}
|
||||
static Janet os_sleep(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
double delay = janet_getnumber(argv, 0);
|
||||
if (delay < 0) janet_panic("invalid argument to sleep");
|
||||
#ifdef JANET_WINDOWS
|
||||
Sleep((DWORD) (delay * 1000));
|
||||
#else
|
||||
@@ -264,11 +255,12 @@ static int os_sleep(JanetArgs args) {
|
||||
: 0;
|
||||
nanosleep(&ts, NULL);
|
||||
#endif
|
||||
return 0;
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static int os_cwd(JanetArgs args) {
|
||||
JANET_FIXARITY(args, 0);
|
||||
static Janet os_cwd(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 0);
|
||||
(void) argv;
|
||||
char buf[FILENAME_MAX];
|
||||
char *ptr;
|
||||
#ifdef JANET_WINDOWS
|
||||
@@ -276,67 +268,73 @@ static int os_cwd(JanetArgs args) {
|
||||
#else
|
||||
ptr = getcwd(buf, FILENAME_MAX);
|
||||
#endif
|
||||
if (NULL == ptr) {
|
||||
JANET_THROW(args, "could not get current directory");
|
||||
}
|
||||
JANET_RETURN_CSTRING(args, ptr);
|
||||
if (NULL == ptr) janet_panic("could not get current directory");
|
||||
return janet_cstringv(ptr);
|
||||
}
|
||||
|
||||
static const JanetReg cfuns[] = {
|
||||
{"os/which", os_which,
|
||||
"(os/which)\n\n"
|
||||
"Check the current operating system. Returns one of:\n\n"
|
||||
"\t:windows - Microsoft Windows\n"
|
||||
"\t:macos - Apple macos\n"
|
||||
"\t:posix - A POSIX compatible system (default)"
|
||||
{
|
||||
"os/which", os_which,
|
||||
JDOC("(os/which)\n\n"
|
||||
"Check the current operating system. Returns one of:\n\n"
|
||||
"\t:windows - Microsoft Windows\n"
|
||||
"\t:macos - Apple macos\n"
|
||||
"\t:posix - A POSIX compatible system (default)")
|
||||
},
|
||||
{"os/execute", os_execute,
|
||||
"(os/execute program & args)\n\n"
|
||||
"Execute a program on the system and pass it string arguments. Returns "
|
||||
"the exit status of the program."
|
||||
{
|
||||
"os/execute", os_execute,
|
||||
JDOC("(os/execute program & args)\n\n"
|
||||
"Execute a program on the system and pass it string arguments. Returns "
|
||||
"the exit status of the program.")
|
||||
},
|
||||
{"os/shell", os_shell,
|
||||
"(os/shell str)\n\n"
|
||||
"Pass a command string str directly to the system shell."
|
||||
{
|
||||
"os/shell", os_shell,
|
||||
JDOC("(os/shell str)\n\n"
|
||||
"Pass a command string str directly to the system shell.")
|
||||
},
|
||||
{"os/exit", os_exit,
|
||||
"(os/exit x)\n\n"
|
||||
"Exit from janet with an exit code equal to x. If x is not an integer, "
|
||||
"the exit with status equal the hash of x."
|
||||
{
|
||||
"os/exit", os_exit,
|
||||
JDOC("(os/exit x)\n\n"
|
||||
"Exit from janet with an exit code equal to x. If x is not an integer, "
|
||||
"the exit with status equal the hash of x.")
|
||||
},
|
||||
{"os/getenv", os_getenv,
|
||||
"(os/getenv variable)\n\n"
|
||||
"Get the string value of an environment variable."
|
||||
{
|
||||
"os/getenv", os_getenv,
|
||||
JDOC("(os/getenv variable)\n\n"
|
||||
"Get the string value of an environment variable.")
|
||||
},
|
||||
{"os/setenv", os_setenv,
|
||||
"(os/setenv variable value)\n\n"
|
||||
"Set an environment variable."
|
||||
{
|
||||
"os/setenv", os_setenv,
|
||||
JDOC("(os/setenv variable value)\n\n"
|
||||
"Set an environment variable.")
|
||||
},
|
||||
{"os/time", os_time,
|
||||
"(os/time)\n\n"
|
||||
"Get the current time expressed as the number of seconds since "
|
||||
"January 1, 1970, the Unix epoch. Returns a real number."
|
||||
{
|
||||
"os/time", os_time,
|
||||
JDOC("(os/time)\n\n"
|
||||
"Get the current time expressed as the number of seconds since "
|
||||
"January 1, 1970, the Unix epoch. Returns a real number.")
|
||||
},
|
||||
{"os/clock", os_clock,
|
||||
"(os/clock)\n\n"
|
||||
"Return the number of seconds since some fixed point in time. The clock "
|
||||
"is guaranteed to be non decreased in real time."
|
||||
{
|
||||
"os/clock", os_clock,
|
||||
JDOC("(os/clock)\n\n"
|
||||
"Return the number of seconds since some fixed point in time. The clock "
|
||||
"is guaranteed to be non decreased in real time.")
|
||||
},
|
||||
{"os/sleep", os_sleep,
|
||||
"(os/sleep nsec)\n\n"
|
||||
"Suspend the program for nsec seconds. 'nsec' can be a real number. Returns "
|
||||
"nil."
|
||||
{
|
||||
"os/sleep", os_sleep,
|
||||
JDOC("(os/sleep nsec)\n\n"
|
||||
"Suspend the program for nsec seconds. 'nsec' can be a real number. Returns "
|
||||
"nil.")
|
||||
},
|
||||
{"os/cwd", os_cwd,
|
||||
"(os/cwd)\n\n"
|
||||
"Returns the current working directory."
|
||||
{
|
||||
"os/cwd", os_cwd,
|
||||
JDOC("(os/cwd)\n\n"
|
||||
"Returns the current working directory.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
/* Module entry point */
|
||||
int janet_lib_os(JanetArgs args) {
|
||||
JanetTable *env = janet_env(args);
|
||||
void janet_lib_os(JanetTable *env) {
|
||||
janet_cfuns(env, NULL, cfuns);
|
||||
return 0;
|
||||
}
|
||||
|
||||
423
src/core/parse.c
423
src/core/parse.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2018 Calvin Rose
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -21,6 +21,7 @@
|
||||
*/
|
||||
|
||||
#include <janet/janet.h>
|
||||
#include "util.h"
|
||||
|
||||
/* Check if a character is whitespace */
|
||||
static int is_whitespace(uint8_t c) {
|
||||
@@ -49,7 +50,7 @@ static int is_symbol_char(uint8_t c) {
|
||||
}
|
||||
|
||||
/* Validate some utf8. Useful for identifiers. Only validates
|
||||
* the encoding, does not check for valid codepoints (they
|
||||
* the encoding, does not check for valid code points (they
|
||||
* are less well defined than the encoding). */
|
||||
static int valid_utf8(const uint8_t *str, int32_t len) {
|
||||
int32_t i = 0;
|
||||
@@ -74,7 +75,7 @@ static int valid_utf8(const uint8_t *str, int32_t len) {
|
||||
if ((str[j] >> 6) != 2) return 0;
|
||||
}
|
||||
|
||||
/* Check for overlong encodings */
|
||||
/* Check for overlong encoding */
|
||||
if ((nexti == i + 2) && str[i] < 0xC2) return 0;
|
||||
if ((str[i] == 0xE0) && str[i + 1] < 0xA0) return 0;
|
||||
if ((str[i] == 0xF0) && str[i + 1] < 0x90) return 0;
|
||||
@@ -139,6 +140,7 @@ DEF_PARSER_STACK(_pushstate, JanetParseState, states, statecount, statecap)
|
||||
#define PFLAG_STRING 0x2000
|
||||
#define PFLAG_LONGSTRING 0x4000
|
||||
#define PFLAG_READERMAC 0x8000
|
||||
#define PFLAG_ATSYM 0x10000
|
||||
|
||||
static void pushstate(JanetParser *p, Consumer consumer, int flags) {
|
||||
JanetParseState s;
|
||||
@@ -161,12 +163,14 @@ static void popstate(JanetParser *p, Janet val) {
|
||||
janet_tuple_sm_end(janet_unwrap_tuple(val)) = (int32_t) p->offset;
|
||||
}
|
||||
newtop->argn++;
|
||||
/* Keep track of number of values in the root state */
|
||||
if (p->statecount == 1) p->pending++;
|
||||
push_arg(p, val);
|
||||
return;
|
||||
} else if (newtop->flags & PFLAG_READERMAC) {
|
||||
Janet *t = janet_tuple_begin(2);
|
||||
int c = newtop->flags & 0xFF;
|
||||
const char *which =
|
||||
const char *which =
|
||||
(c == '\'') ? "quote" :
|
||||
(c == ',') ? "unquote" :
|
||||
(c == ';') ? "splice" :
|
||||
@@ -282,7 +286,6 @@ static int tokenchar(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
Janet ret;
|
||||
double numval;
|
||||
int32_t blen;
|
||||
int scanerr;
|
||||
if (is_symbol_char(c)) {
|
||||
push_buf(p, (uint8_t) c);
|
||||
if (c > 127) state->argn = 1; /* Use to indicate non ascii */
|
||||
@@ -290,9 +293,9 @@ static int tokenchar(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
}
|
||||
/* Token finished */
|
||||
blen = (int32_t) p->bufcount;
|
||||
scanerr = 0;
|
||||
numval = janet_scan_number(p->buf, blen, &scanerr);
|
||||
if (!scanerr) {
|
||||
if (p->buf[0] == ':') {
|
||||
ret = janet_keywordv(p->buf + 1, blen - 1);
|
||||
} else if (!janet_scan_number(p->buf, blen, &numval)) {
|
||||
ret = janet_wrap_number(numval);
|
||||
} else if (!check_str_const("nil", p->buf, blen)) {
|
||||
ret = janet_wrap_nil();
|
||||
@@ -305,7 +308,7 @@ static int tokenchar(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
p->error = "symbol literal cannot start with a digit";
|
||||
return 0;
|
||||
} else {
|
||||
/* Don't do full utf8 check unless we have seen non ascii characters. */
|
||||
/* Don't do full utf-8 check unless we have seen non ascii characters. */
|
||||
int valid = (!state->argn) || valid_utf8(p->buf, blen);
|
||||
if (!valid) {
|
||||
p->error = "invalid utf-8 in symbol";
|
||||
@@ -328,78 +331,39 @@ static int comment(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
return 1;
|
||||
}
|
||||
|
||||
/* Forward declaration */
|
||||
static int root(JanetParser *p, JanetParseState *state, uint8_t c);
|
||||
|
||||
static int dotuple(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
if (state->flags & PFLAG_SQRBRACKETS
|
||||
? c == ']'
|
||||
: c == ')') {
|
||||
int32_t i;
|
||||
Janet *ret = janet_tuple_begin(state->argn);
|
||||
for (i = state->argn - 1; i >= 0; i--) {
|
||||
ret[i] = p->args[--p->argcount];
|
||||
}
|
||||
popstate(p, janet_wrap_tuple(janet_tuple_end(ret)));
|
||||
return 1;
|
||||
}
|
||||
return root(p, state, c);
|
||||
static Janet close_tuple(JanetParser *p, JanetParseState *state) {
|
||||
Janet *ret = janet_tuple_begin(state->argn);
|
||||
for (int32_t i = state->argn - 1; i >= 0; i--)
|
||||
ret[i] = p->args[--p->argcount];
|
||||
return janet_wrap_tuple(janet_tuple_end(ret));
|
||||
}
|
||||
|
||||
static int doarray(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
if (state->flags & PFLAG_SQRBRACKETS
|
||||
? c == ']'
|
||||
: c == ')') {
|
||||
int32_t i;
|
||||
JanetArray *array = janet_array(state->argn);
|
||||
for (i = state->argn - 1; i >= 0; i--) {
|
||||
array->data[i] = p->args[--p->argcount];
|
||||
}
|
||||
array->count = state->argn;
|
||||
popstate(p, janet_wrap_array(array));
|
||||
return 1;
|
||||
}
|
||||
return root(p, state, c);
|
||||
static Janet close_array(JanetParser *p, JanetParseState *state) {
|
||||
JanetArray *array = janet_array(state->argn);
|
||||
for (int32_t i = state->argn - 1; i >= 0; i--)
|
||||
array->data[i] = p->args[--p->argcount];
|
||||
array->count = state->argn;
|
||||
return janet_wrap_array(array);
|
||||
}
|
||||
|
||||
static int dostruct(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
if (c == '}') {
|
||||
int32_t i;
|
||||
JanetKV *st;
|
||||
if (state->argn & 1) {
|
||||
p->error = "struct literal expects even number of arguments";
|
||||
return 1;
|
||||
}
|
||||
st = janet_struct_begin(state->argn >> 1);
|
||||
for (i = state->argn; i > 0; i -= 2) {
|
||||
Janet value = p->args[--p->argcount];
|
||||
Janet key = p->args[--p->argcount];
|
||||
janet_struct_put(st, key, value);
|
||||
}
|
||||
popstate(p, janet_wrap_struct(janet_struct_end(st)));
|
||||
return 1;
|
||||
static Janet close_struct(JanetParser *p, JanetParseState *state) {
|
||||
JanetKV *st = janet_struct_begin(state->argn >> 1);
|
||||
for (int32_t i = state->argn; i > 0; i -= 2) {
|
||||
Janet value = p->args[--p->argcount];
|
||||
Janet key = p->args[--p->argcount];
|
||||
janet_struct_put(st, key, value);
|
||||
}
|
||||
return root(p, state, c);
|
||||
return janet_wrap_struct(janet_struct_end(st));
|
||||
}
|
||||
|
||||
static int dotable(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
if (c == '}') {
|
||||
int32_t i;
|
||||
JanetTable *table;
|
||||
if (state->argn & 1) {
|
||||
p->error = "table literal expects even number of arguments";
|
||||
return 1;
|
||||
}
|
||||
table = janet_table(state->argn >> 1);
|
||||
for (i = state->argn; i > 0; i -= 2) {
|
||||
Janet value = p->args[--p->argcount];
|
||||
Janet key = p->args[--p->argcount];
|
||||
janet_table_put(table, key, value);
|
||||
}
|
||||
popstate(p, janet_wrap_table(table));
|
||||
return 1;
|
||||
static Janet close_table(JanetParser *p, JanetParseState *state) {
|
||||
JanetTable *table = janet_table(state->argn >> 1);
|
||||
for (int32_t i = state->argn; i > 0; i -= 2) {
|
||||
Janet value = p->args[--p->argcount];
|
||||
Janet key = p->args[--p->argcount];
|
||||
janet_table_put(table, key, value);
|
||||
}
|
||||
return root(p, state, c);
|
||||
return janet_wrap_table(table);
|
||||
}
|
||||
|
||||
#define PFLAG_INSTRING 0x100000
|
||||
@@ -446,12 +410,14 @@ static int longstring(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
}
|
||||
}
|
||||
|
||||
static int root(JanetParser *p, JanetParseState *state, uint8_t c);
|
||||
|
||||
static int ampersand(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
(void) state;
|
||||
p->statecount--;
|
||||
switch (c) {
|
||||
case '{':
|
||||
pushstate(p, dotable, PFLAG_CONTAINER | PFLAG_CURLYBRACKETS);
|
||||
pushstate(p, root, PFLAG_CONTAINER | PFLAG_CURLYBRACKETS | PFLAG_ATSYM);
|
||||
return 1;
|
||||
case '"':
|
||||
pushstate(p, stringchar, PFLAG_BUFFER | PFLAG_STRING);
|
||||
@@ -460,10 +426,10 @@ static int ampersand(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
pushstate(p, longstring, PFLAG_BUFFER | PFLAG_LONGSTRING);
|
||||
return 1;
|
||||
case '[':
|
||||
pushstate(p, doarray, PFLAG_CONTAINER | PFLAG_SQRBRACKETS);
|
||||
pushstate(p, root, PFLAG_CONTAINER | PFLAG_SQRBRACKETS | PFLAG_ATSYM);
|
||||
return 1;
|
||||
case '(':
|
||||
pushstate(p, doarray, PFLAG_CONTAINER | PFLAG_PARENS);
|
||||
pushstate(p, root, PFLAG_CONTAINER | PFLAG_PARENS | PFLAG_ATSYM);
|
||||
return 1;
|
||||
default:
|
||||
break;
|
||||
@@ -475,7 +441,6 @@ static int ampersand(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
|
||||
/* The root state of the parser */
|
||||
static int root(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
(void) state;
|
||||
switch (c) {
|
||||
default:
|
||||
if (is_whitespace(c)) return 1;
|
||||
@@ -506,16 +471,44 @@ static int root(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
case ')':
|
||||
case ']':
|
||||
case '}':
|
||||
p->error = "mismatched delimiter";
|
||||
{
|
||||
Janet ds;
|
||||
if (p->statecount == 1) {
|
||||
p->error = "mismatched delimiter";
|
||||
return 1;
|
||||
}
|
||||
if ((c == ')' && (state->flags & PFLAG_PARENS)) ||
|
||||
(c == ']' && (state->flags & PFLAG_SQRBRACKETS))) {
|
||||
if (state->flags & PFLAG_ATSYM) {
|
||||
ds = close_array(p, state);
|
||||
} else {
|
||||
ds = close_tuple(p, state);
|
||||
}
|
||||
} else if (c == '}' && (state->flags & PFLAG_CURLYBRACKETS)) {
|
||||
if (state->argn & 1) {
|
||||
p->error = "struct and table literals expect even number of arguments";
|
||||
return 1;
|
||||
}
|
||||
if (state->flags & PFLAG_ATSYM) {
|
||||
ds = close_table(p, state);
|
||||
} else {
|
||||
ds = close_struct(p, state);
|
||||
}
|
||||
} else {
|
||||
p->error = "mismatched delimiter";
|
||||
return 1;
|
||||
}
|
||||
popstate(p, ds);
|
||||
}
|
||||
return 1;
|
||||
case '(':
|
||||
pushstate(p, dotuple, PFLAG_CONTAINER | PFLAG_PARENS);
|
||||
pushstate(p, root, PFLAG_CONTAINER | PFLAG_PARENS);
|
||||
return 1;
|
||||
case '[':
|
||||
pushstate(p, dotuple, PFLAG_CONTAINER | PFLAG_SQRBRACKETS);
|
||||
pushstate(p, root, PFLAG_CONTAINER | PFLAG_SQRBRACKETS);
|
||||
return 1;
|
||||
case '{':
|
||||
pushstate(p, dostruct, PFLAG_CONTAINER | PFLAG_CURLYBRACKETS);
|
||||
pushstate(p, root, PFLAG_CONTAINER | PFLAG_CURLYBRACKETS);
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
@@ -535,7 +528,6 @@ int janet_parser_consume(JanetParser *parser, uint8_t c) {
|
||||
enum JanetParserStatus janet_parser_status(JanetParser *parser) {
|
||||
if (parser->error) return JANET_PARSE_ERROR;
|
||||
if (parser->statecount > 1) return JANET_PARSE_PENDING;
|
||||
if (parser->argcount) return JANET_PARSE_FULL;
|
||||
return JANET_PARSE_ROOT;
|
||||
}
|
||||
|
||||
@@ -543,6 +535,7 @@ void janet_parser_flush(JanetParser *parser) {
|
||||
parser->argcount = 0;
|
||||
parser->statecount = 1;
|
||||
parser->bufcount = 0;
|
||||
parser->pending = 0;
|
||||
}
|
||||
|
||||
const char *janet_parser_error(JanetParser *parser) {
|
||||
@@ -559,12 +552,12 @@ const char *janet_parser_error(JanetParser *parser) {
|
||||
Janet janet_parser_produce(JanetParser *parser) {
|
||||
Janet ret;
|
||||
size_t i;
|
||||
enum JanetParserStatus status = janet_parser_status(parser);
|
||||
if (status != JANET_PARSE_FULL) return janet_wrap_nil();
|
||||
if (parser->pending == 0) return janet_wrap_nil();
|
||||
ret = parser->args[0];
|
||||
for (i = 1; i < parser->argcount; i++) {
|
||||
parser->args[i - 1] = parser->args[i];
|
||||
}
|
||||
parser->pending--;
|
||||
parser->argcount--;
|
||||
return ret;
|
||||
}
|
||||
@@ -582,6 +575,7 @@ void janet_parser_init(JanetParser *parser) {
|
||||
parser->error = NULL;
|
||||
parser->lookback = -1;
|
||||
parser->offset = 0;
|
||||
parser->pending = 0;
|
||||
|
||||
pushstate(parser, root, PFLAG_CONTAINER);
|
||||
}
|
||||
@@ -612,142 +606,110 @@ static int parsergc(void *p, size_t size) {
|
||||
}
|
||||
|
||||
static JanetAbstractType janet_parse_parsertype = {
|
||||
":core/parser",
|
||||
"core/parser",
|
||||
parsergc,
|
||||
parsermark
|
||||
};
|
||||
|
||||
JanetParser *janet_check_parser(Janet x) {
|
||||
if (!janet_checktype(x, JANET_ABSTRACT))
|
||||
return NULL;
|
||||
void *abstract = janet_unwrap_abstract(x);
|
||||
if (janet_abstract_type(abstract) != &janet_parse_parsertype)
|
||||
return NULL;
|
||||
return (JanetParser *)abstract;
|
||||
}
|
||||
|
||||
/* C Function parser */
|
||||
static int cfun_parser(JanetArgs args) {
|
||||
JANET_FIXARITY(args, 0);
|
||||
static Janet cfun_parser(int32_t argc, Janet *argv) {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
JanetParser *p = janet_abstract(&janet_parse_parsertype, sizeof(JanetParser));
|
||||
janet_parser_init(p);
|
||||
JANET_RETURN_ABSTRACT(args, p);
|
||||
return janet_wrap_abstract(p);
|
||||
}
|
||||
|
||||
static int cfun_consume(JanetArgs args) {
|
||||
const uint8_t *bytes;
|
||||
int32_t len;
|
||||
JanetParser *p;
|
||||
int32_t i;
|
||||
JANET_MINARITY(args, 2);
|
||||
JANET_MAXARITY(args, 3);
|
||||
JANET_CHECKABSTRACT(args, 0, &janet_parse_parsertype);
|
||||
p = (JanetParser *) janet_unwrap_abstract(args.v[0]);
|
||||
JANET_ARG_BYTES(bytes, len, args, 1);
|
||||
if (args.n == 3) {
|
||||
int32_t offset;
|
||||
JANET_ARG_INTEGER(offset, args, 2);
|
||||
if (offset < 0 || offset > len)
|
||||
JANET_THROW(args, "invalid offset");
|
||||
len -= offset;
|
||||
bytes += offset;
|
||||
static Janet cfun_consume(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 3);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||
JanetByteView view = janet_getbytes(argv, 1);
|
||||
if (argc == 3) {
|
||||
int32_t offset = janet_getinteger(argv, 2);
|
||||
if (offset < 0 || offset > view.len)
|
||||
janet_panicf("invalid offset %d out of range [0,%d]", offset, view.len);
|
||||
view.len -= offset;
|
||||
view.bytes += offset;
|
||||
}
|
||||
for (i = 0; i < len; i++) {
|
||||
janet_parser_consume(p, bytes[i]);
|
||||
int32_t i;
|
||||
for (i = 0; i < view.len; i++) {
|
||||
janet_parser_consume(p, view.bytes[i]);
|
||||
switch (janet_parser_status(p)) {
|
||||
case JANET_PARSE_ROOT:
|
||||
case JANET_PARSE_PENDING:
|
||||
break;
|
||||
default:
|
||||
JANET_RETURN_INTEGER(args, i + 1);
|
||||
return janet_wrap_integer(i + 1);
|
||||
}
|
||||
}
|
||||
JANET_RETURN_INTEGER(args, i);
|
||||
return janet_wrap_integer(i);
|
||||
}
|
||||
|
||||
static int cfun_byte(JanetArgs args) {
|
||||
int32_t i;
|
||||
JanetParser *p;
|
||||
JANET_FIXARITY(args, 2);
|
||||
JANET_CHECKABSTRACT(args, 0, &janet_parse_parsertype);
|
||||
p = (JanetParser *) janet_unwrap_abstract(args.v[0]);
|
||||
JANET_ARG_INTEGER(i, args, 1);
|
||||
static Janet cfun_has_more(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||
return janet_wrap_boolean(janet_parser_has_more(p));
|
||||
}
|
||||
|
||||
static Janet cfun_byte(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||
int32_t i = janet_getinteger(argv, 1);
|
||||
janet_parser_consume(p, 0xFF & i);
|
||||
JANET_RETURN(args, args.v[0]);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static int cfun_status(JanetArgs args) {
|
||||
static Janet cfun_status(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||
const char *stat = NULL;
|
||||
JanetParser *p;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_CHECKABSTRACT(args, 0, &janet_parse_parsertype);
|
||||
p = (JanetParser *) janet_unwrap_abstract(args.v[0]);
|
||||
switch (janet_parser_status(p)) {
|
||||
case JANET_PARSE_FULL:
|
||||
stat = ":full";
|
||||
break;
|
||||
case JANET_PARSE_PENDING:
|
||||
stat = ":pending";
|
||||
stat = "pending";
|
||||
break;
|
||||
case JANET_PARSE_ERROR:
|
||||
stat = ":error";
|
||||
stat = "error";
|
||||
break;
|
||||
case JANET_PARSE_ROOT:
|
||||
stat = ":root";
|
||||
stat = "root";
|
||||
break;
|
||||
}
|
||||
JANET_RETURN_CSYMBOL(args, stat);
|
||||
return janet_ckeywordv(stat);
|
||||
}
|
||||
|
||||
static int cfun_error(JanetArgs args) {
|
||||
const char *err;
|
||||
JanetParser *p;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_CHECKABSTRACT(args, 0, &janet_parse_parsertype);
|
||||
p = (JanetParser *) janet_unwrap_abstract(args.v[0]);
|
||||
err = janet_parser_error(p);
|
||||
if (err) {
|
||||
JANET_RETURN_CSYMBOL(args, err);
|
||||
} else {
|
||||
JANET_RETURN_NIL(args);
|
||||
}
|
||||
static Janet cfun_error(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||
const char *err = janet_parser_error(p);
|
||||
if (err) return janet_cstringv(err);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static int cfun_produce(JanetArgs args) {
|
||||
Janet val;
|
||||
JanetParser *p;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_CHECKABSTRACT(args, 0, &janet_parse_parsertype);
|
||||
p = (JanetParser *) janet_unwrap_abstract(args.v[0]);
|
||||
val = janet_parser_produce(p);
|
||||
JANET_RETURN(args, val);
|
||||
static Janet cfun_produce(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||
return janet_parser_produce(p);
|
||||
}
|
||||
|
||||
static int cfun_flush(JanetArgs args) {
|
||||
JanetParser *p;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_CHECKABSTRACT(args, 0, &janet_parse_parsertype);
|
||||
p = (JanetParser *) janet_unwrap_abstract(args.v[0]);
|
||||
static Janet cfun_flush(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||
janet_parser_flush(p);
|
||||
JANET_RETURN(args, args.v[0]);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static int cfun_where(JanetArgs args) {
|
||||
JanetParser *p;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_CHECKABSTRACT(args, 0, &janet_parse_parsertype);
|
||||
p = (JanetParser *) janet_unwrap_abstract(args.v[0]);
|
||||
JANET_RETURN_INTEGER(args, p->offset);
|
||||
static Janet cfun_where(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||
return janet_wrap_integer(p->offset);
|
||||
}
|
||||
|
||||
static int cfun_state(JanetArgs args) {
|
||||
static Janet cfun_state(int32_t argc, Janet *argv) {
|
||||
size_t i;
|
||||
const uint8_t *str;
|
||||
size_t oldcount;
|
||||
JanetParser *p;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_CHECKABSTRACT(args, 0, &janet_parse_parsertype);
|
||||
p = (JanetParser *) janet_unwrap_abstract(args.v[0]);
|
||||
janet_fixarity(argc, 1);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||
oldcount = p->bufcount;
|
||||
for (i = 0; i < p->statecount; i++) {
|
||||
JanetParseState *s = p->states + i;
|
||||
@@ -768,70 +730,83 @@ static int cfun_state(JanetArgs args) {
|
||||
}
|
||||
str = janet_string(p->buf + oldcount, (int32_t)(p->bufcount - oldcount));
|
||||
p->bufcount = oldcount;
|
||||
JANET_RETURN_STRING(args, str);
|
||||
return janet_wrap_string(str);
|
||||
}
|
||||
|
||||
static const JanetReg cfuns[] = {
|
||||
{"parser/new", cfun_parser,
|
||||
"(parser/new)\n\n"
|
||||
"Creates and returns a new parser object. Parsers are state machines "
|
||||
"that can receive bytes, and generate a stream of janet values. "
|
||||
{
|
||||
"parser/new", cfun_parser,
|
||||
JDOC("(parser/new)\n\n"
|
||||
"Creates and returns a new parser object. Parsers are state machines "
|
||||
"that can receive bytes, and generate a stream of janet values. ")
|
||||
},
|
||||
{"parser/produce", cfun_produce,
|
||||
"(parser/produce parser)\n\n"
|
||||
"Dequeue the next value in the parse queue. Will return nil if "
|
||||
"no parsed values are in the queue, otherwise will dequeue the "
|
||||
"next value."
|
||||
{
|
||||
"parser/has-more", cfun_has_more,
|
||||
JDOC("(parser/has-more parser)\n\n"
|
||||
"Check if the parser has more values in the value queue.")
|
||||
},
|
||||
{"parser/consume", cfun_consume,
|
||||
"(parser/consume parser bytes [, index])\n\n"
|
||||
"Input bytes into the parser and parse them. Will not throw errors "
|
||||
"if there is a parse error. Starts at the byte index given by index. Returns "
|
||||
"the number of bytes read."
|
||||
{
|
||||
"parser/produce", cfun_produce,
|
||||
JDOC("(parser/produce parser)\n\n"
|
||||
"Dequeue the next value in the parse queue. Will return nil if "
|
||||
"no parsed values are in the queue, otherwise will dequeue the "
|
||||
"next value.")
|
||||
},
|
||||
{"parser/byte", cfun_byte,
|
||||
"(parser/byte parser b)\n\n"
|
||||
"Input a single byte into the parser byte stream. Returns the parser."
|
||||
{
|
||||
"parser/consume", cfun_consume,
|
||||
JDOC("(parser/consume parser bytes [, index])\n\n"
|
||||
"Input bytes into the parser and parse them. Will not throw errors "
|
||||
"if there is a parse error. Starts at the byte index given by index. Returns "
|
||||
"the number of bytes read.")
|
||||
},
|
||||
{"parser/error", cfun_error,
|
||||
"(parser/error parser)\n\n"
|
||||
"If the parser is in the error state, returns the message asscoiated with "
|
||||
"that error. Otherwise, returns nil."
|
||||
{
|
||||
"parser/byte", cfun_byte,
|
||||
JDOC("(parser/byte parser b)\n\n"
|
||||
"Input a single byte into the parser byte stream. Returns the parser.")
|
||||
},
|
||||
{"parser/status", cfun_status,
|
||||
"(parser/status parser)\n\n"
|
||||
"Gets the current status of the parser state machine. The status will "
|
||||
"be one of:\n\n"
|
||||
"\t:full - there are values in the parse queue to be consumed.\n"
|
||||
"\t:pending - no values in the queue but a value is being parsed.\n"
|
||||
"\t:error - a parsing error was encountered.\n"
|
||||
"\t:root - the parser can either read more values or safely terminate."
|
||||
{
|
||||
"parser/error", cfun_error,
|
||||
JDOC("(parser/error parser)\n\n"
|
||||
"If the parser is in the error state, returns the message associated with "
|
||||
"that error. Otherwise, returns nil. Also flushes the parser state and parser "
|
||||
"queue, so be sure to handle everything in the queue before calling "
|
||||
"parser/error.")
|
||||
},
|
||||
{"parser/flush", cfun_flush,
|
||||
"(parser/flush parser)\n\n"
|
||||
"Clears the parser state and parse queue. Can be used to reset the parser "
|
||||
"if an error was encountered. Does not reset the line and column counter, so "
|
||||
"to begin parsing in a new context, create a new parser."
|
||||
{
|
||||
"parser/status", cfun_status,
|
||||
JDOC("(parser/status parser)\n\n"
|
||||
"Gets the current status of the parser state machine. The status will "
|
||||
"be one of:\n\n"
|
||||
"\t:pending - a value is being parsed.\n"
|
||||
"\t:error - a parsing error was encountered.\n"
|
||||
"\t:root - the parser can either read more values or safely terminate.")
|
||||
},
|
||||
{"parser/state", cfun_state,
|
||||
"(parser/state parser)\n\n"
|
||||
"Returns a string representation of the internal state of the parser. "
|
||||
"Each byte in the string represents a nested data structure. For example, "
|
||||
"if the parser state is '([\"', then the parser is in the middle of parsing a "
|
||||
"string inside of square brackets inside parens. Can be used to augment a repl prompt."
|
||||
{
|
||||
"parser/flush", cfun_flush,
|
||||
JDOC("(parser/flush parser)\n\n"
|
||||
"Clears the parser state and parse queue. Can be used to reset the parser "
|
||||
"if an error was encountered. Does not reset the line and column counter, so "
|
||||
"to begin parsing in a new context, create a new parser.")
|
||||
},
|
||||
{"parser/where", cfun_where,
|
||||
"(parser/where parser)\n\n"
|
||||
"Returns the current line number and column number of the parser's location "
|
||||
"in the byte stream as a tuple (line, column). Lines and columns are counted from "
|
||||
"1, (the first byte is line1, column 1) and a newline is considered ascii 0x0A."
|
||||
{
|
||||
"parser/state", cfun_state,
|
||||
JDOC("(parser/state parser)\n\n"
|
||||
"Returns a string representation of the internal state of the parser. "
|
||||
"Each byte in the string represents a nested data structure. For example, "
|
||||
"if the parser state is '([\"', then the parser is in the middle of parsing a "
|
||||
"string inside of square brackets inside parentheses. Can be used to augment a REPL prompt.")
|
||||
},
|
||||
{
|
||||
"parser/where", cfun_where,
|
||||
JDOC("(parser/where parser)\n\n"
|
||||
"Returns the current line number and column number of the parser's location "
|
||||
"in the byte stream as a tuple (line, column). Lines and columns are counted from "
|
||||
"1, (the first byte is line 1, column 1) and a newline is considered ASCII 0x0A.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
/* Load the library */
|
||||
int janet_lib_parse(JanetArgs args) {
|
||||
JanetTable *env = janet_env(args);
|
||||
void janet_lib_parse(JanetTable *env) {
|
||||
janet_cfuns(env, NULL, cfuns);
|
||||
return 0;
|
||||
}
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2018 Calvin Rose
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -57,7 +57,7 @@ static int32_t count_trailing_ones(uint32_t x) {
|
||||
/* Get N bits */
|
||||
#define nbits(N) (ithbit(N) - 1)
|
||||
|
||||
/* Copy a regsiter allocator */
|
||||
/* Copy a register allocator */
|
||||
void janetc_regalloc_clone(JanetcRegisterAllocator *dest, JanetcRegisterAllocator *src) {
|
||||
size_t size;
|
||||
dest->count = src->count;
|
||||
@@ -153,78 +153,3 @@ void janetc_regalloc_freetemp(JanetcRegisterAllocator *ra, int32_t reg, JanetcRe
|
||||
if (reg < 0xF0)
|
||||
janetc_regalloc_free(ra, reg);
|
||||
}
|
||||
|
||||
/* Disable multi-slot allocation for now. */
|
||||
|
||||
/*
|
||||
static int32_t checkrange(JanetcRegisterAllocator *ra, int32_t start, int32_t end) {
|
||||
int32_t startchunk = start / 32;
|
||||
int32_t endchunk = end / 32;
|
||||
for (int32_t chunk = startchunk; chunk <= endchunk; chunk++) {
|
||||
while (ra->count <= chunk) pushchunk(ra);
|
||||
uint32_t mask = 0xFFFFFFFF;
|
||||
if (chunk == startchunk)
|
||||
mask &= ~nbits(start & 0x1F);
|
||||
if (chunk == endchunk)
|
||||
mask &= nbits(end & 0x1F);
|
||||
uint32_t block = ra->chunks[chunk];
|
||||
uint32_t masking = mask & block;
|
||||
if (masking) {
|
||||
int32_t nextbit = (block == 0xFFFFFFFF)
|
||||
? 32
|
||||
: count_trailing_zeros(masking) + 1;
|
||||
return chunk * 32 + nextbit;
|
||||
}
|
||||
}
|
||||
return -1;
|
||||
}
|
||||
|
||||
static void markrange(JanetcRegisterAllocator *ra, int32_t start, int32_t end) {
|
||||
int32_t startchunk = start / 32;
|
||||
int32_t endchunk = end / 32;
|
||||
for (int32_t chunk = startchunk; chunk <= endchunk; chunk++) {
|
||||
uint32_t mask = 0xFFFFFFFF;
|
||||
if (chunk == startchunk)
|
||||
mask &= ~nbits(start & 0x1F);
|
||||
if (chunk == endchunk)
|
||||
mask &= nbits(end & 0x1F);
|
||||
ra->chunks[chunk] |= mask;
|
||||
}
|
||||
}
|
||||
|
||||
void janetc_regalloc_freerange(JanetcRegisterAllocator *ra, int32_t start, int32_t n) {
|
||||
int32_t end = start + n - 1;
|
||||
int32_t startchunk = start / 32;
|
||||
int32_t endchunk = end / 32;
|
||||
for (int32_t chunk = startchunk; chunk <= endchunk; chunk++) {
|
||||
uint32_t mask = 0;
|
||||
if (chunk == startchunk)
|
||||
mask |= nbits(start & 0x1F);
|
||||
if (chunk == endchunk)
|
||||
mask |= ~nbits(end & 0x1F);
|
||||
ra->chunks[chunk] &= mask;
|
||||
}
|
||||
}
|
||||
|
||||
int32_t janetc_regalloc_n(JanetcRegisterAllocator *ra, int32_t n) {
|
||||
int32_t start = 0, end = 0, next = 0;
|
||||
while (next >= 0) {
|
||||
start = next;
|
||||
end = start + n - 1;
|
||||
next = checkrange(ra, start, end);
|
||||
}
|
||||
markrange(ra, start, end);
|
||||
if (end > ra->max)
|
||||
ra->max = end;
|
||||
return start;
|
||||
}
|
||||
|
||||
int32_t janetc_regalloc_call(JanetcRegisterAllocator *ra, int32_t callee, int32_t nargs) {
|
||||
if (checkrange(ra, callee, callee + nargs) < 0) {
|
||||
markrange(ra, callee + 1, callee + nargs);
|
||||
return callee;
|
||||
}
|
||||
return janetc_regalloc_n(ra, nargs + 1);
|
||||
}
|
||||
|
||||
*/
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2018 Calvin Rose
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -44,7 +44,7 @@ typedef struct {
|
||||
int32_t count; /* number of chunks in chunks */
|
||||
int32_t capacity; /* amount allocated for chunks */
|
||||
int32_t max; /* The maximum allocated register so far */
|
||||
int32_t regtemps; /* Hold which tempregistered are alloced. */
|
||||
int32_t regtemps; /* Hold which temp. registers are allocated. */
|
||||
} JanetcRegisterAllocator;
|
||||
|
||||
void janetc_regalloc_init(JanetcRegisterAllocator *ra);
|
||||
@@ -57,11 +57,4 @@ void janetc_regalloc_freetemp(JanetcRegisterAllocator *ra, int32_t reg, JanetcRe
|
||||
void janetc_regalloc_clone(JanetcRegisterAllocator *dest, JanetcRegisterAllocator *src);
|
||||
void janetc_regalloc_touch(JanetcRegisterAllocator *ra, int32_t reg);
|
||||
|
||||
/* Mutli-slot allocation disabled */
|
||||
/*
|
||||
int32_t janetc_regalloc_n(JanetcRegisterAllocator *ra, int32_t n);
|
||||
int32_t janetc_regalloc_call(JanetcRegisterAllocator *ra, int32_t callee, int32_t nargs);
|
||||
void janetc_regalloc_freerange(JanetcRegisterAllocator *ra, int32_t regstart, int32_t n);
|
||||
*/
|
||||
|
||||
#endif
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2018 Calvin Rose
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -92,26 +92,29 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
||||
janet_parser_init(&parser);
|
||||
|
||||
while (!errflags && !done) {
|
||||
switch (janet_parser_status(&parser)) {
|
||||
case JANET_PARSE_FULL:
|
||||
{
|
||||
Janet form = janet_parser_produce(&parser);
|
||||
JanetCompileResult cres = janet_compile(form, env, where);
|
||||
if (cres.status == JANET_COMPILE_OK) {
|
||||
JanetFunction *f = janet_thunk(cres.funcdef);
|
||||
JanetFiber *fiber = janet_fiber(f, 64);
|
||||
JanetSignal status = janet_continue(fiber, janet_wrap_nil(), &ret);
|
||||
if (status != JANET_SIGNAL_OK) {
|
||||
janet_stacktrace(fiber, "runtime", ret);
|
||||
errflags |= 0x01;
|
||||
}
|
||||
} else {
|
||||
janet_stacktrace(cres.macrofiber, "compile",
|
||||
janet_wrap_string(cres.error));
|
||||
errflags |= 0x02;
|
||||
}
|
||||
|
||||
/* Evaluate parsed values */
|
||||
while (janet_parser_has_more(&parser)) {
|
||||
Janet form = janet_parser_produce(&parser);
|
||||
JanetCompileResult cres = janet_compile(form, env, where);
|
||||
if (cres.status == JANET_COMPILE_OK) {
|
||||
JanetFunction *f = janet_thunk(cres.funcdef);
|
||||
JanetFiber *fiber = janet_fiber(f, 64);
|
||||
JanetSignal status = janet_continue(fiber, janet_wrap_nil(), &ret);
|
||||
if (status != JANET_SIGNAL_OK) {
|
||||
janet_stacktrace(fiber, "runtime", ret);
|
||||
errflags |= 0x01;
|
||||
}
|
||||
break;
|
||||
} else {
|
||||
fprintf(stderr, "source path: %s\n", sourcePath);
|
||||
janet_stacktrace(cres.macrofiber, "compile",
|
||||
janet_wrap_string(cres.error));
|
||||
errflags |= 0x02;
|
||||
}
|
||||
}
|
||||
|
||||
/* Dispatch based on parse state */
|
||||
switch (janet_parser_status(&parser)) {
|
||||
case JANET_PARSE_ERROR:
|
||||
errflags |= 0x04;
|
||||
fprintf(stderr, "parse error: %s\n", janet_parser_error(&parser));
|
||||
@@ -137,6 +140,7 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
||||
}
|
||||
break;
|
||||
}
|
||||
|
||||
}
|
||||
janet_parser_deinit(&parser);
|
||||
if (where) janet_gcunroot(janet_wrap_string(where));
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2018 Calvin Rose
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -94,7 +94,7 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x) {
|
||||
janet_v_push(slots, key);
|
||||
janet_v_push(slots, value);
|
||||
}
|
||||
return qq_slots(opts, slots,
|
||||
return qq_slots(opts, slots,
|
||||
janet_checktype(x, JANET_TABLE) ? JOP_MAKE_TABLE : JOP_MAKE_STRUCT);
|
||||
}
|
||||
}
|
||||
@@ -116,7 +116,7 @@ static JanetSlot janetc_unquote(JanetFopts opts, int32_t argn, const Janet *argv
|
||||
}
|
||||
|
||||
/* Preform destructuring. Be careful to
|
||||
* keep the order registers are freed.
|
||||
* keep the order registers are freed.
|
||||
* Returns if the slot 'right' can be freed. */
|
||||
static int destructure(JanetCompiler *c,
|
||||
Janet left,
|
||||
@@ -182,19 +182,47 @@ static const Janet *janetc_make_sourcemap(JanetCompiler *c) {
|
||||
}
|
||||
|
||||
static JanetSlot janetc_varset(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
/*JanetFopts subopts = janetc_fopts_default(opts.compiler);*/
|
||||
/*JanetSlot ret, dest;*/
|
||||
Janet head;
|
||||
if (argn != 2) {
|
||||
janetc_cerror(opts.compiler, "expected 2 arguments");
|
||||
return janetc_cslot(janet_wrap_nil());
|
||||
}
|
||||
head = argv[0];
|
||||
if (!janet_checktype(head, JANET_SYMBOL)) {
|
||||
janetc_cerror(opts.compiler, "expected symbol");
|
||||
JanetFopts subopts = janetc_fopts_default(opts.compiler);
|
||||
if (janet_checktype(argv[0], JANET_SYMBOL)) {
|
||||
/* Normal var - (set a 1) */
|
||||
const uint8_t *sym = janet_unwrap_symbol(argv[0]);
|
||||
JanetSlot dest = janetc_resolve(opts.compiler, sym);
|
||||
if (!(dest.flags & JANET_SLOT_MUTABLE)) {
|
||||
janetc_cerror(opts.compiler, "cannot set constant");
|
||||
return janetc_cslot(janet_wrap_nil());
|
||||
}
|
||||
subopts.flags = JANET_FOPTS_HINT;
|
||||
subopts.hint = dest;
|
||||
JanetSlot ret = janetc_value(subopts, argv[1]);
|
||||
janetc_copy(opts.compiler, dest, ret);
|
||||
return ret;
|
||||
} else if (janet_checktype(argv[0], JANET_TUPLE)) {
|
||||
/* Set a field (setf behavior) - (set (tab :key) 2) */
|
||||
const Janet *tup = janet_unwrap_tuple(argv[0]);
|
||||
/* Tuple must have 2 elements */
|
||||
if (janet_tuple_length(tup) != 2) {
|
||||
janetc_cerror(opts.compiler, "expected 2 element tuple for l-value to set");
|
||||
return janetc_cslot(janet_wrap_nil());
|
||||
}
|
||||
JanetSlot ds = janetc_value(subopts, tup[0]);
|
||||
JanetSlot key = janetc_value(subopts, tup[1]);
|
||||
/* Can't be tail position because we will emit a PUT instruction afterwards */
|
||||
/* Also can't drop either */
|
||||
opts.flags &= ~(JANET_FOPTS_TAIL | JANET_FOPTS_DROP);
|
||||
JanetSlot rvalue = janetc_value(opts, argv[1]);
|
||||
/* Emit the PUT instruction */
|
||||
janetc_emit_sss(opts.compiler, JOP_PUT, ds, key, rvalue, 0);
|
||||
return rvalue;
|
||||
} else {
|
||||
/* Error */
|
||||
janet_inspect(argv[0]);
|
||||
janetc_cerror(opts.compiler, "expected symbol or tuple for l-value to set");
|
||||
return janetc_cslot(janet_wrap_nil());
|
||||
}
|
||||
return janetc_sym_lvalue(opts, janet_unwrap_symbol(head), argv[1]);
|
||||
}
|
||||
|
||||
/* Add attributes to a global def or var table */
|
||||
@@ -207,11 +235,11 @@ static JanetTable *handleattr(JanetCompiler *c, int32_t argn, const Janet *argv)
|
||||
default:
|
||||
janetc_cerror(c, "could not add metadata to binding");
|
||||
break;
|
||||
case JANET_SYMBOL:
|
||||
case JANET_KEYWORD:
|
||||
janet_table_put(tab, attr, janet_wrap_true());
|
||||
break;
|
||||
case JANET_STRING:
|
||||
janet_table_put(tab, janet_csymbolv(":doc"), attr);
|
||||
janet_table_put(tab, janet_ckeywordv("doc"), attr);
|
||||
break;
|
||||
}
|
||||
}
|
||||
@@ -260,8 +288,8 @@ static int varleaf(
|
||||
reftab->proto = attr;
|
||||
JanetArray *ref = janet_array(1);
|
||||
janet_array_push(ref, janet_wrap_nil());
|
||||
janet_table_put(reftab, janet_csymbolv(":ref"), janet_wrap_array(ref));
|
||||
janet_table_put(reftab, janet_csymbolv(":source-map"),
|
||||
janet_table_put(reftab, janet_ckeywordv("ref"), janet_wrap_array(ref));
|
||||
janet_table_put(reftab, janet_ckeywordv("source-map"),
|
||||
janet_wrap_tuple(janetc_make_sourcemap(c)));
|
||||
janet_table_put(c->env, janet_wrap_symbol(sym), janet_wrap_table(reftab));
|
||||
refslot = janetc_cslot(janet_wrap_array(ref));
|
||||
@@ -289,10 +317,10 @@ static int defleaf(
|
||||
JanetTable *attr) {
|
||||
if (c->scope->flags & JANET_SCOPE_TOP) {
|
||||
JanetTable *tab = janet_table(2);
|
||||
janet_table_put(tab, janet_csymbolv(":source-map"),
|
||||
janet_table_put(tab, janet_ckeywordv("source-map"),
|
||||
janet_wrap_tuple(janetc_make_sourcemap(c)));
|
||||
tab->proto = attr;
|
||||
JanetSlot valsym = janetc_cslot(janet_csymbolv(":value"));
|
||||
JanetSlot valsym = janetc_cslot(janet_ckeywordv("value"));
|
||||
JanetSlot tabslot = janetc_cslot(janet_wrap_table(tab));
|
||||
|
||||
/* Add env entry to env */
|
||||
@@ -511,7 +539,7 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
|
||||
/* Recompile in the function scope */
|
||||
cond = janetc_value(subopts, argv[0]);
|
||||
if (!(cond.flags & JANET_SLOT_CONSTANT)) {
|
||||
/* If not an infinte loop, return nil when condition false */
|
||||
/* If not an infinite loop, return nil when condition false */
|
||||
janetc_emit_si(c, JOP_JUMP_IF, cond, 2, 0);
|
||||
janetc_emit(c, JOP_RETURN_NIL);
|
||||
}
|
||||
@@ -536,7 +564,7 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
|
||||
return janetc_cslot(janet_wrap_nil());
|
||||
}
|
||||
|
||||
/* Compile jump to whiletop */
|
||||
/* Compile jump to :whiletop */
|
||||
labeljt = janet_v_count(c->buffer);
|
||||
janetc_emit(c, JOP_JUMP);
|
||||
|
||||
@@ -597,7 +625,7 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
Janet param = params[i];
|
||||
if (janet_checktype(param, JANET_SYMBOL)) {
|
||||
/* Check for varargs and unfixed arity */
|
||||
if ((!seenamp) &&
|
||||
if ((!seenamp) &&
|
||||
(0 == janet_cstrcmp(janet_unwrap_symbol(param), "&"))) {
|
||||
seenamp = 1;
|
||||
fixarity = 0;
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2018 Calvin Rose
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -27,10 +27,10 @@
|
||||
|
||||
/* The VM state. Rather than a struct that is passed
|
||||
* around, the vm state is global for simplicity. If
|
||||
* at some point a a global state object, or context,
|
||||
* is required to be passed around, this is waht would
|
||||
* be in it. However, thread local globals for interpreter
|
||||
* state should allow easy multithreading. */
|
||||
* at some point a global state object, or context,
|
||||
* is required to be passed around, this is what would
|
||||
* be in it. However, thread local global variables for interpreter
|
||||
* state should allow easy multi-threading. */
|
||||
|
||||
/* How many VM stacks have been entered */
|
||||
extern JANET_THREAD_LOCAL int janet_vm_stackn;
|
||||
@@ -39,7 +39,7 @@ extern JANET_THREAD_LOCAL int janet_vm_stackn;
|
||||
* Set and unset by janet_run. */
|
||||
extern JANET_THREAD_LOCAL JanetFiber *janet_vm_fiber;
|
||||
|
||||
/* The global registry for c functions. Used to store metadata
|
||||
/* The global registry for c functions. Used to store meta-data
|
||||
* along with otherwise bare c function pointers. */
|
||||
extern JANET_THREAD_LOCAL JanetTable *janet_vm_registry;
|
||||
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2018 Calvin Rose
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -21,26 +21,21 @@
|
||||
*/
|
||||
|
||||
/* Use a custom double parser instead of libc's strtod for better portability
|
||||
* and control. Also, uses a less strict rounding method than ieee to not incur
|
||||
* the cost of 4000 loc and dependence on arbitary precision arithmetic. There
|
||||
* is no plan to use arbitrary precision arithmetic for parsing numbers, and a
|
||||
* formal rounding mode has yet to be chosen (round towards 0 seems
|
||||
* reasonable).
|
||||
* and control.
|
||||
*
|
||||
* This version has been modified for much greater flexibility in parsing, such
|
||||
* as choosing the radix, supporting integer output, and returning Janets
|
||||
* directly.
|
||||
* as choosing the radix and supporting scientific notation with any radix.
|
||||
*
|
||||
* Numbers are of the form [-+]R[rR]I.F[eE&][-+]X where R is the radix, I is
|
||||
* the integer part, F is the fractional part, and X is the exponent. All
|
||||
* signs, radix, decimal point, fractional part, and exponent can be ommited.
|
||||
* signs, radix, decimal point, fractional part, and exponent can be omitted.
|
||||
* The number will be considered and integer if the there is no decimal point
|
||||
* and no exponent. Any number greater the 2^32-1 or less than -(2^32) will be
|
||||
* coerced to a double. If there is an error, the function janet_scan_number will
|
||||
* return a janet nil. The radix is assumed to be 10 if omitted, and the E
|
||||
* separator for the exponent can only be used when the radix is 10. This is
|
||||
* because E is a vaid digit in bases 15 or greater. For bases greater than 10,
|
||||
* the letters are used as digitis. A through Z correspond to the digits 10
|
||||
* because E is a valid digit in bases 15 or greater. For bases greater than 10,
|
||||
* the letters are used as digits. A through Z correspond to the digits 10
|
||||
* through 35, and the lowercase letters have the same values. The radix number
|
||||
* is always in base 10. For example, a hexidecimal number could be written
|
||||
* '16rdeadbeef'. janet_scan_number also supports some c style syntax for
|
||||
@@ -51,6 +46,7 @@
|
||||
|
||||
#include <janet/janet.h>
|
||||
#include <math.h>
|
||||
#include <string.h>
|
||||
|
||||
/* Lookup table for getting values of characters when parsing numbers. Handles
|
||||
* digits 0-9 and a-z (and A-Z). A-Z have values of 10 to 35. */
|
||||
@@ -65,98 +61,194 @@ static uint8_t digit_lookup[128] = {
|
||||
25,26,27,28,29,30,31,32,33,34,35,0xff,0xff,0xff,0xff,0xff
|
||||
};
|
||||
|
||||
#define BIGNAT_NBIT 31
|
||||
#define BIGNAT_BASE 0x80000000U
|
||||
|
||||
/* Allow for large mantissa. BigNat is a natural number. */
|
||||
struct BigNat {
|
||||
uint32_t first_digit; /* First digit so we don't need to allocate when not needed. */
|
||||
int32_t n; /* n digits */
|
||||
int32_t cap; /* allocated digit capacity */
|
||||
uint32_t *digits; /* Each digit is base (2 ^ 31). Digits are least significant first. */
|
||||
};
|
||||
|
||||
static void bignat_zero(struct BigNat *x) {
|
||||
x->first_digit = 0;
|
||||
x->n = 0;
|
||||
x->cap = 0;
|
||||
x->digits = NULL;
|
||||
}
|
||||
|
||||
/* Allocate n more digits for mant. Return a pointer to these digits. */
|
||||
static uint32_t *bignat_extra(struct BigNat *mant, int32_t n) {
|
||||
int32_t oldn = mant->n;
|
||||
int32_t newn = oldn + n;
|
||||
if (mant->cap < newn) {
|
||||
int32_t newcap = 2 * newn;
|
||||
uint32_t *mem = realloc(mant->digits, newcap * sizeof(uint32_t));
|
||||
if (NULL == mem) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
mant->cap = newcap;
|
||||
mant->digits = mem;
|
||||
}
|
||||
mant->n = newn;
|
||||
return mant->digits + oldn;
|
||||
}
|
||||
|
||||
/* Append a digit */
|
||||
static void bignat_append(struct BigNat *mant, uint32_t dig) {
|
||||
bignat_extra(mant, 1)[0] = dig;
|
||||
}
|
||||
|
||||
/* Multiply the mantissa mant by a factor and the add a term
|
||||
* in one operation. factor will be between 2 and 36^4,
|
||||
* term will be between 0 and 36. */
|
||||
static void bignat_muladd(struct BigNat *mant, uint32_t factor, uint32_t term) {
|
||||
int32_t i;
|
||||
uint64_t carry = ((uint64_t) mant->first_digit) * factor + term;
|
||||
mant->first_digit = carry % BIGNAT_BASE;
|
||||
carry /= BIGNAT_BASE;
|
||||
for (i = 0; i < mant->n; i++) {
|
||||
carry += ((uint64_t) mant->digits[i]) * factor;
|
||||
mant->digits[i] = carry % BIGNAT_BASE;
|
||||
carry /= BIGNAT_BASE;
|
||||
}
|
||||
if (carry) bignat_append(mant, (uint32_t) carry);
|
||||
}
|
||||
|
||||
/* Divide the mantissa mant by a factor. Drop the remainder. */
|
||||
static void bignat_div(struct BigNat *mant, uint32_t divisor) {
|
||||
int32_t i;
|
||||
uint32_t quotient, remainder;
|
||||
uint64_t dividend;
|
||||
remainder = 0;
|
||||
for (i = mant->n - 1; i >= 0; i--) {
|
||||
dividend = ((uint64_t)remainder * BIGNAT_BASE) + mant->digits[i];
|
||||
if (i < mant->n - 1) mant->digits[i + 1] = quotient;
|
||||
quotient = (uint32_t)(dividend / divisor);
|
||||
remainder = (uint32_t)(dividend % divisor);
|
||||
mant->digits[i] = remainder;
|
||||
}
|
||||
dividend = ((uint64_t)remainder * BIGNAT_BASE) + mant->first_digit;
|
||||
if (mant->n && mant->digits[mant->n - 1] == 0) mant->n--;
|
||||
mant->first_digit = (uint32_t)(dividend / divisor);
|
||||
}
|
||||
|
||||
/* Shift left by a multiple of BIGNAT_NBIT */
|
||||
static void bignat_lshift_n(struct BigNat *mant, int n) {
|
||||
if (!n) return;
|
||||
int32_t oldn = mant->n;
|
||||
bignat_extra(mant, n);
|
||||
memmove(mant->digits + n, mant->digits, sizeof(uint32_t) * oldn);
|
||||
memset(mant->digits, 0, sizeof(uint32_t) * (n - 1));
|
||||
mant->digits[n - 1] = mant->first_digit;
|
||||
mant->first_digit = 0;
|
||||
}
|
||||
|
||||
#ifdef __GNUC__
|
||||
#define clz(x) __builtin_clz(x)
|
||||
#else
|
||||
static int clz(uint32_t x) {
|
||||
int n = 0;
|
||||
if (x <= 0x0000ffff) n += 16, x <<= 16;
|
||||
if (x <= 0x00ffffff) n += 8, x <<= 8;
|
||||
if (x <= 0x0fffffff) n += 4, x <<= 4;
|
||||
if (x <= 0x3fffffff) n += 2, x <<= 2;
|
||||
if (x <= 0x7fffffff) n ++;
|
||||
return n;
|
||||
}
|
||||
#endif
|
||||
|
||||
/* Extract double value from mantissa */
|
||||
static double bignat_extract(struct BigNat *mant, int32_t exponent2) {
|
||||
uint64_t top53;
|
||||
int32_t n = mant->n;
|
||||
/* Get most significant 53 bits from mant. Bit 52 (0 indexed) should
|
||||
* always be 1. This is essentially a large right shift on mant.*/
|
||||
if (n) {
|
||||
/* Two or more digits */
|
||||
uint64_t d1 = mant->digits[n - 1]; /* MSD (non-zero) */
|
||||
uint64_t d2 = (n == 1) ? mant->first_digit : mant->digits[n - 2];
|
||||
uint64_t d3 = (n > 2) ? mant->digits[n - 3] : (n == 2) ? mant->first_digit : 0;
|
||||
int lz = clz((uint32_t) d1);
|
||||
int nbits = 32 - lz;
|
||||
/* First get 54 bits */
|
||||
top53 = (d2 << (54 - BIGNAT_NBIT)) + (d3 >> (2 * BIGNAT_NBIT - 54));
|
||||
top53 >>= nbits;
|
||||
top53 |= (d1 << (54 - nbits));
|
||||
/* Rounding based on lowest bit of 54 */
|
||||
if (top53 & 1) top53++;
|
||||
top53 >>= 1;
|
||||
if (top53 > 0x1FffffFFFFffffUL) {
|
||||
top53 >>= 1;
|
||||
exponent2++;
|
||||
}
|
||||
/* Correct exponent - to correct for large right shift to mantissa. */
|
||||
exponent2 += (nbits - 53) + BIGNAT_NBIT * n;
|
||||
} else {
|
||||
/* One digit */
|
||||
top53 = mant->first_digit;
|
||||
}
|
||||
return ldexp((double)top53, exponent2);
|
||||
}
|
||||
|
||||
/* Read in a mantissa and exponent of a certain base, and give
|
||||
* back the double value. Should properly handle 0s, Inifinties, and
|
||||
* back the double value. Should properly handle 0s, Infinities, and
|
||||
* denormalized numbers. (When the exponent values are too large) */
|
||||
static double convert(
|
||||
int negative,
|
||||
uint64_t mantissa,
|
||||
struct BigNat *mant,
|
||||
int32_t base,
|
||||
int32_t exponent) {
|
||||
|
||||
int32_t exponent2 = 0;
|
||||
|
||||
/* Short circuit zero and huge numbers */
|
||||
if (mantissa == 0)
|
||||
return 0.0;
|
||||
if (exponent > 1022)
|
||||
if (mant->n == 0 && mant->first_digit == 0)
|
||||
return negative ? -0.0 : 0.0;
|
||||
if (exponent > 1023)
|
||||
return negative ? -INFINITY : INFINITY;
|
||||
|
||||
/* TODO add fast paths */
|
||||
/* Final value is X = mant * base ^ exponent * 2 ^ exponent2
|
||||
* Get exponent to zero while holding X constant. */
|
||||
|
||||
/* Convert exponent on the base into exponent2, the power of
|
||||
* 2 the will be used. Modify the mantissa as we convert. */
|
||||
if (exponent > 0) {
|
||||
/* Make the mantissa large enough so no precision is lost */
|
||||
while (mantissa <= 0x03ffffffffffffffULL && exponent > 0) {
|
||||
mantissa *= base;
|
||||
exponent--;
|
||||
}
|
||||
while (exponent > 0) {
|
||||
/* Allow 6 bits of room when multiplying. This is because
|
||||
* the largest base is 36, which is 6 bits. The space of 6 should
|
||||
* prevent overflow.*/
|
||||
mantissa >>= 1;
|
||||
exponent2++;
|
||||
if (mantissa <= 0x03ffffffffffffffULL) {
|
||||
mantissa *= base;
|
||||
exponent--;
|
||||
}
|
||||
}
|
||||
} else {
|
||||
while (exponent < 0) {
|
||||
mantissa <<= 1;
|
||||
exponent2--;
|
||||
/* Ensure that the last bit is set for minimum error
|
||||
* before dividing by the base */
|
||||
if (mantissa > 0x7fffffffffffffffULL) {
|
||||
mantissa /= base;
|
||||
exponent++;
|
||||
}
|
||||
}
|
||||
/* Positive exponents are simple */
|
||||
for (;exponent > 3; exponent -= 4) bignat_muladd(mant, base * base * base * base, 0);
|
||||
for (;exponent > 1; exponent -= 2) bignat_muladd(mant, base * base, 0);
|
||||
for (;exponent > 0; exponent -= 1) bignat_muladd(mant, base, 0);
|
||||
|
||||
/* Negative exponents are tricky - we don't want to loose bits
|
||||
* from integer division, so we need to premultiply. */
|
||||
if (exponent < 0) {
|
||||
int32_t shamt = 5 - exponent / 4;
|
||||
bignat_lshift_n(mant, shamt);
|
||||
exponent2 -= shamt * BIGNAT_NBIT;
|
||||
for (;exponent < -3; exponent += 4) bignat_div(mant, base * base * base * base);
|
||||
for (;exponent < -2; exponent += 2) bignat_div(mant, base * base);
|
||||
for (;exponent < 0; exponent += 1) bignat_div(mant, base);
|
||||
}
|
||||
|
||||
return negative
|
||||
? -ldexp((double) mantissa, exponent2)
|
||||
: ldexp((double) mantissa, exponent2);
|
||||
? -bignat_extract(mant, exponent2)
|
||||
: bignat_extract(mant, exponent2);
|
||||
}
|
||||
|
||||
/* Result of scanning a number source string. Will be further processed
|
||||
* depending on the desired resultant type. */
|
||||
struct JanetScanRes {
|
||||
uint64_t mant;
|
||||
int32_t ex;
|
||||
int error;
|
||||
int base;
|
||||
int seenpoint;
|
||||
int foundexp;
|
||||
int neg;
|
||||
};
|
||||
|
||||
/* Get the mantissa and exponent of decimal number. The
|
||||
* mantissa will be stored in a 64 bit unsigned integer (always positive).
|
||||
* The exponent will be in a signed 32 bit integer. Will also check if
|
||||
* the decimal point has been seen. Returns -1 if there is an invalid
|
||||
* number. */
|
||||
static struct JanetScanRes janet_scan_impl(
|
||||
/* Scan a real (double) from a string. If the string cannot be converted into
|
||||
* and integer, set *err to 1 and return 0. */
|
||||
int janet_scan_number(
|
||||
const uint8_t *str,
|
||||
int32_t len) {
|
||||
|
||||
struct JanetScanRes res;
|
||||
int32_t len,
|
||||
double *out) {
|
||||
const uint8_t *end = str + len;
|
||||
|
||||
/* Initialize flags */
|
||||
int seenadigit = 0;
|
||||
int gotradix = 0;
|
||||
|
||||
/* Initialize result */
|
||||
res.mant = 0;
|
||||
res.ex = 0;
|
||||
res.error = 0;
|
||||
res.base = 10;
|
||||
res.seenpoint = 0;
|
||||
res.foundexp = 0;
|
||||
res.neg = 0;
|
||||
int ex = 0;
|
||||
int base = 10;
|
||||
int seenpoint = 0;
|
||||
int foundexp = 0;
|
||||
int neg = 0;
|
||||
struct BigNat mant;
|
||||
bignat_zero(&mant);
|
||||
|
||||
/* Prevent some kinds of overflow bugs relating to the exponent
|
||||
* overflowing. For example, if a string was passed 2GB worth of 0s after
|
||||
@@ -168,18 +260,36 @@ static struct JanetScanRes janet_scan_impl(
|
||||
/* Get sign */
|
||||
if (str >= end) goto error;
|
||||
if (*str == '-') {
|
||||
res.neg = 1;
|
||||
neg = 1;
|
||||
str++;
|
||||
} else if (*str == '+') {
|
||||
str++;
|
||||
}
|
||||
|
||||
/* Check for leading 0x or digit digit r */
|
||||
if (str + 1 < end && str[0] == '0' && str[1] == 'x') {
|
||||
base = 16;
|
||||
str += 2;
|
||||
} else if (str + 1 < end &&
|
||||
str[0] >= '0' && str[0] <= '9' &&
|
||||
str[1] == 'r') {
|
||||
base = str[0] - '0';
|
||||
str += 2;
|
||||
} else if (str + 2 < end &&
|
||||
str[0] >= '0' && str[0] <= '9' &&
|
||||
str[1] >= '0' && str[1] <= '9' &&
|
||||
str[2] == 'r') {
|
||||
base = 10 * (str[0] - '0') + (str[1] - '0');
|
||||
if (base < 2 || base > 36) goto error;
|
||||
str += 3;
|
||||
}
|
||||
|
||||
/* Skip leading zeros */
|
||||
while (str < end && (*str == '0' || *str == '.')) {
|
||||
if (res.seenpoint) res.ex--;
|
||||
if (seenpoint) ex--;
|
||||
if (*str == '.') {
|
||||
if (res.seenpoint) goto error;
|
||||
res.seenpoint = 1;
|
||||
if (seenpoint) goto error;
|
||||
seenpoint = 1;
|
||||
}
|
||||
seenadigit = 1;
|
||||
str++;
|
||||
@@ -188,37 +298,21 @@ static struct JanetScanRes janet_scan_impl(
|
||||
/* Parse significant digits */
|
||||
while (str < end) {
|
||||
if (*str == '.') {
|
||||
if (res.seenpoint) goto error;
|
||||
res.seenpoint = 1;
|
||||
if (seenpoint) goto error;
|
||||
seenpoint = 1;
|
||||
} else if (*str == '&') {
|
||||
res.foundexp = 1;
|
||||
foundexp = 1;
|
||||
break;
|
||||
} else if (res.base == 10 && (*str == 'E' || *str == 'e')) {
|
||||
res.foundexp = 1;
|
||||
} else if (base == 10 && (*str == 'E' || *str == 'e')) {
|
||||
foundexp = 1;
|
||||
break;
|
||||
} else if (!gotradix && (*str == 'x' || *str == 'X')) {
|
||||
} else if (*str == '_') {
|
||||
if (!seenadigit) goto error;
|
||||
if (res.seenpoint || res.mant > 0) goto error;
|
||||
res.base = 16;
|
||||
res.mant = 0;
|
||||
seenadigit = 0;
|
||||
gotradix = 1;
|
||||
} else if (!gotradix && (*str == 'r' || *str == 'R')) {
|
||||
if (res.seenpoint) goto error;
|
||||
if (res.mant < 2 || res.mant > 36) goto error;
|
||||
res.base = (int) res.mant;
|
||||
res.mant = 0;
|
||||
seenadigit = 0;
|
||||
gotradix = 1;
|
||||
} else if (*str != '_') {
|
||||
/* underscores are ignored - can be used for separator */
|
||||
} else {
|
||||
int digit = digit_lookup[*str & 0x7F];
|
||||
if (*str > 127 || digit >= res.base) goto error;
|
||||
if (res.seenpoint) res.ex--;
|
||||
if (res.mant > 0x00ffffffffffffff)
|
||||
res.ex++;
|
||||
else
|
||||
res.mant = res.base * res.mant + digit;
|
||||
if (*str > 127 || digit >= base) goto error;
|
||||
if (seenpoint) ex--;
|
||||
bignat_muladd(&mant, base, digit);
|
||||
seenadigit = 1;
|
||||
}
|
||||
str++;
|
||||
@@ -228,7 +322,7 @@ static struct JanetScanRes janet_scan_impl(
|
||||
goto error;
|
||||
|
||||
/* Read exponent */
|
||||
if (str < end && res.foundexp) {
|
||||
if (str < end && foundexp) {
|
||||
int eneg = 0;
|
||||
int ee = 0;
|
||||
seenadigit = 0;
|
||||
@@ -241,72 +335,28 @@ static struct JanetScanRes janet_scan_impl(
|
||||
str++;
|
||||
}
|
||||
/* Skip leading 0s in exponent */
|
||||
while (str < end && *str == '0') str++;
|
||||
while (str < end && ee < (INT32_MAX / 40)) {
|
||||
int digit = digit_lookup[*str & 0x7F];
|
||||
if (*str == '_') {
|
||||
str++;
|
||||
continue;
|
||||
}
|
||||
if (*str > 127 || digit >= res.base) goto error;
|
||||
ee = res.base * ee + digit;
|
||||
while (str < end && *str == '0') {
|
||||
str++;
|
||||
seenadigit = 1;
|
||||
}
|
||||
if (eneg) res.ex -= ee; else res.ex += ee;
|
||||
while (str < end && ee < (INT32_MAX / 40)) {
|
||||
int digit = digit_lookup[*str & 0x7F];
|
||||
if (*str > 127 || digit >= base) goto error;
|
||||
ee = base * ee + digit;
|
||||
str++;
|
||||
seenadigit = 1;
|
||||
}
|
||||
if (eneg) ex -= ee; else ex += ee;
|
||||
}
|
||||
|
||||
if (!seenadigit)
|
||||
goto error;
|
||||
|
||||
return res;
|
||||
|
||||
error:
|
||||
res.error = 1;
|
||||
return res;
|
||||
}
|
||||
|
||||
/* Scan an integer from a string. If the string cannot be converted into
|
||||
* and integer, set *err to 1 and return 0. */
|
||||
int32_t janet_scan_integer(
|
||||
const uint8_t *str,
|
||||
int32_t len,
|
||||
int *err) {
|
||||
struct JanetScanRes res = janet_scan_impl(str, len);
|
||||
int64_t i64;
|
||||
if (res.error) goto error;
|
||||
if (res.seenpoint) goto error;
|
||||
if (res.ex < 0) goto error;
|
||||
i64 = res.neg ? -(int64_t)res.mant : (int64_t)res.mant;
|
||||
while (res.ex > 0) {
|
||||
i64 *= res.base;
|
||||
if (i64 > INT32_MAX || i64 < INT32_MIN) goto error;
|
||||
res.ex--;
|
||||
}
|
||||
if (i64 > INT32_MAX || i64 < INT32_MIN) goto error;
|
||||
if (NULL != err)
|
||||
*err = 0;
|
||||
return (int32_t) i64;
|
||||
error:
|
||||
if (NULL != err)
|
||||
*err = 1;
|
||||
*out = convert(neg, &mant, base, ex);
|
||||
free(mant.digits);
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* Scan a real (double) from a string. If the string cannot be converted into
|
||||
* and integer, set *err to 1 and return 0. */
|
||||
double janet_scan_number(
|
||||
const uint8_t *str,
|
||||
int32_t len,
|
||||
int *err) {
|
||||
struct JanetScanRes res = janet_scan_impl(str, len);
|
||||
if (res.error) {
|
||||
if (NULL != err)
|
||||
*err = 1;
|
||||
return 0.0;
|
||||
} else {
|
||||
if (NULL != err)
|
||||
*err = 0;
|
||||
}
|
||||
return convert(res.neg, res.mant, res.base, res.ex);
|
||||
error:
|
||||
free(mant.digits);
|
||||
return 1;
|
||||
}
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2018 Calvin Rose
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -62,7 +62,7 @@ const JanetKV *janet_struct_find(const JanetKV *st, Janet key) {
|
||||
*
|
||||
* Runs will be in sorted order, as the collisions resolver essentially
|
||||
* preforms an in-place insertion sort. This ensures the internal structure of the
|
||||
* hash map is independant of insertion order.
|
||||
* hash map is independent of insertion order.
|
||||
*/
|
||||
void janet_struct_put(JanetKV *st, Janet key, Janet value) {
|
||||
int32_t cap = janet_struct_capacity(st);
|
||||
@@ -89,9 +89,9 @@ void janet_struct_put(JanetKV *st, Janet key, Janet value) {
|
||||
}
|
||||
/* Robinhood hashing - check if colliding kv pair
|
||||
* is closer to their source than current. We use robinhood
|
||||
* hashing to ensure that equivalent structs that are contsructed
|
||||
* hashing to ensure that equivalent structs that are constructed
|
||||
* with different order have the same internal layout, and therefor
|
||||
* will compare properly - i.e., {1 2 3 4} should equal {3 4 1 2}.
|
||||
* will compare properly - i.e., {1 2 3 4} should equal {3 4 1 2}.
|
||||
* Collisions are resolved via an insertion sort insertion. */
|
||||
otherhash = janet_hash(kv->key);
|
||||
otherindex = janet_maphash(cap, otherhash);
|
||||
@@ -158,17 +158,6 @@ Janet janet_struct_get(const JanetKV *st, Janet key) {
|
||||
return kv ? kv->value : janet_wrap_nil();
|
||||
}
|
||||
|
||||
/* Get the next key in a struct */
|
||||
const JanetKV *janet_struct_next(const JanetKV *st, const JanetKV *kv) {
|
||||
const JanetKV *end = st + janet_struct_capacity(st);
|
||||
kv = (kv == NULL) ? st : kv + 1;
|
||||
while (kv < end) {
|
||||
if (!janet_checktype(kv->key, JANET_NIL)) return kv;
|
||||
kv++;
|
||||
}
|
||||
return NULL;
|
||||
}
|
||||
|
||||
/* Convert struct to table */
|
||||
JanetTable *janet_struct_to_table(const JanetKV *st) {
|
||||
JanetTable *table = janet_table(janet_struct_capacity(st));
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2018 Calvin Rose
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -190,17 +190,6 @@ const uint8_t *janet_csymbol(const char *cstr) {
|
||||
return janet_symbol((const uint8_t *)cstr, len);
|
||||
}
|
||||
|
||||
/* Convert a string to a symbol */
|
||||
const uint8_t *janet_symbol_from_string(const uint8_t *str) {
|
||||
int success = 0;
|
||||
const uint8_t **bucket = janet_symcache_find(str, &success);
|
||||
if (success)
|
||||
return *bucket;
|
||||
janet_symcache_put((const uint8_t *)str, bucket);
|
||||
janet_gc_settype(janet_string_raw(str), JANET_MEMORY_SYMBOL);
|
||||
return str;
|
||||
}
|
||||
|
||||
/* Store counter for genysm to avoid quadratic behavior */
|
||||
JANET_THREAD_LOCAL uint8_t gensym_counter[8] = {'_', '0', '0', '0', '0', '0', '0', 0};
|
||||
|
||||
@@ -234,16 +223,16 @@ const uint8_t *janet_symbol_gen(void) {
|
||||
* is enough for resolving collisions. */
|
||||
do {
|
||||
hash = janet_string_calchash(
|
||||
gensym_counter,
|
||||
gensym_counter,
|
||||
sizeof(gensym_counter) - 1);
|
||||
bucket = janet_symcache_findmem(
|
||||
gensym_counter,
|
||||
gensym_counter,
|
||||
sizeof(gensym_counter) - 1,
|
||||
hash,
|
||||
&status);
|
||||
} while (status && (inc_gensym(), 1));
|
||||
sym = (uint8_t *) janet_gcalloc(
|
||||
JANET_MEMORY_SYMBOL,
|
||||
JANET_MEMORY_SYMBOL,
|
||||
2 * sizeof(int32_t) + sizeof(gensym_counter)) +
|
||||
(2 * sizeof(int32_t));
|
||||
memcpy(sym, gensym_counter, sizeof(gensym_counter));
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2018 Calvin Rose
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
127
src/core/table.c
127
src/core/table.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2018 Calvin Rose
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -158,18 +158,6 @@ void janet_table_clear(JanetTable *t) {
|
||||
t->deleted = 0;
|
||||
}
|
||||
|
||||
/* Find next key in an object. Returns NULL if no next key. */
|
||||
const JanetKV *janet_table_next(JanetTable *t, const JanetKV *kv) {
|
||||
JanetKV *end = t->data + t->capacity;
|
||||
kv = (kv == NULL) ? t->data : kv + 1;
|
||||
while (kv < end) {
|
||||
if (!janet_checktype(kv->key, JANET_NIL))
|
||||
return kv;
|
||||
kv++;
|
||||
}
|
||||
return NULL;
|
||||
}
|
||||
|
||||
/* Convert table to struct */
|
||||
const JanetKV *janet_table_to_struct(JanetTable *t) {
|
||||
JanetKV *st = janet_struct_begin(t->count);
|
||||
@@ -206,87 +194,80 @@ void janet_table_merge_struct(JanetTable *table, const JanetKV *other) {
|
||||
|
||||
/* C Functions */
|
||||
|
||||
static int cfun_new(JanetArgs args) {
|
||||
JanetTable *t;
|
||||
int32_t cap;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_ARG_INTEGER(cap, args, 0);
|
||||
t = janet_table(cap);
|
||||
JANET_RETURN_TABLE(args, t);
|
||||
static Janet cfun_new(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
int32_t cap = janet_getinteger(argv, 0);
|
||||
return janet_wrap_table(janet_table(cap));
|
||||
}
|
||||
|
||||
static int cfun_getproto(JanetArgs args) {
|
||||
JanetTable *t;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_ARG_TABLE(t, args, 0);
|
||||
JANET_RETURN(args, t->proto
|
||||
? janet_wrap_table(t->proto)
|
||||
: janet_wrap_nil());
|
||||
static Janet cfun_getproto(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetTable *t = janet_gettable(argv, 0);
|
||||
return t->proto
|
||||
? janet_wrap_table(t->proto)
|
||||
: janet_wrap_nil();
|
||||
}
|
||||
|
||||
static int cfun_setproto(JanetArgs args) {
|
||||
JanetTable *table, *proto;
|
||||
JANET_FIXARITY(args, 2);
|
||||
JANET_ARG_TABLE(table, args, 0);
|
||||
if (janet_checktype(args.v[1], JANET_NIL)) {
|
||||
proto = NULL;
|
||||
} else {
|
||||
JANET_ARG_TABLE(proto, args, 1);
|
||||
static Janet cfun_setproto(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetTable *table = janet_gettable(argv, 0);
|
||||
JanetTable *proto = NULL;
|
||||
if (!janet_checktype(argv[1], JANET_NIL)) {
|
||||
proto = janet_gettable(argv, 1);
|
||||
}
|
||||
table->proto = proto;
|
||||
JANET_RETURN_TABLE(args, table);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static int cfun_tostruct(JanetArgs args) {
|
||||
JanetTable *t;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_ARG_TABLE(t, args, 0);
|
||||
JANET_RETURN_STRUCT(args, janet_table_to_struct(t));
|
||||
static Janet cfun_tostruct(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetTable *t = janet_gettable(argv, 0);
|
||||
return janet_wrap_struct(janet_table_to_struct(t));
|
||||
}
|
||||
|
||||
static int cfun_rawget(JanetArgs args) {
|
||||
JanetTable *table;
|
||||
JANET_FIXARITY(args, 2);
|
||||
JANET_ARG_TABLE(table, args, 0);
|
||||
JANET_RETURN(args, janet_table_rawget(table, args.v[1]));
|
||||
static Janet cfun_rawget(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetTable *table = janet_gettable(argv, 0);
|
||||
return janet_table_rawget(table, argv[1]);
|
||||
}
|
||||
|
||||
static const JanetReg cfuns[] = {
|
||||
{"table/new", cfun_new,
|
||||
"(table/new capacity)\n\n"
|
||||
"Creates a new empty table with pre-allocated memory "
|
||||
"for capacity entries. This means that if one knows the number of "
|
||||
"entries going to go in a table on creation, extra memory allocation "
|
||||
"can be avoided. Returns the new table."
|
||||
{
|
||||
"table/new", cfun_new,
|
||||
JDOC("(table/new capacity)\n\n"
|
||||
"Creates a new empty table with pre-allocated memory "
|
||||
"for capacity entries. This means that if one knows the number of "
|
||||
"entries going to go in a table on creation, extra memory allocation "
|
||||
"can be avoided. Returns the new table.")
|
||||
},
|
||||
{"table/to-struct", cfun_tostruct,
|
||||
"(table/to-struct tab)\n\n"
|
||||
"Convert a table to a struct. Returns a new struct. This function "
|
||||
"does not take into account prototype tables."
|
||||
{
|
||||
"table/to-struct", cfun_tostruct,
|
||||
JDOC("(table/to-struct tab)\n\n"
|
||||
"Convert a table to a struct. Returns a new struct. This function "
|
||||
"does not take into account prototype tables.")
|
||||
},
|
||||
{"table/getproto", cfun_getproto,
|
||||
"(table/getproto tab)\n\n"
|
||||
"Get the prototype table of a table. Returns nil if a table "
|
||||
"has no prototype, otherwise returns the prototype."
|
||||
{
|
||||
"table/getproto", cfun_getproto,
|
||||
JDOC("(table/getproto tab)\n\n"
|
||||
"Get the prototype table of a table. Returns nil if a table "
|
||||
"has no prototype, otherwise returns the prototype.")
|
||||
},
|
||||
{"table/setproto", cfun_setproto,
|
||||
"(table/setproto tab proto)\n\n"
|
||||
"Set the prototype of a table. Returns the original table tab."
|
||||
{
|
||||
"table/setproto", cfun_setproto,
|
||||
JDOC("(table/setproto tab proto)\n\n"
|
||||
"Set the prototype of a table. Returns the original table tab.")
|
||||
},
|
||||
{"table/rawget", cfun_rawget,
|
||||
"(table/rawget tab key)\n\n"
|
||||
"Gets a value from a table without looking at the prototype table. "
|
||||
"If a table tab does not contain t directly, the function will return "
|
||||
"nil without checking the prototype. Returns the value in the table."
|
||||
{
|
||||
"table/rawget", cfun_rawget,
|
||||
JDOC("(table/rawget tab key)\n\n"
|
||||
"Gets a value from a table without looking at the prototype table. "
|
||||
"If a table tab does not contain t directly, the function will return "
|
||||
"nil without checking the prototype. Returns the value in the table.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
/* Load the table module */
|
||||
int janet_lib_table(JanetArgs args) {
|
||||
JanetTable *env = janet_env(args);
|
||||
void janet_lib_table(JanetTable *env) {
|
||||
janet_cfuns(env, NULL, cfuns);
|
||||
return 0;
|
||||
}
|
||||
|
||||
#undef janet_maphash
|
||||
|
||||
111
src/core/tuple.c
111
src/core/tuple.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2018 Calvin Rose
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -91,91 +91,58 @@ int janet_tuple_compare(const Janet *lhs, const Janet *rhs) {
|
||||
|
||||
/* C Functions */
|
||||
|
||||
static int cfun_slice(JanetArgs args) {
|
||||
const Janet *vals;
|
||||
int32_t len;
|
||||
Janet *ret;
|
||||
int32_t start, end;
|
||||
JANET_MINARITY(args, 1);
|
||||
if (!janet_indexed_view(args.v[0], &vals, &len)) JANET_THROW(args, "expected array/tuple");
|
||||
/* Get start */
|
||||
if (args.n < 2) {
|
||||
start = 0;
|
||||
} else {
|
||||
JANET_ARG_INTEGER(start, args, 1);
|
||||
}
|
||||
/* Get end */
|
||||
if (args.n < 3) {
|
||||
end = -1;
|
||||
} else {
|
||||
JANET_ARG_INTEGER(end, args, 2);
|
||||
}
|
||||
if (start < 0) start = len + start;
|
||||
if (end < 0) end = len + end + 1;
|
||||
if (end < 0 || start < 0 || end > len || start > len)
|
||||
JANET_THROW(args, "slice range out of bounds");
|
||||
if (end >= start) {
|
||||
ret = janet_tuple_begin(end - start);
|
||||
memcpy(ret, vals + start, sizeof(Janet) * (end - start));
|
||||
} else {
|
||||
ret = janet_tuple_begin(0);
|
||||
}
|
||||
JANET_RETURN_TUPLE(args, janet_tuple_end(ret));
|
||||
static Janet cfun_slice(int32_t argc, Janet *argv) {
|
||||
JanetRange range = janet_getslice(argc, argv);
|
||||
JanetView view = janet_getindexed(argv, 0);
|
||||
return janet_wrap_tuple(janet_tuple_n(view.items + range.start, range.end - range.start));
|
||||
}
|
||||
|
||||
static int cfun_prepend(JanetArgs args) {
|
||||
const Janet *t;
|
||||
int32_t len, i;
|
||||
Janet *n;
|
||||
JANET_MINARITY(args, 1);
|
||||
if (!janet_indexed_view(args.v[0], &t, &len))
|
||||
JANET_THROW(args, "expected tuple/array");
|
||||
n = janet_tuple_begin(len - 1 + args.n);
|
||||
memcpy(n - 1 + args.n, t, sizeof(Janet) * len);
|
||||
for (i = 1; i < args.n; i++) {
|
||||
n[args.n - i - 1] = args.v[i];
|
||||
static Janet cfun_prepend(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, -1);
|
||||
JanetView view = janet_getindexed(argv, 0);
|
||||
Janet *n = janet_tuple_begin(view.len - 1 + argc);
|
||||
memcpy(n - 1 + argc, view.items, sizeof(Janet) * view.len);
|
||||
for (int32_t i = 1; i < argc; i++) {
|
||||
n[argc - i - 1] = argv[i];
|
||||
}
|
||||
JANET_RETURN_TUPLE(args, janet_tuple_end(n));
|
||||
return janet_wrap_tuple(janet_tuple_end(n));
|
||||
}
|
||||
|
||||
static int cfun_append(JanetArgs args) {
|
||||
const Janet *t;
|
||||
int32_t len;
|
||||
Janet *n;
|
||||
JANET_MINARITY(args, 1);
|
||||
if (!janet_indexed_view(args.v[0], &t, &len))
|
||||
JANET_THROW(args, "expected tuple/array");
|
||||
n = janet_tuple_begin(len - 1 + args.n);
|
||||
memcpy(n, t, sizeof(Janet) * len);
|
||||
memcpy(n + len, args.v + 1, sizeof(Janet) * (args.n - 1));
|
||||
JANET_RETURN_TUPLE(args, janet_tuple_end(n));
|
||||
static Janet cfun_append(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, -1);
|
||||
JanetView view = janet_getindexed(argv, 0);
|
||||
Janet *n = janet_tuple_begin(view.len - 1 + argc);
|
||||
memcpy(n, view.items, sizeof(Janet) * view.len);
|
||||
memcpy(n + view.len, argv + 1, sizeof(Janet) * (argc - 1));
|
||||
return janet_wrap_tuple(janet_tuple_end(n));
|
||||
}
|
||||
|
||||
static const JanetReg cfuns[] = {
|
||||
{"tuple/slice", cfun_slice,
|
||||
"(tuple/slice arrtup [,start=0 [,end=(length arrtup)]])\n\n"
|
||||
"Take a sub sequence of an array or tuple from index start "
|
||||
"inclusive to index end exclusive. If start or end are not provided, "
|
||||
"they default to 0 and the length of arrtup respectively."
|
||||
"Returns the new tuple."
|
||||
{
|
||||
"tuple/slice", cfun_slice,
|
||||
JDOC("(tuple/slice arrtup [,start=0 [,end=(length arrtup)]])\n\n"
|
||||
"Take a sub sequence of an array or tuple from index start "
|
||||
"inclusive to index end exclusive. If start or end are not provided, "
|
||||
"they default to 0 and the length of arrtup respectively."
|
||||
"Returns the new tuple.")
|
||||
},
|
||||
{"tuple/append", cfun_append,
|
||||
"(tuple/append tup & items)\n\n"
|
||||
"Returns a new tuple that is the result of appending "
|
||||
"each element in items to tup."
|
||||
{
|
||||
"tuple/append", cfun_append,
|
||||
JDOC("(tuple/append tup & items)\n\n"
|
||||
"Returns a new tuple that is the result of appending "
|
||||
"each element in items to tup.")
|
||||
},
|
||||
{"tuple/prepend", cfun_prepend,
|
||||
"(tuple/prepend tup & items)\n\n"
|
||||
"Prepends each element in items to tuple and "
|
||||
"returns a new tuple. Items are prepended such that the "
|
||||
"last element in items is the first element in the new tuple."
|
||||
{
|
||||
"tuple/prepend", cfun_prepend,
|
||||
JDOC("(tuple/prepend tup & items)\n\n"
|
||||
"Prepends each element in items to tuple and "
|
||||
"returns a new tuple. Items are prepended such that the "
|
||||
"last element in items is the first element in the new tuple.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
/* Load the tuple module */
|
||||
int janet_lib_tuple(JanetArgs args) {
|
||||
JanetTable *env = janet_env(args);
|
||||
void janet_lib_tuple(JanetTable *env) {
|
||||
janet_cfuns(env, NULL, cfuns);
|
||||
return 0;
|
||||
}
|
||||
|
||||
236
src/core/util.c
236
src/core/util.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2018 Calvin Rose
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -21,6 +21,7 @@
|
||||
*/
|
||||
|
||||
#include <janet/janet.h>
|
||||
#include <inttypes.h>
|
||||
#include "util.h"
|
||||
#include "state.h"
|
||||
#include "gc.h"
|
||||
@@ -34,58 +35,59 @@ const char janet_base64[65] =
|
||||
|
||||
/* The JANET value types in order. These types can be used as
|
||||
* mnemonics instead of a bit pattern for type checking */
|
||||
const char *const janet_type_names[15] = {
|
||||
":nil",
|
||||
":boolean",
|
||||
":boolean",
|
||||
":fiber",
|
||||
":number",
|
||||
":string",
|
||||
":symbol",
|
||||
":array",
|
||||
":tuple",
|
||||
":table",
|
||||
":struct",
|
||||
":buffer",
|
||||
":function",
|
||||
":cfunction",
|
||||
":abstract"
|
||||
const char *const janet_type_names[16] = {
|
||||
"number",
|
||||
"nil",
|
||||
"boolean",
|
||||
"boolean",
|
||||
"fiber",
|
||||
"string",
|
||||
"symbol",
|
||||
"keyword",
|
||||
"array",
|
||||
"tuple",
|
||||
"table",
|
||||
"struct",
|
||||
"buffer",
|
||||
"function",
|
||||
"cfunction",
|
||||
"abstract"
|
||||
};
|
||||
|
||||
const char *const janet_signal_names[14] = {
|
||||
":ok",
|
||||
":error",
|
||||
":debug",
|
||||
":yield",
|
||||
":user0",
|
||||
":user1",
|
||||
":user2",
|
||||
":user3",
|
||||
":user4",
|
||||
":user5",
|
||||
":user6",
|
||||
":user7",
|
||||
":user8",
|
||||
":user9"
|
||||
"ok",
|
||||
"error",
|
||||
"debug",
|
||||
"yield",
|
||||
"user0",
|
||||
"user1",
|
||||
"user2",
|
||||
"user3",
|
||||
"user4",
|
||||
"user5",
|
||||
"user6",
|
||||
"user7",
|
||||
"user8",
|
||||
"user9"
|
||||
};
|
||||
|
||||
const char *const janet_status_names[16] = {
|
||||
":dead",
|
||||
":error",
|
||||
":debug",
|
||||
":pending",
|
||||
":user0",
|
||||
":user1",
|
||||
":user2",
|
||||
":user3",
|
||||
":user4",
|
||||
":user5",
|
||||
":user6",
|
||||
":user7",
|
||||
":user8",
|
||||
":user9",
|
||||
":new",
|
||||
":alive"
|
||||
"dead",
|
||||
"error",
|
||||
"debug",
|
||||
"pending",
|
||||
"user0",
|
||||
"user1",
|
||||
"user2",
|
||||
"user3",
|
||||
"user4",
|
||||
"user5",
|
||||
"user6",
|
||||
"user7",
|
||||
"user8",
|
||||
"user9",
|
||||
"new",
|
||||
"alive"
|
||||
};
|
||||
|
||||
/* Calculate hash for string */
|
||||
@@ -131,7 +133,7 @@ int32_t janet_tablen(int32_t n) {
|
||||
}
|
||||
|
||||
/* Helper to find a value in a Janet struct or table. Returns the bucket
|
||||
* containg the key, or the first empty bucket if there is no such key. */
|
||||
* containing the key, or the first empty bucket if there is no such key. */
|
||||
const JanetKV *janet_dict_find(const JanetKV *buckets, int32_t cap, Janet key) {
|
||||
int32_t index = janet_maphash(cap, janet_hash(key));
|
||||
int32_t i;
|
||||
@@ -186,7 +188,7 @@ const JanetKV *janet_dictionary_next(const JanetKV *kvs, int32_t cap, const Jane
|
||||
return NULL;
|
||||
}
|
||||
|
||||
/* Compare a janet string with a cstring. more efficient than loading
|
||||
/* Compare a janet string with a cstring. More efficient than loading
|
||||
* c string as a janet string. */
|
||||
int janet_cstrcmp(const uint8_t *str, const char *other) {
|
||||
int32_t len = janet_string_length(str);
|
||||
@@ -203,7 +205,7 @@ int janet_cstrcmp(const uint8_t *str, const char *other) {
|
||||
|
||||
/* Do a binary search on a static array of structs. Each struct must
|
||||
* have a string as its first element, and the struct must be sorted
|
||||
* lexogrpahically by that element. */
|
||||
* lexicographically by that element. */
|
||||
const void *janet_strbinsearch(
|
||||
const void *tab,
|
||||
size_t tabcount,
|
||||
@@ -238,9 +240,9 @@ void janet_register(const char *name, JanetCFunction cfun) {
|
||||
/* Add a def to an environment */
|
||||
void janet_def(JanetTable *env, const char *name, Janet val, const char *doc) {
|
||||
JanetTable *subt = janet_table(2);
|
||||
janet_table_put(subt, janet_csymbolv(":value"), val);
|
||||
janet_table_put(subt, janet_ckeywordv("value"), val);
|
||||
if (doc)
|
||||
janet_table_put(subt, janet_csymbolv(":doc"), janet_cstringv(doc));
|
||||
janet_table_put(subt, janet_ckeywordv("doc"), janet_cstringv(doc));
|
||||
janet_table_put(env, janet_csymbolv(name), janet_wrap_table(subt));
|
||||
}
|
||||
|
||||
@@ -249,9 +251,9 @@ void janet_var(JanetTable *env, const char *name, Janet val, const char *doc) {
|
||||
JanetArray *array = janet_array(1);
|
||||
JanetTable *subt = janet_table(2);
|
||||
janet_array_push(array, val);
|
||||
janet_table_put(subt, janet_csymbolv(":ref"), janet_wrap_array(array));
|
||||
janet_table_put(subt, janet_ckeywordv("ref"), janet_wrap_array(array));
|
||||
if (doc)
|
||||
janet_table_put(subt, janet_csymbolv(":doc"), janet_cstringv(doc));
|
||||
janet_table_put(subt, janet_ckeywordv("doc"), janet_cstringv(doc));
|
||||
janet_table_put(env, janet_csymbolv(name), janet_wrap_table(subt));
|
||||
}
|
||||
|
||||
@@ -268,7 +270,7 @@ void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns)
|
||||
uint8_t *longname_buffer =
|
||||
janet_string_begin(reglen + 1 + nmlen);
|
||||
memcpy(longname_buffer, regprefix, reglen);
|
||||
longname_buffer[reglen] = '.';
|
||||
longname_buffer[reglen] = '/';
|
||||
memcpy(longname_buffer + reglen + 1, cfuns->name, nmlen);
|
||||
longname = janet_wrap_symbol(janet_string_end(longname_buffer));
|
||||
}
|
||||
@@ -288,32 +290,20 @@ JanetBindingType janet_resolve(JanetTable *env, const uint8_t *sym, Janet *out)
|
||||
return JANET_BINDING_NONE;
|
||||
entry_table = janet_unwrap_table(entry);
|
||||
if (!janet_checktype(
|
||||
janet_table_get(entry_table, janet_csymbolv(":macro")),
|
||||
janet_table_get(entry_table, janet_ckeywordv("macro")),
|
||||
JANET_NIL)) {
|
||||
*out = janet_table_get(entry_table, janet_csymbolv(":value"));
|
||||
*out = janet_table_get(entry_table, janet_ckeywordv("value"));
|
||||
return JANET_BINDING_MACRO;
|
||||
}
|
||||
ref = janet_table_get(entry_table, janet_csymbolv(":ref"));
|
||||
ref = janet_table_get(entry_table, janet_ckeywordv("ref"));
|
||||
if (janet_checktype(ref, JANET_ARRAY)) {
|
||||
*out = ref;
|
||||
return JANET_BINDING_VAR;
|
||||
}
|
||||
*out = janet_table_get(entry_table, janet_csymbolv(":value"));
|
||||
*out = janet_table_get(entry_table, janet_ckeywordv("value"));
|
||||
return JANET_BINDING_DEF;
|
||||
}
|
||||
|
||||
/* Get module from the arguments passed to library */
|
||||
JanetTable *janet_env(JanetArgs args) {
|
||||
JanetTable *module;
|
||||
if (args.n >= 1 && janet_checktype(args.v[0], JANET_TABLE)) {
|
||||
module = janet_unwrap_table(args.v[0]);
|
||||
} else {
|
||||
module = janet_table(0);
|
||||
}
|
||||
*args.ret = janet_wrap_table(module);
|
||||
return module;
|
||||
}
|
||||
|
||||
/* Read both tuples and arrays as c pointers + int32_t length. Return 1 if the
|
||||
* view can be constructed, 0 if an invalid type. */
|
||||
int janet_indexed_view(Janet seq, const Janet **data, int32_t *len) {
|
||||
@@ -332,7 +322,8 @@ int janet_indexed_view(Janet seq, const Janet **data, int32_t *len) {
|
||||
/* Read both strings and buffer as unsigned character array + int32_t len.
|
||||
* Returns 1 if the view can be constructed and 0 if the type is invalid. */
|
||||
int janet_bytes_view(Janet str, const uint8_t **data, int32_t *len) {
|
||||
if (janet_checktype(str, JANET_STRING) || janet_checktype(str, JANET_SYMBOL)) {
|
||||
if (janet_checktype(str, JANET_STRING) || janet_checktype(str, JANET_SYMBOL) ||
|
||||
janet_checktype(str, JANET_KEYWORD)) {
|
||||
*data = janet_unwrap_string(str);
|
||||
*len = janet_string_length(janet_unwrap_string(str));
|
||||
return 1;
|
||||
@@ -362,67 +353,6 @@ int janet_dictionary_view(Janet tab, const JanetKV **data, int32_t *len, int32_t
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* Get actual type name of a value for debugging purposes */
|
||||
static const char *typestr(JanetArgs args, int32_t n) {
|
||||
JanetType actual = n < args.n ? janet_type(args.v[n]) : JANET_NIL;
|
||||
return ((actual == JANET_ABSTRACT)
|
||||
? janet_abstract_type(janet_unwrap_abstract(args.v[n]))->name
|
||||
: janet_type_names[actual]) + 1;
|
||||
}
|
||||
|
||||
int janet_type_err(JanetArgs args, int32_t n, JanetType expected) {
|
||||
const uint8_t *message = janet_formatc(
|
||||
"bad slot #%d, expected %t, got %s",
|
||||
n,
|
||||
expected,
|
||||
typestr(args, n));
|
||||
JANET_THROWV(args, janet_wrap_string(message));
|
||||
}
|
||||
|
||||
void janet_buffer_push_types(JanetBuffer *buffer, int types) {
|
||||
int first = 1;
|
||||
int i = 0;
|
||||
while (types) {
|
||||
if (1 & types) {
|
||||
if (first) {
|
||||
first = 0;
|
||||
} else {
|
||||
janet_buffer_push_u8(buffer, '|');
|
||||
}
|
||||
janet_buffer_push_cstring(buffer, janet_type_names[i] + 1);
|
||||
}
|
||||
i++;
|
||||
types >>= 1;
|
||||
}
|
||||
}
|
||||
|
||||
int janet_typemany_err(JanetArgs args, int32_t n, int expected) {
|
||||
const uint8_t *message;
|
||||
JanetBuffer buf;
|
||||
janet_buffer_init(&buf, 20);
|
||||
janet_buffer_push_string(&buf, janet_formatc("bad slot #%d, expected ", n));
|
||||
janet_buffer_push_types(&buf, expected);
|
||||
janet_buffer_push_cstring(&buf, ", got ");
|
||||
janet_buffer_push_cstring(&buf, typestr(args, n));
|
||||
message = janet_string(buf.data, buf.count);
|
||||
janet_buffer_deinit(&buf);
|
||||
JANET_THROWV(args, janet_wrap_string(message));
|
||||
}
|
||||
|
||||
int janet_arity_err(JanetArgs args, int32_t n, const char *prefix) {
|
||||
JANET_THROWV(args,
|
||||
janet_wrap_string(janet_formatc(
|
||||
"expected %s%d argument%s, got %d",
|
||||
prefix, n, n == 1 ? "" : "s", args.n)));
|
||||
}
|
||||
|
||||
int janet_typeabstract_err(JanetArgs args, int32_t n, const JanetAbstractType *at) {
|
||||
JANET_THROWV(args,
|
||||
janet_wrap_string(janet_formatc(
|
||||
"bad slot #%d, expected %s, got %s",
|
||||
n, at->name, typestr(args, n))));
|
||||
}
|
||||
|
||||
int janet_checkint(Janet x) {
|
||||
if (!janet_checktype(x, JANET_NUMBER))
|
||||
return 0;
|
||||
@@ -436,3 +366,43 @@ int janet_checkint64(Janet x) {
|
||||
double dval = janet_unwrap_number(x);
|
||||
return janet_checkint64range(dval);
|
||||
}
|
||||
|
||||
/* Useful for inspecting values while debugging */
|
||||
void janet_inspect(Janet x) {
|
||||
printf("<type=%s, ", janet_type_names[janet_type(x)]);
|
||||
|
||||
#ifdef JANET_BIG_ENDIAN
|
||||
printf("be ");
|
||||
#else
|
||||
printf("le ");
|
||||
#endif
|
||||
|
||||
#ifdef JANET_NANBOX_64
|
||||
printf("nanbox64 raw=0x%.16" PRIx64 ", ", x.u64);
|
||||
#endif
|
||||
|
||||
#ifdef JANET_NANBOX_32
|
||||
printf("nanbox32 type=0x%.8" PRIx32 ", ", x.tagged.type);
|
||||
printf("payload=%" PRId32 ", ", x.tagged.payload.integer);
|
||||
#endif
|
||||
|
||||
switch (janet_type(x)) {
|
||||
case JANET_NIL:
|
||||
printf("value=nil");
|
||||
break;
|
||||
case JANET_NUMBER:
|
||||
printf("number=%.17g", janet_unwrap_number(x));
|
||||
break;
|
||||
case JANET_TRUE:
|
||||
printf("value=true");
|
||||
break;
|
||||
case JANET_FALSE:
|
||||
printf("value=false");
|
||||
break;
|
||||
default:
|
||||
printf("pointer=%p", janet_unwrap_pointer(x));
|
||||
break;
|
||||
}
|
||||
|
||||
printf(">\n");
|
||||
}
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2018 Calvin Rose
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -25,6 +25,13 @@
|
||||
|
||||
#include <janet/janet.h>
|
||||
|
||||
/* Omit docstrings in some builds */
|
||||
#ifdef JANET_NO_BOOTSTRAP
|
||||
#define JDOC(x) NULL
|
||||
#else
|
||||
#define JDOC(x) x
|
||||
#endif
|
||||
|
||||
/* Utils */
|
||||
#define janet_maphash(cap, hash) ((uint32_t)(hash) & (cap - 1))
|
||||
extern const char janet_base64[65];
|
||||
@@ -35,6 +42,8 @@ int32_t janet_tablen(int32_t n);
|
||||
void janet_buffer_push_types(JanetBuffer *buffer, int types);
|
||||
const JanetKV *janet_dict_find(const JanetKV *buckets, int32_t cap, Janet key);
|
||||
Janet janet_dict_get(const JanetKV *buckets, int32_t cap, Janet key);
|
||||
void janet_memempty(JanetKV *mem, int32_t count);
|
||||
void *janet_memalloc_empty(int32_t count);
|
||||
const void *janet_strbinsearch(
|
||||
const void *tab,
|
||||
size_t tabcount,
|
||||
@@ -42,21 +51,21 @@ const void *janet_strbinsearch(
|
||||
const uint8_t *key);
|
||||
|
||||
/* Initialize builtin libraries */
|
||||
int janet_lib_io(JanetArgs args);
|
||||
int janet_lib_math(JanetArgs args);
|
||||
int janet_lib_array(JanetArgs args);
|
||||
int janet_lib_tuple(JanetArgs args);
|
||||
int janet_lib_buffer(JanetArgs args);
|
||||
int janet_lib_table(JanetArgs args);
|
||||
int janet_lib_fiber(JanetArgs args);
|
||||
int janet_lib_os(JanetArgs args);
|
||||
int janet_lib_string(JanetArgs args);
|
||||
int janet_lib_marsh(JanetArgs args);
|
||||
int janet_lib_parse(JanetArgs args);
|
||||
void janet_lib_io(JanetTable *env);
|
||||
void janet_lib_math(JanetTable *env);
|
||||
void janet_lib_array(JanetTable *env);
|
||||
void janet_lib_tuple(JanetTable *env);
|
||||
void janet_lib_buffer(JanetTable *env);
|
||||
void janet_lib_table(JanetTable *env);
|
||||
void janet_lib_fiber(JanetTable *env);
|
||||
void janet_lib_os(JanetTable *env);
|
||||
void janet_lib_string(JanetTable *env);
|
||||
void janet_lib_marsh(JanetTable *env);
|
||||
void janet_lib_parse(JanetTable *env);
|
||||
#ifdef JANET_ASSEMBLER
|
||||
int janet_lib_asm(JanetArgs args);
|
||||
void janet_lib_asm(JanetTable *env);
|
||||
#endif
|
||||
int janet_lib_compile(JanetArgs args);
|
||||
int janet_lib_debug(JanetArgs args);
|
||||
void janet_lib_compile(JanetTable *env);
|
||||
void janet_lib_debug(JanetTable *env);
|
||||
|
||||
#endif
|
||||
|
||||
102
src/core/value.c
102
src/core/value.c
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2018 Calvin Rose
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -74,6 +74,7 @@ int32_t janet_hash(Janet x) {
|
||||
break;
|
||||
case JANET_STRING:
|
||||
case JANET_SYMBOL:
|
||||
case JANET_KEYWORD:
|
||||
hash = janet_string_hash(janet_unwrap_string(x));
|
||||
break;
|
||||
case JANET_TUPLE:
|
||||
@@ -101,7 +102,7 @@ int32_t janet_hash(Janet x) {
|
||||
return hash;
|
||||
}
|
||||
|
||||
/* Compares x to y. If they are equal retuns 0. If x is less, returns -1.
|
||||
/* Compares x to y. If they are equal returns 0. If x is less, returns -1.
|
||||
* If y is less, returns 1. All types are comparable
|
||||
* and should have strict ordering. */
|
||||
int janet_compare(Janet x, Janet y) {
|
||||
@@ -112,7 +113,7 @@ int janet_compare(Janet x, Janet y) {
|
||||
case JANET_TRUE:
|
||||
return 0;
|
||||
case JANET_NUMBER:
|
||||
/* Check for nans to ensure total order */
|
||||
/* Check for NaNs to ensure total order */
|
||||
if (janet_unwrap_number(x) != janet_unwrap_number(x))
|
||||
return janet_unwrap_number(y) != janet_unwrap_number(y)
|
||||
? 0
|
||||
@@ -127,6 +128,7 @@ int janet_compare(Janet x, Janet y) {
|
||||
}
|
||||
case JANET_STRING:
|
||||
case JANET_SYMBOL:
|
||||
case JANET_KEYWORD:
|
||||
return janet_string_compare(janet_unwrap_string(x), janet_unwrap_string(y));
|
||||
case JANET_TUPLE:
|
||||
return janet_tuple_compare(janet_unwrap_tuple(x), janet_unwrap_tuple(y));
|
||||
@@ -143,13 +145,14 @@ int janet_compare(Janet x, Janet y) {
|
||||
return (janet_type(x) < janet_type(y)) ? -1 : 1;
|
||||
}
|
||||
|
||||
/* Gets a value and returns. If successful, return 0. If there is an error,
|
||||
* returns -1 for bad ds, -2 for bad key */
|
||||
int janet_get(Janet ds, Janet key, Janet *out) {
|
||||
/* Gets a value and returns. Can panic. */
|
||||
Janet janet_get(Janet ds, Janet key) {
|
||||
Janet value;
|
||||
switch (janet_type(ds)) {
|
||||
default:
|
||||
return -1;
|
||||
janet_panicf("expected %T, got %v", JANET_TFLAG_LENGTHABLE, ds);
|
||||
value = janet_wrap_nil();
|
||||
break;
|
||||
case JANET_STRUCT:
|
||||
value = janet_struct_get(janet_unwrap_struct(ds), key);
|
||||
break;
|
||||
@@ -160,7 +163,8 @@ int janet_get(Janet ds, Janet key, Janet *out) {
|
||||
{
|
||||
JanetArray *array = janet_unwrap_array(ds);
|
||||
int32_t index;
|
||||
if (!janet_checkint(key)) return -2;
|
||||
if (!janet_checkint(key))
|
||||
janet_panic("expected integer key");
|
||||
index = janet_unwrap_integer(key);
|
||||
if (index < 0 || index >= array->count) {
|
||||
value = janet_wrap_nil();
|
||||
@@ -173,10 +177,10 @@ int janet_get(Janet ds, Janet key, Janet *out) {
|
||||
{
|
||||
const Janet *tuple = janet_unwrap_tuple(ds);
|
||||
int32_t index;
|
||||
if (!janet_checkint(key)) return -2;
|
||||
if (!janet_checkint(key))
|
||||
janet_panic("expected integer key");
|
||||
index = janet_unwrap_integer(key);
|
||||
if (index < 0 || index >= janet_tuple_length(tuple)) {
|
||||
/*vm_throw("index out of bounds");*/
|
||||
value = janet_wrap_nil();
|
||||
} else {
|
||||
value = tuple[index];
|
||||
@@ -187,7 +191,8 @@ int janet_get(Janet ds, Janet key, Janet *out) {
|
||||
{
|
||||
JanetBuffer *buffer = janet_unwrap_buffer(ds);
|
||||
int32_t index;
|
||||
if (!janet_checkint(key)) return -2;
|
||||
if (!janet_checkint(key))
|
||||
janet_panic("expected integer key");
|
||||
index = janet_unwrap_integer(key);
|
||||
if (index < 0 || index >= buffer->count) {
|
||||
value = janet_wrap_nil();
|
||||
@@ -198,10 +203,12 @@ int janet_get(Janet ds, Janet key, Janet *out) {
|
||||
}
|
||||
case JANET_STRING:
|
||||
case JANET_SYMBOL:
|
||||
case JANET_KEYWORD:
|
||||
{
|
||||
const uint8_t *str = janet_unwrap_string(ds);
|
||||
int32_t index;
|
||||
if (!janet_checkint(key)) return -2;
|
||||
if (!janet_checkint(key))
|
||||
janet_panic("expected integer key");
|
||||
index = janet_unwrap_integer(key);
|
||||
if (index < 0 || index >= janet_string_length(str)) {
|
||||
value = janet_wrap_nil();
|
||||
@@ -211,19 +218,20 @@ int janet_get(Janet ds, Janet key, Janet *out) {
|
||||
break;
|
||||
}
|
||||
}
|
||||
*out = value;
|
||||
return 0;
|
||||
return value;
|
||||
}
|
||||
|
||||
int janet_getindex(Janet ds, int32_t index, Janet *out) {
|
||||
Janet janet_getindex(Janet ds, int32_t index) {
|
||||
Janet value;
|
||||
if (index < 0)
|
||||
return -2;
|
||||
if (index < 0) janet_panic("expected non-negative index");
|
||||
switch (janet_type(ds)) {
|
||||
default:
|
||||
return -1;
|
||||
janet_panicf("expected %T, got %v", JANET_TFLAG_LENGTHABLE, ds);
|
||||
value = janet_wrap_nil();
|
||||
break;
|
||||
case JANET_STRING:
|
||||
case JANET_SYMBOL:
|
||||
case JANET_KEYWORD:
|
||||
if (index >= janet_string_length(janet_unwrap_string(ds))) {
|
||||
value = janet_wrap_nil();
|
||||
} else {
|
||||
@@ -258,43 +266,37 @@ int janet_getindex(Janet ds, int32_t index, Janet *out) {
|
||||
value = janet_struct_get(janet_unwrap_struct(ds), janet_wrap_integer(index));
|
||||
break;
|
||||
}
|
||||
*out = value;
|
||||
return 0;
|
||||
return value;
|
||||
}
|
||||
|
||||
int janet_length(Janet x, int32_t *out) {
|
||||
int32_t len;
|
||||
int32_t janet_length(Janet x) {
|
||||
switch (janet_type(x)) {
|
||||
default:
|
||||
return -1;
|
||||
janet_panicf("expected %T, got %v", JANET_TFLAG_LENGTHABLE, x);
|
||||
return 0;
|
||||
case JANET_STRING:
|
||||
case JANET_SYMBOL:
|
||||
len = janet_string_length(janet_unwrap_string(x));
|
||||
break;
|
||||
case JANET_KEYWORD:
|
||||
return janet_string_length(janet_unwrap_string(x));
|
||||
case JANET_ARRAY:
|
||||
len = janet_unwrap_array(x)->count;
|
||||
break;
|
||||
return janet_unwrap_array(x)->count;
|
||||
case JANET_BUFFER:
|
||||
len = janet_unwrap_buffer(x)->count;
|
||||
break;
|
||||
return janet_unwrap_buffer(x)->count;
|
||||
case JANET_TUPLE:
|
||||
len = janet_tuple_length(janet_unwrap_tuple(x));
|
||||
break;
|
||||
return janet_tuple_length(janet_unwrap_tuple(x));
|
||||
case JANET_STRUCT:
|
||||
len = janet_struct_length(janet_unwrap_struct(x));
|
||||
break;
|
||||
return janet_struct_length(janet_unwrap_struct(x));
|
||||
case JANET_TABLE:
|
||||
len = janet_unwrap_table(x)->count;
|
||||
break;
|
||||
return janet_unwrap_table(x)->count;
|
||||
}
|
||||
*out = len;
|
||||
return 0;
|
||||
}
|
||||
|
||||
int janet_putindex(Janet ds, int32_t index, Janet value) {
|
||||
void janet_putindex(Janet ds, int32_t index, Janet value) {
|
||||
switch (janet_type(ds)) {
|
||||
default:
|
||||
return -1;
|
||||
janet_panicf("expected %T, got %v",
|
||||
JANET_TFLAG_ARRAY | JANET_TFLAG_BUFFER | JANET_TFLAG_TABLE, ds);
|
||||
break;
|
||||
case JANET_ARRAY:
|
||||
{
|
||||
JanetArray *array = janet_unwrap_array(ds);
|
||||
@@ -308,7 +310,8 @@ int janet_putindex(Janet ds, int32_t index, Janet value) {
|
||||
case JANET_BUFFER:
|
||||
{
|
||||
JanetBuffer *buffer = janet_unwrap_buffer(ds);
|
||||
if (!janet_checkint(value)) return -3;
|
||||
if (!janet_checkint(value))
|
||||
janet_panicf("can only put integers in buffers, got %v", value);
|
||||
if (index >= buffer->count) {
|
||||
janet_buffer_ensure(buffer, index + 1, 2);
|
||||
buffer->count = index + 1;
|
||||
@@ -323,20 +326,21 @@ int janet_putindex(Janet ds, int32_t index, Janet value) {
|
||||
break;
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
int janet_put(Janet ds, Janet key, Janet value) {
|
||||
void janet_put(Janet ds, Janet key, Janet value) {
|
||||
switch (janet_type(ds)) {
|
||||
default:
|
||||
return -1;
|
||||
janet_panicf("expected %T, got %v",
|
||||
JANET_TFLAG_ARRAY | JANET_TFLAG_BUFFER | JANET_TFLAG_TABLE, ds);
|
||||
break;
|
||||
case JANET_ARRAY:
|
||||
{
|
||||
int32_t index;
|
||||
JanetArray *array = janet_unwrap_array(ds);
|
||||
if (!janet_checkint(key)) return -2;
|
||||
if (!janet_checkint(key)) janet_panicf("expected integer key, got %v", key);
|
||||
index = janet_unwrap_integer(key);
|
||||
if (index < 0 || index == INT32_MAX) return -2;
|
||||
if (index < 0 || index == INT32_MAX) janet_panicf("bad integer key, got %v", key);
|
||||
if (index >= array->count) {
|
||||
janet_array_setcount(array, index + 1);
|
||||
}
|
||||
@@ -347,10 +351,11 @@ int janet_put(Janet ds, Janet key, Janet value) {
|
||||
{
|
||||
int32_t index;
|
||||
JanetBuffer *buffer = janet_unwrap_buffer(ds);
|
||||
if (!janet_checkint(key)) return -2;
|
||||
if (!janet_checkint(key)) janet_panicf("expected integer key, got %v", key);
|
||||
index = janet_unwrap_integer(key);
|
||||
if (index < 0 || index == INT32_MAX) return -2;
|
||||
if (!janet_checkint(value)) return -3;
|
||||
if (index < 0 || index == INT32_MAX) janet_panicf("bad integer key, got %v", key);
|
||||
if (!janet_checkint(value))
|
||||
janet_panicf("can only put integers in buffers, got %v", value);
|
||||
if (index >= buffer->count) {
|
||||
janet_buffer_setcount(buffer, index + 1);
|
||||
}
|
||||
@@ -361,5 +366,4 @@ int janet_put(Janet ds, Janet key, Janet value) {
|
||||
janet_table_put(janet_unwrap_table(ds), key, value);
|
||||
break;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2018 Calvin Rose
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2018 Calvin Rose
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
849
src/core/vm.c
849
src/core/vm.c
File diff suppressed because it is too large
Load Diff
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2018 Calvin Rose
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -22,6 +22,26 @@
|
||||
|
||||
#include <janet/janet.h>
|
||||
|
||||
void *janet_memalloc_empty(int32_t count) {
|
||||
int32_t i;
|
||||
void *mem = malloc(count * sizeof(JanetKV));
|
||||
JanetKV *mmem = (JanetKV *)mem;
|
||||
for (i = 0; i < count; i++) {
|
||||
JanetKV *kv = mmem + i;
|
||||
kv->key = janet_wrap_nil();
|
||||
kv->value = janet_wrap_nil();
|
||||
}
|
||||
return mem;
|
||||
}
|
||||
|
||||
void janet_memempty(JanetKV *mem, int32_t count) {
|
||||
int32_t i;
|
||||
for (i = 0; i < count; i++) {
|
||||
mem[i].key = janet_wrap_nil();
|
||||
mem[i].value = janet_wrap_nil();
|
||||
}
|
||||
}
|
||||
|
||||
#ifdef JANET_NANBOX_64
|
||||
|
||||
void *janet_nanbox_to_pointer(Janet x) {
|
||||
@@ -46,9 +66,6 @@ Janet janet_nanbox_from_cpointer(const void *p, uint64_t tagmask) {
|
||||
Janet janet_nanbox_from_double(double d) {
|
||||
Janet ret;
|
||||
ret.number = d;
|
||||
/* Normalize NaNs */
|
||||
if (d != d)
|
||||
ret.u64 = janet_nanbox_tag(JANET_NUMBER);
|
||||
return ret;
|
||||
}
|
||||
|
||||
@@ -58,26 +75,6 @@ Janet janet_nanbox_from_bits(uint64_t bits) {
|
||||
return ret;
|
||||
}
|
||||
|
||||
void *janet_nanbox_memalloc_empty(int32_t count) {
|
||||
int32_t i;
|
||||
void *mem = malloc(count * sizeof(JanetKV));
|
||||
JanetKV *mmem = (JanetKV *)mem;
|
||||
for (i = 0; i < count; i++) {
|
||||
JanetKV *kv = mmem + i;
|
||||
kv->key = janet_wrap_nil();
|
||||
kv->value = janet_wrap_nil();
|
||||
}
|
||||
return mem;
|
||||
}
|
||||
|
||||
void janet_nanbox_memempty(JanetKV *mem, int32_t count) {
|
||||
int32_t i;
|
||||
for (i = 0; i < count; i++) {
|
||||
mem[i].key = janet_wrap_nil();
|
||||
mem[i].value = janet_wrap_nil();
|
||||
}
|
||||
}
|
||||
|
||||
#elif defined(JANET_NANBOX_32)
|
||||
|
||||
Janet janet_wrap_number(double x) {
|
||||
@@ -154,6 +151,7 @@ Janet janet_wrap_##NAME(TYPE x) {\
|
||||
JANET_WRAP_DEFINE(number, double, JANET_NUMBER, number)
|
||||
JANET_WRAP_DEFINE(string, const uint8_t *, JANET_STRING, cpointer)
|
||||
JANET_WRAP_DEFINE(symbol, const uint8_t *, JANET_SYMBOL, cpointer)
|
||||
JANET_WRAP_DEFINE(keyword, const uint8_t *, JANET_KEYWORD, cpointer)
|
||||
JANET_WRAP_DEFINE(array, JanetArray *, JANET_ARRAY, pointer)
|
||||
JANET_WRAP_DEFINE(tuple, const Janet *, JANET_TUPLE, cpointer)
|
||||
JANET_WRAP_DEFINE(struct, const JanetKV *, JANET_STRUCT, cpointer)
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2018 Calvin Rose
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -29,7 +29,7 @@ extern "C" {
|
||||
|
||||
/***** START SECTION CONFIG *****/
|
||||
|
||||
#define JANET_VERSION "0.2.0"
|
||||
#define JANET_VERSION "0.3.0"
|
||||
|
||||
#ifndef JANET_BUILD
|
||||
#define JANET_BUILD "local"
|
||||
@@ -113,7 +113,7 @@ extern "C" {
|
||||
#define JANET_THREAD_LOCAL
|
||||
#endif
|
||||
|
||||
/* Enable or disbale dynamic module loading. Enabled by default. */
|
||||
/* Enable or disable dynamic module loading. Enabled by default. */
|
||||
#ifndef JANET_NO_DYNAMIC_MODULES
|
||||
#define JANET_DYNAMIC_MODULES
|
||||
#endif
|
||||
@@ -201,9 +201,10 @@ extern "C" {
|
||||
#include <string.h>
|
||||
#include <stdlib.h>
|
||||
#include <stdarg.h>
|
||||
#include <setjmp.h>
|
||||
|
||||
/* Names of all of the types */
|
||||
extern const char *const janet_type_names[15];
|
||||
extern const char *const janet_type_names[16];
|
||||
extern const char *const janet_signal_names[14];
|
||||
extern const char *const janet_status_names[16];
|
||||
|
||||
@@ -267,20 +268,24 @@ typedef struct JanetFuncEnv JanetFuncEnv;
|
||||
typedef struct JanetKV JanetKV;
|
||||
typedef struct JanetStackFrame JanetStackFrame;
|
||||
typedef struct JanetAbstractType JanetAbstractType;
|
||||
typedef struct JanetArgs JanetArgs;
|
||||
typedef struct JanetReg JanetReg;
|
||||
typedef struct JanetSourceMapping JanetSourceMapping;
|
||||
typedef int (*JanetCFunction)(JanetArgs args);
|
||||
typedef struct JanetView JanetView;
|
||||
typedef struct JanetByteView JanetByteView;
|
||||
typedef struct JanetDictView JanetDictView;
|
||||
typedef struct JanetRange JanetRange;
|
||||
typedef Janet (*JanetCFunction)(int32_t argc, Janet *argv);
|
||||
|
||||
/* Basic types for all Janet Values */
|
||||
typedef enum JanetType {
|
||||
JANET_NUMBER,
|
||||
JANET_NIL,
|
||||
JANET_FALSE,
|
||||
JANET_TRUE,
|
||||
JANET_FIBER,
|
||||
JANET_NUMBER,
|
||||
JANET_STRING,
|
||||
JANET_SYMBOL,
|
||||
JANET_KEYWORD,
|
||||
JANET_ARRAY,
|
||||
JANET_TUPLE,
|
||||
JANET_TABLE,
|
||||
@@ -301,6 +306,7 @@ typedef enum JanetType {
|
||||
#define JANET_TFLAG_NUMBER (1 << JANET_NUMBER)
|
||||
#define JANET_TFLAG_STRING (1 << JANET_STRING)
|
||||
#define JANET_TFLAG_SYMBOL (1 << JANET_SYMBOL)
|
||||
#define JANET_TFLAG_KEYWORD (1 << JANET_KEYWORD)
|
||||
#define JANET_TFLAG_ARRAY (1 << JANET_ARRAY)
|
||||
#define JANET_TFLAG_TUPLE (1 << JANET_TUPLE)
|
||||
#define JANET_TFLAG_TABLE (1 << JANET_TABLE)
|
||||
@@ -312,13 +318,13 @@ typedef enum JanetType {
|
||||
|
||||
/* Some abstractions */
|
||||
#define JANET_TFLAG_BOOLEAN (JANET_TFLAG_TRUE | JANET_TFLAG_FALSE)
|
||||
#define JANET_TFLAG_CALLABLE (JANET_TFLAG_FUNCTION | JANET_TFLAG_CFUNCTION)
|
||||
#define JANET_TFLAG_BYTES (JANET_TFLAG_STRING | JANET_TFLAG_SYMBOL | JANET_TFLAG_BUFFER)
|
||||
#define JANET_TFLAG_BYTES (JANET_TFLAG_STRING | JANET_TFLAG_SYMBOL | JANET_TFLAG_BUFFER | JANET_TFLAG_KEYWORD)
|
||||
#define JANET_TFLAG_INDEXED (JANET_TFLAG_ARRAY | JANET_TFLAG_TUPLE)
|
||||
#define JANET_TFLAG_DICTIONARY (JANET_TFLAG_TABLE | JANET_TFLAG_STRUCT)
|
||||
#define JANET_TFLAG_LENGTHABLE (JANET_TFLAG_BYTES | JANET_TFLAG_INDEXED | JANET_TFLAG_DICTIONARY)
|
||||
#define JANET_TFLAG_CALLABLE (JANET_TFLAG_FUNCTION | JANET_TFLAG_CFUNCTION)
|
||||
|
||||
/* We provide three possible implemenations of Janets. The preferred
|
||||
/* We provide three possible implementations of Janets. The preferred
|
||||
* nanboxing approach, for 32 or 64 bits, and the standard C version. Code in the rest of the
|
||||
* application must interact through exposed interface. */
|
||||
|
||||
@@ -372,17 +378,11 @@ union Janet {
|
||||
: janet_nanbox_checkauxtype((x), (t)))
|
||||
|
||||
JANET_API void *janet_nanbox_to_pointer(Janet x);
|
||||
JANET_API void janet_nanbox_memempty(JanetKV *mem, int32_t count);
|
||||
JANET_API void *janet_nanbox_memalloc_empty(int32_t count);
|
||||
JANET_API Janet janet_nanbox_from_pointer(void *p, uint64_t tagmask);
|
||||
JANET_API Janet janet_nanbox_from_cpointer(const void *p, uint64_t tagmask);
|
||||
JANET_API Janet janet_nanbox_from_double(double d);
|
||||
JANET_API Janet janet_nanbox_from_bits(uint64_t bits);
|
||||
|
||||
#define janet_memempty(mem, len) janet_nanbox_memempty((mem), (len))
|
||||
#define janet_memalloc_empty(count) janet_nanbox_memalloc_empty(count)
|
||||
|
||||
/* Todo - check for single mask operation */
|
||||
#define janet_truthy(x) \
|
||||
(!(janet_checktype((x), JANET_NIL) || janet_checktype((x), JANET_FALSE)))
|
||||
|
||||
@@ -416,6 +416,7 @@ JANET_API Janet janet_nanbox_from_bits(uint64_t bits);
|
||||
#define janet_wrap_buffer(s) janet_nanbox_wrap_((s), JANET_BUFFER)
|
||||
#define janet_wrap_string(s) janet_nanbox_wrap_c((s), JANET_STRING)
|
||||
#define janet_wrap_symbol(s) janet_nanbox_wrap_c((s), JANET_SYMBOL)
|
||||
#define janet_wrap_keyword(s) janet_nanbox_wrap_c((s), JANET_KEYWORD)
|
||||
#define janet_wrap_abstract(s) janet_nanbox_wrap_((s), JANET_ABSTRACT)
|
||||
#define janet_wrap_function(s) janet_nanbox_wrap_((s), JANET_FUNCTION)
|
||||
#define janet_wrap_cfunction(s) janet_nanbox_wrap_((s), JANET_CFUNCTION)
|
||||
@@ -429,6 +430,7 @@ JANET_API Janet janet_nanbox_from_bits(uint64_t bits);
|
||||
#define janet_unwrap_buffer(x) ((JanetBuffer *)janet_nanbox_to_pointer(x))
|
||||
#define janet_unwrap_string(x) ((const uint8_t *)janet_nanbox_to_pointer(x))
|
||||
#define janet_unwrap_symbol(x) ((const uint8_t *)janet_nanbox_to_pointer(x))
|
||||
#define janet_unwrap_keyword(x) ((const uint8_t *)janet_nanbox_to_pointer(x))
|
||||
#define janet_unwrap_abstract(x) (janet_nanbox_to_pointer(x))
|
||||
#define janet_unwrap_pointer(x) (janet_nanbox_to_pointer(x))
|
||||
#define janet_unwrap_function(x) ((JanetFunction *)janet_nanbox_to_pointer(x))
|
||||
@@ -461,9 +463,9 @@ union Janet {
|
||||
|
||||
#define janet_u64(x) ((x).u64)
|
||||
#define janet_type(x) (((x).tagged.type < JANET_DOUBLE_OFFSET) ? (x).tagged.type : JANET_NUMBER)
|
||||
#define janet_checktype(x, t) ((x).tagged.type == (t))
|
||||
#define janet_memempty(mem, count) memset((mem), 0, sizeof(JanetKV) * (count))
|
||||
#define janet_memalloc_empty(count) calloc((count), sizeof(JanetKV))
|
||||
#define janet_checktype(x, t) ((t) == JANET_NUMBER \
|
||||
? (x).tagged.type >= JANET_DOUBLE_OFFSET \
|
||||
: (x).tagged.type == (t))
|
||||
#define janet_truthy(x) ((x).tagged.type != JANET_NIL && (x).tagged.type != JANET_FALSE)
|
||||
|
||||
JANET_API Janet janet_wrap_number(double x);
|
||||
@@ -484,6 +486,7 @@ JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
|
||||
#define janet_wrap_buffer(s) janet_nanbox32_from_tagp(JANET_BUFFER, (void *)(s))
|
||||
#define janet_wrap_string(s) janet_nanbox32_from_tagp(JANET_STRING, (void *)(s))
|
||||
#define janet_wrap_symbol(s) janet_nanbox32_from_tagp(JANET_SYMBOL, (void *)(s))
|
||||
#define janet_wrap_keyword(s) janet_nanbox32_from_tagp(JANET_KEYWORD, (void *)(s))
|
||||
#define janet_wrap_abstract(s) janet_nanbox32_from_tagp(JANET_ABSTRACT, (void *)(s))
|
||||
#define janet_wrap_function(s) janet_nanbox32_from_tagp(JANET_FUNCTION, (void *)(s))
|
||||
#define janet_wrap_cfunction(s) janet_nanbox32_from_tagp(JANET_CFUNCTION, (void *)(s))
|
||||
@@ -496,6 +499,7 @@ JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
|
||||
#define janet_unwrap_buffer(x) ((JanetBuffer *)(x).tagged.payload.pointer)
|
||||
#define janet_unwrap_string(x) ((const uint8_t *)(x).tagged.payload.pointer)
|
||||
#define janet_unwrap_symbol(x) ((const uint8_t *)(x).tagged.payload.pointer)
|
||||
#define janet_unwrap_keyword(x) ((const uint8_t *)(x).tagged.payload.pointer)
|
||||
#define janet_unwrap_abstract(x) ((x).tagged.payload.pointer)
|
||||
#define janet_unwrap_pointer(x) ((x).tagged.payload.pointer)
|
||||
#define janet_unwrap_function(x) ((JanetFunction *)(x).tagged.payload.pointer)
|
||||
@@ -518,8 +522,6 @@ struct Janet {
|
||||
};
|
||||
|
||||
#define janet_u64(x) ((x).as.u64)
|
||||
#define janet_memempty(mem, count) memset((mem), 0, sizeof(JanetKV) * (count))
|
||||
#define janet_memalloc_empty(count) calloc((count), sizeof(JanetKV))
|
||||
#define janet_type(x) ((x).type)
|
||||
#define janet_checktype(x, t) ((x).type == (t))
|
||||
#define janet_truthy(x) \
|
||||
@@ -533,6 +535,7 @@ struct Janet {
|
||||
#define janet_unwrap_buffer(x) ((JanetBuffer *)(x).as.pointer)
|
||||
#define janet_unwrap_string(x) ((const uint8_t *)(x).as.pointer)
|
||||
#define janet_unwrap_symbol(x) ((const uint8_t *)(x).as.pointer)
|
||||
#define janet_unwrap_keyword(x) ((const uint8_t *)(x).as.pointer)
|
||||
#define janet_unwrap_abstract(x) ((x).as.pointer)
|
||||
#define janet_unwrap_pointer(x) ((x).as.pointer)
|
||||
#define janet_unwrap_function(x) ((JanetFunction *)(x).as.pointer)
|
||||
@@ -547,6 +550,7 @@ JANET_API Janet janet_wrap_false(void);
|
||||
JANET_API Janet janet_wrap_boolean(int x);
|
||||
JANET_API Janet janet_wrap_string(const uint8_t *x);
|
||||
JANET_API Janet janet_wrap_symbol(const uint8_t *x);
|
||||
JANET_API Janet janet_wrap_keyword(const uint8_t *x);
|
||||
JANET_API Janet janet_wrap_array(JanetArray *x);
|
||||
JANET_API Janet janet_wrap_tuple(const Janet *x);
|
||||
JANET_API Janet janet_wrap_struct(const JanetKV *x);
|
||||
@@ -562,17 +566,12 @@ JANET_API Janet janet_wrap_abstract(void *x);
|
||||
|
||||
JANET_API int janet_checkint(Janet x);
|
||||
JANET_API int janet_checkint64(Janet x);
|
||||
#define janet_checkintrange(x) ((x) == (int32_t)(x) && (x) >= INT32_MIN && (x) <= INT32_MAX)
|
||||
#define janet_checkintrange(x) ((x) == (int32_t)(x))
|
||||
#define janet_checkint64range(x) ((x) == (int64_t)(x))
|
||||
#define janet_unwrap_integer(x) ((int32_t) janet_unwrap_number(x))
|
||||
#define janet_wrap_integer(x) janet_wrap_number((int32_t)(x))
|
||||
|
||||
/* Hold components of arguments passed to JanetCFunction. */
|
||||
struct JanetArgs {
|
||||
Janet *v;
|
||||
Janet *ret;
|
||||
int32_t n;
|
||||
};
|
||||
#define janet_checktypes(x, tps) ((1 << janet_type(x)) & (tps))
|
||||
|
||||
/* Fiber signal masks. */
|
||||
#define JANET_FIBER_MASK_ERROR 2
|
||||
@@ -607,6 +606,7 @@ struct JanetFiber {
|
||||
int32_t capacity;
|
||||
int32_t maxstack; /* Arbitrary defined limit for stack overflow */
|
||||
int32_t flags; /* Various flags */
|
||||
jmp_buf buf; /* Handle errors */
|
||||
};
|
||||
|
||||
/* Mark if a stack frame is a tail call for debugging */
|
||||
@@ -631,7 +631,7 @@ struct JanetArray {
|
||||
int32_t capacity;
|
||||
};
|
||||
|
||||
/* A bytebuffer type. Used as a mutable string or string builder. */
|
||||
/* A byte buffer type. Used as a mutable string or string builder. */
|
||||
struct JanetBuffer {
|
||||
uint8_t *data;
|
||||
int32_t count;
|
||||
@@ -653,7 +653,7 @@ struct JanetKV {
|
||||
Janet value;
|
||||
};
|
||||
|
||||
/* Some function defintion flags */
|
||||
/* Some function definition flags */
|
||||
#define JANET_FUNCDEF_FLAG_VARARG 0x10000
|
||||
#define JANET_FUNCDEF_FLAG_NEEDSENV 0x20000
|
||||
#define JANET_FUNCDEF_FLAG_FIXARITY 0x40000
|
||||
@@ -691,7 +691,7 @@ struct JanetFuncDef {
|
||||
int32_t defs_length;
|
||||
};
|
||||
|
||||
/* A fuction environment */
|
||||
/* A function environment */
|
||||
struct JanetFuncEnv {
|
||||
union {
|
||||
JanetFiber *fiber;
|
||||
@@ -714,7 +714,6 @@ typedef struct JanetParser JanetParser;
|
||||
enum JanetParserStatus {
|
||||
JANET_PARSE_ROOT,
|
||||
JANET_PARSE_ERROR,
|
||||
JANET_PARSE_FULL,
|
||||
JANET_PARSE_PENDING
|
||||
};
|
||||
|
||||
@@ -731,6 +730,7 @@ struct JanetParser {
|
||||
size_t bufcount;
|
||||
size_t bufcap;
|
||||
size_t offset;
|
||||
size_t pending;
|
||||
int lookback;
|
||||
};
|
||||
|
||||
@@ -741,7 +741,7 @@ struct JanetAbstractType {
|
||||
int (*gcmark)(void *data, size_t len);
|
||||
};
|
||||
|
||||
/* Contains information about userdata */
|
||||
/* Contains information about abstract types */
|
||||
struct JanetAbstractHeader {
|
||||
const JanetAbstractType *type;
|
||||
size_t size;
|
||||
@@ -753,6 +753,27 @@ struct JanetReg {
|
||||
const char *documentation;
|
||||
};
|
||||
|
||||
struct JanetView {
|
||||
const Janet *items;
|
||||
int32_t len;
|
||||
};
|
||||
|
||||
struct JanetByteView {
|
||||
const uint8_t *bytes;
|
||||
int32_t len;
|
||||
};
|
||||
|
||||
struct JanetDictView {
|
||||
const JanetKV *kvs;
|
||||
int32_t len;
|
||||
int32_t cap;
|
||||
};
|
||||
|
||||
struct JanetRange {
|
||||
int32_t start;
|
||||
int32_t end;
|
||||
};
|
||||
|
||||
/***** END SECTION TYPES *****/
|
||||
|
||||
/***** START SECTION OPCODES *****/
|
||||
@@ -875,6 +896,7 @@ JANET_API Janet janet_parser_produce(JanetParser *parser);
|
||||
JANET_API const char *janet_parser_error(JanetParser *parser);
|
||||
JANET_API void janet_parser_flush(JanetParser *parser);
|
||||
JANET_API JanetParser *janet_check_parser(Janet x);
|
||||
#define janet_parser_has_more(P) ((P)->pending)
|
||||
|
||||
/* Assembly */
|
||||
#ifdef JANET_ASSEMBLER
|
||||
@@ -915,13 +937,12 @@ JANET_API int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len,
|
||||
JANET_API int janet_dostring(JanetTable *env, const char *str, const char *sourcePath, Janet *out);
|
||||
|
||||
/* Number scanning */
|
||||
JANET_API int32_t janet_scan_integer(const uint8_t *str, int32_t len, int *err);
|
||||
JANET_API double janet_scan_number(const uint8_t *str, int32_t len, int *err);
|
||||
JANET_API int janet_scan_number(const uint8_t *str, int32_t len, double *out);
|
||||
|
||||
/* Debugging */
|
||||
JANET_API int janet_debug_break(JanetFuncDef *def, int32_t pc);
|
||||
JANET_API int janet_debug_unbreak(JanetFuncDef *def, int32_t pc);
|
||||
JANET_API int janet_debug_find(
|
||||
JANET_API void janet_debug_break(JanetFuncDef *def, int32_t pc);
|
||||
JANET_API void janet_debug_unbreak(JanetFuncDef *def, int32_t pc);
|
||||
JANET_API void janet_debug_find(
|
||||
JanetFuncDef **def_out, int32_t *pc_out,
|
||||
const uint8_t *source, int32_t offset);
|
||||
|
||||
@@ -942,14 +963,14 @@ JANET_API JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity);
|
||||
JANET_API void janet_buffer_deinit(JanetBuffer *buffer);
|
||||
JANET_API void janet_buffer_ensure(JanetBuffer *buffer, int32_t capacity, int32_t growth);
|
||||
JANET_API void janet_buffer_setcount(JanetBuffer *buffer, int32_t count);
|
||||
JANET_API int janet_buffer_extra(JanetBuffer *buffer, int32_t n);
|
||||
JANET_API int janet_buffer_push_bytes(JanetBuffer *buffer, const uint8_t *string, int32_t len);
|
||||
JANET_API int janet_buffer_push_string(JanetBuffer *buffer, const uint8_t *string);
|
||||
JANET_API int janet_buffer_push_cstring(JanetBuffer *buffer, const char *cstring);
|
||||
JANET_API int janet_buffer_push_u8(JanetBuffer *buffer, uint8_t x);
|
||||
JANET_API int janet_buffer_push_u16(JanetBuffer *buffer, uint16_t x);
|
||||
JANET_API int janet_buffer_push_u32(JanetBuffer *buffer, uint32_t x);
|
||||
JANET_API int janet_buffer_push_u64(JanetBuffer *buffer, uint64_t x);
|
||||
JANET_API void janet_buffer_extra(JanetBuffer *buffer, int32_t n);
|
||||
JANET_API void janet_buffer_push_bytes(JanetBuffer *buffer, const uint8_t *string, int32_t len);
|
||||
JANET_API void janet_buffer_push_string(JanetBuffer *buffer, const uint8_t *string);
|
||||
JANET_API void janet_buffer_push_cstring(JanetBuffer *buffer, const char *cstring);
|
||||
JANET_API void janet_buffer_push_u8(JanetBuffer *buffer, uint8_t x);
|
||||
JANET_API void janet_buffer_push_u16(JanetBuffer *buffer, uint16_t x);
|
||||
JANET_API void janet_buffer_push_u32(JanetBuffer *buffer, uint32_t x);
|
||||
JANET_API void janet_buffer_push_u64(JanetBuffer *buffer, uint64_t x);
|
||||
|
||||
/* Tuple */
|
||||
#define janet_tuple_raw(t) ((int32_t *)(t) - 4)
|
||||
@@ -974,12 +995,10 @@ JANET_API const uint8_t *janet_cstring(const char *cstring);
|
||||
JANET_API int janet_string_compare(const uint8_t *lhs, const uint8_t *rhs);
|
||||
JANET_API int janet_string_equal(const uint8_t *lhs, const uint8_t *rhs);
|
||||
JANET_API int janet_string_equalconst(const uint8_t *lhs, const uint8_t *rhs, int32_t rlen, int32_t rhash);
|
||||
JANET_API const uint8_t *janet_string_unique(const uint8_t *buf, int32_t len);
|
||||
JANET_API const uint8_t *janet_cstring_unique(const char *s);
|
||||
JANET_API const uint8_t *janet_description(Janet x);
|
||||
JANET_API const uint8_t *janet_to_string(Janet x);
|
||||
JANET_API void janet_to_string_b(JanetBuffer *buffer, Janet x);
|
||||
JANET_API void janet_to_description_b(JanetBuffer *buffer, Janet x);
|
||||
JANET_API void janet_description_b(JanetBuffer *buffer, Janet x);
|
||||
#define janet_cstringv(cstr) janet_wrap_string(janet_cstring(cstr))
|
||||
#define janet_stringv(str, len) janet_wrap_string(janet_string((str), (len)))
|
||||
JANET_API const uint8_t *janet_formatc(const char *format, ...);
|
||||
@@ -987,12 +1006,17 @@ JANET_API void janet_puts(const uint8_t *str);
|
||||
|
||||
/* Symbol functions */
|
||||
JANET_API const uint8_t *janet_symbol(const uint8_t *str, int32_t len);
|
||||
JANET_API const uint8_t *janet_symbol_from_string(const uint8_t *str);
|
||||
JANET_API const uint8_t *janet_csymbol(const char *str);
|
||||
JANET_API const uint8_t *janet_symbol_gen(void);
|
||||
#define janet_symbolv(str, len) janet_wrap_symbol(janet_symbol((str), (len)))
|
||||
#define janet_csymbolv(cstr) janet_wrap_symbol(janet_csymbol(cstr))
|
||||
|
||||
/* Keyword functions */
|
||||
#define janet_keyword janet_symbol
|
||||
#define janet_ckeyword janet_csymbol
|
||||
#define janet_keywordv(str, len) janet_wrap_keyword(janet_keyword((str), (len)))
|
||||
#define janet_ckeywordv(cstr) janet_wrap_keyword(janet_ckeyword(cstr))
|
||||
|
||||
/* Structs */
|
||||
#define janet_struct_raw(t) ((int32_t *)(t) - 4)
|
||||
#define janet_struct_length(t) (janet_struct_raw(t)[0])
|
||||
@@ -1003,7 +1027,6 @@ JANET_API JanetKV *janet_struct_begin(int32_t count);
|
||||
JANET_API void janet_struct_put(JanetKV *st, Janet key, Janet value);
|
||||
JANET_API const JanetKV *janet_struct_end(JanetKV *st);
|
||||
JANET_API Janet janet_struct_get(const JanetKV *st, Janet key);
|
||||
JANET_API const JanetKV *janet_struct_next(const JanetKV *st, const JanetKV *kv);
|
||||
JANET_API JanetTable *janet_struct_to_table(const JanetKV *st);
|
||||
JANET_API int janet_struct_equal(const JanetKV *lhs, const JanetKV *rhs);
|
||||
JANET_API int janet_struct_compare(const JanetKV *lhs, const JanetKV *rhs);
|
||||
@@ -1017,7 +1040,6 @@ JANET_API Janet janet_table_get(JanetTable *t, Janet key);
|
||||
JANET_API Janet janet_table_rawget(JanetTable *t, Janet key);
|
||||
JANET_API Janet janet_table_remove(JanetTable *t, Janet key);
|
||||
JANET_API void janet_table_put(JanetTable *t, Janet key, Janet value);
|
||||
JANET_API const JanetKV *janet_table_next(JanetTable *t, const JanetKV *kv);
|
||||
JANET_API const JanetKV *janet_table_to_struct(JanetTable *t);
|
||||
JANET_API void janet_table_merge_table(JanetTable *table, JanetTable *other);
|
||||
JANET_API void janet_table_merge_struct(JanetTable *table, const JanetKV *other);
|
||||
@@ -1042,7 +1064,8 @@ JANET_API const JanetKV *janet_dictionary_next(const JanetKV *kvs, int32_t cap,
|
||||
JANET_API void *janet_abstract(const JanetAbstractType *type, size_t size);
|
||||
|
||||
/* Native */
|
||||
JANET_API JanetCFunction janet_native(const char *name, const uint8_t **error);
|
||||
typedef void (*JanetModule)(JanetTable *);
|
||||
JANET_API JanetModule janet_native(const char *name, const uint8_t **error);
|
||||
|
||||
/* Marshaling */
|
||||
JANET_API int janet_marshal(
|
||||
@@ -1082,11 +1105,12 @@ JANET_API int32_t janet_hash(Janet x);
|
||||
JANET_API int janet_compare(Janet x, Janet y);
|
||||
JANET_API int janet_cstrcmp(const uint8_t *str, const char *other);
|
||||
JANET_API JanetBuffer *janet_pretty(JanetBuffer *buffer, int depth, Janet x);
|
||||
JANET_API int janet_get(Janet ds, Janet key, Janet *out);
|
||||
JANET_API int janet_getindex(Janet ds, int32_t index, Janet *out);
|
||||
JANET_API int janet_length(Janet x, int32_t *out);
|
||||
JANET_API int janet_put(Janet ds, Janet key, Janet value);
|
||||
JANET_API int janet_putindex(Janet ds, int32_t index, Janet value);
|
||||
JANET_API Janet janet_get(Janet ds, Janet key);
|
||||
JANET_API Janet janet_getindex(Janet ds, int32_t index);
|
||||
JANET_API int32_t janet_length(Janet x);
|
||||
JANET_API void janet_put(Janet ds, Janet key, Janet value);
|
||||
JANET_API void janet_putindex(Janet ds, int32_t index, Janet value);
|
||||
JANET_API void janet_inspect(Janet x);
|
||||
|
||||
/* VM functions */
|
||||
JANET_API int janet_init(void);
|
||||
@@ -1106,150 +1130,45 @@ JANET_API void janet_def(JanetTable *env, const char *name, Janet val, const cha
|
||||
JANET_API void janet_var(JanetTable *env, const char *name, Janet val, const char *documentation);
|
||||
JANET_API void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns);
|
||||
JANET_API JanetBindingType janet_resolve(JanetTable *env, const uint8_t *sym, Janet *out);
|
||||
JANET_API JanetTable *janet_env(JanetArgs args);
|
||||
JANET_API void janet_register(const char *name, JanetCFunction cfun);
|
||||
|
||||
/* C Function helpers */
|
||||
JANET_API int janet_arity_err(JanetArgs args, int32_t n, const char *prefix);
|
||||
JANET_API int janet_type_err(JanetArgs args, int32_t n, JanetType expected);
|
||||
JANET_API int janet_typemany_err(JanetArgs args, int32_t n, int expected);
|
||||
JANET_API int janet_typeabstract_err(JanetArgs args, int32_t n, const JanetAbstractType *at);
|
||||
/* New C API */
|
||||
|
||||
/* Helpers for writing modules */
|
||||
#define JANET_MODULE_ENTRY JANET_API int _janet_init
|
||||
#define JANET_MODULE_ENTRY JANET_API void _janet_init
|
||||
JANET_API void janet_panicv(Janet message);
|
||||
JANET_API void janet_panic(const char *message);
|
||||
JANET_API void janet_panics(const uint8_t *message);
|
||||
#define janet_panicf(...) janet_panics(janet_formatc(__VA_ARGS__))
|
||||
#define janet_printf(...) fputs((const char *)janet_formatc(__VA_ARGS__), stdout)
|
||||
JANET_API void janet_panic_type(Janet x, int32_t n, int expected);
|
||||
JANET_API void janet_panic_abstract(Janet x, int32_t n, const JanetAbstractType *at);
|
||||
JANET_API void janet_arity(int32_t arity, int32_t min, int32_t max);
|
||||
JANET_API void janet_fixarity(int32_t arity, int32_t fix);
|
||||
|
||||
JANET_API double janet_getnumber(const Janet *argv, int32_t n);
|
||||
JANET_API JanetArray *janet_getarray(const Janet *argv, int32_t n);
|
||||
JANET_API const Janet *janet_gettuple(const Janet *argv, int32_t n);
|
||||
JANET_API JanetTable *janet_gettable(const Janet *argv, int32_t n);
|
||||
JANET_API const JanetKV *janet_getstruct(const Janet *argv, int32_t n);
|
||||
JANET_API const uint8_t *janet_getstring(const Janet *argv, int32_t n);
|
||||
JANET_API const uint8_t *janet_getsymbol(const Janet *argv, int32_t n);
|
||||
JANET_API const uint8_t *janet_getkeyword(const Janet *argv, int32_t n);
|
||||
JANET_API JanetBuffer *janet_getbuffer(const Janet *argv, int32_t n);
|
||||
JANET_API JanetFiber *janet_getfiber(const Janet *argv, int32_t n);
|
||||
JANET_API JanetFunction *janet_getfunction(const Janet *argv, int32_t n);
|
||||
JANET_API JanetCFunction janet_getcfunction(const Janet *argv, int32_t n);
|
||||
JANET_API int janet_getboolean(const Janet *argv, int32_t n);
|
||||
|
||||
JANET_API int32_t janet_getinteger(const Janet *argv, int32_t n);
|
||||
JANET_API int64_t janet_getinteger64(const Janet *argv, int32_t n);
|
||||
JANET_API JanetView janet_getindexed(const Janet *argv, int32_t n);
|
||||
JANET_API JanetByteView janet_getbytes(const Janet *argv, int32_t n);
|
||||
JANET_API JanetDictView janet_getdictionary(const Janet *argv, int32_t n);
|
||||
JANET_API void *janet_getabstract(const Janet *argv, int32_t n, const JanetAbstractType *at);
|
||||
JANET_API JanetRange janet_getslice(int32_t argc, const Janet *argv);
|
||||
|
||||
/***** END SECTION MAIN *****/
|
||||
|
||||
/***** START SECTION MACROS *****/
|
||||
|
||||
/* Macros */
|
||||
#define JANET_THROW(a, e) return (*((a).ret) = janet_cstringv(e), 1)
|
||||
#define JANET_THROWV(a, v) return (*((a).ret) = (v), 1)
|
||||
#define JANET_RETURN(a, v) return (*((a).ret) = (v), 0)
|
||||
|
||||
/* Early exit macros */
|
||||
#define JANET_MAXARITY(A, N) do { if ((A).n > (N))\
|
||||
return janet_arity_err(A, N, "at most "); } while (0)
|
||||
#define JANET_MINARITY(A, N) do { if ((A).n < (N))\
|
||||
return janet_arity_err(A, N, "at least "); } while (0)
|
||||
#define JANET_FIXARITY(A, N) do { if ((A).n != (N))\
|
||||
return janet_arity_err(A, N, ""); } while (0)
|
||||
#define JANET_CHECK(A, N, T) do {\
|
||||
if ((A).n > (N)) {\
|
||||
if (!janet_checktype((A).v[(N)], (T))) return janet_type_err(A, N, T);\
|
||||
} else {\
|
||||
if ((T) != JANET_NIL) return janet_type_err(A, N, T);\
|
||||
}\
|
||||
} while (0)
|
||||
#define JANET_CHECKMANY(A, N, TS) do {\
|
||||
if ((A).n > (N)) {\
|
||||
JanetType _t_ = janet_type((A).v[(N)]);\
|
||||
if (!((1 << _t_) & (TS))) return janet_typemany_err(A, N, TS);\
|
||||
} else {\
|
||||
if (!((TS) & JANET_NIL)) return janet_typemany_err(A, N, TS);\
|
||||
}\
|
||||
} while (0)
|
||||
|
||||
#define JANET_CHECKABSTRACT(A, N, AT) do {\
|
||||
if ((A).n > (N)) {\
|
||||
Janet _x_ = (A).v[(N)];\
|
||||
if (!janet_checktype(_x_, JANET_ABSTRACT) ||\
|
||||
janet_abstract_type(janet_unwrap_abstract(_x_)) != (AT))\
|
||||
return janet_typeabstract_err(A, N, AT);\
|
||||
} else {\
|
||||
return janet_typeabstract_err(A, N, AT);\
|
||||
}\
|
||||
} while (0)
|
||||
|
||||
#define JANET_ARG_BOOLEAN(DEST, A, N) do { \
|
||||
JANET_CHECKMANY(A, N, JANET_TFLAG_TRUE | JANET_TFLAG_FALSE);\
|
||||
DEST = janet_unwrap_boolean((A).v[(N)]); \
|
||||
} while (0)
|
||||
|
||||
#define JANET_ARG_BYTES(DESTBYTES, DESTLEN, A, N) do {\
|
||||
if ((A).n <= (N)) return janet_typemany_err(A, N, JANET_TFLAG_BYTES);\
|
||||
if (!janet_bytes_view((A).v[(N)], &(DESTBYTES), &(DESTLEN))) {\
|
||||
return janet_typemany_err(A, N, JANET_TFLAG_BYTES);\
|
||||
}\
|
||||
} while (0)
|
||||
|
||||
#define JANET_ARG_INDEXED(DESTVALS, DESTLEN, A, N) do {\
|
||||
if ((A).n <= (N)) return janet_typemany_err(A, N, JANET_TFLAG_INDEXED);\
|
||||
if (!janet_indexed_view((A).v[(N)], &(DESTVALS), &(DESTLEN))) {\
|
||||
return janet_typemany_err(A, N, JANET_TFLAG_INDEXED);\
|
||||
}\
|
||||
} while (0)
|
||||
|
||||
#define _JANET_ARG(TYPE, NAME, DEST, A, N) do { \
|
||||
JANET_CHECK(A, N, TYPE);\
|
||||
DEST = janet_unwrap_##NAME((A).v[(N)]); \
|
||||
} while (0)
|
||||
|
||||
#define JANET_ARG_FIBER(DEST, A, N) _JANET_ARG(JANET_FIBER, fiber, DEST, A, N)
|
||||
#define JANET_ARG_NUMBER(DEST, A, N) _JANET_ARG(JANET_NUMBER, number, DEST, A, N)
|
||||
#define JANET_ARG_STRING(DEST, A, N) _JANET_ARG(JANET_STRING, string, DEST, A, N)
|
||||
#define JANET_ARG_SYMBOL(DEST, A, N) _JANET_ARG(JANET_SYMBOL, symbol, DEST, A, N)
|
||||
#define JANET_ARG_ARRAY(DEST, A, N) _JANET_ARG(JANET_ARRAY, array, DEST, A, N)
|
||||
#define JANET_ARG_TUPLE(DEST, A, N) _JANET_ARG(JANET_TUPLE, tuple, DEST, A, N)
|
||||
#define JANET_ARG_TABLE(DEST, A, N) _JANET_ARG(JANET_TABLE, table, DEST, A, N)
|
||||
#define JANET_ARG_STRUCT(DEST, A, N) _JANET_ARG(JANET_STRUCT, struct, DEST, A, N)
|
||||
#define JANET_ARG_BUFFER(DEST, A, N) _JANET_ARG(JANET_BUFFER, buffer, DEST, A, N)
|
||||
#define JANET_ARG_FUNCTION(DEST, A, N) _JANET_ARG(JANET_FUNCTION, function, DEST, A, N)
|
||||
#define JANET_ARG_CFUNCTION(DEST, A, N) _JANET_ARG(JANET_CFUNCTION, cfunction, DEST, A, N)
|
||||
|
||||
#define JANET_ARG_INTEGER(DEST, A, N) do { \
|
||||
if ((A).n <= (N) || !janet_checktype((A).v[(N)], JANET_NUMBER)) { \
|
||||
JANET_THROW(A, "expected integer"); \
|
||||
} \
|
||||
double _x_ = janet_unwrap_number((A).v[(N)]); \
|
||||
if (janet_checkintrange(_x_)) { \
|
||||
DEST = (int32_t) _x_; \
|
||||
} else { \
|
||||
JANET_THROW(A, "expected integer representable by 32 bits"); \
|
||||
} \
|
||||
} while (0)
|
||||
|
||||
#define JANET_ARG_INTEGER64(DEST, A, N) do { \
|
||||
if ((A).n <= (N) || !janet_checktype((A).v[(N)], JANET_NUMBER)) { \
|
||||
JANET_THROW(A, "expected integer"); \
|
||||
} \
|
||||
double _x_ = janet_unwrap_number((A).v[(N)]); \
|
||||
if (janet_checkintrange64(_x_)) { \
|
||||
DEST = (int64_t) _x_; \
|
||||
} else { \
|
||||
JANET_THROW(A, "expected integer representable by 64 bits"); \
|
||||
} \
|
||||
} while (0)
|
||||
|
||||
#define JANET_ARG_ABSTRACT(DEST, A, N, AT) do { \
|
||||
JANET_CHECKABSTRACT(A, N, AT); \
|
||||
DEST = janet_unwrap_abstract((A).v[(N)]); \
|
||||
} while (0)
|
||||
|
||||
#define JANET_RETURN_NIL(A) do { return JANET_SIGNAL_OK; } while (0)
|
||||
#define JANET_RETURN_FALSE(A) JANET_RETURN(A, janet_wrap_false())
|
||||
#define JANET_RETURN_TRUE(A) JANET_RETURN(A, janet_wrap_true())
|
||||
#define JANET_RETURN_BOOLEAN(A, X) JANET_RETURN(A, janet_wrap_boolean(X))
|
||||
#define JANET_RETURN_FIBER(A, X) JANET_RETURN(A, janet_wrap_fiber(X))
|
||||
#define JANET_RETURN_NUMBER(A, X) JANET_RETURN(A, janet_wrap_number(X))
|
||||
#define JANET_RETURN_STRING(A, X) JANET_RETURN(A, janet_wrap_string(X))
|
||||
#define JANET_RETURN_SYMBOL(A, X) JANET_RETURN(A, janet_wrap_symbol(X))
|
||||
#define JANET_RETURN_ARRAY(A, X) JANET_RETURN(A, janet_wrap_array(X))
|
||||
#define JANET_RETURN_TUPLE(A, X) JANET_RETURN(A, janet_wrap_tuple(X))
|
||||
#define JANET_RETURN_TABLE(A, X) JANET_RETURN(A, janet_wrap_table(X))
|
||||
#define JANET_RETURN_STRUCT(A, X) JANET_RETURN(A, janet_wrap_struct(X))
|
||||
#define JANET_RETURN_BUFFER(A, X) JANET_RETURN(A, janet_wrap_buffer(X))
|
||||
#define JANET_RETURN_FUNCTION(A, X) JANET_RETURN(A, janet_wrap_function(X))
|
||||
#define JANET_RETURN_CFUNCTION(A, X) JANET_RETURN(A, janet_wrap_cfunction(X))
|
||||
#define JANET_RETURN_ABSTRACT(A, X) JANET_RETURN(A, janet_wrap_abstract(X))
|
||||
|
||||
#define JANET_RETURN_CSTRING(A, X) JANET_RETURN(A, janet_cstringv(X))
|
||||
#define JANET_RETURN_CSYMBOL(A, X) JANET_RETURN(A, janet_csymbolv(X))
|
||||
|
||||
#define JANET_RETURN_INTEGER(A, X) JANET_RETURN(A, janet_wrap_number((double) (X)))
|
||||
|
||||
/**** END SECTION MACROS *****/
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright 2017-2018 (C) Calvin Rose
|
||||
# Copyright 2017-2019 (C) Calvin Rose
|
||||
|
||||
(do
|
||||
|
||||
@@ -11,7 +11,7 @@
|
||||
# Flag handlers
|
||||
(def handlers :private
|
||||
{"h" (fn [&]
|
||||
(print "usage: " process/args.0 " [options] scripts...")
|
||||
(print "usage: " (get process/args 0) " [options] scripts...")
|
||||
(print
|
||||
`Options are:
|
||||
-h Show this help
|
||||
@@ -30,7 +30,7 @@
|
||||
"-" (fn [&] (set *handleopts* false) 1)
|
||||
"e" (fn [i &]
|
||||
(set *no-file* false)
|
||||
(eval (get process/args (+ i 1)))
|
||||
(eval-string (get process/args (+ i 1)))
|
||||
2)})
|
||||
|
||||
(defn- dohandler [n i &]
|
||||
@@ -51,7 +51,7 @@
|
||||
|
||||
(when (or *should-repl* *no-file*)
|
||||
(if *raw-stdin*
|
||||
(repl nil identity)
|
||||
(repl nil (fn [x &] x))
|
||||
(do
|
||||
(print (string "Janet " janet/version "-" janet/build " Copyright (C) 2017-2018 Calvin Rose"))
|
||||
(repl (fn [buf p]
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2018 Calvin Rose
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -23,14 +23,12 @@
|
||||
#include "line.h"
|
||||
|
||||
/* Common */
|
||||
int janet_line_getter(JanetArgs args) {
|
||||
JANET_FIXARITY(args, 2);
|
||||
JANET_CHECK(args, 0, JANET_STRING);
|
||||
JANET_CHECK(args, 1, JANET_BUFFER);
|
||||
janet_line_get(
|
||||
janet_unwrap_string(args.v[0]),
|
||||
janet_unwrap_buffer(args.v[1]));
|
||||
JANET_RETURN(args, args.v[0]);
|
||||
Janet janet_line_getter(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
const uint8_t *str = janet_getstring(argv, 0);
|
||||
JanetBuffer *buf = janet_getbuffer(argv, 1);
|
||||
janet_line_get(str, buf);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static void simpleline(JanetBuffer *buffer) {
|
||||
@@ -186,7 +184,7 @@ static void clear() {
|
||||
static void refresh() {
|
||||
char seq[64];
|
||||
JanetBuffer b;
|
||||
|
||||
|
||||
/* Keep cursor position on screen */
|
||||
char *_buf = buf;
|
||||
int _len = len;
|
||||
@@ -298,7 +296,7 @@ static void kright() {
|
||||
static void kbackspace() {
|
||||
if (pos > 0) {
|
||||
memmove(buf + pos - 1, buf + pos, len - pos);
|
||||
pos--;
|
||||
pos--;
|
||||
buf[--len] = '\0';
|
||||
refresh();
|
||||
}
|
||||
@@ -447,7 +445,7 @@ static int checktermsupport() {
|
||||
}
|
||||
|
||||
void janet_line_get(const uint8_t *p, JanetBuffer *buffer) {
|
||||
prompt = (const char *)p;
|
||||
prompt = (const char *)p;
|
||||
buffer->count = 0;
|
||||
historyi = 0;
|
||||
if (!isatty(STDIN_FILENO) || !checktermsupport()) {
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2018 Calvin Rose
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -29,6 +29,6 @@ void janet_line_init();
|
||||
void janet_line_deinit();
|
||||
|
||||
void janet_line_get(const uint8_t *p, JanetBuffer *buffer);
|
||||
int janet_line_getter(JanetArgs args);
|
||||
Janet janet_line_getter(int32_t argc, Janet *argv);
|
||||
|
||||
#endif
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2018 Calvin Rose
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2018 Calvin Rose
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -32,11 +32,11 @@ static const uint8_t *line_prompt = NULL;
|
||||
|
||||
/* Yield to JS event loop from janet. Takes a repl prompt
|
||||
* and a buffer to fill with input data. */
|
||||
static int repl_yield(JanetArgs args) {
|
||||
JANET_FIXARITY(args, 2);
|
||||
JANET_ARG_STRING(line_prompt, args, 0);
|
||||
JANET_ARG_BUFFER(line_buffer, args, 1);
|
||||
JANET_RETURN_NIL(args);
|
||||
static Janet repl_yield(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
line_prompt = janet_getstring(argv, 0);
|
||||
line_buffer = janet_getbuffer(argv, 1);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
/* Re-enter the loop */
|
||||
@@ -52,18 +52,15 @@ static int enter_loop(void) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* Allow JS interop from within janet */
|
||||
static int cfun_js(JanetArgs args) {
|
||||
const uint8_t *bytes;
|
||||
int32_t len;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_ARG_BYTES(bytes, len, args, 0);
|
||||
(void) len;
|
||||
emscripten_run_script((const char *)bytes);
|
||||
JANET_RETURN_NIL(args);
|
||||
/* Allow JS interoperation from within janet */
|
||||
static Janet cfun_js(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetByteView bytes = janet_getbytes(argv, 0);
|
||||
emscripten_run_script((const char *)bytes.bytes);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
/* Intialize the repl */
|
||||
/* Initialize the repl */
|
||||
EMSCRIPTEN_KEEPALIVE
|
||||
void repl_init(void) {
|
||||
int status;
|
||||
|
||||
@@ -1,4 +1,5 @@
|
||||
# Copyright 2017-2018 (C) Calvin Rose
|
||||
# Copyright 2017-2019 (C) Calvin Rose
|
||||
|
||||
(print (string "Janet " janet/version "-" janet/build " Copyright (C) 2017-2018 Calvin Rose"))
|
||||
|
||||
(fiber/new (fn webrepl []
|
||||
|
||||
@@ -3,20 +3,29 @@
|
||||
(var num-tests-passed 0)
|
||||
(var num-tests-run 0)
|
||||
(var suite-num 0)
|
||||
(var numchecks 0)
|
||||
|
||||
(defn assert [x e]
|
||||
(++ num-tests-run)
|
||||
(when x (++ num-tests-passed))
|
||||
(print (if x
|
||||
" \e[32m✔\e[0m "
|
||||
" \e[31m✘\e[0m ") e)
|
||||
(if x
|
||||
(do
|
||||
(when (= numchecks 25)
|
||||
(set numchecks 0)
|
||||
(print))
|
||||
(++ numchecks)
|
||||
(file/write stdout "\e[32m✔\e[0m"))
|
||||
(do
|
||||
(file/write stdout "\n\e[31m✘\e[0m ")
|
||||
(set numchecks 0)
|
||||
(print e)))
|
||||
x)
|
||||
|
||||
(defn start-suite [x]
|
||||
(set suite-num x)
|
||||
(print "\nRunning test suite " x " tests...\n"))
|
||||
(print "\nRunning test suite " x " tests...\n "))
|
||||
|
||||
(defn end-suite []
|
||||
(print "\nTest suite " suite-num " finished.")
|
||||
(print "\n\nTest suite " suite-num " finished.")
|
||||
(print num-tests-passed " of " num-tests-run " tests passed.\n")
|
||||
(if (not= num-tests-passed num-tests-run) (os/exit 1)))
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2018 Calvin Rose
|
||||
# Copyright (c) 2019 Calvin Rose
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
@@ -37,10 +37,11 @@
|
||||
(assert (= 7 (% 20 13)) "modulo 1")
|
||||
(assert (= -7 (% -20 13)) "modulo 2")
|
||||
|
||||
(assert (order< nil false true
|
||||
(assert (order< 1.0 nil false true
|
||||
(fiber/new (fn [] 1))
|
||||
1.0 "hi"
|
||||
"hi"
|
||||
(quote hello)
|
||||
:hello
|
||||
(array 1 2 3)
|
||||
(tuple 1 2 3)
|
||||
(table "a" "b" "c" "d")
|
||||
@@ -78,7 +79,7 @@
|
||||
(assert (= "\e" "\x1B") "escape character")
|
||||
(assert (= "\x09" "\t") "tab character")
|
||||
|
||||
# Mcarthy's 91 function
|
||||
# McCarthy's 91 function
|
||||
(var f91 nil)
|
||||
(set f91 (fn [n] (if (> n 100) (- n 10) (f91 (f91 (+ n 11))))))
|
||||
(assert (= 91 (f91 10)) "f91(10) = 91")
|
||||
@@ -201,7 +202,7 @@
|
||||
|
||||
(def 🦊 :fox)
|
||||
(def 🐮 :cow)
|
||||
(assert (= (string "🐼" 🦊 🐮) "🐼:fox:cow") "emojis 🙉 :)")
|
||||
(assert (= (string "🐼" 🦊 🐮) "🐼foxcow") "emojis 🙉 :)")
|
||||
(assert (not= 🦊 "🦊") "utf8 strings are not symbols and vice versa")
|
||||
|
||||
# Symbols with @ character
|
||||
@@ -216,7 +217,7 @@
|
||||
# Merge sort
|
||||
|
||||
# Imperative (and verbose) merge sort merge
|
||||
(defn merge
|
||||
(defn merge
|
||||
[xs ys]
|
||||
(def ret @[])
|
||||
(def xlen (length xs))
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
# Copyright (c) 2018 Calvin Rose
|
||||
|
||||
# Copyright (c) 2019 Calvin Rose
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
# deal in the Software without restriction, including without limitation the
|
||||
@@ -95,7 +95,7 @@
|
||||
|
||||
# Find the maximum path from the top (root)
|
||||
# of the triangle to the leaves of the triangle.
|
||||
|
||||
|
||||
(defn myfold [xs ys]
|
||||
(let [xs1 (tuple/prepend xs 0)
|
||||
xs2 (tuple/append xs 0)
|
||||
@@ -190,7 +190,7 @@
|
||||
(assert (= '[2 -2 2 0.5] (myfun 2)) "juxt")
|
||||
|
||||
# Case statements
|
||||
(assert
|
||||
(assert
|
||||
(= :six (case (+ 1 2 3)
|
||||
1 :one
|
||||
2 :two
|
||||
@@ -214,11 +214,11 @@
|
||||
|
||||
# Closure in while loop
|
||||
(def closures (seq [i :range [0 5]] (fn [] i)))
|
||||
(assert (= 0 (closures.0)) "closure in loop 0")
|
||||
(assert (= 1 (closures.1)) "closure in loop 1")
|
||||
(assert (= 2 (closures.2)) "closure in loop 2")
|
||||
(assert (= 3 (closures.3)) "closure in loop 3")
|
||||
(assert (= 4 (closures.4)) "closure in loop 4")
|
||||
(assert (= 0 ((get closures 0))) "closure in loop 0")
|
||||
(assert (= 1 ((get closures 1))) "closure in loop 1")
|
||||
(assert (= 2 ((get closures 2))) "closure in loop 2")
|
||||
(assert (= 3 ((get closures 3))) "closure in loop 3")
|
||||
(assert (= 4 ((get closures 4))) "closure in loop 4")
|
||||
|
||||
# More numerical tests
|
||||
(assert (== 1 1.0) "numerical equal 1")
|
||||
@@ -238,7 +238,7 @@
|
||||
(def arr (array))
|
||||
(array/push arr :hello)
|
||||
(array/push arr :world)
|
||||
(assert (array= arr @[:hello :world]) "array comparision")
|
||||
(assert (array= arr @[:hello :world]) "array comparison")
|
||||
(assert (array= @[1 2 3 4 5] @[1 2 3 4 5]) "array comparison 2")
|
||||
(assert (array= @[:one :two :three :four :five] @[:one :two :three :four :five]) "array comparison 3")
|
||||
(assert (array= (array/slice @[1 2 3] 0 2) @[1 2]) "array/slice 1")
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2018 Calvin Rose
|
||||
# Copyright (c) 2019 Calvin Rose
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2018 Calvin Rose
|
||||
# Copyright (c) 2019 Calvin Rose
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
@@ -53,4 +53,73 @@
|
||||
|
||||
(assert (= var-b "hello") "regression 1")
|
||||
|
||||
# Some macros
|
||||
|
||||
(assert (= 2 (if-not 1 3 2)) "if-not 1")
|
||||
(assert (= 3 (if-not false 3)) "if-not 2")
|
||||
(assert (= 3 (if-not nil 3 2)) "if-not 3")
|
||||
(assert (= nil (if-not true 3)) "if-not 4")
|
||||
|
||||
(assert (= 4 (unless false (+ 1 2 3) 4)) "unless")
|
||||
|
||||
(def res @{})
|
||||
(loop [[k v] :pairs @{1 2 3 4 5 6}]
|
||||
(put res k v))
|
||||
(assert (and
|
||||
(= (get res 1) 2)
|
||||
(= (get res 3) 4)
|
||||
(= (get res 5) 6)) "loop :pairs")
|
||||
|
||||
# Another regression test - no segfaults
|
||||
(defn afn [x] x)
|
||||
(assert (= 1 (try (afn) ([err] 1))) "bad arity 1")
|
||||
(assert (= 4 (try ((fn [x y] (+ x y)) 1) ([_] 4))) "bad arity 2")
|
||||
(assert (= 1 (try (identity) ([err] 1))) "bad arity 3")
|
||||
(assert (= 1 (try (map) ([err] 1))) "bad arity 4")
|
||||
(assert (= 1 (try (not) ([err] 1))) "bad arity 5")
|
||||
|
||||
# Assembly test
|
||||
# Fibonacci sequence, implemented with naive recursion.
|
||||
(def fibasm (asm '{
|
||||
arity 1
|
||||
bytecode [
|
||||
(ltim 1 0 0x2) # $1 = $0 < 2
|
||||
(jmpif 1 :done) # if ($1) goto :done
|
||||
(lds 1) # $1 = self
|
||||
(addim 0 0 -0x1) # $0 = $0 - 1
|
||||
(push 0) # push($0), push argument for next function call
|
||||
(call 2 1) # $2 = call($1)
|
||||
(addim 0 0 -0x1) # $0 = $0 - 1
|
||||
(push 0) # push($0)
|
||||
(call 0 1) # $0 = call($1)
|
||||
(add 0 0 2) # $0 = $0 + $2 (integers)
|
||||
:done
|
||||
(ret 0) # return $0
|
||||
]
|
||||
}))
|
||||
|
||||
(assert (= 0 (fibasm 0)) "fibasm 1")
|
||||
(assert (= 1 (fibasm 1)) "fibasm 2")
|
||||
(assert (= 55 (fibasm 10)) "fibasm 3")
|
||||
(assert (= 6765 (fibasm 20)) "fibasm 4")
|
||||
|
||||
# Calling non functions
|
||||
|
||||
(assert (= 1 ({:ok 1} :ok)) "calling struct")
|
||||
(assert (= 2 (@{:ok 2} :ok)) "calling table")
|
||||
(assert (= :bad (try (@{:ok 2} :ok :no) ([err] :bad))) "calling table too many arguments")
|
||||
(assert (= :bad (try (:ok @{:ok 2} :no) ([err] :bad))) "calling keyword too many arguments")
|
||||
(assert (= :oops (try (1 1) ([err] :oops))) "calling number fails")
|
||||
|
||||
# Method test
|
||||
|
||||
(def Dog @{:bark (fn bark [self what] (string (self :name) " says " what "!"))})
|
||||
(defn make-dog
|
||||
[name]
|
||||
(table/setproto @{:name name} Dog))
|
||||
|
||||
(assert (= "fido" ((make-dog "fido") :name)) "oo 1")
|
||||
(def spot (make-dog "spot"))
|
||||
(assert (= "spot says hi!" (:bark spot "hi")) "oo 2")
|
||||
|
||||
(end-suite)
|
||||
|
||||
@@ -30,6 +30,16 @@
|
||||
(shell "rmdir " path " /s")
|
||||
(shell "rm -rf " path)))
|
||||
|
||||
(defn- older-than
|
||||
[f1 f2]
|
||||
"Check if f1 is newer than f2. Used for checking if a file should be updated."
|
||||
(if is-win true
|
||||
(zero? (os/shell (string "[ " f1 " -ot " f2 " ]")))))
|
||||
|
||||
(defn- older-than-some
|
||||
[f others]
|
||||
(some (partial older-than f) others))
|
||||
|
||||
(defn- embed-name
|
||||
"Rename a janet symbol for embedding."
|
||||
[path]
|
||||
@@ -66,6 +76,20 @@
|
||||
[name]
|
||||
(string "build" sep name modext))
|
||||
|
||||
(defn- make-define
|
||||
"Generate strings for adding custom defines to the compiler."
|
||||
[define value]
|
||||
(def prefix (if is-win "\\D" "-D"))
|
||||
(if value
|
||||
(string prefix define "=" value)
|
||||
(string prefix define)))
|
||||
|
||||
(defn- make-defines
|
||||
"Generate many defines. Takes a dictionary of defines. If a value is
|
||||
true, generates -DNAME (\\DNAME on windows), otherwise -DNAME=value."
|
||||
[defines]
|
||||
(seq [[d v] :pairs defines] (make-define d (if (not= v true) v))))
|
||||
|
||||
# Defaults
|
||||
(def OPTIMIZE 2)
|
||||
(def CC (if is-win "cl" "cc"))
|
||||
@@ -75,38 +99,42 @@
|
||||
(defn- compile-c
|
||||
"Compile a C file into an object file."
|
||||
[opts src dest]
|
||||
(def cc (or opts:compiler CC))
|
||||
(def cflags (or opts:cflags CFLAGS))
|
||||
(if is-win
|
||||
(shell cc " /nologo /c " cflags " /Fo" dest " " src)
|
||||
(shell cc " " cflags " -o " dest " -c " src)))
|
||||
(def cc (or (opts :compiler) CC))
|
||||
(def cflags (or (opts :cflags) CFLAGS))
|
||||
(def defines (interpose " " (make-defines (or (opts :defines) {}))))
|
||||
(if (older-than dest src)
|
||||
(if is-win
|
||||
(shell cc " " ;defines " /nologo /c " cflags " /Fo" dest " " src)
|
||||
(shell cc " " ;defines " " cflags " -o " dest " -c " src))))
|
||||
|
||||
(defn- link-c
|
||||
"Link a number of object files together."
|
||||
[opts target & objects]
|
||||
(def ld (or opts:linker LD))
|
||||
(def cflags (or opts:cflags CFLAGS))
|
||||
(def ld (or (opts :linker) LD))
|
||||
(def cflags (or (opts :cflags) CFLAGS))
|
||||
(def olist (string/join objects " "))
|
||||
(if is-win
|
||||
(shell ld "/out:" target " " olist)
|
||||
(shell ld " " cflags " -o " target " " olist)))
|
||||
(if (older-than-some target objects)
|
||||
(if is-win
|
||||
(shell ld "/out:" target " " olist)
|
||||
(shell ld " " cflags " -o " target " " olist))))
|
||||
|
||||
(defn- create-buffer-c
|
||||
"Inline raw byte file as a c file."
|
||||
[source dest name]
|
||||
(def f (file/open source :r))
|
||||
(if (not f) (error (string "file " f " not found")))
|
||||
(def out (file/open dest :w))
|
||||
(def chunks (seq [b :in (file/read f :all)] (string b)))
|
||||
(file/write out
|
||||
"#include <janet/janet.h>\n"
|
||||
"static const unsigned char bytes[] = {"
|
||||
;(interpose ", " chunks)
|
||||
"};\n\n"
|
||||
"const unsigned char *" name "_embed = bytes;\n"
|
||||
"size_t " name "_embed_size = sizeof(bytes);\n")
|
||||
(file/close out)
|
||||
(file/close f))
|
||||
(when (older-than dest source)
|
||||
(def f (file/open source :r))
|
||||
(if (not f) (error (string "file " f " not found")))
|
||||
(def out (file/open dest :w))
|
||||
(def chunks (seq [b :in (file/read f :all)] (string b)))
|
||||
(file/write out
|
||||
"#include <janet/janet.h>\n"
|
||||
"static const unsigned char bytes[] = {"
|
||||
;(interpose ", " chunks)
|
||||
"};\n\n"
|
||||
"const unsigned char *" name "_embed = bytes;\n"
|
||||
"size_t " name "_embed_size = sizeof(bytes);\n")
|
||||
(file/close out)
|
||||
(file/close f)))
|
||||
|
||||
# Public
|
||||
|
||||
@@ -116,17 +144,19 @@
|
||||
[& opts]
|
||||
(def opt-table (table ;opts))
|
||||
(mkdir "build")
|
||||
(loop [src :in opt-table:source]
|
||||
(def sources (opt-table :source))
|
||||
(def name (opt-table :name))
|
||||
(loop [src :in sources]
|
||||
(compile-c opt-table src (object-name src)))
|
||||
(def objects (map object-name opt-table:source))
|
||||
(when opt-table:embedded
|
||||
(loop [src :in opt-table:embedded]
|
||||
(def objects (map object-name sources))
|
||||
(when-let [embedded (opt-table :embedded)]
|
||||
(loop [src :in embedded]
|
||||
(def c-src (embed-c-name src))
|
||||
(def o-src (embed-o-name src))
|
||||
(array/push objects o-src)
|
||||
(create-buffer-c src c-src (embed-name src))
|
||||
(compile-c opt-table c-src o-src)))
|
||||
(link-c opt-table (lib-name opt-table:name) ;objects))
|
||||
(link-c opt-table (lib-name name) ;objects))
|
||||
|
||||
(defn clean
|
||||
"Remove all built artifacts."
|
||||
|
||||
@@ -44,7 +44,7 @@
|
||||
"Trim leading newlines"
|
||||
[str]
|
||||
(var i 0)
|
||||
(while (= 10 str.i) (++ i))
|
||||
(while (= 10 (get str i)) (++ i))
|
||||
(string/slice str i))
|
||||
|
||||
(defn- html-escape
|
||||
@@ -52,7 +52,7 @@
|
||||
[str]
|
||||
(def buf @"")
|
||||
(loop [byte :in str]
|
||||
(if-let [rep escapes.byte]
|
||||
(if-let [rep (get escapes byte)]
|
||||
(buffer/push-string buf rep)
|
||||
(buffer/push-byte buf byte)))
|
||||
buf)
|
||||
@@ -77,7 +77,7 @@
|
||||
:doc docstring} env-entry
|
||||
binding-type (cond
|
||||
macro :macro
|
||||
ref (string :var " (" (type ref.0) ")")
|
||||
ref (string :var " (" (type (get ref 0)) ")")
|
||||
(type val))
|
||||
source-ref (if-let [[path start end] sm]
|
||||
(string "<span class=\"source-map\">" path " (" start ":" end ")</span>")
|
||||
@@ -90,7 +90,7 @@
|
||||
# Generate parts and print them to stdout
|
||||
(def parts (seq [[k entry]
|
||||
:in (sort (pairs (table/getproto _env)))
|
||||
:when (and entry:doc (not entry:private))]
|
||||
:when (and (get entry :doc) (not (get entry :private)))]
|
||||
(emit-item k entry)))
|
||||
(print
|
||||
prelude
|
||||
|
||||
21
tools/marshal_core.janet
Normal file
21
tools/marshal_core.janet
Normal file
@@ -0,0 +1,21 @@
|
||||
# Tool to dump a marshalled version of the janet core to stdout. The
|
||||
# image should eventually allow janet to be started from a pre-compiled
|
||||
# image rather than recompiled every time from the embedded source. More
|
||||
# work will go into shrinking the image (it isn't currently that large but
|
||||
# could be smaller), creating the mechanism to load the image, and modifying
|
||||
# the build process to compile janet with a built image rather than
|
||||
# embedded source.
|
||||
|
||||
# Get image. This image contains as much of the core library and documentation that
|
||||
# can be written to an image (no cfunctions, no abstracts (stdout, stdin, stderr)),
|
||||
# everything else goes. Cfunctions and abstracts will be referenced from a register
|
||||
# table which will be generated on janet startup.
|
||||
(def image (let [env-pairs (pairs (env-lookup _env))
|
||||
essential-pairs (filter (fn [[k v]] (or (cfunction? v) (abstract? v))) env-pairs)
|
||||
lookup (table ;(mapcat identity essential-pairs))
|
||||
reverse-lookup (invert lookup)]
|
||||
(marshal (table/getproto _env) reverse-lookup)))
|
||||
|
||||
# Write image
|
||||
(file/write stdout image)
|
||||
(file/flush stdout)
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2018 Calvin Rose
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -1,4 +1,5 @@
|
||||
# Helper to generate core library mappings for janet
|
||||
# Used to help build the tmLanguage grammar.
|
||||
|
||||
(def allsyms (all-symbols))
|
||||
|
||||
@@ -22,7 +23,7 @@
|
||||
[str]
|
||||
(def buf @"")
|
||||
(loop [byte :in str]
|
||||
(if-let [rep escapes.byte]
|
||||
(if-let [rep (get escapes byte)]
|
||||
(buffer/push-string buf rep)
|
||||
(buffer/push-byte buf byte)))
|
||||
buf)
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2018 Calvin Rose
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
Reference in New Issue
Block a user