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/sequent.kl CHANGED
@@ -1,556 +1,156 @@
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.datatype-error (V1585) (cond ((and (cons? V1585) (and (cons? (tl V1585)) (= () (tl (tl V1585))))) (simple-error (cn "datatype syntax error here:
51
+
52
+ " (shen.app (shen.next-50 50 (hd V1585)) "
53
+ " shen.a)))) (true (shen.sys-error shen.datatype-error))))
54
+
55
+ (defun shen.<datatype-rules> (V1590) (let Result (let Parse_shen.<datatype-rule> (shen.<datatype-rule> V1590) (if (not (= (fail) Parse_shen.<datatype-rule>)) (let Parse_shen.<datatype-rules> (shen.<datatype-rules> Parse_shen.<datatype-rule>) (if (not (= (fail) Parse_shen.<datatype-rules>)) (shen.pair (hd Parse_shen.<datatype-rules>) (cons (shen.hdtl Parse_shen.<datatype-rule>) (shen.hdtl Parse_shen.<datatype-rules>))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_<e> (<e> V1590) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) ()) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
56
+
57
+ (defun shen.<datatype-rule> (V1595) (let Result (let Parse_shen.<side-conditions> (shen.<side-conditions> V1595) (if (not (= (fail) Parse_shen.<side-conditions>)) (let Parse_shen.<premises> (shen.<premises> Parse_shen.<side-conditions>) (if (not (= (fail) Parse_shen.<premises>)) (let Parse_shen.<singleunderline> (shen.<singleunderline> Parse_shen.<premises>) (if (not (= (fail) Parse_shen.<singleunderline>)) (let Parse_shen.<conclusion> (shen.<conclusion> Parse_shen.<singleunderline>) (if (not (= (fail) Parse_shen.<conclusion>)) (shen.pair (hd Parse_shen.<conclusion>) (shen.sequent shen.single (cons (shen.hdtl Parse_shen.<side-conditions>) (cons (shen.hdtl Parse_shen.<premises>) (cons (shen.hdtl Parse_shen.<conclusion>) ()))))) (fail))) (fail))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<side-conditions> (shen.<side-conditions> V1595) (if (not (= (fail) Parse_shen.<side-conditions>)) (let Parse_shen.<premises> (shen.<premises> Parse_shen.<side-conditions>) (if (not (= (fail) Parse_shen.<premises>)) (let Parse_shen.<doubleunderline> (shen.<doubleunderline> Parse_shen.<premises>) (if (not (= (fail) Parse_shen.<doubleunderline>)) (let Parse_shen.<conclusion> (shen.<conclusion> Parse_shen.<doubleunderline>) (if (not (= (fail) Parse_shen.<conclusion>)) (shen.pair (hd Parse_shen.<conclusion>) (shen.sequent shen.double (cons (shen.hdtl Parse_shen.<side-conditions>) (cons (shen.hdtl Parse_shen.<premises>) (cons (shen.hdtl Parse_shen.<conclusion>) ()))))) (fail))) (fail))) (fail))) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
58
+
59
+ (defun shen.<side-conditions> (V1600) (let Result (let Parse_shen.<side-condition> (shen.<side-condition> V1600) (if (not (= (fail) Parse_shen.<side-condition>)) (let Parse_shen.<side-conditions> (shen.<side-conditions> Parse_shen.<side-condition>) (if (not (= (fail) Parse_shen.<side-conditions>)) (shen.pair (hd Parse_shen.<side-conditions>) (cons (shen.hdtl Parse_shen.<side-condition>) (shen.hdtl Parse_shen.<side-conditions>))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_<e> (<e> V1600) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) ()) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
60
+
61
+ (defun shen.<side-condition> (V1605) (let Result (if (and (cons? (hd V1605)) (= if (hd (hd V1605)))) (let Parse_shen.<expr> (shen.<expr> (shen.pair (tl (hd V1605)) (shen.hdtl V1605))) (if (not (= (fail) Parse_shen.<expr>)) (shen.pair (hd Parse_shen.<expr>) (cons if (cons (shen.hdtl Parse_shen.<expr>) ()))) (fail))) (fail)) (if (= Result (fail)) (let Result (if (and (cons? (hd V1605)) (= let (hd (hd V1605)))) (let Parse_shen.<variable?> (shen.<variable?> (shen.pair (tl (hd V1605)) (shen.hdtl V1605))) (if (not (= (fail) Parse_shen.<variable?>)) (let Parse_shen.<expr> (shen.<expr> Parse_shen.<variable?>) (if (not (= (fail) Parse_shen.<expr>)) (shen.pair (hd Parse_shen.<expr>) (cons let (cons (shen.hdtl Parse_shen.<variable?>) (cons (shen.hdtl Parse_shen.<expr>) ())))) (fail))) (fail))) (fail)) (if (= Result (fail)) (fail) Result)) Result)))
62
+
63
+ (defun shen.<variable?> (V1610) (let Result (if (cons? (hd V1610)) (let Parse_X (hd (hd V1610)) (if (variable? Parse_X) (shen.pair (hd (shen.pair (tl (hd V1610)) (shen.hdtl V1610))) Parse_X) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
64
+
65
+ (defun shen.<expr> (V1615) (let Result (if (cons? (hd V1615)) (let Parse_X (hd (hd V1615)) (if (not (or (element? Parse_X (cons >> (cons ; ()))) (or (shen.singleunderline? Parse_X) (shen.doubleunderline? Parse_X)))) (shen.pair (hd (shen.pair (tl (hd V1615)) (shen.hdtl V1615))) (shen.remove-bar Parse_X)) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
66
+
67
+ (defun shen.remove-bar (V1616) (cond ((and (cons? V1616) (and (cons? (tl V1616)) (and (cons? (tl (tl V1616))) (and (= () (tl (tl (tl V1616)))) (= (hd (tl V1616)) bar!))))) (cons (hd V1616) (hd (tl (tl V1616))))) ((cons? V1616) (cons (shen.remove-bar (hd V1616)) (shen.remove-bar (tl V1616)))) (true V1616)))
68
+
69
+ (defun shen.<premises> (V1621) (let Result (let Parse_shen.<premise> (shen.<premise> V1621) (if (not (= (fail) Parse_shen.<premise>)) (let Parse_shen.<semicolon-symbol> (shen.<semicolon-symbol> Parse_shen.<premise>) (if (not (= (fail) Parse_shen.<semicolon-symbol>)) (let Parse_shen.<premises> (shen.<premises> Parse_shen.<semicolon-symbol>) (if (not (= (fail) Parse_shen.<premises>)) (shen.pair (hd Parse_shen.<premises>) (cons (shen.hdtl Parse_shen.<premise>) (shen.hdtl Parse_shen.<premises>))) (fail))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_<e> (<e> V1621) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) ()) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
70
+
71
+ (defun shen.<semicolon-symbol> (V1626) (let Result (if (cons? (hd V1626)) (let Parse_X (hd (hd V1626)) (if (= Parse_X ;) (shen.pair (hd (shen.pair (tl (hd V1626)) (shen.hdtl V1626))) shen.skip) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
72
+
73
+ (defun shen.<premise> (V1631) (let Result (if (and (cons? (hd V1631)) (= ! (hd (hd V1631)))) (shen.pair (hd (shen.pair (tl (hd V1631)) (shen.hdtl V1631))) !) (fail)) (if (= Result (fail)) (let Result (let Parse_shen.<formulae> (shen.<formulae> V1631) (if (not (= (fail) Parse_shen.<formulae>)) (if (and (cons? (hd Parse_shen.<formulae>)) (= >> (hd (hd Parse_shen.<formulae>)))) (let Parse_shen.<formula> (shen.<formula> (shen.pair (tl (hd Parse_shen.<formulae>)) (shen.hdtl Parse_shen.<formulae>))) (if (not (= (fail) Parse_shen.<formula>)) (shen.pair (hd Parse_shen.<formula>) (shen.sequent (shen.hdtl Parse_shen.<formulae>) (shen.hdtl Parse_shen.<formula>))) (fail))) (fail)) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<formula> (shen.<formula> V1631) (if (not (= (fail) Parse_shen.<formula>)) (shen.pair (hd Parse_shen.<formula>) (shen.sequent () (shen.hdtl Parse_shen.<formula>))) (fail))) (if (= Result (fail)) (fail) Result)) Result)) Result)))
74
+
75
+ (defun shen.<conclusion> (V1636) (let Result (let Parse_shen.<formulae> (shen.<formulae> V1636) (if (not (= (fail) Parse_shen.<formulae>)) (if (and (cons? (hd Parse_shen.<formulae>)) (= >> (hd (hd Parse_shen.<formulae>)))) (let Parse_shen.<formula> (shen.<formula> (shen.pair (tl (hd Parse_shen.<formulae>)) (shen.hdtl Parse_shen.<formulae>))) (if (not (= (fail) Parse_shen.<formula>)) (let Parse_shen.<semicolon-symbol> (shen.<semicolon-symbol> Parse_shen.<formula>) (if (not (= (fail) Parse_shen.<semicolon-symbol>)) (shen.pair (hd Parse_shen.<semicolon-symbol>) (shen.sequent (shen.hdtl Parse_shen.<formulae>) (shen.hdtl Parse_shen.<formula>))) (fail))) (fail))) (fail)) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<formula> (shen.<formula> V1636) (if (not (= (fail) Parse_shen.<formula>)) (let Parse_shen.<semicolon-symbol> (shen.<semicolon-symbol> Parse_shen.<formula>) (if (not (= (fail) Parse_shen.<semicolon-symbol>)) (shen.pair (hd Parse_shen.<semicolon-symbol>) (shen.sequent () (shen.hdtl Parse_shen.<formula>))) (fail))) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
76
+
77
+ (defun shen.sequent (V1637 V1638) (@p V1637 V1638))
78
+
79
+ (defun shen.<formulae> (V1643) (let Result (let Parse_shen.<formula> (shen.<formula> V1643) (if (not (= (fail) Parse_shen.<formula>)) (let Parse_shen.<comma-symbol> (shen.<comma-symbol> Parse_shen.<formula>) (if (not (= (fail) Parse_shen.<comma-symbol>)) (let Parse_shen.<formulae> (shen.<formulae> Parse_shen.<comma-symbol>) (if (not (= (fail) Parse_shen.<formulae>)) (shen.pair (hd Parse_shen.<formulae>) (cons (shen.hdtl Parse_shen.<formula>) (shen.hdtl Parse_shen.<formulae>))) (fail))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<formula> (shen.<formula> V1643) (if (not (= (fail) Parse_shen.<formula>)) (shen.pair (hd Parse_shen.<formula>) (cons (shen.hdtl Parse_shen.<formula>) ())) (fail))) (if (= Result (fail)) (let Result (let Parse_<e> (<e> V1643) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) ()) (fail))) (if (= Result (fail)) (fail) Result)) Result)) Result)))
80
+
81
+ (defun shen.<comma-symbol> (V1648) (let Result (if (cons? (hd V1648)) (let Parse_X (hd (hd V1648)) (if (= Parse_X (intern ",")) (shen.pair (hd (shen.pair (tl (hd V1648)) (shen.hdtl V1648))) shen.skip) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
82
+
83
+ (defun shen.<formula> (V1653) (let Result (let Parse_shen.<expr> (shen.<expr> V1653) (if (not (= (fail) Parse_shen.<expr>)) (if (and (cons? (hd Parse_shen.<expr>)) (= : (hd (hd Parse_shen.<expr>)))) (let Parse_shen.<type> (shen.<type> (shen.pair (tl (hd Parse_shen.<expr>)) (shen.hdtl Parse_shen.<expr>))) (if (not (= (fail) Parse_shen.<type>)) (shen.pair (hd Parse_shen.<type>) (cons (shen.curry (shen.hdtl Parse_shen.<expr>)) (cons : (cons (shen.normalise-type (shen.hdtl Parse_shen.<type>)) ())))) (fail))) (fail)) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<expr> (shen.<expr> V1653) (if (not (= (fail) Parse_shen.<expr>)) (shen.pair (hd Parse_shen.<expr>) (shen.hdtl Parse_shen.<expr>)) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
84
+
85
+ (defun shen.<type> (V1658) (let Result (let Parse_shen.<expr> (shen.<expr> V1658) (if (not (= (fail) Parse_shen.<expr>)) (shen.pair (hd Parse_shen.<expr>) (shen.curry-type (shen.hdtl Parse_shen.<expr>))) (fail))) (if (= Result (fail)) (fail) Result)))
86
+
87
+ (defun shen.<doubleunderline> (V1663) (let Result (if (cons? (hd V1663)) (let Parse_X (hd (hd V1663)) (if (shen.doubleunderline? Parse_X) (shen.pair (hd (shen.pair (tl (hd V1663)) (shen.hdtl V1663))) Parse_X) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
88
+
89
+ (defun shen.<singleunderline> (V1668) (let Result (if (cons? (hd V1668)) (let Parse_X (hd (hd V1668)) (if (shen.singleunderline? Parse_X) (shen.pair (hd (shen.pair (tl (hd V1668)) (shen.hdtl V1668))) Parse_X) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
90
+
91
+ (defun shen.singleunderline? (V1669) (and (symbol? V1669) (shen.sh? (str V1669))))
92
+
93
+ (defun shen.sh? (V1670) (cond ((= "_" V1670) true) (true (and (= (pos V1670 0) "_") (shen.sh? (tlstr V1670))))))
94
+
95
+ (defun shen.doubleunderline? (V1671) (and (symbol? V1671) (shen.dh? (str V1671))))
96
+
97
+ (defun shen.dh? (V1672) (cond ((= "=" V1672) true) (true (and (= (pos V1672 0) "=") (shen.dh? (tlstr V1672))))))
98
+
99
+ (defun shen.process-datatype (V1673 V1674) (shen.remember-datatype (shen.s-prolog (shen.rules->horn-clauses V1673 V1674))))
100
+
101
+ (defun shen.remember-datatype (V1679) (cond ((cons? V1679) (do (set shen.*datatypes* (adjoin (hd V1679) (value shen.*datatypes*))) (do (set shen.*alldatatypes* (adjoin (hd V1679) (value shen.*alldatatypes*))) (hd V1679)))) (true (shen.sys-error shen.remember-datatype))))
102
+
103
+ (defun shen.rules->horn-clauses (V1682 V1683) (cond ((= () V1683) ()) ((and (cons? V1683) (and (tuple? (hd V1683)) (= shen.single (fst (hd V1683))))) (cons (shen.rule->horn-clause V1682 (snd (hd V1683))) (shen.rules->horn-clauses V1682 (tl V1683)))) ((and (cons? V1683) (and (tuple? (hd V1683)) (= shen.double (fst (hd V1683))))) (shen.rules->horn-clauses V1682 (append (shen.double->singles (snd (hd V1683))) (tl V1683)))) (true (shen.sys-error shen.rules->horn-clauses))))
104
+
105
+ (defun shen.double->singles (V1684) (cons (shen.right-rule V1684) (cons (shen.left-rule V1684) ())))
106
+
107
+ (defun shen.right-rule (V1685) (@p shen.single V1685))
108
+
109
+ (defun shen.left-rule (V1686) (cond ((and (cons? V1686) (and (cons? (tl V1686)) (and (cons? (tl (tl V1686))) (and (tuple? (hd (tl (tl V1686)))) (and (= () (fst (hd (tl (tl V1686))))) (= () (tl (tl (tl V1686))))))))) (let Q (gensym Qv) (let NewConclusion (@p (cons (snd (hd (tl (tl V1686)))) ()) Q) (let NewPremises (cons (@p (map shen.right->left (hd (tl V1686))) Q) ()) (@p shen.single (cons (hd V1686) (cons NewPremises (cons NewConclusion ())))))))) (true (shen.sys-error shen.left-rule))))
110
+
111
+ (defun shen.right->left (V1691) (cond ((and (tuple? V1691) (= () (fst V1691))) (snd V1691)) (true (simple-error "syntax error with ==========
112
+ "))))
113
+
114
+ (defun shen.rule->horn-clause (V1692 V1693) (cond ((and (cons? V1693) (and (cons? (tl V1693)) (and (cons? (tl (tl V1693))) (and (tuple? (hd (tl (tl V1693)))) (= () (tl (tl (tl V1693)))))))) (cons (shen.rule->horn-clause-head V1692 (snd (hd (tl (tl V1693))))) (cons :- (cons (shen.rule->horn-clause-body (hd V1693) (hd (tl V1693)) (fst (hd (tl (tl V1693))))) ())))) (true (shen.sys-error shen.rule->horn-clause))))
115
+
116
+ (defun shen.rule->horn-clause-head (V1694 V1695) (cons V1694 (cons (shen.mode-ify V1695) (cons Context_1957 ()))))
117
+
118
+ (defun shen.mode-ify (V1696) (cond ((and (cons? V1696) (and (cons? (tl V1696)) (and (= : (hd (tl V1696))) (and (cons? (tl (tl V1696))) (= () (tl (tl (tl V1696)))))))) (cons mode (cons (cons (hd V1696) (cons : (cons (cons mode (cons (hd (tl (tl V1696))) (cons + ()))) ()))) (cons - ())))) (true V1696)))
119
+
120
+ (defun shen.rule->horn-clause-body (V1697 V1698 V1699) (let Variables (map shen.extract_vars V1699) (let Predicates (map (lambda X (gensym shen.cl)) V1699) (let SearchLiterals (shen.construct-search-literals Predicates Variables Context_1957 Context1_1957) (let SearchClauses (shen.construct-search-clauses Predicates V1699 Variables) (let SideLiterals (shen.construct-side-literals V1697) (let PremissLiterals (map (lambda X (shen.construct-premiss-literal X (empty? V1699))) V1698) (append SearchLiterals (append SideLiterals PremissLiterals)))))))))
121
+
122
+ (defun shen.construct-search-literals (V1704 V1705 V1706 V1707) (cond ((and (= () V1704) (= () V1705)) ()) (true (shen.csl-help V1704 V1705 V1706 V1707))))
123
+
124
+ (defun shen.csl-help (V1710 V1711 V1712 V1713) (cond ((and (= () V1710) (= () V1711)) (cons (cons bind (cons ContextOut_1957 (cons V1712 ()))) ())) ((and (cons? V1710) (cons? V1711)) (cons (cons (hd V1710) (cons V1712 (cons V1713 (hd V1711)))) (shen.csl-help (tl V1710) (tl V1711) V1713 (gensym Context)))) (true (shen.sys-error shen.csl-help))))
125
+
126
+ (defun shen.construct-search-clauses (V1714 V1715 V1716) (cond ((and (= () V1714) (and (= () V1715) (= () V1716))) shen.skip) ((and (cons? V1714) (and (cons? V1715) (cons? V1716))) (do (shen.construct-search-clause (hd V1714) (hd V1715) (hd V1716)) (shen.construct-search-clauses (tl V1714) (tl V1715) (tl V1716)))) (true (shen.sys-error shen.construct-search-clauses))))
127
+
128
+ (defun shen.construct-search-clause (V1717 V1718 V1719) (shen.s-prolog (cons (shen.construct-base-search-clause V1717 V1718 V1719) (cons (shen.construct-recursive-search-clause V1717 V1718 V1719) ()))))
129
+
130
+ (defun shen.construct-base-search-clause (V1720 V1721 V1722) (cons (cons V1720 (cons (cons (shen.mode-ify V1721) In_1957) (cons In_1957 V1722))) (cons :- (cons () ()))))
131
+
132
+ (defun shen.construct-recursive-search-clause (V1723 V1724 V1725) (cons (cons V1723 (cons (cons Assumption_1957 Assumptions_1957) (cons (cons Assumption_1957 Out_1957) V1725))) (cons :- (cons (cons (cons V1723 (cons Assumptions_1957 (cons Out_1957 V1725))) ()) ()))))
133
+
134
+ (defun shen.construct-side-literals (V1730) (cond ((= () V1730) ()) ((and (cons? V1730) (and (cons? (hd V1730)) (and (= if (hd (hd V1730))) (and (cons? (tl (hd V1730))) (= () (tl (tl (hd V1730)))))))) (cons (cons when (tl (hd V1730))) (shen.construct-side-literals (tl V1730)))) ((and (cons? V1730) (and (cons? (hd V1730)) (and (= let (hd (hd V1730))) (and (cons? (tl (hd V1730))) (and (cons? (tl (tl (hd V1730)))) (= () (tl (tl (tl (hd V1730)))))))))) (cons (cons is (tl (hd V1730))) (shen.construct-side-literals (tl V1730)))) ((cons? V1730) (shen.construct-side-literals (tl V1730))) (true (shen.sys-error shen.construct-side-literals))))
135
+
136
+ (defun shen.construct-premiss-literal (V1735 V1736) (cond ((tuple? V1735) (cons shen.t* (cons (shen.recursive_cons_form (snd V1735)) (cons (shen.construct-context V1736 (fst V1735)) ())))) ((= ! V1735) (cons cut (cons Throwcontrol ()))) (true (shen.sys-error shen.construct-premiss-literal))))
137
+
138
+ (defun shen.construct-context (V1737 V1738) (cond ((and (= true V1737) (= () V1738)) Context_1957) ((and (= false V1737) (= () V1738)) ContextOut_1957) ((cons? V1738) (cons cons (cons (shen.recursive_cons_form (hd V1738)) (cons (shen.construct-context V1737 (tl V1738)) ())))) (true (shen.sys-error shen.construct-context))))
139
+
140
+ (defun shen.recursive_cons_form (V1739) (cond ((cons? V1739) (cons cons (cons (shen.recursive_cons_form (hd V1739)) (cons (shen.recursive_cons_form (tl V1739)) ())))) (true V1739)))
141
+
142
+ (defun preclude (V1740) (let FilterDatatypes (set shen.*datatypes* (difference (value shen.*datatypes*) V1740)) (value shen.*datatypes*)))
143
+
144
+ (defun include (V1741) (let ValidTypes (intersection V1741 (value shen.*alldatatypes*)) (let NewDatatypes (set shen.*datatypes* (union ValidTypes (value shen.*datatypes*))) (value shen.*datatypes*))))
145
+
146
+ (defun preclude-all-but (V1742) (preclude (difference (value shen.*alldatatypes*) V1742)))
147
+
148
+ (defun include-all-but (V1743) (include (difference (value shen.*alldatatypes*) V1743)))
149
+
150
+ (defun shen.synonyms-help (V1748) (cond ((= () V1748) synonyms) ((and (cons? V1748) (cons? (tl V1748))) (do (shen.pushnew (cons (hd V1748) (hd (tl V1748))) shen.*synonyms*) (shen.synonyms-help (tl (tl V1748))))) (true (simple-error (cn "odd number of synonyms
151
+ " "")))))
152
+
153
+ (defun shen.pushnew (V1749 V1750) (if (element? V1749 (value V1750)) (value V1750) (set V1750 (cons V1749 (value V1750)))))
154
+
1
155
 
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-datatype-error (V1549)
19
- (interror "datatype syntax error here:~%~% ~A~%"
20
- (@p (shen-next-50 50 V1549) ())))
21
-
22
- (defun shen-<datatype-rules> (V1550)
23
- (let Result
24
- (let Parse_<datatype-rule> (shen-<datatype-rule> V1550)
25
- (if (not (= (fail) Parse_<datatype-rule>))
26
- (let Parse_<datatype-rules> (shen-<datatype-rules> Parse_<datatype-rule>)
27
- (if (not (= (fail) Parse_<datatype-rules>))
28
- (shen-reassemble (fst Parse_<datatype-rules>)
29
- (cons (snd Parse_<datatype-rule>) (snd Parse_<datatype-rules>)))
30
- (fail)))
31
- (fail)))
32
- (if (= Result (fail))
33
- (let Result
34
- (let Parse_<e> (<e> V1550)
35
- (if (not (= (fail) Parse_<e>)) (shen-reassemble (fst Parse_<e>) ())
36
- (fail)))
37
- (if (= Result (fail)) (fail) Result))
38
- Result)))
39
-
40
- (defun shen-<datatype-rule> (V1551)
41
- (let Result
42
- (let Parse_<side-conditions> (shen-<side-conditions> V1551)
43
- (if (not (= (fail) Parse_<side-conditions>))
44
- (let Parse_<premises> (shen-<premises> Parse_<side-conditions>)
45
- (if (not (= (fail) Parse_<premises>))
46
- (let Parse_<singleunderline> (shen-<singleunderline> Parse_<premises>)
47
- (if (not (= (fail) Parse_<singleunderline>))
48
- (let Parse_<conclusion> (shen-<conclusion> Parse_<singleunderline>)
49
- (if (not (= (fail) Parse_<conclusion>))
50
- (shen-reassemble (fst Parse_<conclusion>)
51
- (@p shen-single
52
- (cons (snd Parse_<side-conditions>)
53
- (cons (snd Parse_<premises>)
54
- (cons (snd Parse_<conclusion>) ())))))
55
- (fail)))
56
- (fail)))
57
- (fail)))
58
- (fail)))
59
- (if (= Result (fail))
60
- (let Result
61
- (let Parse_<side-conditions> (shen-<side-conditions> V1551)
62
- (if (not (= (fail) Parse_<side-conditions>))
63
- (let Parse_<premises> (shen-<premises> Parse_<side-conditions>)
64
- (if (not (= (fail) Parse_<premises>))
65
- (let Parse_<doubleunderline> (shen-<doubleunderline> Parse_<premises>)
66
- (if (not (= (fail) Parse_<doubleunderline>))
67
- (let Parse_<conclusion> (shen-<conclusion> Parse_<doubleunderline>)
68
- (if (not (= (fail) Parse_<conclusion>))
69
- (shen-reassemble (fst Parse_<conclusion>)
70
- (@p shen-double
71
- (cons (snd Parse_<side-conditions>)
72
- (cons (snd Parse_<premises>)
73
- (cons (snd Parse_<conclusion>) ())))))
74
- (fail)))
75
- (fail)))
76
- (fail)))
77
- (fail)))
78
- (if (= Result (fail)) (fail) Result))
79
- Result)))
80
-
81
- (defun shen-<side-conditions> (V1552)
82
- (let Result
83
- (let Parse_<side-condition> (shen-<side-condition> V1552)
84
- (if (not (= (fail) Parse_<side-condition>))
85
- (let Parse_<side-conditions>
86
- (shen-<side-conditions> Parse_<side-condition>)
87
- (if (not (= (fail) Parse_<side-conditions>))
88
- (shen-reassemble (fst Parse_<side-conditions>)
89
- (cons (snd Parse_<side-condition>) (snd Parse_<side-conditions>)))
90
- (fail)))
91
- (fail)))
92
- (if (= Result (fail))
93
- (let Result
94
- (let Parse_<e> (<e> V1552)
95
- (if (not (= (fail) Parse_<e>)) (shen-reassemble (fst Parse_<e>) ())
96
- (fail)))
97
- (if (= Result (fail)) (fail) Result))
98
- Result)))
99
-
100
- (defun shen-<side-condition> (V1553)
101
- (let Result
102
- (if (and (cons? (fst V1553)) (= if (hd (fst V1553))))
103
- (let Parse_<expr>
104
- (shen-<expr> (shen-reassemble (tl (fst V1553)) (snd V1553)))
105
- (if (not (= (fail) Parse_<expr>))
106
- (shen-reassemble (fst Parse_<expr>)
107
- (cons if (cons (snd Parse_<expr>) ())))
108
- (fail)))
109
- (fail))
110
- (if (= Result (fail))
111
- (let Result
112
- (if (and (cons? (fst V1553)) (= let (hd (fst V1553))))
113
- (let Parse_<variable?>
114
- (shen-<variable?> (shen-reassemble (tl (fst V1553)) (snd V1553)))
115
- (if (not (= (fail) Parse_<variable?>))
116
- (let Parse_<expr> (shen-<expr> Parse_<variable?>)
117
- (if (not (= (fail) Parse_<expr>))
118
- (shen-reassemble (fst Parse_<expr>)
119
- (cons let
120
- (cons (snd Parse_<variable?>) (cons (snd Parse_<expr>) ()))))
121
- (fail)))
122
- (fail)))
123
- (fail))
124
- (if (= Result (fail)) (fail) Result))
125
- Result)))
126
-
127
- (defun shen-<variable?> (V1554)
128
- (let Result
129
- (if (cons? (fst V1554))
130
- (shen-reassemble (fst (shen-reassemble (tl (fst V1554)) (snd V1554)))
131
- (if (not (variable? (hd (fst V1554)))) (fail) (hd (fst V1554))))
132
- (fail))
133
- (if (= Result (fail)) (fail) Result)))
134
-
135
- (defun shen-<expr> (V1555)
136
- (let Result
137
- (if (cons? (fst V1555))
138
- (shen-reassemble (fst (shen-reassemble (tl (fst V1555)) (snd V1555)))
139
- (if
140
- (or (element? (hd (fst V1555)) (cons >> (cons ; ())))
141
- (or (shen-singleunderline? (hd (fst V1555)))
142
- (shen-doubleunderline? (hd (fst V1555)))))
143
- (fail) (shen-remove-bar (hd (fst V1555)))))
144
- (fail))
145
- (if (= Result (fail)) (fail) Result)))
146
-
147
- (defun shen-remove-bar (V1556)
148
- (cond
149
- ((and (cons? V1556)
150
- (and (cons? (tl V1556))
151
- (and (cons? (tl (tl V1556)))
152
- (and (= () (tl (tl (tl V1556)))) (= (hd (tl V1556)) bar!)))))
153
- (cons (hd V1556) (hd (tl (tl V1556)))))
154
- ((cons? V1556)
155
- (cons (shen-remove-bar (hd V1556)) (shen-remove-bar (tl V1556))))
156
- (true V1556)))
157
-
158
- (defun shen-<premises> (V1557)
159
- (let Result
160
- (let Parse_<premise> (shen-<premise> V1557)
161
- (if (not (= (fail) Parse_<premise>))
162
- (let Parse_<semicolon-symbol> (shen-<semicolon-symbol> Parse_<premise>)
163
- (if (not (= (fail) Parse_<semicolon-symbol>))
164
- (let Parse_<premises> (shen-<premises> Parse_<semicolon-symbol>)
165
- (if (not (= (fail) Parse_<premises>))
166
- (shen-reassemble (fst Parse_<premises>)
167
- (cons (snd Parse_<premise>) (snd Parse_<premises>)))
168
- (fail)))
169
- (fail)))
170
- (fail)))
171
- (if (= Result (fail))
172
- (let Result
173
- (let Parse_<e> (<e> V1557)
174
- (if (not (= (fail) Parse_<e>)) (shen-reassemble (fst Parse_<e>) ())
175
- (fail)))
176
- (if (= Result (fail)) (fail) Result))
177
- Result)))
178
-
179
- (defun shen-<semicolon-symbol> (V1558)
180
- (let Result
181
- (if (cons? (fst V1558))
182
- (shen-reassemble (fst (shen-reassemble (tl (fst V1558)) (snd V1558)))
183
- (if (= (hd (fst V1558)) ;) shen-skip (fail)))
184
- (fail))
185
- (if (= Result (fail)) (fail) Result)))
186
-
187
- (defun shen-<premise> (V1559)
188
- (let Result
189
- (if (and (cons? (fst V1559)) (= ! (hd (fst V1559))))
190
- (shen-reassemble (fst (shen-reassemble (tl (fst V1559)) (snd V1559))) !)
191
- (fail))
192
- (if (= Result (fail))
193
- (let Result
194
- (let Parse_<formulae> (shen-<formulae> V1559)
195
- (if (not (= (fail) Parse_<formulae>))
196
- (if
197
- (and (cons? (fst Parse_<formulae>))
198
- (= >> (hd (fst Parse_<formulae>))))
199
- (let Parse_<formula>
200
- (shen-<formula>
201
- (shen-reassemble (tl (fst Parse_<formulae>)) (snd Parse_<formulae>)))
202
- (if (not (= (fail) Parse_<formula>))
203
- (shen-reassemble (fst Parse_<formula>)
204
- (@p (snd Parse_<formulae>) (snd Parse_<formula>)))
205
- (fail)))
206
- (fail))
207
- (fail)))
208
- (if (= Result (fail))
209
- (let Result
210
- (let Parse_<formula> (shen-<formula> V1559)
211
- (if (not (= (fail) Parse_<formula>))
212
- (shen-reassemble (fst Parse_<formula>) (@p () (snd Parse_<formula>)))
213
- (fail)))
214
- (if (= Result (fail)) (fail) Result))
215
- Result))
216
- Result)))
217
-
218
- (defun shen-<conclusion> (V1560)
219
- (let Result
220
- (let Parse_<formulae> (shen-<formulae> V1560)
221
- (if (not (= (fail) Parse_<formulae>))
222
- (if
223
- (and (cons? (fst Parse_<formulae>)) (= >> (hd (fst Parse_<formulae>))))
224
- (let Parse_<formula>
225
- (shen-<formula>
226
- (shen-reassemble (tl (fst Parse_<formulae>)) (snd Parse_<formulae>)))
227
- (if (not (= (fail) Parse_<formula>))
228
- (let Parse_<semicolon-symbol> (shen-<semicolon-symbol> Parse_<formula>)
229
- (if (not (= (fail) Parse_<semicolon-symbol>))
230
- (shen-reassemble (fst Parse_<semicolon-symbol>)
231
- (@p (snd Parse_<formulae>) (snd Parse_<formula>)))
232
- (fail)))
233
- (fail)))
234
- (fail))
235
- (fail)))
236
- (if (= Result (fail))
237
- (let Result
238
- (let Parse_<formula> (shen-<formula> V1560)
239
- (if (not (= (fail) Parse_<formula>))
240
- (let Parse_<semicolon-symbol> (shen-<semicolon-symbol> Parse_<formula>)
241
- (if (not (= (fail) Parse_<semicolon-symbol>))
242
- (shen-reassemble (fst Parse_<semicolon-symbol>)
243
- (@p () (snd Parse_<formula>)))
244
- (fail)))
245
- (fail)))
246
- (if (= Result (fail)) (fail) Result))
247
- Result)))
248
-
249
- (defun shen-<formulae> (V1561)
250
- (let Result
251
- (let Parse_<formula> (shen-<formula> V1561)
252
- (if (not (= (fail) Parse_<formula>))
253
- (if
254
- (and (cons? (fst Parse_<formula>))
255
- (= shen- (hd (fst Parse_<formula>))))
256
- (let Parse_<formulae>
257
- (shen-<formulae>
258
- (shen-reassemble (tl (fst Parse_<formula>)) (snd Parse_<formula>)))
259
- (if (not (= (fail) Parse_<formulae>))
260
- (shen-reassemble (fst Parse_<formulae>)
261
- (cons (snd Parse_<formula>) (snd Parse_<formulae>)))
262
- (fail)))
263
- (fail))
264
- (fail)))
265
- (if (= Result (fail))
266
- (let Result
267
- (let Parse_<formula> (shen-<formula> V1561)
268
- (if (not (= (fail) Parse_<formula>))
269
- (shen-reassemble (fst Parse_<formula>) (cons (snd Parse_<formula>) ()))
270
- (fail)))
271
- (if (= Result (fail))
272
- (let Result
273
- (let Parse_<e> (<e> V1561)
274
- (if (not (= (fail) Parse_<e>)) (shen-reassemble (fst Parse_<e>) ())
275
- (fail)))
276
- (if (= Result (fail)) (fail) Result))
277
- Result))
278
- Result)))
279
-
280
- (defun shen-<formula> (V1562)
281
- (let Result
282
- (let Parse_<expr> (shen-<expr> V1562)
283
- (if (not (= (fail) Parse_<expr>))
284
- (if (and (cons? (fst Parse_<expr>)) (= : (hd (fst Parse_<expr>))))
285
- (let Parse_<type>
286
- (shen-<type>
287
- (shen-reassemble (tl (fst Parse_<expr>)) (snd Parse_<expr>)))
288
- (if (not (= (fail) Parse_<type>))
289
- (shen-reassemble (fst Parse_<type>)
290
- (cons (shen-curry (snd Parse_<expr>))
291
- (cons : (cons (shen-normalise-type (snd Parse_<type>)) ()))))
292
- (fail)))
293
- (fail))
294
- (fail)))
295
- (if (= Result (fail))
296
- (let Result
297
- (let Parse_<expr> (shen-<expr> V1562)
298
- (if (not (= (fail) Parse_<expr>))
299
- (shen-reassemble (fst Parse_<expr>) (snd Parse_<expr>)) (fail)))
300
- (if (= Result (fail)) (fail) Result))
301
- Result)))
302
-
303
- (defun shen-<colonsymbol> (V1563)
304
- (let Result
305
- (if (cons? (fst V1563))
306
- (shen-reassemble (fst (shen-reassemble (tl (fst V1563)) (snd V1563)))
307
- (if (= (hd (fst V1563)) ;) (hd (fst V1563)) (fail)))
308
- (fail))
309
- (if (= Result (fail)) (fail) Result)))
310
-
311
- (defun shen-<type> (V1564)
312
- (let Result
313
- (let Parse_<expr> (shen-<expr> V1564)
314
- (if (not (= (fail) Parse_<expr>))
315
- (shen-reassemble (fst Parse_<expr>) (shen-curry-type (snd Parse_<expr>)))
316
- (fail)))
317
- (if (= Result (fail)) (fail) Result)))
318
-
319
- (defun shen-<doubleunderline> (V1565)
320
- (let Result
321
- (if (cons? (fst V1565))
322
- (shen-reassemble (fst (shen-reassemble (tl (fst V1565)) (snd V1565)))
323
- (if (shen-doubleunderline? (hd (fst V1565))) (hd (fst V1565)) (fail)))
324
- (fail))
325
- (if (= Result (fail)) (fail) Result)))
326
-
327
- (defun shen-<singleunderline> (V1566)
328
- (let Result
329
- (if (cons? (fst V1566))
330
- (shen-reassemble (fst (shen-reassemble (tl (fst V1566)) (snd V1566)))
331
- (if (shen-singleunderline? (hd (fst V1566))) (hd (fst V1566)) (fail)))
332
- (fail))
333
- (if (= Result (fail)) (fail) Result)))
334
-
335
- (defun shen-singleunderline? (V1567)
336
- (and (symbol? V1567) (shen-sh? (str V1567))))
337
-
338
- (defun shen-sh? (V1568)
339
- (cond ((= "_" V1568) true)
340
- (true (and (= (pos V1568 0) "_") (shen-sh? (tlstr V1568))))))
341
-
342
- (defun shen-doubleunderline? (V1569)
343
- (and (symbol? V1569) (shen-dh? (str V1569))))
344
-
345
- (defun shen-dh? (V1570)
346
- (cond ((= "=" V1570) true)
347
- (true (and (= (pos V1570 0) "=") (shen-dh? (tlstr V1570))))))
348
-
349
- (defun shen-process-datatype (V1571 V1572)
350
- (shen-remember-datatype
351
- (shen-s-prolog (shen-rules->horn-clauses V1571 V1572))))
352
-
353
- (defun shen-remember-datatype (V1577)
354
- (cond
355
- ((cons? V1577)
356
- (do (set shen-*datatypes* (adjoin (hd V1577) (value shen-*datatypes*)))
357
- (do
358
- (set shen-*alldatatypes* (adjoin (hd V1577) (value shen-*alldatatypes*)))
359
- (hd V1577))))
360
- (true (shen-sys-error shen-remember-datatype))))
361
-
362
- (defun shen-rules->horn-clauses (V1580 V1581)
363
- (cond ((= () V1581) ())
364
- ((and (cons? V1581)
365
- (and (tuple? (hd V1581)) (= shen-single (fst (hd V1581)))))
366
- (cons (shen-rule->horn-clause V1580 (snd (hd V1581)))
367
- (shen-rules->horn-clauses V1580 (tl V1581))))
368
- ((and (cons? V1581)
369
- (and (tuple? (hd V1581)) (= shen-double (fst (hd V1581)))))
370
- (shen-rules->horn-clauses V1580
371
- (append (shen-double->singles (snd (hd V1581))) (tl V1581))))
372
- (true (shen-sys-error shen-rules->horn-clauses))))
373
-
374
- (defun shen-double->singles (V1582)
375
- (cons (shen-right-rule V1582) (cons (shen-left-rule V1582) ())))
376
-
377
- (defun shen-right-rule (V1583) (@p shen-single V1583))
378
-
379
- (defun shen-left-rule (V1584)
380
- (cond
381
- ((and (cons? V1584)
382
- (and (cons? (tl V1584))
383
- (and (cons? (tl (tl V1584)))
384
- (and (tuple? (hd (tl (tl V1584))))
385
- (and (= () (fst (hd (tl (tl V1584)))))
386
- (= () (tl (tl (tl V1584)))))))))
387
- (let Q (gensym Qv)
388
- (let NewConclusion (@p (cons (snd (hd (tl (tl V1584)))) ()) Q)
389
- (let NewPremises
390
- (cons
391
- (@p (map (lambda V1585 (shen-right->left V1585)) (hd (tl V1584))) Q)
392
- ())
393
- (@p shen-single
394
- (cons (hd V1584) (cons NewPremises (cons NewConclusion ()))))))))
395
- (true (shen-sys-error shen-left-rule))))
396
-
397
- (defun shen-right->left (V1590)
398
- (cond ((and (tuple? V1590) (= () (fst V1590))) (snd V1590))
399
- (true (interror "syntax error with ==========~%" ()))))
400
-
401
- (defun shen-rule->horn-clause (V1591 V1592)
402
- (cond
403
- ((and (cons? V1592)
404
- (and (cons? (tl V1592))
405
- (and (cons? (tl (tl V1592)))
406
- (and (tuple? (hd (tl (tl V1592)))) (= () (tl (tl (tl V1592))))))))
407
- (cons (shen-rule->horn-clause-head V1591 (snd (hd (tl (tl V1592)))))
408
- (cons :-
409
- (cons
410
- (shen-rule->horn-clause-body (hd V1592) (hd (tl V1592))
411
- (fst (hd (tl (tl V1592)))))
412
- ()))))
413
- (true (shen-sys-error shen-rule->horn-clause))))
414
-
415
- (defun shen-rule->horn-clause-head (V1593 V1594)
416
- (cons V1593 (cons (shen-mode-ify V1594) (cons Context_1957 ()))))
417
-
418
- (defun shen-mode-ify (V1595)
419
- (cond
420
- ((and (cons? V1595)
421
- (and (cons? (tl V1595))
422
- (and (= : (hd (tl V1595)))
423
- (and (cons? (tl (tl V1595))) (= () (tl (tl (tl V1595))))))))
424
- (cons mode
425
- (cons
426
- (cons (hd V1595)
427
- (cons :
428
- (cons (cons mode (cons (hd (tl (tl V1595))) (cons + ()))) ())))
429
- (cons - ()))))
430
- (true V1595)))
431
-
432
- (defun shen-rule->horn-clause-body (V1596 V1597 V1598)
433
- (let Variables (map (lambda V1599 (shen-extract_vars V1599)) V1598)
434
- (let Predicates (map (lambda X (gensym shen-cl)) V1598)
435
- (let SearchLiterals
436
- (shen-construct-search-literals Predicates Variables Context_1957
437
- Context1_1957)
438
- (let SearchClauses
439
- (shen-construct-search-clauses Predicates V1598 Variables)
440
- (let SideLiterals (shen-construct-side-literals V1596)
441
- (let PremissLiterals
442
- (map (lambda X (shen-construct-premiss-literal X (empty? V1598))) V1597)
443
- (append SearchLiterals (append SideLiterals PremissLiterals)))))))))
444
-
445
- (defun shen-construct-search-literals (V1604 V1605 V1606 V1607)
446
- (cond ((and (= () V1604) (= () V1605)) ())
447
- (true (shen-csl-help V1604 V1605 V1606 V1607))))
448
-
449
- (defun shen-csl-help (V1610 V1611 V1612 V1613)
450
- (cond
451
- ((and (= () V1610) (= () V1611))
452
- (cons (cons bind (cons ContextOut_1957 (cons V1612 ()))) ()))
453
- ((and (cons? V1610) (cons? V1611))
454
- (cons (cons (hd V1610) (cons V1612 (cons V1613 (hd V1611))))
455
- (shen-csl-help (tl V1610) (tl V1611) V1613 (gensym Context))))
456
- (true (shen-sys-error shen-csl-help))))
457
-
458
- (defun shen-construct-search-clauses (V1614 V1615 V1616)
459
- (cond
460
- ((and (= () V1614) (and (= () V1615) (= () V1616))) shen-skip)
461
- ((and (cons? V1614) (and (cons? V1615) (cons? V1616)))
462
- (do (shen-construct-search-clause (hd V1614) (hd V1615) (hd V1616))
463
- (shen-construct-search-clauses (tl V1614) (tl V1615) (tl V1616))))
464
- (true (shen-sys-error shen-construct-search-clauses))))
465
-
466
- (defun shen-construct-search-clause (V1617 V1618 V1619)
467
- (shen-s-prolog
468
- (cons (shen-construct-base-search-clause V1617 V1618 V1619)
469
- (cons (shen-construct-recursive-search-clause V1617 V1618 V1619) ()))))
470
-
471
- (defun shen-construct-base-search-clause (V1620 V1621 V1622)
472
- (cons
473
- (cons V1620 (cons (cons (shen-mode-ify V1621) In_1957) (cons In_1957 V1622)))
474
- (cons :- (cons () ()))))
475
-
476
- (defun shen-construct-recursive-search-clause (V1623 V1624 V1625)
477
- (cons
478
- (cons V1623
479
- (cons (cons Assumption_1957 Assumptions_1957)
480
- (cons (cons Assumption_1957 Out_1957) V1625)))
481
- (cons :-
482
- (cons (cons (cons V1623 (cons Assumptions_1957 (cons Out_1957 V1625))) ())
483
- ()))))
484
-
485
- (defun shen-construct-side-literals (V1630)
486
- (cond ((= () V1630) ())
487
- ((and (cons? V1630)
488
- (and (cons? (hd V1630))
489
- (and (= if (hd (hd V1630)))
490
- (and (cons? (tl (hd V1630))) (= () (tl (tl (hd V1630))))))))
491
- (cons (cons when (tl (hd V1630)))
492
- (shen-construct-side-literals (tl V1630))))
493
- ((and (cons? V1630)
494
- (and (cons? (hd V1630))
495
- (and (= let (hd (hd V1630)))
496
- (and (cons? (tl (hd V1630)))
497
- (and (cons? (tl (tl (hd V1630))))
498
- (= () (tl (tl (tl (hd V1630))))))))))
499
- (cons (cons is (tl (hd V1630))) (shen-construct-side-literals (tl V1630))))
500
- ((cons? V1630) (shen-construct-side-literals (tl V1630)))
501
- (true (shen-sys-error shen-construct-side-literals))))
502
-
503
- (defun shen-construct-premiss-literal (V1635 V1636)
504
- (cond
505
- ((tuple? V1635)
506
- (cons shen-t*
507
- (cons (shen-recursive_cons_form (snd V1635))
508
- (cons (shen-construct-context V1636 (fst V1635)) ()))))
509
- ((= ! V1635) (cons cut (cons Throwcontrol ())))
510
- (true (shen-sys-error shen-construct-premiss-literal))))
511
-
512
- (defun shen-construct-context (V1637 V1638)
513
- (cond ((and (= true V1637) (= () V1638)) Context_1957)
514
- ((and (= false V1637) (= () V1638)) ContextOut_1957)
515
- ((cons? V1638)
516
- (cons cons
517
- (cons (shen-recursive_cons_form (hd V1638))
518
- (cons (shen-construct-context V1637 (tl V1638)) ()))))
519
- (true (shen-sys-error shen-construct-context))))
520
-
521
- (defun shen-recursive_cons_form (V1639)
522
- (cond
523
- ((cons? V1639)
524
- (cons cons
525
- (cons (shen-recursive_cons_form (hd V1639))
526
- (cons (shen-recursive_cons_form (tl V1639)) ()))))
527
- (true V1639)))
528
-
529
- (defun preclude (V1640)
530
- (let FilterDatatypes
531
- (set shen-*datatypes* (difference (value shen-*datatypes*) V1640))
532
- (value shen-*datatypes*)))
533
-
534
- (defun include (V1641)
535
- (let ValidTypes (intersection V1641 (value shen-*alldatatypes*))
536
- (let NewDatatypes
537
- (set shen-*datatypes* (union ValidTypes (value shen-*datatypes*)))
538
- (value shen-*datatypes*))))
539
-
540
- (defun preclude-all-but (V1642)
541
- (preclude (difference (value shen-*alldatatypes*) V1642)))
542
-
543
- (defun include-all-but (V1643)
544
- (include (difference (value shen-*alldatatypes*) V1643)))
545
-
546
- (defun shen-synonyms-help (V1648)
547
- (cond ((= () V1648) synonyms)
548
- ((and (cons? V1648) (cons? (tl V1648)))
549
- (do (shen-pushnew (cons (hd V1648) (hd (tl V1648))) shen-*synonyms*)
550
- (shen-synonyms-help (tl (tl V1648)))))
551
- (true (interror "odd number of synonyms~%" (@p () ())))))
552
-
553
- (defun shen-pushnew (V1649 V1650)
554
- (if (element? V1649 (value V1650)) (value V1650)
555
- (set V1650 (cons V1649 (value V1650)))))
556
156