shen-ruby 0.10.0 → 0.11.0
Sign up to get free protection for your applications and to get access to all the features.
- checksums.yaml +4 -4
- data/.rspec +1 -0
- data/.travis.yml +9 -3
- data/Gemfile +1 -4
- data/HISTORY.md +16 -0
- data/MIT_LICENSE.txt +1 -1
- data/README.md +25 -26
- data/Rakefile +3 -11
- data/bin/shen_test_suite.rb +15 -3
- data/bin/srrepl +6 -8
- data/lib/shen_ruby.rb +6 -1
- data/lib/shen_ruby/converters.rb +23 -0
- data/lib/shen_ruby/version.rb +1 -1
- data/shen-ruby.gemspec +4 -1
- data/shen/lib/shen_ruby/shen.rb +49 -33
- data/shen/release/benchmarks/N_queens.shen +45 -45
- data/shen/release/benchmarks/README.shen +14 -14
- data/shen/release/benchmarks/benchmarks.shen +52 -52
- data/shen/release/benchmarks/einstein.shen +32 -32
- data/shen/release/benchmarks/interpreter.shen +219 -219
- data/shen/release/benchmarks/jnk.shen +193 -193
- data/shen/release/benchmarks/powerset.shen +10 -10
- data/shen/release/benchmarks/prime.shen +10 -10
- data/shen/release/benchmarks/short.shen +129 -129
- data/shen/release/k_lambda/core.kl +181 -181
- data/shen/release/k_lambda/declarations.kl +131 -131
- data/shen/release/k_lambda/load.kl +84 -84
- data/shen/release/k_lambda/macros.kl +112 -112
- data/shen/release/k_lambda/prolog.kl +252 -252
- data/shen/release/k_lambda/reader.kl +222 -222
- data/shen/release/k_lambda/sequent.kl +166 -166
- data/shen/release/k_lambda/sys.kl +271 -271
- data/shen/release/k_lambda/t-star.kl +139 -139
- data/shen/release/k_lambda/toplevel.kl +135 -135
- data/shen/release/k_lambda/track.kl +103 -103
- data/shen/release/k_lambda/types.kl +324 -324
- data/shen/release/k_lambda/writer.kl +105 -105
- data/shen/release/k_lambda/yacc.kl +113 -113
- data/shen/release/test_programs/Chap13/problems.txt +26 -26
- data/shen/release/test_programs/README.shen +52 -52
- data/shen/release/test_programs/TinyLispFunctions.txt +15 -15
- data/shen/release/test_programs/TinyTypes.shen +55 -55
- data/shen/release/test_programs/binary.shen +24 -24
- data/shen/release/test_programs/bubble_version_1.shen +28 -28
- data/shen/release/test_programs/bubble_version_2.shen +22 -22
- data/shen/release/test_programs/calculator.shen +21 -21
- data/shen/release/test_programs/cartprod.shen +23 -23
- data/shen/release/test_programs/change.shen +25 -25
- data/shen/release/test_programs/classes-defaults.shen +94 -94
- data/shen/release/test_programs/classes-inheritance.shen +100 -100
- data/shen/release/test_programs/classes-typed.shen +74 -74
- data/shen/release/test_programs/classes-untyped.shen +46 -46
- data/shen/release/test_programs/depth_.shen +14 -14
- data/shen/release/test_programs/einstein.shen +34 -34
- data/shen/release/test_programs/fruit_machine.shen +46 -46
- data/shen/release/test_programs/interpreter.shen +217 -217
- data/shen/release/test_programs/metaprog.shen +85 -85
- data/shen/release/test_programs/minim.shen +192 -192
- data/shen/release/test_programs/mutual.shen +11 -11
- data/shen/release/test_programs/n_queens.shen +45 -45
- data/shen/release/test_programs/newton_version_1.shen +33 -33
- data/shen/release/test_programs/newton_version_2.shen +24 -24
- data/shen/release/test_programs/parse.prl +14 -14
- data/shen/release/test_programs/parser.shen +51 -51
- data/shen/release/test_programs/powerset.shen +10 -10
- data/shen/release/test_programs/prime.shen +10 -10
- data/shen/release/test_programs/prolog.shen +78 -78
- data/shen/release/test_programs/proof_assistant.shen +80 -80
- data/shen/release/test_programs/proplog_version_1.shen +25 -25
- data/shen/release/test_programs/proplog_version_2.shen +27 -27
- data/shen/release/test_programs/qmachine.shen +66 -66
- data/shen/release/test_programs/red-black.shen +54 -54
- data/shen/release/test_programs/search.shen +55 -55
- data/shen/release/test_programs/semantic_net.shen +44 -44
- data/shen/release/test_programs/spreadsheet.shen +34 -34
- data/shen/release/test_programs/stack.shen +27 -27
- data/shen/release/test_programs/streams.shen +20 -20
- data/shen/release/test_programs/strings.shen +57 -57
- data/shen/release/test_programs/structures-typed.shen +71 -71
- data/shen/release/test_programs/structures-untyped.shen +41 -41
- data/shen/release/test_programs/tests.shen +232 -232
- data/shen/release/test_programs/types.shen +11 -11
- data/shen/release/test_programs/whist.shen +239 -239
- data/shen/release/test_programs/yacc.shen +132 -132
- data/spec/shen_ruby/converters_spec.rb +48 -0
- data/spec/spec_helper.rb +1 -2
- metadata +55 -60
- data/k_lambda_spec/atom_spec.rb +0 -85
- data/k_lambda_spec/primitives/arithmetic_spec.rb +0 -175
- data/k_lambda_spec/primitives/assignments_spec.rb +0 -44
- data/k_lambda_spec/primitives/boolean_operations_spec.rb +0 -136
- data/k_lambda_spec/primitives/generic_functions_spec.rb +0 -120
- data/k_lambda_spec/primitives/lists_spec.rb +0 -40
- data/k_lambda_spec/primitives/strings_spec.rb +0 -77
- data/k_lambda_spec/primitives/symbols_spec.rb +0 -24
- data/k_lambda_spec/primitives/vectors_spec.rb +0 -92
- data/k_lambda_spec/spec_helper.rb +0 -29
- data/k_lambda_spec/support/shared_examples.rb +0 -124
- data/k_lambda_spec/tail_recursion_spec.rb +0 -30
- data/lib/kl.rb +0 -7
- data/lib/kl/absvector.rb +0 -12
- data/lib/kl/compiler.rb +0 -360
- data/lib/kl/cons.rb +0 -51
- data/lib/kl/empty_list.rb +0 -12
- data/lib/kl/environment.rb +0 -163
- data/lib/kl/error.rb +0 -4
- data/lib/kl/internal_error.rb +0 -7
- data/lib/kl/lexer.rb +0 -186
- data/lib/kl/primitives/arithmetic.rb +0 -60
- data/lib/kl/primitives/assignments.rb +0 -15
- data/lib/kl/primitives/booleans.rb +0 -21
- data/lib/kl/primitives/error_handling.rb +0 -13
- data/lib/kl/primitives/extensions.rb +0 -12
- data/lib/kl/primitives/generic_functions.rb +0 -29
- data/lib/kl/primitives/lists.rb +0 -23
- data/lib/kl/primitives/streams.rb +0 -28
- data/lib/kl/primitives/strings.rb +0 -63
- data/lib/kl/primitives/symbols.rb +0 -18
- data/lib/kl/primitives/time.rb +0 -17
- data/lib/kl/primitives/vectors.rb +0 -36
- data/lib/kl/reader.rb +0 -46
- data/spec/kl/cons_spec.rb +0 -12
- data/spec/kl/environment_spec.rb +0 -282
- data/spec/kl/interop_spec.rb +0 -68
- data/spec/kl/lexer_spec.rb +0 -149
- data/spec/kl/primitives/generic_functions_spec.rb +0 -29
- data/spec/kl/primitives/symbols_spec.rb +0 -21
- data/spec/kl/reader_spec.rb +0 -42
@@ -1,11 +1,11 @@
|
|
1
|
-
(if-without-checking "switch on the typechecker first!~%")
|
2
|
-
|
3
|
-
(datatype fruit
|
4
|
-
|
5
|
-
if (element? Fruit [cherry pear orange pineapple lemon])
|
6
|
-
_____________
|
7
|
-
Fruit : fruit;)
|
8
|
-
|
9
|
-
|
10
|
-
|
11
|
-
|
1
|
+
(if-without-checking "switch on the typechecker first!~%")
|
2
|
+
|
3
|
+
(datatype fruit
|
4
|
+
|
5
|
+
if (element? Fruit [cherry pear orange pineapple lemon])
|
6
|
+
_____________
|
7
|
+
Fruit : fruit;)
|
8
|
+
|
9
|
+
|
10
|
+
|
11
|
+
|
@@ -1,240 +1,240 @@
|
|
1
|
-
(synonyms
|
2
|
-
card (rank * suit)
|
3
|
-
cscore number
|
4
|
-
pscore number )
|
5
|
-
|
6
|
-
(datatype rank
|
7
|
-
|
8
|
-
if (element? Rank [2 3 4 5 6 7 8 9 10 11 12 13 14])
|
9
|
-
___________________________________________________
|
10
|
-
Rank : rank;
|
11
|
-
|
12
|
-
Rank : rank;
|
13
|
-
___________
|
14
|
-
Rank : number;)
|
15
|
-
|
16
|
-
(datatype suit
|
17
|
-
|
18
|
-
if (element? Suit [c d h s])
|
19
|
-
____________________________
|
20
|
-
Suit : suit;)
|
21
|
-
|
22
|
-
(datatype lead
|
23
|
-
|
24
|
-
if (element? L [player computer])
|
25
|
-
_________________________________
|
26
|
-
L : lead;)
|
27
|
-
|
28
|
-
(define whist
|
29
|
-
{lead --> string}
|
30
|
-
Lead -> (whist-loop (deal-whist 13 (deck _) (@p [] [])) 0 0 Lead))
|
31
|
-
|
32
|
-
(define deck
|
33
|
-
{A --> (list card)}
|
34
|
-
_ -> (cartprod [2 3 4 5 6 7 8 9 10 11 12 13 14] [c d h s]))
|
35
|
-
|
36
|
-
(define cartprod
|
37
|
-
{(list A) --> (list B) --> (list (A * B))}
|
38
|
-
[] _ -> []
|
39
|
-
[X | Y] Z -> (append (map (/. W (@p X W)) Z) (cartprod Y Z)))
|
40
|
-
|
41
|
-
(define deal-whist
|
42
|
-
{number --> (list card) --> ((list card) * (list card)) --> ((list card) * (list card))}
|
43
|
-
0 _ (@p Computer Player) -> (@p Computer Player)
|
44
|
-
N Deck (@p Computer Player)
|
45
|
-
-> (let CCard (deal-card Deck)
|
46
|
-
Deck-1 (remove CCard Deck)
|
47
|
-
PCard (deal-card Deck-1)
|
48
|
-
Deck-2 (remove PCard Deck-1)
|
49
|
-
(deal-whist (- N 1) Deck-2 (@p [CCard | Computer] [PCard | Player]))))
|
50
|
-
|
51
|
-
(define deal-card
|
52
|
-
{(list card) --> card}
|
53
|
-
Cards -> (nth (+ (random (length Cards)) 1) Cards))
|
54
|
-
|
55
|
-
(define random
|
56
|
-
{A --> A}
|
57
|
-
X -> X)
|
58
|
-
|
59
|
-
(define whist-loop
|
60
|
-
{((list card) * (list card)) --> cscore --> pscore --> lead --> string}
|
61
|
-
Hands Cscore Pscore _
|
62
|
-
-> (if (> Cscore Pscore)
|
63
|
-
(output "~%Computer tricks: ~A, Player tricks: ~A; ~%Computer wins!~%"
|
64
|
-
Cscore Pscore)
|
65
|
-
(output "~%Computer tricks: ~A, Player tricks: ~A; ~%You win!~%"
|
66
|
-
Cscore Pscore))
|
67
|
-
where (game-over? Hands)
|
68
|
-
(@p Computer Player) Cscore Pscore computer
|
69
|
-
-> (let Ccard (computer-shows (play-computer-lead Computer))
|
70
|
-
Pcard (determine-legal (play-player Player) Ccard Player)
|
71
|
-
Winner (return-winner (determine-winner Ccard Pcard computer))
|
72
|
-
Computer-1 (remove Ccard Computer)
|
73
|
-
Player-1 (remove Pcard Player)
|
74
|
-
(if (= Winner computer)
|
75
|
-
(whist-loop (@p Computer-1 Player-1)
|
76
|
-
(+ 1 Cscore)
|
77
|
-
Pscore
|
78
|
-
computer)
|
79
|
-
(whist-loop (@p Computer-1 Player-1)
|
80
|
-
Cscore
|
81
|
-
(+ Pscore 1)
|
82
|
-
player)))
|
83
|
-
(@p Computer Player) Cscore Pscore player
|
84
|
-
-> (let Pcard (play-player Player)
|
85
|
-
Ccard (computer-shows (play-computer-follow Computer Pcard))
|
86
|
-
Winner (return-winner (determine-winner Ccard Pcard player))
|
87
|
-
Computer-1 (remove Ccard Computer)
|
88
|
-
Player-1 (remove Pcard Player)
|
89
|
-
(if (= Winner computer)
|
90
|
-
(whist-loop (@p Computer-1 Player-1)
|
91
|
-
(+ 1 Cscore)
|
92
|
-
Pscore
|
93
|
-
computer)
|
94
|
-
(whist-loop (@p Computer-1 Player-1)
|
95
|
-
Cscore
|
96
|
-
(+ Pscore 1)
|
97
|
-
player))))
|
98
|
-
|
99
|
-
(define determine-legal
|
100
|
-
{card --> card --> (list card) --> card}
|
101
|
-
Pcard Ccard Player -> Pcard where (legal? Pcard Ccard Player)
|
102
|
-
_ Ccard Player -> (do (output "You must follow suit!" [])
|
103
|
-
(determine-legal (play-player Player)
|
104
|
-
Ccard
|
105
|
-
Player)))
|
106
|
-
|
107
|
-
(define legal?
|
108
|
-
{card --> card --> (list card) --> boolean}
|
109
|
-
(@p _ Suit) (@p _ Suit) _ -> true
|
110
|
-
_ (@p _ Suit) Player -> (void-of-suit? Suit Player))
|
111
|
-
|
112
|
-
(define void-of-suit?
|
113
|
-
{suit --> (list card) --> boolean}
|
114
|
-
Suit Player -> (empty? (same-suit Player Suit)))
|
115
|
-
|
116
|
-
(define same-suit
|
117
|
-
{(list card) --> suit --> (list card)}
|
118
|
-
[] _ -> []
|
119
|
-
[(@p Rank Suit) | Cards] Suit -> [(@p Rank Suit) | (same-suit Cards Suit)]
|
120
|
-
[_ | Cards] Suit -> (same-suit Cards Suit))
|
121
|
-
|
122
|
-
(define determine-winner
|
123
|
-
{card --> card --> lead --> lead}
|
124
|
-
(@p Rank1 Suit) (@p Rank2 Suit) _ -> (if (> Rank1 Rank2) computer player)
|
125
|
-
_ _ Lead -> Lead)
|
126
|
-
|
127
|
-
(define return-winner
|
128
|
-
{lead --> lead}
|
129
|
-
computer -> (do (output "~%Computer wins the trick.~%____________________________________________~%" [])
|
130
|
-
computer)
|
131
|
-
player -> (do (output "~%Player wins the trick.~%____________________________________________~%" [])
|
132
|
-
player))
|
133
|
-
|
134
|
-
(define game-over?
|
135
|
-
{((list card) * (list card)) --> boolean}
|
136
|
-
(@p [] []) -> true
|
137
|
-
_ -> false)
|
138
|
-
|
139
|
-
(define play-computer-lead
|
140
|
-
{(list card) --> card}
|
141
|
-
Cards -> (select-highest Cards))
|
142
|
-
|
143
|
-
(define computer-shows
|
144
|
-
{card --> card}
|
145
|
-
(@p Rank Suit) -> (do (output "~%Computer plays the ~A of ~A~%"
|
146
|
-
(map-rank Rank) (map-suit Suit))
|
147
|
-
(@p Rank Suit)))
|
148
|
-
|
149
|
-
(define map-rank
|
150
|
-
{rank --> string}
|
151
|
-
14 -> "ace"
|
152
|
-
13 -> "king"
|
153
|
-
12 -> "queen"
|
154
|
-
11 -> "jack"
|
155
|
-
N -> (make-string "~A" N))
|
156
|
-
|
157
|
-
(define map-suit
|
158
|
-
{suit --> string}
|
159
|
-
c -> "c#5;"
|
160
|
-
d -> "c#4;"
|
161
|
-
h -> "c#3;"
|
162
|
-
s -> "c#6;")
|
163
|
-
|
164
|
-
(define select-highest
|
165
|
-
{(list card) --> card}
|
166
|
-
[Card | Cards] -> (select-highest-help Card Cards))
|
167
|
-
|
168
|
-
(define select-highest-help
|
169
|
-
{card --> (list card) --> card}
|
170
|
-
Card [] -> Card
|
171
|
-
Card1 [Card2 | Cards]
|
172
|
-
-> (select-highest-help Card2 Cards) where (higher? Card2 Card1)
|
173
|
-
Card [_ | Cards] -> (select-highest-help Card Cards))
|
174
|
-
|
175
|
-
(define higher?
|
176
|
-
{card --> card --> boolean}
|
177
|
-
(@p Rank1 _) (@p Rank2 _) -> (> Rank1 Rank2))
|
178
|
-
|
179
|
-
(define play-computer-follow
|
180
|
-
{(list card) --> card --> card}
|
181
|
-
Cards (@p Rank Suit)
|
182
|
-
-> (let FollowSuit (sort lower? (same-suit Cards Suit))
|
183
|
-
(if (empty? FollowSuit)
|
184
|
-
(select-lowest Cards)
|
185
|
-
(let Ccard (select-higher (@p Rank Suit) FollowSuit)
|
186
|
-
(if (= (determine-winner Ccard (@p Rank Suit) player) computer)
|
187
|
-
Ccard
|
188
|
-
(head FollowSuit))))))
|
189
|
-
|
190
|
-
(define sort
|
191
|
-
{(A --> A --> boolean) --> (list A) --> (list A)}
|
192
|
-
R X -> (fix (/. Y (sort-help R Y)) X))
|
193
|
-
|
194
|
-
(define sort-help
|
195
|
-
{(A --> A --> boolean) --> (list A) --> (list A)}
|
196
|
-
_ [] -> []
|
197
|
-
_ [X] -> [X]
|
198
|
-
R [X Y | Z] -> [Y | (sort-help R [X | Z])] where (R Y X)
|
199
|
-
R [X | Y] -> [X | (sort-help R Y)])
|
200
|
-
|
201
|
-
(define select-higher
|
202
|
-
{card --> (list card) --> card}
|
203
|
-
_ [Card] -> Card
|
204
|
-
Card1 [Card2 | _] -> Card2 where (higher? Card2 Card1)
|
205
|
-
Card [_ | Cards] -> (select-higher Card Cards))
|
206
|
-
|
207
|
-
(define select-lowest
|
208
|
-
{(list card) --> card}
|
209
|
-
[Card | Cards] -> (select-lowest-help Card Cards))
|
210
|
-
|
211
|
-
(define select-lowest-help
|
212
|
-
{card --> (list card) --> card}
|
213
|
-
Card [] -> Card
|
214
|
-
Card1 [Card2 | Cards]
|
215
|
-
-> (select-lowest-help Card2 Cards) where (lower? Card2 Card1)
|
216
|
-
Card [_ | Cards] -> (select-lowest-help Card Cards))
|
217
|
-
|
218
|
-
(define lower?
|
219
|
-
{card --> card --> boolean}
|
220
|
-
(@p Rank1 _) (@p Rank2 _) -> (< Rank1 Rank2))
|
221
|
-
|
222
|
-
(define play-player
|
223
|
-
{(list card) --> card}
|
224
|
-
Cards -> (do (output "~%Your hand is ~%~%")
|
225
|
-
(show-cards 1 Cards)
|
226
|
-
(let N (input+ number)
|
227
|
-
(if (in-range? N Cards)
|
228
|
-
(nth N Cards)
|
229
|
-
(play-player Cards)))))
|
230
|
-
|
231
|
-
(define show-cards
|
232
|
-
{number --> (list card) --> string}
|
233
|
-
_ [] -> (output "~%~%Choose a Card: ")
|
234
|
-
N [(@p Rank Suit) | Cards]
|
235
|
-
-> (do (output "~%~A. ~A of ~A" N (map-rank Rank) (map-suit Suit))
|
236
|
-
(show-cards (+ N 1) Cards)))
|
237
|
-
|
238
|
-
(define in-range?
|
239
|
-
{number --> (list card) --> boolean}
|
1
|
+
(synonyms
|
2
|
+
card (rank * suit)
|
3
|
+
cscore number
|
4
|
+
pscore number )
|
5
|
+
|
6
|
+
(datatype rank
|
7
|
+
|
8
|
+
if (element? Rank [2 3 4 5 6 7 8 9 10 11 12 13 14])
|
9
|
+
___________________________________________________
|
10
|
+
Rank : rank;
|
11
|
+
|
12
|
+
Rank : rank;
|
13
|
+
___________
|
14
|
+
Rank : number;)
|
15
|
+
|
16
|
+
(datatype suit
|
17
|
+
|
18
|
+
if (element? Suit [c d h s])
|
19
|
+
____________________________
|
20
|
+
Suit : suit;)
|
21
|
+
|
22
|
+
(datatype lead
|
23
|
+
|
24
|
+
if (element? L [player computer])
|
25
|
+
_________________________________
|
26
|
+
L : lead;)
|
27
|
+
|
28
|
+
(define whist
|
29
|
+
{lead --> string}
|
30
|
+
Lead -> (whist-loop (deal-whist 13 (deck _) (@p [] [])) 0 0 Lead))
|
31
|
+
|
32
|
+
(define deck
|
33
|
+
{A --> (list card)}
|
34
|
+
_ -> (cartprod [2 3 4 5 6 7 8 9 10 11 12 13 14] [c d h s]))
|
35
|
+
|
36
|
+
(define cartprod
|
37
|
+
{(list A) --> (list B) --> (list (A * B))}
|
38
|
+
[] _ -> []
|
39
|
+
[X | Y] Z -> (append (map (/. W (@p X W)) Z) (cartprod Y Z)))
|
40
|
+
|
41
|
+
(define deal-whist
|
42
|
+
{number --> (list card) --> ((list card) * (list card)) --> ((list card) * (list card))}
|
43
|
+
0 _ (@p Computer Player) -> (@p Computer Player)
|
44
|
+
N Deck (@p Computer Player)
|
45
|
+
-> (let CCard (deal-card Deck)
|
46
|
+
Deck-1 (remove CCard Deck)
|
47
|
+
PCard (deal-card Deck-1)
|
48
|
+
Deck-2 (remove PCard Deck-1)
|
49
|
+
(deal-whist (- N 1) Deck-2 (@p [CCard | Computer] [PCard | Player]))))
|
50
|
+
|
51
|
+
(define deal-card
|
52
|
+
{(list card) --> card}
|
53
|
+
Cards -> (nth (+ (random (length Cards)) 1) Cards))
|
54
|
+
|
55
|
+
(define random
|
56
|
+
{A --> A}
|
57
|
+
X -> X)
|
58
|
+
|
59
|
+
(define whist-loop
|
60
|
+
{((list card) * (list card)) --> cscore --> pscore --> lead --> string}
|
61
|
+
Hands Cscore Pscore _
|
62
|
+
-> (if (> Cscore Pscore)
|
63
|
+
(output "~%Computer tricks: ~A, Player tricks: ~A; ~%Computer wins!~%"
|
64
|
+
Cscore Pscore)
|
65
|
+
(output "~%Computer tricks: ~A, Player tricks: ~A; ~%You win!~%"
|
66
|
+
Cscore Pscore))
|
67
|
+
where (game-over? Hands)
|
68
|
+
(@p Computer Player) Cscore Pscore computer
|
69
|
+
-> (let Ccard (computer-shows (play-computer-lead Computer))
|
70
|
+
Pcard (determine-legal (play-player Player) Ccard Player)
|
71
|
+
Winner (return-winner (determine-winner Ccard Pcard computer))
|
72
|
+
Computer-1 (remove Ccard Computer)
|
73
|
+
Player-1 (remove Pcard Player)
|
74
|
+
(if (= Winner computer)
|
75
|
+
(whist-loop (@p Computer-1 Player-1)
|
76
|
+
(+ 1 Cscore)
|
77
|
+
Pscore
|
78
|
+
computer)
|
79
|
+
(whist-loop (@p Computer-1 Player-1)
|
80
|
+
Cscore
|
81
|
+
(+ Pscore 1)
|
82
|
+
player)))
|
83
|
+
(@p Computer Player) Cscore Pscore player
|
84
|
+
-> (let Pcard (play-player Player)
|
85
|
+
Ccard (computer-shows (play-computer-follow Computer Pcard))
|
86
|
+
Winner (return-winner (determine-winner Ccard Pcard player))
|
87
|
+
Computer-1 (remove Ccard Computer)
|
88
|
+
Player-1 (remove Pcard Player)
|
89
|
+
(if (= Winner computer)
|
90
|
+
(whist-loop (@p Computer-1 Player-1)
|
91
|
+
(+ 1 Cscore)
|
92
|
+
Pscore
|
93
|
+
computer)
|
94
|
+
(whist-loop (@p Computer-1 Player-1)
|
95
|
+
Cscore
|
96
|
+
(+ Pscore 1)
|
97
|
+
player))))
|
98
|
+
|
99
|
+
(define determine-legal
|
100
|
+
{card --> card --> (list card) --> card}
|
101
|
+
Pcard Ccard Player -> Pcard where (legal? Pcard Ccard Player)
|
102
|
+
_ Ccard Player -> (do (output "You must follow suit!" [])
|
103
|
+
(determine-legal (play-player Player)
|
104
|
+
Ccard
|
105
|
+
Player)))
|
106
|
+
|
107
|
+
(define legal?
|
108
|
+
{card --> card --> (list card) --> boolean}
|
109
|
+
(@p _ Suit) (@p _ Suit) _ -> true
|
110
|
+
_ (@p _ Suit) Player -> (void-of-suit? Suit Player))
|
111
|
+
|
112
|
+
(define void-of-suit?
|
113
|
+
{suit --> (list card) --> boolean}
|
114
|
+
Suit Player -> (empty? (same-suit Player Suit)))
|
115
|
+
|
116
|
+
(define same-suit
|
117
|
+
{(list card) --> suit --> (list card)}
|
118
|
+
[] _ -> []
|
119
|
+
[(@p Rank Suit) | Cards] Suit -> [(@p Rank Suit) | (same-suit Cards Suit)]
|
120
|
+
[_ | Cards] Suit -> (same-suit Cards Suit))
|
121
|
+
|
122
|
+
(define determine-winner
|
123
|
+
{card --> card --> lead --> lead}
|
124
|
+
(@p Rank1 Suit) (@p Rank2 Suit) _ -> (if (> Rank1 Rank2) computer player)
|
125
|
+
_ _ Lead -> Lead)
|
126
|
+
|
127
|
+
(define return-winner
|
128
|
+
{lead --> lead}
|
129
|
+
computer -> (do (output "~%Computer wins the trick.~%____________________________________________~%" [])
|
130
|
+
computer)
|
131
|
+
player -> (do (output "~%Player wins the trick.~%____________________________________________~%" [])
|
132
|
+
player))
|
133
|
+
|
134
|
+
(define game-over?
|
135
|
+
{((list card) * (list card)) --> boolean}
|
136
|
+
(@p [] []) -> true
|
137
|
+
_ -> false)
|
138
|
+
|
139
|
+
(define play-computer-lead
|
140
|
+
{(list card) --> card}
|
141
|
+
Cards -> (select-highest Cards))
|
142
|
+
|
143
|
+
(define computer-shows
|
144
|
+
{card --> card}
|
145
|
+
(@p Rank Suit) -> (do (output "~%Computer plays the ~A of ~A~%"
|
146
|
+
(map-rank Rank) (map-suit Suit))
|
147
|
+
(@p Rank Suit)))
|
148
|
+
|
149
|
+
(define map-rank
|
150
|
+
{rank --> string}
|
151
|
+
14 -> "ace"
|
152
|
+
13 -> "king"
|
153
|
+
12 -> "queen"
|
154
|
+
11 -> "jack"
|
155
|
+
N -> (make-string "~A" N))
|
156
|
+
|
157
|
+
(define map-suit
|
158
|
+
{suit --> string}
|
159
|
+
c -> "c#5;"
|
160
|
+
d -> "c#4;"
|
161
|
+
h -> "c#3;"
|
162
|
+
s -> "c#6;")
|
163
|
+
|
164
|
+
(define select-highest
|
165
|
+
{(list card) --> card}
|
166
|
+
[Card | Cards] -> (select-highest-help Card Cards))
|
167
|
+
|
168
|
+
(define select-highest-help
|
169
|
+
{card --> (list card) --> card}
|
170
|
+
Card [] -> Card
|
171
|
+
Card1 [Card2 | Cards]
|
172
|
+
-> (select-highest-help Card2 Cards) where (higher? Card2 Card1)
|
173
|
+
Card [_ | Cards] -> (select-highest-help Card Cards))
|
174
|
+
|
175
|
+
(define higher?
|
176
|
+
{card --> card --> boolean}
|
177
|
+
(@p Rank1 _) (@p Rank2 _) -> (> Rank1 Rank2))
|
178
|
+
|
179
|
+
(define play-computer-follow
|
180
|
+
{(list card) --> card --> card}
|
181
|
+
Cards (@p Rank Suit)
|
182
|
+
-> (let FollowSuit (sort lower? (same-suit Cards Suit))
|
183
|
+
(if (empty? FollowSuit)
|
184
|
+
(select-lowest Cards)
|
185
|
+
(let Ccard (select-higher (@p Rank Suit) FollowSuit)
|
186
|
+
(if (= (determine-winner Ccard (@p Rank Suit) player) computer)
|
187
|
+
Ccard
|
188
|
+
(head FollowSuit))))))
|
189
|
+
|
190
|
+
(define sort
|
191
|
+
{(A --> A --> boolean) --> (list A) --> (list A)}
|
192
|
+
R X -> (fix (/. Y (sort-help R Y)) X))
|
193
|
+
|
194
|
+
(define sort-help
|
195
|
+
{(A --> A --> boolean) --> (list A) --> (list A)}
|
196
|
+
_ [] -> []
|
197
|
+
_ [X] -> [X]
|
198
|
+
R [X Y | Z] -> [Y | (sort-help R [X | Z])] where (R Y X)
|
199
|
+
R [X | Y] -> [X | (sort-help R Y)])
|
200
|
+
|
201
|
+
(define select-higher
|
202
|
+
{card --> (list card) --> card}
|
203
|
+
_ [Card] -> Card
|
204
|
+
Card1 [Card2 | _] -> Card2 where (higher? Card2 Card1)
|
205
|
+
Card [_ | Cards] -> (select-higher Card Cards))
|
206
|
+
|
207
|
+
(define select-lowest
|
208
|
+
{(list card) --> card}
|
209
|
+
[Card | Cards] -> (select-lowest-help Card Cards))
|
210
|
+
|
211
|
+
(define select-lowest-help
|
212
|
+
{card --> (list card) --> card}
|
213
|
+
Card [] -> Card
|
214
|
+
Card1 [Card2 | Cards]
|
215
|
+
-> (select-lowest-help Card2 Cards) where (lower? Card2 Card1)
|
216
|
+
Card [_ | Cards] -> (select-lowest-help Card Cards))
|
217
|
+
|
218
|
+
(define lower?
|
219
|
+
{card --> card --> boolean}
|
220
|
+
(@p Rank1 _) (@p Rank2 _) -> (< Rank1 Rank2))
|
221
|
+
|
222
|
+
(define play-player
|
223
|
+
{(list card) --> card}
|
224
|
+
Cards -> (do (output "~%Your hand is ~%~%")
|
225
|
+
(show-cards 1 Cards)
|
226
|
+
(let N (input+ number)
|
227
|
+
(if (in-range? N Cards)
|
228
|
+
(nth N Cards)
|
229
|
+
(play-player Cards)))))
|
230
|
+
|
231
|
+
(define show-cards
|
232
|
+
{number --> (list card) --> string}
|
233
|
+
_ [] -> (output "~%~%Choose a Card: ")
|
234
|
+
N [(@p Rank Suit) | Cards]
|
235
|
+
-> (do (output "~%~A. ~A of ~A" N (map-rank Rank) (map-suit Suit))
|
236
|
+
(show-cards (+ N 1) Cards)))
|
237
|
+
|
238
|
+
(define in-range?
|
239
|
+
{number --> (list card) --> boolean}
|
240
240
|
N Cards -> (and (integer? N) (and (> N 0) (<= N (length Cards)))))
|