1
0
mirror of https://github.com/janet-lang/janet synced 2024-06-17 10:49:56 +00:00

Be stricter with function arity.

This commit is contained in:
Calvin Rose 2018-08-03 13:41:44 -04:00
parent a91e29bc1d
commit 06c755c98a
7 changed files with 86 additions and 35 deletions

View File

@ -268,7 +268,7 @@
[head & body]
(def len (length head))
(defn doone
[i preds]
@[i preds]
(default preds @['and])
(if (>= i len)
(tuple.prepend body 'do)
@ -338,7 +338,7 @@
subloop
(tuple ':= $i (tuple + 1 $i)))))
(error (string "unexpected loop verb: " verb)))))))
(doone 0))
(doone 0 nil))
(defmacro for
"Similar to loop, but accumulates the loop body into an array and returns that."
@ -364,13 +364,13 @@
(defmacro coro
"A wrapper for making fibers. Same as (fiber (fn [] ...body))."
[& body]
(tuple fiber.new (apply tuple 'fn [] body)))
(tuple fiber.new (apply tuple 'fn @[] 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"))
@ -477,12 +477,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]
@[ind by]
(def sa (sort (apply1 array ind) by))
(if (= :tuple (type ind))
(apply1 tuple sa)
@ -491,7 +491,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)))
@ -545,7 +545,7 @@
"Map a function over every element in an array or tuple and
use array to concatenate the results. Returns the same
type as the input sequence."
[f ind t]
@[f ind t]
(def res @[])
(loop [x :in ind]
(array.concat res (f x)))
@ -556,7 +556,7 @@
(defn filter
"Given a predicate, take only elements from an array or tuple for
which (pred element) is truthy. Returns the same type as the input sequence."
[pred ind t]
@[pred ind t]
(def res @[])
(loop [item :in ind]
(if (pred item)
@ -673,12 +673,12 @@
(if (zero? (length more)) f
(fn [& r] (apply1 f (array.concat @[] more r)))))
(defn every? [pred seq]
(defn every? [pred ind]
(var res true)
(var i 0)
(def len (length seq))
(def len (length ind))
(while (< i len)
(def item (get seq i))
(def item (get ind i))
(if (pred item)
(++ i)
(do (:= res false) (:= i len))))
@ -709,7 +709,7 @@
(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))
@ -987,7 +987,8 @@
###
###
(defn make-env [parent]
(defn make-env
@[parent]
(def parent (if parent parent _env))
(def newenv (table.setproto @{} parent))
(put newenv '_env @{:value newenv :private true})
@ -1005,7 +1006,7 @@
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)
@ -1047,7 +1048,7 @@
(var good true)
(def f
(fiber.new
(fn []
(fn @[]
(def res (compile source env where))
(if (= (type res) :function)
(res)
@ -1121,7 +1122,7 @@
environment is needed, use run-context."
[str]
(var state (string str))
(defn chunks [buf]
(defn chunks [buf _]
(def ret state)
(:= state nil)
(if ret
@ -1191,7 +1192,7 @@
(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 {}))
@ -1206,10 +1207,10 @@
(if f
(do
# Normal dst module
(defn chunks [buf] (file.read f 1024 buf))
(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))
@ -1239,11 +1240,12 @@
(put env (symbol prefix k) newv))
(:= k (next newenv k))))
(defmacro import [path & args]
(defmacro import
"Import a module. First requires the module, and then merges its
symbols into the current environment, prepending a given prefix as needed.
(use the :as or :prefix option to set a prefix). If no prefix is provided,
use the name of the module as a prefix."
[path & args]
(def argm (map (fn [x]
(if (and (symbol? x) (= (get x 0) 58))
x
@ -1251,9 +1253,10 @@
args))
(apply tuple import* '_env (string path) argm))
(defn repl [getchunk onvalue onerr]
(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]
(def newenv (make-env))
(default getchunk (fn [buf]
(file.read stdin :line buf)))
@ -1265,7 +1268,7 @@
(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))))

View File

@ -107,7 +107,7 @@ void dst_fiber_pushn(DstFiber *fiber, const Dst *arr, int32_t n) {
}
/* Push a stack frame to a fiber */
void dst_fiber_funcframe(DstFiber *fiber, DstFunction *func) {
int dst_fiber_funcframe(DstFiber *fiber, DstFunction *func) {
DstStackFrame *newframe;
int32_t i;
@ -116,6 +116,13 @@ void dst_fiber_funcframe(DstFiber *fiber, DstFunction *func) {
int32_t nextframe = fiber->stackstart;
int32_t nextstacktop = nextframe + func->def->slotcount + DST_FRAME_SIZE;
/* Check strict arity */
if (func->def->flags & DST_FUNCDEF_FLAG_FIXARITY) {
if (func->def->arity != (fiber->stacktop - fiber->stackstart)) {
return 1;
}
}
if (fiber->capacity < nextstacktop) {
dst_fiber_setcapacity(fiber, 2 * nextstacktop);
}
@ -146,6 +153,9 @@ void dst_fiber_funcframe(DstFiber *fiber, DstFunction *func) {
oldtop - tuplehead));
}
}
/* Good return */
return 0;
}
/* If a frame has a closure environment, detach it from
@ -165,12 +175,19 @@ static void dst_env_detach(DstFuncEnv *env) {
}
/* Create a tail frame for a function */
void dst_fiber_funcframe_tail(DstFiber *fiber, DstFunction *func) {
int dst_fiber_funcframe_tail(DstFiber *fiber, DstFunction *func) {
int32_t i;
int32_t nextframetop = fiber->frame + func->def->slotcount;
int32_t nextstacktop = nextframetop + DST_FRAME_SIZE;
int32_t stacksize;
/* Check strict arity */
if (func->def->flags & DST_FUNCDEF_FLAG_FIXARITY) {
if (func->def->arity != (fiber->stacktop - fiber->stackstart)) {
return 1;
}
}
if (fiber->capacity < nextstacktop) {
dst_fiber_setcapacity(fiber, 2 * nextstacktop);
}
@ -213,6 +230,9 @@ void dst_fiber_funcframe_tail(DstFiber *fiber, DstFunction *func) {
dst_fiber_frame(fiber)->func = func;
dst_fiber_frame(fiber)->pc = func->def->bytecode;
dst_fiber_frame(fiber)->flags |= DST_STACKFRAME_TAILCALL;
/* Good return */
return 0;
}
/* Push a stack frame to a fiber for a c function */
@ -263,6 +283,11 @@ static int cfun_new(DstArgs args) {
DST_MINARITY(args, 1);
DST_MAXARITY(args, 2);
DST_ARG_FUNCTION(func, args, 0);
if (func->def->flags & DST_FUNCDEF_FLAG_FIXARITY) {
if (func->def->arity != 1) {
DST_THROW(args, "expected unit arity function in fiber constructor");
}
}
fiber = dst_fiber(func, 64);
if (args.n == 2) {
const uint8_t *flags;

View File

@ -40,8 +40,8 @@ void dst_fiber_push(DstFiber *fiber, Dst x);
void dst_fiber_push2(DstFiber *fiber, Dst x, Dst y);
void dst_fiber_push3(DstFiber *fiber, Dst x, Dst y, Dst z);
void dst_fiber_pushn(DstFiber *fiber, const Dst *arr, int32_t n);
void dst_fiber_funcframe(DstFiber *fiber, DstFunction *func);
void dst_fiber_funcframe_tail(DstFiber *fiber, DstFunction *func);
int dst_fiber_funcframe(DstFiber *fiber, DstFunction *func);
int dst_fiber_funcframe_tail(DstFiber *fiber, DstFunction *func);
void dst_fiber_cframe(DstFiber *fiber, DstCFunction cfun);
void dst_fiber_popframe(DstFiber *fiber);

View File

@ -549,7 +549,14 @@ static DstSlot dstc_fn(DstFopts opts, int32_t argn, const Dst *argv) {
/* Build function */
def = dstc_pop_funcdef(c);
def->arity = arity;
if (varargs) def->flags |= DST_FUNCDEF_FLAG_VARARG;
/* Tuples indicated fixed arity, arrays indicate flexible arity */
/* TODO - revisit this */
if (varargs)
def->flags |= DST_FUNCDEF_FLAG_VARARG;
else if (dst_checktype(paramv, DST_TUPLE))
def->flags |= DST_FUNCDEF_FLAG_FIXARITY;
if (selfref) def->name = dst_unwrap_symbol(head);
defindex = dstc_addfuncdef(c, def);

View File

@ -768,7 +768,8 @@ static void *op_lookup[255] = {
if (dst_checktype(callee, DST_FUNCTION)) {
func = dst_unwrap_function(callee);
dst_stack_frame(stack)->pc = pc;
dst_fiber_funcframe(fiber, func);
if (dst_fiber_funcframe(fiber, func))
goto vm_arity_error;
stack = fiber->data + fiber->frame;
pc = func->def->bytecode;
vm_checkgc_next();
@ -794,7 +795,8 @@ static void *op_lookup[255] = {
Dst callee = stack[oparg(1, 0xFFFFFF)];
if (dst_checktype(callee, DST_FUNCTION)) {
func = dst_unwrap_function(callee);
dst_fiber_funcframe_tail(fiber, func);
if (dst_fiber_funcframe_tail(fiber, func))
goto vm_arity_error;
stack = fiber->data + fiber->frame;
pc = func->def->bytecode;
vm_checkgc_next();
@ -1190,6 +1192,17 @@ static void *op_lookup[255] = {
goto vm_reset;
}
/* Handle function calls with bad arity */
vm_arity_error:
{
retreg = dst_wrap_string(dst_formatc("calling %V got %d arguments, expected %d",
dst_wrap_function(func),
fiber->stacktop - fiber->stackstart,
func->def->arity));
signal = DST_SIGNAL_ERROR;
goto vm_exit;
}
/* Resume a child fiber */
vm_resume_child:
{
@ -1293,7 +1306,10 @@ DstSignal dst_call(
*f = fiber;
for (i = 0; i < argn; i++)
dst_fiber_push(fiber, argv[i]);
dst_fiber_funcframe(fiber, fiber->root);
if (dst_fiber_funcframe(fiber, fiber->root)) {
*out = dst_cstringv("arity mismatch");
return DST_SIGNAL_ERROR;
}
/* Prevent push an extra value on the stack */
dst_fiber_set_status(fiber, DST_STATUS_PENDING);
return dst_continue(fiber, dst_wrap_nil(), out);

View File

@ -155,7 +155,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")

View File

@ -43,7 +43,7 @@
(defn assert-many [f n e]
(var good true)
(loop [i :range [0 n]]
(if (not (f i))
(if (not (f))
(:= good false)))
(assert good e))
@ -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))