forth
voc: ans
ans

' | alias \

\ ans.forth
\ ------------------------------------------------
\ This module implements partial ANS compatibility
\ for Retro. It is not intended to fully implement
\ ANS, but rather to provide enough of the words
\ to make porting ANS code to Retro easier. It
\ also helps to highlight some of the differences
\ between ANS and Retro.
\
\ At the end of this file is the number of non-
\ implemented words in the library.
\
\ Words marked xxx are defined, but not compatible
\ with ANS.
\ ------------------------------------------------
\  
\ ------------------------------------------------
\ CORE
\ ------------------------------------------------
\ Word         Implemented in
\ ===========  ==============
\ !            Rx
\ #            ---
\ #>           ---
\ #s           ---
\ '            Rx
\ (            Rx
\ *            Rx
\ */           Library
  : */ >r * r> / ;
\ */mod        Library
  : */mod >r * r> /mod ;
\ +            Rx
\ +!           Rx 
\ +loop        ---
\ ,            Rx
\ -            Rx
\ .            Rx
\ ."           Rx
\ /            Rx
\ /mod         Rx
\ 0<           Library
  : 0< 0 <if true ;then false ;
\ 0=           Library
  : 0= 0 =if true ;then false ;
\ 1+           Rx
\ 1-           Rx
\ 2!           Library
  : 2! swap over ! cell+ ! ;
\ 2*           Library
  : 2* 1 << ;
\ 2/           Library
  : 2/ 1 >> ;
\ 2@           Library
  : 2@ dup cell+ @ swap @ ;
\ 2dup         Rx
\ 2drop        Rx
\ 2over        Library
  : 2over >r >r 2dup r> -rot r> -rot ;
\ 2swap        Library
  : 2swap rot >r rot r> ;
\ :            Rx
\ ;            Rx
\ <            Rx
\ <#           ---
\ =            Rx
\ >            Rx
\ >body        Library
  : >body ;
\ >in          xxx
\ >number      xxx
\ >r           Rx
\ ?dup         Library
  : ?dup dup 0; ;
\ @            Rx
\ abort        Library
  : abort rdrop reset ['] boot execute ;
\ abort"       ---
\ abs          Library
  : abs dup 0 <if negate then ;
\ accept       Retro
\ aligned      Library
  : aligned dup 4 mod + ;
\ align        Library
  : align here aligned h0 ! ;
\ allot        Rx
\ and          Rx 
\ base         Rx
\ begin        Library
  macro : begin here ; forth
\ bl           Library
  32 constant bl
\ c!           Rx
\ c,           Library
  ' 1, is c,
\ c@           Rx
\ cell+        Rx
\ cells        Rx
\ char         Library (see [char])
\ char+        Library
  ' 1+ alias char+
\ chars        Library
  : chars ;
\ constant     Rx 
\ count        Rx 
\ cr           Retro
\ create       Rx 
\ decimal      Rx
\ depth        Library
  loc:
    : sp@ dup [ $f089 2, ]  ;
    reset sp@ constant base
   :: base sp@ - 4 / 1- ;
  ;loc alias depth
\ do           Library
  macro : do here ['] swap compile x: >r x: >r ; forth
\ does>        Retro
\ drop         Rx
\ dup          Rx
\ else         Library
  macro
  : else  $e9 1, here 0 , swap dup here swap - 4 - swap ! ;
  forth
\ emit         Retro
\ environment? Library
  : environment 2drop false ;
\ evaluate     ---
\ execute      Rx 
\ exit         Library
  macro  ' ;; is exit forth 
\ fill         Rx 
\ find         ---
\ fm/mod       Library
  : fm/mod [ $168bad91 , $d285f9f7 , $c0850774 , $01480379 , $1689ca 3, ] ;
\ here         Rx
\ hold         ---
\ i            Library
  : i dup [ $0424448b , ] ;
\ if           Rx
\ immediate    Library
  : immediate ~.self reclass ;
\ invert       Library
  ' not alias invert
\ j            Library
  : j dup [ $0c24448b , ] ;
\ key          Retro
\ leave        Library
  macro : leave x: rdrop x: rdrop x: ;; ; forth
\ literal      Rx
\ loop         Library
  loc:
    macro
    : jump? x: >if $e9 1, swap here - 4 - , x: then ;
    : end_loop ['] 2dup compile x: jump? x: drop x: drop ;
    : start_loop x: r> x: r> x: swap ;
   :: x: start_loop x: 1+ x: end_loop ;
  ;loc is loop forth
\ lshift       Library
  ' << alias lshift
\ m*           Library
  : m*     [ $892ef799 , $16 1, ] ;
\ max          Library
  : max 2dup >if drop ;then nip ;
\ min          Library
  : min 2dup <if drop ;then nip ;
\ mod          Rx
\ move         Rx 
\ negate       Rx
\ or           Rx 
\ over         Rx
\ postpone     Library 
  ' x: alias postpone immediate
\ quit         Library
  : quit reset boot ;
\ r>           Rx
\ r@           Library
  ' r alias r@ immediate
\ recurse      Library
  : recurse last @ :xt @ compile ; immediate
\ repeat       Library
  : repeat swap compile x: ;; dup here swap - 1- swap c! $90 1, $ad 1, ; immediate
\ rot          Rx
\ rshift       Library
  ' >> alias rshift
\ s"           Rx
\ s>d          Library
  : s>d    [ $04ee8399 , $1689 2, ] ;
\ sign         ---
\ sm/rem       Library
  : sm/rem [ $168bad91 , $1689f9f7 , ] ;
\ source       ---
\ space        Retro
\ spaces       Retro
\ state        Rx
\ swap         Rx
\ then         Rx
\ type         Retro
\ u.           Retro
\ u<           ---
\ um*          Library
  : um*    [ $26f7d231 , $1689 2, ] ;
\ um/mod       Library
  : um/mod [ $168bad91 , $1689f1f7 , ] ;
\ unloop       ---
\ until        Library
  : until 0 literal, x: =if $eb 1, here 0 1, x: then x: repeat ; immediate
\ variable     Rx 
\ while        Library
  : while 0 literal, x: <>if $eb 1, here 0 1, x: then ; immediate
\ word         Library
  ' parse alias word
\ xor          Rx 
\ [            Rx
\ [']          Rx
\ [char]       Library
  : char 
  : [char] @base >r 255 !base wsparse >number drop literal? r> !base ; 
  immediate
\ ]            Rx

^