mirror of https://github.com/janet-lang/janet
Add shorthand function literals to janet.
These are similar to the function literals from Clojure (also Fennel), and should make short functions for maps, filters, etc. easier to write.
This commit is contained in:
Calvin Rose
parent
5c83ebd75d
commit
44e752d737
|
|
@ -2,6 +2,9 @@
|
|||
All notable changes to this project will be documented in this file.
|
||||
|
||||
## Unreleased
|
||||
- Add function literal short-hand via `|` reader macro, which maps to the
|
||||
`short-fn` macro.
|
||||
- Add `int?` and `nat?` functions to the core.
|
||||
- Add `(dyn :executable)` at top level to get what used to be
|
||||
`(process/args 0)`.
|
||||
- Add `:linux` to platforms returned by `(os/which)`.
|
||||
|
|
|
|||
|
|
@ -106,6 +106,7 @@
|
|||
(defn false? "Check if x is false." [x] (= x false))
|
||||
(defn nil? "Check if x is nil." [x] (= x nil))
|
||||
(defn empty? "Check if xs is empty." [xs] (= 0 (length xs)))
|
||||
|
||||
(def idempotent?
|
||||
"(idempotent? x)\n\nCheck if x is a value that evaluates to itself when compiled."
|
||||
(do
|
||||
|
|
@ -390,7 +391,7 @@
|
|||
and object is any janet expression. The available verbs are:\n\n
|
||||
\t:iterate - repeatedly evaluate and bind to the expression while it is truthy.\n
|
||||
\t:range - loop over a range. The object should be two element tuple with a start
|
||||
and end value, and an optional postive step. The range is half open, [start, end).\n
|
||||
and end value, and an optional positive step. The range is half open, [start, end).\n
|
||||
\t:down - Same as range, but loops in reverse.\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
|
||||
|
|
@ -1290,14 +1291,21 @@
|
|||
###
|
||||
|
||||
(defn macex1
|
||||
"Expand macros in a form, but do not recursively expand macros."
|
||||
[x]
|
||||
"Expand macros in a form, but do not recursively expand macros.
|
||||
See macex docs for info on on-binding."
|
||||
[x &opt on-binding]
|
||||
|
||||
(when on-binding
|
||||
(when (symbol? x)
|
||||
(break (on-binding x))))
|
||||
|
||||
(defn recur [y] (macex1 y on-binding))
|
||||
|
||||
(defn dotable [t on-value]
|
||||
(def newt @{})
|
||||
(var key (next t nil))
|
||||
(while (not= nil key)
|
||||
(put newt (macex1 key) (on-value (get t key)))
|
||||
(put newt (recur key) (on-value (get t key)))
|
||||
(set key (next t key)))
|
||||
newt)
|
||||
|
||||
|
|
@ -1307,7 +1315,7 @@
|
|||
:tuple (tuple/slice (map expand-bindings x))
|
||||
:table (dotable x expand-bindings)
|
||||
:struct (table/to-struct (dotable x expand-bindings))
|
||||
(macex1 x)))
|
||||
(recur x)))
|
||||
|
||||
(defn expanddef [t]
|
||||
(def last (get t (- (length t) 1)))
|
||||
|
|
@ -1316,20 +1324,20 @@
|
|||
(array/concat
|
||||
@[(get t 0) (expand-bindings bound)]
|
||||
(tuple/slice t 2 -2)
|
||||
@[(macex1 last)])))
|
||||
@[(recur last)])))
|
||||
|
||||
(defn expandall [t]
|
||||
(def args (map macex1 (tuple/slice t 1)))
|
||||
(def args (map recur (tuple/slice t 1)))
|
||||
(tuple (get t 0) ;args))
|
||||
|
||||
(defn expandfn [t]
|
||||
(def t1 (get t 1))
|
||||
(if (symbol? t1)
|
||||
(do
|
||||
(def args (map macex1 (tuple/slice t 3)))
|
||||
(def args (map recur (tuple/slice t 3)))
|
||||
(tuple 'fn t1 (get t 2) ;args))
|
||||
(do
|
||||
(def args (map macex1 (tuple/slice t 2)))
|
||||
(def args (map recur (tuple/slice t 2)))
|
||||
(tuple 'fn t1 ;args))))
|
||||
|
||||
(defn expandqq [t]
|
||||
|
|
@ -1338,7 +1346,7 @@
|
|||
:tuple (do
|
||||
(def x0 (get x 0))
|
||||
(if (or (= 'unquote x0) (= 'unquote-splicing x0))
|
||||
(tuple x0 (macex1 (get x 1)))
|
||||
(tuple x0 (recur (get x 1)))
|
||||
(tuple/slice (map qq x))))
|
||||
:array (map qq x)
|
||||
:table (table (map qq (kvs x)))
|
||||
|
|
@ -1366,16 +1374,16 @@
|
|||
(cond
|
||||
s (s t)
|
||||
m? (m ;(tuple/slice t 1))
|
||||
(tuple/slice (map macex1 t))))
|
||||
(tuple/slice (map recur t))))
|
||||
|
||||
(def ret
|
||||
(case (type x)
|
||||
:tuple (if (= (tuple/type x) :brackets)
|
||||
(tuple/brackets ;(map macex1 x))
|
||||
(tuple/brackets ;(map recur x))
|
||||
(dotup x))
|
||||
:array (map macex1 x)
|
||||
:struct (table/to-struct (dotable x macex1))
|
||||
:table (dotable x macex1)
|
||||
:array (map recur x)
|
||||
:struct (table/to-struct (dotable x recur))
|
||||
:table (dotable x recur)
|
||||
x))
|
||||
ret)
|
||||
|
||||
|
|
@ -1415,18 +1423,64 @@
|
|||
(not (deep-not= x y)))
|
||||
|
||||
(defn macex
|
||||
"Expand macros completely."
|
||||
[x]
|
||||
"Expand macros completely.
|
||||
on-binding is an optional callback whenever a normal symbolic binding
|
||||
is encounter. This allows macros to easily see all bindings use by their
|
||||
arguments by calling macex on their contents. The binding itself is also
|
||||
replaced by the value returned by on-binding within the expand macro."
|
||||
[x &opt on-binding]
|
||||
(var previous x)
|
||||
(var current (macex1 x))
|
||||
(var current (macex1 x on-binding))
|
||||
(var counter 0)
|
||||
(while (deep-not= current previous)
|
||||
(if (> (++ counter) 200)
|
||||
(error "macro expansion too nested"))
|
||||
(set previous current)
|
||||
(set current (macex1 current)))
|
||||
(set current (macex1 current on-binding)))
|
||||
current)
|
||||
|
||||
###
|
||||
###
|
||||
### Function shorthand
|
||||
###
|
||||
###
|
||||
|
||||
(defmacro short-fn
|
||||
"fn shorthand.\n\n
|
||||
usage:\n\n
|
||||
\t(short-fn (+ $ $)) - A function that double's its arguments.\n
|
||||
\t(short-fn (string $0 $1)) - accepting multiple args\n
|
||||
\t|(+ $ $) - use pipe reader macro for terse function literals\n
|
||||
\t|(+ $&) - variadic functions"
|
||||
[arg]
|
||||
(var max-param-seen -1)
|
||||
(var vararg false)
|
||||
(defn saw-special-arg
|
||||
[num]
|
||||
(set max-param-seen (max max-param-seen num)))
|
||||
(defn on-binding
|
||||
[x]
|
||||
(if (string/has-prefix? '$ x)
|
||||
(cond
|
||||
(= '$ x)
|
||||
(do
|
||||
(saw-special-arg 0)
|
||||
'$0)
|
||||
(= '$& x)
|
||||
(do
|
||||
(set vararg true)
|
||||
x)
|
||||
:else
|
||||
(do
|
||||
(def num (scan-number (string/slice x 1)))
|
||||
(if (nat? num)
|
||||
(saw-special-arg num))
|
||||
x))
|
||||
x))
|
||||
(def expanded (macex arg on-binding))
|
||||
(def fn-args (seq [i :range [0 (+ 1 max-param-seen)]] (symbol '$ i)))
|
||||
~(fn [,;fn-args ,;(if vararg ['& '$&] [])] ,expanded))
|
||||
|
||||
###
|
||||
###
|
||||
### Evaluation and Compilation
|
||||
|
|
@ -1474,7 +1528,7 @@
|
|||
:env - the environment to compile against - default is the current env\n\t
|
||||
:source - string path of source for better errors - default is \"<anonymous>\"\n\t
|
||||
:on-compile-error - callback when compilation fails - default is bad-compile\n\t
|
||||
:compile-only - only compile the souce, do not execute it - default is false\n\t
|
||||
:compile-only - only compile the source, do not execute it - default is false\n\t
|
||||
:on-status - callback when a value is evaluated - default is debug/stacktrace\n\t
|
||||
:fiber-flags - what flags to wrap the compilation fiber with. Default is :ia."
|
||||
[opts]
|
||||
|
|
|
|||
|
|
@ -22,6 +22,7 @@
|
|||
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet.h>
|
||||
#include <math.h>
|
||||
#include "compile.h"
|
||||
#include "state.h"
|
||||
#include "util.h"
|
||||
|
|
@ -459,6 +460,24 @@ static Janet janet_core_untrace(int32_t argc, Janet *argv) {
|
|||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet janet_core_check_int(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
if (!janet_checktype(argv[0], JANET_NUMBER)) goto ret_false;
|
||||
double num = janet_unwrap_number(argv[0]);
|
||||
return janet_wrap_boolean(num == (double)((int32_t)num));
|
||||
ret_false:
|
||||
return janet_wrap_false();
|
||||
}
|
||||
|
||||
static Janet janet_core_check_nat(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
if (!janet_checktype(argv[0], JANET_NUMBER)) goto ret_false;
|
||||
double num = janet_unwrap_number(argv[0]);
|
||||
return janet_wrap_boolean(num >= 0 && (num == (double)((int32_t)num)));
|
||||
ret_false:
|
||||
return janet_wrap_false();
|
||||
}
|
||||
|
||||
static const JanetReg corelib_cfuns[] = {
|
||||
{
|
||||
"native", janet_core_native,
|
||||
|
|
@ -636,6 +655,16 @@ static const JanetReg corelib_cfuns[] = {
|
|||
"to expand the path to a path that can be "
|
||||
"used for importing files.")
|
||||
},
|
||||
{
|
||||
"int?", janet_core_check_int,
|
||||
JDOC("(int? x)\n\n"
|
||||
"Check if x can be exactly represented as a 32 bit signed two's complement integer.")
|
||||
},
|
||||
{
|
||||
"nat?", janet_core_check_nat,
|
||||
JDOC("(nat? x)\n\n"
|
||||
"Check if x can be exactly represented as a non-negative 32 bit signed two's complement integer.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
|
|
|
|||
|
|
@ -42,7 +42,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, 0x17fffffe,
|
||||
0x00000000, 0xf7ffec72, 0xc7ffffff, 0x07fffffe,
|
||||
0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff
|
||||
};
|
||||
|
||||
|
|
@ -179,6 +179,7 @@ static void popstate(JanetParser *p, Janet val) {
|
|||
(c == '\'') ? "quote" :
|
||||
(c == ',') ? "unquote" :
|
||||
(c == ';') ? "splice" :
|
||||
(c == '|') ? "short-fn" :
|
||||
(c == '~') ? "quasiquote" : "<unknown>";
|
||||
t[0] = janet_csymbolv(which);
|
||||
t[1] = val;
|
||||
|
|
@ -492,6 +493,7 @@ static int root(JanetParser *p, JanetParseState *state, uint8_t c) {
|
|||
case ',':
|
||||
case ';':
|
||||
case '~':
|
||||
case '|':
|
||||
pushstate(p, root, PFLAG_READERMAC | c);
|
||||
return 1;
|
||||
case '"':
|
||||
|
|
|
|||
|
|
@ -144,4 +144,16 @@
|
|||
(assert (= 15 ((comp inc inc inc inc inc +) 1 2 3 4)) "variadic comp 6")
|
||||
(assert (= 16 ((comp inc inc inc inc inc inc +) 1 2 3 4)) "variadic comp 7")
|
||||
|
||||
# Function shorthand
|
||||
(assert (= (|(+ 1 2 3)) 6) "function shorthand 1")
|
||||
(assert (= (|(+ 1 2 3 $) 4) 10) "function shorthand 2")
|
||||
(assert (= (|(+ 1 2 3 $0) 4) 10) "function shorthand 3")
|
||||
(assert (= (|(+ $0 $0 $0 $0) 4) 16) "function shorthand 4")
|
||||
(assert (= (|(+ $ $ $ $) 4) 16) "function shorthand 5")
|
||||
(assert (= (|4) 4) "function shorthand 6")
|
||||
(assert (= (((|||4))) 4) "function shorthand 7")
|
||||
(assert (= (|(+ $1 $1 $1 $1) 2 4) 16) "function shorthand 8")
|
||||
(assert (= (|(+ $0 $1 $3 $2 $6) 0 1 2 3 4 5 6) 12) "function shorthand 9")
|
||||
|
||||
|
||||
(end-suite)
|
||||
|
|
|
|||
|
|
@ -44,8 +44,7 @@ static int is_symbol_char_gen(uint8_t c) {
|
|||
c == '>' ||
|
||||
c == '@' ||
|
||||
c == '^' ||
|
||||
c == '_' ||
|
||||
c == '|');
|
||||
c == '_');
|
||||
}
|
||||
|
||||
int main() {
|
||||
|
|
|
|||
Loading…
Reference in New Issue