74 lines
2.4 KiB
Text
74 lines
2.4 KiB
Text
[ stack ] is operators ( --> s )
|
|
|
|
0 $ "*/+-" witheach [ bit | ]
|
|
operators put
|
|
|
|
[ stack ] is numbers ( --> s )
|
|
|
|
[ 0 swap
|
|
witheach [ bit | ]
|
|
numbers put ] is putnumbers ( $ --> )
|
|
|
|
[ $ "123456789" shuffle 4 split drop sort ] is choosenumbers ( --> $ )
|
|
|
|
[ say "Using any of the operators * / + -" cr
|
|
say "and each of the numbers "
|
|
witheach [ emit sp ] say "once," cr
|
|
say "enter an RPN expression equal to 24." cr
|
|
$ "Spaces between characters are optional: "
|
|
input ] is getexpression ( $ --> $ )
|
|
|
|
[ $ "" swap witheach
|
|
[ dup space = iff drop else join ] ] is stripspaces ( $ --> $ )
|
|
|
|
[ stack ] is opcount ( --> s )
|
|
[ stack ] is numcount ( --> s )
|
|
[ stack ] is numsused ( --> s )
|
|
|
|
[ true swap
|
|
0 opcount put
|
|
0 numcount put
|
|
0 numsused put
|
|
witheach
|
|
[ bit dup numbers share & iff
|
|
[ 1 numcount tally
|
|
numsused take | numsused put ]
|
|
else
|
|
[ operators share & if
|
|
[ 1 opcount tally ] ]
|
|
opcount share numcount share < not if
|
|
[ drop false conclude ] ]
|
|
numsused take
|
|
numbers share != if [ drop false ]
|
|
numcount take 4 != if [ drop false ]
|
|
opcount take 3 != if [ drop false ] ] is checkexpression ( $ --> b )
|
|
|
|
[ $ "" swap
|
|
witheach
|
|
[ dup char 0 char 9 1+ within iff
|
|
[ join $ " n->v " join ] done
|
|
[ switch
|
|
char * case [ $ "v* " join ]
|
|
char / case [ $ "v/ " join ]
|
|
char + case [ $ "v+ " join ]
|
|
char - case [ $ "v- " join ]
|
|
otherwise [ $ "Error!" fail ] ] ] ] is quackerise ( $ --> [ )
|
|
|
|
[ choosenumbers
|
|
dup putnumbers
|
|
[ dup getexpression
|
|
stripspaces
|
|
dup checkexpression not while
|
|
cr
|
|
say "Badly formed expression. Try again."
|
|
cr cr
|
|
drop again ]
|
|
nip
|
|
quackerise
|
|
quackery
|
|
cr
|
|
say "Your expression is equal to "
|
|
2dup 10 point$ echo$
|
|
24 n->v v- v0= iff
|
|
[ say ". :-)" ] else [ say ". :-(" ]
|
|
numbers release ] is game ( --> )
|