Re: [Amforth-devel] Version 2.6: case ... endcase broken?

[Erich W. <ew....@on...>]

Hello,

Matthias Trute wrote:
> Hi Erich,
> 
> better late than never
> 
> Erich Waelde wrote:
> 
>> In release 2.6 "case" "encase" "of" "endof" were moved into
>> lib/case.frt
> 
>> Any ideas? 
> 
> I took the code from the usenet and did not test it. mea culpa.
> Another forth-project named flashforth has a different implementation
> for it, maybe you can test theirs?
> 

After downloading "flashforth" (for PIC controllers, GPL v3) 
from flashforth.sourceforge.net, I stole "case.fth" from 
their code base. With a minimum of changes (change "for ... 
next" to "?do ... loop") it did work for my tests. In 
particular, case did work, and the argument is cleaned up 
properly. I found this implementation easily readable. Kudos 
to Mikael Nordman and the flashforth folks.

Please find below the files I used.


Cheers,
Erich

-------------------------------------------------------------------
flash_case.fs
-------------------------------------------------------------------
\ 
*********************************************************************
\    Case for FlashForth 
           *
\    Filename:      case.fth 
           *
\    Date:          15.1.2008 
           *
\    FF Version:    3.2 
           *
\    Copyright:     Mikael Nordman 
           *
\    Author:        Mikael Nordman 
           *
\ 
*********************************************************************
\    FlashForth is licensed acording to the GNU General 
Public License*
\ 
*********************************************************************
\ A case implementation posted by Jenny Brien on c.l.f.
\ Modified to use for..next instead of do..loop

\ Modified for use in amforth, changed for..next back
\ to do..loop; Erich Waelde

\ -case
\ marker -case
\ hex ram

variable #of
: case  (  x -- x #of )
   #of @  0 #of !  \ allow nesting
; immediate


: of  ( -- orig)
     postpone over  postpone = ( copy and test case value)
     postpone if    ( add orig to control flow stack )
     postpone drop  ( discards case value if = )
; immediate

: endof ( orig1  -- orig2 )
    postpone else 1 #of +!
; immediate

: endcase  ( #of  orig1..orign  -- )
     postpone drop  ( discard case value )
     #of @ 0 do
       postpone then
     loop
     #of !
; immediate

-------------------------------------------------------------------
test_case.fs

\ 2008-02-02 Erich Waelde


#include lib/ans94/postpone.frt
#include flash_case.fs

: checkout ( n -- )
   case
     0 of ." none" endof
     1 of ." once" endof
     2 of ." twice" endof
     ." unknown"
   endcase
;

-------------------------------------------------------------------