87 lines
2.4 KiB
Plaintext
87 lines
2.4 KiB
Plaintext
[ stack [ ] ] is elements ( --> s )
|
|
|
|
[ elements share 2dup find
|
|
dup rot found iff nip done
|
|
swap elements take
|
|
swap nested join
|
|
elements put ] is elementid ( $ --> n )
|
|
|
|
[ 0 temp put
|
|
[ trim
|
|
dup $ "" = if
|
|
[ $ '"set{" without "}set"'
|
|
message put bail ]
|
|
nextword
|
|
dup $ "}set" = iff drop done
|
|
elementid bit
|
|
temp take | temp put
|
|
again ]
|
|
temp take
|
|
swap dip
|
|
[ nested nested join ] ] builds set{ ( [ $ --> [ $ )
|
|
|
|
[ [] 0 rot
|
|
[ dup while
|
|
dup 1 & if
|
|
[ over elements share
|
|
swap peek nested
|
|
swap dip
|
|
[ rot join swap ] ]
|
|
dip 1+
|
|
1 >>
|
|
again ]
|
|
2drop ] is set->nest ( { --> [ )
|
|
|
|
[ say "{ "
|
|
set->nest witheach [ echo$ sp ]
|
|
say "}" ] is echoset ( { --> )
|
|
|
|
[ & ] is intersection ( { { --> { )
|
|
|
|
[ | ] is union ( { { --> { )
|
|
|
|
[ ^ ] is symmdiff ( { { --> { )
|
|
|
|
[ over intersection symmdiff ] is difference ( { { --> { )
|
|
|
|
[ over intersection = ] is subset ( { { --> b )
|
|
|
|
[ dip [ elementid bit ] subset ] is element ( $ { --> b )
|
|
|
|
[ 2dup = iff
|
|
[ 2drop false ]
|
|
else subset ] is propersubset ( { { --> b )
|
|
|
|
( ----------------------------- demo ---------------------------- )
|
|
|
|
set{ apple peach pear melon
|
|
apricot banana orange }set is fruits ( --> { )
|
|
|
|
set{ red orange green blue
|
|
purple apricot peach }set is colours ( --> { )
|
|
|
|
fruits dup echoset say " are fruits" cr
|
|
|
|
colours dup echoset say " are colours" cr
|
|
|
|
2dup intersection echoset say " are both fruits and colours" cr
|
|
|
|
2dup union echoset say " are fruits or colours" cr
|
|
|
|
2dup symmdiff echoset say " are fruits or colours but not both" cr
|
|
|
|
difference echoset say " are fruits that are not colours" cr
|
|
|
|
set{ red green blue }set dup echoset say " are"
|
|
colours subset not if [ say " not" ] say " all colours" cr
|
|
|
|
say "fruits and colours are" fruits colours = not if [ say " not" ]
|
|
say " exactly the same" cr
|
|
|
|
$ "orange" dup echo$ say " is"
|
|
fruits element not if [ say " not" ] say " a fruit" cr
|
|
|
|
set{ orange }set dup echoset say " is"
|
|
fruits propersubset dup if [ say " not" ] say " the only fruit"
|
|
not if [ say " or not a fruit" ] cr
|