From 99cfbaa63b480d7ae4f457c70bdc309ee73f08f2 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Thu, 6 Jan 2022 19:44:03 -0600 Subject: [PATCH] Tweaks on redef feature branch. --- src/boot/boot.janet | 31 ++++++++++++++++++------------- src/core/compile.c | 10 ++++++---- src/core/specials.c | 12 +++++++----- src/core/util.c | 32 +++++++++++++------------------- src/include/janet.h | 7 +++---- test/helper.janet | 2 +- test/suite0000.janet | 4 ++-- 7 files changed, 50 insertions(+), 48 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 2984dcc1..901b9bd8 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -1952,8 +1952,8 @@ (def h (in t 0)) (def s (in specs h)) (def entry (or (dyn h) {})) - (def m (if (entry :redef) (in (entry :value) 0) (entry :value))) - (def m? (entry :macro)) + (def m (do (def r (get entry :ref)) (if r (in r 0) (get entry :value)))) + (def m? (in entry :macro)) (cond s (s t) m? (do (setdyn :macro-form t) (m ;(tuple/slice t 1))) @@ -2186,19 +2186,20 @@ the file, prints nothing." [where line col] (if-not line (break)) + (unless (string? where) (break)) (when-with [f (file/open where :r)] (def source-code (file/read f :all)) (var index 0) (repeat (dec line) (if-not index (break)) - (set index (inc (string/find "\n" source-code index)))) + (set index (string/find "\n" source-code index)) + (if index (++ index))) (when index (def line-end (string/find "\n" source-code index)) (eprint " " (string/slice source-code index line-end)) (when col (+= index col) - (eprint (string/repeat " " (inc col)) "^")) - (eflush)))) + (eprint (string/repeat " " (inc col)) "^"))))) (defn warn-compile "Default handler for a compile warning" @@ -3077,10 +3078,10 @@ (def bind-type (string " " (cond + (x :redef) (type (in (x :ref) 0)) (x :ref) (string :var " (" (type (in (x :ref) 0)) ")") (x :macro) :macro (x :module) (string :module " (" (x :kind) ")") - (x :redef) (type (in (x :value) 0)) (type (x :value))) "\n")) (def sm (x :source-map)) @@ -3144,7 +3145,7 @@ (loop [module-set :in [[root-env] module/cache] module :in module-set value :in module] - (let [check (or (value :ref) (if (value :redef) (in (value :value) 0) (value :value)))] + (let [check (or (get value :ref) (get value :value))] (when (= check x) (print-module-entry value) (set found true) @@ -3538,7 +3539,7 @@ (defn- run-main [env subargs arg] (if-let [entry (in env 'main) - main (if (entry :redef) (in (entry :value) 0) (entry :value))] + main (or (get entry :value) (in (get entry :ref) 0))] (let [thunk (compile [main ;subargs] env arg)] (if (function? thunk) (thunk) (error (thunk :error)))))) @@ -3583,7 +3584,6 @@ -e code : Execute a string of janet -E code arguments... : Evaluate an expression as a short-fn with arguments -d : Set the debug flag in the REPL - -D : Use redefinable def bindings -r : Enter the REPL after running all scripts -R : Disables loading profile.janet when JANET_PROFILE is present -p : Keep on executing if there is a top-level error (persistent) @@ -3634,7 +3634,6 @@ (error (get thunk :error))) math/inf) "d" (fn [&] (set debug-flag true) 1) - "D" (fn [&] (setdyn :redefs true) 1) "w" (fn [i &] (set warn-level (get-lint-level i)) 2) "x" (fn [i &] (set error-level (get-lint-level i)) 2) "R" (fn [&] (setdyn :profilepath nil) 1)}) @@ -3659,14 +3658,18 @@ (put env :args subargs) (put env :lint-error error-level) (put env :lint-warn warn-level) - (if debug-flag (put env :debug true)) + (when debug-flag + (put env :debug true) + (put env :redef true)) (run-main env subargs arg)) (do (def env (make-env)) (put env :args subargs) (put env :lint-error error-level) (put env :lint-warn warn-level) - (if debug-flag (put env :debug true)) + (when debug-flag + (put env :debug true) + (put env :redef true)) (if compile-only (flycheck arg :exit exit-on-error :env env) (do @@ -3692,7 +3695,9 @@ (when-let [profile.janet (dyn :profilepath)] (def new-env (dofile profile.janet :exit true)) (merge-module env new-env "" false)) - (if debug-flag (put env :debug true)) + (when debug-flag + (put env :debug true) + (put env :redef true)) (def getter (if raw-stdin getstdin getline)) (defn getchunk [buf p] (getter (getprompt p) buf env)) diff --git a/src/core/compile.c b/src/core/compile.c index 34317913..62a47d80 100644 --- a/src/core/compile.c +++ b/src/core/compile.c @@ -238,10 +238,12 @@ JanetSlot janetc_resolve( case JANET_BINDING_DEF: case JANET_BINDING_MACRO: /* Macro should function like defs when not in calling pos */ ret = janetc_cslot(binding.value); - if (binding.dynamic) { - ret.flags |= JANET_SLOT_REF | JANET_SLOT_NAMED | JANET_SLOTTYPE_ANY; - ret.flags &= ~JANET_SLOT_CONSTANT; - } + break; + case JANET_BINDING_DYNAMIC_DEF: + case JANET_BINDING_DYNAMIC_MACRO: + ret = janetc_cslot(binding.value); + ret.flags |= JANET_SLOT_REF | JANET_SLOT_NAMED | JANET_SLOTTYPE_ANY; + ret.flags &= ~JANET_SLOT_CONSTANT; break; case JANET_BINDING_VAR: { ret = janetc_cslot(binding.value); diff --git a/src/core/specials.c b/src/core/specials.c index 00872af9..ede62824 100644 --- a/src/core/specials.c +++ b/src/core/specials.c @@ -333,24 +333,26 @@ static int defleaf( janet_wrap_tuple(janetc_make_sourcemap(c))); int is_redef = 0; - Janet meta_redef = janet_table_get(entry, janet_ckeywordv("redef")); + Janet redef_kw = janet_ckeywordv("redef"); + Janet meta_redef = janet_table_get(entry, redef_kw); if (janet_truthy(meta_redef)) { is_redef = 1; - } else if (janet_checktype(meta_redef, JANET_NIL) && janet_truthy(janet_dyn("redefs"))) { - janet_table_put(entry, janet_ckeywordv("redef"), janet_wrap_true()); + } else if (janet_checktype(meta_redef, JANET_NIL) && + janet_truthy(janet_table_get(c->env, redef_kw))) { + janet_table_put(entry, redef_kw, janet_wrap_true()); is_redef = 1; } if (is_redef) { JanetBinding binding = janet_resolve_ext(c->env, sym); JanetArray *ref; - if (janet_checktype(binding.value, JANET_ARRAY)) { + if (binding.type == JANET_BINDING_DYNAMIC_DEF || binding.type == JANET_BINDING_DYNAMIC_MACRO) { ref = janet_unwrap_array(binding.value); } else { ref = janet_array(1); janet_array_push(ref, janet_wrap_nil()); } - janet_table_put(entry, janet_ckeywordv("value"), janet_wrap_array(ref)); + janet_table_put(entry, janet_ckeywordv("ref"), janet_wrap_array(ref)); JanetSlot refslot = janetc_cslot(janet_wrap_array(ref)); janetc_emit_ssu(c, JOP_PUT_INDEX, refslot, s, 0, 0); } else { diff --git a/src/core/util.c b/src/core/util.c index 03354d2f..706e3646 100644 --- a/src/core/util.c +++ b/src/core/util.c @@ -598,14 +598,12 @@ void janet_core_cfuns_ext(JanetTable *env, const char *regprefix, const JanetReg #endif JanetBinding janet_resolve_ext(JanetTable *env, const uint8_t *sym) { - Janet ref; JanetTable *entry_table; Janet entry = janet_table_get(env, janet_wrap_symbol(sym)); JanetBinding binding = { JANET_BINDING_NONE, janet_wrap_nil(), - JANET_BINDING_DEP_NONE, - JANET_BINDING_STATIC + JANET_BINDING_DEP_NONE }; /* Check environment for entry */ @@ -628,36 +626,32 @@ JanetBinding janet_resolve_ext(JanetTable *env, const uint8_t *sym) { binding.deprecation = JANET_BINDING_DEP_NORMAL; } - binding.dynamic = janet_truthy(janet_table_get(entry_table, janet_ckeywordv("redef"))); + int redef = janet_truthy(janet_table_get(entry_table, janet_ckeywordv("redef"))); + int macro = janet_truthy(janet_table_get(entry_table, janet_ckeywordv("macro"))); + Janet value = janet_table_get(entry_table, janet_ckeywordv("value")); + Janet ref = janet_table_get(entry_table, janet_ckeywordv("ref")); - if (!janet_checktype( - janet_table_get(entry_table, janet_ckeywordv("macro")), - JANET_NIL)) { - binding.value = janet_table_get(entry_table, janet_ckeywordv("value")); - binding.type = JANET_BINDING_MACRO; + if (macro) { + binding.value = redef ? ref : value; + binding.type = redef ? JANET_BINDING_DYNAMIC_MACRO : JANET_BINDING_MACRO; return binding; } - ref = janet_table_get(entry_table, janet_ckeywordv("ref")); - if (janet_checktype(ref, JANET_ARRAY)) { + if (!redef && janet_checktype(ref, JANET_ARRAY)) { binding.value = ref; binding.type = JANET_BINDING_VAR; return binding; } - binding.value = janet_table_get(entry_table, janet_ckeywordv("value")); - binding.type = JANET_BINDING_DEF; + binding.value = redef ? ref : value; + binding.type = redef ? JANET_BINDING_DYNAMIC_DEF : JANET_BINDING_DEF; return binding; } JanetBindingType janet_resolve(JanetTable *env, const uint8_t *sym, Janet *out) { JanetBinding binding = janet_resolve_ext(env, sym); - if (binding.dynamic) { - if (janet_checktype(binding.value, JANET_ARRAY)) { - *out = janet_array_peek(janet_unwrap_array(binding.value)); - } else { - *out = janet_wrap_nil(); - } + if (binding.type == JANET_BINDING_DYNAMIC_DEF || binding.type == JANET_BINDING_DYNAMIC_MACRO) { + *out = janet_array_peek(janet_unwrap_array(binding.value)); } else { *out = binding.value; } diff --git a/src/include/janet.h b/src/include/janet.h index 8379defd..4f7763f9 100644 --- a/src/include/janet.h +++ b/src/include/janet.h @@ -1779,7 +1779,9 @@ typedef enum { JANET_BINDING_NONE, JANET_BINDING_DEF, JANET_BINDING_VAR, - JANET_BINDING_MACRO + JANET_BINDING_MACRO, + JANET_BINDING_DYNAMIC_DEF, + JANET_BINDING_DYNAMIC_MACRO } JanetBindingType; typedef struct { @@ -1791,9 +1793,6 @@ typedef struct { JANET_BINDING_DEP_NORMAL, JANET_BINDING_DEP_STRICT, } deprecation; - enum { - JANET_BINDING_STATIC, - JANET_BINDING_DYNAMIC } dynamic; } JanetBinding; JANET_API void janet_def(JanetTable *env, const char *name, Janet val, const char *documentation); diff --git a/test/helper.janet b/test/helper.janet index 03167715..d76f6368 100644 --- a/test/helper.janet +++ b/test/helper.janet @@ -16,7 +16,7 @@ (def str (string e)) (if x (when is-verbose (eprintf "\e[32m✔\e[0m %s: %v" (describe e) x)) - (eprintf "\n\e[31m✘\e[0m %s: %v" (describe e) x)) + (eprintf "\e[31m✘\e[0m %s: %v" (describe e) x)) x) (defmacro assert-error diff --git a/test/suite0000.janet b/test/suite0000.janet index e068c0f4..d3a46400 100644 --- a/test/suite0000.janet +++ b/test/suite0000.janet @@ -307,7 +307,7 @@ (assert (= 1 (dynamicdef1-inc)) "before redefinition with :redef") (def dynamicdef1 :redef 1) (assert (= 2 (dynamicdef1-inc)) "after redefinition with :redef") -(setdyn :redefs true) +(setdyn :redef true) (def staticdef2 {:redef false} 0) (defn staticdef2-inc [] (+ 1 staticdef2)) (assert (= 1 (staticdef2-inc)) "before redefinition with :redef false") @@ -318,7 +318,7 @@ (assert (= 1 (dynamicdef2-inc)) "before redefinition with dyn :redefs") (def dynamicdef2 1) (assert (= 2 (dynamicdef2-inc)) "after redefinition with dyn :redefs") -(setdyn :redefs nil) +(setdyn :redef nil) # Denormal tables and structs