1 ! Copyright © 2008 Reginald Keith Ford II
3 USING: accessors backtrack combinators combinators.smart
4 continuations formatting io kernel math prettyprint
5 quotations random sequences ;
10 : ?/ ( a b -- c ) [ drop 1/0. ] [ / ] if-zero ;
12 : do-operation ( a b -- c )
13 { + - * ?/ } amb-execute ;
15 : permute-2 ( a b -- a b )
16 { nop swap } amb-execute ;
18 : permute-3 ( a b c -- a b c )
19 { nop rot -rot swap spin swapd } amb-execute ;
21 : makes-24? ( a b c d -- ? )
23 permute-3 do-operation
24 permute-3 do-operation
25 permute-2 do-operation
29 : random-4 ( -- array )
30 4 [ 10 random ] replicate ;
32 : make-24 ( -- array )
33 [ random-4 dup first4 makes-24? not ] smart-loop ;
35 : q ( -- obj ) "quit" ;
37 CONSTANT: (operators) { + - * / rot swap q }
39 : operators ( array -- operators )
40 length 3 < [ \ rot (operators) remove ] [ (operators) ] if ;
42 : find-operator ( operators string -- word/f )
43 '[ name>> _ = ] find nip ;
45 : get-operator ( operators -- word )
46 dup "Operators: %u\n" printf flush
47 dup readln find-operator [ ] [
48 "Operator not found..." print get-operator
51 : try-operator ( array -- array )
53 [ dup operators get-operator 1quotation with-datastack ]
56 : end-game ( array -- )
60 "%d is not 24... You lose." sprintf
63 : quit-game ( array -- )
64 drop "you're a quitter" print ;
66 : play-24 ( array -- )
68 { [ dup length 1 = ] [ end-game ] }
69 { [ dup last "quit" = ] [ quit-game ] }
70 [ try-operator play-24 ]
73 : 24-game ( -- ) make-24 play-24 ;