From 83474396442b97d09d74da5414fe87d91eb8bada Mon Sep 17 00:00:00 2001 From: Michael Camilleri Date: Sat, 18 Dec 2021 13:05:16 +0900 Subject: [PATCH] Support redefinable bindings --- src/core/compile.c | 8 +++++++- src/core/specials.c | 23 ++++++++++++++++++----- src/core/util.c | 30 +++++++++++++++++++----------- src/include/janet.h | 4 +++- test/suite0000.janet | 13 +++++++++++++ 5 files changed, 60 insertions(+), 18 deletions(-) diff --git a/src/core/compile.c b/src/core/compile.c index a7020993..946e7887 100644 --- a/src/core/compile.c +++ b/src/core/compile.c @@ -239,6 +239,12 @@ JanetSlot janetc_resolve( case JANET_BINDING_MACRO: /* Macro should function like defs when not in calling pos */ ret = janetc_cslot(binding.value); break; + case JANET_BINDING_DEF_REF: + case JANET_BINDING_MACRO_REF: + 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); ret.flags |= JANET_SLOT_REF | JANET_SLOT_NAMED | JANET_SLOT_MUTABLE | JANET_SLOTTYPE_ANY; @@ -651,7 +657,7 @@ static int macroexpand1( } Janet macroval; JanetBindingType btype = janet_resolve(c->env, name, ¯oval); - if (btype != JANET_BINDING_MACRO || + if (!(btype == JANET_BINDING_MACRO || btype == JANET_BINDING_MACRO_REF) || !janet_checktype(macroval, JANET_FUNCTION)) return 0; diff --git a/src/core/specials.c b/src/core/specials.c index 2734a827..ae4c7b4e 100644 --- a/src/core/specials.c +++ b/src/core/specials.c @@ -331,14 +331,27 @@ static int defleaf( JanetTable *entry = janet_table_clone(tab); janet_table_put(entry, janet_ckeywordv("source-map"), janet_wrap_tuple(janetc_make_sourcemap(c))); - JanetSlot valsym = janetc_cslot(janet_ckeywordv("value")); - JanetSlot tabslot = janetc_cslot(janet_wrap_table(entry)); + + if (!janet_checktype(janet_table_get(entry, janet_ckeywordv("redef")), JANET_NIL)) { + JanetBinding binding = janet_resolve_ext(c->env, sym); + JanetArray *ref; + if (janet_checktype(binding.value, JANET_ARRAY)) { + ref = janet_unwrap_array(binding.value); + } else { + ref = janet_array(1); + janet_array_push(ref, janet_wrap_nil()); + } + 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 { + JanetSlot valsym = janetc_cslot(janet_ckeywordv("value")); + JanetSlot tabslot = janetc_cslot(janet_wrap_table(entry)); + janetc_emit_sss(c, JOP_PUT, tabslot, valsym, s, 0); + } /* Add env entry to env */ janet_table_put(c->env, janet_wrap_symbol(sym), janet_wrap_table(entry)); - - /* Put value in table when evaulated */ - janetc_emit_sss(c, JOP_PUT, tabslot, valsym, s, 0); } return namelocal(c, sym, 0, s); } diff --git a/src/core/util.c b/src/core/util.c index e472c684..3fd67008 100644 --- a/src/core/util.c +++ b/src/core/util.c @@ -627,23 +627,31 @@ JanetBinding janet_resolve_ext(JanetTable *env, const uint8_t *sym) { binding.deprecation = JANET_BINDING_DEP_NORMAL; } - if (!janet_checktype( - janet_table_get(entry_table, janet_ckeywordv("macro")), - JANET_NIL)) { + ref = janet_table_get(entry_table, janet_ckeywordv("ref")); + int is_value = !janet_checktype(ref, JANET_ARRAY); + int is_macro = !janet_checktype(janet_table_get(entry_table, janet_ckeywordv("macro")), JANET_NIL); + int is_redef = !janet_checktype(janet_table_get(entry_table, janet_ckeywordv("redef")), JANET_NIL); + + if (is_redef && is_value) { + /* invalid, return empty binding */ + return binding; + } else if (is_macro && is_redef) { + binding.value = ref; + binding.type = JANET_BINDING_MACRO_REF; + } else if (is_macro) { binding.value = janet_table_get(entry_table, janet_ckeywordv("value")); binding.type = JANET_BINDING_MACRO; - return binding; - } - - ref = janet_table_get(entry_table, janet_ckeywordv("ref")); - if (janet_checktype(ref, JANET_ARRAY)) { + } else if (is_redef) { + binding.value = ref; + binding.type = JANET_BINDING_DEF_REF; + } else if (is_value) { + binding.value = janet_table_get(entry_table, janet_ckeywordv("value")); + binding.type = JANET_BINDING_DEF; + } else { 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; return binding; } diff --git a/src/include/janet.h b/src/include/janet.h index d128a7c1..907563fa 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_DEF_REF, + JANET_BINDING_MACRO_REF } JanetBindingType; typedef struct { diff --git a/test/suite0000.janet b/test/suite0000.janet index 39d63b6e..8ef17318 100644 --- a/test/suite0000.janet +++ b/test/suite0000.janet @@ -295,6 +295,19 @@ (++ i)) (assert (= i 6) "when macro")) +# Redefs + +(def noredef 0) +(defn noredef-inc [] (+ 1 noredef)) +(assert (= 1 (noredef-inc)) "result before redef without :redef") +(def noredef 1) +(assert (= 1 (noredef-inc)) "result after redef without :redef") +(def redef :redef 0) +(defn redef-inc [] (+ 1 redef)) +(assert (= 1 (redef-inc)) "result before redef with :redef") +(def redef :redef 1) +(assert (= 2 (redef-inc)) "result before redef with :redef") + # Denormal tables and structs (assert (= (length {1 2 nil 3}) 1) "nil key struct literal")