diff --git a/CHANGELOG.md b/CHANGELOG.md index e951507f..1611b936 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,7 @@ All notable changes to this project will be documented in this file. ## Unreleased +- Add compile time arity checking when function in function call is known. - Added `slice` to the core library. - The `*/slice` family of functions now can take nil as start or end to get the same behavior as the defaults (0 and -1) for those parameters. diff --git a/src/core/compile.c b/src/core/compile.c index cb33293b..fef980ec 100644 --- a/src/core/compile.c +++ b/src/core/compile.c @@ -320,33 +320,46 @@ JanetSlot *janetc_toslotskv(JanetCompiler *c, Janet ds) { return ret; } -/* Push slots load via janetc_toslots. */ -void janetc_pushslots(JanetCompiler *c, JanetSlot *slots) { +/* Push slots loaded via janetc_toslots. Return the minimum number of slots pushed, + * or -1 - min_arity if there is a splice. (if there is no splice, min_arity is also + * the maximum possible arity). */ +int32_t janetc_pushslots(JanetCompiler *c, JanetSlot *slots) { int32_t i; int32_t count = janet_v_count(slots); + int32_t min_arity = 0; + int has_splice = 0; for (i = 0; i < count;) { if (slots[i].flags & JANET_SLOT_SPLICED) { janetc_emit_s(c, JOP_PUSH_ARRAY, slots[i], 0); i++; + has_splice = 1; } else if (i + 1 == count) { janetc_emit_s(c, JOP_PUSH, slots[i], 0); i++; + min_arity++; } else if (slots[i + 1].flags & JANET_SLOT_SPLICED) { janetc_emit_s(c, JOP_PUSH, slots[i], 0); janetc_emit_s(c, JOP_PUSH_ARRAY, slots[i + 1], 0); i += 2; + min_arity++; + has_splice = 1; } else if (i + 2 == count) { janetc_emit_ss(c, JOP_PUSH_2, slots[i], slots[i + 1], 0); i += 2; + min_arity += 2; } else if (slots[i + 2].flags & JANET_SLOT_SPLICED) { janetc_emit_ss(c, JOP_PUSH_2, slots[i], slots[i + 1], 0); janetc_emit_s(c, JOP_PUSH_ARRAY, slots[i + 2], 0); i += 3; + min_arity += 2; + has_splice = 1; } else { janetc_emit_sss(c, JOP_PUSH_3, slots[i], slots[i + 1], slots[i + 2], 0); i += 3; + min_arity += 3; } } + return has_splice ? (-1 - min_arity) : min_arity; } /* Check if a list of slots has any spliced slots */ @@ -403,7 +416,68 @@ static JanetSlot janetc_call(JanetFopts opts, JanetSlot *slots, JanetSlot fun) { /* TODO janet function inlining (no c functions)*/ } if (!specialized) { - janetc_pushslots(c, slots); + int32_t min_arity = janetc_pushslots(c, slots); + /* Check for provably incorrect function calls */ + if (fun.flags & JANET_SLOT_CONSTANT) { + + /* Check for bad arity type if fun is a constant */ + switch (janet_type(fun.constant)) { + case JANET_FUNCTION: + { + JanetFunction *f = janet_unwrap_function(fun.constant); + int32_t min = f->def->min_arity; + int32_t max = f->def->max_arity; + if (min_arity < 0) { + /* Call has splices */ + min_arity = -1 - min_arity; + if (min_arity > max && max >= 0) { + const uint8_t *es = janet_formatc( + "%v expects at most %d argument, got at least %d", + fun.constant, max, min_arity); + janetc_error(c, es); + } + } else { + /* Call has no splices */ + if (min_arity > max && max >= 0) { + const uint8_t *es = janet_formatc( + "%v expects at most %d argument, got %d", + fun.constant, max, min_arity); + janetc_error(c, es); + } + if (min_arity < min) { + const uint8_t *es = janet_formatc( + "%v expects at least %d argument, got %d", + fun.constant, min, min_arity); + janetc_error(c, es); + } + } + } + break; + case JANET_CFUNCTION: + case JANET_ABSTRACT: + break; + case JANET_KEYWORD: + if (min_arity == 0) { + const uint8_t *es = janet_formatc("%v expects at least 1 argument, got 0", + fun.constant); + janetc_error(c, es); + } + break; + default: + if (min_arity > 1 || min_arity == 0) { + const uint8_t *es = janet_formatc("%v expects 1 argument, got %d", + fun.constant, min_arity); + janetc_error(c, es); + } + if (min_arity < -2) { + const uint8_t *es = janet_formatc("%v expects 1 argument, got at least %d", + fun.constant, -1 - min_arity); + janetc_error(c, es); + } + break; + } + } + if ((opts.flags & JANET_FOPTS_TAIL) && /* Prevent top level tail calls for better errors */ !(c->scope->flags & JANET_SCOPE_TOP)) { diff --git a/src/core/compile.h b/src/core/compile.h index 8132defe..1b5a5bfb 100644 --- a/src/core/compile.h +++ b/src/core/compile.h @@ -214,7 +214,7 @@ JanetSlot *janetc_toslots(JanetCompiler *c, const Janet *vals, int32_t len); JanetSlot *janetc_toslotskv(JanetCompiler *c, Janet ds); /* Push slots load via janetc_toslots. */ -void janetc_pushslots(JanetCompiler *c, JanetSlot *slots); +int32_t janetc_pushslots(JanetCompiler *c, JanetSlot *slots); /* Free slots loaded via janetc_toslots */ void janetc_freeslots(JanetCompiler *c, JanetSlot *slots); diff --git a/test/suite3.janet b/test/suite3.janet index 31277a75..b96d435c 100644 --- a/test/suite3.janet +++ b/test/suite3.janet @@ -78,11 +78,15 @@ # Another regression test - no segfaults (defn afn [x] x) -(assert (= 1 (try (afn) ([err] 1))) "bad arity 1") +(var afn-var afn) +(var identity-var identity) +(var map-var map) +(var not-var not) +(assert (= 1 (try (afn-var) ([err] 1))) "bad arity 1") (assert (= 4 (try ((fn [x y] (+ x y)) 1) ([_] 4))) "bad arity 2") -(assert (= 1 (try (identity) ([err] 1))) "bad arity 3") -(assert (= 1 (try (map) ([err] 1))) "bad arity 4") -(assert (= 1 (try (not) ([err] 1))) "bad arity 5") +(assert (= 1 (try (identity-var) ([err] 1))) "bad arity 3") +(assert (= 1 (try (map-var) ([err] 1))) "bad arity 4") +(assert (= 1 (try (not-var) ([err] 1))) "bad arity 5") # Assembly test # Fibonacci sequence, implemented with naive recursion. @@ -113,9 +117,9 @@ (assert (= 1 ({:ok 1} :ok)) "calling struct") (assert (= 2 (@{:ok 2} :ok)) "calling table") -(assert (= :bad (try (@{:ok 2} :ok :no) ([err] :bad))) "calling table too many arguments") -(assert (= :bad (try (:ok @{:ok 2} :no) ([err] :bad))) "calling keyword too many arguments") -(assert (= :oops (try (1 1) ([err] :oops))) "calling number fails") +(assert (= :bad (try ((identity @{:ok 2}) :ok :no) ([err] :bad))) "calling table too many arguments") +(assert (= :bad (try ((identity :ok) @{:ok 2} :no) ([err] :bad))) "calling keyword too many arguments") +(assert (= :oops (try ((+ 2 -1) 1) ([err] :oops))) "calling number fails") # Method test