mirror of https://github.com/janet-lang/janet
Change format for declaring flexible arity functions.
This commit is contained in:
Calvin Rose
parent
5b3fc3d2cc
commit
d4ee760b3e
|
|
@ -0,0 +1,67 @@
|
|||
# Classes need to:
|
||||
# 1. Construct Objects
|
||||
# 2. Keep metadata of objects
|
||||
# 3. Support Method Lookup given a method signature
|
||||
# 4. Add Methods
|
||||
# 5. Keep around state
|
||||
|
||||
(defn- parse-signature
|
||||
"Turn a signature into a (method, object) pair."
|
||||
[signature]
|
||||
(when (not (symbol? signature)) (error "expected method signature"))
|
||||
(def parts (string.split ":" signature))
|
||||
(def self (symbol (get parts 0)))
|
||||
(def method (apply symbol (tuple.slice parts 1)))
|
||||
(tuple (tuple 'quote method) self))
|
||||
|
||||
(defn- add-self-to-body
|
||||
"Take a function definition and add the parameter 'self'
|
||||
to the declaration."
|
||||
[body]
|
||||
(def args-index (find-index tuple? body))
|
||||
(def bodya (apply array body))
|
||||
(put bodya args-index (tuple.prepend (get bodya args-index) 'self))
|
||||
bodya)
|
||||
|
||||
(defmacro call
|
||||
"Call a method."
|
||||
[signature & args]
|
||||
(def [method self] (parse-signature signature))
|
||||
(apply tuple (tuple get self method) self args))
|
||||
|
||||
(def :macro $ call)
|
||||
|
||||
(defn class
|
||||
"Create a new class."
|
||||
[& args]
|
||||
(def classobj (apply table args))
|
||||
|
||||
# Set up super class
|
||||
(def super (get classobj :super))
|
||||
(when super
|
||||
(put classobj :super nil)
|
||||
(table.setproto classobj super))
|
||||
|
||||
classobj)
|
||||
|
||||
(defn new
|
||||
"Create a new instance of a class."
|
||||
[class & args]
|
||||
(def obj (table.setproto @{} class))
|
||||
(def init (get class 'init))
|
||||
(when init (apply init obj args))
|
||||
obj)
|
||||
|
||||
(defmacro defmethod
|
||||
"Defines a method for a class."
|
||||
[signature & args]
|
||||
(def [method self] (parse-signature signature))
|
||||
(def newargs (add-self-to-body args))
|
||||
(tuple put self method (tuple.prepend newargs signature 'fn)))
|
||||
|
||||
(defmacro defclass
|
||||
"Defines a new class."
|
||||
[name & body]
|
||||
(tuple 'def name
|
||||
(tuple.prepend body class)))
|
||||
|
||||
|
|
@ -1,5 +1,3 @@
|
|||
# Prints hello
|
||||
|
||||
(import examples.3sum)
|
||||
|
||||
(print "hello, world!")
|
||||
|
|
|
|||
|
|
@ -21,18 +21,16 @@
|
|||
(fn recur [i]
|
||||
(def {i ith} more)
|
||||
(def t (type ith))
|
||||
(def tuple? (= t :tuple))
|
||||
(def array? (= t :array))
|
||||
(if (if tuple? tuple? array?)
|
||||
(if (= t :tuple)
|
||||
i
|
||||
(do
|
||||
(if (= (type ith) :string)
|
||||
(if (= t :string)
|
||||
(:= docstr ith)
|
||||
(array.push modifiers ith))
|
||||
(if (< i len) (recur (+ i 1)))))))
|
||||
(def start (fstart 0))
|
||||
(def args (get more start))
|
||||
# Add arguments to definition
|
||||
# Add function signature to docstring
|
||||
(var index 0)
|
||||
(def arglen (length args))
|
||||
(def buf (buffer "(" name))
|
||||
|
|
@ -49,22 +47,22 @@
|
|||
(defn defmacro :macro
|
||||
"Define a macro."
|
||||
[name & more]
|
||||
(apply defn (array.concat @[name :macro] more)))
|
||||
(apply defn name :macro more))
|
||||
|
||||
(defmacro defmacro-
|
||||
"Define a private macro that will not be exported."
|
||||
[name & more]
|
||||
(tuple.slice (array.concat @['defmacro name :private] more) 0))
|
||||
(apply defn name :macro :private more))
|
||||
|
||||
(defmacro defn-
|
||||
"Define a private function that will not be exported."
|
||||
[name & more]
|
||||
(tuple.slice (array.concat @['defn name :private] more) 0))
|
||||
(apply defn name :private more))
|
||||
|
||||
(defmacro def-
|
||||
"Define a private value that will not be exported."
|
||||
[name & more]
|
||||
(tuple.slice (array.concat @['def name :private] more) 0))
|
||||
(tuple.slice (array.concat @['def name :private] more)))
|
||||
|
||||
(defn defglobal
|
||||
"Dynamically create a global def."
|
||||
|
|
@ -290,7 +288,7 @@
|
|||
(if (not= :tuple (type head))
|
||||
(error "expected tuple for loop head"))
|
||||
(defn doone
|
||||
@[i preds]
|
||||
[i preds &]
|
||||
(default preds @['and])
|
||||
(if (>= i len)
|
||||
(tuple.prepend body 'do)
|
||||
|
|
@ -419,7 +417,8 @@
|
|||
that yields all values inside the loop in order. See loop for details."
|
||||
[head & body]
|
||||
(tuple fiber.new
|
||||
(tuple 'fn @[] (tuple 'loop head (tuple yield (tuple.prepend body 'do))))))
|
||||
(tuple 'fn [tuple '&]
|
||||
(tuple 'loop head (tuple yield (tuple.prepend body 'do))))))
|
||||
|
||||
(defn sum [xs]
|
||||
(var accum 0)
|
||||
|
|
@ -432,15 +431,15 @@
|
|||
accum)
|
||||
|
||||
(defmacro coro
|
||||
"A wrapper for making fibers. Same as (fiber.new (fn @[] ...body))."
|
||||
"A wrapper for making fibers. Same as (fiber.new (fn [&] ...body))."
|
||||
[& body]
|
||||
(tuple fiber.new (apply tuple 'fn @[] body)))
|
||||
(tuple fiber.new (apply tuple 'fn [tuple '&] body)))
|
||||
|
||||
(defmacro if-let
|
||||
"Takes the first one or two forms in a vector and if both are true binds
|
||||
all the forms with let and evaluates the first expression else
|
||||
evaluates the second"
|
||||
@[bindings tru fal]
|
||||
[bindings tru fal &]
|
||||
(def len (length bindings))
|
||||
(if (zero? len) (error "expected at least 1 binding"))
|
||||
(if (odd? len) (error "expected an even number of bindings"))
|
||||
|
|
@ -547,12 +546,12 @@
|
|||
(sort-help a (+ piv 1) hi by))
|
||||
a)
|
||||
|
||||
(fn @[a by]
|
||||
(fn [a by &]
|
||||
(sort-help a 0 (- (length a) 1) (or by order<)))))
|
||||
|
||||
(defn sorted
|
||||
"Returns the sorted version of an indexed data structure."
|
||||
@[ind by t]
|
||||
[ind by t &]
|
||||
(def sa (sort (array.slice ind 0) by))
|
||||
(if (= :tuple (or t (type ind)))
|
||||
(tuple.slice sa 0)
|
||||
|
|
@ -561,7 +560,7 @@
|
|||
(defn reduce
|
||||
"Reduce, also know as fold-left in many languages, transforms
|
||||
an indexed type (array, tuple) with a function to produce a value."
|
||||
@[f init ind]
|
||||
[f init ind &]
|
||||
(var res init)
|
||||
(loop [x :in ind]
|
||||
(:= res (f res x)))
|
||||
|
|
@ -621,7 +620,7 @@
|
|||
"Map a function over every element in an array or tuple and
|
||||
use array to concatenate the results. Returns the type given
|
||||
as the third argument, or same type as the input indexed structure."
|
||||
@[f ind t]
|
||||
[f ind t &]
|
||||
(def res @[])
|
||||
(loop [x :in ind]
|
||||
(array.concat res (f x)))
|
||||
|
|
@ -633,7 +632,7 @@
|
|||
"Given a predicate, take only elements from an array or tuple for
|
||||
which (pred element) is truthy. Returns the type given as the
|
||||
third argument, or the same type as the input indexed structure."
|
||||
@[pred ind t]
|
||||
[pred ind t &]
|
||||
(def res @[])
|
||||
(loop [item :in ind]
|
||||
(if (pred item)
|
||||
|
|
@ -796,7 +795,7 @@ value, one key will be ignored."
|
|||
(defn zipcoll
|
||||
"Creates an table or tuple from two arrays/tuples. If a third argument of
|
||||
:struct is given result is struct else is table."
|
||||
@[keys vals t]
|
||||
[keys vals t &]
|
||||
(def res @{})
|
||||
(def lk (length keys))
|
||||
(def lv (length vals))
|
||||
|
|
@ -1070,7 +1069,7 @@ value, one key will be ignored."
|
|||
###
|
||||
|
||||
(defn make-env
|
||||
@[parent]
|
||||
[parent &]
|
||||
(def parent (if parent parent _env))
|
||||
(def newenv (table.setproto @{} parent))
|
||||
(put newenv '_env @{:value newenv :private true
|
||||
|
|
@ -1089,7 +1088,7 @@ value, one key will be ignored."
|
|||
This function can be used to implement a repl very easily, simply
|
||||
pass a function that reads line from stdin to chunks, and print to
|
||||
onvalue."
|
||||
@[env chunks onvalue onerr where]
|
||||
[env chunks onvalue onerr where &]
|
||||
|
||||
# Are we done yet?
|
||||
(var going true)
|
||||
|
|
@ -1131,7 +1130,7 @@ value, one key will be ignored."
|
|||
(var good true)
|
||||
(def f
|
||||
(fiber.new
|
||||
(fn @[]
|
||||
(fn [&]
|
||||
(def res (compile source env where))
|
||||
(if (= (type res) :function)
|
||||
(res)
|
||||
|
|
@ -1163,7 +1162,7 @@ value, one key will be ignored."
|
|||
env)
|
||||
|
||||
(defn default-error-handler
|
||||
@[source t x f]
|
||||
[source t x f &]
|
||||
(file.write stderr
|
||||
(string t " error in " source ": ")
|
||||
(if (bytes? x) x (string.pretty x))
|
||||
|
|
@ -1282,7 +1281,7 @@ value, one key will be ignored."
|
|||
|
||||
(def cache @{})
|
||||
(def loading @{})
|
||||
(fn require @[path args]
|
||||
(fn require [path args &]
|
||||
(when (get loading path)
|
||||
(error (string "circular dependency: module " path " is loading")))
|
||||
(def {:exit exit-on-error} (or args {}))
|
||||
|
|
@ -1300,7 +1299,7 @@ value, one key will be ignored."
|
|||
(defn chunks [buf _] (file.read f 1024 buf))
|
||||
(run-context newenv chunks identity
|
||||
(if exit-on-error
|
||||
(fn @[a b c d] (default-error-handler a b c d) (os.exit 1))
|
||||
(fn [a b c d &] (default-error-handler a b c d) (os.exit 1))
|
||||
default-error-handler)
|
||||
path)
|
||||
(file.close f))
|
||||
|
|
@ -1344,9 +1343,9 @@ value, one key will be ignored."
|
|||
(defn repl
|
||||
"Run a repl. The first parameter is an optional function to call to
|
||||
get a chunk of source code. Should return nil for end of file."
|
||||
@[getchunk onvalue onerr]
|
||||
[getchunk onvalue onerr &]
|
||||
(def newenv (make-env))
|
||||
(default getchunk (fn @[buf]
|
||||
(default getchunk (fn [buf &]
|
||||
(file.read stdin :line buf)))
|
||||
(def buf @"")
|
||||
(default onvalue (fn [x]
|
||||
|
|
@ -1358,7 +1357,7 @@ value, one key will be ignored."
|
|||
|
||||
(defn all-symbols
|
||||
"Get all symbols available in the current environment."
|
||||
@[env]
|
||||
[env &]
|
||||
(default env *env*)
|
||||
(def envs @[])
|
||||
(do (var e env) (while e (array.push envs e) (:= e (table.getproto e))))
|
||||
|
|
|
|||
|
|
@ -469,14 +469,18 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||
JanetCompiler *c = opts.compiler;
|
||||
JanetFuncDef *def;
|
||||
JanetSlot ret;
|
||||
Janet head, paramv;
|
||||
Janet head;
|
||||
JanetScope fnscope;
|
||||
int32_t paramcount, argi, parami, arity, defindex;
|
||||
int32_t paramcount, argi, parami, arity, defindex, i;
|
||||
JanetFopts subopts = janetc_fopts_default(c);
|
||||
const Janet *params;
|
||||
const char *errmsg = NULL;
|
||||
int varargs = 0;
|
||||
|
||||
/* Function flags */
|
||||
int vararg = 0;
|
||||
int fixarity = 1;
|
||||
int selfref = 0;
|
||||
int seenamp = 0;
|
||||
|
||||
/* Begin function */
|
||||
c->scope->flags |= JANET_SCOPE_CLOSURE;
|
||||
|
|
@ -489,41 +493,43 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||
|
||||
/* Read function parameters */
|
||||
parami = 0;
|
||||
arity = 0;
|
||||
head = argv[0];
|
||||
if (janet_checktype(head, JANET_SYMBOL)) {
|
||||
selfref = 1;
|
||||
parami = 1;
|
||||
}
|
||||
if (parami >= argn) {
|
||||
if (parami >= argn || !janet_checktype(argv[parami], JANET_TUPLE)) {
|
||||
errmsg = "expected function parameters";
|
||||
goto error;
|
||||
}
|
||||
paramv = argv[parami];
|
||||
if (janet_indexed_view(paramv, ¶ms, ¶mcount)) {
|
||||
int32_t i;
|
||||
for (i = 0; i < paramcount; i++) {
|
||||
Janet param = params[i];
|
||||
if (janet_checktype(param, JANET_SYMBOL)) {
|
||||
/* Check for varargs */
|
||||
if (0 == janet_cstrcmp(janet_unwrap_symbol(param), "&")) {
|
||||
if (i != paramcount - 2) {
|
||||
errmsg = "variable argument symbol in unexpected location";
|
||||
goto error;
|
||||
}
|
||||
varargs = 1;
|
||||
|
||||
/* Compile function parameters */
|
||||
params = janet_unwrap_tuple(argv[parami]);
|
||||
paramcount = janet_tuple_length(params);
|
||||
arity = paramcount;
|
||||
for (i = 0; i < paramcount; i++) {
|
||||
Janet param = params[i];
|
||||
if (janet_checktype(param, JANET_SYMBOL)) {
|
||||
/* Check for varargs and unfixed arity */
|
||||
if ((!seenamp) &&
|
||||
(0 == janet_cstrcmp(janet_unwrap_symbol(param), "&"))) {
|
||||
seenamp = 1;
|
||||
fixarity = 0;
|
||||
if (i == paramcount - 1) {
|
||||
arity--;
|
||||
continue;
|
||||
} else if (i == paramcount - 2) {
|
||||
vararg = 1;
|
||||
arity -= 2;
|
||||
} else {
|
||||
errmsg = "variable argument symbol in unexpected location";
|
||||
goto error;
|
||||
}
|
||||
janetc_nameslot(c, janet_unwrap_symbol(param), janetc_farslot(c));
|
||||
} else {
|
||||
destructure(c, param, janetc_farslot(c), defleaf, NULL);
|
||||
janetc_nameslot(c, janet_unwrap_symbol(param), janetc_farslot(c));
|
||||
}
|
||||
arity++;
|
||||
} else {
|
||||
destructure(c, param, janetc_farslot(c), defleaf, NULL);
|
||||
}
|
||||
} else {
|
||||
errmsg = "expected function parameters";
|
||||
goto error;
|
||||
}
|
||||
|
||||
/* Check for self ref */
|
||||
|
|
@ -547,19 +553,14 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||
/* Build function */
|
||||
def = janetc_pop_funcdef(c);
|
||||
def->arity = arity;
|
||||
|
||||
/* Tuples indicated fixed arity, arrays indicate flexible arity */
|
||||
/* TODO - revisit this */
|
||||
if (varargs)
|
||||
def->flags |= JANET_FUNCDEF_FLAG_VARARG;
|
||||
else if (janet_checktype(paramv, JANET_TUPLE))
|
||||
def->flags |= JANET_FUNCDEF_FLAG_FIXARITY;
|
||||
if (fixarity) def->flags |= JANET_FUNCDEF_FLAG_FIXARITY;
|
||||
if (vararg) def->flags |= JANET_FUNCDEF_FLAG_VARARG;
|
||||
|
||||
if (selfref) def->name = janet_unwrap_symbol(head);
|
||||
defindex = janetc_addfuncdef(c, def);
|
||||
|
||||
/* Ensure enough slots for vararg function. */
|
||||
if (arity + varargs > def->slotcount) def->slotcount = arity + varargs;
|
||||
if (arity + vararg > def->slotcount) def->slotcount = arity + vararg;
|
||||
|
||||
/* Instantiate closure */
|
||||
ret = janetc_gettarget(opts);
|
||||
|
|
|
|||
|
|
@ -10,7 +10,7 @@
|
|||
|
||||
# Flag handlers
|
||||
(def handlers :private
|
||||
{"h" (fn @[]
|
||||
{"h" (fn [&]
|
||||
(print "usage: " (get process.args 0) " [options] scripts...")
|
||||
(print
|
||||
`Options are:
|
||||
|
|
@ -23,17 +23,17 @@
|
|||
-- Stop handling options`)
|
||||
(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]
|
||||
"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)))
|
||||
2)})
|
||||
|
||||
(defn- dohandler @[n i]
|
||||
(defn- dohandler [n i &]
|
||||
(def h (get handlers n))
|
||||
(if h (h i) (do (print "unknown flag -" n) ((get handlers "h")))))
|
||||
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
(print (string "Janet " janet.version " Copyright (C) 2017-2018 Calvin Rose"))
|
||||
|
||||
(fiber.new
|
||||
(fn @[]
|
||||
(fn [&]
|
||||
(repl (fn [buf p]
|
||||
(def [line] (parser.where p))
|
||||
(def prompt (string "janet:" line ":" (parser.state p) "> "))
|
||||
|
|
|
|||
|
|
@ -164,7 +164,7 @@
|
|||
|
||||
# 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")
|
||||
|
|
|
|||
|
|
@ -76,9 +76,9 @@
|
|||
# More fiber semantics
|
||||
|
||||
(var myvar 0)
|
||||
(defn fiberstuff @[]
|
||||
(defn fiberstuff [&]
|
||||
(++ myvar)
|
||||
(def f (fiber.new (fn @[] (++ myvar) (debug) (++ myvar))))
|
||||
(def f (fiber.new (fn [&] (++ myvar) (debug) (++ myvar))))
|
||||
(resume f)
|
||||
(++ myvar))
|
||||
|
||||
|
|
@ -169,7 +169,7 @@
|
|||
(testmarsh (fn thing [x] (+ 11 x x 30)) "marshal function 3")
|
||||
(testmarsh mapa "marshal function 4")
|
||||
(testmarsh reduce "marshal function 5")
|
||||
(testmarsh (fiber.new (fn @[] (yield 1) 2)) "marshal simple fiber")
|
||||
(testmarsh (fiber.new (fn [&] (yield 1) 2)) "marshal simple fiber")
|
||||
|
||||
# Large functions
|
||||
(def manydefs (fora [i :range [0 300]] (tuple 'def (gensym) (string "value_" i))))
|
||||
|
|
|
|||
Loading…
Reference in New Issue