move (most) of core-ext to its own file

4 files changed, 65 insertions, 57 deletions

diff --git a/Makefile b/Makefile
index afe8614..04dbefd 100644
--- a/Makefile
+++ b/Makefile
@@ -32,7 +32,7 @@ cppcheck:
              libalee alee*.cpp *dict.hpp
 
 test: standalone
-	echo "\nbye\n" | ./alee-standalone test/tester.fr test/core.fr
+	echo "\nbye\n" | ./alee-standalone core-ext.fth test/tester.fr test/core.fr
 
 $(LIBFILE): $(OBJFILES)
 	$(AR) crs $@ $(OBJFILES)
diff --git a/README.md b/README.md
index e41b628..b59c463 100644
--- a/README.md
+++ b/README.md
@@ -12,9 +12,9 @@ System-specific functionality is obtained through a `sys` Forth word. This word
 
 # Forth compatibility
 
-Alee implements a large majority of the "core" and "core extension" [glossaries](https://forth-standard.org/standard/core). Implementation is tracked in `compat.txt`, with missing words listed below. Fundamental words are built into Alee (written in C++); the rest of the implementation is in `core.fth`.
+Alee implements a large majority of the "core" and "core extension" [word sets](https://forth-standard.org/standard/core). Implementation is tracked in `compat.txt`, with missing words listed below. Fundamental words are built into Alee (written in C++); the rest of the implementation is in `core.fth` and `core-ext.fth`.
 
-This means Alee should be executed as `alee core.fth` to include these words. Alternatively, the `standalone` target packages the `core.fth` dictionary into the program.
+Running Alee without `core.fth` or `core-ext.fth` passed as arguments will leave you with a minimal word set. The `standalone` target will package the `core.fth` dictionary into the program.
 
 **Missing** core features:  
 * Pictured numeric output conversion `<# #>`
@@ -36,8 +36,8 @@ Alee requires `make` and a C++17-compatible compiler.
 To compile, simply run the `make` command. This will produce a library, `libalee.a`, as well as a REPL binary named `alee`.  
 A `small` target exists that optimizes the build for size.  
 A `fast` target exists that optimizes for maximum performance on the host system.
-The `standalone` target will produce a `alee-standalone` binary that contains and pre-loads the core dictionary.
-The `msp430` target builds Alee for the [MSP430G2553](https://www.ti.com/product/MSP430G2553) microcontroller. Like `standalone`, the core dictionary is built into the binary.
+The `standalone` target will produce a `alee-standalone` binary that has the core dictionary built in.
+The `msp430` target builds Alee for the [MSP430G2553](https://www.ti.com/product/MSP430G2553) microcontroller. This target requires `standalone` for the core dictionary.
 
 Configurable constants and types are defined either in the Makefile or in `types.hpp`.
 
diff --git a/core-ext.fth b/core-ext.fth
new file mode 100644
index 0000000..e1f7eac
--- /dev/null
+++ b/core-ext.fth
@@ -0,0 +1,49 @@
+-1 constant true
+0 constant false
+
+: hex      16 base ! ;
+
+: nip      swap drop ;
+: tuck     swap over ;
+
+: 0>       0 > ;
+: 0<>      0= 0= ;
+
+: 2r@      ['] r> , ['] r> , ['] 2dup , ['] >r , ['] >r , ['] swap , ; imm
+
+: compile, postpone literal postpone execute ;
+: \        _source @ >in @ +
+           begin dup c@ while 0 over c! char+ repeat drop ; imm
+: again    postpone repeat ; imm
+: ?do      ['] 2dup , ['] _lit , here 0 , ['] >r , ['] = , postpone if
+           ['] 2drop , postpone 2r> ['] drop , ['] >r , ['] exit ,
+           postpone then postpone 2>r here ; imm
+
+: .(       [char] ) word count type ; imm
+: c"       state @ if ['] _jmp , here 0 , then
+           [char] " word
+           state @ 0= if exit then
+           dup count nip allot
+           here rot !
+           postpone literal ; imm
+
+: buffer:  create allot ;
+: value    constant ;
+: to       ' 4 cells + state @ if postpone literal ['] ! , else ! then ; imm
+: defer    create does> @ execute ;
+: defer@   >body @ ;
+: defer!   >body ! ;
+: is       state @ if postpone ['] postpone defer! else ' defer! then ; imm
+: action-of state @ if postpone ['] postpone defer@ else ' defer@ then ; imm
+
+: erase    begin dup 0 > while swap 0 over ! 1+ swap 1- repeat ;
+: roll     dup if swap >r 1- recurse r> swap exit then drop ;
+
+: marker   create _latest @ , here , does>
+           dup @ _latest ! cell+ @ here swap - allot ;
+
+: case     ['] _lit , 1 here 0 , ['] drop , ; imm
+: of       ['] over , ['] = , postpone if ; imm
+: endof    ['] _jmp , here >r 0 , postpone then
+           swap 1+ swap r> tuck ! ; imm
+: endcase  swap 0 do dup @ swap here swap ! loop drop ['] drop , ; imm
diff --git a/core.fth b/core.fth
index 7807489..c23c366 100644
--- a/core.fth
+++ b/core.fth
@@ -48,8 +48,6 @@
 : over     1 pick ;
 : rot      >r swap r> swap ;
 : -rot     rot rot ;
-: nip      swap drop ;
-: tuck     swap over ;
 
 : 2drop    drop drop ;
 : 2dup     over over ;
@@ -63,11 +61,9 @@
 : chars    ;
 
 : decimal  10 base ! ;
-: hex      16 base ! ;
 
 : 2r>      ['] r> , ['] r> , ['] swap , ; imm
 : 2>r      ['] swap , ['] >r , ['] >r , ; imm
-: 2r@      ['] r> , ['] r> , ['] 2dup , ['] >r , ['] >r , ['] swap , ; imm
 : r@       ['] r> , ['] dup , ['] >r , ; imm
 
 : 2!       swap over ! cell+ ! ;
@@ -78,19 +74,13 @@
 : <=       2dup < >r = r> | ;
 : >        swap < ;
 : <>       = 0= ;
-: 0<>      0= 0= ;
-: 0>       0 > ;
 
 : begin    0 here ; imm
 : while    swap 1+ swap postpone if -rot ; imm
 : repeat   ['] _jmp , , if postpone then then ; imm
 : until    ['] _jmp0 , , drop ; imm
-: again    postpone repeat ; imm
 
 : do       ['] _lit , here 0 , ['] >r , postpone 2>r here ; imm
-: ?do      ['] 2dup , ['] _lit , here 0 , ['] >r , ['] = , postpone if
-           ['] 2drop , postpone 2r> ['] drop , ['] >r , ['] exit ,
-           postpone then postpone 2>r here ; imm
 : unloop   postpone 2r> ['] 2drop , ['] r> , ['] drop , ; imm
 : leave    postpone 2r> ['] 2drop , postpone 2r>
            ['] drop , ['] >r , ['] exit , ; imm
@@ -106,8 +96,8 @@
 : j        postpone 2r> ['] r> , postpone r@ ['] swap ,
            ['] >r , ['] -rot , postpone 2>r ; imm
 
-: align    here 1 cells 1- tuck & if 1 cells swap - allot else drop then ;
-: aligned  dup 1 cells 1- tuck & if 1 cells swap - + else drop then ;
+: align    here 1 cells 1- swap over & if 1 cells swap - allot else drop then ;
+: aligned  dup 1 cells 1- swap over & if 1 cells swap - + else drop then ;
 
 : and      & ;
 : or       | ;
@@ -137,8 +127,8 @@
 
 : negate   -1 * ;
 : abs      dup 0< if negate then ;
-: min      2dup <= if drop else nip then ;
-: max      2dup <= if nip else drop then ;
+: min      2dup <= if drop else swap drop then ;
+: max      2dup <= if swap drop else drop then ;
 
 : source   _source @ 0 begin 2dup + c@ while char+ repeat ;
 : key      _source @ >in @ +
@@ -147,15 +137,13 @@
 : key?     _source @ >in @ + c@ 0 <> ;
 : word     here dup >r char+ >r
            begin key? if key 2dup <> else 0 0 then while
-           r> tuck c! char+ >r repeat
-           2drop r> r> tuck - 1- over c! ;
+           r> swap over c! char+ >r repeat
+           2drop r> r> swap over - 1- over c! ;
 : count    dup char+ swap c@ ;
 : char     bl word char+ c@ ;
 : [char]   char postpone literal ; imm
 
 : (        begin [char] ) key <> while repeat ; imm
-: \        _source @ >in @ +
-           begin dup c@ while 0 over c! char+ repeat drop ; imm
 
 : type     begin dup 0 > while swap dup c@ emit char+ swap 1- repeat 2drop ;
 : s"       state @ if ['] _jmp , here 0 , then
@@ -164,20 +152,13 @@
            dup cell+ allot
            rot here swap !
            swap postpone literal postpone literal ; imm
-: c"       state @ if ['] _jmp , here 0 , then
-           [char] " word
-           state @ 0= if exit then
-           dup count nip allot
-           here rot !
-           postpone literal ; imm
 : ."       postpone s" state @ if ['] type , else type then ; imm
-: .(       [char] ) word count type ; imm
 
 : create   align here
            1 cells 1 chars - allot
-           bl word count nip
+           bl word count swap drop
            1 chars allot
-           tuck over ! swap allot align
+           swap over over ! swap allot align
            ['] _lit , here 3 cells + , ['] exit dup , ,
            dup @ 31 & over _latest @ - 6 << or over ! _latest ! ;
 : _does>   _latest @ dup @ 31 & + cell+ aligned 2 cells +
@@ -186,21 +167,9 @@
 : does>    ['] _jmp , here 2 cells + dup , 2 cells + ,
            ['] _does> , ['] exit , ; imm
 : >body    cell+ @ ;
-: compile, postpone literal postpone execute ;
 
-: buffer:  create allot ;
-: variable 1 cells buffer: ;
+: variable create 1 cells allot ;
 : constant create , does> @ ;
-: value    constant ;
-: to       ' 4 cells + state @ if postpone literal ['] ! , else ! then ; imm
-: defer    create does> @ execute ;
-: defer@   >body @ ;
-: defer!   >body ! ;
-: is       state @ if postpone ['] postpone defer! else ' defer! then ; imm
-: action-of state @ if postpone ['] postpone defer@ else ' defer@ then ; imm
-
--1 constant true
-0 constant false
 
 : quit     begin _rdepth 1 > while r> drop repeat postpone [ ;
 : abort    begin depth 0 > while drop repeat quit ;
@@ -219,26 +188,16 @@
 : fill     -rot begin dup 0 > while
            >r 2dup c! char+ r> 1- repeat
            2drop drop ;
-: erase    begin dup 0 > while swap 0 over ! 1+ swap 1- repeat ;
-: roll     dup if swap >r 1- recurse r> swap exit then drop ;
 
-: environment? 2drop false ;
+: environment? 2drop 1 0= ;
 
 : accept   over >r begin dup 0 > while
            key dup 32 < if 2drop 0
-           else dup emit rot 2dup c! char+ nip swap 1- then
+           else dup emit rot 2dup c! char+ swap drop swap 1- then
            repeat drop r> - 1 chars / ;
 
-: marker   create _latest @ , here , does>
-           dup @ _latest ! cell+ @ here swap - allot ;
 : :noname  0 , here ] ;
 
 : evaluate _source @ >r _sourceu @ >r >in @ >r
            0 >in ! _sourceu ! _source ! 5 sys
            r> >in ! r> _sourceu ! r> _source ! ;
-
-: case     ['] _lit , 1 here 0 , ['] drop , ; imm
-: of       ['] over , ['] = , postpone if ; imm
-: endof    ['] _jmp , here >r 0 , postpone then
-           swap 1+ swap r> tuck ! ; imm
-: endcase  swap 0 do dup @ swap here swap ! loop drop ['] drop , ; imm