shen-ruby 0.10.0 → 0.11.0

Sign up to get free protection for your applications and to get access to all the features.
Files changed (128) hide show
  1. checksums.yaml +4 -4
  2. data/.rspec +1 -0
  3. data/.travis.yml +9 -3
  4. data/Gemfile +1 -4
  5. data/HISTORY.md +16 -0
  6. data/MIT_LICENSE.txt +1 -1
  7. data/README.md +25 -26
  8. data/Rakefile +3 -11
  9. data/bin/shen_test_suite.rb +15 -3
  10. data/bin/srrepl +6 -8
  11. data/lib/shen_ruby.rb +6 -1
  12. data/lib/shen_ruby/converters.rb +23 -0
  13. data/lib/shen_ruby/version.rb +1 -1
  14. data/shen-ruby.gemspec +4 -1
  15. data/shen/lib/shen_ruby/shen.rb +49 -33
  16. data/shen/release/benchmarks/N_queens.shen +45 -45
  17. data/shen/release/benchmarks/README.shen +14 -14
  18. data/shen/release/benchmarks/benchmarks.shen +52 -52
  19. data/shen/release/benchmarks/einstein.shen +32 -32
  20. data/shen/release/benchmarks/interpreter.shen +219 -219
  21. data/shen/release/benchmarks/jnk.shen +193 -193
  22. data/shen/release/benchmarks/powerset.shen +10 -10
  23. data/shen/release/benchmarks/prime.shen +10 -10
  24. data/shen/release/benchmarks/short.shen +129 -129
  25. data/shen/release/k_lambda/core.kl +181 -181
  26. data/shen/release/k_lambda/declarations.kl +131 -131
  27. data/shen/release/k_lambda/load.kl +84 -84
  28. data/shen/release/k_lambda/macros.kl +112 -112
  29. data/shen/release/k_lambda/prolog.kl +252 -252
  30. data/shen/release/k_lambda/reader.kl +222 -222
  31. data/shen/release/k_lambda/sequent.kl +166 -166
  32. data/shen/release/k_lambda/sys.kl +271 -271
  33. data/shen/release/k_lambda/t-star.kl +139 -139
  34. data/shen/release/k_lambda/toplevel.kl +135 -135
  35. data/shen/release/k_lambda/track.kl +103 -103
  36. data/shen/release/k_lambda/types.kl +324 -324
  37. data/shen/release/k_lambda/writer.kl +105 -105
  38. data/shen/release/k_lambda/yacc.kl +113 -113
  39. data/shen/release/test_programs/Chap13/problems.txt +26 -26
  40. data/shen/release/test_programs/README.shen +52 -52
  41. data/shen/release/test_programs/TinyLispFunctions.txt +15 -15
  42. data/shen/release/test_programs/TinyTypes.shen +55 -55
  43. data/shen/release/test_programs/binary.shen +24 -24
  44. data/shen/release/test_programs/bubble_version_1.shen +28 -28
  45. data/shen/release/test_programs/bubble_version_2.shen +22 -22
  46. data/shen/release/test_programs/calculator.shen +21 -21
  47. data/shen/release/test_programs/cartprod.shen +23 -23
  48. data/shen/release/test_programs/change.shen +25 -25
  49. data/shen/release/test_programs/classes-defaults.shen +94 -94
  50. data/shen/release/test_programs/classes-inheritance.shen +100 -100
  51. data/shen/release/test_programs/classes-typed.shen +74 -74
  52. data/shen/release/test_programs/classes-untyped.shen +46 -46
  53. data/shen/release/test_programs/depth_.shen +14 -14
  54. data/shen/release/test_programs/einstein.shen +34 -34
  55. data/shen/release/test_programs/fruit_machine.shen +46 -46
  56. data/shen/release/test_programs/interpreter.shen +217 -217
  57. data/shen/release/test_programs/metaprog.shen +85 -85
  58. data/shen/release/test_programs/minim.shen +192 -192
  59. data/shen/release/test_programs/mutual.shen +11 -11
  60. data/shen/release/test_programs/n_queens.shen +45 -45
  61. data/shen/release/test_programs/newton_version_1.shen +33 -33
  62. data/shen/release/test_programs/newton_version_2.shen +24 -24
  63. data/shen/release/test_programs/parse.prl +14 -14
  64. data/shen/release/test_programs/parser.shen +51 -51
  65. data/shen/release/test_programs/powerset.shen +10 -10
  66. data/shen/release/test_programs/prime.shen +10 -10
  67. data/shen/release/test_programs/prolog.shen +78 -78
  68. data/shen/release/test_programs/proof_assistant.shen +80 -80
  69. data/shen/release/test_programs/proplog_version_1.shen +25 -25
  70. data/shen/release/test_programs/proplog_version_2.shen +27 -27
  71. data/shen/release/test_programs/qmachine.shen +66 -66
  72. data/shen/release/test_programs/red-black.shen +54 -54
  73. data/shen/release/test_programs/search.shen +55 -55
  74. data/shen/release/test_programs/semantic_net.shen +44 -44
  75. data/shen/release/test_programs/spreadsheet.shen +34 -34
  76. data/shen/release/test_programs/stack.shen +27 -27
  77. data/shen/release/test_programs/streams.shen +20 -20
  78. data/shen/release/test_programs/strings.shen +57 -57
  79. data/shen/release/test_programs/structures-typed.shen +71 -71
  80. data/shen/release/test_programs/structures-untyped.shen +41 -41
  81. data/shen/release/test_programs/tests.shen +232 -232
  82. data/shen/release/test_programs/types.shen +11 -11
  83. data/shen/release/test_programs/whist.shen +239 -239
  84. data/shen/release/test_programs/yacc.shen +132 -132
  85. data/spec/shen_ruby/converters_spec.rb +48 -0
  86. data/spec/spec_helper.rb +1 -2
  87. metadata +55 -60
  88. data/k_lambda_spec/atom_spec.rb +0 -85
  89. data/k_lambda_spec/primitives/arithmetic_spec.rb +0 -175
  90. data/k_lambda_spec/primitives/assignments_spec.rb +0 -44
  91. data/k_lambda_spec/primitives/boolean_operations_spec.rb +0 -136
  92. data/k_lambda_spec/primitives/generic_functions_spec.rb +0 -120
  93. data/k_lambda_spec/primitives/lists_spec.rb +0 -40
  94. data/k_lambda_spec/primitives/strings_spec.rb +0 -77
  95. data/k_lambda_spec/primitives/symbols_spec.rb +0 -24
  96. data/k_lambda_spec/primitives/vectors_spec.rb +0 -92
  97. data/k_lambda_spec/spec_helper.rb +0 -29
  98. data/k_lambda_spec/support/shared_examples.rb +0 -124
  99. data/k_lambda_spec/tail_recursion_spec.rb +0 -30
  100. data/lib/kl.rb +0 -7
  101. data/lib/kl/absvector.rb +0 -12
  102. data/lib/kl/compiler.rb +0 -360
  103. data/lib/kl/cons.rb +0 -51
  104. data/lib/kl/empty_list.rb +0 -12
  105. data/lib/kl/environment.rb +0 -163
  106. data/lib/kl/error.rb +0 -4
  107. data/lib/kl/internal_error.rb +0 -7
  108. data/lib/kl/lexer.rb +0 -186
  109. data/lib/kl/primitives/arithmetic.rb +0 -60
  110. data/lib/kl/primitives/assignments.rb +0 -15
  111. data/lib/kl/primitives/booleans.rb +0 -21
  112. data/lib/kl/primitives/error_handling.rb +0 -13
  113. data/lib/kl/primitives/extensions.rb +0 -12
  114. data/lib/kl/primitives/generic_functions.rb +0 -29
  115. data/lib/kl/primitives/lists.rb +0 -23
  116. data/lib/kl/primitives/streams.rb +0 -28
  117. data/lib/kl/primitives/strings.rb +0 -63
  118. data/lib/kl/primitives/symbols.rb +0 -18
  119. data/lib/kl/primitives/time.rb +0 -17
  120. data/lib/kl/primitives/vectors.rb +0 -36
  121. data/lib/kl/reader.rb +0 -46
  122. data/spec/kl/cons_spec.rb +0 -12
  123. data/spec/kl/environment_spec.rb +0 -282
  124. data/spec/kl/interop_spec.rb +0 -68
  125. data/spec/kl/lexer_spec.rb +0 -149
  126. data/spec/kl/primitives/generic_functions_spec.rb +0 -29
  127. data/spec/kl/primitives/symbols_spec.rb +0 -21
  128. data/spec/kl/reader_spec.rb +0 -42
@@ -1,105 +1,105 @@
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 pr (V2294 V2295) (trap-error (shen.prh V2294 V2295 0) (lambda E V2294)))
51
-
52
- (defun shen.prh (V2296 V2297 V2298) (shen.prh V2296 V2297 (shen.write-char-and-inc V2296 V2297 V2298)))
53
-
54
- (defun shen.write-char-and-inc (V2299 V2300 V2301) (do (write-byte (string->n (pos V2299 V2301)) V2300) (+ V2301 1)))
55
-
56
- (defun print (V2302) (let String (shen.insert V2302 "~S") (let Print (shen.prhush String (stoutput)) V2302)))
57
-
58
- (defun shen.prhush (V2303 V2304) (if (value *hush*) V2303 (pr V2303 V2304)))
59
-
60
- (defun shen.mkstr (V2305 V2306) (cond ((string? V2305) (shen.mkstr-l (shen.proc-nl V2305) V2306)) (true (shen.mkstr-r (cons shen.proc-nl (cons V2305 ())) V2306))))
61
-
62
- (defun shen.mkstr-l (V2307 V2308) (cond ((= () V2308) V2307) ((cons? V2308) (shen.mkstr-l (shen.insert-l (hd V2308) V2307) (tl V2308))) (true (shen.sys-error shen.mkstr-l))))
63
-
64
- (defun shen.insert-l (V2311 V2312) (cond ((= "" V2312) "") ((and (shen.+string? V2312) (and (= "~" (pos V2312 0)) (and (shen.+string? (tlstr V2312)) (= "A" (pos (tlstr V2312) 0))))) (cons shen.app (cons V2311 (cons (tlstr (tlstr V2312)) (cons shen.a ()))))) ((and (shen.+string? V2312) (and (= "~" (pos V2312 0)) (and (shen.+string? (tlstr V2312)) (= "R" (pos (tlstr V2312) 0))))) (cons shen.app (cons V2311 (cons (tlstr (tlstr V2312)) (cons shen.r ()))))) ((and (shen.+string? V2312) (and (= "~" (pos V2312 0)) (and (shen.+string? (tlstr V2312)) (= "S" (pos (tlstr V2312) 0))))) (cons shen.app (cons V2311 (cons (tlstr (tlstr V2312)) (cons shen.s ()))))) ((shen.+string? V2312) (shen.factor-cn (cons cn (cons (pos V2312 0) (cons (shen.insert-l V2311 (tlstr V2312)) ()))))) ((and (cons? V2312) (and (= cn (hd V2312)) (and (cons? (tl V2312)) (and (cons? (tl (tl V2312))) (= () (tl (tl (tl V2312)))))))) (cons cn (cons (hd (tl V2312)) (cons (shen.insert-l V2311 (hd (tl (tl V2312)))) ())))) ((and (cons? V2312) (and (= shen.app (hd V2312)) (and (cons? (tl V2312)) (and (cons? (tl (tl V2312))) (and (cons? (tl (tl (tl V2312)))) (= () (tl (tl (tl (tl V2312)))))))))) (cons shen.app (cons (hd (tl V2312)) (cons (shen.insert-l V2311 (hd (tl (tl V2312)))) (tl (tl (tl V2312))))))) (true (shen.sys-error shen.insert-l))))
65
-
66
- (defun shen.factor-cn (V2313) (cond ((and (cons? V2313) (and (= cn (hd V2313)) (and (cons? (tl V2313)) (and (cons? (tl (tl V2313))) (and (cons? (hd (tl (tl V2313)))) (and (= cn (hd (hd (tl (tl V2313))))) (and (cons? (tl (hd (tl (tl V2313))))) (and (cons? (tl (tl (hd (tl (tl V2313)))))) (and (= () (tl (tl (tl (hd (tl (tl V2313))))))) (and (= () (tl (tl (tl V2313)))) (and (string? (hd (tl V2313))) (string? (hd (tl (hd (tl (tl V2313))))))))))))))))) (cons cn (cons (cn (hd (tl V2313)) (hd (tl (hd (tl (tl V2313)))))) (tl (tl (hd (tl (tl V2313)))))))) (true V2313)))
67
-
68
- (defun shen.proc-nl (V2314) (cond ((= "" V2314) "") ((and (shen.+string? V2314) (and (= "~" (pos V2314 0)) (and (shen.+string? (tlstr V2314)) (= "%" (pos (tlstr V2314) 0))))) (cn (n->string 10) (shen.proc-nl (tlstr (tlstr V2314))))) ((shen.+string? V2314) (cn (pos V2314 0) (shen.proc-nl (tlstr V2314)))) (true (shen.sys-error shen.proc-nl))))
69
-
70
- (defun shen.mkstr-r (V2315 V2316) (cond ((= () V2316) V2315) ((cons? V2316) (shen.mkstr-r (cons shen.insert (cons (hd V2316) (cons V2315 ()))) (tl V2316))) (true (shen.sys-error shen.mkstr-r))))
71
-
72
- (defun shen.insert (V2317 V2318) (shen.insert-h V2317 V2318 ""))
73
-
74
- (defun shen.insert-h (V2321 V2322 V2323) (cond ((= "" V2322) V2323) ((and (shen.+string? V2322) (and (= "~" (pos V2322 0)) (and (shen.+string? (tlstr V2322)) (= "A" (pos (tlstr V2322) 0))))) (cn V2323 (shen.app V2321 (tlstr (tlstr V2322)) shen.a))) ((and (shen.+string? V2322) (and (= "~" (pos V2322 0)) (and (shen.+string? (tlstr V2322)) (= "R" (pos (tlstr V2322) 0))))) (cn V2323 (shen.app V2321 (tlstr (tlstr V2322)) shen.r))) ((and (shen.+string? V2322) (and (= "~" (pos V2322 0)) (and (shen.+string? (tlstr V2322)) (= "S" (pos (tlstr V2322) 0))))) (cn V2323 (shen.app V2321 (tlstr (tlstr V2322)) shen.s))) ((shen.+string? V2322) (shen.insert-h V2321 (tlstr V2322) (cn V2323 (pos V2322 0)))) (true (shen.sys-error shen.insert-h))))
75
-
76
- (defun shen.app (V2324 V2325 V2326) (cn (shen.arg->str V2324 V2326) V2325))
77
-
78
- (defun shen.arg->str (V2332 V2333) (cond ((= V2332 (fail)) "...") ((shen.list? V2332) (shen.list->str V2332 V2333)) ((string? V2332) (shen.str->str V2332 V2333)) ((absvector? V2332) (shen.vector->str V2332 V2333)) (true (shen.atom->str V2332))))
79
-
80
- (defun shen.list->str (V2334 V2335) (cond ((= shen.r V2335) (@s "(" (@s (shen.iter-list V2334 shen.r (shen.maxseq)) ")"))) (true (@s "[" (@s (shen.iter-list V2334 V2335 (shen.maxseq)) "]")))))
81
-
82
- (defun shen.maxseq () (value *maximum-print-sequence-size*))
83
-
84
- (defun shen.iter-list (V2346 V2347 V2348) (cond ((= () V2346) "") ((= 0 V2348) "... etc") ((and (cons? V2346) (= () (tl V2346))) (shen.arg->str (hd V2346) V2347)) ((cons? V2346) (@s (shen.arg->str (hd V2346) V2347) (@s " " (shen.iter-list (tl V2346) V2347 (- V2348 1))))) (true (@s "|" (@s " " (shen.arg->str V2346 V2347))))))
85
-
86
- (defun shen.str->str (V2353 V2354) (cond ((= shen.a V2354) V2353) (true (@s (n->string 34) (@s V2353 (n->string 34))))))
87
-
88
- (defun shen.vector->str (V2355 V2356) (if (shen.print-vector? V2355) ((<-address V2355 0) V2355) (if (vector? V2355) (@s "<" (@s (shen.iter-vector V2355 1 V2356 (shen.maxseq)) ">")) (@s "<" (@s "<" (@s (shen.iter-vector V2355 0 V2356 (shen.maxseq)) ">>"))))))
89
-
90
- (defun shen.print-vector? (V2357) (let Zero (<-address V2357 0) (if (= Zero shen.tuple) true (if (= Zero shen.pvar) true (if (not (number? Zero)) (shen.fbound? Zero) false)))))
91
-
92
- (defun shen.fbound? (V2358) (trap-error (do (ps V2358) true) (lambda E false)))
93
-
94
- (defun shen.tuple (V2359) (cn "(@p " (shen.app (<-address V2359 1) (cn " " (shen.app (<-address V2359 2) ")" shen.s)) shen.s)))
95
-
96
- (defun shen.iter-vector (V2366 V2367 V2368 V2369) (cond ((= 0 V2369) "... etc") (true (let Item (trap-error (<-address V2366 V2367) (lambda E shen.out-of-bounds)) (let Next (trap-error (<-address V2366 (+ V2367 1)) (lambda E shen.out-of-bounds)) (if (= Item shen.out-of-bounds) "" (if (= Next shen.out-of-bounds) (shen.arg->str Item V2368) (@s (shen.arg->str Item V2368) (@s " " (shen.iter-vector V2366 (+ V2367 1) V2368 (- V2369 1)))))))))))
97
-
98
- (defun shen.atom->str (V2370) (trap-error (str V2370) (lambda E (shen.funexstring))))
99
-
100
- (defun shen.funexstring () (@s "" (@s "f" (@s "u" (@s "n" (@s "e" (@s (shen.arg->str (gensym (intern "x")) shen.a) "")))))))
101
-
102
- (defun shen.list? (V2371) (or (empty? V2371) (cons? V2371)))
103
-
104
-
105
-
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 pr (V2294 V2295) (trap-error (shen.prh V2294 V2295 0) (lambda E V2294)))
51
+
52
+ (defun shen.prh (V2296 V2297 V2298) (shen.prh V2296 V2297 (shen.write-char-and-inc V2296 V2297 V2298)))
53
+
54
+ (defun shen.write-char-and-inc (V2299 V2300 V2301) (do (write-byte (string->n (pos V2299 V2301)) V2300) (+ V2301 1)))
55
+
56
+ (defun print (V2302) (let String (shen.insert V2302 "~S") (let Print (shen.prhush String (stoutput)) V2302)))
57
+
58
+ (defun shen.prhush (V2303 V2304) (if (value *hush*) V2303 (pr V2303 V2304)))
59
+
60
+ (defun shen.mkstr (V2305 V2306) (cond ((string? V2305) (shen.mkstr-l (shen.proc-nl V2305) V2306)) (true (shen.mkstr-r (cons shen.proc-nl (cons V2305 ())) V2306))))
61
+
62
+ (defun shen.mkstr-l (V2307 V2308) (cond ((= () V2308) V2307) ((cons? V2308) (shen.mkstr-l (shen.insert-l (hd V2308) V2307) (tl V2308))) (true (shen.sys-error shen.mkstr-l))))
63
+
64
+ (defun shen.insert-l (V2311 V2312) (cond ((= "" V2312) "") ((and (shen.+string? V2312) (and (= "~" (pos V2312 0)) (and (shen.+string? (tlstr V2312)) (= "A" (pos (tlstr V2312) 0))))) (cons shen.app (cons V2311 (cons (tlstr (tlstr V2312)) (cons shen.a ()))))) ((and (shen.+string? V2312) (and (= "~" (pos V2312 0)) (and (shen.+string? (tlstr V2312)) (= "R" (pos (tlstr V2312) 0))))) (cons shen.app (cons V2311 (cons (tlstr (tlstr V2312)) (cons shen.r ()))))) ((and (shen.+string? V2312) (and (= "~" (pos V2312 0)) (and (shen.+string? (tlstr V2312)) (= "S" (pos (tlstr V2312) 0))))) (cons shen.app (cons V2311 (cons (tlstr (tlstr V2312)) (cons shen.s ()))))) ((shen.+string? V2312) (shen.factor-cn (cons cn (cons (pos V2312 0) (cons (shen.insert-l V2311 (tlstr V2312)) ()))))) ((and (cons? V2312) (and (= cn (hd V2312)) (and (cons? (tl V2312)) (and (cons? (tl (tl V2312))) (= () (tl (tl (tl V2312)))))))) (cons cn (cons (hd (tl V2312)) (cons (shen.insert-l V2311 (hd (tl (tl V2312)))) ())))) ((and (cons? V2312) (and (= shen.app (hd V2312)) (and (cons? (tl V2312)) (and (cons? (tl (tl V2312))) (and (cons? (tl (tl (tl V2312)))) (= () (tl (tl (tl (tl V2312)))))))))) (cons shen.app (cons (hd (tl V2312)) (cons (shen.insert-l V2311 (hd (tl (tl V2312)))) (tl (tl (tl V2312))))))) (true (shen.sys-error shen.insert-l))))
65
+
66
+ (defun shen.factor-cn (V2313) (cond ((and (cons? V2313) (and (= cn (hd V2313)) (and (cons? (tl V2313)) (and (cons? (tl (tl V2313))) (and (cons? (hd (tl (tl V2313)))) (and (= cn (hd (hd (tl (tl V2313))))) (and (cons? (tl (hd (tl (tl V2313))))) (and (cons? (tl (tl (hd (tl (tl V2313)))))) (and (= () (tl (tl (tl (hd (tl (tl V2313))))))) (and (= () (tl (tl (tl V2313)))) (and (string? (hd (tl V2313))) (string? (hd (tl (hd (tl (tl V2313))))))))))))))))) (cons cn (cons (cn (hd (tl V2313)) (hd (tl (hd (tl (tl V2313)))))) (tl (tl (hd (tl (tl V2313)))))))) (true V2313)))
67
+
68
+ (defun shen.proc-nl (V2314) (cond ((= "" V2314) "") ((and (shen.+string? V2314) (and (= "~" (pos V2314 0)) (and (shen.+string? (tlstr V2314)) (= "%" (pos (tlstr V2314) 0))))) (cn (n->string 10) (shen.proc-nl (tlstr (tlstr V2314))))) ((shen.+string? V2314) (cn (pos V2314 0) (shen.proc-nl (tlstr V2314)))) (true (shen.sys-error shen.proc-nl))))
69
+
70
+ (defun shen.mkstr-r (V2315 V2316) (cond ((= () V2316) V2315) ((cons? V2316) (shen.mkstr-r (cons shen.insert (cons (hd V2316) (cons V2315 ()))) (tl V2316))) (true (shen.sys-error shen.mkstr-r))))
71
+
72
+ (defun shen.insert (V2317 V2318) (shen.insert-h V2317 V2318 ""))
73
+
74
+ (defun shen.insert-h (V2321 V2322 V2323) (cond ((= "" V2322) V2323) ((and (shen.+string? V2322) (and (= "~" (pos V2322 0)) (and (shen.+string? (tlstr V2322)) (= "A" (pos (tlstr V2322) 0))))) (cn V2323 (shen.app V2321 (tlstr (tlstr V2322)) shen.a))) ((and (shen.+string? V2322) (and (= "~" (pos V2322 0)) (and (shen.+string? (tlstr V2322)) (= "R" (pos (tlstr V2322) 0))))) (cn V2323 (shen.app V2321 (tlstr (tlstr V2322)) shen.r))) ((and (shen.+string? V2322) (and (= "~" (pos V2322 0)) (and (shen.+string? (tlstr V2322)) (= "S" (pos (tlstr V2322) 0))))) (cn V2323 (shen.app V2321 (tlstr (tlstr V2322)) shen.s))) ((shen.+string? V2322) (shen.insert-h V2321 (tlstr V2322) (cn V2323 (pos V2322 0)))) (true (shen.sys-error shen.insert-h))))
75
+
76
+ (defun shen.app (V2324 V2325 V2326) (cn (shen.arg->str V2324 V2326) V2325))
77
+
78
+ (defun shen.arg->str (V2332 V2333) (cond ((= V2332 (fail)) "...") ((shen.list? V2332) (shen.list->str V2332 V2333)) ((string? V2332) (shen.str->str V2332 V2333)) ((absvector? V2332) (shen.vector->str V2332 V2333)) (true (shen.atom->str V2332))))
79
+
80
+ (defun shen.list->str (V2334 V2335) (cond ((= shen.r V2335) (@s "(" (@s (shen.iter-list V2334 shen.r (shen.maxseq)) ")"))) (true (@s "[" (@s (shen.iter-list V2334 V2335 (shen.maxseq)) "]")))))
81
+
82
+ (defun shen.maxseq () (value *maximum-print-sequence-size*))
83
+
84
+ (defun shen.iter-list (V2346 V2347 V2348) (cond ((= () V2346) "") ((= 0 V2348) "... etc") ((and (cons? V2346) (= () (tl V2346))) (shen.arg->str (hd V2346) V2347)) ((cons? V2346) (@s (shen.arg->str (hd V2346) V2347) (@s " " (shen.iter-list (tl V2346) V2347 (- V2348 1))))) (true (@s "|" (@s " " (shen.arg->str V2346 V2347))))))
85
+
86
+ (defun shen.str->str (V2353 V2354) (cond ((= shen.a V2354) V2353) (true (@s (n->string 34) (@s V2353 (n->string 34))))))
87
+
88
+ (defun shen.vector->str (V2355 V2356) (if (shen.print-vector? V2355) ((<-address V2355 0) V2355) (if (vector? V2355) (@s "<" (@s (shen.iter-vector V2355 1 V2356 (shen.maxseq)) ">")) (@s "<" (@s "<" (@s (shen.iter-vector V2355 0 V2356 (shen.maxseq)) ">>"))))))
89
+
90
+ (defun shen.print-vector? (V2357) (let Zero (<-address V2357 0) (if (= Zero shen.tuple) true (if (= Zero shen.pvar) true (if (not (number? Zero)) (shen.fbound? Zero) false)))))
91
+
92
+ (defun shen.fbound? (V2358) (trap-error (do (ps V2358) true) (lambda E false)))
93
+
94
+ (defun shen.tuple (V2359) (cn "(@p " (shen.app (<-address V2359 1) (cn " " (shen.app (<-address V2359 2) ")" shen.s)) shen.s)))
95
+
96
+ (defun shen.iter-vector (V2366 V2367 V2368 V2369) (cond ((= 0 V2369) "... etc") (true (let Item (trap-error (<-address V2366 V2367) (lambda E shen.out-of-bounds)) (let Next (trap-error (<-address V2366 (+ V2367 1)) (lambda E shen.out-of-bounds)) (if (= Item shen.out-of-bounds) "" (if (= Next shen.out-of-bounds) (shen.arg->str Item V2368) (@s (shen.arg->str Item V2368) (@s " " (shen.iter-vector V2366 (+ V2367 1) V2368 (- V2369 1)))))))))))
97
+
98
+ (defun shen.atom->str (V2370) (trap-error (str V2370) (lambda E (shen.funexstring))))
99
+
100
+ (defun shen.funexstring () (@s "" (@s "f" (@s "u" (@s "n" (@s "e" (@s (shen.arg->str (gensym (intern "x")) shen.a) "")))))))
101
+
102
+ (defun shen.list? (V2371) (or (empty? V2371) (cons? V2371)))
103
+
104
+
105
+
@@ -1,113 +1,113 @@
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.yacc (V2187) (cond ((and (cons? V2187) (and (= defcc (hd V2187)) (and (cons? (tl V2187)) (and (cons? (tl (tl V2187))) (and (= { (hd (tl (tl V2187)))) (and (cons? (tl (tl (tl V2187)))) (and (cons? (tl (tl (tl (tl V2187))))) (and (= ==> (hd (tl (tl (tl (tl V2187)))))) (and (cons? (tl (tl (tl (tl (tl V2187)))))) (and (cons? (tl (tl (tl (tl (tl (tl V2187))))))) (= } (hd (tl (tl (tl (tl (tl (tl V2187)))))))))))))))))) (shen.yacc (cons defcc (cons (hd (tl V2187)) (tl (tl (tl (tl (tl (tl (tl V2187))))))))))) ((and (cons? V2187) (and (= defcc (hd V2187)) (cons? (tl V2187)))) (shen.yacc->shen (hd (tl V2187)) (tl (tl V2187)))) (true (shen.sys-error shen.yacc))))
51
-
52
- (defun shen.yacc->shen (V2188 V2189) (let CCRules (shen.split_cc_rules true V2189 ()) (let CCBody (map (lambda X2185 (shen.cc_body X2185)) CCRules) (let YaccCases (shen.yacc_cases CCBody) (cons define (cons V2188 (cons Stream (cons -> (cons (shen.kill-code YaccCases) ())))))))))
53
-
54
- (defun shen.kill-code (V2190) (cond ((> (occurrences kill V2190) 0) (cons trap-error (cons V2190 (cons (cons lambda (cons E (cons (cons shen.analyse-kill (cons E ())) ()))) ())))) (true V2190)))
55
-
56
- (defun kill () (simple-error "yacc kill"))
57
-
58
- (defun shen.analyse-kill (V2191) (let String (error-to-string V2191) (if (= String "yacc kill") (fail) V2191)))
59
-
60
- (defun shen.split_cc_rules (V2194 V2195 V2196) (cond ((and (= () V2195) (= () V2196)) ()) ((= () V2195) (cons (shen.split_cc_rule V2194 (reverse V2196) ()) ())) ((and (cons? V2195) (= ; (hd V2195))) (cons (shen.split_cc_rule V2194 (reverse V2196) ()) (shen.split_cc_rules V2194 (tl V2195) ()))) ((cons? V2195) (shen.split_cc_rules V2194 (tl V2195) (cons (hd V2195) V2196))) (true (shen.sys-error shen.split_cc_rules))))
61
-
62
- (defun shen.split_cc_rule (V2201 V2202 V2203) (cond ((and (cons? V2202) (and (= := (hd V2202)) (and (cons? (tl V2202)) (= () (tl (tl V2202)))))) (cons (reverse V2203) (tl V2202))) ((and (cons? V2202) (and (= := (hd V2202)) (and (cons? (tl V2202)) (and (cons? (tl (tl V2202))) (and (= where (hd (tl (tl V2202)))) (and (cons? (tl (tl (tl V2202)))) (= () (tl (tl (tl (tl V2202))))))))))) (cons (reverse V2203) (cons (cons where (cons (hd (tl (tl (tl V2202)))) (cons (hd (tl V2202)) ()))) ()))) ((= () V2202) (do (shen.semantic-completion-warning V2201 V2203) (shen.split_cc_rule V2201 (cons := (cons (shen.default_semantics (reverse V2203)) ())) V2203))) ((cons? V2202) (shen.split_cc_rule V2201 (tl V2202) (cons (hd V2202) V2203))) (true (shen.sys-error shen.split_cc_rule))))
63
-
64
- (defun shen.semantic-completion-warning (V2212 V2213) (cond ((= true V2212) (do (shen.prhush "warning: " (stoutput)) (do (map (lambda X (shen.prhush (shen.app X " " shen.a) (stoutput))) (reverse V2213)) (shen.prhush "has no semantics.
65
- " (stoutput))))) (true shen.skip)))
66
-
67
- (defun shen.default_semantics (V2214) (cond ((= () V2214) ()) ((and (cons? V2214) (and (= () (tl V2214)) (shen.grammar_symbol? (hd V2214)))) (hd V2214)) ((and (cons? V2214) (shen.grammar_symbol? (hd V2214))) (cons append (cons (hd V2214) (cons (shen.default_semantics (tl V2214)) ())))) ((cons? V2214) (cons cons (cons (hd V2214) (cons (shen.default_semantics (tl V2214)) ())))) (true (shen.sys-error shen.default_semantics))))
68
-
69
- (defun shen.grammar_symbol? (V2215) (and (symbol? V2215) (let Cs (shen.strip-pathname (explode V2215)) (and (= (hd Cs) "<") (= (hd (reverse Cs)) ">")))))
70
-
71
- (defun shen.yacc_cases (V2216) (cond ((and (cons? V2216) (= () (tl V2216))) (hd V2216)) ((cons? V2216) (let P YaccParse (cons let (cons P (cons (hd V2216) (cons (cons if (cons (cons = (cons P (cons (cons fail ()) ()))) (cons (shen.yacc_cases (tl V2216)) (cons P ())))) ())))))) (true (shen.sys-error shen.yacc_cases))))
72
-
73
- (defun shen.cc_body (V2217) (cond ((and (cons? V2217) (and (cons? (tl V2217)) (= () (tl (tl V2217))))) (shen.syntax (hd V2217) Stream (hd (tl V2217)))) (true (shen.sys-error shen.cc_body))))
74
-
75
- (defun shen.syntax (V2218 V2219 V2220) (cond ((and (= () V2218) (and (cons? V2220) (and (= where (hd V2220)) (and (cons? (tl V2220)) (and (cons? (tl (tl V2220))) (= () (tl (tl (tl V2220))))))))) (cons if (cons (shen.semantics (hd (tl V2220))) (cons (cons shen.pair (cons (cons hd (cons V2219 ())) (cons (shen.semantics (hd (tl (tl V2220)))) ()))) (cons (cons fail ()) ()))))) ((= () V2218) (cons shen.pair (cons (cons hd (cons V2219 ())) (cons (shen.semantics V2220) ())))) ((cons? V2218) (if (shen.grammar_symbol? (hd V2218)) (shen.recursive_descent V2218 V2219 V2220) (if (variable? (hd V2218)) (shen.variable-match V2218 V2219 V2220) (if (shen.jump_stream? (hd V2218)) (shen.jump_stream V2218 V2219 V2220) (if (shen.terminal? (hd V2218)) (shen.check_stream V2218 V2219 V2220) (if (cons? (hd V2218)) (shen.list-stream (shen.decons (hd V2218)) (tl V2218) V2219 V2220) (simple-error (shen.app (hd V2218) " is not legal syntax
76
- " shen.a)))))))) (true (shen.sys-error shen.syntax))))
77
-
78
- (defun shen.list-stream (V2221 V2222 V2223 V2224) (let Test (cons and (cons (cons cons? (cons (cons hd (cons V2223 ())) ())) (cons (cons cons? (cons (cons hd (cons (cons hd (cons V2223 ())) ())) ())) ()))) (let Placeholder (gensym shen.place) (let RunOn (shen.syntax V2222 (cons shen.pair (cons (cons tl (cons (cons hd (cons V2223 ())) ())) (cons (cons hd (cons (cons tl (cons V2223 ())) ())) ()))) V2224) (let Action (shen.insert-runon RunOn Placeholder (shen.syntax V2221 (cons shen.pair (cons (cons hd (cons (cons hd (cons V2223 ())) ())) (cons (cons hd (cons (cons tl (cons V2223 ())) ())) ()))) Placeholder)) (cons if (cons Test (cons Action (cons (cons fail ()) ())))))))))
79
-
80
- (defun shen.decons (V2225) (cond ((and (cons? V2225) (and (= cons (hd V2225)) (and (cons? (tl V2225)) (and (cons? (tl (tl V2225))) (and (= () (hd (tl (tl V2225)))) (= () (tl (tl (tl V2225))))))))) (cons (hd (tl V2225)) ())) ((and (cons? V2225) (and (= cons (hd V2225)) (and (cons? (tl V2225)) (and (cons? (tl (tl V2225))) (= () (tl (tl (tl V2225)))))))) (cons (hd (tl V2225)) (shen.decons (hd (tl (tl V2225)))))) (true V2225)))
81
-
82
- (defun shen.insert-runon (V2236 V2237 V2238) (cond ((and (cons? V2238) (and (= shen.pair (hd V2238)) (and (cons? (tl V2238)) (and (cons? (tl (tl V2238))) (and (= () (tl (tl (tl V2238)))) (= (hd (tl (tl V2238))) V2237)))))) V2236) ((cons? V2238) (map (lambda Z (shen.insert-runon V2236 V2237 Z)) V2238)) (true V2238)))
83
-
84
- (defun shen.strip-pathname (V2244) (cond ((not (element? "." V2244)) V2244) ((cons? V2244) (shen.strip-pathname (tl V2244))) (true (shen.sys-error shen.strip-pathname))))
85
-
86
- (defun shen.recursive_descent (V2245 V2246 V2247) (cond ((cons? V2245) (let Test (cons (hd V2245) (cons V2246 ())) (let Action (shen.syntax (tl V2245) (concat Parse_ (hd V2245)) V2247) (let Else (cons fail ()) (cons let (cons (concat Parse_ (hd V2245)) (cons Test (cons (cons if (cons (cons not (cons (cons = (cons (cons fail ()) (cons (concat Parse_ (hd V2245)) ()))) ())) (cons Action (cons Else ())))) ())))))))) (true (shen.sys-error shen.recursive_descent))))
87
-
88
- (defun shen.variable-match (V2248 V2249 V2250) (cond ((cons? V2248) (let Test (cons cons? (cons (cons hd (cons V2249 ())) ())) (let Action (cons let (cons (concat Parse_ (hd V2248)) (cons (cons hd (cons (cons hd (cons V2249 ())) ())) (cons (shen.syntax (tl V2248) (cons shen.pair (cons (cons tl (cons (cons hd (cons V2249 ())) ())) (cons (cons shen.hdtl (cons V2249 ())) ()))) V2250) ())))) (let Else (cons fail ()) (cons if (cons Test (cons Action (cons Else ())))))))) (true (shen.sys-error shen.variable-match))))
89
-
90
- (defun shen.terminal? (V2259) (cond ((cons? V2259) false) ((variable? V2259) false) (true true)))
91
-
92
- (defun shen.jump_stream? (V2264) (cond ((= V2264 _) true) (true false)))
93
-
94
- (defun shen.check_stream (V2265 V2266 V2267) (cond ((cons? V2265) (let Test (cons and (cons (cons cons? (cons (cons hd (cons V2266 ())) ())) (cons (cons = (cons (hd V2265) (cons (cons hd (cons (cons hd (cons V2266 ())) ())) ()))) ()))) (let Action (shen.syntax (tl V2265) (cons shen.pair (cons (cons tl (cons (cons hd (cons V2266 ())) ())) (cons (cons shen.hdtl (cons V2266 ())) ()))) V2267) (let Else (cons fail ()) (cons if (cons Test (cons Action (cons Else ())))))))) (true (shen.sys-error shen.check_stream))))
95
-
96
- (defun shen.jump_stream (V2268 V2269 V2270) (cond ((cons? V2268) (let Test (cons cons? (cons (cons hd (cons V2269 ())) ())) (let Action (shen.syntax (tl V2268) (cons shen.pair (cons (cons tl (cons (cons hd (cons V2269 ())) ())) (cons (cons shen.hdtl (cons V2269 ())) ()))) V2270) (let Else (cons fail ()) (cons if (cons Test (cons Action (cons Else ())))))))) (true (shen.sys-error shen.jump_stream))))
97
-
98
- (defun shen.semantics (V2271) (cond ((= () V2271) ()) ((shen.grammar_symbol? V2271) (cons shen.hdtl (cons (concat Parse_ V2271) ()))) ((variable? V2271) (concat Parse_ V2271)) ((cons? V2271) (map (lambda X2186 (shen.semantics X2186)) V2271)) (true V2271)))
99
-
100
- (defun shen.snd-or-fail (V2278) (cond ((and (cons? V2278) (and (cons? (tl V2278)) (= () (tl (tl V2278))))) (hd (tl V2278))) (true (fail))))
101
-
102
- (defun fail () shen.fail!)
103
-
104
- (defun shen.pair (V2279 V2280) (cons V2279 (cons V2280 ())))
105
-
106
- (defun shen.hdtl (V2281) (hd (tl V2281)))
107
-
108
- (defun <!> (V2288) (cond ((and (cons? V2288) (and (cons? (tl V2288)) (= () (tl (tl V2288))))) (cons () (cons (hd V2288) ()))) (true (fail))))
109
-
110
- (defun <e> (V2293) (cond ((and (cons? V2293) (and (cons? (tl V2293)) (= () (tl (tl V2293))))) (cons (hd V2293) (cons () ()))) (true (shen.sys-error <e>))))
111
-
112
-
113
-
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.yacc (V2187) (cond ((and (cons? V2187) (and (= defcc (hd V2187)) (and (cons? (tl V2187)) (and (cons? (tl (tl V2187))) (and (= { (hd (tl (tl V2187)))) (and (cons? (tl (tl (tl V2187)))) (and (cons? (tl (tl (tl (tl V2187))))) (and (= ==> (hd (tl (tl (tl (tl V2187)))))) (and (cons? (tl (tl (tl (tl (tl V2187)))))) (and (cons? (tl (tl (tl (tl (tl (tl V2187))))))) (= } (hd (tl (tl (tl (tl (tl (tl V2187)))))))))))))))))) (shen.yacc (cons defcc (cons (hd (tl V2187)) (tl (tl (tl (tl (tl (tl (tl V2187))))))))))) ((and (cons? V2187) (and (= defcc (hd V2187)) (cons? (tl V2187)))) (shen.yacc->shen (hd (tl V2187)) (tl (tl V2187)))) (true (shen.sys-error shen.yacc))))
51
+
52
+ (defun shen.yacc->shen (V2188 V2189) (let CCRules (shen.split_cc_rules true V2189 ()) (let CCBody (map (lambda X2185 (shen.cc_body X2185)) CCRules) (let YaccCases (shen.yacc_cases CCBody) (cons define (cons V2188 (cons Stream (cons -> (cons (shen.kill-code YaccCases) ())))))))))
53
+
54
+ (defun shen.kill-code (V2190) (cond ((> (occurrences kill V2190) 0) (cons trap-error (cons V2190 (cons (cons lambda (cons E (cons (cons shen.analyse-kill (cons E ())) ()))) ())))) (true V2190)))
55
+
56
+ (defun kill () (simple-error "yacc kill"))
57
+
58
+ (defun shen.analyse-kill (V2191) (let String (error-to-string V2191) (if (= String "yacc kill") (fail) V2191)))
59
+
60
+ (defun shen.split_cc_rules (V2194 V2195 V2196) (cond ((and (= () V2195) (= () V2196)) ()) ((= () V2195) (cons (shen.split_cc_rule V2194 (reverse V2196) ()) ())) ((and (cons? V2195) (= ; (hd V2195))) (cons (shen.split_cc_rule V2194 (reverse V2196) ()) (shen.split_cc_rules V2194 (tl V2195) ()))) ((cons? V2195) (shen.split_cc_rules V2194 (tl V2195) (cons (hd V2195) V2196))) (true (shen.sys-error shen.split_cc_rules))))
61
+
62
+ (defun shen.split_cc_rule (V2201 V2202 V2203) (cond ((and (cons? V2202) (and (= := (hd V2202)) (and (cons? (tl V2202)) (= () (tl (tl V2202)))))) (cons (reverse V2203) (tl V2202))) ((and (cons? V2202) (and (= := (hd V2202)) (and (cons? (tl V2202)) (and (cons? (tl (tl V2202))) (and (= where (hd (tl (tl V2202)))) (and (cons? (tl (tl (tl V2202)))) (= () (tl (tl (tl (tl V2202))))))))))) (cons (reverse V2203) (cons (cons where (cons (hd (tl (tl (tl V2202)))) (cons (hd (tl V2202)) ()))) ()))) ((= () V2202) (do (shen.semantic-completion-warning V2201 V2203) (shen.split_cc_rule V2201 (cons := (cons (shen.default_semantics (reverse V2203)) ())) V2203))) ((cons? V2202) (shen.split_cc_rule V2201 (tl V2202) (cons (hd V2202) V2203))) (true (shen.sys-error shen.split_cc_rule))))
63
+
64
+ (defun shen.semantic-completion-warning (V2212 V2213) (cond ((= true V2212) (do (shen.prhush "warning: " (stoutput)) (do (map (lambda X (shen.prhush (shen.app X " " shen.a) (stoutput))) (reverse V2213)) (shen.prhush "has no semantics.
65
+ " (stoutput))))) (true shen.skip)))
66
+
67
+ (defun shen.default_semantics (V2214) (cond ((= () V2214) ()) ((and (cons? V2214) (and (= () (tl V2214)) (shen.grammar_symbol? (hd V2214)))) (hd V2214)) ((and (cons? V2214) (shen.grammar_symbol? (hd V2214))) (cons append (cons (hd V2214) (cons (shen.default_semantics (tl V2214)) ())))) ((cons? V2214) (cons cons (cons (hd V2214) (cons (shen.default_semantics (tl V2214)) ())))) (true (shen.sys-error shen.default_semantics))))
68
+
69
+ (defun shen.grammar_symbol? (V2215) (and (symbol? V2215) (let Cs (shen.strip-pathname (explode V2215)) (and (= (hd Cs) "<") (= (hd (reverse Cs)) ">")))))
70
+
71
+ (defun shen.yacc_cases (V2216) (cond ((and (cons? V2216) (= () (tl V2216))) (hd V2216)) ((cons? V2216) (let P YaccParse (cons let (cons P (cons (hd V2216) (cons (cons if (cons (cons = (cons P (cons (cons fail ()) ()))) (cons (shen.yacc_cases (tl V2216)) (cons P ())))) ())))))) (true (shen.sys-error shen.yacc_cases))))
72
+
73
+ (defun shen.cc_body (V2217) (cond ((and (cons? V2217) (and (cons? (tl V2217)) (= () (tl (tl V2217))))) (shen.syntax (hd V2217) Stream (hd (tl V2217)))) (true (shen.sys-error shen.cc_body))))
74
+
75
+ (defun shen.syntax (V2218 V2219 V2220) (cond ((and (= () V2218) (and (cons? V2220) (and (= where (hd V2220)) (and (cons? (tl V2220)) (and (cons? (tl (tl V2220))) (= () (tl (tl (tl V2220))))))))) (cons if (cons (shen.semantics (hd (tl V2220))) (cons (cons shen.pair (cons (cons hd (cons V2219 ())) (cons (shen.semantics (hd (tl (tl V2220)))) ()))) (cons (cons fail ()) ()))))) ((= () V2218) (cons shen.pair (cons (cons hd (cons V2219 ())) (cons (shen.semantics V2220) ())))) ((cons? V2218) (if (shen.grammar_symbol? (hd V2218)) (shen.recursive_descent V2218 V2219 V2220) (if (variable? (hd V2218)) (shen.variable-match V2218 V2219 V2220) (if (shen.jump_stream? (hd V2218)) (shen.jump_stream V2218 V2219 V2220) (if (shen.terminal? (hd V2218)) (shen.check_stream V2218 V2219 V2220) (if (cons? (hd V2218)) (shen.list-stream (shen.decons (hd V2218)) (tl V2218) V2219 V2220) (simple-error (shen.app (hd V2218) " is not legal syntax
76
+ " shen.a)))))))) (true (shen.sys-error shen.syntax))))
77
+
78
+ (defun shen.list-stream (V2221 V2222 V2223 V2224) (let Test (cons and (cons (cons cons? (cons (cons hd (cons V2223 ())) ())) (cons (cons cons? (cons (cons hd (cons (cons hd (cons V2223 ())) ())) ())) ()))) (let Placeholder (gensym shen.place) (let RunOn (shen.syntax V2222 (cons shen.pair (cons (cons tl (cons (cons hd (cons V2223 ())) ())) (cons (cons hd (cons (cons tl (cons V2223 ())) ())) ()))) V2224) (let Action (shen.insert-runon RunOn Placeholder (shen.syntax V2221 (cons shen.pair (cons (cons hd (cons (cons hd (cons V2223 ())) ())) (cons (cons hd (cons (cons tl (cons V2223 ())) ())) ()))) Placeholder)) (cons if (cons Test (cons Action (cons (cons fail ()) ())))))))))
79
+
80
+ (defun shen.decons (V2225) (cond ((and (cons? V2225) (and (= cons (hd V2225)) (and (cons? (tl V2225)) (and (cons? (tl (tl V2225))) (and (= () (hd (tl (tl V2225)))) (= () (tl (tl (tl V2225))))))))) (cons (hd (tl V2225)) ())) ((and (cons? V2225) (and (= cons (hd V2225)) (and (cons? (tl V2225)) (and (cons? (tl (tl V2225))) (= () (tl (tl (tl V2225)))))))) (cons (hd (tl V2225)) (shen.decons (hd (tl (tl V2225)))))) (true V2225)))
81
+
82
+ (defun shen.insert-runon (V2236 V2237 V2238) (cond ((and (cons? V2238) (and (= shen.pair (hd V2238)) (and (cons? (tl V2238)) (and (cons? (tl (tl V2238))) (and (= () (tl (tl (tl V2238)))) (= (hd (tl (tl V2238))) V2237)))))) V2236) ((cons? V2238) (map (lambda Z (shen.insert-runon V2236 V2237 Z)) V2238)) (true V2238)))
83
+
84
+ (defun shen.strip-pathname (V2244) (cond ((not (element? "." V2244)) V2244) ((cons? V2244) (shen.strip-pathname (tl V2244))) (true (shen.sys-error shen.strip-pathname))))
85
+
86
+ (defun shen.recursive_descent (V2245 V2246 V2247) (cond ((cons? V2245) (let Test (cons (hd V2245) (cons V2246 ())) (let Action (shen.syntax (tl V2245) (concat Parse_ (hd V2245)) V2247) (let Else (cons fail ()) (cons let (cons (concat Parse_ (hd V2245)) (cons Test (cons (cons if (cons (cons not (cons (cons = (cons (cons fail ()) (cons (concat Parse_ (hd V2245)) ()))) ())) (cons Action (cons Else ())))) ())))))))) (true (shen.sys-error shen.recursive_descent))))
87
+
88
+ (defun shen.variable-match (V2248 V2249 V2250) (cond ((cons? V2248) (let Test (cons cons? (cons (cons hd (cons V2249 ())) ())) (let Action (cons let (cons (concat Parse_ (hd V2248)) (cons (cons hd (cons (cons hd (cons V2249 ())) ())) (cons (shen.syntax (tl V2248) (cons shen.pair (cons (cons tl (cons (cons hd (cons V2249 ())) ())) (cons (cons shen.hdtl (cons V2249 ())) ()))) V2250) ())))) (let Else (cons fail ()) (cons if (cons Test (cons Action (cons Else ())))))))) (true (shen.sys-error shen.variable-match))))
89
+
90
+ (defun shen.terminal? (V2259) (cond ((cons? V2259) false) ((variable? V2259) false) (true true)))
91
+
92
+ (defun shen.jump_stream? (V2264) (cond ((= V2264 _) true) (true false)))
93
+
94
+ (defun shen.check_stream (V2265 V2266 V2267) (cond ((cons? V2265) (let Test (cons and (cons (cons cons? (cons (cons hd (cons V2266 ())) ())) (cons (cons = (cons (hd V2265) (cons (cons hd (cons (cons hd (cons V2266 ())) ())) ()))) ()))) (let Action (shen.syntax (tl V2265) (cons shen.pair (cons (cons tl (cons (cons hd (cons V2266 ())) ())) (cons (cons shen.hdtl (cons V2266 ())) ()))) V2267) (let Else (cons fail ()) (cons if (cons Test (cons Action (cons Else ())))))))) (true (shen.sys-error shen.check_stream))))
95
+
96
+ (defun shen.jump_stream (V2268 V2269 V2270) (cond ((cons? V2268) (let Test (cons cons? (cons (cons hd (cons V2269 ())) ())) (let Action (shen.syntax (tl V2268) (cons shen.pair (cons (cons tl (cons (cons hd (cons V2269 ())) ())) (cons (cons shen.hdtl (cons V2269 ())) ()))) V2270) (let Else (cons fail ()) (cons if (cons Test (cons Action (cons Else ())))))))) (true (shen.sys-error shen.jump_stream))))
97
+
98
+ (defun shen.semantics (V2271) (cond ((= () V2271) ()) ((shen.grammar_symbol? V2271) (cons shen.hdtl (cons (concat Parse_ V2271) ()))) ((variable? V2271) (concat Parse_ V2271)) ((cons? V2271) (map (lambda X2186 (shen.semantics X2186)) V2271)) (true V2271)))
99
+
100
+ (defun shen.snd-or-fail (V2278) (cond ((and (cons? V2278) (and (cons? (tl V2278)) (= () (tl (tl V2278))))) (hd (tl V2278))) (true (fail))))
101
+
102
+ (defun fail () shen.fail!)
103
+
104
+ (defun shen.pair (V2279 V2280) (cons V2279 (cons V2280 ())))
105
+
106
+ (defun shen.hdtl (V2281) (hd (tl V2281)))
107
+
108
+ (defun <!> (V2288) (cond ((and (cons? V2288) (and (cons? (tl V2288)) (= () (tl (tl V2288))))) (cons () (cons (hd V2288) ()))) (true (fail))))
109
+
110
+ (defun <e> (V2293) (cond ((and (cons? V2293) (and (cons? (tl V2293)) (= () (tl (tl V2293))))) (cons (hd V2293) (cons () ()))) (true (shen.sys-error <e>))))
111
+
112
+
113
+
@@ -1,26 +1,26 @@
1
-
2
- [[[y-combinator [/. ADD [/. X [/. Y [if [= X 0] Y [[ADD [-- X]] [++ Y]]]]]]] 2] 3]
3
-
4
-
5
- [[[y-combinator [/. ADD [/. X [/. Y [if [= X 0] Y [[ADD [-- X]] [++ Y]]]]]]] 33] 4]
6
-
7
- [[[/. [@p X Y] X]
8
- [y-combinator [/. T
9
- [@p [/. A [cases [[/. 1 false] A]
10
- [[/. X [[[/. [@p X Y] Y] T] [-- X]]] A]]]
11
- [/. A [cases [[/. 1 true] A]
12
- [[/. X [[[/. [@p X Y] X] T] [-- X]]] A]]]]]]] 6]
13
-
14
-
15
-
16
-
17
-
18
-
19
-
20
-
21
-
22
-
23
-
24
-
25
-
26
-
1
+
2
+ [[[y-combinator [/. ADD [/. X [/. Y [if [= X 0] Y [[ADD [-- X]] [++ Y]]]]]]] 2] 3]
3
+
4
+
5
+ [[[y-combinator [/. ADD [/. X [/. Y [if [= X 0] Y [[ADD [-- X]] [++ Y]]]]]]] 33] 4]
6
+
7
+ [[[/. [@p X Y] X]
8
+ [y-combinator [/. T
9
+ [@p [/. A [cases [[/. 1 false] A]
10
+ [[/. X [[[/. [@p X Y] Y] T] [-- X]]] A]]]
11
+ [/. A [cases [[/. 1 true] A]
12
+ [[/. X [[[/. [@p X Y] X] T] [-- X]]] A]]]]]]] 6]
13
+
14
+
15
+
16
+
17
+
18
+
19
+
20
+
21
+
22
+
23
+
24
+
25
+
26
+