shen-ruby 0.1.0
Sign up to get free protection for your applications and to get access to all the features.
- data/.gitignore +4 -0
- data/.rspec +0 -0
- data/Gemfile +6 -0
- data/Gemfile.lock +20 -0
- data/MIT_LICENSE.txt +26 -0
- data/README.md +94 -0
- data/bin/shen_test_suite.rb +9 -0
- data/bin/srrepl +23 -0
- data/lib/kl.rb +7 -0
- data/lib/kl/absvector.rb +12 -0
- data/lib/kl/compiler.rb +253 -0
- data/lib/kl/cons.rb +51 -0
- data/lib/kl/empty_list.rb +12 -0
- data/lib/kl/environment.rb +123 -0
- data/lib/kl/error.rb +4 -0
- data/lib/kl/internal_error.rb +7 -0
- data/lib/kl/lexer.rb +186 -0
- data/lib/kl/primitives/arithmetic.rb +60 -0
- data/lib/kl/primitives/assignments.rb +18 -0
- data/lib/kl/primitives/booleans.rb +17 -0
- data/lib/kl/primitives/error_handling.rb +13 -0
- data/lib/kl/primitives/generic_functions.rb +22 -0
- data/lib/kl/primitives/lists.rb +21 -0
- data/lib/kl/primitives/streams.rb +38 -0
- data/lib/kl/primitives/strings.rb +55 -0
- data/lib/kl/primitives/symbols.rb +17 -0
- data/lib/kl/primitives/time.rb +17 -0
- data/lib/kl/primitives/vectors.rb +30 -0
- data/lib/kl/reader.rb +40 -0
- data/lib/kl/trampoline.rb +14 -0
- data/lib/shen_ruby.rb +7 -0
- data/lib/shen_ruby/version.rb +3 -0
- data/shen-ruby.gemspec +26 -0
- data/shen/README.txt +17 -0
- data/shen/lib/shen_ruby/shen.rb +124 -0
- data/shen/license.txt +34 -0
- data/shen/release/benchmarks/N_queens.shen +45 -0
- data/shen/release/benchmarks/README.shen +14 -0
- data/shen/release/benchmarks/benchmarks.shen +56 -0
- data/shen/release/benchmarks/bigprog +2173 -0
- data/shen/release/benchmarks/br.shen +13 -0
- data/shen/release/benchmarks/einstein.shen +33 -0
- data/shen/release/benchmarks/heatwave.gif +0 -0
- data/shen/release/benchmarks/interpreter.shen +219 -0
- data/shen/release/benchmarks/picture.jpg +0 -0
- data/shen/release/benchmarks/plato.jpg +0 -0
- data/shen/release/benchmarks/powerset.shen +10 -0
- data/shen/release/benchmarks/prime.shen +10 -0
- data/shen/release/benchmarks/short.shen +129 -0
- data/shen/release/benchmarks/text.txt +68 -0
- data/shen/release/k_lambda/core.kl +1002 -0
- data/shen/release/k_lambda/declarations.kl +1021 -0
- data/shen/release/k_lambda/load.kl +94 -0
- data/shen/release/k_lambda/macros.kl +479 -0
- data/shen/release/k_lambda/prolog.kl +1309 -0
- data/shen/release/k_lambda/reader.kl +1058 -0
- data/shen/release/k_lambda/sequent.kl +556 -0
- data/shen/release/k_lambda/sys.kl +582 -0
- data/shen/release/k_lambda/t-star.kl +3493 -0
- data/shen/release/k_lambda/toplevel.kl +223 -0
- data/shen/release/k_lambda/track.kl +208 -0
- data/shen/release/k_lambda/types.kl +455 -0
- data/shen/release/k_lambda/writer.kl +108 -0
- data/shen/release/k_lambda/yacc.kl +280 -0
- data/shen/release/test_programs/Chap13/problems.txt +26 -0
- data/shen/release/test_programs/README.shen +53 -0
- data/shen/release/test_programs/TinyLispFunctions.txt +16 -0
- data/shen/release/test_programs/TinyTypes.shen +55 -0
- data/shen/release/test_programs/binary.shen +24 -0
- data/shen/release/test_programs/bubble_version_1.shen +28 -0
- data/shen/release/test_programs/bubble_version_2.shen +22 -0
- data/shen/release/test_programs/calculator.shen +21 -0
- data/shen/release/test_programs/cartprod.shen +23 -0
- data/shen/release/test_programs/change.shen +25 -0
- data/shen/release/test_programs/classes-defaults.shen +94 -0
- data/shen/release/test_programs/classes-inheritance.shen +100 -0
- data/shen/release/test_programs/classes-typed.shen +74 -0
- data/shen/release/test_programs/classes-untyped.shen +46 -0
- data/shen/release/test_programs/depth_.shen +14 -0
- data/shen/release/test_programs/einstein.shen +33 -0
- data/shen/release/test_programs/fruit_machine.shen +46 -0
- data/shen/release/test_programs/interpreter.shen +219 -0
- data/shen/release/test_programs/metaprog.shen +85 -0
- data/shen/release/test_programs/minim.shen +193 -0
- data/shen/release/test_programs/mutual.shen +11 -0
- data/shen/release/test_programs/n_queens.shen +45 -0
- data/shen/release/test_programs/newton_version_1.shen +33 -0
- data/shen/release/test_programs/newton_version_2.shen +24 -0
- data/shen/release/test_programs/parse.prl +14 -0
- data/shen/release/test_programs/parser.shen +52 -0
- data/shen/release/test_programs/powerset.shen +10 -0
- data/shen/release/test_programs/prime.shen +10 -0
- data/shen/release/test_programs/proof_assistant.shen +81 -0
- data/shen/release/test_programs/proplog_version_1.shen +25 -0
- data/shen/release/test_programs/proplog_version_2.shen +27 -0
- data/shen/release/test_programs/qmachine.shen +67 -0
- data/shen/release/test_programs/red-black.shen +55 -0
- data/shen/release/test_programs/search.shen +56 -0
- data/shen/release/test_programs/semantic_net.shen +44 -0
- data/shen/release/test_programs/spreadsheet.shen +35 -0
- data/shen/release/test_programs/stack.shen +27 -0
- data/shen/release/test_programs/streams.shen +20 -0
- data/shen/release/test_programs/strings.shen +59 -0
- data/shen/release/test_programs/structures-typed.shen +71 -0
- data/shen/release/test_programs/structures-untyped.shen +42 -0
- data/shen/release/test_programs/tests.shen +294 -0
- data/shen/release/test_programs/types.shen +11 -0
- data/shen/release/test_programs/whist.shen +240 -0
- data/shen/release/test_programs/yacc.shen +136 -0
- data/spec/kl/cons_spec.rb +12 -0
- data/spec/kl/environment_spec.rb +306 -0
- data/spec/kl/lexer_spec.rb +149 -0
- data/spec/kl/primitives/generic_functions_spec.rb +29 -0
- data/spec/kl/primitives/symbols_spec.rb +21 -0
- data/spec/kl/reader_spec.rb +36 -0
- data/spec/spec_helper.rb +2 -0
- 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
|
+
|