shen-ruby 0.1.0

Sign up to get free protection for your applications and to get access to all the features.
Files changed (117) hide show
  1. data/.gitignore +4 -0
  2. data/.rspec +0 -0
  3. data/Gemfile +6 -0
  4. data/Gemfile.lock +20 -0
  5. data/MIT_LICENSE.txt +26 -0
  6. data/README.md +94 -0
  7. data/bin/shen_test_suite.rb +9 -0
  8. data/bin/srrepl +23 -0
  9. data/lib/kl.rb +7 -0
  10. data/lib/kl/absvector.rb +12 -0
  11. data/lib/kl/compiler.rb +253 -0
  12. data/lib/kl/cons.rb +51 -0
  13. data/lib/kl/empty_list.rb +12 -0
  14. data/lib/kl/environment.rb +123 -0
  15. data/lib/kl/error.rb +4 -0
  16. data/lib/kl/internal_error.rb +7 -0
  17. data/lib/kl/lexer.rb +186 -0
  18. data/lib/kl/primitives/arithmetic.rb +60 -0
  19. data/lib/kl/primitives/assignments.rb +18 -0
  20. data/lib/kl/primitives/booleans.rb +17 -0
  21. data/lib/kl/primitives/error_handling.rb +13 -0
  22. data/lib/kl/primitives/generic_functions.rb +22 -0
  23. data/lib/kl/primitives/lists.rb +21 -0
  24. data/lib/kl/primitives/streams.rb +38 -0
  25. data/lib/kl/primitives/strings.rb +55 -0
  26. data/lib/kl/primitives/symbols.rb +17 -0
  27. data/lib/kl/primitives/time.rb +17 -0
  28. data/lib/kl/primitives/vectors.rb +30 -0
  29. data/lib/kl/reader.rb +40 -0
  30. data/lib/kl/trampoline.rb +14 -0
  31. data/lib/shen_ruby.rb +7 -0
  32. data/lib/shen_ruby/version.rb +3 -0
  33. data/shen-ruby.gemspec +26 -0
  34. data/shen/README.txt +17 -0
  35. data/shen/lib/shen_ruby/shen.rb +124 -0
  36. data/shen/license.txt +34 -0
  37. data/shen/release/benchmarks/N_queens.shen +45 -0
  38. data/shen/release/benchmarks/README.shen +14 -0
  39. data/shen/release/benchmarks/benchmarks.shen +56 -0
  40. data/shen/release/benchmarks/bigprog +2173 -0
  41. data/shen/release/benchmarks/br.shen +13 -0
  42. data/shen/release/benchmarks/einstein.shen +33 -0
  43. data/shen/release/benchmarks/heatwave.gif +0 -0
  44. data/shen/release/benchmarks/interpreter.shen +219 -0
  45. data/shen/release/benchmarks/picture.jpg +0 -0
  46. data/shen/release/benchmarks/plato.jpg +0 -0
  47. data/shen/release/benchmarks/powerset.shen +10 -0
  48. data/shen/release/benchmarks/prime.shen +10 -0
  49. data/shen/release/benchmarks/short.shen +129 -0
  50. data/shen/release/benchmarks/text.txt +68 -0
  51. data/shen/release/k_lambda/core.kl +1002 -0
  52. data/shen/release/k_lambda/declarations.kl +1021 -0
  53. data/shen/release/k_lambda/load.kl +94 -0
  54. data/shen/release/k_lambda/macros.kl +479 -0
  55. data/shen/release/k_lambda/prolog.kl +1309 -0
  56. data/shen/release/k_lambda/reader.kl +1058 -0
  57. data/shen/release/k_lambda/sequent.kl +556 -0
  58. data/shen/release/k_lambda/sys.kl +582 -0
  59. data/shen/release/k_lambda/t-star.kl +3493 -0
  60. data/shen/release/k_lambda/toplevel.kl +223 -0
  61. data/shen/release/k_lambda/track.kl +208 -0
  62. data/shen/release/k_lambda/types.kl +455 -0
  63. data/shen/release/k_lambda/writer.kl +108 -0
  64. data/shen/release/k_lambda/yacc.kl +280 -0
  65. data/shen/release/test_programs/Chap13/problems.txt +26 -0
  66. data/shen/release/test_programs/README.shen +53 -0
  67. data/shen/release/test_programs/TinyLispFunctions.txt +16 -0
  68. data/shen/release/test_programs/TinyTypes.shen +55 -0
  69. data/shen/release/test_programs/binary.shen +24 -0
  70. data/shen/release/test_programs/bubble_version_1.shen +28 -0
  71. data/shen/release/test_programs/bubble_version_2.shen +22 -0
  72. data/shen/release/test_programs/calculator.shen +21 -0
  73. data/shen/release/test_programs/cartprod.shen +23 -0
  74. data/shen/release/test_programs/change.shen +25 -0
  75. data/shen/release/test_programs/classes-defaults.shen +94 -0
  76. data/shen/release/test_programs/classes-inheritance.shen +100 -0
  77. data/shen/release/test_programs/classes-typed.shen +74 -0
  78. data/shen/release/test_programs/classes-untyped.shen +46 -0
  79. data/shen/release/test_programs/depth_.shen +14 -0
  80. data/shen/release/test_programs/einstein.shen +33 -0
  81. data/shen/release/test_programs/fruit_machine.shen +46 -0
  82. data/shen/release/test_programs/interpreter.shen +219 -0
  83. data/shen/release/test_programs/metaprog.shen +85 -0
  84. data/shen/release/test_programs/minim.shen +193 -0
  85. data/shen/release/test_programs/mutual.shen +11 -0
  86. data/shen/release/test_programs/n_queens.shen +45 -0
  87. data/shen/release/test_programs/newton_version_1.shen +33 -0
  88. data/shen/release/test_programs/newton_version_2.shen +24 -0
  89. data/shen/release/test_programs/parse.prl +14 -0
  90. data/shen/release/test_programs/parser.shen +52 -0
  91. data/shen/release/test_programs/powerset.shen +10 -0
  92. data/shen/release/test_programs/prime.shen +10 -0
  93. data/shen/release/test_programs/proof_assistant.shen +81 -0
  94. data/shen/release/test_programs/proplog_version_1.shen +25 -0
  95. data/shen/release/test_programs/proplog_version_2.shen +27 -0
  96. data/shen/release/test_programs/qmachine.shen +67 -0
  97. data/shen/release/test_programs/red-black.shen +55 -0
  98. data/shen/release/test_programs/search.shen +56 -0
  99. data/shen/release/test_programs/semantic_net.shen +44 -0
  100. data/shen/release/test_programs/spreadsheet.shen +35 -0
  101. data/shen/release/test_programs/stack.shen +27 -0
  102. data/shen/release/test_programs/streams.shen +20 -0
  103. data/shen/release/test_programs/strings.shen +59 -0
  104. data/shen/release/test_programs/structures-typed.shen +71 -0
  105. data/shen/release/test_programs/structures-untyped.shen +42 -0
  106. data/shen/release/test_programs/tests.shen +294 -0
  107. data/shen/release/test_programs/types.shen +11 -0
  108. data/shen/release/test_programs/whist.shen +240 -0
  109. data/shen/release/test_programs/yacc.shen +136 -0
  110. data/spec/kl/cons_spec.rb +12 -0
  111. data/spec/kl/environment_spec.rb +306 -0
  112. data/spec/kl/lexer_spec.rb +149 -0
  113. data/spec/kl/primitives/generic_functions_spec.rb +29 -0
  114. data/spec/kl/primitives/symbols_spec.rb +21 -0
  115. data/spec/kl/reader_spec.rb +36 -0
  116. data/spec/spec_helper.rb +2 -0
  117. metadata +189 -0
@@ -0,0 +1,1309 @@
1
+
2
+ " The License
3
+
4
+ The user is free to produce commercial applications with the software, to distribute these applications in source or binary form, and to charge monies for them as he sees fit and in concordance with the laws of the land subject to the following license.
5
+
6
+ 1. The license applies to all the software and all derived software and must appear on such.
7
+ 2. It is illegal to distribute the software without this license attached to it and use of the software implies agreement
8
+ with the license as such. It is illegal for anyone who is not the copyright holder to tamper with or change the license.
9
+ 3. Neither the names of Lambda Associates or the copyright holder may be used to endorse or promote products built using
10
+ the software without specific prior written permission from the copyright holder.
11
+ 4. That possession of this license does not confer on the copyright holder any special contractual obligation towards the user. That in no event shall the copyright holder be liable for any direct, indirect, incidental, special, exemplary or consequential damages (including but not limited to procurement of substitute goods or services, loss of use, data, or profits; or business interruption), however caused and on any theory of liability, whether in contract, strict liability or tort (including negligence) arising in any way out of the use of the software, even if advised of the possibility of such damage.
12
+ 5. It is permitted for the user to change the software, for the purpose of improving performance, correcting an error, or porting to a new platform, and distribute the modified version of Shen (hereafter the modified version) provided the resulting program conforms in all respects to the Shen standard and is issued under that title. The user must make it clear with his distribution that he/she is the author of the changes and what these changes are and why.
13
+ 6. Derived versions of this software in whatever form are subject to the same restrictions. In particular it is not permitted to make derived copies of this software which do not conform to the Shen standard or appear under a different title.
14
+ 7. It is permitted to distribute versions of Shen which incorporate libraries, graphics or other facilities which are not part of the Shen standard.
15
+
16
+ For an explication of this license see http://www.lambdassociates.org/News/june11/license.htm which explains this license in full."
17
+
18
+ (defun shen-<defprolog> (V1168)
19
+ (let Result
20
+ (let Parse_<predicate*> (shen-<predicate*> V1168)
21
+ (if (not (= (fail) Parse_<predicate*>))
22
+ (let Parse_<clauses*> (shen-<clauses*> Parse_<predicate*>)
23
+ (if (not (= (fail) Parse_<clauses*>))
24
+ (shen-reassemble (fst Parse_<clauses*>)
25
+ (hd
26
+ (shen-prolog->shen
27
+ (map (lambda X (shen-insert-predicate (snd Parse_<predicate*>) X))
28
+ (snd Parse_<clauses*>)))))
29
+ (fail)))
30
+ (fail)))
31
+ (if (= Result (fail)) (fail) Result)))
32
+
33
+ (defun shen-prolog-error (V1169 V1170)
34
+ (interror "prolog syntax error in ~A here:~%~% ~A~%"
35
+ (@p V1169 (@p (shen-next-50 50 V1170) ()))))
36
+
37
+ (defun shen-next-50 (V1175 V1176)
38
+ (cond ((= () V1176) "") ((= 0 V1175) "")
39
+ ((cons? V1176)
40
+ (cn (shen-decons-string (hd V1176)) (shen-next-50 (- V1175 1) (tl V1176))))
41
+ (true (shen-sys-error shen-next-50))))
42
+
43
+ (defun shen-decons-string (V1177)
44
+ (cond
45
+ ((and (cons? V1177)
46
+ (and (= cons (hd V1177))
47
+ (and (cons? (tl V1177))
48
+ (and (cons? (tl (tl V1177))) (= () (tl (tl (tl V1177))))))))
49
+ (intmake-string "~S " (@p (shen-eval-cons V1177) ())))
50
+ (true (intmake-string "~R " (@p V1177 ())))))
51
+
52
+ (defun shen-insert-predicate (V1178 V1179)
53
+ (cond
54
+ ((and (cons? V1179) (and (cons? (tl V1179)) (= () (tl (tl V1179)))))
55
+ (cons (cons V1178 (hd V1179)) (cons :- (tl V1179))))
56
+ (true (shen-sys-error shen-insert-predicate))))
57
+
58
+ (defun shen-<predicate*> (V1180)
59
+ (let Result
60
+ (if (cons? (fst V1180))
61
+ (shen-reassemble (fst (shen-reassemble (tl (fst V1180)) (snd V1180)))
62
+ (hd (fst V1180)))
63
+ (fail))
64
+ (if (= Result (fail)) (fail) Result)))
65
+
66
+ (defun shen-<clauses*> (V1181)
67
+ (let Result
68
+ (let Parse_<clause*> (shen-<clause*> V1181)
69
+ (if (not (= (fail) Parse_<clause*>))
70
+ (let Parse_<clauses*> (shen-<clauses*> Parse_<clause*>)
71
+ (if (not (= (fail) Parse_<clauses*>))
72
+ (shen-reassemble (fst Parse_<clauses*>)
73
+ (cons (snd Parse_<clause*>) (snd Parse_<clauses*>)))
74
+ (fail)))
75
+ (fail)))
76
+ (if (= Result (fail))
77
+ (let Result
78
+ (let Parse_<e> (<e> V1181)
79
+ (if (not (= (fail) Parse_<e>))
80
+ (shen-reassemble (fst Parse_<e>) (snd Parse_<e>)) (fail)))
81
+ (if (= Result (fail)) (fail) Result))
82
+ Result)))
83
+
84
+ (defun shen-<clause*> (V1182)
85
+ (let Result
86
+ (let Parse_<head*> (shen-<head*> V1182)
87
+ (if (not (= (fail) Parse_<head*>))
88
+ (if (and (cons? (fst Parse_<head*>)) (= <-- (hd (fst Parse_<head*>))))
89
+ (let Parse_<body*>
90
+ (shen-<body*>
91
+ (shen-reassemble (tl (fst Parse_<head*>)) (snd Parse_<head*>)))
92
+ (if (not (= (fail) Parse_<body*>))
93
+ (let Parse_<end*> (shen-<end*> Parse_<body*>)
94
+ (if (not (= (fail) Parse_<end*>))
95
+ (shen-reassemble (fst Parse_<end*>)
96
+ (cons (snd Parse_<head*>) (cons (snd Parse_<body*>) ())))
97
+ (fail)))
98
+ (fail)))
99
+ (fail))
100
+ (fail)))
101
+ (if (= Result (fail)) (fail) Result)))
102
+
103
+ (defun shen-<head*> (V1183)
104
+ (let Result
105
+ (let Parse_<term*> (shen-<term*> V1183)
106
+ (if (not (= (fail) Parse_<term*>))
107
+ (let Parse_<head*> (shen-<head*> Parse_<term*>)
108
+ (if (not (= (fail) Parse_<head*>))
109
+ (shen-reassemble (fst Parse_<head*>)
110
+ (cons (snd Parse_<term*>) (snd Parse_<head*>)))
111
+ (fail)))
112
+ (fail)))
113
+ (if (= Result (fail))
114
+ (let Result
115
+ (let Parse_<e> (<e> V1183)
116
+ (if (not (= (fail) Parse_<e>))
117
+ (shen-reassemble (fst Parse_<e>) (snd Parse_<e>)) (fail)))
118
+ (if (= Result (fail)) (fail) Result))
119
+ Result)))
120
+
121
+ (defun shen-<term*> (V1184)
122
+ (let Result
123
+ (if (cons? (fst V1184))
124
+ (shen-reassemble (fst (shen-reassemble (tl (fst V1184)) (snd V1184)))
125
+ (if
126
+ (and (not (= <-- (hd (fst V1184))))
127
+ (shen-legitimate-term? (hd (fst V1184))))
128
+ (shen-eval-cons (hd (fst V1184))) (fail)))
129
+ (fail))
130
+ (if (= Result (fail)) (fail) Result)))
131
+
132
+ (defun shen-legitimate-term? (V1189)
133
+ (cond
134
+ ((and (cons? V1189)
135
+ (and (= cons (hd V1189))
136
+ (and (cons? (tl V1189))
137
+ (and (cons? (tl (tl V1189))) (= () (tl (tl (tl V1189))))))))
138
+ (and (shen-legitimate-term? (hd (tl V1189)))
139
+ (shen-legitimate-term? (hd (tl (tl V1189))))))
140
+ ((and (cons? V1189)
141
+ (and (= mode (hd V1189))
142
+ (and (cons? (tl V1189))
143
+ (and (cons? (tl (tl V1189)))
144
+ (and (= + (hd (tl (tl V1189)))) (= () (tl (tl (tl V1189)))))))))
145
+ (shen-legitimate-term? (hd (tl V1189))))
146
+ ((and (cons? V1189)
147
+ (and (= mode (hd V1189))
148
+ (and (cons? (tl V1189))
149
+ (and (cons? (tl (tl V1189)))
150
+ (and (= - (hd (tl (tl V1189)))) (= () (tl (tl (tl V1189)))))))))
151
+ (shen-legitimate-term? (hd (tl V1189))))
152
+ ((cons? V1189) false) (true true)))
153
+
154
+ (defun shen-eval-cons (V1190)
155
+ (cond
156
+ ((and (cons? V1190)
157
+ (and (= cons (hd V1190))
158
+ (and (cons? (tl V1190))
159
+ (and (cons? (tl (tl V1190))) (= () (tl (tl (tl V1190))))))))
160
+ (cons (shen-eval-cons (hd (tl V1190)))
161
+ (shen-eval-cons (hd (tl (tl V1190))))))
162
+ ((and (cons? V1190)
163
+ (and (= mode (hd V1190))
164
+ (and (cons? (tl V1190))
165
+ (and (cons? (tl (tl V1190))) (= () (tl (tl (tl V1190))))))))
166
+ (cons mode (cons (shen-eval-cons (hd (tl V1190))) (tl (tl V1190)))))
167
+ (true V1190)))
168
+
169
+ (defun shen-<body*> (V1191)
170
+ (let Result
171
+ (let Parse_<literal*> (shen-<literal*> V1191)
172
+ (if (not (= (fail) Parse_<literal*>))
173
+ (let Parse_<body*> (shen-<body*> Parse_<literal*>)
174
+ (if (not (= (fail) Parse_<body*>))
175
+ (shen-reassemble (fst Parse_<body*>)
176
+ (cons (snd Parse_<literal*>) (snd Parse_<body*>)))
177
+ (fail)))
178
+ (fail)))
179
+ (if (= Result (fail))
180
+ (let Result
181
+ (let Parse_<e> (<e> V1191)
182
+ (if (not (= (fail) Parse_<e>))
183
+ (shen-reassemble (fst Parse_<e>) (snd Parse_<e>)) (fail)))
184
+ (if (= Result (fail)) (fail) Result))
185
+ Result)))
186
+
187
+ (defun shen-<literal*> (V1192)
188
+ (let Result
189
+ (if (and (cons? (fst V1192)) (= ! (hd (fst V1192))))
190
+ (shen-reassemble (fst (shen-reassemble (tl (fst V1192)) (snd V1192)))
191
+ (cons cut (cons Throwcontrol ())))
192
+ (fail))
193
+ (if (= Result (fail))
194
+ (let Result
195
+ (if (cons? (fst V1192))
196
+ (shen-reassemble (fst (shen-reassemble (tl (fst V1192)) (snd V1192)))
197
+ (if (cons? (hd (fst V1192))) (hd (fst V1192)) (fail)))
198
+ (fail))
199
+ (if (= Result (fail)) (fail) Result))
200
+ Result)))
201
+
202
+ (defun shen-<end*> (V1193)
203
+ (let Result
204
+ (if (cons? (fst V1193))
205
+ (shen-reassemble (fst (shen-reassemble (tl (fst V1193)) (snd V1193)))
206
+ (if (= (hd (fst V1193)) ;) shen-skip (fail)))
207
+ (fail))
208
+ (if (= Result (fail)) (fail) Result)))
209
+
210
+ (defun cut (V1194 V1195 V1196)
211
+ (let Result (thaw V1196) (if (= Result false) V1194 Result)))
212
+
213
+ (defun shen-insert_modes (V1197)
214
+ (cond
215
+ ((and (cons? V1197)
216
+ (and (= mode (hd V1197))
217
+ (and (cons? (tl V1197))
218
+ (and (cons? (tl (tl V1197))) (= () (tl (tl (tl V1197))))))))
219
+ V1197)
220
+ ((= () V1197) ())
221
+ ((cons? V1197)
222
+ (cons (cons mode (cons (hd V1197) (cons + ())))
223
+ (cons mode (cons (shen-insert_modes (tl V1197)) (cons - ())))))
224
+ (true V1197)))
225
+
226
+ (defun shen-s-prolog (V1198)
227
+ (map (lambda V1199 (eval V1199)) (shen-prolog->shen V1198)))
228
+
229
+ (defun shen-prolog->shen (V1200)
230
+ (map (lambda V1201 (shen-compile_prolog_procedure V1201))
231
+ (shen-group_clauses
232
+ (map (lambda V1202 (shen-s-prolog_clause V1202))
233
+ (mapcan (lambda V1203 (shen-head_abstraction V1203)) V1200)))))
234
+
235
+ (defun shen-s-prolog_clause (V1204)
236
+ (cond
237
+ ((and (cons? V1204)
238
+ (and (cons? (tl V1204))
239
+ (and (= :- (hd (tl V1204)))
240
+ (and (cons? (tl (tl V1204))) (= () (tl (tl (tl V1204))))))))
241
+ (cons (hd V1204)
242
+ (cons :-
243
+ (cons
244
+ (map (lambda V1205 (shen-s-prolog_literal V1205)) (hd (tl (tl V1204))))
245
+ ()))))
246
+ (true (shen-sys-error shen-s-prolog_clause))))
247
+
248
+ (defun shen-head_abstraction (V1206)
249
+ (cond
250
+ ((and (cons? V1206)
251
+ (and (cons? (tl V1206))
252
+ (and (= :- (hd (tl V1206)))
253
+ (and (cons? (tl (tl V1206)))
254
+ (and (= () (tl (tl (tl V1206))))
255
+ (< (shen-complexity_head (hd V1206))
256
+ (value shen-*maxcomplexity*)))))))
257
+ (cons V1206 ()))
258
+ ((and (cons? V1206)
259
+ (and (cons? (hd V1206))
260
+ (and (cons? (tl V1206))
261
+ (and (= :- (hd (tl V1206)))
262
+ (and (cons? (tl (tl V1206))) (= () (tl (tl (tl V1206)))))))))
263
+ (let Terms (map (lambda Y (gensym V)) (tl (hd V1206)))
264
+ (let XTerms (shen-rcons_form (shen-remove_modes (tl (hd V1206))))
265
+ (let Literal (cons unify (cons (shen-cons_form Terms) (cons XTerms ())))
266
+ (let Clause
267
+ (cons (cons (hd (hd V1206)) Terms)
268
+ (cons :- (cons (cons Literal (hd (tl (tl V1206)))) ())))
269
+ (cons Clause ()))))))
270
+ (true (shen-sys-error shen-head_abstraction))))
271
+
272
+ (defun shen-complexity_head (V1211)
273
+ (cond
274
+ ((cons? V1211)
275
+ (shen-product (map (lambda V1212 (shen-complexity V1212)) (tl V1211))))
276
+ (true (shen-sys-error shen-complexity_head))))
277
+
278
+ (defun shen-complexity (V1220)
279
+ (cond
280
+ ((and (cons? V1220)
281
+ (and (= mode (hd V1220))
282
+ (and (cons? (tl V1220))
283
+ (and (cons? (hd (tl V1220)))
284
+ (and (= mode (hd (hd (tl V1220))))
285
+ (and (cons? (tl (hd (tl V1220))))
286
+ (and (cons? (tl (tl (hd (tl V1220)))))
287
+ (and (= () (tl (tl (tl (hd (tl V1220))))))
288
+ (and (cons? (tl (tl V1220)))
289
+ (= () (tl (tl (tl V1220)))))))))))))
290
+ (shen-complexity (hd (tl V1220))))
291
+ ((and (cons? V1220)
292
+ (and (= mode (hd V1220))
293
+ (and (cons? (tl V1220))
294
+ (and (cons? (hd (tl V1220)))
295
+ (and (cons? (tl (tl V1220)))
296
+ (and (= + (hd (tl (tl V1220))))
297
+ (= () (tl (tl (tl V1220))))))))))
298
+ (* 2
299
+ (*
300
+ (shen-complexity (cons mode (cons (hd (hd (tl V1220))) (tl (tl V1220)))))
301
+ (shen-complexity
302
+ (cons mode (cons (tl (hd (tl V1220))) (tl (tl V1220))))))))
303
+ ((and (cons? V1220)
304
+ (and (= mode (hd V1220))
305
+ (and (cons? (tl V1220))
306
+ (and (cons? (hd (tl V1220)))
307
+ (and (cons? (tl (tl V1220)))
308
+ (and (= - (hd (tl (tl V1220))))
309
+ (= () (tl (tl (tl V1220))))))))))
310
+ (* (shen-complexity (cons mode (cons (hd (hd (tl V1220))) (tl (tl V1220)))))
311
+ (shen-complexity (cons mode (cons (tl (hd (tl V1220))) (tl (tl V1220)))))))
312
+ ((and (cons? V1220)
313
+ (and (= mode (hd V1220))
314
+ (and (cons? (tl V1220))
315
+ (and (cons? (tl (tl V1220)))
316
+ (and (= () (tl (tl (tl V1220)))) (variable? (hd (tl V1220))))))))
317
+ 1)
318
+ ((and (cons? V1220)
319
+ (and (= mode (hd V1220))
320
+ (and (cons? (tl V1220))
321
+ (and (cons? (tl (tl V1220)))
322
+ (and (= + (hd (tl (tl V1220)))) (= () (tl (tl (tl V1220)))))))))
323
+ 2)
324
+ ((and (cons? V1220)
325
+ (and (= mode (hd V1220))
326
+ (and (cons? (tl V1220))
327
+ (and (cons? (tl (tl V1220)))
328
+ (and (= - (hd (tl (tl V1220)))) (= () (tl (tl (tl V1220)))))))))
329
+ 1)
330
+ (true (shen-complexity (cons mode (cons V1220 (cons + ())))))))
331
+
332
+ (defun shen-product (V1221)
333
+ (cond ((= () V1221) 1)
334
+ ((cons? V1221) (* (hd V1221) (shen-product (tl V1221))))
335
+ (true (shen-sys-error shen-product))))
336
+
337
+ (defun shen-s-prolog_literal (V1222)
338
+ (cond
339
+ ((and (cons? V1222)
340
+ (and (= is (hd V1222))
341
+ (and (cons? (tl V1222))
342
+ (and (cons? (tl (tl V1222))) (= () (tl (tl (tl V1222))))))))
343
+ (cons bind
344
+ (cons (hd (tl V1222))
345
+ (cons (shen-insert_deref (hd (tl (tl V1222)))) ()))))
346
+ ((and (cons? V1222)
347
+ (and (= when (hd V1222))
348
+ (and (cons? (tl V1222)) (= () (tl (tl V1222))))))
349
+ (cons fwhen (cons (shen-insert_deref (hd (tl V1222))) ())))
350
+ ((and (cons? V1222)
351
+ (and (= bind (hd V1222))
352
+ (and (cons? (tl V1222))
353
+ (and (cons? (tl (tl V1222))) (= () (tl (tl (tl V1222))))))))
354
+ (cons bind
355
+ (cons (hd (tl V1222))
356
+ (cons (shen-insert_lazyderef (hd (tl (tl V1222)))) ()))))
357
+ ((and (cons? V1222)
358
+ (and (= fwhen (hd V1222))
359
+ (and (cons? (tl V1222)) (= () (tl (tl V1222))))))
360
+ (cons fwhen (cons (shen-insert_lazyderef (hd (tl V1222))) ())))
361
+ ((cons? V1222)
362
+ (cons (shen-m_prolog_to_s-prolog_predicate (hd V1222)) (tl V1222)))
363
+ (true (shen-sys-error shen-s-prolog_literal))))
364
+
365
+ (defun shen-insert_deref (V1223)
366
+ (cond ((variable? V1223) (cons shen-deref (cons V1223 (cons ProcessN ()))))
367
+ ((cons? V1223)
368
+ (cons (shen-insert_deref (hd V1223)) (shen-insert_deref (tl V1223))))
369
+ (true V1223)))
370
+
371
+ (defun shen-insert_lazyderef (V1224)
372
+ (cond
373
+ ((variable? V1224) (cons shen-lazyderef (cons V1224 (cons ProcessN ()))))
374
+ ((cons? V1224)
375
+ (cons (shen-insert_lazyderef (hd V1224))
376
+ (shen-insert_lazyderef (tl V1224))))
377
+ (true V1224)))
378
+
379
+ (defun shen-m_prolog_to_s-prolog_predicate (V1225)
380
+ (cond ((= = V1225) unify) ((= =! V1225) unify!)
381
+ ((= == V1225) identical) (true V1225)))
382
+
383
+ (defun shen-group_clauses (V1226)
384
+ (cond ((= () V1226) ())
385
+ ((cons? V1226)
386
+ (let Group
387
+ (shen-collect (lambda X (shen-same_predicate? (hd V1226) X)) V1226)
388
+ (let Rest (difference V1226 Group)
389
+ (cons Group (shen-group_clauses Rest)))))
390
+ (true (shen-sys-error shen-group_clauses))))
391
+
392
+ (defun shen-collect (V1229 V1230)
393
+ (cond ((= () V1230) ())
394
+ ((cons? V1230)
395
+ (if (V1229 (hd V1230)) (cons (hd V1230) (shen-collect V1229 (tl V1230)))
396
+ (shen-collect V1229 (tl V1230))))
397
+ (true (shen-sys-error shen-collect))))
398
+
399
+ (defun shen-same_predicate? (V1247 V1248)
400
+ (cond
401
+ ((and (cons? V1247)
402
+ (and (cons? (hd V1247)) (and (cons? V1248) (cons? (hd V1248)))))
403
+ (= (hd (hd V1247)) (hd (hd V1248))))
404
+ (true (shen-sys-error shen-same_predicate?))))
405
+
406
+ (defun shen-compile_prolog_procedure (V1249)
407
+ (let F (shen-procedure_name V1249)
408
+ (let Shen (shen-clauses-to-shen F V1249) Shen)))
409
+
410
+ (defun shen-procedure_name (V1262)
411
+ (cond
412
+ ((and (cons? V1262) (and (cons? (hd V1262)) (cons? (hd (hd V1262)))))
413
+ (hd (hd (hd V1262))))
414
+ (true (shen-sys-error shen-procedure_name))))
415
+
416
+ (defun shen-clauses-to-shen (V1263 V1264)
417
+ (let Linear (map (lambda V1265 (shen-linearise-clause V1265)) V1264)
418
+ (let Arity
419
+ (shen-prolog-aritycheck V1263 (map (lambda V1266 (head V1266)) V1264))
420
+ (let Parameters (shen-parameters Arity)
421
+ (let AUM_instructions (map (lambda X (shen-aum X Parameters)) Linear)
422
+ (let Code
423
+ (shen-catch-cut
424
+ (shen-nest-disjunct
425
+ (map (lambda V1267 (shen-aum_to_shen V1267)) AUM_instructions)))
426
+ (let ShenDef
427
+ (cons define
428
+ (cons V1263
429
+ (append Parameters
430
+ (append (cons ProcessN (cons Continuation ()))
431
+ (cons -> (cons Code ()))))))
432
+ ShenDef)))))))
433
+
434
+ (defun shen-catch-cut (V1268)
435
+ (cond ((not (shen-occurs? cut V1268)) V1268)
436
+ (true
437
+ (cons let
438
+ (cons Throwcontrol
439
+ (cons (cons shen-catchpoint ())
440
+ (cons (cons shen-cutpoint (cons Throwcontrol (cons V1268 ())))
441
+ ())))))))
442
+
443
+ (defun shen-catchpoint () (set shen-*catch* (+ 1 (value shen-*catch*))))
444
+
445
+ (defun shen-cutpoint (V1273 V1274)
446
+ (cond ((= V1274 V1273) false) (true V1274)))
447
+
448
+ (defun shen-nest-disjunct (V1276)
449
+ (cond ((and (cons? V1276) (= () (tl V1276))) (hd V1276))
450
+ ((cons? V1276) (shen-lisp-or (hd V1276) (shen-nest-disjunct (tl V1276))))
451
+ (true (shen-sys-error shen-nest-disjunct))))
452
+
453
+ (defun shen-lisp-or (V1277 V1278)
454
+ (cons let
455
+ (cons Case
456
+ (cons V1277
457
+ (cons
458
+ (cons if
459
+ (cons (cons = (cons Case (cons false ())))
460
+ (cons V1278 (cons Case ()))))
461
+ ())))))
462
+
463
+ (defun shen-prolog-aritycheck (V1281 V1282)
464
+ (cond ((and (cons? V1282) (= () (tl V1282))) (- (length (hd V1282)) 1))
465
+ ((and (cons? V1282) (cons? (tl V1282)))
466
+ (if (= (length (hd V1282)) (length (hd (tl V1282))))
467
+ (shen-prolog-aritycheck V1281 (tl V1282))
468
+ (interror "arity error in prolog procedure ~A~%"
469
+ (@p (cons V1281 ()) ()))))
470
+ (true (shen-sys-error shen-prolog-aritycheck))))
471
+
472
+ (defun shen-linearise-clause (V1283)
473
+ (cond
474
+ ((and (cons? V1283)
475
+ (and (cons? (tl V1283))
476
+ (and (= :- (hd (tl V1283)))
477
+ (and (cons? (tl (tl V1283))) (= () (tl (tl (tl V1283))))))))
478
+ (let Linear (shen-linearise (cons (hd V1283) (tl (tl V1283))))
479
+ (shen-clause_form Linear)))
480
+ (true (shen-sys-error shen-linearise-clause))))
481
+
482
+ (defun shen-clause_form (V1284)
483
+ (cond
484
+ ((and (cons? V1284) (and (cons? (tl V1284)) (= () (tl (tl V1284)))))
485
+ (cons (shen-explicit_modes (hd V1284))
486
+ (cons :- (cons (shen-cf_help (hd (tl V1284))) ()))))
487
+ (true (shen-sys-error shen-clause_form))))
488
+
489
+ (defun shen-explicit_modes (V1285)
490
+ (cond
491
+ ((cons? V1285)
492
+ (cons (hd V1285) (map (lambda V1286 (shen-em_help V1286)) (tl V1285))))
493
+ (true (shen-sys-error shen-explicit_modes))))
494
+
495
+ (defun shen-em_help (V1287)
496
+ (cond
497
+ ((and (cons? V1287)
498
+ (and (= mode (hd V1287))
499
+ (and (cons? (tl V1287))
500
+ (and (cons? (tl (tl V1287))) (= () (tl (tl (tl V1287))))))))
501
+ V1287)
502
+ (true (cons mode (cons V1287 (cons + ()))))))
503
+
504
+ (defun shen-cf_help (V1288)
505
+ (cond
506
+ ((and (cons? V1288)
507
+ (and (= where (hd V1288))
508
+ (and (cons? (tl V1288))
509
+ (and (cons? (hd (tl V1288)))
510
+ (and (= = (hd (hd (tl V1288))))
511
+ (and (cons? (tl (hd (tl V1288))))
512
+ (and (cons? (tl (tl (hd (tl V1288)))))
513
+ (and (= () (tl (tl (tl (hd (tl V1288))))))
514
+ (and (cons? (tl (tl V1288)))
515
+ (= () (tl (tl (tl V1288)))))))))))))
516
+ (cons (cons (if (value shen-*occurs*) unify! unify) (tl (hd (tl V1288))))
517
+ (shen-cf_help (hd (tl (tl V1288))))))
518
+ (true V1288)))
519
+
520
+ (defun occurs-check (V1293)
521
+ (cond ((= + V1293) (set shen-*occurs* true))
522
+ ((= - V1293) (set shen-*occurs* false))
523
+ (true (interror "occurs-check expects + or -~%" ()))))
524
+
525
+ (defun shen-aum (V1294 V1295)
526
+ (cond
527
+ ((and (cons? V1294)
528
+ (and (cons? (hd V1294))
529
+ (and (cons? (tl V1294))
530
+ (and (= :- (hd (tl V1294)))
531
+ (and (cons? (tl (tl V1294))) (= () (tl (tl (tl V1294)))))))))
532
+ (let MuApplication
533
+ (shen-make_mu_application
534
+ (cons shen-mu
535
+ (cons (tl (hd V1294))
536
+ (cons (shen-continuation_call (tl (hd V1294)) (hd (tl (tl V1294))))
537
+ ())))
538
+ V1295)
539
+ (shen-mu_reduction MuApplication +)))
540
+ (true (shen-sys-error shen-aum))))
541
+
542
+ (defun shen-continuation_call (V1296 V1297)
543
+ (let VTerms (cons ProcessN (shen-extract_vars V1296))
544
+ (let VBody (shen-extract_vars V1297)
545
+ (let Free (remove Throwcontrol (difference VBody VTerms))
546
+ (shen-cc_help Free V1297)))))
547
+
548
+ (defun remove (V1298 V1299) (shen-remove-h V1298 V1299 ()))
549
+
550
+ (defun shen-remove-h (V1302 V1303 V1304)
551
+ (cond ((= () V1303) (reverse V1304))
552
+ ((and (cons? V1303) (= (hd V1303) V1302))
553
+ (shen-remove-h (hd V1303) (tl V1303) V1304))
554
+ ((cons? V1303) (shen-remove-h V1302 (tl V1303) (cons (hd V1303) V1304)))
555
+ (true (shen-sys-error shen-remove-h))))
556
+
557
+ (defun shen-cc_help (V1306 V1307)
558
+ (cond
559
+ ((and (= () V1306) (= () V1307))
560
+ (cons shen-pop (cons shen-the (cons shen-stack ()))))
561
+ ((= () V1307)
562
+ (cons shen-rename
563
+ (cons shen-the
564
+ (cons shen-variables
565
+ (cons in
566
+ (cons V1306
567
+ (cons and
568
+ (cons shen-then
569
+ (cons (cons shen-pop (cons shen-the (cons shen-stack ())))
570
+ ())))))))))
571
+ ((= () V1306)
572
+ (cons call (cons shen-the (cons shen-continuation (cons V1307 ())))))
573
+ (true
574
+ (cons shen-rename
575
+ (cons shen-the
576
+ (cons shen-variables
577
+ (cons in
578
+ (cons V1306
579
+ (cons and
580
+ (cons shen-then
581
+ (cons
582
+ (cons call
583
+ (cons shen-the (cons shen-continuation (cons V1307 ()))))
584
+ ())))))))))))
585
+
586
+ (defun shen-make_mu_application (V1308 V1309)
587
+ (cond
588
+ ((and (cons? V1308)
589
+ (and (= shen-mu (hd V1308))
590
+ (and (cons? (tl V1308))
591
+ (and (= () (hd (tl V1308)))
592
+ (and (cons? (tl (tl V1308)))
593
+ (and (= () (tl (tl (tl V1308)))) (= () V1309)))))))
594
+ (hd (tl (tl V1308))))
595
+ ((and (cons? V1308)
596
+ (and (= shen-mu (hd V1308))
597
+ (and (cons? (tl V1308))
598
+ (and (cons? (hd (tl V1308)))
599
+ (and (cons? (tl (tl V1308)))
600
+ (and (= () (tl (tl (tl V1308)))) (cons? V1309)))))))
601
+ (cons
602
+ (cons shen-mu
603
+ (cons (hd (hd (tl V1308)))
604
+ (cons
605
+ (shen-make_mu_application
606
+ (cons shen-mu (cons (tl (hd (tl V1308))) (tl (tl V1308)))) (tl V1309))
607
+ ())))
608
+ (cons (hd V1309) ())))
609
+ (true (shen-sys-error shen-make_mu_application))))
610
+
611
+ (defun shen-mu_reduction (V1316 V1317)
612
+ (cond
613
+ ((and (cons? V1316)
614
+ (and (cons? (hd V1316))
615
+ (and (= shen-mu (hd (hd V1316)))
616
+ (and (cons? (tl (hd V1316)))
617
+ (and (cons? (hd (tl (hd V1316))))
618
+ (and (= mode (hd (hd (tl (hd V1316)))))
619
+ (and (cons? (tl (hd (tl (hd V1316)))))
620
+ (and (cons? (tl (tl (hd (tl (hd V1316))))))
621
+ (and (= () (tl (tl (tl (hd (tl (hd V1316)))))))
622
+ (and (cons? (tl (tl (hd V1316))))
623
+ (and (= () (tl (tl (tl (hd V1316)))))
624
+ (and (cons? (tl V1316)) (= () (tl (tl V1316)))))))))))))))
625
+ (shen-mu_reduction
626
+ (cons
627
+ (cons shen-mu (cons (hd (tl (hd (tl (hd V1316))))) (tl (tl (hd V1316)))))
628
+ (tl V1316))
629
+ (hd (tl (tl (hd (tl (hd V1316))))))))
630
+ ((and (cons? V1316)
631
+ (and (cons? (hd V1316))
632
+ (and (= shen-mu (hd (hd V1316)))
633
+ (and (cons? (tl (hd V1316)))
634
+ (and (cons? (tl (tl (hd V1316))))
635
+ (and (= () (tl (tl (tl (hd V1316)))))
636
+ (and (cons? (tl V1316))
637
+ (and (= () (tl (tl V1316))) (= _ (hd (tl (hd V1316))))))))))))
638
+ (shen-mu_reduction (hd (tl (tl (hd V1316)))) V1317))
639
+ ((and (cons? V1316)
640
+ (and (cons? (hd V1316))
641
+ (and (= shen-mu (hd (hd V1316)))
642
+ (and (cons? (tl (hd V1316)))
643
+ (and (cons? (tl (tl (hd V1316))))
644
+ (and (= () (tl (tl (tl (hd V1316)))))
645
+ (and (cons? (tl V1316))
646
+ (and (= () (tl (tl V1316)))
647
+ (shen-ephemeral_variable? (hd (tl (hd V1316)))
648
+ (hd (tl V1316)))))))))))
649
+ (subst (hd (tl V1316)) (hd (tl (hd V1316)))
650
+ (shen-mu_reduction (hd (tl (tl (hd V1316)))) V1317)))
651
+ ((and (cons? V1316)
652
+ (and (cons? (hd V1316))
653
+ (and (= shen-mu (hd (hd V1316)))
654
+ (and (cons? (tl (hd V1316)))
655
+ (and (cons? (tl (tl (hd V1316))))
656
+ (and (= () (tl (tl (tl (hd V1316)))))
657
+ (and (cons? (tl V1316))
658
+ (and (= () (tl (tl V1316)))
659
+ (variable? (hd (tl (hd V1316))))))))))))
660
+ (cons let
661
+ (cons (hd (tl (hd V1316)))
662
+ (cons shen-be
663
+ (cons (hd (tl V1316))
664
+ (cons in
665
+ (cons (shen-mu_reduction (hd (tl (tl (hd V1316)))) V1317) ())))))))
666
+ ((and (cons? V1316)
667
+ (and (cons? (hd V1316))
668
+ (and (= shen-mu (hd (hd V1316)))
669
+ (and (cons? (tl (hd V1316)))
670
+ (and (cons? (tl (tl (hd V1316))))
671
+ (and (= () (tl (tl (tl (hd V1316)))))
672
+ (and (cons? (tl V1316))
673
+ (and (= () (tl (tl V1316)))
674
+ (and (= - V1317)
675
+ (shen-prolog_constant? (hd (tl (hd V1316)))))))))))))
676
+ (let Z (gensym V)
677
+ (cons let
678
+ (cons Z
679
+ (cons shen-be
680
+ (cons
681
+ (cons shen-the
682
+ (cons shen-result
683
+ (cons shen-of (cons shen-dereferencing (tl V1316)))))
684
+ (cons in
685
+ (cons
686
+ (cons if
687
+ (cons
688
+ (cons Z
689
+ (cons is
690
+ (cons identical (cons shen-to (cons (hd (tl (hd V1316))) ())))))
691
+ (cons shen-then
692
+ (cons (shen-mu_reduction (hd (tl (tl (hd V1316)))) -)
693
+ (cons shen-else (cons (fail) ()))))))
694
+ ()))))))))
695
+ ((and (cons? V1316)
696
+ (and (cons? (hd V1316))
697
+ (and (= shen-mu (hd (hd V1316)))
698
+ (and (cons? (tl (hd V1316)))
699
+ (and (cons? (tl (tl (hd V1316))))
700
+ (and (= () (tl (tl (tl (hd V1316)))))
701
+ (and (cons? (tl V1316))
702
+ (and (= () (tl (tl V1316)))
703
+ (and (= + V1317)
704
+ (shen-prolog_constant? (hd (tl (hd V1316)))))))))))))
705
+ (let Z (gensym V)
706
+ (cons let
707
+ (cons Z
708
+ (cons shen-be
709
+ (cons
710
+ (cons shen-the
711
+ (cons shen-result
712
+ (cons shen-of (cons shen-dereferencing (tl V1316)))))
713
+ (cons in
714
+ (cons
715
+ (cons if
716
+ (cons
717
+ (cons Z
718
+ (cons is
719
+ (cons identical (cons shen-to (cons (hd (tl (hd V1316))) ())))))
720
+ (cons shen-then
721
+ (cons (shen-mu_reduction (hd (tl (tl (hd V1316)))) +)
722
+ (cons shen-else
723
+ (cons
724
+ (cons if
725
+ (cons
726
+ (cons Z (cons is (cons shen-a (cons shen-variable ()))))
727
+ (cons shen-then
728
+ (cons
729
+ (cons bind
730
+ (cons Z
731
+ (cons shen-to
732
+ (cons (hd (tl (hd V1316)))
733
+ (cons in
734
+ (cons (shen-mu_reduction (hd (tl (tl (hd V1316)))) +)
735
+ ()))))))
736
+ (cons shen-else (cons (fail) ()))))))
737
+ ()))))))
738
+ ()))))))))
739
+ ((and (cons? V1316)
740
+ (and (cons? (hd V1316))
741
+ (and (= shen-mu (hd (hd V1316)))
742
+ (and (cons? (tl (hd V1316)))
743
+ (and (cons? (hd (tl (hd V1316))))
744
+ (and (cons? (tl (tl (hd V1316))))
745
+ (and (= () (tl (tl (tl (hd V1316)))))
746
+ (and (cons? (tl V1316))
747
+ (and (= () (tl (tl V1316))) (= - V1317))))))))))
748
+ (let Z (gensym V)
749
+ (cons let
750
+ (cons Z
751
+ (cons shen-be
752
+ (cons
753
+ (cons shen-the
754
+ (cons shen-result
755
+ (cons shen-of (cons shen-dereferencing (tl V1316)))))
756
+ (cons in
757
+ (cons
758
+ (cons if
759
+ (cons
760
+ (cons Z
761
+ (cons is (cons shen-a (cons shen-non-empty (cons list ())))))
762
+ (cons shen-then
763
+ (cons
764
+ (shen-mu_reduction
765
+ (cons
766
+ (cons shen-mu
767
+ (cons (hd (hd (tl (hd V1316))))
768
+ (cons
769
+ (cons
770
+ (cons shen-mu
771
+ (cons (tl (hd (tl (hd V1316)))) (tl (tl (hd V1316)))))
772
+ (cons
773
+ (cons shen-the (cons tail (cons shen-of (cons Z ()))))
774
+ ()))
775
+ ())))
776
+ (cons (cons shen-the (cons head (cons shen-of (cons Z ()))))
777
+ ()))
778
+ -)
779
+ (cons shen-else (cons (fail) ()))))))
780
+ ()))))))))
781
+ ((and (cons? V1316)
782
+ (and (cons? (hd V1316))
783
+ (and (= shen-mu (hd (hd V1316)))
784
+ (and (cons? (tl (hd V1316)))
785
+ (and (cons? (hd (tl (hd V1316))))
786
+ (and (cons? (tl (tl (hd V1316))))
787
+ (and (= () (tl (tl (tl (hd V1316)))))
788
+ (and (cons? (tl V1316))
789
+ (and (= () (tl (tl V1316))) (= + V1317))))))))))
790
+ (let Z (gensym V)
791
+ (cons let
792
+ (cons Z
793
+ (cons shen-be
794
+ (cons
795
+ (cons shen-the
796
+ (cons shen-result
797
+ (cons shen-of (cons shen-dereferencing (tl V1316)))))
798
+ (cons in
799
+ (cons
800
+ (cons if
801
+ (cons
802
+ (cons Z
803
+ (cons is (cons shen-a (cons shen-non-empty (cons list ())))))
804
+ (cons shen-then
805
+ (cons
806
+ (shen-mu_reduction
807
+ (cons
808
+ (cons shen-mu
809
+ (cons (hd (hd (tl (hd V1316))))
810
+ (cons
811
+ (cons
812
+ (cons shen-mu
813
+ (cons (tl (hd (tl (hd V1316)))) (tl (tl (hd V1316)))))
814
+ (cons
815
+ (cons shen-the (cons tail (cons shen-of (cons Z ()))))
816
+ ()))
817
+ ())))
818
+ (cons (cons shen-the (cons head (cons shen-of (cons Z ()))))
819
+ ()))
820
+ +)
821
+ (cons shen-else
822
+ (cons
823
+ (cons if
824
+ (cons
825
+ (cons Z (cons is (cons shen-a (cons shen-variable ()))))
826
+ (cons shen-then
827
+ (cons
828
+ (cons shen-rename
829
+ (cons shen-the
830
+ (cons shen-variables
831
+ (cons in
832
+ (cons (shen-extract_vars (hd (tl (hd V1316))))
833
+ (cons and
834
+ (cons shen-then
835
+ (cons
836
+ (cons bind
837
+ (cons Z
838
+ (cons shen-to
839
+ (cons
840
+ (shen-rcons_form
841
+ (shen-remove_modes (hd (tl (hd V1316)))))
842
+ (cons in
843
+ (cons
844
+ (shen-mu_reduction (hd (tl (tl (hd V1316))))
845
+ +)
846
+ ()))))))
847
+ ()))))))))
848
+ (cons shen-else (cons (fail) ()))))))
849
+ ()))))))
850
+ ()))))))))
851
+ (true V1316)))
852
+
853
+ (defun shen-rcons_form (V1318)
854
+ (cond
855
+ ((cons? V1318)
856
+ (cons cons
857
+ (cons (shen-rcons_form (hd V1318))
858
+ (cons (shen-rcons_form (tl V1318)) ()))))
859
+ (true V1318)))
860
+
861
+ (defun shen-remove_modes (V1319)
862
+ (cond
863
+ ((and (cons? V1319)
864
+ (and (= mode (hd V1319))
865
+ (and (cons? (tl V1319))
866
+ (and (cons? (tl (tl V1319)))
867
+ (and (= + (hd (tl (tl V1319)))) (= () (tl (tl (tl V1319)))))))))
868
+ (shen-remove_modes (hd (tl V1319))))
869
+ ((and (cons? V1319)
870
+ (and (= mode (hd V1319))
871
+ (and (cons? (tl V1319))
872
+ (and (cons? (tl (tl V1319)))
873
+ (and (= - (hd (tl (tl V1319)))) (= () (tl (tl (tl V1319)))))))))
874
+ (shen-remove_modes (hd (tl V1319))))
875
+ ((cons? V1319)
876
+ (cons (shen-remove_modes (hd V1319)) (shen-remove_modes (tl V1319))))
877
+ (true V1319)))
878
+
879
+ (defun shen-ephemeral_variable? (V1320 V1321)
880
+ (and (variable? V1320) (variable? V1321)))
881
+
882
+ (defun shen-prolog_constant? (V1330) (cond ((cons? V1330) false) (true true)))
883
+
884
+ (defun shen-aum_to_shen (V1331)
885
+ (cond
886
+ ((and (cons? V1331)
887
+ (and (= let (hd V1331))
888
+ (and (cons? (tl V1331))
889
+ (and (cons? (tl (tl V1331)))
890
+ (and (= shen-be (hd (tl (tl V1331))))
891
+ (and (cons? (tl (tl (tl V1331))))
892
+ (and (cons? (tl (tl (tl (tl V1331)))))
893
+ (and (= in (hd (tl (tl (tl (tl V1331))))))
894
+ (and (cons? (tl (tl (tl (tl (tl V1331))))))
895
+ (= () (tl (tl (tl (tl (tl (tl V1331))))))))))))))))
896
+ (cons let
897
+ (cons (hd (tl V1331))
898
+ (cons (shen-aum_to_shen (hd (tl (tl (tl V1331)))))
899
+ (cons (shen-aum_to_shen (hd (tl (tl (tl (tl (tl V1331))))))) ())))))
900
+ ((and (cons? V1331)
901
+ (and (= shen-the (hd V1331))
902
+ (and (cons? (tl V1331))
903
+ (and (= shen-result (hd (tl V1331)))
904
+ (and (cons? (tl (tl V1331)))
905
+ (and (= shen-of (hd (tl (tl V1331))))
906
+ (and (cons? (tl (tl (tl V1331))))
907
+ (and (= shen-dereferencing (hd (tl (tl (tl V1331)))))
908
+ (and (cons? (tl (tl (tl (tl V1331)))))
909
+ (= () (tl (tl (tl (tl (tl V1331)))))))))))))))
910
+ (cons shen-lazyderef
911
+ (cons (shen-aum_to_shen (hd (tl (tl (tl (tl V1331))))))
912
+ (cons ProcessN ()))))
913
+ ((and (cons? V1331)
914
+ (and (= if (hd V1331))
915
+ (and (cons? (tl V1331))
916
+ (and (cons? (tl (tl V1331)))
917
+ (and (= shen-then (hd (tl (tl V1331))))
918
+ (and (cons? (tl (tl (tl V1331))))
919
+ (and (cons? (tl (tl (tl (tl V1331)))))
920
+ (and (= shen-else (hd (tl (tl (tl (tl V1331))))))
921
+ (and (cons? (tl (tl (tl (tl (tl V1331))))))
922
+ (= () (tl (tl (tl (tl (tl (tl V1331))))))))))))))))
923
+ (cons if
924
+ (cons (shen-aum_to_shen (hd (tl V1331)))
925
+ (cons (shen-aum_to_shen (hd (tl (tl (tl V1331)))))
926
+ (cons (shen-aum_to_shen (hd (tl (tl (tl (tl (tl V1331))))))) ())))))
927
+ ((and (cons? V1331)
928
+ (and (cons? (tl V1331))
929
+ (and (= is (hd (tl V1331)))
930
+ (and (cons? (tl (tl V1331)))
931
+ (and (= shen-a (hd (tl (tl V1331))))
932
+ (and (cons? (tl (tl (tl V1331))))
933
+ (and (= shen-variable (hd (tl (tl (tl V1331)))))
934
+ (= () (tl (tl (tl (tl V1331))))))))))))
935
+ (cons shen-pvar? (cons (hd V1331) ())))
936
+ ((and (cons? V1331)
937
+ (and (cons? (tl V1331))
938
+ (and (= is (hd (tl V1331)))
939
+ (and (cons? (tl (tl V1331)))
940
+ (and (= shen-a (hd (tl (tl V1331))))
941
+ (and (cons? (tl (tl (tl V1331))))
942
+ (and (= shen-non-empty (hd (tl (tl (tl V1331)))))
943
+ (and (cons? (tl (tl (tl (tl V1331)))))
944
+ (and (= list (hd (tl (tl (tl (tl V1331))))))
945
+ (= () (tl (tl (tl (tl (tl V1331)))))))))))))))
946
+ (cons cons? (cons (hd V1331) ())))
947
+ ((and (cons? V1331)
948
+ (and (= shen-rename (hd V1331))
949
+ (and (cons? (tl V1331))
950
+ (and (= shen-the (hd (tl V1331)))
951
+ (and (cons? (tl (tl V1331)))
952
+ (and (= shen-variables (hd (tl (tl V1331))))
953
+ (and (cons? (tl (tl (tl V1331))))
954
+ (and (= in (hd (tl (tl (tl V1331)))))
955
+ (and (cons? (tl (tl (tl (tl V1331)))))
956
+ (and (= () (hd (tl (tl (tl (tl V1331))))))
957
+ (and (cons? (tl (tl (tl (tl (tl V1331))))))
958
+ (and (= and (hd (tl (tl (tl (tl (tl V1331)))))))
959
+ (and (cons? (tl (tl (tl (tl (tl (tl V1331)))))))
960
+ (and (= shen-then (hd (tl (tl (tl (tl (tl (tl V1331))))))))
961
+ (and (cons? (tl (tl (tl (tl (tl (tl (tl V1331))))))))
962
+ (= ()
963
+ (tl
964
+ (tl (tl (tl (tl (tl (tl (tl V1331))))))))))))))))))))))))
965
+ (shen-aum_to_shen (hd (tl (tl (tl (tl (tl (tl (tl V1331))))))))))
966
+ ((and (cons? V1331)
967
+ (and (= shen-rename (hd V1331))
968
+ (and (cons? (tl V1331))
969
+ (and (= shen-the (hd (tl V1331)))
970
+ (and (cons? (tl (tl V1331)))
971
+ (and (= shen-variables (hd (tl (tl V1331))))
972
+ (and (cons? (tl (tl (tl V1331))))
973
+ (and (= in (hd (tl (tl (tl V1331)))))
974
+ (and (cons? (tl (tl (tl (tl V1331)))))
975
+ (and (cons? (hd (tl (tl (tl (tl V1331))))))
976
+ (and (cons? (tl (tl (tl (tl (tl V1331))))))
977
+ (and (= and (hd (tl (tl (tl (tl (tl V1331)))))))
978
+ (and (cons? (tl (tl (tl (tl (tl (tl V1331)))))))
979
+ (and (= shen-then (hd (tl (tl (tl (tl (tl (tl V1331))))))))
980
+ (and (cons? (tl (tl (tl (tl (tl (tl (tl V1331))))))))
981
+ (= ()
982
+ (tl
983
+ (tl (tl (tl (tl (tl (tl (tl V1331))))))))))))))))))))))))
984
+ (cons let
985
+ (cons (hd (hd (tl (tl (tl (tl V1331))))))
986
+ (cons (cons shen-newpv (cons ProcessN ()))
987
+ (cons
988
+ (shen-aum_to_shen
989
+ (cons shen-rename
990
+ (cons shen-the
991
+ (cons shen-variables
992
+ (cons in
993
+ (cons (tl (hd (tl (tl (tl (tl V1331))))))
994
+ (tl (tl (tl (tl (tl V1331)))))))))))
995
+ ())))))
996
+ ((and (cons? V1331)
997
+ (and (= bind (hd V1331))
998
+ (and (cons? (tl V1331))
999
+ (and (cons? (tl (tl V1331)))
1000
+ (and (= shen-to (hd (tl (tl V1331))))
1001
+ (and (cons? (tl (tl (tl V1331))))
1002
+ (and (cons? (tl (tl (tl (tl V1331)))))
1003
+ (and (= in (hd (tl (tl (tl (tl V1331))))))
1004
+ (and (cons? (tl (tl (tl (tl (tl V1331))))))
1005
+ (= () (tl (tl (tl (tl (tl (tl V1331))))))))))))))))
1006
+ (cons do
1007
+ (cons
1008
+ (cons shen-bindv
1009
+ (cons (hd (tl V1331))
1010
+ (cons (shen-chwild (hd (tl (tl (tl V1331))))) (cons ProcessN ()))))
1011
+ (cons
1012
+ (cons let
1013
+ (cons Result
1014
+ (cons (shen-aum_to_shen (hd (tl (tl (tl (tl (tl V1331)))))))
1015
+ (cons
1016
+ (cons do
1017
+ (cons (cons shen-unbindv (cons (hd (tl V1331)) (cons ProcessN ())))
1018
+ (cons Result ())))
1019
+ ()))))
1020
+ ()))))
1021
+ ((and (cons? V1331)
1022
+ (and (cons? (tl V1331))
1023
+ (and (= is (hd (tl V1331)))
1024
+ (and (cons? (tl (tl V1331)))
1025
+ (and (= identical (hd (tl (tl V1331))))
1026
+ (and (cons? (tl (tl (tl V1331))))
1027
+ (and (= shen-to (hd (tl (tl (tl V1331)))))
1028
+ (and (cons? (tl (tl (tl (tl V1331)))))
1029
+ (= () (tl (tl (tl (tl (tl V1331))))))))))))))
1030
+ (cons = (cons (hd (tl (tl (tl (tl V1331))))) (cons (hd V1331) ()))))
1031
+ ((= V1331 (fail)) false)
1032
+ ((and (cons? V1331)
1033
+ (and (= shen-the (hd V1331))
1034
+ (and (cons? (tl V1331))
1035
+ (and (= head (hd (tl V1331)))
1036
+ (and (cons? (tl (tl V1331)))
1037
+ (and (= shen-of (hd (tl (tl V1331))))
1038
+ (and (cons? (tl (tl (tl V1331))))
1039
+ (= () (tl (tl (tl (tl V1331))))))))))))
1040
+ (cons hd (tl (tl (tl V1331)))))
1041
+ ((and (cons? V1331)
1042
+ (and (= shen-the (hd V1331))
1043
+ (and (cons? (tl V1331))
1044
+ (and (= tail (hd (tl V1331)))
1045
+ (and (cons? (tl (tl V1331)))
1046
+ (and (= shen-of (hd (tl (tl V1331))))
1047
+ (and (cons? (tl (tl (tl V1331))))
1048
+ (= () (tl (tl (tl (tl V1331))))))))))))
1049
+ (cons tl (tl (tl (tl V1331)))))
1050
+ ((and (cons? V1331)
1051
+ (and (= shen-pop (hd V1331))
1052
+ (and (cons? (tl V1331))
1053
+ (and (= shen-the (hd (tl V1331)))
1054
+ (and (cons? (tl (tl V1331)))
1055
+ (and (= shen-stack (hd (tl (tl V1331))))
1056
+ (= () (tl (tl (tl V1331))))))))))
1057
+ (cons do
1058
+ (cons (cons shen-incinfs ())
1059
+ (cons (cons thaw (cons Continuation ())) ()))))
1060
+ ((and (cons? V1331)
1061
+ (and (= call (hd V1331))
1062
+ (and (cons? (tl V1331))
1063
+ (and (= shen-the (hd (tl V1331)))
1064
+ (and (cons? (tl (tl V1331)))
1065
+ (and (= shen-continuation (hd (tl (tl V1331))))
1066
+ (and (cons? (tl (tl (tl V1331))))
1067
+ (= () (tl (tl (tl (tl V1331))))))))))))
1068
+ (cons do
1069
+ (cons (cons shen-incinfs ())
1070
+ (cons
1071
+ (shen-call_the_continuation (shen-chwild (hd (tl (tl (tl V1331)))))
1072
+ ProcessN Continuation)
1073
+ ()))))
1074
+ (true V1331)))
1075
+
1076
+ (defun shen-chwild (V1332)
1077
+ (cond ((= V1332 _) (cons shen-newpv (cons ProcessN ())))
1078
+ ((cons? V1332) (map (lambda V1333 (shen-chwild V1333)) V1332)) (true V1332)))
1079
+
1080
+ (defun shen-newpv (V1334)
1081
+ (let Count+1 (+ (<-address (value shen-*varcounter*) V1334) 1)
1082
+ (let IncVar (address-> (value shen-*varcounter*) V1334 Count+1)
1083
+ (let Vector (<-address (value shen-*prologvectors*) V1334)
1084
+ (let ResizeVectorIfNeeded
1085
+ (if (= Count+1 (limit Vector)) (shen-resizeprocessvector V1334 Count+1)
1086
+ shen-skip)
1087
+ (shen-mk-pvar Count+1))))))
1088
+
1089
+ (defun shen-resizeprocessvector (V1335 V1336)
1090
+ (let Vector (<-address (value shen-*prologvectors*) V1335)
1091
+ (let BigVector (shen-resize-vector Vector (+ V1336 V1336) shen--null-)
1092
+ (address-> (value shen-*prologvectors*) V1335 BigVector))))
1093
+
1094
+ (defun shen-resize-vector (V1337 V1338 V1339)
1095
+ (let BigVector (address-> (absvector (+ 1 V1338)) 0 V1338)
1096
+ (shen-copy-vector V1337 BigVector (limit V1337) V1338 V1339)))
1097
+
1098
+ (defun shen-copy-vector (V1340 V1341 V1342 V1343 V1344)
1099
+ (shen-copy-vector-stage-2 (+ 1 V1342) (+ V1343 1) V1344
1100
+ (shen-copy-vector-stage-1 1 V1340 V1341 (+ 1 V1342))))
1101
+
1102
+ (defun shen-copy-vector-stage-1 (V1347 V1348 V1349 V1350)
1103
+ (cond ((= V1350 V1347) V1349)
1104
+ (true
1105
+ (shen-copy-vector-stage-1 (+ 1 V1347) V1348
1106
+ (address-> V1349 V1347 (<-address V1348 V1347)) V1350))))
1107
+
1108
+ (defun shen-copy-vector-stage-2 (V1354 V1355 V1356 V1357)
1109
+ (cond ((= V1355 V1354) V1357)
1110
+ (true
1111
+ (shen-copy-vector-stage-2 (+ V1354 1) V1355 V1356
1112
+ (address-> V1357 V1354 V1356)))))
1113
+
1114
+ (defun shen-mk-pvar (V1359)
1115
+ (address-> (address-> (absvector 2) 0 shen-pvar) 1 V1359))
1116
+
1117
+ (defun shen-pvar? (V1360)
1118
+ (and (absvector? V1360) (= (<-address V1360 0) shen-pvar)))
1119
+
1120
+ (defun shen-bindv (V1361 V1362 V1363)
1121
+ (let Vector (<-address (value shen-*prologvectors*) V1363)
1122
+ (address-> Vector (<-address V1361 1) V1362)))
1123
+
1124
+ (defun shen-unbindv (V1364 V1365)
1125
+ (let Vector (<-address (value shen-*prologvectors*) V1365)
1126
+ (address-> Vector (<-address V1364 1) shen--null-)))
1127
+
1128
+ (defun shen-incinfs () (set shen-*infs* (+ 1 (value shen-*infs*))))
1129
+
1130
+ (defun shen-call_the_continuation (V1366 V1367 V1368)
1131
+ (cond
1132
+ ((and (cons? V1366) (and (cons? (hd V1366)) (= () (tl V1366))))
1133
+ (cons (hd (hd V1366))
1134
+ (append (tl (hd V1366)) (cons V1367 (cons V1368 ())))))
1135
+ ((and (cons? V1366) (cons? (hd V1366)))
1136
+ (let NewContinuation (shen-newcontinuation (tl V1366) V1367 V1368)
1137
+ (cons (hd (hd V1366))
1138
+ (append (tl (hd V1366)) (cons V1367 (cons NewContinuation ()))))))
1139
+ (true (shen-sys-error shen-call_the_continuation))))
1140
+
1141
+ (defun shen-newcontinuation (V1369 V1370 V1371)
1142
+ (cond ((= () V1369) V1371)
1143
+ ((and (cons? V1369) (cons? (hd V1369)))
1144
+ (cons freeze
1145
+ (cons
1146
+ (cons (hd (hd V1369))
1147
+ (append (tl (hd V1369))
1148
+ (cons V1370 (cons (shen-newcontinuation (tl V1369) V1370 V1371) ()))))
1149
+ ())))
1150
+ (true (shen-sys-error shen-newcontinuation))))
1151
+
1152
+ (defun return (V1376 V1377 V1378) (shen-deref V1376 V1377))
1153
+
1154
+ (defun shen-measure&return (V1383 V1384 V1385)
1155
+ (do (intoutput "~A inferences~%" (@p (value shen-*infs*) ()))
1156
+ (shen-deref V1383 V1384)))
1157
+
1158
+ (defun unify (V1386 V1387 V1388 V1389)
1159
+ (shen-lzy= (shen-lazyderef V1386 V1388) (shen-lazyderef V1387 V1388) V1388
1160
+ V1389))
1161
+
1162
+ (defun shen-lzy= (V1406 V1407 V1408 V1409)
1163
+ (cond ((= V1407 V1406) (thaw V1409))
1164
+ ((shen-pvar? V1406) (bind V1406 V1407 V1408 V1409))
1165
+ ((shen-pvar? V1407) (bind V1407 V1406 V1408 V1409))
1166
+ ((and (cons? V1406) (cons? V1407))
1167
+ (shen-lzy= (shen-lazyderef (hd V1406) V1408)
1168
+ (shen-lazyderef (hd V1407) V1408) V1408
1169
+ (freeze
1170
+ (shen-lzy= (shen-lazyderef (tl V1406) V1408)
1171
+ (shen-lazyderef (tl V1407) V1408) V1408 V1409))))
1172
+ (true false)))
1173
+
1174
+ (defun shen-deref (V1411 V1412)
1175
+ (cond
1176
+ ((cons? V1411)
1177
+ (cons (shen-deref (hd V1411) V1412) (shen-deref (tl V1411) V1412)))
1178
+ (true
1179
+ (if (shen-pvar? V1411)
1180
+ (let Value (shen-valvector V1411 V1412)
1181
+ (if (= Value shen--null-) V1411 (shen-deref Value V1412)))
1182
+ V1411))))
1183
+
1184
+ (defun shen-lazyderef (V1413 V1414)
1185
+ (if (shen-pvar? V1413)
1186
+ (let Value (shen-valvector V1413 V1414)
1187
+ (if (= Value shen--null-) V1413 (shen-lazyderef Value V1414)))
1188
+ V1413))
1189
+
1190
+ (defun shen-valvector (V1415 V1416)
1191
+ (<-address (<-address (value shen-*prologvectors*) V1416)
1192
+ (<-address V1415 1)))
1193
+
1194
+ (defun unify! (V1417 V1418 V1419 V1420)
1195
+ (shen-lzy=! (shen-lazyderef V1417 V1419) (shen-lazyderef V1418 V1419) V1419
1196
+ V1420))
1197
+
1198
+ (defun shen-lzy=! (V1437 V1438 V1439 V1440)
1199
+ (cond ((= V1438 V1437) (thaw V1440))
1200
+ ((and (shen-pvar? V1437) (not (shen-occurs? V1437 (shen-deref V1438 V1439))))
1201
+ (bind V1437 V1438 V1439 V1440))
1202
+ ((and (shen-pvar? V1438) (not (shen-occurs? V1438 (shen-deref V1437 V1439))))
1203
+ (bind V1438 V1437 V1439 V1440))
1204
+ ((and (cons? V1437) (cons? V1438))
1205
+ (shen-lzy=! (shen-lazyderef (hd V1437) V1439)
1206
+ (shen-lazyderef (hd V1438) V1439) V1439
1207
+ (freeze
1208
+ (shen-lzy=! (shen-lazyderef (tl V1437) V1439)
1209
+ (shen-lazyderef (tl V1438) V1439) V1439 V1440))))
1210
+ (true false)))
1211
+
1212
+ (defun shen-occurs? (V1450 V1451)
1213
+ (cond ((= V1451 V1450) true)
1214
+ ((cons? V1451)
1215
+ (or (shen-occurs? V1450 (hd V1451)) (shen-occurs? V1450 (tl V1451))))
1216
+ (true false)))
1217
+
1218
+ (defun identical (V1453 V1454 V1455 V1456)
1219
+ (shen-lzy== (shen-lazyderef V1453 V1455) (shen-lazyderef V1454 V1455) V1455
1220
+ V1456))
1221
+
1222
+ (defun shen-lzy== (V1473 V1474 V1475 V1476)
1223
+ (cond ((= V1474 V1473) (thaw V1476))
1224
+ ((and (cons? V1473) (cons? V1474))
1225
+ (shen-lzy== (shen-lazyderef (hd V1473) V1475)
1226
+ (shen-lazyderef (hd V1474) V1475) V1475
1227
+ (freeze (shen-lzy== (tl V1473) (tl V1474) V1475 V1476))))
1228
+ (true false)))
1229
+
1230
+ (defun shen-pvar (V1478) (intmake-string "Var~A" (@p (<-address V1478 1) ())))
1231
+
1232
+ (defun bind (V1479 V1480 V1481 V1482)
1233
+ (do (shen-bindv V1479 V1480 V1481)
1234
+ (let Result (thaw V1482) (do (shen-unbindv V1479 V1481) Result))))
1235
+
1236
+ (defun fwhen (V1497 V1498 V1499)
1237
+ (cond ((= true V1497) (thaw V1499)) ((= false V1497) false)
1238
+ (true (interror "fwhen expects a boolean: not ~S%" (@p V1497 ())))))
1239
+
1240
+ (defun call (V1512 V1513 V1514)
1241
+ (cond
1242
+ ((cons? V1512)
1243
+ (shen-call-help
1244
+ (shen-m_prolog_to_s-prolog_predicate (shen-lazyderef (hd V1512) V1513))
1245
+ (tl V1512) V1513 V1514))
1246
+ (true false)))
1247
+
1248
+ (defun shen-call-help (V1515 V1516 V1517 V1518)
1249
+ (cond ((= () V1516) (V1515 V1517 V1518))
1250
+ ((cons? V1516) (shen-call-help (V1515 (hd V1516)) (tl V1516) V1517 V1518))
1251
+ (true (shen-sys-error shen-call-help))))
1252
+
1253
+ (defun shen-intprolog (V1519)
1254
+ (cond
1255
+ ((and (cons? V1519) (cons? (hd V1519)))
1256
+ (let ProcessN (shen-start-new-prolog-process)
1257
+ (shen-intprolog-help (hd (hd V1519))
1258
+ (shen-insert-prolog-variables (cons (tl (hd V1519)) (cons (tl V1519) ()))
1259
+ ProcessN)
1260
+ ProcessN)))
1261
+ (true (shen-sys-error shen-intprolog))))
1262
+
1263
+ (defun shen-intprolog-help (V1520 V1521 V1522)
1264
+ (cond
1265
+ ((and (cons? V1521) (and (cons? (tl V1521)) (= () (tl (tl V1521)))))
1266
+ (shen-intprolog-help-help V1520 (hd V1521) (hd (tl V1521)) V1522))
1267
+ (true (shen-sys-error shen-intprolog-help))))
1268
+
1269
+ (defun shen-intprolog-help-help (V1523 V1524 V1525 V1526)
1270
+ (cond ((= () V1524) (V1523 V1526 (freeze (shen-call-rest V1525 V1526))))
1271
+ ((cons? V1524)
1272
+ (shen-intprolog-help-help (V1523 (hd V1524)) (tl V1524) V1525 V1526))
1273
+ (true (shen-sys-error shen-intprolog-help-help))))
1274
+
1275
+ (defun shen-call-rest (V1529 V1530)
1276
+ (cond ((= () V1529) true)
1277
+ ((and (cons? V1529) (and (cons? (hd V1529)) (cons? (tl (hd V1529)))))
1278
+ (shen-call-rest
1279
+ (cons (cons ((hd (hd V1529)) (hd (tl (hd V1529)))) (tl (tl (hd V1529))))
1280
+ (tl V1529))
1281
+ V1530))
1282
+ ((and (cons? V1529) (and (cons? (hd V1529)) (= () (tl (hd V1529)))))
1283
+ ((hd (hd V1529)) V1530 (freeze (shen-call-rest (tl V1529) V1530))))
1284
+ (true (shen-sys-error shen-call-rest))))
1285
+
1286
+ (defun shen-start-new-prolog-process ()
1287
+ (let IncrementProcessCounter
1288
+ (set shen-*process-counter* (+ 1 (value shen-*process-counter*)))
1289
+ (shen-initialise-prolog IncrementProcessCounter)))
1290
+
1291
+ (defun shen-insert-prolog-variables (V1531 V1532)
1292
+ (shen-insert-prolog-variables-help V1531 (shen-flatten V1531) V1532))
1293
+
1294
+ (defun shen-insert-prolog-variables-help (V1537 V1538 V1539)
1295
+ (cond ((= () V1538) V1537)
1296
+ ((and (cons? V1538) (variable? (hd V1538)))
1297
+ (let V (shen-newpv V1539)
1298
+ (let XV/Y (subst V (hd V1538) V1537)
1299
+ (let Z-Y (remove (hd V1538) (tl V1538))
1300
+ (shen-insert-prolog-variables-help XV/Y Z-Y V1539)))))
1301
+ ((cons? V1538) (shen-insert-prolog-variables-help V1537 (tl V1538) V1539))
1302
+ (true (shen-sys-error shen-insert-prolog-variables-help))))
1303
+
1304
+ (defun shen-initialise-prolog (V1540)
1305
+ (let Vector
1306
+ (address-> (value shen-*prologvectors*) V1540
1307
+ (shen-fillvector (vector 10) 1 10 shen--null-))
1308
+ (let Counter (address-> (value shen-*varcounter*) V1540 1) V1540)))
1309
+