shen-ruby 0.3.1 → 0.4.0

Sign up to get free protection for your applications and to get access to all the features.
Files changed (55) hide show
  1. data/.gitignore +2 -0
  2. data/.travis.yml +5 -0
  3. data/Gemfile +2 -2
  4. data/HISTORY.md +12 -0
  5. data/README.md +10 -7
  6. data/Rakefile +92 -0
  7. data/bin/srrepl +2 -2
  8. data/k_lambda_spec/primitives/arithmetic_spec.rb +175 -0
  9. data/k_lambda_spec/primitives/assignments_spec.rb +44 -0
  10. data/k_lambda_spec/primitives/generic_functions_spec.rb +115 -2
  11. data/k_lambda_spec/primitives/lists_spec.rb +40 -0
  12. data/k_lambda_spec/primitives/strings_spec.rb +77 -0
  13. data/k_lambda_spec/primitives/symbols_spec.rb +24 -0
  14. data/k_lambda_spec/primitives/vectors_spec.rb +92 -0
  15. data/k_lambda_spec/support/shared_examples.rb +93 -2
  16. data/k_lambda_spec/tail_recursion_spec.rb +30 -0
  17. data/lib/kl/compiler.rb +19 -33
  18. data/lib/kl/environment.rb +1 -0
  19. data/lib/kl/primitives/assignments.rb +1 -0
  20. data/lib/kl/primitives/generic_functions.rb +7 -0
  21. data/lib/kl/primitives/lists.rb +2 -0
  22. data/lib/kl/primitives/strings.rb +13 -5
  23. data/lib/kl/primitives/symbols.rb +1 -0
  24. data/lib/kl/primitives/vectors.rb +5 -0
  25. data/lib/shen_ruby/version.rb +1 -1
  26. data/shen-ruby.gemspec +1 -1
  27. data/shen/lib/shen_ruby/shen.rb +5 -6
  28. data/shen/release/benchmarks/benchmarks.shen +0 -4
  29. data/shen/release/benchmarks/interpreter.shen +2 -2
  30. data/shen/release/benchmarks/plato.jpg +0 -0
  31. data/shen/release/k_lambda/core.kl +171 -1000
  32. data/shen/release/k_lambda/declarations.kl +90 -992
  33. data/shen/release/k_lambda/load.kl +69 -81
  34. data/shen/release/k_lambda/macros.kl +113 -478
  35. data/shen/release/k_lambda/prolog.kl +250 -1307
  36. data/shen/release/k_lambda/reader.kl +115 -996
  37. data/shen/release/k_lambda/sequent.kl +154 -554
  38. data/shen/release/k_lambda/sys.kl +246 -562
  39. data/shen/release/k_lambda/t-star.kl +114 -3643
  40. data/shen/release/k_lambda/toplevel.kl +136 -221
  41. data/shen/release/k_lambda/track.kl +101 -206
  42. data/shen/release/k_lambda/types.kl +143 -298
  43. data/shen/release/k_lambda/writer.kl +93 -106
  44. data/shen/release/k_lambda/yacc.kl +77 -252
  45. data/shen/release/test_programs/README.shen +1 -1
  46. data/shen/release/test_programs/classes-typed.shen +1 -1
  47. data/shen/release/test_programs/interpreter.shen +2 -2
  48. data/shen/release/test_programs/metaprog.shen +2 -2
  49. data/shen/release/test_programs/prolog.shen +79 -0
  50. data/shen/release/test_programs/structures-typed.shen +2 -2
  51. data/shen/release/test_programs/tests.shen +19 -80
  52. data/shen/release/test_programs/yacc.shen +11 -15
  53. metadata +14 -6
  54. data/Gemfile.lock +0 -20
  55. data/shen/release/benchmarks/br.shen +0 -13
data/shen/release/k_lambda/prolog.kl CHANGED
@@ -1,1309 +1,252 @@
1
+ "**********************************************************************************
2
+ * The License *
3
+ * *
4
+ * The user is free to produce commercial applications with the software, to *
5
+ * distribute these applications in source or binary form, and to charge monies *
6
+ * for them as he sees fit and in concordance with the laws of the land subject *
7
+ * to the following license. *
8
+ * *
9
+ * 1. The license applies to all the software and all derived software and *
10
+ * must appear on such. *
11
+ * *
12
+ * 2. It is illegal to distribute the software without this license attached *
13
+ * to it and use of the software implies agreement with the license as such. *
14
+ * It is illegal for anyone who is not the copyright holder to tamper with *
15
+ * or change the license. *
16
+ * *
17
+ * 3. Neither the names of Lambda Associates or the copyright holder may be used *
18
+ * to endorse or promote products built using the software without specific *
19
+ * prior written permission from the copyright holder. *
20
+ * *
21
+ * 4. That possession of this license does not confer on the copyright holder *
22
+ * any special contractual obligation towards the user. That in no event *
23
+ * shall the copyright holder be liable for any direct, indirect, incidental, *
24
+ * special, exemplary or consequential damages (including but not limited *
25
+ * to procurement of substitute goods or services, loss of use, data, *
26
+ * interruption), however caused and on any theory of liability, whether in *
27
+ * contract, strict liability or tort (including negligence) arising in any *
28
+ * way out of the use of the software, even if advised of the possibility of *
29
+ * such damage. *
30
+ * *
31
+ * 5. It is permitted for the user to change the software, for the purpose of *
32
+ * improving performance, correcting an error, or porting to a new platform, *
33
+ * and distribute the derived version of Shen provided the resulting program *
34
+ * conforms in all respects to the Shen standard and is issued under that *
35
+ * title. The user must make it clear with his distribution that he/she is *
36
+ * the author of the changes and what these changes are and why. *
37
+ * *
38
+ * 6. Derived versions of this software in whatever form are subject to the same *
39
+ * restrictions. In particular it is not permitted to make derived copies of *
40
+ * this software which do not conform to the Shen standard or appear under a *
41
+ * different title. *
42
+ * *
43
+ * It is permitted to distribute versions of Shen which incorporate libraries, *
44
+ * graphics or other facilities which are not part of the Shen standard. *
45
+ * *
46
+ * For an explication of this license see www.shenlanguage.org/license.htm which *
47
+ * explains this license in full. *
48
+ * *
49
+ *****************************************************************************************
50
+ "(defun shen.<defprolog> (V898) (let Result (let Parse_shen.<predicate*> (shen.<predicate*> V898) (if (not (= (fail) Parse_shen.<predicate*>)) (let Parse_shen.<clauses*> (shen.<clauses*> Parse_shen.<predicate*>) (if (not (= (fail) Parse_shen.<clauses*>)) (shen.pair (hd Parse_shen.<clauses*>) (hd (shen.prolog->shen (map (lambda Parse_X (shen.insert-predicate (shen.hdtl Parse_shen.<predicate*>) Parse_X)) (shen.hdtl Parse_shen.<clauses*>))))) (fail))) (fail))) (if (= Result (fail)) (fail) Result)))
51
+
52
+ (defun shen.prolog-error (V905 V906) (cond ((and (cons? V906) (and (cons? (tl V906)) (= () (tl (tl V906))))) (simple-error (cn "prolog syntax error in " (shen.app V905 (cn " here:
53
+
54
+ " (shen.app (shen.next-50 50 (hd V906)) "
55
+ " shen.a)) shen.a)))) (true (simple-error (cn "prolog syntax error in " (shen.app V905 "
56
+ " shen.a))))))
57
+
58
+ (defun shen.next-50 (V911 V912) (cond ((= () V912) "") ((= 0 V911) "") ((cons? V912) (cn (shen.decons-string (hd V912)) (shen.next-50 (- V911 1) (tl V912)))) (true (shen.sys-error shen.next-50))))
59
+
60
+ (defun shen.decons-string (V913) (cond ((and (cons? V913) (and (= cons (hd V913)) (and (cons? (tl V913)) (and (cons? (tl (tl V913))) (= () (tl (tl (tl V913)))))))) (shen.app (shen.eval-cons V913) " " shen.s)) (true (shen.app V913 " " shen.r))))
61
+
62
+ (defun shen.insert-predicate (V914 V915) (cond ((and (cons? V915) (and (cons? (tl V915)) (= () (tl (tl V915))))) (cons (cons V914 (hd V915)) (cons :- (tl V915)))) (true (shen.sys-error shen.insert-predicate))))
63
+
64
+ (defun shen.<predicate*> (V920) (let Result (if (cons? (hd V920)) (let Parse_X (hd (hd V920)) (shen.pair (hd (shen.pair (tl (hd V920)) (shen.hdtl V920))) Parse_X)) (fail)) (if (= Result (fail)) (fail) Result)))
65
+
66
+ (defun shen.<clauses*> (V925) (let Result (let Parse_shen.<clause*> (shen.<clause*> V925) (if (not (= (fail) Parse_shen.<clause*>)) (let Parse_shen.<clauses*> (shen.<clauses*> Parse_shen.<clause*>) (if (not (= (fail) Parse_shen.<clauses*>)) (shen.pair (hd Parse_shen.<clauses*>) (cons (shen.hdtl Parse_shen.<clause*>) (shen.hdtl Parse_shen.<clauses*>))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_<e> (<e> V925) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) (append (shen.hdtl Parse_<e>) ())) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
67
+
68
+ (defun shen.<clause*> (V930) (let Result (let Parse_shen.<head*> (shen.<head*> V930) (if (not (= (fail) Parse_shen.<head*>)) (if (and (cons? (hd Parse_shen.<head*>)) (= <-- (hd (hd Parse_shen.<head*>)))) (let Parse_shen.<body*> (shen.<body*> (shen.pair (tl (hd Parse_shen.<head*>)) (shen.hdtl Parse_shen.<head*>))) (if (not (= (fail) Parse_shen.<body*>)) (let Parse_shen.<end*> (shen.<end*> Parse_shen.<body*>) (if (not (= (fail) Parse_shen.<end*>)) (shen.pair (hd Parse_shen.<end*>) (cons (shen.hdtl Parse_shen.<head*>) (cons (shen.hdtl Parse_shen.<body*>) ()))) (fail))) (fail))) (fail)) (fail))) (if (= Result (fail)) (fail) Result)))
69
+
70
+ (defun shen.<head*> (V935) (let Result (let Parse_shen.<term*> (shen.<term*> V935) (if (not (= (fail) Parse_shen.<term*>)) (let Parse_shen.<head*> (shen.<head*> Parse_shen.<term*>) (if (not (= (fail) Parse_shen.<head*>)) (shen.pair (hd Parse_shen.<head*>) (cons (shen.hdtl Parse_shen.<term*>) (shen.hdtl Parse_shen.<head*>))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_<e> (<e> V935) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) (append (shen.hdtl Parse_<e>) ())) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
71
+
72
+ (defun shen.<term*> (V940) (let Result (if (cons? (hd V940)) (let Parse_X (hd (hd V940)) (if (and (not (= <-- Parse_X)) (shen.legitimate-term? Parse_X)) (shen.pair (hd (shen.pair (tl (hd V940)) (shen.hdtl V940))) (shen.eval-cons Parse_X)) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
73
+
74
+ (defun shen.legitimate-term? (V945) (cond ((and (cons? V945) (and (= cons (hd V945)) (and (cons? (tl V945)) (and (cons? (tl (tl V945))) (= () (tl (tl (tl V945)))))))) (and (shen.legitimate-term? (hd (tl V945))) (shen.legitimate-term? (hd (tl (tl V945)))))) ((and (cons? V945) (and (= mode (hd V945)) (and (cons? (tl V945)) (and (cons? (tl (tl V945))) (and (= + (hd (tl (tl V945)))) (= () (tl (tl (tl V945))))))))) (shen.legitimate-term? (hd (tl V945)))) ((and (cons? V945) (and (= mode (hd V945)) (and (cons? (tl V945)) (and (cons? (tl (tl V945))) (and (= - (hd (tl (tl V945)))) (= () (tl (tl (tl V945))))))))) (shen.legitimate-term? (hd (tl V945)))) ((cons? V945) false) (true true)))
75
+
76
+ (defun shen.eval-cons (V946) (cond ((and (cons? V946) (and (= cons (hd V946)) (and (cons? (tl V946)) (and (cons? (tl (tl V946))) (= () (tl (tl (tl V946)))))))) (cons (shen.eval-cons (hd (tl V946))) (shen.eval-cons (hd (tl (tl V946)))))) ((and (cons? V946) (and (= mode (hd V946)) (and (cons? (tl V946)) (and (cons? (tl (tl V946))) (= () (tl (tl (tl V946)))))))) (cons mode (cons (shen.eval-cons (hd (tl V946))) (tl (tl V946))))) (true V946)))
77
+
78
+ (defun shen.<body*> (V951) (let Result (let Parse_shen.<literal*> (shen.<literal*> V951) (if (not (= (fail) Parse_shen.<literal*>)) (let Parse_shen.<body*> (shen.<body*> Parse_shen.<literal*>) (if (not (= (fail) Parse_shen.<body*>)) (shen.pair (hd Parse_shen.<body*>) (cons (shen.hdtl Parse_shen.<literal*>) (shen.hdtl Parse_shen.<body*>))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_<e> (<e> V951) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) (append (shen.hdtl Parse_<e>) ())) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
79
+
80
+ (defun shen.<literal*> (V956) (let Result (if (and (cons? (hd V956)) (= ! (hd (hd V956)))) (shen.pair (hd (shen.pair (tl (hd V956)) (shen.hdtl V956))) (cons cut (cons (intern "Throwcontrol") ()))) (fail)) (if (= Result (fail)) (let Result (if (cons? (hd V956)) (let Parse_X (hd (hd V956)) (if (cons? Parse_X) (shen.pair (hd (shen.pair (tl (hd V956)) (shen.hdtl V956))) Parse_X) (fail))) (fail)) (if (= Result (fail)) (fail) Result)) Result)))
81
+
82
+ (defun shen.<end*> (V961) (let Result (if (cons? (hd V961)) (let Parse_X (hd (hd V961)) (if (= Parse_X ;) (shen.pair (hd (shen.pair (tl (hd V961)) (shen.hdtl V961))) Parse_X) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
83
+
84
+ (defun cut (V962 V963 V964) (let Result (thaw V964) (if (= Result false) V962 Result)))
85
+
86
+ (defun shen.insert_modes (V965) (cond ((and (cons? V965) (and (= mode (hd V965)) (and (cons? (tl V965)) (and (cons? (tl (tl V965))) (= () (tl (tl (tl V965)))))))) V965) ((= () V965) ()) ((cons? V965) (cons (cons mode (cons (hd V965) (cons + ()))) (cons mode (cons (shen.insert_modes (tl V965)) (cons - ()))))) (true V965)))
87
+
88
+ (defun shen.s-prolog (V966) (map (lambda V892 (eval V892)) (shen.prolog->shen V966)))
89
+
90
+ (defun shen.prolog->shen (V967) (map shen.compile_prolog_procedure (shen.group_clauses (map shen.s-prolog_clause (mapcan shen.head_abstraction V967)))))
91
+
92
+ (defun shen.s-prolog_clause (V968) (cond ((and (cons? V968) (and (cons? (tl V968)) (and (= :- (hd (tl V968))) (and (cons? (tl (tl V968))) (= () (tl (tl (tl V968)))))))) (cons (hd V968) (cons :- (cons (map shen.s-prolog_literal (hd (tl (tl V968)))) ())))) (true (shen.sys-error shen.s-prolog_clause))))
93
+
94
+ (defun shen.head_abstraction (V969) (cond ((and (cons? V969) (and (cons? (tl V969)) (and (= :- (hd (tl V969))) (and (cons? (tl (tl V969))) (and (= () (tl (tl (tl V969)))) (< (shen.complexity_head (hd V969)) (value shen.*maxcomplexity*))))))) (cons V969 ())) ((and (cons? V969) (and (cons? (hd V969)) (and (cons? (tl V969)) (and (= :- (hd (tl V969))) (and (cons? (tl (tl V969))) (= () (tl (tl (tl V969))))))))) (let Terms (map (lambda Y (gensym V)) (tl (hd V969))) (let XTerms (shen.rcons_form (shen.remove_modes (tl (hd V969)))) (let Literal (cons unify (cons (shen.cons_form Terms) (cons XTerms ()))) (let Clause (cons (cons (hd (hd V969)) Terms) (cons :- (cons (cons Literal (hd (tl (tl V969)))) ()))) (cons Clause ())))))) (true (shen.sys-error shen.head_abstraction))))
95
+
96
+ (defun shen.complexity_head (V974) (cond ((cons? V974) (shen.product (map shen.complexity (tl V974)))) (true (shen.sys-error shen.complexity_head))))
97
+
98
+ (defun shen.complexity (V982) (cond ((and (cons? V982) (and (= mode (hd V982)) (and (cons? (tl V982)) (and (cons? (hd (tl V982))) (and (= mode (hd (hd (tl V982)))) (and (cons? (tl (hd (tl V982)))) (and (cons? (tl (tl (hd (tl V982))))) (and (= () (tl (tl (tl (hd (tl V982)))))) (and (cons? (tl (tl V982))) (= () (tl (tl (tl V982))))))))))))) (shen.complexity (hd (tl V982)))) ((and (cons? V982) (and (= mode (hd V982)) (and (cons? (tl V982)) (and (cons? (hd (tl V982))) (and (cons? (tl (tl V982))) (and (= + (hd (tl (tl V982)))) (= () (tl (tl (tl V982)))))))))) (* 2 (* (shen.complexity (cons mode (cons (hd (hd (tl V982))) (tl (tl V982))))) (shen.complexity (cons mode (cons (tl (hd (tl V982))) (tl (tl V982)))))))) ((and (cons? V982) (and (= mode (hd V982)) (and (cons? (tl V982)) (and (cons? (hd (tl V982))) (and (cons? (tl (tl V982))) (and (= - (hd (tl (tl V982)))) (= () (tl (tl (tl V982)))))))))) (* (shen.complexity (cons mode (cons (hd (hd (tl V982))) (tl (tl V982))))) (shen.complexity (cons mode (cons (tl (hd (tl V982))) (tl (tl V982))))))) ((and (cons? V982) (and (= mode (hd V982)) (and (cons? (tl V982)) (and (cons? (tl (tl V982))) (and (= () (tl (tl (tl V982)))) (variable? (hd (tl V982)))))))) 1) ((and (cons? V982) (and (= mode (hd V982)) (and (cons? (tl V982)) (and (cons? (tl (tl V982))) (and (= + (hd (tl (tl V982)))) (= () (tl (tl (tl V982))))))))) 2) ((and (cons? V982) (and (= mode (hd V982)) (and (cons? (tl V982)) (and (cons? (tl (tl V982))) (and (= - (hd (tl (tl V982)))) (= () (tl (tl (tl V982))))))))) 1) (true (shen.complexity (cons mode (cons V982 (cons + ())))))))
99
+
100
+ (defun shen.product (V983) (cond ((= () V983) 1) ((cons? V983) (* (hd V983) (shen.product (tl V983)))) (true (shen.sys-error shen.product))))
101
+
102
+ (defun shen.s-prolog_literal (V984) (cond ((and (cons? V984) (and (= is (hd V984)) (and (cons? (tl V984)) (and (cons? (tl (tl V984))) (= () (tl (tl (tl V984)))))))) (cons bind (cons (hd (tl V984)) (cons (shen.insert_deref (hd (tl (tl V984)))) ())))) ((and (cons? V984) (and (= when (hd V984)) (and (cons? (tl V984)) (= () (tl (tl V984)))))) (cons fwhen (cons (shen.insert_deref (hd (tl V984))) ()))) ((and (cons? V984) (and (= bind (hd V984)) (and (cons? (tl V984)) (and (cons? (tl (tl V984))) (= () (tl (tl (tl V984)))))))) (cons bind (cons (hd (tl V984)) (cons (shen.insert_lazyderef (hd (tl (tl V984)))) ())))) ((and (cons? V984) (and (= fwhen (hd V984)) (and (cons? (tl V984)) (= () (tl (tl V984)))))) (cons fwhen (cons (shen.insert_lazyderef (hd (tl V984))) ()))) ((cons? V984) (cons (shen.m_prolog_to_s-prolog_predicate (hd V984)) (tl V984))) (true (shen.sys-error shen.s-prolog_literal))))
103
+
104
+ (defun shen.insert_deref (V985) (cond ((variable? V985) (cons shen.deref (cons V985 (cons ProcessN ())))) ((cons? V985) (cons (shen.insert_deref (hd V985)) (shen.insert_deref (tl V985)))) (true V985)))
105
+
106
+ (defun shen.insert_lazyderef (V986) (cond ((variable? V986) (cons shen.lazyderef (cons V986 (cons ProcessN ())))) ((cons? V986) (cons (shen.insert_lazyderef (hd V986)) (shen.insert_lazyderef (tl V986)))) (true V986)))
107
+
108
+ (defun shen.m_prolog_to_s-prolog_predicate (V987) (cond ((= = V987) unify) ((= =! V987) unify!) ((= == V987) identical) (true V987)))
109
+
110
+ (defun shen.group_clauses (V988) (cond ((= () V988) ()) ((cons? V988) (let Group (shen.collect (lambda X (shen.same_predicate? (hd V988) X)) V988) (let Rest (difference V988 Group) (cons Group (shen.group_clauses Rest))))) (true (shen.sys-error shen.group_clauses))))
111
+
112
+ (defun shen.collect (V991 V992) (cond ((= () V992) ()) ((cons? V992) (if (V991 (hd V992)) (cons (hd V992) (shen.collect V991 (tl V992))) (shen.collect V991 (tl V992)))) (true (shen.sys-error shen.collect))))
113
+
114
+ (defun shen.same_predicate? (V1009 V1010) (cond ((and (cons? V1009) (and (cons? (hd V1009)) (and (cons? V1010) (cons? (hd V1010))))) (= (hd (hd V1009)) (hd (hd V1010)))) (true (shen.sys-error shen.same_predicate?))))
115
+
116
+ (defun shen.compile_prolog_procedure (V1011) (let F (shen.procedure_name V1011) (let Shen (shen.clauses-to-shen F V1011) Shen)))
117
+
118
+ (defun shen.procedure_name (V1024) (cond ((and (cons? V1024) (and (cons? (hd V1024)) (cons? (hd (hd V1024))))) (hd (hd (hd V1024)))) (true (shen.sys-error shen.procedure_name))))
119
+
120
+ (defun shen.clauses-to-shen (V1025 V1026) (let Linear (map shen.linearise-clause V1026) (let Arity (shen.prolog-aritycheck V1025 (map (lambda V893 (head V893)) V1026)) (let Parameters (shen.parameters Arity) (let AUM_instructions (map (lambda X (shen.aum X Parameters)) Linear) (let Code (shen.catch-cut (shen.nest-disjunct (map shen.aum_to_shen AUM_instructions))) (let ShenDef (cons define (cons V1025 (append Parameters (append (cons ProcessN (cons Continuation ())) (cons -> (cons Code ())))))) ShenDef)))))))
121
+
122
+ (defun shen.catch-cut (V1027) (cond ((not (shen.occurs? cut V1027)) V1027) (true (cons let (cons Throwcontrol (cons (cons shen.catchpoint ()) (cons (cons shen.cutpoint (cons Throwcontrol (cons V1027 ()))) ())))))))
123
+
124
+ (defun shen.catchpoint () (set shen.*catch* (+ 1 (value shen.*catch*))))
125
+
126
+ (defun shen.cutpoint (V1032 V1033) (cond ((= V1033 V1032) false) (true V1033)))
127
+
128
+ (defun shen.nest-disjunct (V1035) (cond ((and (cons? V1035) (= () (tl V1035))) (hd V1035)) ((cons? V1035) (shen.lisp-or (hd V1035) (shen.nest-disjunct (tl V1035)))) (true (shen.sys-error shen.nest-disjunct))))
129
+
130
+ (defun shen.lisp-or (V1036 V1037) (cons let (cons Case (cons V1036 (cons (cons if (cons (cons = (cons Case (cons false ()))) (cons V1037 (cons Case ())))) ())))))
131
+
132
+ (defun shen.prolog-aritycheck (V1040 V1041) (cond ((and (cons? V1041) (= () (tl V1041))) (- (length (hd V1041)) 1)) ((and (cons? V1041) (cons? (tl V1041))) (if (= (length (hd V1041)) (length (hd (tl V1041)))) (shen.prolog-aritycheck V1040 (tl V1041)) (simple-error (cn "arity error in prolog procedure " (shen.app (cons V1040 ()) "
133
+ " shen.a))))) (true (shen.sys-error shen.prolog-aritycheck))))
134
+
135
+ (defun shen.linearise-clause (V1042) (cond ((and (cons? V1042) (and (cons? (tl V1042)) (and (= :- (hd (tl V1042))) (and (cons? (tl (tl V1042))) (= () (tl (tl (tl V1042)))))))) (let Linear (shen.linearise (cons (hd V1042) (tl (tl V1042)))) (shen.clause_form Linear))) (true (shen.sys-error shen.linearise-clause))))
136
+
137
+ (defun shen.clause_form (V1043) (cond ((and (cons? V1043) (and (cons? (tl V1043)) (= () (tl (tl V1043))))) (cons (shen.explicit_modes (hd V1043)) (cons :- (cons (shen.cf_help (hd (tl V1043))) ())))) (true (shen.sys-error shen.clause_form))))
138
+
139
+ (defun shen.explicit_modes (V1044) (cond ((cons? V1044) (cons (hd V1044) (map shen.em_help (tl V1044)))) (true (shen.sys-error shen.explicit_modes))))
140
+
141
+ (defun shen.em_help (V1045) (cond ((and (cons? V1045) (and (= mode (hd V1045)) (and (cons? (tl V1045)) (and (cons? (tl (tl V1045))) (= () (tl (tl (tl V1045)))))))) V1045) (true (cons mode (cons V1045 (cons + ()))))))
142
+
143
+ (defun shen.cf_help (V1046) (cond ((and (cons? V1046) (and (= where (hd V1046)) (and (cons? (tl V1046)) (and (cons? (hd (tl V1046))) (and (= = (hd (hd (tl V1046)))) (and (cons? (tl (hd (tl V1046)))) (and (cons? (tl (tl (hd (tl V1046))))) (and (= () (tl (tl (tl (hd (tl V1046)))))) (and (cons? (tl (tl V1046))) (= () (tl (tl (tl V1046))))))))))))) (cons (cons (if (value shen.*occurs*) unify! unify) (tl (hd (tl V1046)))) (shen.cf_help (hd (tl (tl V1046)))))) (true V1046)))
144
+
145
+ (defun occurs-check (V1051) (cond ((= + V1051) (set shen.*occurs* true)) ((= - V1051) (set shen.*occurs* false)) (true (simple-error "occurs-check expects + or -
146
+ "))))
147
+
148
+ (defun shen.aum (V1052 V1053) (cond ((and (cons? V1052) (and (cons? (hd V1052)) (and (cons? (tl V1052)) (and (= :- (hd (tl V1052))) (and (cons? (tl (tl V1052))) (= () (tl (tl (tl V1052))))))))) (let MuApplication (shen.make_mu_application (cons shen.mu (cons (tl (hd V1052)) (cons (shen.continuation_call (tl (hd V1052)) (hd (tl (tl V1052)))) ()))) V1053) (shen.mu_reduction MuApplication +))) (true (shen.sys-error shen.aum))))
149
+
150
+ (defun shen.continuation_call (V1054 V1055) (let VTerms (cons ProcessN (shen.extract_vars V1054)) (let VBody (shen.extract_vars V1055) (let Free (remove Throwcontrol (difference VBody VTerms)) (shen.cc_help Free V1055)))))
151
+
152
+ (defun remove (V1056 V1057) (shen.remove-h V1056 V1057 ()))
153
+
154
+ (defun shen.remove-h (V1060 V1061 V1062) (cond ((= () V1061) (reverse V1062)) ((and (cons? V1061) (= (hd V1061) V1060)) (shen.remove-h (hd V1061) (tl V1061) V1062)) ((cons? V1061) (shen.remove-h V1060 (tl V1061) (cons (hd V1061) V1062))) (true (shen.sys-error shen.remove-h))))
155
+
156
+ (defun shen.cc_help (V1064 V1065) (cond ((and (= () V1064) (= () V1065)) (cons shen.pop (cons shen.the (cons shen.stack ())))) ((= () V1065) (cons shen.rename (cons shen.the (cons shen.variables (cons in (cons V1064 (cons and (cons shen.then (cons (cons shen.pop (cons shen.the (cons shen.stack ()))) ()))))))))) ((= () V1064) (cons call (cons shen.the (cons shen.continuation (cons V1065 ()))))) (true (cons shen.rename (cons shen.the (cons shen.variables (cons in (cons V1064 (cons and (cons shen.then (cons (cons call (cons shen.the (cons shen.continuation (cons V1065 ())))) ())))))))))))
157
+
158
+ (defun shen.make_mu_application (V1066 V1067) (cond ((and (cons? V1066) (and (= shen.mu (hd V1066)) (and (cons? (tl V1066)) (and (= () (hd (tl V1066))) (and (cons? (tl (tl V1066))) (and (= () (tl (tl (tl V1066)))) (= () V1067))))))) (hd (tl (tl V1066)))) ((and (cons? V1066) (and (= shen.mu (hd V1066)) (and (cons? (tl V1066)) (and (cons? (hd (tl V1066))) (and (cons? (tl (tl V1066))) (and (= () (tl (tl (tl V1066)))) (cons? V1067))))))) (cons (cons shen.mu (cons (hd (hd (tl V1066))) (cons (shen.make_mu_application (cons shen.mu (cons (tl (hd (tl V1066))) (tl (tl V1066)))) (tl V1067)) ()))) (cons (hd V1067) ()))) (true (shen.sys-error shen.make_mu_application))))
159
+
160
+ (defun shen.mu_reduction (V1074 V1075) (cond ((and (cons? V1074) (and (cons? (hd V1074)) (and (= shen.mu (hd (hd V1074))) (and (cons? (tl (hd V1074))) (and (cons? (hd (tl (hd V1074)))) (and (= mode (hd (hd (tl (hd V1074))))) (and (cons? (tl (hd (tl (hd V1074))))) (and (cons? (tl (tl (hd (tl (hd V1074)))))) (and (= () (tl (tl (tl (hd (tl (hd V1074))))))) (and (cons? (tl (tl (hd V1074)))) (and (= () (tl (tl (tl (hd V1074))))) (and (cons? (tl V1074)) (= () (tl (tl V1074))))))))))))))) (shen.mu_reduction (cons (cons shen.mu (cons (hd (tl (hd (tl (hd V1074))))) (tl (tl (hd V1074))))) (tl V1074)) (hd (tl (tl (hd (tl (hd V1074)))))))) ((and (cons? V1074) (and (cons? (hd V1074)) (and (= shen.mu (hd (hd V1074))) (and (cons? (tl (hd V1074))) (and (cons? (tl (tl (hd V1074)))) (and (= () (tl (tl (tl (hd V1074))))) (and (cons? (tl V1074)) (and (= () (tl (tl V1074))) (= _ (hd (tl (hd V1074)))))))))))) (shen.mu_reduction (hd (tl (tl (hd V1074)))) V1075)) ((and (cons? V1074) (and (cons? (hd V1074)) (and (= shen.mu (hd (hd V1074))) (and (cons? (tl (hd V1074))) (and (cons? (tl (tl (hd V1074)))) (and (= () (tl (tl (tl (hd V1074))))) (and (cons? (tl V1074)) (and (= () (tl (tl V1074))) (shen.ephemeral_variable? (hd (tl (hd V1074))) (hd (tl V1074))))))))))) (subst (hd (tl V1074)) (hd (tl (hd V1074))) (shen.mu_reduction (hd (tl (tl (hd V1074)))) V1075))) ((and (cons? V1074) (and (cons? (hd V1074)) (and (= shen.mu (hd (hd V1074))) (and (cons? (tl (hd V1074))) (and (cons? (tl (tl (hd V1074)))) (and (= () (tl (tl (tl (hd V1074))))) (and (cons? (tl V1074)) (and (= () (tl (tl V1074))) (variable? (hd (tl (hd V1074)))))))))))) (cons let (cons (hd (tl (hd V1074))) (cons shen.be (cons (hd (tl V1074)) (cons in (cons (shen.mu_reduction (hd (tl (tl (hd V1074)))) V1075) ()))))))) ((and (cons? V1074) (and (cons? (hd V1074)) (and (= shen.mu (hd (hd V1074))) (and (cons? (tl (hd V1074))) (and (cons? (tl (tl (hd V1074)))) (and (= () (tl (tl (tl (hd V1074))))) (and (cons? (tl V1074)) (and (= () (tl (tl V1074))) (and (= - V1075) (shen.prolog_constant? (hd (tl (hd V1074))))))))))))) (let Z (gensym V) (cons let (cons Z (cons shen.be (cons (cons shen.the (cons shen.result (cons shen.of (cons shen.dereferencing (tl V1074))))) (cons in (cons (cons if (cons (cons Z (cons is (cons identical (cons shen.to (cons (hd (tl (hd V1074))) ()))))) (cons shen.then (cons (shen.mu_reduction (hd (tl (tl (hd V1074)))) -) (cons shen.else (cons shen.failed! ())))))) ())))))))) ((and (cons? V1074) (and (cons? (hd V1074)) (and (= shen.mu (hd (hd V1074))) (and (cons? (tl (hd V1074))) (and (cons? (tl (tl (hd V1074)))) (and (= () (tl (tl (tl (hd V1074))))) (and (cons? (tl V1074)) (and (= () (tl (tl V1074))) (and (= + V1075) (shen.prolog_constant? (hd (tl (hd V1074))))))))))))) (let Z (gensym V) (cons let (cons Z (cons shen.be (cons (cons shen.the (cons shen.result (cons shen.of (cons shen.dereferencing (tl V1074))))) (cons in (cons (cons if (cons (cons Z (cons is (cons identical (cons shen.to (cons (hd (tl (hd V1074))) ()))))) (cons shen.then (cons (shen.mu_reduction (hd (tl (tl (hd V1074)))) +) (cons shen.else (cons (cons if (cons (cons Z (cons is (cons shen.a (cons shen.variable ())))) (cons shen.then (cons (cons bind (cons Z (cons shen.to (cons (hd (tl (hd V1074))) (cons in (cons (shen.mu_reduction (hd (tl (tl (hd V1074)))) +) ())))))) (cons shen.else (cons shen.failed! ())))))) ())))))) ())))))))) ((and (cons? V1074) (and (cons? (hd V1074)) (and (= shen.mu (hd (hd V1074))) (and (cons? (tl (hd V1074))) (and (cons? (hd (tl (hd V1074)))) (and (cons? (tl (tl (hd V1074)))) (and (= () (tl (tl (tl (hd V1074))))) (and (cons? (tl V1074)) (and (= () (tl (tl V1074))) (= - V1075)))))))))) (let Z (gensym V) (cons let (cons Z (cons shen.be (cons (cons shen.the (cons shen.result (cons shen.of (cons shen.dereferencing (tl V1074))))) (cons in (cons (cons if (cons (cons Z (cons is (cons shen.a (cons shen.non-empty (cons list ()))))) (cons shen.then (cons (shen.mu_reduction (cons (cons shen.mu (cons (hd (hd (tl (hd V1074)))) (cons (cons (cons shen.mu (cons (tl (hd (tl (hd V1074)))) (tl (tl (hd V1074))))) (cons (cons shen.the (cons tail (cons shen.of (cons Z ())))) ())) ()))) (cons (cons shen.the (cons head (cons shen.of (cons Z ())))) ())) -) (cons shen.else (cons shen.failed! ())))))) ())))))))) ((and (cons? V1074) (and (cons? (hd V1074)) (and (= shen.mu (hd (hd V1074))) (and (cons? (tl (hd V1074))) (and (cons? (hd (tl (hd V1074)))) (and (cons? (tl (tl (hd V1074)))) (and (= () (tl (tl (tl (hd V1074))))) (and (cons? (tl V1074)) (and (= () (tl (tl V1074))) (= + V1075)))))))))) (let Z (gensym V) (cons let (cons Z (cons shen.be (cons (cons shen.the (cons shen.result (cons shen.of (cons shen.dereferencing (tl V1074))))) (cons in (cons (cons if (cons (cons Z (cons is (cons shen.a (cons shen.non-empty (cons list ()))))) (cons shen.then (cons (shen.mu_reduction (cons (cons shen.mu (cons (hd (hd (tl (hd V1074)))) (cons (cons (cons shen.mu (cons (tl (hd (tl (hd V1074)))) (tl (tl (hd V1074))))) (cons (cons shen.the (cons tail (cons shen.of (cons Z ())))) ())) ()))) (cons (cons shen.the (cons head (cons shen.of (cons Z ())))) ())) +) (cons shen.else (cons (cons if (cons (cons Z (cons is (cons shen.a (cons shen.variable ())))) (cons shen.then (cons (cons shen.rename (cons shen.the (cons shen.variables (cons in (cons (shen.extract_vars (hd (tl (hd V1074)))) (cons and (cons shen.then (cons (cons bind (cons Z (cons shen.to (cons (shen.rcons_form (shen.remove_modes (hd (tl (hd V1074))))) (cons in (cons (shen.mu_reduction (hd (tl (tl (hd V1074)))) +) ())))))) ())))))))) (cons shen.else (cons shen.failed! ())))))) ())))))) ())))))))) (true V1074)))
161
+
162
+ (defun shen.rcons_form (V1076) (cond ((cons? V1076) (cons cons (cons (shen.rcons_form (hd V1076)) (cons (shen.rcons_form (tl V1076)) ())))) (true V1076)))
163
+
164
+ (defun shen.remove_modes (V1077) (cond ((and (cons? V1077) (and (= mode (hd V1077)) (and (cons? (tl V1077)) (and (cons? (tl (tl V1077))) (and (= + (hd (tl (tl V1077)))) (= () (tl (tl (tl V1077))))))))) (shen.remove_modes (hd (tl V1077)))) ((and (cons? V1077) (and (= mode (hd V1077)) (and (cons? (tl V1077)) (and (cons? (tl (tl V1077))) (and (= - (hd (tl (tl V1077)))) (= () (tl (tl (tl V1077))))))))) (shen.remove_modes (hd (tl V1077)))) ((cons? V1077) (cons (shen.remove_modes (hd V1077)) (shen.remove_modes (tl V1077)))) (true V1077)))
165
+
166
+ (defun shen.ephemeral_variable? (V1078 V1079) (and (variable? V1078) (variable? V1079)))
167
+
168
+ (defun shen.prolog_constant? (V1088) (cond ((cons? V1088) false) (true true)))
169
+
170
+ (defun shen.aum_to_shen (V1089) (cond ((and (cons? V1089) (and (= let (hd V1089)) (and (cons? (tl V1089)) (and (cons? (tl (tl V1089))) (and (= shen.be (hd (tl (tl V1089)))) (and (cons? (tl (tl (tl V1089)))) (and (cons? (tl (tl (tl (tl V1089))))) (and (= in (hd (tl (tl (tl (tl V1089)))))) (and (cons? (tl (tl (tl (tl (tl V1089)))))) (= () (tl (tl (tl (tl (tl (tl V1089)))))))))))))))) (cons let (cons (hd (tl V1089)) (cons (shen.aum_to_shen (hd (tl (tl (tl V1089))))) (cons (shen.aum_to_shen (hd (tl (tl (tl (tl (tl V1089))))))) ()))))) ((and (cons? V1089) (and (= shen.the (hd V1089)) (and (cons? (tl V1089)) (and (= shen.result (hd (tl V1089))) (and (cons? (tl (tl V1089))) (and (= shen.of (hd (tl (tl V1089)))) (and (cons? (tl (tl (tl V1089)))) (and (= shen.dereferencing (hd (tl (tl (tl V1089))))) (and (cons? (tl (tl (tl (tl V1089))))) (= () (tl (tl (tl (tl (tl V1089))))))))))))))) (cons shen.lazyderef (cons (shen.aum_to_shen (hd (tl (tl (tl (tl V1089)))))) (cons ProcessN ())))) ((and (cons? V1089) (and (= if (hd V1089)) (and (cons? (tl V1089)) (and (cons? (tl (tl V1089))) (and (= shen.then (hd (tl (tl V1089)))) (and (cons? (tl (tl (tl V1089)))) (and (cons? (tl (tl (tl (tl V1089))))) (and (= shen.else (hd (tl (tl (tl (tl V1089)))))) (and (cons? (tl (tl (tl (tl (tl V1089)))))) (= () (tl (tl (tl (tl (tl (tl V1089)))))))))))))))) (cons if (cons (shen.aum_to_shen (hd (tl V1089))) (cons (shen.aum_to_shen (hd (tl (tl (tl V1089))))) (cons (shen.aum_to_shen (hd (tl (tl (tl (tl (tl V1089))))))) ()))))) ((and (cons? V1089) (and (cons? (tl V1089)) (and (= is (hd (tl V1089))) (and (cons? (tl (tl V1089))) (and (= shen.a (hd (tl (tl V1089)))) (and (cons? (tl (tl (tl V1089)))) (and (= shen.variable (hd (tl (tl (tl V1089))))) (= () (tl (tl (tl (tl V1089)))))))))))) (cons shen.pvar? (cons (hd V1089) ()))) ((and (cons? V1089) (and (cons? (tl V1089)) (and (= is (hd (tl V1089))) (and (cons? (tl (tl V1089))) (and (= shen.a (hd (tl (tl V1089)))) (and (cons? (tl (tl (tl V1089)))) (and (= shen.non-empty (hd (tl (tl (tl V1089))))) (and (cons? (tl (tl (tl (tl V1089))))) (and (= list (hd (tl (tl (tl (tl V1089)))))) (= () (tl (tl (tl (tl (tl V1089))))))))))))))) (cons cons? (cons (hd V1089) ()))) ((and (cons? V1089) (and (= shen.rename (hd V1089)) (and (cons? (tl V1089)) (and (= shen.the (hd (tl V1089))) (and (cons? (tl (tl V1089))) (and (= shen.variables (hd (tl (tl V1089)))) (and (cons? (tl (tl (tl V1089)))) (and (= in (hd (tl (tl (tl V1089))))) (and (cons? (tl (tl (tl (tl V1089))))) (and (= () (hd (tl (tl (tl (tl V1089)))))) (and (cons? (tl (tl (tl (tl (tl V1089)))))) (and (= and (hd (tl (tl (tl (tl (tl V1089))))))) (and (cons? (tl (tl (tl (tl (tl (tl V1089))))))) (and (= shen.then (hd (tl (tl (tl (tl (tl (tl V1089)))))))) (and (cons? (tl (tl (tl (tl (tl (tl (tl V1089)))))))) (= () (tl (tl (tl (tl (tl (tl (tl (tl V1089)))))))))))))))))))))))) (shen.aum_to_shen (hd (tl (tl (tl (tl (tl (tl (tl V1089)))))))))) ((and (cons? V1089) (and (= shen.rename (hd V1089)) (and (cons? (tl V1089)) (and (= shen.the (hd (tl V1089))) (and (cons? (tl (tl V1089))) (and (= shen.variables (hd (tl (tl V1089)))) (and (cons? (tl (tl (tl V1089)))) (and (= in (hd (tl (tl (tl V1089))))) (and (cons? (tl (tl (tl (tl V1089))))) (and (cons? (hd (tl (tl (tl (tl V1089)))))) (and (cons? (tl (tl (tl (tl (tl V1089)))))) (and (= and (hd (tl (tl (tl (tl (tl V1089))))))) (and (cons? (tl (tl (tl (tl (tl (tl V1089))))))) (and (= shen.then (hd (tl (tl (tl (tl (tl (tl V1089)))))))) (and (cons? (tl (tl (tl (tl (tl (tl (tl V1089)))))))) (= () (tl (tl (tl (tl (tl (tl (tl (tl V1089)))))))))))))))))))))))) (cons let (cons (hd (hd (tl (tl (tl (tl V1089)))))) (cons (cons shen.newpv (cons ProcessN ())) (cons (shen.aum_to_shen (cons shen.rename (cons shen.the (cons shen.variables (cons in (cons (tl (hd (tl (tl (tl (tl V1089)))))) (tl (tl (tl (tl (tl V1089))))))))))) ()))))) ((and (cons? V1089) (and (= bind (hd V1089)) (and (cons? (tl V1089)) (and (cons? (tl (tl V1089))) (and (= shen.to (hd (tl (tl V1089)))) (and (cons? (tl (tl (tl V1089)))) (and (cons? (tl (tl (tl (tl V1089))))) (and (= in (hd (tl (tl (tl (tl V1089)))))) (and (cons? (tl (tl (tl (tl (tl V1089)))))) (= () (tl (tl (tl (tl (tl (tl V1089)))))))))))))))) (cons do (cons (cons shen.bindv (cons (hd (tl V1089)) (cons (shen.chwild (hd (tl (tl (tl V1089))))) (cons ProcessN ())))) (cons (cons let (cons Result (cons (shen.aum_to_shen (hd (tl (tl (tl (tl (tl V1089))))))) (cons (cons do (cons (cons shen.unbindv (cons (hd (tl V1089)) (cons ProcessN ()))) (cons Result ()))) ())))) ())))) ((and (cons? V1089) (and (cons? (tl V1089)) (and (= is (hd (tl V1089))) (and (cons? (tl (tl V1089))) (and (= identical (hd (tl (tl V1089)))) (and (cons? (tl (tl (tl V1089)))) (and (= shen.to (hd (tl (tl (tl V1089))))) (and (cons? (tl (tl (tl (tl V1089))))) (= () (tl (tl (tl (tl (tl V1089)))))))))))))) (cons = (cons (hd (tl (tl (tl (tl V1089))))) (cons (hd V1089) ())))) ((= shen.failed! V1089) false) ((and (cons? V1089) (and (= shen.the (hd V1089)) (and (cons? (tl V1089)) (and (= head (hd (tl V1089))) (and (cons? (tl (tl V1089))) (and (= shen.of (hd (tl (tl V1089)))) (and (cons? (tl (tl (tl V1089)))) (= () (tl (tl (tl (tl V1089)))))))))))) (cons hd (tl (tl (tl V1089))))) ((and (cons? V1089) (and (= shen.the (hd V1089)) (and (cons? (tl V1089)) (and (= tail (hd (tl V1089))) (and (cons? (tl (tl V1089))) (and (= shen.of (hd (tl (tl V1089)))) (and (cons? (tl (tl (tl V1089)))) (= () (tl (tl (tl (tl V1089)))))))))))) (cons tl (tl (tl (tl V1089))))) ((and (cons? V1089) (and (= shen.pop (hd V1089)) (and (cons? (tl V1089)) (and (= shen.the (hd (tl V1089))) (and (cons? (tl (tl V1089))) (and (= shen.stack (hd (tl (tl V1089)))) (= () (tl (tl (tl V1089)))))))))) (cons do (cons (cons shen.incinfs ()) (cons (cons thaw (cons Continuation ())) ())))) ((and (cons? V1089) (and (= call (hd V1089)) (and (cons? (tl V1089)) (and (= shen.the (hd (tl V1089))) (and (cons? (tl (tl V1089))) (and (= shen.continuation (hd (tl (tl V1089)))) (and (cons? (tl (tl (tl V1089)))) (= () (tl (tl (tl (tl V1089)))))))))))) (cons do (cons (cons shen.incinfs ()) (cons (shen.call_the_continuation (shen.chwild (hd (tl (tl (tl V1089))))) ProcessN Continuation) ())))) (true V1089)))
171
+
172
+ (defun shen.chwild (V1090) (cond ((= V1090 _) (cons shen.newpv (cons ProcessN ()))) ((cons? V1090) (map shen.chwild V1090)) (true V1090)))
173
+
174
+ (defun shen.newpv (V1091) (let Count+1 (+ (<-address (value shen.*varcounter*) V1091) 1) (let IncVar (address-> (value shen.*varcounter*) V1091 Count+1) (let Vector (<-address (value shen.*prologvectors*) V1091) (let ResizeVectorIfNeeded (if (= Count+1 (limit Vector)) (shen.resizeprocessvector V1091 Count+1) shen.skip) (shen.mk-pvar Count+1))))))
175
+
176
+ (defun shen.resizeprocessvector (V1092 V1093) (let Vector (<-address (value shen.*prologvectors*) V1092) (let BigVector (shen.resize-vector Vector (+ V1093 V1093) shen.-null-) (address-> (value shen.*prologvectors*) V1092 BigVector))))
177
+
178
+ (defun shen.resize-vector (V1094 V1095 V1096) (let BigVector (address-> (absvector (+ 1 V1095)) 0 V1095) (shen.copy-vector V1094 BigVector (limit V1094) V1095 V1096)))
179
+
180
+ (defun shen.copy-vector (V1097 V1098 V1099 V1100 V1101) (shen.copy-vector-stage-2 (+ 1 V1099) (+ V1100 1) V1101 (shen.copy-vector-stage-1 1 V1097 V1098 (+ 1 V1099))))
181
+
182
+ (defun shen.copy-vector-stage-1 (V1104 V1105 V1106 V1107) (cond ((= V1107 V1104) V1106) (true (shen.copy-vector-stage-1 (+ 1 V1104) V1105 (address-> V1106 V1104 (<-address V1105 V1104)) V1107))))
183
+
184
+ (defun shen.copy-vector-stage-2 (V1111 V1112 V1113 V1114) (cond ((= V1112 V1111) V1114) (true (shen.copy-vector-stage-2 (+ V1111 1) V1112 V1113 (address-> V1114 V1111 V1113)))))
185
+
186
+ (defun shen.mk-pvar (V1116) (address-> (address-> (absvector 2) 0 shen.pvar) 1 V1116))
187
+
188
+ (defun shen.pvar? (V1117) (and (absvector? V1117) (= (<-address V1117 0) shen.pvar)))
189
+
190
+ (defun shen.bindv (V1118 V1119 V1120) (let Vector (<-address (value shen.*prologvectors*) V1120) (address-> Vector (<-address V1118 1) V1119)))
191
+
192
+ (defun shen.unbindv (V1121 V1122) (let Vector (<-address (value shen.*prologvectors*) V1122) (address-> Vector (<-address V1121 1) shen.-null-)))
193
+
194
+ (defun shen.incinfs () (set shen.*infs* (+ 1 (value shen.*infs*))))
195
+
196
+ (defun shen.call_the_continuation (V1123 V1124 V1125) (cond ((and (cons? V1123) (and (cons? (hd V1123)) (= () (tl V1123)))) (cons (hd (hd V1123)) (append (tl (hd V1123)) (cons V1124 (cons V1125 ()))))) ((and (cons? V1123) (cons? (hd V1123))) (let NewContinuation (shen.newcontinuation (tl V1123) V1124 V1125) (cons (hd (hd V1123)) (append (tl (hd V1123)) (cons V1124 (cons NewContinuation ())))))) (true (shen.sys-error shen.call_the_continuation))))
197
+
198
+ (defun shen.newcontinuation (V1126 V1127 V1128) (cond ((= () V1126) V1128) ((and (cons? V1126) (cons? (hd V1126))) (cons freeze (cons (cons (hd (hd V1126)) (append (tl (hd V1126)) (cons V1127 (cons (shen.newcontinuation (tl V1126) V1127 V1128) ())))) ()))) (true (shen.sys-error shen.newcontinuation))))
199
+
200
+ (defun return (V1133 V1134 V1135) (shen.deref V1133 V1134))
201
+
202
+ (defun shen.measure&return (V1140 V1141 V1142) (do (pr (shen.app (value shen.*infs*) " inferences
203
+ " shen.a) (stoutput)) (shen.deref V1140 V1141)))
204
+
205
+ (defun unify (V1143 V1144 V1145 V1146) (shen.lzy= (shen.lazyderef V1143 V1145) (shen.lazyderef V1144 V1145) V1145 V1146))
206
+
207
+ (defun shen.lzy= (V1163 V1164 V1165 V1166) (cond ((= V1164 V1163) (thaw V1166)) ((shen.pvar? V1163) (bind V1163 V1164 V1165 V1166)) ((shen.pvar? V1164) (bind V1164 V1163 V1165 V1166)) ((and (cons? V1163) (cons? V1164)) (shen.lzy= (shen.lazyderef (hd V1163) V1165) (shen.lazyderef (hd V1164) V1165) V1165 (freeze (shen.lzy= (shen.lazyderef (tl V1163) V1165) (shen.lazyderef (tl V1164) V1165) V1165 V1166)))) (true false)))
208
+
209
+ (defun shen.deref (V1168 V1169) (cond ((cons? V1168) (cons (shen.deref (hd V1168) V1169) (shen.deref (tl V1168) V1169))) (true (if (shen.pvar? V1168) (let Value (shen.valvector V1168 V1169) (if (= Value shen.-null-) V1168 (shen.deref Value V1169))) V1168))))
210
+
211
+ (defun shen.lazyderef (V1170 V1171) (if (shen.pvar? V1170) (let Value (shen.valvector V1170 V1171) (if (= Value shen.-null-) V1170 (shen.lazyderef Value V1171))) V1170))
212
+
213
+ (defun shen.valvector (V1172 V1173) (<-address (<-address (value shen.*prologvectors*) V1173) (<-address V1172 1)))
214
+
215
+ (defun unify! (V1174 V1175 V1176 V1177) (shen.lzy=! (shen.lazyderef V1174 V1176) (shen.lazyderef V1175 V1176) V1176 V1177))
216
+
217
+ (defun shen.lzy=! (V1194 V1195 V1196 V1197) (cond ((= V1195 V1194) (thaw V1197)) ((and (shen.pvar? V1194) (not (shen.occurs? V1194 (shen.deref V1195 V1196)))) (bind V1194 V1195 V1196 V1197)) ((and (shen.pvar? V1195) (not (shen.occurs? V1195 (shen.deref V1194 V1196)))) (bind V1195 V1194 V1196 V1197)) ((and (cons? V1194) (cons? V1195)) (shen.lzy=! (shen.lazyderef (hd V1194) V1196) (shen.lazyderef (hd V1195) V1196) V1196 (freeze (shen.lzy=! (shen.lazyderef (tl V1194) V1196) (shen.lazyderef (tl V1195) V1196) V1196 V1197)))) (true false)))
218
+
219
+ (defun shen.occurs? (V1207 V1208) (cond ((= V1208 V1207) true) ((cons? V1208) (or (shen.occurs? V1207 (hd V1208)) (shen.occurs? V1207 (tl V1208)))) (true false)))
220
+
221
+ (defun identical (V1210 V1211 V1212 V1213) (shen.lzy== (shen.lazyderef V1210 V1212) (shen.lazyderef V1211 V1212) V1212 V1213))
222
+
223
+ (defun shen.lzy== (V1230 V1231 V1232 V1233) (cond ((= V1231 V1230) (thaw V1233)) ((and (cons? V1230) (cons? V1231)) (shen.lzy== (shen.lazyderef (hd V1230) V1232) (shen.lazyderef (hd V1231) V1232) V1232 (freeze (shen.lzy== (tl V1230) (tl V1231) V1232 V1233)))) (true false)))
224
+
225
+ (defun shen.pvar (V1235) (cn "Var" (shen.app (<-address V1235 1) "" shen.a)))
226
+
227
+ (defun bind (V1236 V1237 V1238 V1239) (do (shen.bindv V1236 V1237 V1238) (let Result (thaw V1239) (do (shen.unbindv V1236 V1238) Result))))
228
+
229
+ (defun fwhen (V1254 V1255 V1256) (cond ((= true V1254) (thaw V1256)) ((= false V1254) false) (true (simple-error (cn "fwhen expects a boolean: not " (shen.app V1254 "%" shen.s))))))
230
+
231
+ (defun call (V1269 V1270 V1271) (cond ((cons? V1269) (shen.call-help (shen.m_prolog_to_s-prolog_predicate (shen.lazyderef (hd V1269) V1270)) (tl V1269) V1270 V1271)) (true false)))
232
+
233
+ (defun shen.call-help (V1272 V1273 V1274 V1275) (cond ((= () V1273) (V1272 V1274 V1275)) ((cons? V1273) (shen.call-help (V1272 (hd V1273)) (tl V1273) V1274 V1275)) (true (shen.sys-error shen.call-help))))
234
+
235
+ (defun shen.intprolog (V1276) (cond ((and (cons? V1276) (cons? (hd V1276))) (let ProcessN (shen.start-new-prolog-process) (shen.intprolog-help (hd (hd V1276)) (shen.insert-prolog-variables (cons (tl (hd V1276)) (cons (tl V1276) ())) ProcessN) ProcessN))) (true (shen.sys-error shen.intprolog))))
236
+
237
+ (defun shen.intprolog-help (V1277 V1278 V1279) (cond ((and (cons? V1278) (and (cons? (tl V1278)) (= () (tl (tl V1278))))) (shen.intprolog-help-help V1277 (hd V1278) (hd (tl V1278)) V1279)) (true (shen.sys-error shen.intprolog-help))))
238
+
239
+ (defun shen.intprolog-help-help (V1280 V1281 V1282 V1283) (cond ((= () V1281) (V1280 V1283 (freeze (shen.call-rest V1282 V1283)))) ((cons? V1281) (shen.intprolog-help-help (V1280 (hd V1281)) (tl V1281) V1282 V1283)) (true (shen.sys-error shen.intprolog-help-help))))
240
+
241
+ (defun shen.call-rest (V1286 V1287) (cond ((= () V1286) true) ((and (cons? V1286) (and (cons? (hd V1286)) (cons? (tl (hd V1286))))) (shen.call-rest (cons (cons ((hd (hd V1286)) (hd (tl (hd V1286)))) (tl (tl (hd V1286)))) (tl V1286)) V1287)) ((and (cons? V1286) (and (cons? (hd V1286)) (= () (tl (hd V1286))))) ((hd (hd V1286)) V1287 (freeze (shen.call-rest (tl V1286) V1287)))) (true (shen.sys-error shen.call-rest))))
242
+
243
+ (defun shen.start-new-prolog-process () (let IncrementProcessCounter (set shen.*process-counter* (+ 1 (value shen.*process-counter*))) (shen.initialise-prolog IncrementProcessCounter)))
244
+
245
+ (defun shen.insert-prolog-variables (V1288 V1289) (shen.insert-prolog-variables-help V1288 (shen.flatten V1288) V1289))
246
+
247
+ (defun shen.insert-prolog-variables-help (V1294 V1295 V1296) (cond ((= () V1295) V1294) ((and (cons? V1295) (variable? (hd V1295))) (let V (shen.newpv V1296) (let XV/Y (subst V (hd V1295) V1294) (let Z-Y (remove (hd V1295) (tl V1295)) (shen.insert-prolog-variables-help XV/Y Z-Y V1296))))) ((cons? V1295) (shen.insert-prolog-variables-help V1294 (tl V1295) V1296)) (true (shen.sys-error shen.insert-prolog-variables-help))))
248
+
249
+ (defun shen.initialise-prolog (V1297) (let Vector (address-> (value shen.*prologvectors*) V1297 (shen.fillvector (vector 10) 1 10 shen.-null-)) (let Counter (address-> (value shen.*varcounter*) V1297 1) V1297)))
250
+
1
251
 
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
252