No CASE construct, huh? Now how are we supposed to make those complex decisions? Well, do it the proper way. Leo Brodie wrote: "I consider the case statement an elegant solution to a misguided problem: attempting an algorithmic expression of what is more aptly described in a decision table". And that is exactly what we are going to teach you.
Let's say we want a routine that takes a number and then prints the approriate month. In ANS-Forth, you could do that this way:
: Get-Month
case
1 of ." Januari " endof
2 of ." Februari " endof
3 of ." March " endof
4 of ." April " endof
5 of ." May " endof
6 of ." June " endof
7 of ." July " endof
8 of ." August " endof
9 of ." September" endof
10 of ." October " endof
11 of ." November " endof
12 of ." December " endof
endcase
cr
;
This takes a lot of code and a lot of comparing. In this case (little wordplay) you would be better of with an indexed table, like this:
create MonthTable
" January " ,
" February " ,
" March " ,
" April " ,
" May " ,
" June " ,
" July " ,
" August " ,
" September" ,
" October " ,
" November " ,
" December " ,
: Get-Month ( n -- )
12 min 1- MonthTable swap th @' pad copy count type cr
;
Which does the very same thing and will certainly work faster. True, you can't do that this easily in ANS-Forth, but in 4tH you can, so use it! But can you use the same method when you're working with a random set of values like "2, 1, 3, 12, 5, 6, 4, 7, 11, 8, 10, 9". Yes, you can. But you need a special routine to access such a table. Of course we designed one for you:
: Search-Table ( n1 a1 n2 n3 -- n4 f)
swap >r ( n1 a1 n3)
rot rot ( n3 n1 a1)
over over ( n3 n1 a1 n1 a1)
0 ( n3 n1 a1 n1 a1 n2)
begin ( n3 n1 a1 n1 a1 n2)
swap over ( n3 n1 a1 n1 n2 a1 n2)
th ( n3 n1 a1 n1 n2 a2)
@' dup ( n3 n1 a1 n1 n2 n3 n3)
0> >r ( n3 n1 a1 n1 n2 n3)
rot <> ( n3 n1 a1 n2 f)
r@ and ( n3 n1 a1 n2 f)
while ( n3 n1 a1 n2)
r> drop ( n3 n1 a1 n2)
r@ + ( n3 n1 a1 n2+2)
>r over over ( n3 n1 a1 n1 a1)
r> ( n3 n1 a1 n1 a1 n2+2)
repeat ( n3 n1 a1 n2)
r@ if
>r rot r> ( n1 a1 n3 n2)
+ th @' ( n1 n4)
swap drop ( n3)
else
drop drop drop ( n1)
then
r> ( n f)
r> drop ( n f)
;
This routine takes four values. The first one is the value you want to search. The second is the address of the table you want to search. The third one is the number of fields this table has. And on top of the stack you'll find the field which value it has to return. The first field must be the "index" field. It contains the values which have to be compared. That field has number zero.
This routine can search zero-terminated tables. That means the last value in the index field must be zero. Finally, it can only lookup positive values. You can change all that by modifying the line with "0> >r". It returns the value in the appropriate field and a flag. If the flag is false, the value was not found.
Now, how do we apply this to our month table? First, we have to redefine it:
0 Constant NULL
create MonthTable
1 , " January " ,
2 , " February " ,
3 , " March " ,
4 , " April " ,
5 , " May " ,
6 , " June " ,
7 , " July " ,
8 , " August " ,
9 , " September" ,
10 , " October " ,
11 , " November " ,
12 , " December " ,
NULL ,
Note that this table is sorted, but that doesn't matter. It would work just as well when it was unsorted. Let's get our stuff together: the address of the table is "MonthTable", it has two fields and we want to return the address of the string, which is located in field 1. Field 0 contains the values we want to compare. We can now define a routine which searches our table:
: Search-Month MonthTable 2 1 Search-Table ; ( n1 -- n2 f)
Now, we define a new "Get-Month" routine:
: Get-Month ( n --)
Search-Month \ search table
if \ if month is found
pad copy count type \ print its name
else \ if month is not found
drop ." Not found" \ drop value
then \ and show message
cr
;
Is this flexible? Oh, you bet! We can extend the table with ease:
0 Constant NULL
3 Constant #MonthFields
create MonthTable
1 , " January " , 31 ,
2 , " February " , 28 ,
3 , " March " , 31 ,
4 , " April " , 30 ,
5 , " May " , 31 ,
6 , " June " , 30 ,
7 , " July " , 31 ,
8 , " August " , 31 ,
9 , " September" , 30 ,
10 , " October " , 31 ,
11 , " November " , 30 ,
12 , " December " , 31 ,
NULL ,
Now we make a slight modification to "Search-Month":
: Search-Month MonthTable #MonthFields 1 Search-Table ;
This enables us to add more fields without ever having to modify "Search-Month" again. If we add another field, we just have to modify "#MonthFields". We can now even add another routine, which enables us to retrieve the number of days in a month:
: Search-#Days MonthTable #Monthfields 2 Search-Table ;
Of course, there is room for even more optimization, but for now we leave it at that. Do you now understand why 4tH doesn't have a CASE construct?