mirrors
/
janet
mirror of https://github.com/janet-lang/janet
1
0
Fork 0
Code Issues 1 Releases Wiki Activity

Tweaks on redef feature branch.

This commit is contained in:
Calvin Rose 2022-01-06 19:44:03 -06:00
parent ea9d5ec793
commit 99cfbaa63b
7 changed files with 50 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
src/boot/boot.janet
View File

@ -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))

10
src/core/compile.c
View File

@ -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);

12
src/core/specials.c
View File

@ -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 {

32
src/core/util.c
View File

@ -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;
}

7
src/include/janet.h
View File

@ -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);

2
test/helper.janet
View File

@ -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

4
test/suite0000.janet
View File

@ -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