comp_dict

diff --git a/core.fth b/core.fth
index c3746c3a80e5799ab97647c9689e7743ba452b61..00f2c872bde119af218d4cc58548f11c5aaa4da1 100644 (file)
--- a/core.fth
+++ b/core.fth
@@ -1,8 +1,4 @@
-: chars     ;
-
 : state     [ _d 7 cells + ] literal ;
-\ : [         0 state ! ; immediate
-\ : ]         -1 state ! ;
 
 : sp        [ _d cell+ ] literal ;
 : rp        [ _d 2 cells + ] literal ;
@@ -16,8 +12,6 @@
 : base      [ _d 9 cells + ] literal ;
 : latest    _d @ ;
 
-\ : dup       sp@ @ ;
-\ : drop      sp@ cell+ sp ! ;
 : pick      cells cell+ sp@ + @ ;
 : >r        rp@ cell - rp !
             rp@ cell+ @ rp@ !
@@ -25,11 +19,8 @@
 : r>        rp@ @
             rp@ cell+ rp !
             rp@ @ swap rp@ ! ;
-\ : rot       >r swap r> swap ;
-: -rot      rot rot ;
 : over      1 pick ;
 
-: 2drop     drop drop ;
 : 2dup      over over ;
 : 2over     3 pick 3 pick ;
 : 2swap     rot >r rot r> ;
@@ -51,18 +42,8 @@
 : 2!        swap over ! cell+ ! ;
 : 2@        dup cell+ @ swap @ ;
 
-: 0=        0 = ;
-: 0<        0 < ;
 : <=        2dup < >r = r> or ;
-: >         swap < ;
-: <>        = 0= ;
-
-: 1+        1 + ;
-: 1-        1 - ;
 
-: invert    -1 xor ;
-: negate    -1 * ;
-: 2*        2 * ;
 : _msb      [ 1 cell 8 * 1- lshift ] literal ;
 : 2/        dup 1 rshift swap 0< if _msb or then ;
 
@@ -75,7 +56,6 @@
 : align     here dup aligned swap - allot ;
 
 : cr        10 emit ;
-: bl        32 ;
 : space     bl emit ;
 \ : spaces    begin dup 0 > while space 1- repeat drop ;
 

diff --git a/forth.hpp b/forth.hpp
index 8f71946c132eaedae39b426afd8ea0458ac8fbf1..770eeb921fd9c431698a8e6851de3e0e674bfb25 100644 (file)
--- a/forth.hpp
+++ b/forth.hpp
@@ -80,10 +80,10 @@ struct word_base : public word_list
 };
 
 template<unsigned N>
-struct ctstring {
+struct cS {
     char data[N];
 
-    consteval ctstring(const char (&s)[N]) {
+    consteval cS(const char (&s)[N]) {
         std::copy(s, s + N, data);
     }
     consteval operator const char *() const {
@@ -94,17 +94,39 @@ struct ctstring {
     }
 };
 
-template<ctstring Name, ctstring Body, auto *Prev = (const word_base *)nullptr>
-struct comp_word : public word_base
+template<cS Name, func Body, auto *Prev = (const word_base *)nullptr>
+struct native_word : public word_base
 {
     constexpr static auto N = (sizeof(Name) + sizeof(cell) - 1) & ~(sizeof(cell) - 1);
+    std::array<char, N> namebuf;
+    func body;
+
+    consteval const func *get_ct(std::string_view name) const {
+        if (name == std::string_view{Name.data})
+            return &body;
+        else if constexpr (Prev != nullptr)
+            return Prev->get_ct(name);
+        else
+            return nullptr;
+    }
+
+    consteval native_word(addr flags = 0):
+        word_base{Prev, N | flags}, namebuf{}, body{Body}
+    {
+        std::copy(Name.data, Name.data + sizeof(Name), namebuf.data());
+    }
+};
+
+template<const func Prol, cS Name, cS Body, auto *Prev = (const word_base *)nullptr>
+struct comp_word : public native_word<Name, Prol, Prev>
+{
     static constexpr std::size_t B = 
         [] {
             std::size_t b = 1;
             std::string_view sv {Body.data};
             auto sourcei = sv.find_first_not_of(" \t\r\n");
             while (sourcei != std::string_view::npos) {
-                const auto word = parse(Body.data, sourcei);
+                const auto word = word_list::parse(Body.data, sourcei);
 
                 b++;
                 if (!Prev->get_ct(word))
@@ -118,39 +140,26 @@ struct comp_word : public word_base
         cell c;
     };
 
-    std::array<char, N> namebuf;
-    const func prologue;
-    std::array<bodyt, B> bodybuf;
-
-    consteval const func *get_ct(std::string_view name) const {
-        if (name == std::string_view{Name.data})
-            return &prologue;
-        else if (Prev)
-            return Prev->get_ct(name);
-        else
-            return nullptr;
-    }
+    std::array<bodyt, B> bodybuf {};
 
-    consteval comp_word(const func prol, addr flags = 0):
-        word_base{Prev, N | flags}, namebuf{}, prologue{prol}, bodybuf{}
+    consteval comp_word(addr flags = 0):
+        native_word<Name, Prol, Prev>{flags}
     {
-        std::copy(Name.data, Name.data + sizeof(Name), namebuf.data());
-
         auto bptr = bodybuf.begin();
         std::string_view sv {Body};
         auto sourcei = sv.find_first_not_of(" \t\r\n");
         while (sourcei != std::string_view::npos) {
-            const auto word = parse(Body, sourcei);
+            const auto word = word_list::parse(Body, sourcei);
 
-            auto w = get_ct(word);
+            auto w = Prev->get_ct(word);
             if (w) {
-                bptr->f = get_ct(word);
+                bptr->f = Prev->get_ct(word);
                 bptr++;
             } else {
                 cell n;
                 std::from_chars(word.cbegin(), word.cend(), n, 10);
 
-                bptr->f = get_ct("_lit");
+                bptr->f = Prev->get_ct("_lit");
                 bptr++;
                 bptr->c = n;
                 bptr++;
@@ -159,30 +168,7 @@ struct comp_word : public word_base
     }
 };
 
-template<ctstring Name, func Body, auto *Prev = (const word_base *)nullptr>
-struct native_word : public word_base
-{
-    constexpr static auto N = (sizeof(Name) + sizeof(cell) - 1) & ~(sizeof(cell) - 1);
-    std::array<char, N> namebuf;
-    func body;
-
-    consteval const func *get_ct(std::string_view name) const {
-        if (name == std::string_view{Name.data})
-            return &body;
-        else if constexpr (Prev != nullptr)
-            return Prev->get_ct(name);
-        else
-            return nullptr;
-    }
-
-    consteval native_word(addr flags = 0):
-        word_base{Prev, N | flags}, namebuf{}, body{Body}
-    {
-        std::copy(Name.data, Name.data + sizeof(Name), namebuf.data());
-    }
-};
-
-template<ctstring Name, func Body, addr Flags, auto... Next>
+template<cS Name, func Body, addr Flags, auto... Next>
 struct native_dict
 {
     constexpr static native_word<Name, Body,
@@ -194,15 +180,15 @@ struct native_dict
         }()> word {Flags};
 };
 
-template<ctstring Name, ctstring Body, addr Flags, auto... Next>
+template<func Prol, auto *Prev, cS Name, cS Body, addr Flags, auto... Next>
 struct comp_dict
 {
-    constexpr static comp_word<Name, Body,
+    constexpr static comp_word<Prol, Name, Body,
         [] {
             if constexpr (sizeof...(Next))
-                return &native_dict<Next...>::word;
+                return &comp_dict<Prol, Prev, Next...>::word;
             else
-                return (const word_base *)nullptr;
+                return Prev;
         }()> word {Flags};
 };
 
@@ -424,54 +410,62 @@ struct forth : public word_list
             *fth.here++ = std::bit_cast<cell>((*g)->body());
         };
 
-        constexpr static auto& asdf = native_dict<
-            ctstring{"_d"}, f_dict, 0,
-            ctstring{"_lit"}, lit_impl, 0,
-            ctstring{"swap"}, f_swap, 0,
-            ctstring{"drop"}, f_drop, 0,
-            ctstring{"dup"}, f_dup, 0,
-            ctstring{"rot"}, f_rot, 0,
-            ctstring{"+"}, f_add, 0,
-            ctstring{"-"}, f_minus, 0,
-            ctstring{"*"}, f_times, 0,
-            ctstring{"/"}, f_divide, 0,
-            ctstring{"mod"}, f_mod, 0,
-            ctstring{"and"}, f_bitand, 0,
-            ctstring{"or"}, f_bitor, 0,
-            ctstring{"xor"}, f_bitxor, 0,
-            ctstring{"lshift"}, f_lshift, 0,
-            ctstring{"rshift"}, f_rshift, 0,
-            ctstring{"["}, f_lbrac, word_base::immediate,
-            ctstring{"]"}, f_rbrac, 0,
-            ctstring{"immediate"}, f_imm, 0,
-            ctstring{"literal"}, f_lit, word_base::immediate,
-            ctstring{"@"}, f_peek, 0,
-            ctstring{"!"}, f_poke, 0,
-            ctstring{"c@"}, f_cpeek, 0,
-            ctstring{"c!"}, f_cpoke, 0,
-            ctstring{"="}, f_eq, 0,
-            ctstring{"<"}, f_lt, 0,
-            ctstring{"\'"}, f_tick, 0,
-            ctstring{":"}, f_colon, 0,
-            ctstring{";"}, f_semic, word_base::immediate,
-            ctstring{"\\"}, f_comm, word_base::immediate,
-            ctstring{"cell"}, f_cell, 0,
-            ctstring{"_jmp"}, f_jmp, 0,
-            ctstring{"_jmp0"}, f_jmp0, 0,
-            ctstring{"postpone"}, f_postpone, word_base::immediate
+        constexpr static auto& dict1 = native_dict<
+            cS{"_d"}, f_dict, 0,
+            cS{"_lit"}, lit_impl, 0,
+            cS{"swap"}, f_swap, 0,
+            cS{"drop"}, f_drop, 0,
+            cS{"dup"}, f_dup, 0,
+            cS{"rot"}, f_rot, 0,
+            cS{"+"}, f_add, 0,
+            cS{"-"}, f_minus, 0,
+            cS{"*"}, f_times, 0,
+            cS{"/"}, f_divide, 0,
+            cS{"mod"}, f_mod, 0,
+            cS{"and"}, f_bitand, 0,
+            cS{"or"}, f_bitor, 0,
+            cS{"xor"}, f_bitxor, 0,
+            cS{"lshift"}, f_lshift, 0,
+            cS{"rshift"}, f_rshift, 0,
+            cS{"["}, f_lbrac, word_base::immediate,
+            cS{"]"}, f_rbrac, 0,
+            cS{"immediate"}, f_imm, 0,
+            cS{"literal"}, f_lit, word_base::immediate,
+            cS{"@"}, f_peek, 0,
+            cS{"!"}, f_poke, 0,
+            cS{"c@"}, f_cpeek, 0,
+            cS{"c!"}, f_cpoke, 0,
+            cS{"="}, f_eq, 0,
+            cS{"<"}, f_lt, 0,
+            cS{"\'"}, f_tick, 0,
+            cS{":"}, f_colon, 0,
+            cS{";"}, f_semic, word_base::immediate,
+            cS{"\\"}, f_comm, word_base::immediate,
+            cS{"cell"}, f_cell, 0,
+            cS{"_jmp"}, f_jmp, 0,
+            cS{"_jmp0"}, f_jmp0, 0,
+            cS{"chars"}, [](auto) {}, 0,
+            cS{"postpone"}, f_postpone, word_base::immediate
+        >::word;
+        constexpr static auto& dict2 = comp_dict<forth::prologue<fthp>, &dict1
+            , cS{"1-"    }, cS{"1 -" }, 0
+            , cS{"1+"    }, cS{"1 +" }, 0
+            , cS{"cell+" }, cS{"cell +"}, 0
+            , cS{"cells" }, cS{"cell *"}, 0
+            , cS{"char+" }, cS{"1 +" }, 0
+            , cS{"-rot"  }, cS{"rot rot"}, 0
+            , cS{"2drop" }, cS{"drop drop"}, 0
+            , cS{"0="    }, cS{"0 ="}, 0
+            , cS{"0<"    }, cS{"0 <"}, 0
+            , cS{"<>"    }, cS{"= 0="}, 0
+            , cS{">"     }, cS{"swap <"}, 0
+            , cS{"invert"}, cS{"-1 xor"}, 0
+            , cS{"negate"}, cS{"-1 *"}, 0
+            , cS{"2*"    }, cS{"2 *"}, 0
+            , cS{"bl"    }, cS{"32"}, 0
         >::word;
-        constexpr static comp_word<"cell+", "cell +", &asdf> w_cellp
-            {forth::prologue<fthp>};
-        constexpr static comp_word<"cells", "cell *", &w_cellp> w_cells
-            {forth::prologue<fthp>};
-        constexpr static comp_word<"char+", "1 +", &w_cells> w_charp
-            {forth::prologue<fthp>};
-        constexpr static comp_word<"1+", "1 +", &w_charp> w_inc
-            {forth::prologue<fthp>};
-        constexpr static comp_word<"1-", "1 -", &w_inc> w_dec
-            {forth::prologue<fthp>};
-
-        fth.next = &w_dec;
+
+        fth.next = &dict2;
         fth.end = end_value;
     }