85 lines
2.3 KiB
Forth
85 lines
2.3 KiB
Forth
include FMS-SI.f
|
|
include FMS-SILib.f
|
|
|
|
\ Since the same join attribute, Name, occurs more than once
|
|
\ in both tables for this problem we need a hash table that
|
|
\ will accept and retrieve multiple identical keys if we want
|
|
\ an efficient solution for large tables. We make use
|
|
\ of the hash collision handling feature of class hash-table.
|
|
|
|
\ Subclass hash-table-m allows multiple entries with the same key.
|
|
\ After a get: hit one can inspect for additional entries with
|
|
\ the same key by using next: until false is returned.
|
|
|
|
:class hash-table-m <super hash-table
|
|
|
|
\ called within insert: method in superclass
|
|
:m (do-search): ( node hash -- idx hash false )
|
|
swap drop idx @ swap false ;m
|
|
:m next: ( -- val true | false )
|
|
last-node @ dup
|
|
if
|
|
begin
|
|
( node ) next: dup
|
|
while
|
|
dup key@: @: key-addr @ key-len @ compare 0=
|
|
if dup last-node ! val@: true exit then
|
|
repeat
|
|
then ;m
|
|
;class
|
|
|
|
\ begin hash phase
|
|
: obj ( addr len -- obj )
|
|
heap> string+ dup >r !: r> ;
|
|
|
|
hash-table-m R 1 r init
|
|
s" Whales " obj s" Jonah" r insert:
|
|
s" Spiders " obj s" Jonah" r insert:
|
|
s" Ghosts " obj s" Alan" r insert:
|
|
s" Buffy " obj s" Glory" r insert:
|
|
s" Zombies " obj s" Alan" r insert:
|
|
s" Vampires " obj s" Jonah" r insert:
|
|
\ end hash phase
|
|
|
|
\ create Age Name table S
|
|
o{ o{ 27 'Jonah' }
|
|
o{ 18 'Alan' }
|
|
o{ 28 'Glory' }
|
|
o{ 18 'Popeye' }
|
|
o{ 28 'Alan' } } value s
|
|
|
|
\ Q is a place to store the relation
|
|
object-list2 Q
|
|
|
|
\ join phase
|
|
: join \ { obj | list -- }
|
|
0 locals| list obj |
|
|
1 obj at: @: r get: \ hash the join-attribute and search table r
|
|
if \ we have a match, so concatenate and save in q
|
|
heap> object-list2 to list list q add: \ start a new sub-list in q
|
|
0 obj at: copy: list add: \ place age from list s in q
|
|
1 obj at: copy: list add: \ place join-attribute (name) from list s in q
|
|
( str-obj ) copy: list add: \ place first nemesis in q
|
|
begin
|
|
r next: \ check for more nemeses
|
|
while
|
|
( str-obj ) copy: list add: \ place next nemesis in q
|
|
repeat
|
|
then ;
|
|
|
|
: probe
|
|
begin
|
|
s each: \ for each tuple object in s
|
|
while
|
|
( obj ) join \ pass the object to function join
|
|
repeat ;
|
|
|
|
probe \ execute the probe function
|
|
|
|
q p: \ print the saved relation
|
|
|
|
\ free allocated memory
|
|
s <free
|
|
r free2:
|
|
q free:
|