home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Geek Gadgets 1
/
ADE-1.bin
/
ade-dist
/
tile-forth-2.1-base.tgz
/
tile-forth-2.1-base.tar
/
fsf
/
tile-forth
/
tst
/
relations.tst
< prev
next >
Wrap
Text File
|
1991-09-14
|
3KB
|
200 lines
.( Loading Relations test...) cr
#include relations.f83
#include blocks.f83
string blocks relations
.( 1: Some simple items and relations between them) cr
item a
item b
item c
item d
.items cr
10 a a put-relation
11 b a put-relation
12 c a put-relation
13 d a put-relation
a .relations cr
b .relations cr
c .relations cr
d .relations cr
a .values cr
a a remove-relation
a .values cr
d a remove-relation
a .values cr
item Joe
item address
item profession
" Forth road 4, Forthiana" address Joe put-relation
" Forth Hacker" profession Joe put-relation
Joe .values cr
cr
.( 2: Reflexive and symmetric relations) cr
: reflexive ( relation item -- )
tuck put-relation
;
: symmetric ( item1 relation item2 -- )
>r 2dup r@ put-relation
r> swap rot put-relation
;
.( 3: Directions and opposite directions) cr
item north
item south
item east
item west
item opposite
.items cr
north opposite south symmetric
east opposite west symmetric
opposite block[ ( value item -- )
.item space opposite .item space .item cr
]; map-relation
cr
.( 4: A small map with locations and paths) cr
: location ( -- )
item
;
: path ( from direction to -- )
>r 2dup r@ put-relation
opposite swap get-relation
r> swap rot put-relation
;
location HardwareShop
location Macdonalds
location Drugstore
location Hotel
.items cr
Hotel west HardwareShop path
Macdonalds south Hotel path
Drugstore west Macdonalds path
Hotel east Hotel path
Hotel .relations cr
Macdonalds .relations cr
HardwareShop .relations cr
Drugstore .relations cr
cr
.( 5: Sets, Bags and Dictionaries using relations) cr
: occurencesOf ( element set -- value)
?get-relation not if 2drop 0 then
;
: ?includes ( element set -- flag)
occurencesOf boolean
;
: add ( element set -- )
1 -rot put-relation
;
: remove ( element set -- )
remove-relation
;
: addWithOccurrences ( value element bag -- )
2dup 2>r occurencesOf + 2r> put-relation
;
item x
item aSet
item aBag
item aDictionary
.items cr
x aSet ?includes .
x aSet add
x aSet ?includes .
x aSet remove
10 x aBag addWithOccurrences
x aBag occurencesOf .
10 x aBag addWithOccurrences
x aBag occurencesOf .
x aBag remove
x aBag occurencesOf .
x aDictionary ?includes .
100 x aDictionary put-relation
x aDictionary get-relation . cr
aSet .relations cr
aBag .relations cr
aDictionary .relations cr
cr
.( 6: Item relation database dump example) cr
item dump
item is-an-item
is-an-item dump dump put-relation
is-an-item dump north put-relation
is-an-item dump west put-relation
is-an-item dump south put-relation
is-an-item dump east put-relation
is-an-item dump opposite put-relation
item is-a-string
is-a-string dump address put-relation
is-a-string dump profession put-relation
: dump-items ( -- )
block[ ( item -- )
." item " .item cr
];
map-items
;
: dump-item-values ( -- )
block[ ( item -- )
dup
block[ ( item value attribute -- item)
tuck dump swap ?get-relation
if
case
is-an-item of .item space endof
is-a-string of ascii " emit space $print ascii " emit space endof
swap .
endcase
else
2drop .
then
.item space dup .item space ." put-relation" cr
];
map-item
drop
];
map-items
;
\ Dump the current set of items and their values in a loadable form
dump-items cr
dump-item-values cr
cr
forth only