add looping words

core.fth

@@ -85,3 +85,24 @@
 : decimal   10 base ! ;
 : hex       16 base ! ;
 
+: begin    0 here ; immediate
+: while    swap 1+ swap postpone if -rot ; immediate
+: repeat   ['] _jmp , , if postpone then then ; immediate
+: until    ['] _jmp0 , , drop ; immediate
+
+: do       ['] _lit , here 0 , ['] >r , postpone 2>r here ; immediate
+: unloop   postpone 2r> ['] 2drop , ['] r> , ['] drop , ; immediate
+: leave    postpone 2r> ['] 2drop , ['] exit , ; immediate
+: +loop    ['] r> , ['] 2dup , ['] + ,
+           postpone r@ ['] swap , ['] >r ,
+           ['] - , ['] 2dup , ['] + , ['] over , ['] xor ,
+           ['] rot , ['] rot , ['] xor , ['] and , ['] _lit , 0 ,
+           ['] < , ['] _jmp0 , ,
+           postpone unloop here 1 cells - swap ! ; immediate
+: loop     postpone 2r> ['] 1+ , ['] 2dup ,
+           postpone 2>r ['] = , ['] _jmp0 , ,
+           postpone unloop here 1 cells - swap ! ; immediate
+: i        postpone r@ ; immediate
+: j        postpone 2r> ['] r> , postpone r@ ['] swap ,
+           ['] >r , ['] -rot , postpone 2>r ; immediate
+

forth.hpp

@@ -237,6 +237,10 @@ struct forth
 
         static auto& fth = **fthp;
 
+        constexpr static func lit_impl = [](auto) {
+            auto ptr = reinterpret_cast<cell *>(++fth.ip);
+            fth.push(*ptr);
+        };
         auto f_dict   = [](auto) { fth.push(reinterpret_cast<cell>(&fth)); };
         auto f_add    = [](auto) { fth.top() += fth.pop(); };
         auto f_minus  = [](auto) { fth.top() -= fth.pop(); };
@@ -253,12 +257,7 @@ struct forth
         auto f_imm    = [](auto) {
             const_cast<word_base *>(fth.latest)->make_immediate(); };
         auto f_lit    = [](auto) {
-            static auto lit_impl = +[] {
-                auto ptr = reinterpret_cast<cell *>(++fth.ip);
-                fth.push(*ptr);
-            };
-
-            assert<error::compile_only_word>(fth.compiling);
+            //assert<error::compile_only_word>(fth.compiling);
             *fth.here++ = reinterpret_cast<cell>(&lit_impl);
             *fth.here++ = fth.pop(); };
         auto f_peek = [](auto) { fth.push(*reinterpret_cast<cell *>(fth.pop())); };
@@ -300,9 +299,20 @@ struct forth
             if (fth.pop() == 0)
                 fth.ip = *reinterpret_cast<func **>(ptr) - 1;
         };
+        auto f_postpone = [](auto) {
+            assert<error::compile_only_word>(fth.compiling);
+
+            auto w = fth.parse();
+            auto g = fth.get(w);
+
+            assert<error::word_not_found>(g.has_value());
+
+            *fth.here++ = reinterpret_cast<cell>((*g)->body());
+        };
 
         constexpr static word w_dict {"_d", f_dict};
-        constexpr static word w_add {"+", f_add, &w_dict};
+        constexpr static word w_liti {"_lit", lit_impl, &w_dict};
+        constexpr static word w_add {"+", f_add, &w_liti};
         constexpr static word w_minus {"-", f_minus, &w_add};
         constexpr static word w_times {"*", f_times, &w_minus};
         constexpr static word w_divide {"/", f_divide, &w_times};
@@ -333,8 +343,9 @@ struct forth
         constexpr static word w_cell {"cell", f_cell, &w_comm};
         constexpr static word w_jmp {"_jmp", f_jmp, &w_cell};
         constexpr static word w_jmp0 {"_jmp0", f_jmp0, &w_jmp};
+        constexpr static word w_postp {"postpone", f_postpone, &w_jmp0, word_base::immediate};
 
-        fth.latest = &w_jmp0;
+        fth.latest = &w_postp;
         fth.end = end_value;
     }
 

main.cpp

@@ -33,7 +33,7 @@ int main(int argc, const char *argv[])
 
     forth::initialize<&fth>(dict.end());
     fth->add(".", [](auto) {
-        char buf[32];
+        char buf[32] = {};
         std::to_chars(buf, buf + sizeof(buf), fth->pop(), fth->base);
         std::cout << buf << ' ';
     });