shen-ruby 0.12.1 → 0.13.0

Sign up to get free protection for your applications and to get access to all the features.
Files changed (102) hide show
  1. checksums.yaml +4 -4
  2. data/HISTORY.md +5 -0
  3. data/README.md +8 -12
  4. data/Rakefile +4 -9
  5. data/bin/shen_test_suite.rb +0 -1
  6. data/bin/srrepl +2 -4
  7. data/lib/shen_ruby/shen.rb +98 -0
  8. data/lib/shen_ruby/version.rb +1 -1
  9. data/shen-ruby.gemspec +3 -3
  10. data/shen/README.txt +9 -13
  11. data/shen/release/BSD +24 -0
  12. data/shen/release/klambda/core.kl +157 -0
  13. data/shen/release/klambda/declarations.kl +109 -0
  14. data/shen/release/klambda/load.kl +59 -0
  15. data/shen/release/klambda/macros.kl +91 -0
  16. data/shen/release/klambda/prolog.kl +228 -0
  17. data/shen/release/klambda/reader.kl +198 -0
  18. data/shen/release/klambda/sequent.kl +142 -0
  19. data/shen/release/klambda/sys.kl +253 -0
  20. data/shen/release/klambda/t-star.kl +123 -0
  21. data/shen/release/klambda/toplevel.kl +110 -0
  22. data/shen/release/klambda/track.kl +79 -0
  23. data/shen/release/{k_lambda → klambda}/types.kl +41 -63
  24. data/shen/release/klambda/writer.kl +81 -0
  25. data/shen/release/klambda/yacc.kl +87 -0
  26. data/shen/release/license.pdf +0 -0
  27. data/shen/release/test_programs/Chap13/problems.txt +26 -26
  28. data/shen/release/test_programs/README.shen +52 -52
  29. data/shen/release/test_programs/TinyLispFunctions.txt +15 -15
  30. data/shen/release/test_programs/TinyTypes.shen +55 -55
  31. data/shen/release/test_programs/binary.shen +24 -24
  32. data/shen/release/test_programs/bubble_version_1.shen +28 -28
  33. data/shen/release/test_programs/bubble_version_2.shen +22 -22
  34. data/shen/release/test_programs/calculator.shen +21 -21
  35. data/shen/release/test_programs/cartprod.shen +23 -23
  36. data/shen/release/test_programs/change.shen +25 -25
  37. data/shen/release/test_programs/classes-defaults.shen +94 -94
  38. data/shen/release/test_programs/classes-inheritance.shen +100 -100
  39. data/shen/release/test_programs/classes-typed.shen +74 -74
  40. data/shen/release/test_programs/classes-untyped.shen +46 -46
  41. data/shen/release/test_programs/depth_.shen +14 -14
  42. data/shen/release/test_programs/einstein.shen +34 -34
  43. data/shen/release/test_programs/fruit_machine.shen +46 -46
  44. data/shen/release/test_programs/interpreter.shen +217 -217
  45. data/shen/release/test_programs/metaprog.shen +85 -85
  46. data/shen/release/test_programs/minim.shen +192 -192
  47. data/shen/release/test_programs/mutual.shen +11 -11
  48. data/shen/release/test_programs/n_queens.shen +45 -45
  49. data/shen/release/test_programs/newton_version_1.shen +33 -33
  50. data/shen/release/test_programs/newton_version_2.shen +24 -24
  51. data/shen/release/test_programs/parse.prl +14 -14
  52. data/shen/release/test_programs/parser.shen +51 -51
  53. data/shen/release/test_programs/powerset.shen +10 -10
  54. data/shen/release/test_programs/prime.shen +10 -10
  55. data/shen/release/test_programs/prolog.shen +78 -78
  56. data/shen/release/test_programs/proof_assistant.shen +80 -80
  57. data/shen/release/test_programs/proplog_version_1.shen +25 -25
  58. data/shen/release/test_programs/proplog_version_2.shen +27 -27
  59. data/shen/release/test_programs/qmachine.shen +66 -66
  60. data/shen/release/test_programs/red-black.shen +54 -54
  61. data/shen/release/test_programs/search.shen +55 -55
  62. data/shen/release/test_programs/semantic_net.shen +44 -44
  63. data/shen/release/test_programs/spreadsheet.shen +34 -34
  64. data/shen/release/test_programs/stack.shen +27 -27
  65. data/shen/release/test_programs/streams.shen +20 -20
  66. data/shen/release/test_programs/strings.shen +57 -57
  67. data/shen/release/test_programs/structures-typed.shen +71 -71
  68. data/shen/release/test_programs/structures-untyped.shen +41 -41
  69. data/shen/release/test_programs/tests.shen +232 -232
  70. data/shen/release/test_programs/types.shen +11 -11
  71. data/shen/release/test_programs/whist.shen +239 -239
  72. data/shen/release/test_programs/yacc.shen +132 -132
  73. metadata +21 -35
  74. data/shen/lib/shen_ruby/shen.rb +0 -160
  75. data/shen/license.txt +0 -34
  76. data/shen/release/benchmarks/N_queens.shen +0 -45
  77. data/shen/release/benchmarks/README.shen +0 -14
  78. data/shen/release/benchmarks/benchmarks.shen +0 -52
  79. data/shen/release/benchmarks/bigprog +0 -2173
  80. data/shen/release/benchmarks/einstein.shen +0 -33
  81. data/shen/release/benchmarks/heatwave.gif +0 -0
  82. data/shen/release/benchmarks/interpreter.shen +0 -219
  83. data/shen/release/benchmarks/jnk.shen +0 -194
  84. data/shen/release/benchmarks/picture.jpg +0 -0
  85. data/shen/release/benchmarks/plato.jpg +0 -0
  86. data/shen/release/benchmarks/powerset.shen +0 -10
  87. data/shen/release/benchmarks/prime.shen +0 -10
  88. data/shen/release/benchmarks/short.shen +0 -129
  89. data/shen/release/benchmarks/text.txt +0 -68
  90. data/shen/release/k_lambda/core.kl +0 -181
  91. data/shen/release/k_lambda/declarations.kl +0 -131
  92. data/shen/release/k_lambda/load.kl +0 -84
  93. data/shen/release/k_lambda/macros.kl +0 -112
  94. data/shen/release/k_lambda/prolog.kl +0 -252
  95. data/shen/release/k_lambda/reader.kl +0 -222
  96. data/shen/release/k_lambda/sequent.kl +0 -166
  97. data/shen/release/k_lambda/sys.kl +0 -271
  98. data/shen/release/k_lambda/t-star.kl +0 -139
  99. data/shen/release/k_lambda/toplevel.kl +0 -135
  100. data/shen/release/k_lambda/track.kl +0 -103
  101. data/shen/release/k_lambda/writer.kl +0 -105
  102. data/shen/release/k_lambda/yacc.kl +0 -113
@@ -1,84 +0,0 @@
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 load (V839) (let Load (let Start (get-time run) (let Result (shen.load-help (value shen.*tc*) (read-file V839)) (let Finish (get-time run) (let Time (- Finish Start) (let Message (shen.prhush (cn "
51
- run time: " (cn (str Time) " secs
52
- ")) (stoutput)) Result))))) (let Infs (if (value shen.*tc*) (shen.prhush (cn "
53
- typechecked in " (shen.app (inferences) " inferences
54
- " shen.a)) (stoutput)) shen.skip) loaded)))
55
-
56
- (defun shen.load-help (V844 V845) (cond ((= false V844) (map (lambda X (shen.prhush (shen.app (shen.eval-without-macros X) "
57
- " shen.s) (stoutput))) V845)) (true (let RemoveSynonyms (mapcan (lambda X834 (shen.remove-synonyms X834)) V845) (let Table (mapcan (lambda X835 (shen.typetable X835)) RemoveSynonyms) (let Assume (map (lambda X836 (shen.assumetype X836)) Table) (trap-error (map (lambda X837 (shen.typecheck-and-load X837)) RemoveSynonyms) (lambda E (shen.unwind-types E Table)))))))))
58
-
59
- (defun shen.remove-synonyms (V846) (cond ((and (cons? V846) (= shen.synonyms-help (hd V846))) (do (eval V846) ())) (true (cons V846 ()))))
60
-
61
- (defun shen.typecheck-and-load (V847) (do (nl 1) (shen.typecheck-and-evaluate V847 (gensym A))))
62
-
63
- (defun shen.typetable (V856) (cond ((and (cons? V856) (and (= define (hd V856)) (cons? (tl V856)))) (let Sig (compile (lambda X838 (shen.<sig+rest> X838)) (tl (tl V856)) ()) (if (= Sig (fail)) (simple-error (shen.app (hd (tl V856)) " lacks a proper signature.
64
- " shen.a)) (cons (cons (hd (tl V856)) Sig) ())))) ((and (cons? V856) (and (= defcc (hd V856)) (and (cons? (tl V856)) (and (cons? (tl (tl V856))) (and (= { (hd (tl (tl V856)))) (and (cons? (tl (tl (tl V856)))) (and (cons? (hd (tl (tl (tl V856))))) (and (= list (hd (hd (tl (tl (tl V856)))))) (and (cons? (tl (hd (tl (tl (tl V856)))))) (and (= () (tl (tl (hd (tl (tl (tl V856))))))) (and (cons? (tl (tl (tl (tl V856))))) (and (= ==> (hd (tl (tl (tl (tl V856)))))) (and (cons? (tl (tl (tl (tl (tl V856)))))) (and (cons? (tl (tl (tl (tl (tl (tl V856))))))) (= } (hd (tl (tl (tl (tl (tl (tl V856)))))))))))))))))))))) (cons (cons (hd (tl V856)) (cons (hd (tl (tl (tl V856)))) (cons ==> (cons (hd (tl (tl (tl (tl (tl V856)))))) ())))) ())) ((and (cons? V856) (and (= defcc (hd V856)) (cons? (tl V856)))) (simple-error (shen.app (hd (tl V856)) " lacks a proper signature.
65
- " shen.a))) (true ())))
66
-
67
- (defun shen.assumetype (V857) (cond ((cons? V857) (declare (hd V857) (tl V857))) (true (shen.sys-error shen.assumetype))))
68
-
69
- (defun shen.unwind-types (V862 V863) (cond ((= () V863) (simple-error (error-to-string V862))) ((and (cons? V863) (cons? (hd V863))) (do (shen.remtype (hd (hd V863))) (shen.unwind-types V862 (tl V863)))) (true (shen.sys-error shen.unwind-types))))
70
-
71
- (defun shen.remtype (V864) (set shen.*signedfuncs* (shen.removetype V864 (value shen.*signedfuncs*))))
72
-
73
- (defun shen.removetype (V869 V870) (cond ((= () V870) ()) ((and (cons? V870) (and (cons? (hd V870)) (= (hd (hd V870)) V869))) (shen.removetype (hd (hd V870)) (tl V870))) ((cons? V870) (cons (hd V870) (shen.removetype V869 (tl V870)))) (true (shen.sys-error shen.removetype))))
74
-
75
- (defun shen.<sig+rest> (V876) (let Result (let Parse_shen.<signature> (shen.<signature> V876) (if (not (= (fail) Parse_shen.<signature>)) (let Parse_<!> (<!> Parse_shen.<signature>) (if (not (= (fail) Parse_<!>)) (shen.pair (hd Parse_<!>) (shen.hdtl Parse_shen.<signature>)) (fail))) (fail))) (if (= Result (fail)) (fail) Result)))
76
-
77
- (defun write-to-file (V877 V878) (let Stream (open V877 out) (let String (if (string? V878) (shen.app V878 "
78
-
79
- " shen.a) (shen.app V878 "
80
-
81
- " shen.s)) (let Write (pr String Stream) (let Close (close Stream) V878)))))
82
-
83
-
84
-
@@ -1,112 +0,0 @@
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 macroexpand (V882) (let Y (shen.compose (value *macros*) V882) (if (= V882 Y) V882 (shen.walk (lambda X879 (macroexpand X879)) Y))))
51
-
52
- (set *macros* (cons shen.timer-macro (cons shen.cases-macro (cons shen.abs-macro (cons shen.put/get-macro (cons shen.compile-macro (cons shen.datatype-macro (cons shen.let-macro (cons shen.assoc-macro (cons shen.make-string-macro (cons shen.output-macro (cons shen.input-macro (cons shen.error-macro (cons shen.prolog-macro (cons shen.synonyms-macro (cons shen.nl-macro (cons shen.@s-macro (cons shen.defprolog-macro (cons shen.function-macro ())))))))))))))))))))
53
-
54
- (defun shen.error-macro (V883) (cond ((and (cons? V883) (and (= error (hd V883)) (cons? (tl V883)))) (cons simple-error (cons (shen.mkstr (hd (tl V883)) (tl (tl V883))) ()))) (true V883)))
55
-
56
- (defun shen.output-macro (V884) (cond ((and (cons? V884) (and (= output (hd V884)) (cons? (tl V884)))) (cons shen.prhush (cons (shen.mkstr (hd (tl V884)) (tl (tl V884))) (cons (cons stoutput ()) ())))) ((and (cons? V884) (and (= pr (hd V884)) (and (cons? (tl V884)) (= () (tl (tl V884)))))) (cons pr (cons (hd (tl V884)) (cons (cons stoutput ()) ())))) (true V884)))
57
-
58
- (defun shen.make-string-macro (V885) (cond ((and (cons? V885) (and (= make-string (hd V885)) (cons? (tl V885)))) (shen.mkstr (hd (tl V885)) (tl (tl V885)))) (true V885)))
59
-
60
- (defun shen.input-macro (V886) (cond ((and (cons? V886) (and (= lineread (hd V886)) (= () (tl V886)))) (cons lineread (cons (cons stinput ()) ()))) ((and (cons? V886) (and (= input (hd V886)) (= () (tl V886)))) (cons input (cons (cons stinput ()) ()))) ((and (cons? V886) (and (= read (hd V886)) (= () (tl V886)))) (cons read (cons (cons stinput ()) ()))) ((and (cons? V886) (and (= input+ (hd V886)) (and (cons? (tl V886)) (= () (tl (tl V886)))))) (cons input+ (cons (hd (tl V886)) (cons (cons stinput ()) ())))) ((and (cons? V886) (and (= read-byte (hd V886)) (= () (tl V886)))) (cons read-byte (cons (cons stinput ()) ()))) (true V886)))
61
-
62
- (defun shen.compose (V887 V888) (cond ((= () V887) V888) ((cons? V887) (shen.compose (tl V887) ((hd V887) V888))) (true (shen.sys-error shen.compose))))
63
-
64
- (defun shen.compile-macro (V889) (cond ((and (cons? V889) (and (= compile (hd V889)) (and (cons? (tl V889)) (and (cons? (tl (tl V889))) (= () (tl (tl (tl V889)))))))) (cons compile (cons (hd (tl V889)) (cons (hd (tl (tl V889))) (cons (cons lambda (cons E (cons (cons if (cons (cons cons? (cons E ())) (cons (cons error (cons "parse error here: ~S~%" (cons E ()))) (cons (cons error (cons "parse error~%" ())) ())))) ()))) ()))))) (true V889)))
65
-
66
- (defun shen.prolog-macro (V890) (cond ((and (cons? V890) (= prolog? (hd V890))) (let F (gensym shen.f) (let Receive (shen.receive-terms (tl V890)) (let PrologDef (eval (append (cons defprolog (cons F ())) (append Receive (append (cons <-- ()) (append (shen.pass-literals (tl V890)) (cons ; ())))))) (let Query (cons F (append Receive (cons (cons shen.start-new-prolog-process ()) (cons (cons freeze (cons true ())) ())))) Query))))) (true V890)))
67
-
68
- (defun shen.receive-terms (V895) (cond ((= () V895) ()) ((and (cons? V895) (and (cons? (hd V895)) (and (= receive (hd (hd V895))) (and (cons? (tl (hd V895))) (= () (tl (tl (hd V895)))))))) (cons (hd (tl (hd V895))) (shen.receive-terms (tl V895)))) ((cons? V895) (shen.receive-terms (tl V895))) (true (shen.sys-error shen.receive-terms))))
69
-
70
- (defun shen.pass-literals (V898) (cond ((= () V898) ()) ((and (cons? V898) (and (cons? (hd V898)) (and (= receive (hd (hd V898))) (and (cons? (tl (hd V898))) (= () (tl (tl (hd V898)))))))) (shen.pass-literals (tl V898))) ((cons? V898) (cons (hd V898) (shen.pass-literals (tl V898)))) (true (shen.sys-error shen.pass-literals))))
71
-
72
- (defun shen.defprolog-macro (V899) (cond ((and (cons? V899) (and (= defprolog (hd V899)) (cons? (tl V899)))) (compile (lambda X880 (shen.<defprolog> X880)) (tl V899) (lambda Y (shen.prolog-error (hd (tl V899)) Y)))) (true V899)))
73
-
74
- (defun shen.datatype-macro (V900) (cond ((and (cons? V900) (and (= datatype (hd V900)) (cons? (tl V900)))) (cons shen.process-datatype (cons (shen.intern-type (hd (tl V900))) (cons (cons compile (cons (cons function (cons shen.<datatype-rules> ())) (cons (shen.rcons_form (tl (tl V900))) (cons (cons function (cons shen.datatype-error ())) ())))) ())))) (true V900)))
75
-
76
- (defun shen.intern-type (V901) (intern (cn "type#" (str V901))))
77
-
78
- (defun shen.@s-macro (V902) (cond ((and (cons? V902) (and (= @s (hd V902)) (and (cons? (tl V902)) (and (cons? (tl (tl V902))) (cons? (tl (tl (tl V902)))))))) (cons @s (cons (hd (tl V902)) (cons (shen.@s-macro (cons @s (tl (tl V902)))) ())))) ((and (cons? V902) (and (= @s (hd V902)) (and (cons? (tl V902)) (and (cons? (tl (tl V902))) (and (= () (tl (tl (tl V902)))) (string? (hd (tl V902)))))))) (let E (explode (hd (tl V902))) (if (> (length E) 1) (shen.@s-macro (cons @s (append E (tl (tl V902))))) V902))) (true V902)))
79
-
80
- (defun shen.synonyms-macro (V903) (cond ((and (cons? V903) (= synonyms (hd V903))) (cons shen.synonyms-help (cons (shen.rcons_form (shen.curry-synonyms (tl V903))) ()))) (true V903)))
81
-
82
- (defun shen.curry-synonyms (V904) (map (lambda X881 (shen.curry-type X881)) V904))
83
-
84
- (defun shen.nl-macro (V905) (cond ((and (cons? V905) (and (= nl (hd V905)) (= () (tl V905)))) (cons nl (cons 1 ()))) (true V905)))
85
-
86
- (defun shen.assoc-macro (V906) (cond ((and (cons? V906) (and (cons? (tl V906)) (and (cons? (tl (tl V906))) (and (cons? (tl (tl (tl V906)))) (element? (hd V906) (cons @p (cons @v (cons append (cons and (cons or (cons + (cons * (cons do ()))))))))))))) (cons (hd V906) (cons (hd (tl V906)) (cons (shen.assoc-macro (cons (hd V906) (tl (tl V906)))) ())))) (true V906)))
87
-
88
- (defun shen.let-macro (V907) (cond ((and (cons? V907) (and (= let (hd V907)) (and (cons? (tl V907)) (and (cons? (tl (tl V907))) (and (cons? (tl (tl (tl V907)))) (cons? (tl (tl (tl (tl V907)))))))))) (cons let (cons (hd (tl V907)) (cons (hd (tl (tl V907))) (cons (shen.let-macro (cons let (tl (tl (tl V907))))) ()))))) (true V907)))
89
-
90
- (defun shen.abs-macro (V908) (cond ((and (cons? V908) (and (= /. (hd V908)) (and (cons? (tl V908)) (and (cons? (tl (tl V908))) (cons? (tl (tl (tl V908)))))))) (cons lambda (cons (hd (tl V908)) (cons (shen.abs-macro (cons /. (tl (tl V908)))) ())))) ((and (cons? V908) (and (= /. (hd V908)) (and (cons? (tl V908)) (and (cons? (tl (tl V908))) (= () (tl (tl (tl V908)))))))) (cons lambda (tl V908))) (true V908)))
91
-
92
- (defun shen.cases-macro (V911) (cond ((and (cons? V911) (and (= cases (hd V911)) (and (cons? (tl V911)) (and (= true (hd (tl V911))) (cons? (tl (tl V911))))))) (hd (tl (tl V911)))) ((and (cons? V911) (and (= cases (hd V911)) (and (cons? (tl V911)) (and (cons? (tl (tl V911))) (= () (tl (tl (tl V911)))))))) (cons if (cons (hd (tl V911)) (cons (hd (tl (tl V911))) (cons (cons simple-error (cons "error: cases exhausted" ())) ()))))) ((and (cons? V911) (and (= cases (hd V911)) (and (cons? (tl V911)) (cons? (tl (tl V911)))))) (cons if (cons (hd (tl V911)) (cons (hd (tl (tl V911))) (cons (shen.cases-macro (cons cases (tl (tl (tl V911))))) ()))))) ((and (cons? V911) (and (= cases (hd V911)) (and (cons? (tl V911)) (= () (tl (tl V911)))))) (simple-error "error: odd number of case elements
93
- ")) (true V911)))
94
-
95
- (defun shen.timer-macro (V912) (cond ((and (cons? V912) (and (= time (hd V912)) (and (cons? (tl V912)) (= () (tl (tl V912)))))) (shen.let-macro (cons let (cons Start (cons (cons get-time (cons run ())) (cons Result (cons (hd (tl V912)) (cons Finish (cons (cons get-time (cons run ())) (cons Time (cons (cons - (cons Finish (cons Start ()))) (cons Message (cons (cons shen.prhush (cons (cons cn (cons "
96
- run time: " (cons (cons cn (cons (cons str (cons Time ())) (cons " secs
97
- " ()))) ()))) (cons (cons stoutput ()) ()))) (cons Result ())))))))))))))) (true V912)))
98
-
99
- (defun shen.tuple-up (V913) (cond ((cons? V913) (cons @p (cons (hd V913) (cons (shen.tuple-up (tl V913)) ())))) (true V913)))
100
-
101
- (defun shen.put/get-macro (V914) (cond ((and (cons? V914) (and (= put (hd V914)) (and (cons? (tl V914)) (and (cons? (tl (tl V914))) (and (cons? (tl (tl (tl V914)))) (= () (tl (tl (tl (tl V914)))))))))) (cons put (cons (hd (tl V914)) (cons (hd (tl (tl V914))) (cons (hd (tl (tl (tl V914)))) (cons (cons value (cons *property-vector* ())) ())))))) ((and (cons? V914) (and (= get (hd V914)) (and (cons? (tl V914)) (and (cons? (tl (tl V914))) (= () (tl (tl (tl V914)))))))) (cons get (cons (hd (tl V914)) (cons (hd (tl (tl V914))) (cons (cons value (cons *property-vector* ())) ()))))) (true V914)))
102
-
103
- (defun shen.function-macro (V915) (cond ((and (cons? V915) (and (= function (hd V915)) (and (cons? (tl V915)) (= () (tl (tl V915)))))) (shen.function-abstraction (hd (tl V915)) (arity (hd (tl V915))))) (true V915)))
104
-
105
- (defun shen.function-abstraction (V916 V917) (cond ((= 0 V917) (cons freeze (cons V916 ()))) ((= -1 V917) V916) (true (shen.function-abstraction-help V916 V917 ()))))
106
-
107
- (defun shen.function-abstraction-help (V918 V919 V920) (cond ((= 0 V919) (cons V918 V920)) (true (let X (gensym V) (cons /. (cons X (cons (shen.function-abstraction-help V918 (- V919 1) (append V920 (cons X ()))) ())))))))
108
-
109
- (defun undefmacro (V921) (do (set *macros* (remove V921 (value *macros*))) V921))
110
-
111
-
112
-
@@ -1,252 +0,0 @@
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> (V937) (let Result (let Parse_shen.<predicate*> (shen.<predicate*> V937) (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 (V944 V945) (cond ((and (cons? V945) (and (cons? (tl V945)) (= () (tl (tl V945))))) (simple-error (cn "prolog syntax error in " (shen.app V944 (cn " here:
53
-
54
- " (shen.app (shen.next-50 50 (hd V945)) "
55
- " shen.a)) shen.a)))) (true (simple-error (cn "prolog syntax error in " (shen.app V944 "
56
- " shen.a))))))
57
-
58
- (defun shen.next-50 (V950 V951) (cond ((= () V951) "") ((= 0 V950) "") ((cons? V951) (cn (shen.decons-string (hd V951)) (shen.next-50 (- V950 1) (tl V951)))) (true (shen.sys-error shen.next-50))))
59
-
60
- (defun shen.decons-string (V952) (cond ((and (cons? V952) (and (= cons (hd V952)) (and (cons? (tl V952)) (and (cons? (tl (tl V952))) (= () (tl (tl (tl V952)))))))) (shen.app (shen.eval-cons V952) " " shen.s)) (true (shen.app V952 " " shen.r))))
61
-
62
- (defun shen.insert-predicate (V953 V954) (cond ((and (cons? V954) (and (cons? (tl V954)) (= () (tl (tl V954))))) (cons (cons V953 (hd V954)) (cons :- (tl V954)))) (true (shen.sys-error shen.insert-predicate))))
63
-
64
- (defun shen.<predicate*> (V959) (let Result (if (cons? (hd V959)) (let Parse_X (hd (hd V959)) (shen.pair (hd (shen.pair (tl (hd V959)) (shen.hdtl V959))) Parse_X)) (fail)) (if (= Result (fail)) (fail) Result)))
65
-
66
- (defun shen.<clauses*> (V964) (let Result (let Parse_shen.<clause*> (shen.<clause*> V964) (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> V964) (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*> (V969) (let Result (let Parse_shen.<head*> (shen.<head*> V969) (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*> (V974) (let Result (let Parse_shen.<term*> (shen.<term*> V974) (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> V974) (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*> (V979) (let Result (if (cons? (hd V979)) (let Parse_X (hd (hd V979)) (if (and (not (= <-- Parse_X)) (shen.legitimate-term? Parse_X)) (shen.pair (hd (shen.pair (tl (hd V979)) (shen.hdtl V979))) (shen.eval-cons Parse_X)) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
73
-
74
- (defun shen.legitimate-term? (V984) (cond ((and (cons? V984) (and (= cons (hd V984)) (and (cons? (tl V984)) (and (cons? (tl (tl V984))) (= () (tl (tl (tl V984)))))))) (and (shen.legitimate-term? (hd (tl V984))) (shen.legitimate-term? (hd (tl (tl V984)))))) ((and (cons? V984) (and (= mode (hd V984)) (and (cons? (tl V984)) (and (cons? (tl (tl V984))) (and (= + (hd (tl (tl V984)))) (= () (tl (tl (tl V984))))))))) (shen.legitimate-term? (hd (tl V984)))) ((and (cons? V984) (and (= mode (hd V984)) (and (cons? (tl V984)) (and (cons? (tl (tl V984))) (and (= - (hd (tl (tl V984)))) (= () (tl (tl (tl V984))))))))) (shen.legitimate-term? (hd (tl V984)))) ((cons? V984) false) (true true)))
75
-
76
- (defun shen.eval-cons (V985) (cond ((and (cons? V985) (and (= cons (hd V985)) (and (cons? (tl V985)) (and (cons? (tl (tl V985))) (= () (tl (tl (tl V985)))))))) (cons (shen.eval-cons (hd (tl V985))) (shen.eval-cons (hd (tl (tl V985)))))) ((and (cons? V985) (and (= mode (hd V985)) (and (cons? (tl V985)) (and (cons? (tl (tl V985))) (= () (tl (tl (tl V985)))))))) (cons mode (cons (shen.eval-cons (hd (tl V985))) (tl (tl V985))))) (true V985)))
77
-
78
- (defun shen.<body*> (V990) (let Result (let Parse_shen.<literal*> (shen.<literal*> V990) (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> V990) (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*> (V995) (let Result (if (and (cons? (hd V995)) (= ! (hd (hd V995)))) (shen.pair (hd (shen.pair (tl (hd V995)) (shen.hdtl V995))) (cons cut (cons (intern "Throwcontrol") ()))) (fail)) (if (= Result (fail)) (let Result (if (cons? (hd V995)) (let Parse_X (hd (hd V995)) (if (cons? Parse_X) (shen.pair (hd (shen.pair (tl (hd V995)) (shen.hdtl V995))) Parse_X) (fail))) (fail)) (if (= Result (fail)) (fail) Result)) Result)))
81
-
82
- (defun shen.<end*> (V1000) (let Result (if (cons? (hd V1000)) (let Parse_X (hd (hd V1000)) (if (= Parse_X ;) (shen.pair (hd (shen.pair (tl (hd V1000)) (shen.hdtl V1000))) Parse_X) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
83
-
84
- (defun cut (V1001 V1002 V1003) (let Result (thaw V1003) (if (= Result false) V1001 Result)))
85
-
86
- (defun shen.insert_modes (V1004) (cond ((and (cons? V1004) (and (= mode (hd V1004)) (and (cons? (tl V1004)) (and (cons? (tl (tl V1004))) (= () (tl (tl (tl V1004)))))))) V1004) ((= () V1004) ()) ((cons? V1004) (cons (cons mode (cons (hd V1004) (cons + ()))) (cons mode (cons (shen.insert_modes (tl V1004)) (cons - ()))))) (true V1004)))
87
-
88
- (defun shen.s-prolog (V1005) (map (lambda X922 (eval X922)) (shen.prolog->shen V1005)))
89
-
90
- (defun shen.prolog->shen (V1006) (map (lambda X923 (shen.compile_prolog_procedure X923)) (shen.group_clauses (map (lambda X924 (shen.s-prolog_clause X924)) (mapcan (lambda X925 (shen.head_abstraction X925)) V1006)))))
91
-
92
- (defun shen.s-prolog_clause (V1007) (cond ((and (cons? V1007) (and (cons? (tl V1007)) (and (= :- (hd (tl V1007))) (and (cons? (tl (tl V1007))) (= () (tl (tl (tl V1007)))))))) (cons (hd V1007) (cons :- (cons (map (lambda X926 (shen.s-prolog_literal X926)) (hd (tl (tl V1007)))) ())))) (true (shen.sys-error shen.s-prolog_clause))))
93
-
94
- (defun shen.head_abstraction (V1008) (cond ((and (cons? V1008) (and (cons? (tl V1008)) (and (= :- (hd (tl V1008))) (and (cons? (tl (tl V1008))) (and (= () (tl (tl (tl V1008)))) (< (shen.complexity_head (hd V1008)) (value shen.*maxcomplexity*))))))) (cons V1008 ())) ((and (cons? V1008) (and (cons? (hd V1008)) (and (cons? (tl V1008)) (and (= :- (hd (tl V1008))) (and (cons? (tl (tl V1008))) (= () (tl (tl (tl V1008))))))))) (let Terms (map (lambda Y (gensym V)) (tl (hd V1008))) (let XTerms (shen.rcons_form (shen.remove_modes (tl (hd V1008)))) (let Literal (cons unify (cons (shen.cons_form Terms) (cons XTerms ()))) (let Clause (cons (cons (hd (hd V1008)) Terms) (cons :- (cons (cons Literal (hd (tl (tl V1008)))) ()))) (cons Clause ())))))) (true (shen.sys-error shen.head_abstraction))))
95
-
96
- (defun shen.complexity_head (V1013) (cond ((cons? V1013) (shen.product (map (lambda X927 (shen.complexity X927)) (tl V1013)))) (true (shen.sys-error shen.complexity_head))))
97
-
98
- (defun shen.complexity (V1021) (cond ((and (cons? V1021) (and (= mode (hd V1021)) (and (cons? (tl V1021)) (and (cons? (hd (tl V1021))) (and (= mode (hd (hd (tl V1021)))) (and (cons? (tl (hd (tl V1021)))) (and (cons? (tl (tl (hd (tl V1021))))) (and (= () (tl (tl (tl (hd (tl V1021)))))) (and (cons? (tl (tl V1021))) (= () (tl (tl (tl V1021))))))))))))) (shen.complexity (hd (tl V1021)))) ((and (cons? V1021) (and (= mode (hd V1021)) (and (cons? (tl V1021)) (and (cons? (hd (tl V1021))) (and (cons? (tl (tl V1021))) (and (= + (hd (tl (tl V1021)))) (= () (tl (tl (tl V1021)))))))))) (* 2 (* (shen.complexity (cons mode (cons (hd (hd (tl V1021))) (tl (tl V1021))))) (shen.complexity (cons mode (cons (tl (hd (tl V1021))) (tl (tl V1021)))))))) ((and (cons? V1021) (and (= mode (hd V1021)) (and (cons? (tl V1021)) (and (cons? (hd (tl V1021))) (and (cons? (tl (tl V1021))) (and (= - (hd (tl (tl V1021)))) (= () (tl (tl (tl V1021)))))))))) (* (shen.complexity (cons mode (cons (hd (hd (tl V1021))) (tl (tl V1021))))) (shen.complexity (cons mode (cons (tl (hd (tl V1021))) (tl (tl V1021))))))) ((and (cons? V1021) (and (= mode (hd V1021)) (and (cons? (tl V1021)) (and (cons? (tl (tl V1021))) (and (= () (tl (tl (tl V1021)))) (variable? (hd (tl V1021)))))))) 1) ((and (cons? V1021) (and (= mode (hd V1021)) (and (cons? (tl V1021)) (and (cons? (tl (tl V1021))) (and (= + (hd (tl (tl V1021)))) (= () (tl (tl (tl V1021))))))))) 2) ((and (cons? V1021) (and (= mode (hd V1021)) (and (cons? (tl V1021)) (and (cons? (tl (tl V1021))) (and (= - (hd (tl (tl V1021)))) (= () (tl (tl (tl V1021))))))))) 1) (true (shen.complexity (cons mode (cons V1021 (cons + ())))))))
99
-
100
- (defun shen.product (V1022) (cond ((= () V1022) 1) ((cons? V1022) (* (hd V1022) (shen.product (tl V1022)))) (true (shen.sys-error shen.product))))
101
-
102
- (defun shen.s-prolog_literal (V1023) (cond ((and (cons? V1023) (and (= is (hd V1023)) (and (cons? (tl V1023)) (and (cons? (tl (tl V1023))) (= () (tl (tl (tl V1023)))))))) (cons bind (cons (hd (tl V1023)) (cons (shen.insert_deref (hd (tl (tl V1023)))) ())))) ((and (cons? V1023) (and (= when (hd V1023)) (and (cons? (tl V1023)) (= () (tl (tl V1023)))))) (cons fwhen (cons (shen.insert_deref (hd (tl V1023))) ()))) ((and (cons? V1023) (and (= bind (hd V1023)) (and (cons? (tl V1023)) (and (cons? (tl (tl V1023))) (= () (tl (tl (tl V1023)))))))) (cons bind (cons (hd (tl V1023)) (cons (shen.insert_lazyderef (hd (tl (tl V1023)))) ())))) ((and (cons? V1023) (and (= fwhen (hd V1023)) (and (cons? (tl V1023)) (= () (tl (tl V1023)))))) (cons fwhen (cons (shen.insert_lazyderef (hd (tl V1023))) ()))) ((cons? V1023) (cons (shen.m_prolog_to_s-prolog_predicate (hd V1023)) (tl V1023))) (true (shen.sys-error shen.s-prolog_literal))))
103
-
104
- (defun shen.insert_deref (V1024) (cond ((variable? V1024) (cons shen.deref (cons V1024 (cons ProcessN ())))) ((cons? V1024) (cons (shen.insert_deref (hd V1024)) (shen.insert_deref (tl V1024)))) (true V1024)))
105
-
106
- (defun shen.insert_lazyderef (V1025) (cond ((variable? V1025) (cons shen.lazyderef (cons V1025 (cons ProcessN ())))) ((cons? V1025) (cons (shen.insert_lazyderef (hd V1025)) (shen.insert_lazyderef (tl V1025)))) (true V1025)))
107
-
108
- (defun shen.m_prolog_to_s-prolog_predicate (V1026) (cond ((= = V1026) unify) ((= =! V1026) unify!) ((= == V1026) identical) (true V1026)))
109
-
110
- (defun shen.group_clauses (V1027) (cond ((= () V1027) ()) ((cons? V1027) (let Group (shen.collect (lambda X (shen.same_predicate? (hd V1027) X)) V1027) (let Rest (difference V1027 Group) (cons Group (shen.group_clauses Rest))))) (true (shen.sys-error shen.group_clauses))))
111
-
112
- (defun shen.collect (V1030 V1031) (cond ((= () V1031) ()) ((cons? V1031) (if (V1030 (hd V1031)) (cons (hd V1031) (shen.collect V1030 (tl V1031))) (shen.collect V1030 (tl V1031)))) (true (shen.sys-error shen.collect))))
113
-
114
- (defun shen.same_predicate? (V1048 V1049) (cond ((and (cons? V1048) (and (cons? (hd V1048)) (and (cons? V1049) (cons? (hd V1049))))) (= (hd (hd V1048)) (hd (hd V1049)))) (true (shen.sys-error shen.same_predicate?))))
115
-
116
- (defun shen.compile_prolog_procedure (V1050) (let F (shen.procedure_name V1050) (let Shen (shen.clauses-to-shen F V1050) Shen)))
117
-
118
- (defun shen.procedure_name (V1063) (cond ((and (cons? V1063) (and (cons? (hd V1063)) (cons? (hd (hd V1063))))) (hd (hd (hd V1063)))) (true (shen.sys-error shen.procedure_name))))
119
-
120
- (defun shen.clauses-to-shen (V1064 V1065) (let Linear (map (lambda X928 (shen.linearise-clause X928)) V1065) (let Arity (shen.prolog-aritycheck V1064 (map (lambda X929 (head X929)) V1065)) (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 (lambda X930 (shen.aum_to_shen X930)) AUM_instructions))) (let ShenDef (cons define (cons V1064 (append Parameters (append (cons ProcessN (cons Continuation ())) (cons -> (cons Code ())))))) ShenDef)))))))
121
-
122
- (defun shen.catch-cut (V1066) (cond ((not (shen.occurs? cut V1066)) V1066) (true (cons let (cons Throwcontrol (cons (cons shen.catchpoint ()) (cons (cons shen.cutpoint (cons Throwcontrol (cons V1066 ()))) ())))))))
123
-
124
- (defun shen.catchpoint () (set shen.*catch* (+ 1 (value shen.*catch*))))
125
-
126
- (defun shen.cutpoint (V1071 V1072) (cond ((= V1072 V1071) false) (true V1072)))
127
-
128
- (defun shen.nest-disjunct (V1074) (cond ((and (cons? V1074) (= () (tl V1074))) (hd V1074)) ((cons? V1074) (shen.lisp-or (hd V1074) (shen.nest-disjunct (tl V1074)))) (true (shen.sys-error shen.nest-disjunct))))
129
-
130
- (defun shen.lisp-or (V1075 V1076) (cons let (cons Case (cons V1075 (cons (cons if (cons (cons = (cons Case (cons false ()))) (cons V1076 (cons Case ())))) ())))))
131
-
132
- (defun shen.prolog-aritycheck (V1079 V1080) (cond ((and (cons? V1080) (= () (tl V1080))) (- (length (hd V1080)) 1)) ((and (cons? V1080) (cons? (tl V1080))) (if (= (length (hd V1080)) (length (hd (tl V1080)))) (shen.prolog-aritycheck V1079 (tl V1080)) (simple-error (cn "arity error in prolog procedure " (shen.app (cons V1079 ()) "
133
- " shen.a))))) (true (shen.sys-error shen.prolog-aritycheck))))
134
-
135
- (defun shen.linearise-clause (V1081) (cond ((and (cons? V1081) (and (cons? (tl V1081)) (and (= :- (hd (tl V1081))) (and (cons? (tl (tl V1081))) (= () (tl (tl (tl V1081)))))))) (let Linear (shen.linearise (cons (hd V1081) (tl (tl V1081)))) (shen.clause_form Linear))) (true (shen.sys-error shen.linearise-clause))))
136
-
137
- (defun shen.clause_form (V1082) (cond ((and (cons? V1082) (and (cons? (tl V1082)) (= () (tl (tl V1082))))) (cons (shen.explicit_modes (hd V1082)) (cons :- (cons (shen.cf_help (hd (tl V1082))) ())))) (true (shen.sys-error shen.clause_form))))
138
-
139
- (defun shen.explicit_modes (V1083) (cond ((cons? V1083) (cons (hd V1083) (map (lambda X931 (shen.em_help X931)) (tl V1083)))) (true (shen.sys-error shen.explicit_modes))))
140
-
141
- (defun shen.em_help (V1084) (cond ((and (cons? V1084) (and (= mode (hd V1084)) (and (cons? (tl V1084)) (and (cons? (tl (tl V1084))) (= () (tl (tl (tl V1084)))))))) V1084) (true (cons mode (cons V1084 (cons + ()))))))
142
-
143
- (defun shen.cf_help (V1085) (cond ((and (cons? V1085) (and (= where (hd V1085)) (and (cons? (tl V1085)) (and (cons? (hd (tl V1085))) (and (= = (hd (hd (tl V1085)))) (and (cons? (tl (hd (tl V1085)))) (and (cons? (tl (tl (hd (tl V1085))))) (and (= () (tl (tl (tl (hd (tl V1085)))))) (and (cons? (tl (tl V1085))) (= () (tl (tl (tl V1085))))))))))))) (cons (cons (if (value shen.*occurs*) unify! unify) (tl (hd (tl V1085)))) (shen.cf_help (hd (tl (tl V1085)))))) (true V1085)))
144
-
145
- (defun occurs-check (V1090) (cond ((= + V1090) (set shen.*occurs* true)) ((= - V1090) (set shen.*occurs* false)) (true (simple-error "occurs-check expects + or -
146
- "))))
147
-
148
- (defun shen.aum (V1091 V1092) (cond ((and (cons? V1091) (and (cons? (hd V1091)) (and (cons? (tl V1091)) (and (= :- (hd (tl V1091))) (and (cons? (tl (tl V1091))) (= () (tl (tl (tl V1091))))))))) (let MuApplication (shen.make_mu_application (cons shen.mu (cons (tl (hd V1091)) (cons (shen.continuation_call (tl (hd V1091)) (hd (tl (tl V1091)))) ()))) V1092) (shen.mu_reduction MuApplication +))) (true (shen.sys-error shen.aum))))
149
-
150
- (defun shen.continuation_call (V1093 V1094) (let VTerms (cons ProcessN (shen.extract_vars V1093)) (let VBody (shen.extract_vars V1094) (let Free (remove Throwcontrol (difference VBody VTerms)) (shen.cc_help Free V1094)))))
151
-
152
- (defun remove (V1095 V1096) (shen.remove-h V1095 V1096 ()))
153
-
154
- (defun shen.remove-h (V1099 V1100 V1101) (cond ((= () V1100) (reverse V1101)) ((and (cons? V1100) (= (hd V1100) V1099)) (shen.remove-h (hd V1100) (tl V1100) V1101)) ((cons? V1100) (shen.remove-h V1099 (tl V1100) (cons (hd V1100) V1101))) (true (shen.sys-error shen.remove-h))))
155
-
156
- (defun shen.cc_help (V1103 V1104) (cond ((and (= () V1103) (= () V1104)) (cons shen.pop (cons shen.the (cons shen.stack ())))) ((= () V1104) (cons shen.rename (cons shen.the (cons shen.variables (cons in (cons V1103 (cons and (cons shen.then (cons (cons shen.pop (cons shen.the (cons shen.stack ()))) ()))))))))) ((= () V1103) (cons call (cons shen.the (cons shen.continuation (cons V1104 ()))))) (true (cons shen.rename (cons shen.the (cons shen.variables (cons in (cons V1103 (cons and (cons shen.then (cons (cons call (cons shen.the (cons shen.continuation (cons V1104 ())))) ())))))))))))
157
-
158
- (defun shen.make_mu_application (V1105 V1106) (cond ((and (cons? V1105) (and (= shen.mu (hd V1105)) (and (cons? (tl V1105)) (and (= () (hd (tl V1105))) (and (cons? (tl (tl V1105))) (and (= () (tl (tl (tl V1105)))) (= () V1106))))))) (hd (tl (tl V1105)))) ((and (cons? V1105) (and (= shen.mu (hd V1105)) (and (cons? (tl V1105)) (and (cons? (hd (tl V1105))) (and (cons? (tl (tl V1105))) (and (= () (tl (tl (tl V1105)))) (cons? V1106))))))) (cons (cons shen.mu (cons (hd (hd (tl V1105))) (cons (shen.make_mu_application (cons shen.mu (cons (tl (hd (tl V1105))) (tl (tl V1105)))) (tl V1106)) ()))) (cons (hd V1106) ()))) (true (shen.sys-error shen.make_mu_application))))
159
-
160
- (defun shen.mu_reduction (V1113 V1114) (cond ((and (cons? V1113) (and (cons? (hd V1113)) (and (= shen.mu (hd (hd V1113))) (and (cons? (tl (hd V1113))) (and (cons? (hd (tl (hd V1113)))) (and (= mode (hd (hd (tl (hd V1113))))) (and (cons? (tl (hd (tl (hd V1113))))) (and (cons? (tl (tl (hd (tl (hd V1113)))))) (and (= () (tl (tl (tl (hd (tl (hd V1113))))))) (and (cons? (tl (tl (hd V1113)))) (and (= () (tl (tl (tl (hd V1113))))) (and (cons? (tl V1113)) (= () (tl (tl V1113))))))))))))))) (shen.mu_reduction (cons (cons shen.mu (cons (hd (tl (hd (tl (hd V1113))))) (tl (tl (hd V1113))))) (tl V1113)) (hd (tl (tl (hd (tl (hd V1113)))))))) ((and (cons? V1113) (and (cons? (hd V1113)) (and (= shen.mu (hd (hd V1113))) (and (cons? (tl (hd V1113))) (and (cons? (tl (tl (hd V1113)))) (and (= () (tl (tl (tl (hd V1113))))) (and (cons? (tl V1113)) (and (= () (tl (tl V1113))) (= _ (hd (tl (hd V1113)))))))))))) (shen.mu_reduction (hd (tl (tl (hd V1113)))) V1114)) ((and (cons? V1113) (and (cons? (hd V1113)) (and (= shen.mu (hd (hd V1113))) (and (cons? (tl (hd V1113))) (and (cons? (tl (tl (hd V1113)))) (and (= () (tl (tl (tl (hd V1113))))) (and (cons? (tl V1113)) (and (= () (tl (tl V1113))) (shen.ephemeral_variable? (hd (tl (hd V1113))) (hd (tl V1113))))))))))) (subst (hd (tl V1113)) (hd (tl (hd V1113))) (shen.mu_reduction (hd (tl (tl (hd V1113)))) V1114))) ((and (cons? V1113) (and (cons? (hd V1113)) (and (= shen.mu (hd (hd V1113))) (and (cons? (tl (hd V1113))) (and (cons? (tl (tl (hd V1113)))) (and (= () (tl (tl (tl (hd V1113))))) (and (cons? (tl V1113)) (and (= () (tl (tl V1113))) (variable? (hd (tl (hd V1113)))))))))))) (cons let (cons (hd (tl (hd V1113))) (cons shen.be (cons (hd (tl V1113)) (cons in (cons (shen.mu_reduction (hd (tl (tl (hd V1113)))) V1114) ()))))))) ((and (cons? V1113) (and (cons? (hd V1113)) (and (= shen.mu (hd (hd V1113))) (and (cons? (tl (hd V1113))) (and (cons? (tl (tl (hd V1113)))) (and (= () (tl (tl (tl (hd V1113))))) (and (cons? (tl V1113)) (and (= () (tl (tl V1113))) (and (= - V1114) (shen.prolog_constant? (hd (tl (hd V1113))))))))))))) (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 V1113))))) (cons in (cons (cons if (cons (cons Z (cons is (cons identical (cons shen.to (cons (hd (tl (hd V1113))) ()))))) (cons shen.then (cons (shen.mu_reduction (hd (tl (tl (hd V1113)))) -) (cons shen.else (cons shen.failed! ())))))) ())))))))) ((and (cons? V1113) (and (cons? (hd V1113)) (and (= shen.mu (hd (hd V1113))) (and (cons? (tl (hd V1113))) (and (cons? (tl (tl (hd V1113)))) (and (= () (tl (tl (tl (hd V1113))))) (and (cons? (tl V1113)) (and (= () (tl (tl V1113))) (and (= + V1114) (shen.prolog_constant? (hd (tl (hd V1113))))))))))))) (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 V1113))))) (cons in (cons (cons if (cons (cons Z (cons is (cons identical (cons shen.to (cons (hd (tl (hd V1113))) ()))))) (cons shen.then (cons (shen.mu_reduction (hd (tl (tl (hd V1113)))) +) (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 V1113))) (cons in (cons (shen.mu_reduction (hd (tl (tl (hd V1113)))) +) ())))))) (cons shen.else (cons shen.failed! ())))))) ())))))) ())))))))) ((and (cons? V1113) (and (cons? (hd V1113)) (and (= shen.mu (hd (hd V1113))) (and (cons? (tl (hd V1113))) (and (cons? (hd (tl (hd V1113)))) (and (cons? (tl (tl (hd V1113)))) (and (= () (tl (tl (tl (hd V1113))))) (and (cons? (tl V1113)) (and (= () (tl (tl V1113))) (= - V1114)))))))))) (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 V1113))))) (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 V1113)))) (cons (cons (cons shen.mu (cons (tl (hd (tl (hd V1113)))) (tl (tl (hd V1113))))) (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? V1113) (and (cons? (hd V1113)) (and (= shen.mu (hd (hd V1113))) (and (cons? (tl (hd V1113))) (and (cons? (hd (tl (hd V1113)))) (and (cons? (tl (tl (hd V1113)))) (and (= () (tl (tl (tl (hd V1113))))) (and (cons? (tl V1113)) (and (= () (tl (tl V1113))) (= + V1114)))))))))) (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 V1113))))) (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 V1113)))) (cons (cons (cons shen.mu (cons (tl (hd (tl (hd V1113)))) (tl (tl (hd V1113))))) (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 V1113)))) (cons and (cons shen.then (cons (cons bind (cons Z (cons shen.to (cons (shen.rcons_form (shen.remove_modes (hd (tl (hd V1113))))) (cons in (cons (shen.mu_reduction (hd (tl (tl (hd V1113)))) +) ())))))) ())))))))) (cons shen.else (cons shen.failed! ())))))) ())))))) ())))))))) (true V1113)))
161
-
162
- (defun shen.rcons_form (V1115) (cond ((cons? V1115) (cons cons (cons (shen.rcons_form (hd V1115)) (cons (shen.rcons_form (tl V1115)) ())))) (true V1115)))
163
-
164
- (defun shen.remove_modes (V1116) (cond ((and (cons? V1116) (and (= mode (hd V1116)) (and (cons? (tl V1116)) (and (cons? (tl (tl V1116))) (and (= + (hd (tl (tl V1116)))) (= () (tl (tl (tl V1116))))))))) (shen.remove_modes (hd (tl V1116)))) ((and (cons? V1116) (and (= mode (hd V1116)) (and (cons? (tl V1116)) (and (cons? (tl (tl V1116))) (and (= - (hd (tl (tl V1116)))) (= () (tl (tl (tl V1116))))))))) (shen.remove_modes (hd (tl V1116)))) ((cons? V1116) (cons (shen.remove_modes (hd V1116)) (shen.remove_modes (tl V1116)))) (true V1116)))
165
-
166
- (defun shen.ephemeral_variable? (V1117 V1118) (and (variable? V1117) (variable? V1118)))
167
-
168
- (defun shen.prolog_constant? (V1127) (cond ((cons? V1127) false) (true true)))
169
-
170
- (defun shen.aum_to_shen (V1128) (cond ((and (cons? V1128) (and (= let (hd V1128)) (and (cons? (tl V1128)) (and (cons? (tl (tl V1128))) (and (= shen.be (hd (tl (tl V1128)))) (and (cons? (tl (tl (tl V1128)))) (and (cons? (tl (tl (tl (tl V1128))))) (and (= in (hd (tl (tl (tl (tl V1128)))))) (and (cons? (tl (tl (tl (tl (tl V1128)))))) (= () (tl (tl (tl (tl (tl (tl V1128)))))))))))))))) (cons let (cons (hd (tl V1128)) (cons (shen.aum_to_shen (hd (tl (tl (tl V1128))))) (cons (shen.aum_to_shen (hd (tl (tl (tl (tl (tl V1128))))))) ()))))) ((and (cons? V1128) (and (= shen.the (hd V1128)) (and (cons? (tl V1128)) (and (= shen.result (hd (tl V1128))) (and (cons? (tl (tl V1128))) (and (= shen.of (hd (tl (tl V1128)))) (and (cons? (tl (tl (tl V1128)))) (and (= shen.dereferencing (hd (tl (tl (tl V1128))))) (and (cons? (tl (tl (tl (tl V1128))))) (= () (tl (tl (tl (tl (tl V1128))))))))))))))) (cons shen.lazyderef (cons (shen.aum_to_shen (hd (tl (tl (tl (tl V1128)))))) (cons ProcessN ())))) ((and (cons? V1128) (and (= if (hd V1128)) (and (cons? (tl V1128)) (and (cons? (tl (tl V1128))) (and (= shen.then (hd (tl (tl V1128)))) (and (cons? (tl (tl (tl V1128)))) (and (cons? (tl (tl (tl (tl V1128))))) (and (= shen.else (hd (tl (tl (tl (tl V1128)))))) (and (cons? (tl (tl (tl (tl (tl V1128)))))) (= () (tl (tl (tl (tl (tl (tl V1128)))))))))))))))) (cons if (cons (shen.aum_to_shen (hd (tl V1128))) (cons (shen.aum_to_shen (hd (tl (tl (tl V1128))))) (cons (shen.aum_to_shen (hd (tl (tl (tl (tl (tl V1128))))))) ()))))) ((and (cons? V1128) (and (cons? (tl V1128)) (and (= is (hd (tl V1128))) (and (cons? (tl (tl V1128))) (and (= shen.a (hd (tl (tl V1128)))) (and (cons? (tl (tl (tl V1128)))) (and (= shen.variable (hd (tl (tl (tl V1128))))) (= () (tl (tl (tl (tl V1128)))))))))))) (cons shen.pvar? (cons (hd V1128) ()))) ((and (cons? V1128) (and (cons? (tl V1128)) (and (= is (hd (tl V1128))) (and (cons? (tl (tl V1128))) (and (= shen.a (hd (tl (tl V1128)))) (and (cons? (tl (tl (tl V1128)))) (and (= shen.non-empty (hd (tl (tl (tl V1128))))) (and (cons? (tl (tl (tl (tl V1128))))) (and (= list (hd (tl (tl (tl (tl V1128)))))) (= () (tl (tl (tl (tl (tl V1128))))))))))))))) (cons cons? (cons (hd V1128) ()))) ((and (cons? V1128) (and (= shen.rename (hd V1128)) (and (cons? (tl V1128)) (and (= shen.the (hd (tl V1128))) (and (cons? (tl (tl V1128))) (and (= shen.variables (hd (tl (tl V1128)))) (and (cons? (tl (tl (tl V1128)))) (and (= in (hd (tl (tl (tl V1128))))) (and (cons? (tl (tl (tl (tl V1128))))) (and (= () (hd (tl (tl (tl (tl V1128)))))) (and (cons? (tl (tl (tl (tl (tl V1128)))))) (and (= and (hd (tl (tl (tl (tl (tl V1128))))))) (and (cons? (tl (tl (tl (tl (tl (tl V1128))))))) (and (= shen.then (hd (tl (tl (tl (tl (tl (tl V1128)))))))) (and (cons? (tl (tl (tl (tl (tl (tl (tl V1128)))))))) (= () (tl (tl (tl (tl (tl (tl (tl (tl V1128)))))))))))))))))))))))) (shen.aum_to_shen (hd (tl (tl (tl (tl (tl (tl (tl V1128)))))))))) ((and (cons? V1128) (and (= shen.rename (hd V1128)) (and (cons? (tl V1128)) (and (= shen.the (hd (tl V1128))) (and (cons? (tl (tl V1128))) (and (= shen.variables (hd (tl (tl V1128)))) (and (cons? (tl (tl (tl V1128)))) (and (= in (hd (tl (tl (tl V1128))))) (and (cons? (tl (tl (tl (tl V1128))))) (and (cons? (hd (tl (tl (tl (tl V1128)))))) (and (cons? (tl (tl (tl (tl (tl V1128)))))) (and (= and (hd (tl (tl (tl (tl (tl V1128))))))) (and (cons? (tl (tl (tl (tl (tl (tl V1128))))))) (and (= shen.then (hd (tl (tl (tl (tl (tl (tl V1128)))))))) (and (cons? (tl (tl (tl (tl (tl (tl (tl V1128)))))))) (= () (tl (tl (tl (tl (tl (tl (tl (tl V1128)))))))))))))))))))))))) (cons let (cons (hd (hd (tl (tl (tl (tl V1128)))))) (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 V1128)))))) (tl (tl (tl (tl (tl V1128))))))))))) ()))))) ((and (cons? V1128) (and (= bind (hd V1128)) (and (cons? (tl V1128)) (and (cons? (tl (tl V1128))) (and (= shen.to (hd (tl (tl V1128)))) (and (cons? (tl (tl (tl V1128)))) (and (cons? (tl (tl (tl (tl V1128))))) (and (= in (hd (tl (tl (tl (tl V1128)))))) (and (cons? (tl (tl (tl (tl (tl V1128)))))) (= () (tl (tl (tl (tl (tl (tl V1128)))))))))))))))) (cons do (cons (cons shen.bindv (cons (hd (tl V1128)) (cons (shen.chwild (hd (tl (tl (tl V1128))))) (cons ProcessN ())))) (cons (cons let (cons Result (cons (shen.aum_to_shen (hd (tl (tl (tl (tl (tl V1128))))))) (cons (cons do (cons (cons shen.unbindv (cons (hd (tl V1128)) (cons ProcessN ()))) (cons Result ()))) ())))) ())))) ((and (cons? V1128) (and (cons? (tl V1128)) (and (= is (hd (tl V1128))) (and (cons? (tl (tl V1128))) (and (= identical (hd (tl (tl V1128)))) (and (cons? (tl (tl (tl V1128)))) (and (= shen.to (hd (tl (tl (tl V1128))))) (and (cons? (tl (tl (tl (tl V1128))))) (= () (tl (tl (tl (tl (tl V1128)))))))))))))) (cons = (cons (hd (tl (tl (tl (tl V1128))))) (cons (hd V1128) ())))) ((= shen.failed! V1128) false) ((and (cons? V1128) (and (= shen.the (hd V1128)) (and (cons? (tl V1128)) (and (= head (hd (tl V1128))) (and (cons? (tl (tl V1128))) (and (= shen.of (hd (tl (tl V1128)))) (and (cons? (tl (tl (tl V1128)))) (= () (tl (tl (tl (tl V1128)))))))))))) (cons hd (tl (tl (tl V1128))))) ((and (cons? V1128) (and (= shen.the (hd V1128)) (and (cons? (tl V1128)) (and (= tail (hd (tl V1128))) (and (cons? (tl (tl V1128))) (and (= shen.of (hd (tl (tl V1128)))) (and (cons? (tl (tl (tl V1128)))) (= () (tl (tl (tl (tl V1128)))))))))))) (cons tl (tl (tl (tl V1128))))) ((and (cons? V1128) (and (= shen.pop (hd V1128)) (and (cons? (tl V1128)) (and (= shen.the (hd (tl V1128))) (and (cons? (tl (tl V1128))) (and (= shen.stack (hd (tl (tl V1128)))) (= () (tl (tl (tl V1128)))))))))) (cons do (cons (cons shen.incinfs ()) (cons (cons thaw (cons Continuation ())) ())))) ((and (cons? V1128) (and (= call (hd V1128)) (and (cons? (tl V1128)) (and (= shen.the (hd (tl V1128))) (and (cons? (tl (tl V1128))) (and (= shen.continuation (hd (tl (tl V1128)))) (and (cons? (tl (tl (tl V1128)))) (= () (tl (tl (tl (tl V1128)))))))))))) (cons do (cons (cons shen.incinfs ()) (cons (shen.call_the_continuation (shen.chwild (hd (tl (tl (tl V1128))))) ProcessN Continuation) ())))) (true V1128)))
171
-
172
- (defun shen.chwild (V1129) (cond ((= V1129 _) (cons shen.newpv (cons ProcessN ()))) ((cons? V1129) (map (lambda X932 (shen.chwild X932)) V1129)) (true V1129)))
173
-
174
- (defun shen.newpv (V1130) (let Count+1 (+ (<-address (value shen.*varcounter*) V1130) 1) (let IncVar (address-> (value shen.*varcounter*) V1130 Count+1) (let Vector (<-address (value shen.*prologvectors*) V1130) (let ResizeVectorIfNeeded (if (= Count+1 (limit Vector)) (shen.resizeprocessvector V1130 Count+1) shen.skip) (shen.mk-pvar Count+1))))))
175
-
176
- (defun shen.resizeprocessvector (V1131 V1132) (let Vector (<-address (value shen.*prologvectors*) V1131) (let BigVector (shen.resize-vector Vector (+ V1132 V1132) shen.-null-) (address-> (value shen.*prologvectors*) V1131 BigVector))))
177
-
178
- (defun shen.resize-vector (V1133 V1134 V1135) (let BigVector (address-> (absvector (+ 1 V1134)) 0 V1134) (shen.copy-vector V1133 BigVector (limit V1133) V1134 V1135)))
179
-
180
- (defun shen.copy-vector (V1136 V1137 V1138 V1139 V1140) (shen.copy-vector-stage-2 (+ 1 V1138) (+ V1139 1) V1140 (shen.copy-vector-stage-1 1 V1136 V1137 (+ 1 V1138))))
181
-
182
- (defun shen.copy-vector-stage-1 (V1143 V1144 V1145 V1146) (cond ((= V1146 V1143) V1145) (true (shen.copy-vector-stage-1 (+ 1 V1143) V1144 (address-> V1145 V1143 (<-address V1144 V1143)) V1146))))
183
-
184
- (defun shen.copy-vector-stage-2 (V1150 V1151 V1152 V1153) (cond ((= V1151 V1150) V1153) (true (shen.copy-vector-stage-2 (+ V1150 1) V1151 V1152 (address-> V1153 V1150 V1152)))))
185
-
186
- (defun shen.mk-pvar (V1155) (address-> (address-> (absvector 2) 0 shen.pvar) 1 V1155))
187
-
188
- (defun shen.pvar? (V1156) (trap-error (and (absvector? V1156) (= (<-address V1156 0) shen.pvar)) (lambda E false)))
189
-
190
- (defun shen.bindv (V1157 V1158 V1159) (let Vector (<-address (value shen.*prologvectors*) V1159) (address-> Vector (<-address V1157 1) V1158)))
191
-
192
- (defun shen.unbindv (V1160 V1161) (let Vector (<-address (value shen.*prologvectors*) V1161) (address-> Vector (<-address V1160 1) shen.-null-)))
193
-
194
- (defun shen.incinfs () (set shen.*infs* (+ 1 (value shen.*infs*))))
195
-
196
- (defun shen.call_the_continuation (V1162 V1163 V1164) (cond ((and (cons? V1162) (and (cons? (hd V1162)) (= () (tl V1162)))) (cons (hd (hd V1162)) (append (tl (hd V1162)) (cons V1163 (cons V1164 ()))))) ((and (cons? V1162) (cons? (hd V1162))) (let NewContinuation (shen.newcontinuation (tl V1162) V1163 V1164) (cons (hd (hd V1162)) (append (tl (hd V1162)) (cons V1163 (cons NewContinuation ())))))) (true (shen.sys-error shen.call_the_continuation))))
197
-
198
- (defun shen.newcontinuation (V1165 V1166 V1167) (cond ((= () V1165) V1167) ((and (cons? V1165) (cons? (hd V1165))) (cons freeze (cons (cons (hd (hd V1165)) (append (tl (hd V1165)) (cons V1166 (cons (shen.newcontinuation (tl V1165) V1166 V1167) ())))) ()))) (true (shen.sys-error shen.newcontinuation))))
199
-
200
- (defun return (V1172 V1173 V1174) (shen.deref V1172 V1173))
201
-
202
- (defun shen.measure&return (V1179 V1180 V1181) (do (shen.prhush (shen.app (value shen.*infs*) " inferences
203
- " shen.a) (stoutput)) (shen.deref V1179 V1180)))
204
-
205
- (defun unify (V1182 V1183 V1184 V1185) (shen.lzy= (shen.lazyderef V1182 V1184) (shen.lazyderef V1183 V1184) V1184 V1185))
206
-
207
- (defun shen.lzy= (V1202 V1203 V1204 V1205) (cond ((= V1203 V1202) (thaw V1205)) ((shen.pvar? V1202) (bind V1202 V1203 V1204 V1205)) ((shen.pvar? V1203) (bind V1203 V1202 V1204 V1205)) ((and (cons? V1202) (cons? V1203)) (shen.lzy= (shen.lazyderef (hd V1202) V1204) (shen.lazyderef (hd V1203) V1204) V1204 (freeze (shen.lzy= (shen.lazyderef (tl V1202) V1204) (shen.lazyderef (tl V1203) V1204) V1204 V1205)))) (true false)))
208
-
209
- (defun shen.deref (V1207 V1208) (cond ((cons? V1207) (cons (shen.deref (hd V1207) V1208) (shen.deref (tl V1207) V1208))) (true (if (shen.pvar? V1207) (let Value (shen.valvector V1207 V1208) (if (= Value shen.-null-) V1207 (shen.deref Value V1208))) V1207))))
210
-
211
- (defun shen.lazyderef (V1209 V1210) (if (shen.pvar? V1209) (let Value (shen.valvector V1209 V1210) (if (= Value shen.-null-) V1209 (shen.lazyderef Value V1210))) V1209))
212
-
213
- (defun shen.valvector (V1211 V1212) (<-address (<-address (value shen.*prologvectors*) V1212) (<-address V1211 1)))
214
-
215
- (defun unify! (V1213 V1214 V1215 V1216) (shen.lzy=! (shen.lazyderef V1213 V1215) (shen.lazyderef V1214 V1215) V1215 V1216))
216
-
217
- (defun shen.lzy=! (V1233 V1234 V1235 V1236) (cond ((= V1234 V1233) (thaw V1236)) ((and (shen.pvar? V1233) (not (shen.occurs? V1233 (shen.deref V1234 V1235)))) (bind V1233 V1234 V1235 V1236)) ((and (shen.pvar? V1234) (not (shen.occurs? V1234 (shen.deref V1233 V1235)))) (bind V1234 V1233 V1235 V1236)) ((and (cons? V1233) (cons? V1234)) (shen.lzy=! (shen.lazyderef (hd V1233) V1235) (shen.lazyderef (hd V1234) V1235) V1235 (freeze (shen.lzy=! (shen.lazyderef (tl V1233) V1235) (shen.lazyderef (tl V1234) V1235) V1235 V1236)))) (true false)))
218
-
219
- (defun shen.occurs? (V1246 V1247) (cond ((= V1247 V1246) true) ((cons? V1247) (or (shen.occurs? V1246 (hd V1247)) (shen.occurs? V1246 (tl V1247)))) (true false)))
220
-
221
- (defun identical (V1249 V1250 V1251 V1252) (shen.lzy== (shen.lazyderef V1249 V1251) (shen.lazyderef V1250 V1251) V1251 V1252))
222
-
223
- (defun shen.lzy== (V1269 V1270 V1271 V1272) (cond ((= V1270 V1269) (thaw V1272)) ((and (cons? V1269) (cons? V1270)) (shen.lzy== (shen.lazyderef (hd V1269) V1271) (shen.lazyderef (hd V1270) V1271) V1271 (freeze (shen.lzy== (tl V1269) (tl V1270) V1271 V1272)))) (true false)))
224
-
225
- (defun shen.pvar (V1274) (cn "Var" (shen.app (<-address V1274 1) "" shen.a)))
226
-
227
- (defun bind (V1275 V1276 V1277 V1278) (do (shen.bindv V1275 V1276 V1277) (let Result (thaw V1278) (do (shen.unbindv V1275 V1277) Result))))
228
-
229
- (defun fwhen (V1293 V1294 V1295) (cond ((= true V1293) (thaw V1295)) ((= false V1293) false) (true (simple-error (cn "fwhen expects a boolean: not " (shen.app V1293 "%" shen.s))))))
230
-
231
- (defun call (V1308 V1309 V1310) (cond ((cons? V1308) (shen.call-help (shen.m_prolog_to_s-prolog_predicate (shen.lazyderef (hd V1308) V1309)) (tl V1308) V1309 V1310)) (true false)))
232
-
233
- (defun shen.call-help (V1311 V1312 V1313 V1314) (cond ((= () V1312) (V1311 V1313 V1314)) ((cons? V1312) (shen.call-help (V1311 (hd V1312)) (tl V1312) V1313 V1314)) (true (shen.sys-error shen.call-help))))
234
-
235
- (defun shen.intprolog (V1315) (cond ((and (cons? V1315) (cons? (hd V1315))) (let ProcessN (shen.start-new-prolog-process) (shen.intprolog-help (hd (hd V1315)) (shen.insert-prolog-variables (cons (tl (hd V1315)) (cons (tl V1315) ())) ProcessN) ProcessN))) (true (shen.sys-error shen.intprolog))))
236
-
237
- (defun shen.intprolog-help (V1316 V1317 V1318) (cond ((and (cons? V1317) (and (cons? (tl V1317)) (= () (tl (tl V1317))))) (shen.intprolog-help-help V1316 (hd V1317) (hd (tl V1317)) V1318)) (true (shen.sys-error shen.intprolog-help))))
238
-
239
- (defun shen.intprolog-help-help (V1319 V1320 V1321 V1322) (cond ((= () V1320) (V1319 V1322 (freeze (shen.call-rest V1321 V1322)))) ((cons? V1320) (shen.intprolog-help-help (V1319 (hd V1320)) (tl V1320) V1321 V1322)) (true (shen.sys-error shen.intprolog-help-help))))
240
-
241
- (defun shen.call-rest (V1325 V1326) (cond ((= () V1325) true) ((and (cons? V1325) (and (cons? (hd V1325)) (cons? (tl (hd V1325))))) (shen.call-rest (cons (cons ((hd (hd V1325)) (hd (tl (hd V1325)))) (tl (tl (hd V1325)))) (tl V1325)) V1326)) ((and (cons? V1325) (and (cons? (hd V1325)) (= () (tl (hd V1325))))) ((hd (hd V1325)) V1326 (freeze (shen.call-rest (tl V1325) V1326)))) (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 (V1327 V1328) (shen.insert-prolog-variables-help V1327 (shen.flatten V1327) V1328))
246
-
247
- (defun shen.insert-prolog-variables-help (V1333 V1334 V1335) (cond ((= () V1334) V1333) ((and (cons? V1334) (variable? (hd V1334))) (let V (shen.newpv V1335) (let XV/Y (subst V (hd V1334) V1333) (let Z-Y (remove (hd V1334) (tl V1334)) (shen.insert-prolog-variables-help XV/Y Z-Y V1335))))) ((cons? V1334) (shen.insert-prolog-variables-help V1333 (tl V1334) V1335)) (true (shen.sys-error shen.insert-prolog-variables-help))))
248
-
249
- (defun shen.initialise-prolog (V1336) (let Vector (address-> (value shen.*prologvectors*) V1336 (shen.fillvector (vector 10) 1 10 shen.-null-)) (let Counter (address-> (value shen.*varcounter*) V1336 1) V1336)))
250
-
251
-
252
-