comp_dict

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 ;
 

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,20 +94,42 @@ struct ctstring {
     }
 };
 
-template<ctstring Name, ctstring Body, auto& Prev>
+template<cS Name, func Body, auto *Prev = (const word_base *)nullptr>
-struct comp_word : public word_base
+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))
+                if (!Prev->get_ct(word))
                     b++;
             }
             return b;
@@ -118,37 +140,26 @@ struct comp_word : public word_base
         cell c;
     };
 
-    std::array<char, N> namebuf;
+    std::array<bodyt, B> bodybuf {};
-    const func prologue;
-    std::array<bodyt, B> bodybuf;
 
-    consteval const func *get_ct(std::string_view name) const {
+    consteval comp_word(addr flags = 0):
-        if (name == std::string_view{Name.data})
+        native_word<Name, Prol, Prev>{flags}
-            return &prologue;
-        else
-            return Prev.get_ct(name);
-    }
-
-    consteval comp_word(const func prol, addr flags = 0):
-        word_base{&Prev, N | flags}, namebuf{}, prologue{prol}, bodybuf{}
     {
-        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++;
@@ -157,27 +168,28 @@ struct comp_word : public word_base
     }
 };
 
-template<ctstring Name, auto *Prev = (const word_base *)nullptr>
+template<cS Name, func Body, addr Flags, auto... Next>
-struct native_word : public word_base
+struct native_dict
 {
-    constexpr static auto N = (sizeof(Name) + sizeof(cell) - 1) & ~(sizeof(cell) - 1);
+    constexpr static native_word<Name, Body,
-    std::array<char, N> namebuf;
+        [] {
-    func body;
+            if constexpr (sizeof...(Next))
-
+                return &native_dict<Next...>::word;
-    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;
+                return (const word_base *)nullptr;
-    }
+        }()> word {Flags};
+};
 
-    consteval native_word(func bod, addr flags = 0):
+template<func Prol, auto *Prev, cS Name, cS Body, addr Flags, auto... Next>
-        word_base{Prev, N | flags}, namebuf{}, body{bod}
+struct comp_dict
 {
-        std::copy(Name.data, Name.data + sizeof(Name), namebuf.data());
+    constexpr static comp_word<Prol, Name, Body,
-    }
+        [] {
+            if constexpr (sizeof...(Next))
+                return &comp_dict<Prol, Prev, Next...>::word;
+            else
+                return Prev;
+        }()> word {Flags};
 };
 
 struct forth : public word_list
@@ -398,57 +410,62 @@ struct forth : public word_list
             *fth.here++ = std::bit_cast<cell>((*g)->body());
         };
 
-        constexpr static native_word<"_d">             w_dict  {f_dict};
+        constexpr static auto& dict1 = native_dict<
-        constexpr static native_word<"_lit", &w_dict>  w_liti  {lit_impl};
+            cS{"_d"}, f_dict, 0,
-        constexpr static native_word<"swap", &w_liti>  w_swap  {f_swap};
+            cS{"_lit"}, lit_impl, 0,
-        constexpr static native_word<"drop", &w_swap>  w_drop  {f_drop};
+            cS{"swap"}, f_swap, 0,
-        constexpr static native_word<"dup",  &w_drop>  w_dup   {f_dup};
+            cS{"drop"}, f_drop, 0,
-        constexpr static native_word<"rot",  &w_dup>   w_rot   {f_rot};
+            cS{"dup"}, f_dup, 0,
-        constexpr static native_word<"+",    &w_rot>   w_add   {f_add};
+            cS{"rot"}, f_rot, 0,
-        constexpr static native_word<"-",    &w_add>   w_minus {f_minus};
+            cS{"+"}, f_add, 0,
-        constexpr static native_word<"*",    &w_minus> w_times {f_times};
+            cS{"-"}, f_minus, 0,
-        constexpr static native_word<"/",    &w_times> w_divid {f_divide};
+            cS{"*"}, f_times, 0,
-        constexpr static native_word<"mod",  &w_divid> w_mod   {f_mod};
+            cS{"/"}, f_divide, 0,
-        constexpr static native_word<"and",  &w_mod>   w_and   {f_bitand};
+            cS{"mod"}, f_mod, 0,
-        constexpr static native_word<"or",   &w_and>   w_or    {f_bitor};
+            cS{"and"}, f_bitand, 0,
-        constexpr static native_word<"xor",  &w_or>    w_xor   {f_bitxor}; 
+            cS{"or"}, f_bitor, 0,
-        constexpr static native_word<"lshift", &w_xor> w_lsh   {f_lshift};
+            cS{"xor"}, f_bitxor, 0,
-        constexpr static native_word<"rshift", &w_lsh> w_rsh   {f_rshift};
+            cS{"lshift"}, f_lshift, 0,
-        constexpr static native_word<"[",    &w_rsh>   w_lbrac {f_lbrac,
+            cS{"rshift"}, f_rshift, 0,
-            word_base::immediate};
+            cS{"["}, f_lbrac, word_base::immediate,
-        constexpr static native_word<"]",    &w_lbrac> w_rbrac {f_rbrac};
+            cS{"]"}, f_rbrac, 0,
-        constexpr static native_word<"immediate", &w_rbrac> w_imm {f_imm};
+            cS{"immediate"}, f_imm, 0,
-        constexpr static native_word<"literal", &w_imm> w_lit  {f_lit,
+            cS{"literal"}, f_lit, word_base::immediate,
-            word_base::immediate};
+            cS{"@"}, f_peek, 0,
-        constexpr static native_word<"@",    &w_lit>   w_peek  {f_peek};
+            cS{"!"}, f_poke, 0,
-        constexpr static native_word<"!",    &w_peek>  w_poke  {f_poke};
+            cS{"c@"}, f_cpeek, 0,
-        constexpr static native_word<"c@",   &w_poke>  w_cpeek {f_cpeek};
+            cS{"c!"}, f_cpoke, 0,
-        constexpr static native_word<"c!",   &w_cpeek> w_cpoke {f_cpoke};
+            cS{"="}, f_eq, 0,
-        constexpr static native_word<"=",    &w_cpoke> w_eq    {f_eq};
+            cS{"<"}, f_lt, 0,
-        constexpr static native_word<"<",    &w_eq>    w_lt    {f_lt};
+            cS{"\'"}, f_tick, 0,
-        constexpr static native_word<"\'",   &w_lt>    w_tick  {f_tick};
+            cS{":"}, f_colon, 0,
-        constexpr static native_word<":",    &w_tick>  w_colon {f_colon};
+            cS{";"}, f_semic, word_base::immediate,
-        constexpr static native_word<";",    &w_colon> w_semic {f_semic,
+            cS{"\\"}, f_comm, word_base::immediate,
-            word_base::immediate};
+            cS{"cell"}, f_cell, 0,
-        constexpr static native_word<"\\",   &w_semic> w_comm  {f_comm,
+            cS{"_jmp"}, f_jmp, 0,
-            word_base::immediate};
+            cS{"_jmp0"}, f_jmp0, 0,
-        constexpr static native_word<"cell", &w_comm>  w_cell  {f_cell};
+            cS{"chars"}, [](auto) {}, 0,
-        constexpr static native_word<"_jmp", &w_cell>  w_jmp   {f_jmp};
+            cS{"postpone"}, f_postpone, word_base::immediate
-        constexpr static native_word<"_jmp0", &w_jmp>  w_jmp0  {f_jmp0};
+        >::word;
-        constexpr static native_word<"postpone", &w_jmp0> w_postp {f_postpone,
+        constexpr static auto& dict2 = comp_dict<forth::prologue<fthp>, &dict1
-            word_base::immediate};
+            , cS{"1-"    }, cS{"1 -" }, 0
-        constexpr static comp_word<"cell+", "cell +", w_postp> w_cellp
+            , cS{"1+"    }, cS{"1 +" }, 0
-            {forth::prologue<fthp>};
+            , cS{"cell+" }, cS{"cell +"}, 0
-        constexpr static comp_word<"cells", "cell *", w_cellp> w_cells
+            , cS{"cells" }, cS{"cell *"}, 0
-            {forth::prologue<fthp>};
+            , cS{"char+" }, cS{"1 +" }, 0
-        constexpr static comp_word<"char+", "1 +", w_cells> w_charp
+            , cS{"-rot"  }, cS{"rot rot"}, 0
-            {forth::prologue<fthp>};
+            , cS{"2drop" }, cS{"drop drop"}, 0
-        constexpr static comp_word<"1+", "1 +", w_charp> w_inc
+            , cS{"0="    }, cS{"0 ="}, 0
-            {forth::prologue<fthp>};
+            , cS{"0<"    }, cS{"0 <"}, 0
-        constexpr static comp_word<"1-", "1 -", w_inc> w_dec
+            , cS{"<>"    }, cS{"= 0="}, 0
-            {forth::prologue<fthp>};
+            , cS{">"     }, cS{"swap <"}, 0
-
+            , cS{"invert"}, cS{"-1 xor"}, 0
-        fth.next = &w_dec;
+            , cS{"negate"}, cS{"-1 *"}, 0
+            , cS{"2*"    }, cS{"2 *"}, 0
+            , cS{"bl"    }, cS{"32"}, 0
+        >::word;
+
+        fth.next = &dict2;
         fth.end = end_value;
     }