\ ==============================================================================
\ 
\ 	RubyFORTH -- Copyright (C) 2007-8, Marc Simpson (GPL). 
\ 
\	Core definitions (written in Forth for expository purposes)
\ 
\ ==============================================================================

\ --[ FORTH words ]-------------------------------------------------------------

: char   ( "char" -- c )  bl parse 0 i@         ;
: ."     ( "...["]" -- )  34 parse type         ;
: +!     ( n addr   -- )  tuck @ + swap !       ;

: 0=     ( n -- f ) 0 =    ;
: not    ( n -- f ) 0 =    ;
: 0<>    ( n -- f ) 0= not ;

: defer  ( "name" -- ) create 0 , does> @ execute ;
: is     ( xt "name" ) ' 3 + ! ;

: 2!     ( n1 n2 a --     )  tuck 1+ ! ! ;
: 2@     ( a     -- n1 n2 )  dup @ swap 1+ @ ;
: 2,     ( n1 n2 --       )  swap , , ;
: -rot   ( a b c -- c a b )  rot rot ;
: <=     ( n1 n2 -- f     )  2dup < -rot = or ;
: >=     ( n1 n2 -- f     )  swap <= ;

\ --[ COMPILER words ]----------------------------------------------------------

compiler

: [compile]   ' , ;
: [']         ' [compile] literal ;
: 2literal    swap [compile] literal [compile] literal ;
: char        bl parse 0 i@ [compile] literal ;
: 2>r         compile >r compile >r ;
: 2r>         compile r> compile r> ;
: 2r@         [compile] 2r> compile 2dup [compile] 2>r ;
: [is]        ' 3 + [compile] literal compile ! ;
: i           compile r@ ;

: ."  [compile] " compile type ;

( Conditionals -- standard method, cf. eforth )

: if compile ?branch here 0 , ;
: then here swap ! ;

: ahead compile branch here 0 , ;
: else [compile] ahead swap [compile] then ;

( Loops )
: dobranch? [compile] 2r@ compile < compile ?branch ;
: 2rdrop    [compile] 2r> compile 2drop ;
: iterate   compile r> compile 1+ compile >r ;

: do   compile swap [compile] 2>r here 0 , [compile] dobranch? here 0 , ;
: loop [compile] iterate compile branch swap , here swap ! [compile] 2rdrop ;

: for  0 [compile] literal [compile] do ;
: next [compile] loop ;

( Quit the loop upon next iteration -- best used with a conditional )
: unloop compile r> compile drop compile r@ compile >r ;

: begin here ;
: while compile ?branch here swap 0 , ; ( w-addr b-addr )
: again  compile branch , ;
: repeat [compile] again here swap ! ;


\ --[ Additional Utilities ]----------------------------------------------------

forth
: ?dup  dup 0<> if dup then ;

: max   ( n1 n2 -- n3 ) 2dup > if drop else nip then ;
: min   ( n1 n2 -- n3 ) 2dup < if drop else nip then ;

compiler
( Conditionally preserve the TOS if it's true, then enter a conditional )
: ?if compile ?dup [compile] if ;

forth
: r/w " r+" ;
: w/r " w+" ;
: r/o " r"  ;
: w/o " w"  ;


\ --[ RubyFORTH banner ]--------------------------------------------------------

defer .banner
: .default-banner
    cr ." --------------------------------------------------------"
    cr space ." RubyFORTH -- Copyright (C) 2007-8, Marc Simpson (GPL). "
    cr ." --------------------------------------------------------" cr cr ;

' .default-banner is .banner


\ --[ Vocabularies ]------------------------------------------------------------

: vocab: ( "name" -- )
    parse-word dup vocab swap ( <vocab> "name" -- )  make , does> @ ;

( Leave the interpreter in FORTH mode. )
( DONE )