1
0
mirror of https://github.com/janet-lang/janet synced 2024-06-25 06:33:16 +00:00

Change syntax for namespaces.

Add quasiquote, unquote, and unquote-splicing
as specials rather than a macro.
This commit is contained in:
Calvin Rose 2018-11-30 22:49:21 -05:00
parent 25c50f5026
commit 4e4dd31164
28 changed files with 678 additions and 609 deletions

View File

@ -28,7 +28,7 @@
(loop [x :range [x1 (+ 1 x2)]
:after (print)
y :range [y1 (+ 1 y2)]]
(file.write stdout (if (get cellset (tuple x y)) "X " ". ")))
(file/write stdout (if (get cellset (tuple x y)) "X " ". ")))
(print))
#

View File

@ -2,8 +2,8 @@
# of the triangle to the leaves of the triangle.
(defn myfold [xs ys]
(let [xs1 (tuple.prepend xs 0)
xs2 (tuple.append xs 0)
(let [xs1 (tuple/prepend xs 0)
xs2 (tuple/append xs 0)
m1 (map + xs1 ys)
m2 (map + xs2 ys)]
(map max m1 m2)))

View File

@ -10,5 +10,5 @@
(for j 0 len
(def trial (get list j))
(if (zero? (% i trial)) (:= isprime? false)))
(if isprime? (array.push list i)))
(if isprime? (array/push list i)))
list)

View File

@ -9,17 +9,17 @@
returns the result of the last expression. Will only evaluate the
body once, and then memoizes the result."
[& forms]
(def $state (gensym))
(def $loaded (gensym))
(tuple 'do
(tuple 'var $state nil)
(tuple 'var $loaded nil)
(tuple 'fn (array)
(tuple 'if $loaded
$state
(tuple 'do
(tuple ':= $loaded true)
(tuple ':= $state (tuple.prepend forms 'do)))))))
(def state (gensym))
(def loaded (gensym))
~(do
(var ,state nil)
(var ,loaded nil)
(fn []
(if ,loaded
,state
(do
(:= ,loaded true)
(:= ,state (do ;forms)))))))
# Use tuples instead of structs to save memory
(def HEAD :private 0)

View File

@ -588,11 +588,11 @@ static int json_encode(JanetArgs args) {
static const JanetReg cfuns[] = {
{"encode", json_encode,
"(json.encode x)\n\n"
"(json/encode x)\n\n"
"Encodes a janet value in JSON (utf-8)."
},
{"decode", json_decode,
"(json.decode json-source)\n\n"
"(json/decode json-source)\n\n"
"Returns a janet object after parsing JSON."
},
{NULL, NULL, NULL}

View File

@ -385,36 +385,36 @@ static int sql_error_code(JanetArgs args) {
static const JanetReg cfuns[] = {
{"open", sql_open,
"(sqlite3.open path)\n\n"
"(sqlite3/open path)\n\n"
"Opens a sqlite3 database on disk. Returns the database handle if the database was opened "
"successfully, and otheriwse throws an error."
},
{"close", sql_close,
"(sqlite3.close db)\n\n"
"(sqlite3/close db)\n\n"
"Closes a database. Use this to free a database after use. Returns nil."
},
{"eval", sql_eval,
"(sqlite3.eval db sql [,params])\n\n"
"(sqlite3/eval db sql [,params])\n\n"
"Evaluate sql in the context of database db. Multiple sql statements "
"can be changed together, and optionally parameters maybe passed in. "
"The optional parameters maybe either an indexed data type (tuple or array), or a dictionary "
"data type (struct or table). If params is a tuple or array, then sqlite "
"parameters are substituted using indices. For example:\n\n"
"\t(sqlite3.eval db `SELECT * FROM tab WHERE id = ?;` [123])\n\n"
"\t(sqlite3/eval db `SELECT * FROM tab WHERE id = ?;` [123])\n\n"
"Will select rows from tab where id is equal to 123. Alternatively, "
"the programmer can use named parameters with tables or structs, like so:\n\n"
"\t(sqlite3.eval db `SELECT * FROM tab WHERE id = :id;` {:id 123})\n\n"
"\t(sqlite3/eval db `SELECT * FROM tab WHERE id = :id;` {:id 123})\n\n"
"Will return an array of rows, where each row contains a table where columns names "
"are keys for column values."
},
{"last-insert-rowid", sql_last_insert_rowid,
"(sqlite3.last-insert-rowid db)\n\n"
"(sqlite3/last-insert-rowid db)\n\n"
"Returns the id of the last inserted row. If the id will fit into a 32-bit"
"signed integer, will returned an integer, otherwise will return a string representation "
"of the id (an 8 bytes string containing a long integer)."
},
{"error-code", sql_error_code,
"(sqlite3.error-code db)\n\n"
"(sqlite3/error-code db)\n\n"
"Returns the error number of the last sqlite3 command that threw an error. Cross "
"check these numbers with the SQLite documentation for more information."
},

View File

@ -254,52 +254,47 @@ static int cfun_insert(JanetArgs args) {
}
static const JanetReg cfuns[] = {
{"array.new", cfun_new,
"(array.new capacity)\n\n"
{"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."
},
{"array.pop", cfun_pop,
"(array.pop arr)\n\n"
{"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."
},
{"array.peek", cfun_peek,
"(array.peel arr)\n\n"
{"array/peek", cfun_peek,
"(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"
{"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."
},
{"array.ensure", cfun_ensure,
"(array.ensure arr capacity)\n\n"
{"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."
},
{"array.slice", cfun_slice,
"(array.slice arrtup)\n\n"
"Returns a copy of an array or tuple.\n\n"
"(array.slice arrtup start)\n\n"
"Takes a slice of an array or tuple from the index start to the last element. Indexes "
"are from 0, or can be negative to index from the end of the array, Where -1 is the last "
"element of the array. Returns a new array.\n\n"
"(array.slice arrtup start end)\n\n"
{"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. Returns a new array."
"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"
{"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."
},
{"array.insert", cfun_insert,
"(array.insert arr at & xs)\n\n"
{"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. "

View File

@ -270,48 +270,43 @@ static int cfun_slice(JanetArgs args) {
}
static const JanetReg cfuns[] = {
{"buffer.new", cfun_new,
"(buffer.new capacity)\n\n"
{"buffer/new", cfun_new,
"(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"
{"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."
},
{"buffer.push-integer", cfun_int,
"(buffer.push-integer buffer x)\n\n"
{"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-string", cfun_chars,
"(buffer.push-string buffer str)\n\n"
{"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."
},
{"buffer.popn", cfun_popn,
"(buffer.popn buffer n)\n\n"
{"buffer/popn", cfun_popn,
"(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"
{"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."
},
{"buffer.slice", cfun_slice,
"(buffer.slice bytes)\n\n"
"Returns a copy of a buffer, string or symbol.\n\n"
"(buffer.slice bytes start)\n\n"
"Takes a slice of a byte sequence from the index start to the last element. Indexes "
"are from 0, or can be negative to index from the end of the array, Where -1 is the last "
"element of the array. Returns a new buffer.\n\n"
"(buffer.slice bytes start end)\n\n"
{"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. Returns a new buffer."
"end of the array. By default, start is 0 and end is the length of the buffer. "
"Returns a new buffer."
},
{NULL, NULL, NULL}
};

View File

@ -76,6 +76,9 @@ typedef struct JanetSpecial JanetSpecial;
#define JANET_SLOT_RETURNED 0x100000
/* Needed for handling single element arrays as global vars. */
/* Used for unquote-splicing */
#define JANET_SLOT_SPLICED 0x200000
#define JANET_SLOTTYPE_ANY 0xFFFF
/* A stack slot */

File diff suppressed because it is too large Load Diff

View File

@ -689,8 +689,8 @@ JanetTable *janet_core_env(void) {
"(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, "~", 1, 1, bnot_asm, sizeof(bnot_asm),
"(~ x)\n\nReturns the bitwise inverse of integer x.");
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.");
make_apply(env);
/* Variadic ops */
@ -776,7 +776,7 @@ JanetTable *janet_core_env(void) {
"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),
janet_def(env, "janet/version", janet_cstringv(JANET_VERSION),
"The version number of the running janet program.");
/* Set as gc root */

View File

@ -468,14 +468,14 @@ static int cfun_setmaxstack(JanetArgs args) {
}
static const JanetReg cfuns[] = {
{"fiber.new", cfun_new,
"(fiber.new func [,sigmask])\n\n"
{"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 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"
"\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"
@ -485,8 +485,8 @@ static const JanetReg cfuns[] = {
"\ty - block yield signals\n"
"\t0-9 - block a specific user signal"
},
{"fiber.status", cfun_status,
"(fiber.status fib)\n\n"
{"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"
@ -496,8 +496,8 @@ static const JanetReg cfuns[] = {
"\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.stack", cfun_stack,
"(fiber.stack fib)\n\n"
{"fiber/stack", cfun_stack,
"(fiber/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 "
@ -511,25 +511,25 @@ static const JanetReg cfuns[] = {
"\t:source - string with filename or other identifier for the source code\n"
"\t:tail - boolean indicating a tail call"
},
{"fiber.current", cfun_current,
"(fiber.current)\n\n"
{"fiber/current", cfun_current,
"(fiber/current)\n\n"
"Returns the currently running fiber."
},
{"fiber.lineage", cfun_lineage,
"(fiber.lineage fib)\n\n"
{"fiber/lineage", cfun_lineage,
"(fiber/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."
},
{"fiber.maxstack", cfun_maxstack,
"(fiber.maxstack fib)\n\n"
{"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.setmaxstack", cfun_setmaxstack,
"(fiber.setmaxstack fib maxstack)\n\n"
{"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."
},

View File

@ -366,8 +366,8 @@ static int janet_io_fseek(JanetArgs args) {
}
static const JanetReg cfuns[] = {
{"file.open", janet_io_fopen,
"(file.open path [,mode])\n\n"
{"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 "
@ -379,14 +379,14 @@ static const JanetReg cfuns[] = {
"\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"
{"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.read", janet_io_fread,
"(file.read f what [,buf])\n\n"
{"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 "
@ -396,18 +396,18 @@ static const JanetReg cfuns[] = {
"\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"
{"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.flush", janet_io_fflush,
"(file.flush f)\n\n"
{"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.seek", janet_io_fseek,
"(file.seek f [,whence [,n]])\n\n"
{"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"
@ -416,8 +416,8 @@ static const JanetReg cfuns[] = {
"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"
{"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 "

View File

@ -143,65 +143,65 @@ static const JanetReg cfuns[] = {
{"real", janet_real,
"(real x)\n\nCast a number x to a real number."
},
{"math.random", janet_rand,
"(math.random)\n\n"
{"math/random", janet_rand,
"(math/random)\n\n"
"Returns a uniformly distrbuted random real number between 0 and 1."
},
{"math.seedrandom", janet_srand,
"(math.seedrandom seed)\n\n"
{"math/seedrandom", janet_srand,
"(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"
{"math/cos", janet_cos,
"(math/cos x)\n\n"
"Returns the cosine of x."
},
{"math.sin", janet_sin,
"(math.sin x)\n\n"
{"math/sin", janet_sin,
"(math/sin x)\n\n"
"Returns the sine of x."
},
{"math.tan", janet_tan,
"(math.tan x)\n\n"
{"math/tan", janet_tan,
"(math/tan x)\n\n"
"Returns the tangent of x."
},
{"math.acos", janet_acos,
"(math.acos x)\n\n"
{"math/acos", janet_acos,
"(math/acos x)\n\n"
"Returns the arccosine of x."
},
{"math.asin", janet_asin,
"(math.asin x)\n\n"
{"math/asin", janet_asin,
"(math/asin x)\n\n"
"Returns the arcsine of x."
},
{"math.atan", janet_atan,
"(math.atan x)\n\n"
{"math/atan", janet_atan,
"(math/atan x)\n\n"
"Returns the arctangent of x."
},
{"math.exp", janet_exp,
"(math.exp x)\n\n"
{"math/exp", janet_exp,
"(math/exp x)\n\n"
"Returns e to the power of x."
},
{"math.log", janet_log,
"(math.log x)\n\n"
{"math/log", janet_log,
"(math/log x)\n\n"
"Returns log base 2 of x."
},
{"math.log10", janet_log10,
"(math.log10 x)\n\n"
{"math/log10", janet_log10,
"(math/log10 x)\n\n"
"Returns log base 10 of x."
},
{"math.sqrt", janet_sqrt,
"(math.sqrt x)\n\n"
{"math/sqrt", janet_sqrt,
"(math/sqrt x)\n\n"
"Returns the square root of x."
},
{"math.floor", janet_floor,
"(math.floor x)\n\n"
{"math/floor", janet_floor,
"(math/floor x)\n\n"
"Returns the largest integer value real number that is not greater than x."
},
{"math.ceil", janet_ceil,
"(math.ceil x)\n\n"
{"math/ceil", janet_ceil,
"(math/ceil x)\n\n"
"Returns the smallest integer value real number that is not less than x."
},
{"math.pow", janet_pow,
"(math.pow a x)\n\n"
{"math/pow", janet_pow,
"(math/pow a x)\n\n"
"Return a to the power of x."
},
{NULL, NULL, NULL}
@ -212,11 +212,11 @@ int janet_lib_math(JanetArgs args) {
JanetTable *env = janet_env(args);
janet_cfuns(env, NULL, cfuns);
janet_def(env, "math.pi", janet_wrap_real(3.1415926535897931),
janet_def(env, "math/pi", janet_wrap_real(3.1415926535897931),
"The value pi.");
janet_def(env, "math.e", janet_wrap_real(2.7182818284590451),
janet_def(env, "math/e", janet_wrap_real(2.7182818284590451),
"The base of the natural log.");
janet_def(env, "math.inf", janet_wrap_real(INFINITY),
janet_def(env, "math/inf", janet_wrap_real(INFINITY),
"The real number representing positive infinity");
return 0;
}

View File

@ -45,7 +45,7 @@ static JanetSlot multisym_do_parts(JanetFopts opts, int put, const uint8_t *sym,
JanetFopts subopts = janetc_fopts_default(opts.compiler);
int i, j;
for (i = 1, j = 0; sym[i]; i++) {
if (sym[i] == ':' || sym[i] == '@') {
if (sym[i] == ':' || sym[i] == '.') {
if (j) {
JanetSlot target = janetc_gettarget(subopts);
JanetSlot value = multisym_parse_part(opts.compiler, sym + j, i - j);

View File

@ -283,53 +283,53 @@ static int os_cwd(JanetArgs args) {
}
static const JanetReg cfuns[] = {
{"os.which", os_which,
"(os.which)\n\n"
{"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.execute", os_execute,
"(os.execute program & args)\n\n"
{"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.shell", os_shell,
"(os.shell str)\n\n"
{"os/shell", os_shell,
"(os/shell str)\n\n"
"Pass a command string str directly to the system shell."
},
{"os.exit", os_exit,
"(os.exit x)\n\n"
{"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.getenv", os_getenv,
"(os.getenv variable)\n\n"
{"os/getenv", os_getenv,
"(os/getenv variable)\n\n"
"Get the string value of an environment variable."
},
{"os.setenv", os_setenv,
"(os.setenv variable value)\n\n"
{"os/setenv", os_setenv,
"(os/setenv variable value)\n\n"
"Set an environment variable."
},
{"os.time", os_time,
"(os.time)\n\n"
{"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.clock", os_clock,
"(os.clock)\n\n"
{"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.sleep", os_sleep,
"(os.sleep nsec)\n\n"
{"os/sleep", os_sleep,
"(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"
{"os/cwd", os_cwd,
"(os/cwd)\n\n"
"Returns the current working directory."
},
{NULL, NULL, NULL}

View File

@ -22,14 +22,6 @@
#include <janet/janet.h>
/* Quote a value */
static Janet quote(Janet x) {
Janet *t = janet_tuple_begin(2);
t[0] = janet_csymbolv("quote");
t[1] = x;
return janet_wrap_tuple(janet_tuple_end(t));
}
/* Check if a character is whitespace */
static int is_whitespace(uint8_t c) {
return c == ' '
@ -37,9 +29,7 @@ static int is_whitespace(uint8_t c) {
|| c == '\n'
|| c == '\r'
|| c == '\0'
|| c == '\f'
|| c == ';'
|| c == ',';
|| c == '\f';
}
/* Code generated by tools/symcharsgen.c.
@ -48,7 +38,7 @@ static int is_whitespace(uint8_t c) {
* if not. The upper characters are also considered symbol
* chars and are then checked for utf-8 compliance. */
static const uint32_t symchars[8] = {
0x00000000, 0xf7ffec72, 0xc7ffffff, 0x57fffffe,
0x00000000, 0xf7ffec72, 0xc7ffffff, 0x17fffffe,
0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff
};
@ -109,7 +99,7 @@ static int to_hex(uint8_t c) {
typedef int (*Consumer)(JanetParser *p, JanetParseState *state, uint8_t c);
struct JanetParseState {
int32_t qcount;
int32_t counter;
int32_t argn;
int flags;
size_t start_line;
@ -142,17 +132,18 @@ DEF_PARSER_STACK(_pushstate, JanetParseState, states, statecount, statecap)
#undef DEF_PARSER_STACK
#define PFLAG_CONTAINER 1
#define PFLAG_BUFFER 2
#define PFLAG_PARENS 4
#define PFLAG_SQRBRACKETS 8
#define PFLAG_CURLYBRACKETS 16
#define PFLAG_STRING 32
#define PFLAG_LONGSTRING 64
#define PFLAG_CONTAINER 0x100
#define PFLAG_BUFFER 0x200
#define PFLAG_PARENS 0x400
#define PFLAG_SQRBRACKETS 0x800
#define PFLAG_CURLYBRACKETS 0x1000
#define PFLAG_STRING 0x2000
#define PFLAG_LONGSTRING 0x4000
#define PFLAG_READERMAC 0x8000
static void pushstate(JanetParser *p, Consumer consumer, int flags) {
JanetParseState s;
s.qcount = 0;
s.counter = 0;
s.argn = 0;
s.flags = flags;
s.consumer = consumer;
@ -162,29 +153,35 @@ static void pushstate(JanetParser *p, Consumer consumer, int flags) {
}
static void popstate(JanetParser *p, Janet val) {
JanetParseState top = p->states[--p->statecount];
JanetParseState *newtop = p->states + p->statecount - 1;
if (newtop->flags & PFLAG_CONTAINER) {
int32_t i, len;
len = newtop->qcount;
/* Quote the returned value qcount times */
for (i = 0; i < len; i++) {
for (;;) {
JanetParseState top = p->states[--p->statecount];
JanetParseState *newtop = p->states + p->statecount - 1;
if (newtop->flags & PFLAG_CONTAINER) {
/* Source mapping info */
if (janet_checktype(val, JANET_TUPLE)) {
janet_tuple_sm_line(janet_unwrap_tuple(val)) = (int32_t) top.start_line;
janet_tuple_sm_col(janet_unwrap_tuple(val)) = (int32_t) top.start_col;
}
val = quote(val);
newtop->argn++;
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 =
(c == '\'') ? "quote" :
(c == ',') ? "unquote" :
(c == ';') ? "unquote-splicing" :
(c == '~') ? "quasiquote" : "<unknown>";
t[0] = janet_csymbolv(which);
t[1] = val;
/* Quote source mapping info */
janet_tuple_sm_line(t) = (int32_t) newtop->start_line;
janet_tuple_sm_col(t) = (int32_t) newtop->start_col;
val = janet_wrap_tuple(janet_tuple_end(t));
} else {
return;
}
newtop->qcount = 0;
/* Ast wrap */
if (janet_checktype(val, JANET_TUPLE)) {
janet_tuple_sm_line(janet_unwrap_tuple(val)) = (int32_t) top.start_line;
janet_tuple_sm_col(janet_unwrap_tuple(val)) = (int32_t) top.start_col;
}
newtop->argn++;
push_arg(p, val);
}
}
@ -214,8 +211,8 @@ static int escapeh(JanetParser *p, JanetParseState *state, uint8_t c) {
return 1;
}
state->argn = (state->argn << 4) + digit;;
state->qcount--;
if (!state->qcount) {
state->counter--;
if (!state->counter) {
push_buf(p, (state->argn & 0xFF));
state->argn = 0;
state->consumer = stringchar;
@ -230,7 +227,7 @@ static int escape1(JanetParser *p, JanetParseState *state, uint8_t c) {
return 1;
}
if (c == 'x') {
state->qcount = 2;
state->counter = 2;
state->argn = 0;
state->consumer = escapeh;
} else {
@ -404,15 +401,15 @@ static int dotable(JanetParser *p, JanetParseState *state, uint8_t c) {
return root(p, state, c);
}
#define PFLAG_INSTRING 128
#define PFLAG_END_CANDIDATE 256
#define PFLAG_INSTRING 0x100000
#define PFLAG_END_CANDIDATE 0x200000
static int longstring(JanetParser *p, JanetParseState *state, uint8_t c) {
if (state->flags & PFLAG_INSTRING) {
/* We are inside the long string */
if (c == '`') {
state->flags |= PFLAG_END_CANDIDATE;
state->flags &= ~PFLAG_INSTRING;
state->qcount = 1; /* Use qcount to keep track of number of '=' seen */
state->counter = 1; /* Use counter to keep track of number of '=' seen */
return 1;
}
push_buf(p, c);
@ -420,20 +417,20 @@ static int longstring(JanetParser *p, JanetParseState *state, uint8_t c) {
} else if (state->flags & PFLAG_END_CANDIDATE) {
int i;
/* We are checking a potential end of the string */
if (state->qcount == state->argn) {
if (state->counter == state->argn) {
stringend(p, state);
return 0;
}
if (c == '`' && state->qcount < state->argn) {
state->qcount++;
if (c == '`' && state->counter < state->argn) {
state->counter++;
return 1;
}
/* Failed end candidate */
for (i = 0; i < state->qcount; i++) {
for (i = 0; i < state->counter; i++) {
push_buf(p, '`');
}
push_buf(p, c);
state->qcount = 0;
state->counter = 0;
state->flags &= ~PFLAG_END_CANDIDATE;
state->flags |= PFLAG_INSTRING;
return 1;
@ -477,6 +474,7 @@ 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;
@ -487,7 +485,10 @@ static int root(JanetParser *p, JanetParseState *state, uint8_t c) {
pushstate(p, tokenchar, 0);
return 0;
case '\'':
state->qcount++;
case ',':
case ';':
case '~':
pushstate(p, root, PFLAG_READERMAC | c);
return 1;
case '"':
pushstate(p, stringchar, PFLAG_STRING);
@ -779,34 +780,34 @@ static int cfun_state(JanetArgs args) {
}
static const JanetReg cfuns[] = {
{"parser.new", cfun_parser,
"(parser.new)\n\n"
{"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.produce", cfun_produce,
"(parser.produce parser)\n\n"
{"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.consume", cfun_consume,
"(parser.consume parser bytes [, index])\n\n"
{"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.byte", cfun_byte,
"(parser.byte parser b)\n\n"
{"parser/byte", cfun_byte,
"(parser/byte parser b)\n\n"
"Input a single byte into the parser byte stream. Returns the parser."
},
{"parser.error", cfun_error,
"(parser.error parser)\n\n"
{"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.status", cfun_status,
"(parser.status parser)\n\n"
{"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"
@ -814,21 +815,21 @@ static const JanetReg cfuns[] = {
"\t:error - a parsing error was encountered.\n"
"\t:root - the parser can either read more values or safely terminate."
},
{"parser.flush", cfun_flush,
"(parser.flush parser)\n\n"
{"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.state", cfun_state,
"(parser.state parser)\n\n"
{"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.where", cfun_where,
"(parser.where parser)\n\n"
{"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."

View File

@ -34,6 +34,93 @@ static JanetSlot janetc_quote(JanetFopts opts, int32_t argn, const Janet *argv)
return janetc_cslot(argv[0]);
}
static JanetSlot qq_slots(JanetFopts opts, JanetSlot *slots, int makeop) {
JanetSlot target = janetc_gettarget(opts);
int32_t i;
for (i = 0; i < janet_v_count(slots); i++) {
JanetSlot s = slots[i];
int op = (s.flags & JANET_SLOT_SPLICED) ? JOP_PUSH_ARRAY : JOP_PUSH;
janetc_emit_s(opts.compiler, op, s, 0);
}
janetc_freeslots(opts.compiler, slots);
janetc_emit_s(opts.compiler, makeop, target, 1);
return target;
}
static JanetSlot quasiquote(JanetFopts opts, Janet x, int can_splice) {
JanetSlot *slots = NULL;
switch (janet_type(x)) {
default:
return janetc_cslot(x);
case JANET_TUPLE:
{
int32_t i, len;
const Janet *tup = janet_unwrap_tuple(x);
len = janet_tuple_length(tup);
if (len > 1 && janet_checktype(tup[0], JANET_SYMBOL)) {
const uint8_t *head = janet_unwrap_symbol(tup[0]);
if (!janet_cstrcmp(head, "unquote")) {
return janetc_value(janetc_fopts_default(opts.compiler), tup[1]);
} else if (!janet_cstrcmp(head, "unquote-splicing")) {
JanetSlot s;
if (!can_splice) {
janetc_cerror(opts.compiler, "cannot use unquote-splicing here");
}
s = janetc_value(janetc_fopts_default(opts.compiler), tup[1]);
s.flags |= JANET_SLOT_SPLICED;
return s;
}
}
for (i = 0; i < len; i++)
janet_v_push(slots, quasiquote(opts, tup[i], 1));
return qq_slots(opts, slots, JOP_MAKE_TUPLE);
}
case JANET_ARRAY:
{
int32_t i;
JanetArray *array = janet_unwrap_array(x);
for (i = 0; i < array->count; i++)
janet_v_push(slots, quasiquote(opts, array->data[i], 1));
return qq_slots(opts, slots, JOP_MAKE_ARRAY);
}
case JANET_TABLE:
case JANET_STRUCT:
{
const JanetKV *kv = NULL, *kvs = NULL;
int32_t len, cap;
janet_dictionary_view(x, &kvs, &len, &cap);
while ((kv = janet_dictionary_next(kvs, cap, kv))) {
janet_v_push(slots, quasiquote(opts, kv->key, 0));
janet_v_push(slots, quasiquote(opts, kv->value, 0));
}
return qq_slots(opts, slots,
janet_checktype(x, JANET_TABLE) ? JOP_MAKE_TABLE : JOP_MAKE_STRUCT);
}
}
}
static JanetSlot janetc_quasiquote(JanetFopts opts, int32_t argn, const Janet *argv) {
if (argn != 1) {
janetc_cerror(opts.compiler, "expected 1 argument");
return janetc_cslot(janet_wrap_nil());
}
return quasiquote(opts, argv[0], 0);
}
static JanetSlot janetc_unquote(JanetFopts opts, int32_t argn, const Janet *argv) {
(void) argn;
(void) argv;
janetc_cerror(opts.compiler, "cannot use unquote here");
return janetc_cslot(janet_wrap_nil());
}
static JanetSlot janetc_unquote_splicing(JanetFopts opts, int32_t argn, const Janet *argv) {
(void) argn;
(void) argv;
janetc_cerror(opts.compiler, "cannot use unquote-splicing here");
return janetc_cslot(janet_wrap_nil());
}
/* Preform destructuring. Be careful to
* keep the order registers are freed.
* Returns if the slot 'right' can be freed. */
@ -582,7 +669,10 @@ static const JanetSpecial janetc_specials[] = {
{"do", janetc_do},
{"fn", janetc_fn},
{"if", janetc_if},
{"quasiquote", janetc_quasiquote},
{"quote", janetc_quote},
{"unquote", janetc_unquote},
{"unquote-splicing", janetc_unquote_splicing},
{"var", janetc_var},
{"while", janetc_while}
};

View File

@ -1205,84 +1205,84 @@ static int cfun_pretty(JanetArgs args) {
}
static const JanetReg cfuns[] = {
{"string.slice", cfun_slice,
"(string.slice bytes [,start=0 [,end=(length str)]])\n\n"
{"string/slice", cfun_slice,
"(string/slice bytes [,start=0 [,end=(length str)]])\n\n"
"Returns a substring from a byte sequence. The substring is from "
"index start inclusive to index end exclusive. All indexing "
"is from 0. 'start' and 'end' can also be negative to indicate indexing "
"from the end of the string."
},
{"string.repeat", cfun_repeat,
"(string.repeat bytes n)\n\n"
{"string/repeat", cfun_repeat,
"(string/repeat bytes n)\n\n"
"Returns a string that is n copies of bytes concatenated."
},
{"string.bytes", cfun_bytes,
"(string.bytes str)\n\n"
{"string/bytes", cfun_bytes,
"(string/bytes str)\n\n"
"Returns an array of integers that are the byte values of the string."
},
{"string.from-bytes", cfun_frombytes,
"(string.from-bytes byte-array)\n\n"
{"string/from-bytes", cfun_frombytes,
"(string/from-bytes byte-array)\n\n"
"Creates a string from an array of integers with byte values. All integers "
"will be coerced to the range of 1 byte 0-255."
},
{"string.ascii-lower", cfun_asciilower,
"(string.ascii-lower str)\n\n"
{"string/ascii-lower", cfun_asciilower,
"(string/ascii-lower str)\n\n"
"Returns a new string where all bytes are replaced with the "
"lowercase version of themselves in ascii. Does only a very simple "
"case check, meaning no unicode support."
},
{"string.ascii-upper", cfun_asciiupper,
"(string.ascii-upper str)\n\n"
{"string/ascii-upper", cfun_asciiupper,
"(string/ascii-upper str)\n\n"
"Returns a new string where all bytes are replaced with the "
"uppercase version of themselves in ascii. Does only a very simple "
"case check, meaning no unicode support."
},
{"string.reverse", cfun_reverse,
"(string.reverse str)\n\n"
{"string/reverse", cfun_reverse,
"(string/reverse str)\n\n"
"Returns a string that is the reversed version of str."
},
{"string.find", cfun_find,
"(string.find patt str)\n\n"
{"string/find", cfun_find,
"(string/find patt str)\n\n"
"Searches for the first instance of pattern patt in string "
"str. Returns the index of the first character in patt if found, "
"otherwise returns nil."
},
{"string.find-all", cfun_findall,
"(string.find patt str)\n\n"
{"string/find-all", cfun_findall,
"(string/find patt str)\n\n"
"Searches for all instances of pattern patt in string "
"str. Returns an array of all indices of found patterns. Overlapping "
"instances of the pattern are not counted, meaning a byte in string "
"will only contribute to finding at most on occurrence of pattern. If no "
"occurrences are found, will return an empty array."
},
{"string.replace", cfun_replace,
"(string.replace patt subst str)\n\n"
{"string/replace", cfun_replace,
"(string/replace patt subst str)\n\n"
"Replace the first occurrence of patt with subst in the the string str. "
"Will return the new string if patt is found, otherwise returns str."
},
{"string.replace-all", cfun_replaceall,
"(string.replace-all patt subst str)\n\n"
{"string/replace-all", cfun_replaceall,
"(string/replace-all patt subst str)\n\n"
"Replace all instances of patt with subst in the string str. "
"Will return the new string if patt is found, otherwise returns str."
},
{"string.split", cfun_split,
"(string.split delim str)\n\n"
{"string/split", cfun_split,
"(string/split delim str)\n\n"
"Splits a string str with delimiter delim and returns an array of "
"substrings. The substrings will not contain the delimiter delim. If delim "
"is not found, the returned array will have one element."
},
{"string.check-set", cfun_checkset,
"(string.check-set set str)\n\n"
{"string/check-set", cfun_checkset,
"(string/check-set set str)\n\n"
"Checks if any of the bytes in the string set appear in the string str. "
"Returns true if some bytes in set do appear in str, false if no bytes do."
},
{"string.join", cfun_join,
"(string.join parts [,sep])\n\n"
{"string/join", cfun_join,
"(string/join parts [,sep])\n\n"
"Joins an array of strings into one string, optionally separated by "
"a separator string sep."
},
{"string.number", cfun_number,
"(string.number x [,format [,maxlen [,precision]]])\n\n"
{"string/number", cfun_number,
"(string/number x [,format [,maxlen [,precision]]])\n\n"
"Formats a number as string. The format parameter indicates how "
"to display the number, either as floating point, scientific, or "
"whichever representation is shorter. format can be:\n\n"
@ -1296,8 +1296,8 @@ static const JanetReg cfuns[] = {
"and the precision (number of places after decimal) in the output number. "
"Returns a string representation of x."
},
{"string.pretty", cfun_pretty,
"(string.pretty x [,depth=4 [,buffer=@\"\"]])\n\n"
{"string/pretty", cfun_pretty,
"(string/pretty x [,depth=4 [,buffer=@\"\"]])\n\n"
"Pretty prints a value to a buffer. Optionally allwos setting max "
"recursion depth, as well as writing to a buffer. Returns the buffer."
},

View File

@ -252,29 +252,29 @@ static int cfun_rawget(JanetArgs args) {
}
static const JanetReg cfuns[] = {
{"table.new", cfun_new,
"(table.new capacity)\n\n"
{"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.to-struct", cfun_tostruct,
"(table.to-struct tab)\n\n"
{"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.getproto", cfun_getproto,
"(table.getproto tab)\n\n"
{"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.setproto", cfun_setproto,
"(table.setproto tab proto)\n\n"
{"table/setproto", cfun_setproto,
"(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"
{"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."

View File

@ -156,20 +156,20 @@ static int cfun_append(JanetArgs args) {
}
static const JanetReg cfuns[] = {
{"tuple.slice", cfun_slice,
"(tuple.slice arrtup [,start=0 [,end=(length arrtup)]])\n\n"
{"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.append", cfun_append,
"(tuple.append tup & items)\n\n"
{"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.prepend", cfun_prepend,
"(tuple.prepend tup & items)\n\n"
{"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."

View File

@ -11,7 +11,7 @@
# Flag handlers
(def handlers :private
{"h" (fn [&]
(print "usage: " process.args@0 " [options] scripts...")
(print "usage: " process/args.0 " [options] scripts...")
(print
`Options are:
-h Show this help
@ -21,16 +21,16 @@
-r Enter the repl after running all scripts
-p Keep on executing if there is a top level error (persistent)
-- Stop handling options`)
(os.exit 0)
(os/exit 0)
1)
"v" (fn [&] (print janet.version) (os.exit 0) 1)
"v" (fn [&] (print janet/version) (os/exit 0) 1)
"s" (fn [&] (:= *raw-stdin* true) (:= *should-repl* true) 1)
"r" (fn [&] (:= *should-repl* true) 1)
"p" (fn [&] (:= *exit-on-error* false) 1)
"-" (fn [&] (:= *handleopts* false) 1)
"e" (fn [i &]
(:= *no-file* false)
(eval (get process.args (+ i 1)))
(eval (get process/args (+ i 1)))
2)})
(defn- dohandler [n i &]
@ -39,11 +39,11 @@
# Process arguments
(var i 1)
(def lenargs (length process.args))
(def lenargs (length process/args))
(while (< i lenargs)
(def arg (get process.args i))
(if (and *handleopts* (= "-" (string.slice arg 0 1)))
(+= i (dohandler (string.slice arg 1 2) i))
(def arg (get process/args i))
(if (and *handleopts* (= "-" (string/slice arg 0 1)))
(+= i (dohandler (string/slice arg 1 2) i))
(do
(:= *no-file* false)
(import* _env arg :prefix "" :exit *exit-on-error*)
@ -53,8 +53,8 @@
(if *raw-stdin*
(repl nil identity)
(do
(print (string "Janet " janet.version " Copyright (C) 2017-2018 Calvin Rose"))
(print (string "Janet " janet/version " Copyright (C) 2017-2018 Calvin Rose"))
(repl (fn [buf p]
(def [line] (parser.where p))
(def prompt (string "janet:" line ":" (parser.state p) "> "))
(def [line] (parser/where p))
(def prompt (string "janet:" line ":" (parser/state p) "> "))
(getline prompt buf)))))))

View File

@ -38,7 +38,7 @@ int main(int argc, char **argv) {
args = janet_array(argc);
for (i = 0; i < argc; i++)
janet_array_push(args, janet_cstringv(argv[i]));
janet_def(env, "process.args", janet_wrap_array(args), "Command line arguments.");
janet_def(env, "process/args", janet_wrap_array(args), "Command line arguments.");
/* Expose line getter */
janet_def(env, "getline", janet_wrap_cfunction(janet_line_getter), NULL);

View File

@ -45,7 +45,6 @@ static int is_symbol_char_gen(uint8_t c) {
c == '@' ||
c == '^' ||
c == '_' ||
c == '~' ||
c == '|');
}

View File

@ -19,4 +19,4 @@
(defn end-suite []
(print "\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)))
(if (not= num-tests-passed num-tests-run) (os/exit 1)))

View File

@ -18,7 +18,7 @@
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
# IN THE SOFTWARE.
(import test.helper :prefix "" :exit true)
(import test/helper :prefix "" :exit true)
(start-suite 0)
(assert (= 10 (+ 1 2 3 4)) "addition")
@ -38,7 +38,7 @@
(assert (= -7 (% -20 13)) "modulo 2")
(assert (order< nil false true
(fiber.new (fn [] 1))
(fiber/new (fn [] 1))
1 1.0 "hi"
(quote hello)
(array 1 2 3)
@ -81,15 +81,15 @@
# Mcarthy's 91 function
(var f91 nil)
(:= f91 (fn [n] (if (> n 100) (- n 10) (f91 (f91 (+ n 11))))))
(assert (= 91 (f91 10)), "f91(10) = 91")
(assert (= 91 (f91 11)), "f91(11) = 91")
(assert (= 91 (f91 20)), "f91(20) = 91")
(assert (= 91 (f91 31)), "f91(31) = 91")
(assert (= 91 (f91 100)), "f91(100) = 91")
(assert (= 91 (f91 101)), "f91(101) = 91")
(assert (= 92 (f91 102)), "f91(102) = 92")
(assert (= 93 (f91 103)), "f91(103) = 93")
(assert (= 94 (f91 104)), "f91(104) = 94")
(assert (= 91 (f91 10)) "f91(10) = 91")
(assert (= 91 (f91 11)) "f91(11) = 91")
(assert (= 91 (f91 20)) "f91(20) = 91")
(assert (= 91 (f91 31)) "f91(31) = 91")
(assert (= 91 (f91 100)) "f91(100) = 91")
(assert (= 91 (f91 101)) "f91(101) = 91")
(assert (= 92 (f91 102)) "f91(102) = 92")
(assert (= 93 (f91 103)) "f91(103) = 93")
(assert (= 94 (f91 104)) "f91(104) = 94")
# Fibonacci
(def fib (do (var fib nil) (:= fib (fn [n] (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2))))))))
@ -154,7 +154,7 @@
# Fiber tests
(def afiber (fiber.new (fn []
(def afiber (fiber/new (fn []
(def x (yield))
(error (string "hello, " x))) :ye))
@ -162,16 +162,16 @@
(def afiber-result (resume afiber "world!"))
(assert (= afiber-result "hello, world!") "fiber error result")
(assert (= (fiber.status afiber) :error) "fiber error status")
(assert (= (fiber/status afiber) :error) "fiber error status")
# yield tests
(def t (fiber.new (fn [&] (yield 1) (yield 2) 3)))
(def t (fiber/new (fn [&] (yield 1) (yield 2) 3)))
(assert (= 1 (resume t)) "initial transfer to new fiber")
(assert (= 2 (resume t)) "second transfer to fiber")
(assert (= 3 (resume t)) "return from fiber")
(assert (= (fiber.status t) :dead) "finished fiber is dead")
(assert (= (fiber/status t) :dead) "finished fiber is dead")
# Var arg tests
@ -215,7 +215,7 @@
# Merge sort
# Imperative merge sort merge
# Imperative (and verbose) merge sort merge
(defn merge
[xs ys]
(def ret @[])
@ -228,17 +228,17 @@
(def xi (get xs i))
(def yj (get ys j))
(if (< xi yj)
(do (array.push ret xi) (:= i (+ i 1)))
(do (array.push ret yj) (:= j (+ j 1)))))
(do (array/push ret xi) (:= i (+ i 1)))
(do (array/push ret yj) (:= j (+ j 1)))))
# Push rest of xs
(while (< i xlen)
(def xi (get xs i))
(array.push ret xi)
(array/push ret xi)
(:= i (+ i 1)))
# Push rest of ys
(while (< j ylen)
(def yj (get ys j))
(array.push ret yj)
(array/push ret yj)
(:= j (+ j 1)))
ret)
@ -260,9 +260,9 @@
# Let
(assert (= (let [a 1 b 2] (+ a b)) 3), "simple let")
(assert (= (let [[a b] @[1 2]] (+ a b)) 3), "destructured let")
(assert (= (let [[a [c d] b] @[1 (tuple 4 3) 2]] (+ a b c d)) 10), "double destructured let")
(assert (= (let [a 1 b 2] (+ a b)) 3) "simple let")
(assert (= (let [[a b] @[1 2]] (+ a b)) 3) "destructured let")
(assert (= (let [[a [c d] b] @[1 (tuple 4 3) 2]] (+ a b c d)) 10) "double destructured let")
# Macros

View File

@ -18,11 +18,11 @@
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
# IN THE SOFTWARE.
(import test.helper :prefix "" :exit true)
(import test/helper :prefix "" :exit true)
(start-suite 1)
(assert (= 400.0 (math.sqrt 160000)) "sqrt(160000)=400")
(assert (= (real 400) (math.sqrt 160000)) "sqrt(160000)=400")
(assert (= 400.0 (math/sqrt 160000)) "sqrt(160000)=400")
(assert (= (real 400) (math/sqrt 160000)) "sqrt(160000)=400")
(def test-struct {'def 1 'bork 2 'sam 3 'a 'b 'het @[1 2 3 4 5]})
(assert (= (get test-struct 'def) 1) "struct get")
@ -47,7 +47,7 @@
(:= good false)))
(assert good e))
(assert-many (fn [] (>= 1 (math.random) 0)) 200 "(random) between 0 and 1")
(assert-many (fn [] (>= 1 (math/random) 0)) 200 "(random) between 0 and 1")
## Table prototypes
@ -59,7 +59,7 @@
:childprop 456
})
(table.setproto childtab roottab)
(table/setproto childtab roottab)
(assert (= 123 (get roottab :parentprop)) "table get 1")
(assert (= 123 (get childtab :parentprop)) "table get proto")
@ -70,7 +70,7 @@
(assert (= "hello, world" `hello, world`) "simple long string")
(assert (= "hello, \"world\"" `hello, "world"`) "long string with embedded quotes")
(assert (= "hello, \\\\\\ \"world\"" `hello, \\\ "world"`),
(assert (= "hello, \\\\\\ \"world\"" `hello, \\\ "world"`)
"long string with embedded quotes and backslashes")
# More fiber semantics
@ -78,19 +78,19 @@
(var myvar 0)
(defn fiberstuff [&]
(++ myvar)
(def f (fiber.new (fn [&] (++ myvar) (debug) (++ myvar))))
(def f (fiber/new (fn [&] (++ myvar) (debug) (++ myvar))))
(resume f)
(++ myvar))
(def myfiber (fiber.new fiberstuff :dey))
(def myfiber (fiber/new fiberstuff :dey))
(assert (= myvar 0) "fiber creation does not call fiber function")
(resume myfiber)
(assert (= myvar 2) "fiber debug statement breaks at proper point")
(assert (= (fiber.status myfiber) :debug) "fiber enters debug state")
(assert (= (fiber/status myfiber) :debug) "fiber enters debug state")
(resume myfiber)
(assert (= myvar 4) "fiber resumes properly from debug state")
(assert (= (fiber.status myfiber) :dead) "fiber properly dies from debug state")
(assert (= (fiber/status myfiber) :dead) "fiber properly dies from debug state")
# Test max triangle program
@ -98,8 +98,8 @@
# of the triangle to the leaves of the triangle.
(defn myfold [xs ys]
(let [xs1 (tuple.prepend xs 0)
xs2 (tuple.append xs 0)
(let [xs1 (tuple/prepend xs 0)
xs2 (tuple/append xs 0)
m1 (map + xs1 ys)
m2 (map + xs2 ys)]
(map max m1 m2)))
@ -119,12 +119,12 @@
(assert (= (maxpath triangle) 25) `max triangle`)
(assert (= (string.join @["one" "two" "three"]) "onetwothree") "string.join 1 argument")
(assert (= (string.join @["one" "two" "three"] ", ") "one, two, three") "string.join 2 arguments")
(assert (= (string.join @[] ", ") "") "string.join empty array")
(assert (= (string/join @["one" "two" "three"]) "onetwothree") "string/join 1 argument")
(assert (= (string/join @["one" "two" "three"] ", ") "one, two, three") "string/join 2 arguments")
(assert (= (string/join @[] ", ") "") "string/join empty array")
(assert (= (string.find "123" "abc123def") 3) "string.find positive")
(assert (= (string.find "1234" "abc123def") nil) "string.find negative")
(assert (= (string/find "123" "abc123def") 3) "string/find positive")
(assert (= (string/find "1234" "abc123def") nil) "string/find negative")
# Test destructuring
(do
@ -169,13 +169,13 @@
(testmarsh (fn thing [x] (+ 11 x x 30)) "marshal function 3")
(testmarsh map "marshal function 4")
(testmarsh reduce "marshal function 5")
(testmarsh (fiber.new (fn [] (yield 1) 2)) "marshal simple fiber 1")
(testmarsh (fiber.new (fn [&] (yield 1) 2)) "marshal simple fiber 2")
(testmarsh (fiber/new (fn [] (yield 1) 2)) "marshal simple fiber 1")
(testmarsh (fiber/new (fn [&] (yield 1) 2)) "marshal simple fiber 2")
# Large functions
(def manydefs (seq [i :range [0 300]] (tuple 'def (gensym) (string "value_" i))))
(array.push manydefs (tuple * 10000 3 5 7 9))
(def f (compile (tuple.prepend manydefs 'do) *env*))
(array/push manydefs (tuple * 10000 3 5 7 9))
(def f (compile (tuple/prepend manydefs 'do) *env*))
(assert (= (f) (* 10000 3 5 7 9)) "long function compilation")
# Some higher order functions and macros
@ -201,9 +201,9 @@
6 :six
7 :seven
8 :eight
9 :nine)), "case macro")
9 :nine)) "case macro")
(assert (= 7 (case :a :b 5 :c 6 :u 10 7)), "case with default")
(assert (= 7 (case :a :b 5 :c 6 :u 10 7)) "case with default")
# Testing the loop and for macros
(def xs (apply tuple (seq [x :range [0 10] :when (even? x)] (tuple (/ x 2) x))))
@ -215,11 +215,11 @@
# Closure in while loop
(def closures (seq [i :range [0 5]] (fn [] i)))
(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")
(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")
# More numerical tests
(assert (== 1 1.0) "numerical equal 1")
@ -237,12 +237,12 @@
(= (apply tuple a) (apply tuple b))))
(assert (= (apply tuple @[1 2 3 4 5]) (tuple 1 2 3 4 5)) "array to tuple")
(def arr (array))
(array.push arr :hello)
(array.push arr :world)
(array/push arr :hello)
(array/push arr :world)
(assert (array= arr @[:hello :world]) "array comparision")
(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")
(assert (array= (array.slice @[0 7 3 9 1 4] 2 -2) @[3 9 1]) "array.slice 2")
(assert (array= (array/slice @[1 2 3] 0 2) @[1 2]) "array/slice 1")
(assert (array= (array/slice @[0 7 3 9 1 4] 2 -2) @[3 9 1]) "array/slice 2")
(end-suite)

View File

@ -18,7 +18,7 @@
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
# IN THE SOFTWARE.
(import test.helper :prefix "" :exit true)
(import test/helper :prefix "" :exit true)
(start-suite 2)
# Buffer stuff
@ -41,7 +41,7 @@
# Looping idea
(def xs
(seq [x :in '[-1 0 1], y :in '[-1 0 1] :when (not= x y 0)] (tuple x y)))
(seq [x :in '[-1 0 1] y :in '[-1 0 1] :when (not= x y 0)] (tuple x y)))
(def txs (apply tuple xs))
(assert (= txs '[[-1 -1] [-1 0] [-1 1] [0 -1] [0 1] [1 -1] [1 0] [1 1]]) "nested seq")
@ -61,26 +61,26 @@
(assert (= X1 100) "X1 as symbol")
# String functions
(assert (= 3 (string.find "abc" " abcdefghijklmnop")) "string.find 1")
(assert (= nil (string.find "" "")) "string.find 2")
(assert (= 0 (string.find "A" "A")) "string.find 3")
(assert (= (string.replace "X" "." "XXX...XXX...XXX") ".XX...XXX...XXX") "string.replace 1")
(assert (= (string.replace-all "X" "." "XXX...XXX...XXX") "...............") "string.replace-all 1")
(assert (= (string.replace-all "XX" "." "XXX...XXX...XXX") ".X....X....X") "string.replace-all 2")
(assert (= (string.ascii-lower "ABCabc&^%!@:;.") "abcabc&^%!@:;.") "string.ascii-lower")
(assert (= (string.ascii-upper "ABCabc&^%!@:;.") "ABCABC&^%!@:;.") "string.ascii-lower")
(assert (= (string.reverse "") "") "string.reverse 1")
(assert (= (string.reverse "a") "a") "string.reverse 2")
(assert (= (string.reverse "abc") "cba") "string.reverse 3")
(assert (= (string.reverse "abcd") "dcba") "string.reverse 4")
(assert (= (string.join @["one" "two" "three"] ",") "one,two,three") "string.join 1")
(assert (= (string.join @["one" "two" "three"] ", ") "one, two, three") "string.join 2")
(assert (= (string.join @["one" "two" "three"]) "onetwothree") "string.join 3")
(assert (= (string.join @[] "hi") "") "string.join 4")
(assert (deep= (string.split "," "one,two,three") @["one" "two" "three"]) "string.split 1")
(assert (deep= (string.split "," "onetwothree") @["onetwothree"]) "string.split 2")
(assert (deep= (string.find-all "e" "onetwothree") @[2 9 10]) "string.find-all 1")
(assert (deep= (string.find-all "," "onetwothree") @[]) "string.find-all 2")
(assert (= 3 (string/find "abc" " abcdefghijklmnop")) "string/find 1")
(assert (= nil (string/find "" "")) "string/find 2")
(assert (= 0 (string/find "A" "A")) "string/find 3")
(assert (= (string/replace "X" "." "XXX...XXX...XXX") ".XX...XXX...XXX") "string/replace 1")
(assert (= (string/replace-all "X" "." "XXX...XXX...XXX") "...............") "string/replace-all 1")
(assert (= (string/replace-all "XX" "." "XXX...XXX...XXX") ".X....X....X") "string/replace-all 2")
(assert (= (string/ascii-lower "ABCabc&^%!@:;.") "abcabc&^%!@:;.") "string/ascii-lower")
(assert (= (string/ascii-upper "ABCabc&^%!@:;.") "ABCABC&^%!@:;.") "string/ascii-lower")
(assert (= (string/reverse "") "") "string/reverse 1")
(assert (= (string/reverse "a") "a") "string/reverse 2")
(assert (= (string/reverse "abc") "cba") "string/reverse 3")
(assert (= (string/reverse "abcd") "dcba") "string/reverse 4")
(assert (= (string/join @["one" "two" "three"] ",") "one,two,three") "string/join 1")
(assert (= (string/join @["one" "two" "three"] ", ") "one, two, three") "string/join 2")
(assert (= (string/join @["one" "two" "three"]) "onetwothree") "string/join 3")
(assert (= (string/join @[] "hi") "") "string/join 4")
(assert (deep= (string/split "," "one,two,three") @["one" "two" "three"]) "string/split 1")
(assert (deep= (string/split "," "onetwothree") @["onetwothree"]) "string/split 2")
(assert (deep= (string/find-all "e" "onetwothree") @[2 9 10]) "string/find-all 1")
(assert (deep= (string/find-all "," "onetwothree") @[]) "string/find-all 2")
# Check if abstract test works
(assert (abstract? stdout) "abstract? stdout")