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
data/shen/release/k_lambda/reader.kl CHANGED
@@ -1,222 +1,222 @@
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 read-file-as-bytelist (V1348) (let Stream (open V1348 in) (let Byte (read-byte Stream) (let Bytes (shen.read-file-as-bytelist-help Stream Byte ()) (let Close (close Stream) (reverse Bytes))))))
51
-
52
- (defun shen.read-file-as-bytelist-help (V1349 V1350 V1351) (cond ((= -1 V1350) V1351) (true (shen.read-file-as-bytelist-help V1349 (read-byte V1349) (cons V1350 V1351)))))
53
-
54
- (defun read-file-as-string (V1352) (let Stream (open V1352 in) (shen.rfas-h Stream (read-byte Stream) "")))
55
-
56
- (defun shen.rfas-h (V1353 V1354 V1355) (cond ((= -1 V1354) (do (close V1353) V1355)) (true (shen.rfas-h V1353 (read-byte V1353) (cn V1355 (n->string V1354))))))
57
-
58
- (defun input (V1356) (eval-kl (read V1356)))
59
-
60
- (defun input+ (V1357 V1358) (let Mono? (shen.monotype V1357) (let Input (read V1358) (if (= false (shen.typecheck Input (shen.demodulate V1357))) (simple-error (cn "type error: " (shen.app Input (cn " is not of type " (shen.app V1357 "
61
- " shen.r)) shen.r))) (eval-kl Input)))))
62
-
63
- (defun shen.monotype (V1359) (cond ((cons? V1359) (map (lambda X1337 (shen.monotype X1337)) V1359)) (true (if (variable? V1359) (simple-error (cn "input+ expects a monotype: not " (shen.app V1359 "
64
- " shen.a))) V1359))))
65
-
66
- (defun read (V1360) (hd (shen.read-loop V1360 (read-byte V1360) ())))
67
-
68
- (defun it () (value shen.*it*))
69
-
70
- (defun shen.read-loop (V1365 V1366 V1367) (cond ((= 94 V1366) (simple-error "read aborted")) ((= -1 V1366) (if (empty? V1367) (simple-error "error: empty stream") (compile (lambda X1338 (shen.<st_input> X1338)) V1367 (lambda E E)))) ((shen.terminator? V1366) (let AllBytes (append V1367 (cons V1366 ())) (let It (shen.record-it AllBytes) (let Read (compile (lambda X1339 (shen.<st_input> X1339)) AllBytes (lambda E shen.nextbyte)) (if (or (= Read shen.nextbyte) (empty? Read)) (shen.read-loop V1365 (read-byte V1365) AllBytes) Read))))) (true (shen.read-loop V1365 (read-byte V1365) (append V1367 (cons V1366 ()))))))
71
-
72
- (defun shen.terminator? (V1368) (element? V1368 (cons 9 (cons 10 (cons 13 (cons 32 (cons 34 (cons 41 (cons 93 ())))))))))
73
-
74
- (defun lineread (V1369) (shen.lineread-loop (read-byte V1369) () V1369))
75
-
76
- (defun shen.lineread-loop (V1371 V1372 V1373) (cond ((= -1 V1371) (if (empty? V1372) (simple-error "empty stream") (compile (lambda X1340 (shen.<st_input> X1340)) V1372 (lambda E E)))) ((= V1371 (shen.hat)) (simple-error "line read aborted")) ((element? V1371 (cons (shen.newline) (cons (shen.carriage-return) ()))) (let Line (compile (lambda X1341 (shen.<st_input> X1341)) V1372 (lambda E shen.nextline)) (let It (shen.record-it V1372) (if (or (= Line shen.nextline) (empty? Line)) (shen.lineread-loop (read-byte V1373) (append V1372 (cons V1371 ())) V1373) Line)))) (true (shen.lineread-loop (read-byte V1373) (append V1372 (cons V1371 ())) V1373))))
77
-
78
- (defun shen.record-it (V1374) (let TrimLeft (shen.trim-whitespace V1374) (let TrimRight (shen.trim-whitespace (reverse TrimLeft)) (let Trimmed (reverse TrimRight) (shen.record-it-h Trimmed)))))
79
-
80
- (defun shen.trim-whitespace (V1375) (cond ((and (cons? V1375) (element? (hd V1375) (cons 9 (cons 10 (cons 13 (cons 32 ())))))) (shen.trim-whitespace (tl V1375))) (true V1375)))
81
-
82
- (defun shen.record-it-h (V1376) (do (set shen.*it* (shen.cn-all (map (lambda X1342 (n->string X1342)) V1376))) V1376))
83
-
84
- (defun shen.cn-all (V1377) (cond ((= () V1377) "") ((cons? V1377) (cn (hd V1377) (shen.cn-all (tl V1377)))) (true (shen.sys-error shen.cn-all))))
85
-
86
- (defun read-file (V1378) (let Bytelist (read-file-as-bytelist V1378) (compile (lambda X1343 (shen.<st_input> X1343)) Bytelist (lambda X1344 (shen.read-error X1344)))))
87
-
88
- (defun read-from-string (V1379) (let Ns (map (lambda X1345 (string->n X1345)) (explode V1379)) (compile (lambda X1346 (shen.<st_input> X1346)) Ns (lambda X1347 (shen.read-error X1347)))))
89
-
90
- (defun shen.read-error (V1386) (cond ((and (cons? V1386) (and (cons? (hd V1386)) (and (cons? (tl V1386)) (= () (tl (tl V1386)))))) (simple-error (cn "read error here:
91
-
92
- " (shen.app (shen.compress-50 50 (hd V1386)) "
93
- " shen.a)))) (true (simple-error "read error
94
- "))))
95
-
96
- (defun shen.compress-50 (V1391 V1392) (cond ((= () V1392) "") ((= 0 V1391) "") ((cons? V1392) (cn (n->string (hd V1392)) (shen.compress-50 (- V1391 1) (tl V1392)))) (true (shen.sys-error shen.compress-50))))
97
-
98
- (defun shen.<st_input> (V1397) (let Result (let Parse_shen.<lsb> (shen.<lsb> V1397) (if (not (= (fail) Parse_shen.<lsb>)) (let Parse_shen.<st_input1> (shen.<st_input1> Parse_shen.<lsb>) (if (not (= (fail) Parse_shen.<st_input1>)) (let Parse_shen.<rsb> (shen.<rsb> Parse_shen.<st_input1>) (if (not (= (fail) Parse_shen.<rsb>)) (let Parse_shen.<st_input2> (shen.<st_input2> Parse_shen.<rsb>) (if (not (= (fail) Parse_shen.<st_input2>)) (shen.pair (hd Parse_shen.<st_input2>) (cons (macroexpand (shen.cons_form (shen.hdtl Parse_shen.<st_input1>))) (shen.hdtl Parse_shen.<st_input2>))) (fail))) (fail))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<lrb> (shen.<lrb> V1397) (if (not (= (fail) Parse_shen.<lrb>)) (let Parse_shen.<st_input1> (shen.<st_input1> Parse_shen.<lrb>) (if (not (= (fail) Parse_shen.<st_input1>)) (let Parse_shen.<rrb> (shen.<rrb> Parse_shen.<st_input1>) (if (not (= (fail) Parse_shen.<rrb>)) (let Parse_shen.<st_input2> (shen.<st_input2> Parse_shen.<rrb>) (if (not (= (fail) Parse_shen.<st_input2>)) (shen.pair (hd Parse_shen.<st_input2>) (shen.package-macro (macroexpand (shen.hdtl Parse_shen.<st_input1>)) (shen.hdtl Parse_shen.<st_input2>))) (fail))) (fail))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<lcurly> (shen.<lcurly> V1397) (if (not (= (fail) Parse_shen.<lcurly>)) (let Parse_shen.<st_input> (shen.<st_input> Parse_shen.<lcurly>) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (cons { (shen.hdtl Parse_shen.<st_input>))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<rcurly> (shen.<rcurly> V1397) (if (not (= (fail) Parse_shen.<rcurly>)) (let Parse_shen.<st_input> (shen.<st_input> Parse_shen.<rcurly>) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (cons } (shen.hdtl Parse_shen.<st_input>))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<bar> (shen.<bar> V1397) (if (not (= (fail) Parse_shen.<bar>)) (let Parse_shen.<st_input> (shen.<st_input> Parse_shen.<bar>) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (cons bar! (shen.hdtl Parse_shen.<st_input>))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<semicolon> (shen.<semicolon> V1397) (if (not (= (fail) Parse_shen.<semicolon>)) (let Parse_shen.<st_input> (shen.<st_input> Parse_shen.<semicolon>) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (cons ; (shen.hdtl Parse_shen.<st_input>))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<colon> (shen.<colon> V1397) (if (not (= (fail) Parse_shen.<colon>)) (let Parse_shen.<equal> (shen.<equal> Parse_shen.<colon>) (if (not (= (fail) Parse_shen.<equal>)) (let Parse_shen.<st_input> (shen.<st_input> Parse_shen.<equal>) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (cons := (shen.hdtl Parse_shen.<st_input>))) (fail))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<colon> (shen.<colon> V1397) (if (not (= (fail) Parse_shen.<colon>)) (let Parse_shen.<minus> (shen.<minus> Parse_shen.<colon>) (if (not (= (fail) Parse_shen.<minus>)) (let Parse_shen.<st_input> (shen.<st_input> Parse_shen.<minus>) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (cons :- (shen.hdtl Parse_shen.<st_input>))) (fail))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<colon> (shen.<colon> V1397) (if (not (= (fail) Parse_shen.<colon>)) (let Parse_shen.<st_input> (shen.<st_input> Parse_shen.<colon>) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (cons : (shen.hdtl Parse_shen.<st_input>))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<comma> (shen.<comma> V1397) (if (not (= (fail) Parse_shen.<comma>)) (let Parse_shen.<st_input> (shen.<st_input> Parse_shen.<comma>) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (cons (intern ",") (shen.hdtl Parse_shen.<st_input>))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<comment> (shen.<comment> V1397) (if (not (= (fail) Parse_shen.<comment>)) (let Parse_shen.<st_input> (shen.<st_input> Parse_shen.<comment>) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (shen.hdtl Parse_shen.<st_input>)) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<atom> (shen.<atom> V1397) (if (not (= (fail) Parse_shen.<atom>)) (let Parse_shen.<st_input> (shen.<st_input> Parse_shen.<atom>) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (cons (macroexpand (shen.hdtl Parse_shen.<atom>)) (shen.hdtl Parse_shen.<st_input>))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<whitespaces> (shen.<whitespaces> V1397) (if (not (= (fail) Parse_shen.<whitespaces>)) (let Parse_shen.<st_input> (shen.<st_input> Parse_shen.<whitespaces>) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (shen.hdtl Parse_shen.<st_input>)) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_<e> (<e> V1397) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) ()) (fail))) (if (= Result (fail)) (fail) Result)) Result)) Result)) Result)) Result)) Result)) Result)) Result)) Result)) Result)) Result)) Result)) Result)) Result)))
99
-
100
- (defun shen.<lsb> (V1402) (let Result (if (and (cons? (hd V1402)) (= 91 (hd (hd V1402)))) (shen.pair (hd (shen.pair (tl (hd V1402)) (shen.hdtl V1402))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
101
-
102
- (defun shen.<rsb> (V1407) (let Result (if (and (cons? (hd V1407)) (= 93 (hd (hd V1407)))) (shen.pair (hd (shen.pair (tl (hd V1407)) (shen.hdtl V1407))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
103
-
104
- (defun shen.<lcurly> (V1412) (let Result (if (and (cons? (hd V1412)) (= 123 (hd (hd V1412)))) (shen.pair (hd (shen.pair (tl (hd V1412)) (shen.hdtl V1412))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
105
-
106
- (defun shen.<rcurly> (V1417) (let Result (if (and (cons? (hd V1417)) (= 125 (hd (hd V1417)))) (shen.pair (hd (shen.pair (tl (hd V1417)) (shen.hdtl V1417))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
107
-
108
- (defun shen.<bar> (V1422) (let Result (if (and (cons? (hd V1422)) (= 124 (hd (hd V1422)))) (shen.pair (hd (shen.pair (tl (hd V1422)) (shen.hdtl V1422))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
109
-
110
- (defun shen.<semicolon> (V1427) (let Result (if (and (cons? (hd V1427)) (= 59 (hd (hd V1427)))) (shen.pair (hd (shen.pair (tl (hd V1427)) (shen.hdtl V1427))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
111
-
112
- (defun shen.<colon> (V1432) (let Result (if (and (cons? (hd V1432)) (= 58 (hd (hd V1432)))) (shen.pair (hd (shen.pair (tl (hd V1432)) (shen.hdtl V1432))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
113
-
114
- (defun shen.<comma> (V1437) (let Result (if (and (cons? (hd V1437)) (= 44 (hd (hd V1437)))) (shen.pair (hd (shen.pair (tl (hd V1437)) (shen.hdtl V1437))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
115
-
116
- (defun shen.<equal> (V1442) (let Result (if (and (cons? (hd V1442)) (= 61 (hd (hd V1442)))) (shen.pair (hd (shen.pair (tl (hd V1442)) (shen.hdtl V1442))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
117
-
118
- (defun shen.<minus> (V1447) (let Result (if (and (cons? (hd V1447)) (= 45 (hd (hd V1447)))) (shen.pair (hd (shen.pair (tl (hd V1447)) (shen.hdtl V1447))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
119
-
120
- (defun shen.<lrb> (V1452) (let Result (if (and (cons? (hd V1452)) (= 40 (hd (hd V1452)))) (shen.pair (hd (shen.pair (tl (hd V1452)) (shen.hdtl V1452))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
121
-
122
- (defun shen.<rrb> (V1457) (let Result (if (and (cons? (hd V1457)) (= 41 (hd (hd V1457)))) (shen.pair (hd (shen.pair (tl (hd V1457)) (shen.hdtl V1457))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
123
-
124
- (defun shen.<atom> (V1462) (let Result (let Parse_shen.<str> (shen.<str> V1462) (if (not (= (fail) Parse_shen.<str>)) (shen.pair (hd Parse_shen.<str>) (shen.control-chars (shen.hdtl Parse_shen.<str>))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<number> (shen.<number> V1462) (if (not (= (fail) Parse_shen.<number>)) (shen.pair (hd Parse_shen.<number>) (shen.hdtl Parse_shen.<number>)) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<sym> (shen.<sym> V1462) (if (not (= (fail) Parse_shen.<sym>)) (shen.pair (hd Parse_shen.<sym>) (if (= (shen.hdtl Parse_shen.<sym>) "<>") (cons vector (cons 0 ())) (intern (shen.hdtl Parse_shen.<sym>)))) (fail))) (if (= Result (fail)) (fail) Result)) Result)) Result)))
125
-
126
- (defun shen.control-chars (V1463) (cond ((= () V1463) "") ((and (cons? V1463) (and (= "c" (hd V1463)) (and (cons? (tl V1463)) (= "#" (hd (tl V1463)))))) (let CodePoint (shen.code-point (tl (tl V1463))) (let AfterCodePoint (shen.after-codepoint (tl (tl V1463))) (@s (n->string (shen.decimalise CodePoint)) (shen.control-chars AfterCodePoint))))) ((cons? V1463) (@s (hd V1463) (shen.control-chars (tl V1463)))) (true (shen.sys-error shen.control-chars))))
127
-
128
- (defun shen.code-point (V1466) (cond ((and (cons? V1466) (= ";" (hd V1466))) "") ((and (cons? V1466) (element? (hd V1466) (cons "0" (cons "1" (cons "2" (cons "3" (cons "4" (cons "5" (cons "6" (cons "7" (cons "8" (cons "9" (cons "0" ()))))))))))))) (cons (hd V1466) (shen.code-point (tl V1466)))) (true (simple-error (cn "code point parse error " (shen.app V1466 "
129
- " shen.a))))))
130
-
131
- (defun shen.after-codepoint (V1471) (cond ((= () V1471) ()) ((and (cons? V1471) (= ";" (hd V1471))) (tl V1471)) ((cons? V1471) (shen.after-codepoint (tl V1471))) (true (shen.sys-error shen.after-codepoint))))
132
-
133
- (defun shen.decimalise (V1472) (shen.pre (reverse (shen.digits->integers V1472)) 0))
134
-
135
- (defun shen.digits->integers (V1477) (cond ((and (cons? V1477) (= "0" (hd V1477))) (cons 0 (shen.digits->integers (tl V1477)))) ((and (cons? V1477) (= "1" (hd V1477))) (cons 1 (shen.digits->integers (tl V1477)))) ((and (cons? V1477) (= "2" (hd V1477))) (cons 2 (shen.digits->integers (tl V1477)))) ((and (cons? V1477) (= "3" (hd V1477))) (cons 3 (shen.digits->integers (tl V1477)))) ((and (cons? V1477) (= "4" (hd V1477))) (cons 4 (shen.digits->integers (tl V1477)))) ((and (cons? V1477) (= "5" (hd V1477))) (cons 5 (shen.digits->integers (tl V1477)))) ((and (cons? V1477) (= "6" (hd V1477))) (cons 6 (shen.digits->integers (tl V1477)))) ((and (cons? V1477) (= "7" (hd V1477))) (cons 7 (shen.digits->integers (tl V1477)))) ((and (cons? V1477) (= "8" (hd V1477))) (cons 8 (shen.digits->integers (tl V1477)))) ((and (cons? V1477) (= "9" (hd V1477))) (cons 9 (shen.digits->integers (tl V1477)))) (true ())))
136
-
137
- (defun shen.<sym> (V1482) (let Result (let Parse_shen.<alpha> (shen.<alpha> V1482) (if (not (= (fail) Parse_shen.<alpha>)) (let Parse_shen.<alphanums> (shen.<alphanums> Parse_shen.<alpha>) (if (not (= (fail) Parse_shen.<alphanums>)) (shen.pair (hd Parse_shen.<alphanums>) (@s (shen.hdtl Parse_shen.<alpha>) (shen.hdtl Parse_shen.<alphanums>))) (fail))) (fail))) (if (= Result (fail)) (fail) Result)))
138
-
139
- (defun shen.<alphanums> (V1487) (let Result (let Parse_shen.<alphanum> (shen.<alphanum> V1487) (if (not (= (fail) Parse_shen.<alphanum>)) (let Parse_shen.<alphanums> (shen.<alphanums> Parse_shen.<alphanum>) (if (not (= (fail) Parse_shen.<alphanums>)) (shen.pair (hd Parse_shen.<alphanums>) (@s (shen.hdtl Parse_shen.<alphanum>) (shen.hdtl Parse_shen.<alphanums>))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_<e> (<e> V1487) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) "") (fail))) (if (= Result (fail)) (fail) Result)) Result)))
140
-
141
- (defun shen.<alphanum> (V1492) (let Result (let Parse_shen.<alpha> (shen.<alpha> V1492) (if (not (= (fail) Parse_shen.<alpha>)) (shen.pair (hd Parse_shen.<alpha>) (shen.hdtl Parse_shen.<alpha>)) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<num> (shen.<num> V1492) (if (not (= (fail) Parse_shen.<num>)) (shen.pair (hd Parse_shen.<num>) (shen.hdtl Parse_shen.<num>)) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
142
-
143
- (defun shen.<num> (V1497) (let Result (if (cons? (hd V1497)) (let Parse_Byte (hd (hd V1497)) (if (shen.numbyte? Parse_Byte) (shen.pair (hd (shen.pair (tl (hd V1497)) (shen.hdtl V1497))) (n->string Parse_Byte)) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
144
-
145
- (defun shen.numbyte? (V1502) (cond ((= 48 V1502) true) ((= 49 V1502) true) ((= 50 V1502) true) ((= 51 V1502) true) ((= 52 V1502) true) ((= 53 V1502) true) ((= 54 V1502) true) ((= 55 V1502) true) ((= 56 V1502) true) ((= 57 V1502) true) (true false)))
146
-
147
- (defun shen.<alpha> (V1507) (let Result (if (cons? (hd V1507)) (let Parse_Byte (hd (hd V1507)) (if (shen.symbol-code? Parse_Byte) (shen.pair (hd (shen.pair (tl (hd V1507)) (shen.hdtl V1507))) (n->string Parse_Byte)) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
148
-
149
- (defun shen.symbol-code? (V1508) (or (= V1508 126) (or (and (> V1508 94) (< V1508 123)) (or (and (> V1508 59) (< V1508 91)) (or (and (> V1508 41) (and (< V1508 58) (not (= V1508 44)))) (or (and (> V1508 34) (< V1508 40)) (= V1508 33)))))))
150
-
151
- (defun shen.<str> (V1513) (let Result (let Parse_shen.<dbq> (shen.<dbq> V1513) (if (not (= (fail) Parse_shen.<dbq>)) (let Parse_shen.<strcontents> (shen.<strcontents> Parse_shen.<dbq>) (if (not (= (fail) Parse_shen.<strcontents>)) (let Parse_shen.<dbq> (shen.<dbq> Parse_shen.<strcontents>) (if (not (= (fail) Parse_shen.<dbq>)) (shen.pair (hd Parse_shen.<dbq>) (shen.hdtl Parse_shen.<strcontents>)) (fail))) (fail))) (fail))) (if (= Result (fail)) (fail) Result)))
152
-
153
- (defun shen.<dbq> (V1518) (let Result (if (cons? (hd V1518)) (let Parse_Byte (hd (hd V1518)) (if (= Parse_Byte 34) (shen.pair (hd (shen.pair (tl (hd V1518)) (shen.hdtl V1518))) Parse_Byte) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
154
-
155
- (defun shen.<strcontents> (V1523) (let Result (let Parse_shen.<strc> (shen.<strc> V1523) (if (not (= (fail) Parse_shen.<strc>)) (let Parse_shen.<strcontents> (shen.<strcontents> Parse_shen.<strc>) (if (not (= (fail) Parse_shen.<strcontents>)) (shen.pair (hd Parse_shen.<strcontents>) (cons (shen.hdtl Parse_shen.<strc>) (shen.hdtl Parse_shen.<strcontents>))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_<e> (<e> V1523) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) ()) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
156
-
157
- (defun shen.<byte> (V1528) (let Result (if (cons? (hd V1528)) (let Parse_Byte (hd (hd V1528)) (shen.pair (hd (shen.pair (tl (hd V1528)) (shen.hdtl V1528))) (n->string Parse_Byte))) (fail)) (if (= Result (fail)) (fail) Result)))
158
-
159
- (defun shen.<strc> (V1533) (let Result (if (cons? (hd V1533)) (let Parse_Byte (hd (hd V1533)) (if (not (= Parse_Byte 34)) (shen.pair (hd (shen.pair (tl (hd V1533)) (shen.hdtl V1533))) (n->string Parse_Byte)) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
160
-
161
- (defun shen.<number> (V1538) (let Result (let Parse_shen.<minus> (shen.<minus> V1538) (if (not (= (fail) Parse_shen.<minus>)) (let Parse_shen.<number> (shen.<number> Parse_shen.<minus>) (if (not (= (fail) Parse_shen.<number>)) (shen.pair (hd Parse_shen.<number>) (- 0 (shen.hdtl Parse_shen.<number>))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<plus> (shen.<plus> V1538) (if (not (= (fail) Parse_shen.<plus>)) (let Parse_shen.<number> (shen.<number> Parse_shen.<plus>) (if (not (= (fail) Parse_shen.<number>)) (shen.pair (hd Parse_shen.<number>) (shen.hdtl Parse_shen.<number>)) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<predigits> (shen.<predigits> V1538) (if (not (= (fail) Parse_shen.<predigits>)) (let Parse_shen.<stop> (shen.<stop> Parse_shen.<predigits>) (if (not (= (fail) Parse_shen.<stop>)) (let Parse_shen.<postdigits> (shen.<postdigits> Parse_shen.<stop>) (if (not (= (fail) Parse_shen.<postdigits>)) (let Parse_shen.<E> (shen.<E> Parse_shen.<postdigits>) (if (not (= (fail) Parse_shen.<E>)) (let Parse_shen.<log10> (shen.<log10> Parse_shen.<E>) (if (not (= (fail) Parse_shen.<log10>)) (shen.pair (hd Parse_shen.<log10>) (* (shen.expt 10 (shen.hdtl Parse_shen.<log10>)) (+ (shen.pre (reverse (shen.hdtl Parse_shen.<predigits>)) 0) (shen.post (shen.hdtl Parse_shen.<postdigits>) 1)))) (fail))) (fail))) (fail))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<digits> (shen.<digits> V1538) (if (not (= (fail) Parse_shen.<digits>)) (let Parse_shen.<E> (shen.<E> Parse_shen.<digits>) (if (not (= (fail) Parse_shen.<E>)) (let Parse_shen.<log10> (shen.<log10> Parse_shen.<E>) (if (not (= (fail) Parse_shen.<log10>)) (shen.pair (hd Parse_shen.<log10>) (* (shen.expt 10 (shen.hdtl Parse_shen.<log10>)) (shen.pre (reverse (shen.hdtl Parse_shen.<digits>)) 0))) (fail))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<predigits> (shen.<predigits> V1538) (if (not (= (fail) Parse_shen.<predigits>)) (let Parse_shen.<stop> (shen.<stop> Parse_shen.<predigits>) (if (not (= (fail) Parse_shen.<stop>)) (let Parse_shen.<postdigits> (shen.<postdigits> Parse_shen.<stop>) (if (not (= (fail) Parse_shen.<postdigits>)) (shen.pair (hd Parse_shen.<postdigits>) (+ (shen.pre (reverse (shen.hdtl Parse_shen.<predigits>)) 0) (shen.post (shen.hdtl Parse_shen.<postdigits>) 1))) (fail))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<digits> (shen.<digits> V1538) (if (not (= (fail) Parse_shen.<digits>)) (shen.pair (hd Parse_shen.<digits>) (shen.pre (reverse (shen.hdtl Parse_shen.<digits>)) 0)) (fail))) (if (= Result (fail)) (fail) Result)) Result)) Result)) Result)) Result)) Result)))
162
-
163
- (defun shen.<E> (V1543) (let Result (if (and (cons? (hd V1543)) (= 101 (hd (hd V1543)))) (shen.pair (hd (shen.pair (tl (hd V1543)) (shen.hdtl V1543))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
164
-
165
- (defun shen.<log10> (V1548) (let Result (let Parse_shen.<minus> (shen.<minus> V1548) (if (not (= (fail) Parse_shen.<minus>)) (let Parse_shen.<digits> (shen.<digits> Parse_shen.<minus>) (if (not (= (fail) Parse_shen.<digits>)) (shen.pair (hd Parse_shen.<digits>) (- 0 (shen.pre (reverse (shen.hdtl Parse_shen.<digits>)) 0))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<digits> (shen.<digits> V1548) (if (not (= (fail) Parse_shen.<digits>)) (shen.pair (hd Parse_shen.<digits>) (shen.pre (reverse (shen.hdtl Parse_shen.<digits>)) 0)) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
166
-
167
- (defun shen.<plus> (V1553) (let Result (if (cons? (hd V1553)) (let Parse_Byte (hd (hd V1553)) (if (= Parse_Byte 43) (shen.pair (hd (shen.pair (tl (hd V1553)) (shen.hdtl V1553))) Parse_Byte) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
168
-
169
- (defun shen.<stop> (V1558) (let Result (if (cons? (hd V1558)) (let Parse_Byte (hd (hd V1558)) (if (= Parse_Byte 46) (shen.pair (hd (shen.pair (tl (hd V1558)) (shen.hdtl V1558))) Parse_Byte) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
170
-
171
- (defun shen.<predigits> (V1563) (let Result (let Parse_shen.<digits> (shen.<digits> V1563) (if (not (= (fail) Parse_shen.<digits>)) (shen.pair (hd Parse_shen.<digits>) (shen.hdtl Parse_shen.<digits>)) (fail))) (if (= Result (fail)) (let Result (let Parse_<e> (<e> V1563) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) ()) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
172
-
173
- (defun shen.<postdigits> (V1568) (let Result (let Parse_shen.<digits> (shen.<digits> V1568) (if (not (= (fail) Parse_shen.<digits>)) (shen.pair (hd Parse_shen.<digits>) (shen.hdtl Parse_shen.<digits>)) (fail))) (if (= Result (fail)) (fail) Result)))
174
-
175
- (defun shen.<digits> (V1573) (let Result (let Parse_shen.<digit> (shen.<digit> V1573) (if (not (= (fail) Parse_shen.<digit>)) (let Parse_shen.<digits> (shen.<digits> Parse_shen.<digit>) (if (not (= (fail) Parse_shen.<digits>)) (shen.pair (hd Parse_shen.<digits>) (cons (shen.hdtl Parse_shen.<digit>) (shen.hdtl Parse_shen.<digits>))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<digit> (shen.<digit> V1573) (if (not (= (fail) Parse_shen.<digit>)) (shen.pair (hd Parse_shen.<digit>) (cons (shen.hdtl Parse_shen.<digit>) ())) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
176
-
177
- (defun shen.<digit> (V1578) (let Result (if (cons? (hd V1578)) (let Parse_X (hd (hd V1578)) (if (shen.numbyte? Parse_X) (shen.pair (hd (shen.pair (tl (hd V1578)) (shen.hdtl V1578))) (shen.byte->digit Parse_X)) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
178
-
179
- (defun shen.byte->digit (V1579) (cond ((= 48 V1579) 0) ((= 49 V1579) 1) ((= 50 V1579) 2) ((= 51 V1579) 3) ((= 52 V1579) 4) ((= 53 V1579) 5) ((= 54 V1579) 6) ((= 55 V1579) 7) ((= 56 V1579) 8) ((= 57 V1579) 9) (true (shen.sys-error shen.byte->digit))))
180
-
181
- (defun shen.pre (V1582 V1583) (cond ((= () V1582) 0) ((cons? V1582) (+ (* (shen.expt 10 V1583) (hd V1582)) (shen.pre (tl V1582) (+ V1583 1)))) (true (shen.sys-error shen.pre))))
182
-
183
- (defun shen.post (V1586 V1587) (cond ((= () V1586) 0) ((cons? V1586) (+ (* (shen.expt 10 (- 0 V1587)) (hd V1586)) (shen.post (tl V1586) (+ V1587 1)))) (true (shen.sys-error shen.post))))
184
-
185
- (defun shen.expt (V1590 V1591) (cond ((= 0 V1591) 1) ((> V1591 0) (* V1590 (shen.expt V1590 (- V1591 1)))) (true (* 1 (/ (shen.expt V1590 (+ V1591 1)) V1590)))))
186
-
187
- (defun shen.<st_input1> (V1596) (let Result (let Parse_shen.<st_input> (shen.<st_input> V1596) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (shen.hdtl Parse_shen.<st_input>)) (fail))) (if (= Result (fail)) (fail) Result)))
188
-
189
- (defun shen.<st_input2> (V1601) (let Result (let Parse_shen.<st_input> (shen.<st_input> V1601) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (shen.hdtl Parse_shen.<st_input>)) (fail))) (if (= Result (fail)) (fail) Result)))
190
-
191
- (defun shen.<comment> (V1606) (let Result (let Parse_shen.<singleline> (shen.<singleline> V1606) (if (not (= (fail) Parse_shen.<singleline>)) (shen.pair (hd Parse_shen.<singleline>) shen.skip) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<multiline> (shen.<multiline> V1606) (if (not (= (fail) Parse_shen.<multiline>)) (shen.pair (hd Parse_shen.<multiline>) shen.skip) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
192
-
193
- (defun shen.<singleline> (V1611) (let Result (let Parse_shen.<backslash> (shen.<backslash> V1611) (if (not (= (fail) Parse_shen.<backslash>)) (let Parse_shen.<backslash> (shen.<backslash> Parse_shen.<backslash>) (if (not (= (fail) Parse_shen.<backslash>)) (let Parse_shen.<anysingle> (shen.<anysingle> Parse_shen.<backslash>) (if (not (= (fail) Parse_shen.<anysingle>)) (let Parse_shen.<return> (shen.<return> Parse_shen.<anysingle>) (if (not (= (fail) Parse_shen.<return>)) (shen.pair (hd Parse_shen.<return>) shen.skip) (fail))) (fail))) (fail))) (fail))) (if (= Result (fail)) (fail) Result)))
194
-
195
- (defun shen.<backslash> (V1616) (let Result (if (and (cons? (hd V1616)) (= 92 (hd (hd V1616)))) (shen.pair (hd (shen.pair (tl (hd V1616)) (shen.hdtl V1616))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
196
-
197
- (defun shen.<anysingle> (V1621) (let Result (let Parse_shen.<non-return> (shen.<non-return> V1621) (if (not (= (fail) Parse_shen.<non-return>)) (let Parse_shen.<anysingle> (shen.<anysingle> Parse_shen.<non-return>) (if (not (= (fail) Parse_shen.<anysingle>)) (shen.pair (hd Parse_shen.<anysingle>) shen.skip) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_<e> (<e> V1621) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) shen.skip) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
198
-
199
- (defun shen.<non-return> (V1626) (let Result (if (cons? (hd V1626)) (let Parse_X (hd (hd V1626)) (if (not (element? Parse_X (cons 10 (cons 13 ())))) (shen.pair (hd (shen.pair (tl (hd V1626)) (shen.hdtl V1626))) shen.skip) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
200
-
201
- (defun shen.<return> (V1631) (let Result (if (cons? (hd V1631)) (let Parse_X (hd (hd V1631)) (if (element? Parse_X (cons 10 (cons 13 ()))) (shen.pair (hd (shen.pair (tl (hd V1631)) (shen.hdtl V1631))) shen.skip) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
202
-
203
- (defun shen.<multiline> (V1636) (let Result (let Parse_shen.<backslash> (shen.<backslash> V1636) (if (not (= (fail) Parse_shen.<backslash>)) (let Parse_shen.<times> (shen.<times> Parse_shen.<backslash>) (if (not (= (fail) Parse_shen.<times>)) (let Parse_shen.<anymulti> (shen.<anymulti> Parse_shen.<times>) (if (not (= (fail) Parse_shen.<anymulti>)) (shen.pair (hd Parse_shen.<anymulti>) shen.skip) (fail))) (fail))) (fail))) (if (= Result (fail)) (fail) Result)))
204
-
205
- (defun shen.<times> (V1641) (let Result (if (and (cons? (hd V1641)) (= 42 (hd (hd V1641)))) (shen.pair (hd (shen.pair (tl (hd V1641)) (shen.hdtl V1641))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
206
-
207
- (defun shen.<anymulti> (V1646) (let Result (let Parse_shen.<comment> (shen.<comment> V1646) (if (not (= (fail) Parse_shen.<comment>)) (let Parse_shen.<anymulti> (shen.<anymulti> Parse_shen.<comment>) (if (not (= (fail) Parse_shen.<anymulti>)) (shen.pair (hd Parse_shen.<anymulti>) shen.skip) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<times> (shen.<times> V1646) (if (not (= (fail) Parse_shen.<times>)) (let Parse_shen.<backslash> (shen.<backslash> Parse_shen.<times>) (if (not (= (fail) Parse_shen.<backslash>)) (shen.pair (hd Parse_shen.<backslash>) shen.skip) (fail))) (fail))) (if (= Result (fail)) (let Result (if (cons? (hd V1646)) (let Parse_X (hd (hd V1646)) (let Parse_shen.<anymulti> (shen.<anymulti> (shen.pair (tl (hd V1646)) (shen.hdtl V1646))) (if (not (= (fail) Parse_shen.<anymulti>)) (shen.pair (hd Parse_shen.<anymulti>) shen.skip) (fail)))) (fail)) (if (= Result (fail)) (fail) Result)) Result)) Result)))
208
-
209
- (defun shen.<whitespaces> (V1651) (let Result (let Parse_shen.<whitespace> (shen.<whitespace> V1651) (if (not (= (fail) Parse_shen.<whitespace>)) (let Parse_shen.<whitespaces> (shen.<whitespaces> Parse_shen.<whitespace>) (if (not (= (fail) Parse_shen.<whitespaces>)) (shen.pair (hd Parse_shen.<whitespaces>) shen.skip) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<whitespace> (shen.<whitespace> V1651) (if (not (= (fail) Parse_shen.<whitespace>)) (shen.pair (hd Parse_shen.<whitespace>) shen.skip) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
210
-
211
- (defun shen.<whitespace> (V1656) (let Result (if (cons? (hd V1656)) (let Parse_X (hd (hd V1656)) (if (let Parse_Case Parse_X (or (= Parse_Case 32) (or (= Parse_Case 13) (or (= Parse_Case 10) (= Parse_Case 9))))) (shen.pair (hd (shen.pair (tl (hd V1656)) (shen.hdtl V1656))) shen.skip) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
212
-
213
- (defun shen.cons_form (V1657) (cond ((= () V1657) ()) ((and (cons? V1657) (and (cons? (tl V1657)) (and (cons? (tl (tl V1657))) (and (= () (tl (tl (tl V1657)))) (= (hd (tl V1657)) bar!))))) (cons cons (cons (hd V1657) (tl (tl V1657))))) ((cons? V1657) (cons cons (cons (hd V1657) (cons (shen.cons_form (tl V1657)) ())))) (true (shen.sys-error shen.cons_form))))
214
-
215
- (defun shen.package-macro (V1660 V1661) (cond ((and (cons? V1660) (and (= $ (hd V1660)) (and (cons? (tl V1660)) (= () (tl (tl V1660)))))) (append (explode (hd (tl V1660))) V1661)) ((and (cons? V1660) (and (= package (hd V1660)) (and (cons? (tl V1660)) (and (= null (hd (tl V1660))) (cons? (tl (tl V1660))))))) (append (tl (tl (tl V1660))) V1661)) ((and (cons? V1660) (and (= package (hd V1660)) (and (cons? (tl V1660)) (cons? (tl (tl V1660)))))) (let ListofExceptions (shen.eval-without-macros (hd (tl (tl V1660)))) (let Record (shen.record-exceptions ListofExceptions (hd (tl V1660))) (let PackageNameDot (intern (cn (str (hd (tl V1660))) ".")) (append (shen.packageh PackageNameDot ListofExceptions (tl (tl (tl V1660)))) V1661))))) (true (cons V1660 V1661))))
216
-
217
- (defun shen.record-exceptions (V1662 V1663) (let CurrExceptions (trap-error (get V1663 shen.external-symbols (value *property-vector*)) (lambda E ())) (let AllExceptions (union V1662 CurrExceptions) (put V1663 shen.external-symbols AllExceptions (value *property-vector*)))))
218
-
219
- (defun shen.packageh (V1672 V1673 V1674) (cond ((cons? V1674) (cons (shen.packageh V1672 V1673 (hd V1674)) (shen.packageh V1672 V1673 (tl V1674)))) ((or (shen.sysfunc? V1674) (or (variable? V1674) (or (element? V1674 V1673) (or (shen.doubleunderline? V1674) (shen.singleunderline? V1674))))) V1674) ((and (symbol? V1674) (not (shen.prefix? (cons "s" (cons "h" (cons "e" (cons "n" (cons "." ()))))) (explode V1674)))) (concat V1672 V1674)) (true V1674)))
220
-
221
-
222
-
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 read-file-as-bytelist (V1348) (let Stream (open V1348 in) (let Byte (read-byte Stream) (let Bytes (shen.read-file-as-bytelist-help Stream Byte ()) (let Close (close Stream) (reverse Bytes))))))
51
+
52
+ (defun shen.read-file-as-bytelist-help (V1349 V1350 V1351) (cond ((= -1 V1350) V1351) (true (shen.read-file-as-bytelist-help V1349 (read-byte V1349) (cons V1350 V1351)))))
53
+
54
+ (defun read-file-as-string (V1352) (let Stream (open V1352 in) (shen.rfas-h Stream (read-byte Stream) "")))
55
+
56
+ (defun shen.rfas-h (V1353 V1354 V1355) (cond ((= -1 V1354) (do (close V1353) V1355)) (true (shen.rfas-h V1353 (read-byte V1353) (cn V1355 (n->string V1354))))))
57
+
58
+ (defun input (V1356) (eval-kl (read V1356)))
59
+
60
+ (defun input+ (V1357 V1358) (let Mono? (shen.monotype V1357) (let Input (read V1358) (if (= false (shen.typecheck Input (shen.demodulate V1357))) (simple-error (cn "type error: " (shen.app Input (cn " is not of type " (shen.app V1357 "
61
+ " shen.r)) shen.r))) (eval-kl Input)))))
62
+
63
+ (defun shen.monotype (V1359) (cond ((cons? V1359) (map (lambda X1337 (shen.monotype X1337)) V1359)) (true (if (variable? V1359) (simple-error (cn "input+ expects a monotype: not " (shen.app V1359 "
64
+ " shen.a))) V1359))))
65
+
66
+ (defun read (V1360) (hd (shen.read-loop V1360 (read-byte V1360) ())))
67
+
68
+ (defun it () (value shen.*it*))
69
+
70
+ (defun shen.read-loop (V1365 V1366 V1367) (cond ((= 94 V1366) (simple-error "read aborted")) ((= -1 V1366) (if (empty? V1367) (simple-error "error: empty stream") (compile (lambda X1338 (shen.<st_input> X1338)) V1367 (lambda E E)))) ((shen.terminator? V1366) (let AllBytes (append V1367 (cons V1366 ())) (let It (shen.record-it AllBytes) (let Read (compile (lambda X1339 (shen.<st_input> X1339)) AllBytes (lambda E shen.nextbyte)) (if (or (= Read shen.nextbyte) (empty? Read)) (shen.read-loop V1365 (read-byte V1365) AllBytes) Read))))) (true (shen.read-loop V1365 (read-byte V1365) (append V1367 (cons V1366 ()))))))
71
+
72
+ (defun shen.terminator? (V1368) (element? V1368 (cons 9 (cons 10 (cons 13 (cons 32 (cons 34 (cons 41 (cons 93 ())))))))))
73
+
74
+ (defun lineread (V1369) (shen.lineread-loop (read-byte V1369) () V1369))
75
+
76
+ (defun shen.lineread-loop (V1371 V1372 V1373) (cond ((= -1 V1371) (if (empty? V1372) (simple-error "empty stream") (compile (lambda X1340 (shen.<st_input> X1340)) V1372 (lambda E E)))) ((= V1371 (shen.hat)) (simple-error "line read aborted")) ((element? V1371 (cons (shen.newline) (cons (shen.carriage-return) ()))) (let Line (compile (lambda X1341 (shen.<st_input> X1341)) V1372 (lambda E shen.nextline)) (let It (shen.record-it V1372) (if (or (= Line shen.nextline) (empty? Line)) (shen.lineread-loop (read-byte V1373) (append V1372 (cons V1371 ())) V1373) Line)))) (true (shen.lineread-loop (read-byte V1373) (append V1372 (cons V1371 ())) V1373))))
77
+
78
+ (defun shen.record-it (V1374) (let TrimLeft (shen.trim-whitespace V1374) (let TrimRight (shen.trim-whitespace (reverse TrimLeft)) (let Trimmed (reverse TrimRight) (shen.record-it-h Trimmed)))))
79
+
80
+ (defun shen.trim-whitespace (V1375) (cond ((and (cons? V1375) (element? (hd V1375) (cons 9 (cons 10 (cons 13 (cons 32 ())))))) (shen.trim-whitespace (tl V1375))) (true V1375)))
81
+
82
+ (defun shen.record-it-h (V1376) (do (set shen.*it* (shen.cn-all (map (lambda X1342 (n->string X1342)) V1376))) V1376))
83
+
84
+ (defun shen.cn-all (V1377) (cond ((= () V1377) "") ((cons? V1377) (cn (hd V1377) (shen.cn-all (tl V1377)))) (true (shen.sys-error shen.cn-all))))
85
+
86
+ (defun read-file (V1378) (let Bytelist (read-file-as-bytelist V1378) (compile (lambda X1343 (shen.<st_input> X1343)) Bytelist (lambda X1344 (shen.read-error X1344)))))
87
+
88
+ (defun read-from-string (V1379) (let Ns (map (lambda X1345 (string->n X1345)) (explode V1379)) (compile (lambda X1346 (shen.<st_input> X1346)) Ns (lambda X1347 (shen.read-error X1347)))))
89
+
90
+ (defun shen.read-error (V1386) (cond ((and (cons? V1386) (and (cons? (hd V1386)) (and (cons? (tl V1386)) (= () (tl (tl V1386)))))) (simple-error (cn "read error here:
91
+
92
+ " (shen.app (shen.compress-50 50 (hd V1386)) "
93
+ " shen.a)))) (true (simple-error "read error
94
+ "))))
95
+
96
+ (defun shen.compress-50 (V1391 V1392) (cond ((= () V1392) "") ((= 0 V1391) "") ((cons? V1392) (cn (n->string (hd V1392)) (shen.compress-50 (- V1391 1) (tl V1392)))) (true (shen.sys-error shen.compress-50))))
97
+
98
+ (defun shen.<st_input> (V1397) (let Result (let Parse_shen.<lsb> (shen.<lsb> V1397) (if (not (= (fail) Parse_shen.<lsb>)) (let Parse_shen.<st_input1> (shen.<st_input1> Parse_shen.<lsb>) (if (not (= (fail) Parse_shen.<st_input1>)) (let Parse_shen.<rsb> (shen.<rsb> Parse_shen.<st_input1>) (if (not (= (fail) Parse_shen.<rsb>)) (let Parse_shen.<st_input2> (shen.<st_input2> Parse_shen.<rsb>) (if (not (= (fail) Parse_shen.<st_input2>)) (shen.pair (hd Parse_shen.<st_input2>) (cons (macroexpand (shen.cons_form (shen.hdtl Parse_shen.<st_input1>))) (shen.hdtl Parse_shen.<st_input2>))) (fail))) (fail))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<lrb> (shen.<lrb> V1397) (if (not (= (fail) Parse_shen.<lrb>)) (let Parse_shen.<st_input1> (shen.<st_input1> Parse_shen.<lrb>) (if (not (= (fail) Parse_shen.<st_input1>)) (let Parse_shen.<rrb> (shen.<rrb> Parse_shen.<st_input1>) (if (not (= (fail) Parse_shen.<rrb>)) (let Parse_shen.<st_input2> (shen.<st_input2> Parse_shen.<rrb>) (if (not (= (fail) Parse_shen.<st_input2>)) (shen.pair (hd Parse_shen.<st_input2>) (shen.package-macro (macroexpand (shen.hdtl Parse_shen.<st_input1>)) (shen.hdtl Parse_shen.<st_input2>))) (fail))) (fail))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<lcurly> (shen.<lcurly> V1397) (if (not (= (fail) Parse_shen.<lcurly>)) (let Parse_shen.<st_input> (shen.<st_input> Parse_shen.<lcurly>) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (cons { (shen.hdtl Parse_shen.<st_input>))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<rcurly> (shen.<rcurly> V1397) (if (not (= (fail) Parse_shen.<rcurly>)) (let Parse_shen.<st_input> (shen.<st_input> Parse_shen.<rcurly>) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (cons } (shen.hdtl Parse_shen.<st_input>))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<bar> (shen.<bar> V1397) (if (not (= (fail) Parse_shen.<bar>)) (let Parse_shen.<st_input> (shen.<st_input> Parse_shen.<bar>) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (cons bar! (shen.hdtl Parse_shen.<st_input>))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<semicolon> (shen.<semicolon> V1397) (if (not (= (fail) Parse_shen.<semicolon>)) (let Parse_shen.<st_input> (shen.<st_input> Parse_shen.<semicolon>) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (cons ; (shen.hdtl Parse_shen.<st_input>))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<colon> (shen.<colon> V1397) (if (not (= (fail) Parse_shen.<colon>)) (let Parse_shen.<equal> (shen.<equal> Parse_shen.<colon>) (if (not (= (fail) Parse_shen.<equal>)) (let Parse_shen.<st_input> (shen.<st_input> Parse_shen.<equal>) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (cons := (shen.hdtl Parse_shen.<st_input>))) (fail))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<colon> (shen.<colon> V1397) (if (not (= (fail) Parse_shen.<colon>)) (let Parse_shen.<minus> (shen.<minus> Parse_shen.<colon>) (if (not (= (fail) Parse_shen.<minus>)) (let Parse_shen.<st_input> (shen.<st_input> Parse_shen.<minus>) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (cons :- (shen.hdtl Parse_shen.<st_input>))) (fail))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<colon> (shen.<colon> V1397) (if (not (= (fail) Parse_shen.<colon>)) (let Parse_shen.<st_input> (shen.<st_input> Parse_shen.<colon>) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (cons : (shen.hdtl Parse_shen.<st_input>))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<comma> (shen.<comma> V1397) (if (not (= (fail) Parse_shen.<comma>)) (let Parse_shen.<st_input> (shen.<st_input> Parse_shen.<comma>) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (cons (intern ",") (shen.hdtl Parse_shen.<st_input>))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<comment> (shen.<comment> V1397) (if (not (= (fail) Parse_shen.<comment>)) (let Parse_shen.<st_input> (shen.<st_input> Parse_shen.<comment>) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (shen.hdtl Parse_shen.<st_input>)) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<atom> (shen.<atom> V1397) (if (not (= (fail) Parse_shen.<atom>)) (let Parse_shen.<st_input> (shen.<st_input> Parse_shen.<atom>) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (cons (macroexpand (shen.hdtl Parse_shen.<atom>)) (shen.hdtl Parse_shen.<st_input>))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<whitespaces> (shen.<whitespaces> V1397) (if (not (= (fail) Parse_shen.<whitespaces>)) (let Parse_shen.<st_input> (shen.<st_input> Parse_shen.<whitespaces>) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (shen.hdtl Parse_shen.<st_input>)) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_<e> (<e> V1397) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) ()) (fail))) (if (= Result (fail)) (fail) Result)) Result)) Result)) Result)) Result)) Result)) Result)) Result)) Result)) Result)) Result)) Result)) Result)) Result)))
99
+
100
+ (defun shen.<lsb> (V1402) (let Result (if (and (cons? (hd V1402)) (= 91 (hd (hd V1402)))) (shen.pair (hd (shen.pair (tl (hd V1402)) (shen.hdtl V1402))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
101
+
102
+ (defun shen.<rsb> (V1407) (let Result (if (and (cons? (hd V1407)) (= 93 (hd (hd V1407)))) (shen.pair (hd (shen.pair (tl (hd V1407)) (shen.hdtl V1407))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
103
+
104
+ (defun shen.<lcurly> (V1412) (let Result (if (and (cons? (hd V1412)) (= 123 (hd (hd V1412)))) (shen.pair (hd (shen.pair (tl (hd V1412)) (shen.hdtl V1412))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
105
+
106
+ (defun shen.<rcurly> (V1417) (let Result (if (and (cons? (hd V1417)) (= 125 (hd (hd V1417)))) (shen.pair (hd (shen.pair (tl (hd V1417)) (shen.hdtl V1417))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
107
+
108
+ (defun shen.<bar> (V1422) (let Result (if (and (cons? (hd V1422)) (= 124 (hd (hd V1422)))) (shen.pair (hd (shen.pair (tl (hd V1422)) (shen.hdtl V1422))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
109
+
110
+ (defun shen.<semicolon> (V1427) (let Result (if (and (cons? (hd V1427)) (= 59 (hd (hd V1427)))) (shen.pair (hd (shen.pair (tl (hd V1427)) (shen.hdtl V1427))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
111
+
112
+ (defun shen.<colon> (V1432) (let Result (if (and (cons? (hd V1432)) (= 58 (hd (hd V1432)))) (shen.pair (hd (shen.pair (tl (hd V1432)) (shen.hdtl V1432))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
113
+
114
+ (defun shen.<comma> (V1437) (let Result (if (and (cons? (hd V1437)) (= 44 (hd (hd V1437)))) (shen.pair (hd (shen.pair (tl (hd V1437)) (shen.hdtl V1437))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
115
+
116
+ (defun shen.<equal> (V1442) (let Result (if (and (cons? (hd V1442)) (= 61 (hd (hd V1442)))) (shen.pair (hd (shen.pair (tl (hd V1442)) (shen.hdtl V1442))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
117
+
118
+ (defun shen.<minus> (V1447) (let Result (if (and (cons? (hd V1447)) (= 45 (hd (hd V1447)))) (shen.pair (hd (shen.pair (tl (hd V1447)) (shen.hdtl V1447))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
119
+
120
+ (defun shen.<lrb> (V1452) (let Result (if (and (cons? (hd V1452)) (= 40 (hd (hd V1452)))) (shen.pair (hd (shen.pair (tl (hd V1452)) (shen.hdtl V1452))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
121
+
122
+ (defun shen.<rrb> (V1457) (let Result (if (and (cons? (hd V1457)) (= 41 (hd (hd V1457)))) (shen.pair (hd (shen.pair (tl (hd V1457)) (shen.hdtl V1457))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
123
+
124
+ (defun shen.<atom> (V1462) (let Result (let Parse_shen.<str> (shen.<str> V1462) (if (not (= (fail) Parse_shen.<str>)) (shen.pair (hd Parse_shen.<str>) (shen.control-chars (shen.hdtl Parse_shen.<str>))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<number> (shen.<number> V1462) (if (not (= (fail) Parse_shen.<number>)) (shen.pair (hd Parse_shen.<number>) (shen.hdtl Parse_shen.<number>)) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<sym> (shen.<sym> V1462) (if (not (= (fail) Parse_shen.<sym>)) (shen.pair (hd Parse_shen.<sym>) (if (= (shen.hdtl Parse_shen.<sym>) "<>") (cons vector (cons 0 ())) (intern (shen.hdtl Parse_shen.<sym>)))) (fail))) (if (= Result (fail)) (fail) Result)) Result)) Result)))
125
+
126
+ (defun shen.control-chars (V1463) (cond ((= () V1463) "") ((and (cons? V1463) (and (= "c" (hd V1463)) (and (cons? (tl V1463)) (= "#" (hd (tl V1463)))))) (let CodePoint (shen.code-point (tl (tl V1463))) (let AfterCodePoint (shen.after-codepoint (tl (tl V1463))) (@s (n->string (shen.decimalise CodePoint)) (shen.control-chars AfterCodePoint))))) ((cons? V1463) (@s (hd V1463) (shen.control-chars (tl V1463)))) (true (shen.sys-error shen.control-chars))))
127
+
128
+ (defun shen.code-point (V1466) (cond ((and (cons? V1466) (= ";" (hd V1466))) "") ((and (cons? V1466) (element? (hd V1466) (cons "0" (cons "1" (cons "2" (cons "3" (cons "4" (cons "5" (cons "6" (cons "7" (cons "8" (cons "9" (cons "0" ()))))))))))))) (cons (hd V1466) (shen.code-point (tl V1466)))) (true (simple-error (cn "code point parse error " (shen.app V1466 "
129
+ " shen.a))))))
130
+
131
+ (defun shen.after-codepoint (V1471) (cond ((= () V1471) ()) ((and (cons? V1471) (= ";" (hd V1471))) (tl V1471)) ((cons? V1471) (shen.after-codepoint (tl V1471))) (true (shen.sys-error shen.after-codepoint))))
132
+
133
+ (defun shen.decimalise (V1472) (shen.pre (reverse (shen.digits->integers V1472)) 0))
134
+
135
+ (defun shen.digits->integers (V1477) (cond ((and (cons? V1477) (= "0" (hd V1477))) (cons 0 (shen.digits->integers (tl V1477)))) ((and (cons? V1477) (= "1" (hd V1477))) (cons 1 (shen.digits->integers (tl V1477)))) ((and (cons? V1477) (= "2" (hd V1477))) (cons 2 (shen.digits->integers (tl V1477)))) ((and (cons? V1477) (= "3" (hd V1477))) (cons 3 (shen.digits->integers (tl V1477)))) ((and (cons? V1477) (= "4" (hd V1477))) (cons 4 (shen.digits->integers (tl V1477)))) ((and (cons? V1477) (= "5" (hd V1477))) (cons 5 (shen.digits->integers (tl V1477)))) ((and (cons? V1477) (= "6" (hd V1477))) (cons 6 (shen.digits->integers (tl V1477)))) ((and (cons? V1477) (= "7" (hd V1477))) (cons 7 (shen.digits->integers (tl V1477)))) ((and (cons? V1477) (= "8" (hd V1477))) (cons 8 (shen.digits->integers (tl V1477)))) ((and (cons? V1477) (= "9" (hd V1477))) (cons 9 (shen.digits->integers (tl V1477)))) (true ())))
136
+
137
+ (defun shen.<sym> (V1482) (let Result (let Parse_shen.<alpha> (shen.<alpha> V1482) (if (not (= (fail) Parse_shen.<alpha>)) (let Parse_shen.<alphanums> (shen.<alphanums> Parse_shen.<alpha>) (if (not (= (fail) Parse_shen.<alphanums>)) (shen.pair (hd Parse_shen.<alphanums>) (@s (shen.hdtl Parse_shen.<alpha>) (shen.hdtl Parse_shen.<alphanums>))) (fail))) (fail))) (if (= Result (fail)) (fail) Result)))
138
+
139
+ (defun shen.<alphanums> (V1487) (let Result (let Parse_shen.<alphanum> (shen.<alphanum> V1487) (if (not (= (fail) Parse_shen.<alphanum>)) (let Parse_shen.<alphanums> (shen.<alphanums> Parse_shen.<alphanum>) (if (not (= (fail) Parse_shen.<alphanums>)) (shen.pair (hd Parse_shen.<alphanums>) (@s (shen.hdtl Parse_shen.<alphanum>) (shen.hdtl Parse_shen.<alphanums>))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_<e> (<e> V1487) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) "") (fail))) (if (= Result (fail)) (fail) Result)) Result)))
140
+
141
+ (defun shen.<alphanum> (V1492) (let Result (let Parse_shen.<alpha> (shen.<alpha> V1492) (if (not (= (fail) Parse_shen.<alpha>)) (shen.pair (hd Parse_shen.<alpha>) (shen.hdtl Parse_shen.<alpha>)) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<num> (shen.<num> V1492) (if (not (= (fail) Parse_shen.<num>)) (shen.pair (hd Parse_shen.<num>) (shen.hdtl Parse_shen.<num>)) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
142
+
143
+ (defun shen.<num> (V1497) (let Result (if (cons? (hd V1497)) (let Parse_Byte (hd (hd V1497)) (if (shen.numbyte? Parse_Byte) (shen.pair (hd (shen.pair (tl (hd V1497)) (shen.hdtl V1497))) (n->string Parse_Byte)) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
144
+
145
+ (defun shen.numbyte? (V1502) (cond ((= 48 V1502) true) ((= 49 V1502) true) ((= 50 V1502) true) ((= 51 V1502) true) ((= 52 V1502) true) ((= 53 V1502) true) ((= 54 V1502) true) ((= 55 V1502) true) ((= 56 V1502) true) ((= 57 V1502) true) (true false)))
146
+
147
+ (defun shen.<alpha> (V1507) (let Result (if (cons? (hd V1507)) (let Parse_Byte (hd (hd V1507)) (if (shen.symbol-code? Parse_Byte) (shen.pair (hd (shen.pair (tl (hd V1507)) (shen.hdtl V1507))) (n->string Parse_Byte)) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
148
+
149
+ (defun shen.symbol-code? (V1508) (or (= V1508 126) (or (and (> V1508 94) (< V1508 123)) (or (and (> V1508 59) (< V1508 91)) (or (and (> V1508 41) (and (< V1508 58) (not (= V1508 44)))) (or (and (> V1508 34) (< V1508 40)) (= V1508 33)))))))
150
+
151
+ (defun shen.<str> (V1513) (let Result (let Parse_shen.<dbq> (shen.<dbq> V1513) (if (not (= (fail) Parse_shen.<dbq>)) (let Parse_shen.<strcontents> (shen.<strcontents> Parse_shen.<dbq>) (if (not (= (fail) Parse_shen.<strcontents>)) (let Parse_shen.<dbq> (shen.<dbq> Parse_shen.<strcontents>) (if (not (= (fail) Parse_shen.<dbq>)) (shen.pair (hd Parse_shen.<dbq>) (shen.hdtl Parse_shen.<strcontents>)) (fail))) (fail))) (fail))) (if (= Result (fail)) (fail) Result)))
152
+
153
+ (defun shen.<dbq> (V1518) (let Result (if (cons? (hd V1518)) (let Parse_Byte (hd (hd V1518)) (if (= Parse_Byte 34) (shen.pair (hd (shen.pair (tl (hd V1518)) (shen.hdtl V1518))) Parse_Byte) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
154
+
155
+ (defun shen.<strcontents> (V1523) (let Result (let Parse_shen.<strc> (shen.<strc> V1523) (if (not (= (fail) Parse_shen.<strc>)) (let Parse_shen.<strcontents> (shen.<strcontents> Parse_shen.<strc>) (if (not (= (fail) Parse_shen.<strcontents>)) (shen.pair (hd Parse_shen.<strcontents>) (cons (shen.hdtl Parse_shen.<strc>) (shen.hdtl Parse_shen.<strcontents>))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_<e> (<e> V1523) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) ()) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
156
+
157
+ (defun shen.<byte> (V1528) (let Result (if (cons? (hd V1528)) (let Parse_Byte (hd (hd V1528)) (shen.pair (hd (shen.pair (tl (hd V1528)) (shen.hdtl V1528))) (n->string Parse_Byte))) (fail)) (if (= Result (fail)) (fail) Result)))
158
+
159
+ (defun shen.<strc> (V1533) (let Result (if (cons? (hd V1533)) (let Parse_Byte (hd (hd V1533)) (if (not (= Parse_Byte 34)) (shen.pair (hd (shen.pair (tl (hd V1533)) (shen.hdtl V1533))) (n->string Parse_Byte)) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
160
+
161
+ (defun shen.<number> (V1538) (let Result (let Parse_shen.<minus> (shen.<minus> V1538) (if (not (= (fail) Parse_shen.<minus>)) (let Parse_shen.<number> (shen.<number> Parse_shen.<minus>) (if (not (= (fail) Parse_shen.<number>)) (shen.pair (hd Parse_shen.<number>) (- 0 (shen.hdtl Parse_shen.<number>))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<plus> (shen.<plus> V1538) (if (not (= (fail) Parse_shen.<plus>)) (let Parse_shen.<number> (shen.<number> Parse_shen.<plus>) (if (not (= (fail) Parse_shen.<number>)) (shen.pair (hd Parse_shen.<number>) (shen.hdtl Parse_shen.<number>)) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<predigits> (shen.<predigits> V1538) (if (not (= (fail) Parse_shen.<predigits>)) (let Parse_shen.<stop> (shen.<stop> Parse_shen.<predigits>) (if (not (= (fail) Parse_shen.<stop>)) (let Parse_shen.<postdigits> (shen.<postdigits> Parse_shen.<stop>) (if (not (= (fail) Parse_shen.<postdigits>)) (let Parse_shen.<E> (shen.<E> Parse_shen.<postdigits>) (if (not (= (fail) Parse_shen.<E>)) (let Parse_shen.<log10> (shen.<log10> Parse_shen.<E>) (if (not (= (fail) Parse_shen.<log10>)) (shen.pair (hd Parse_shen.<log10>) (* (shen.expt 10 (shen.hdtl Parse_shen.<log10>)) (+ (shen.pre (reverse (shen.hdtl Parse_shen.<predigits>)) 0) (shen.post (shen.hdtl Parse_shen.<postdigits>) 1)))) (fail))) (fail))) (fail))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<digits> (shen.<digits> V1538) (if (not (= (fail) Parse_shen.<digits>)) (let Parse_shen.<E> (shen.<E> Parse_shen.<digits>) (if (not (= (fail) Parse_shen.<E>)) (let Parse_shen.<log10> (shen.<log10> Parse_shen.<E>) (if (not (= (fail) Parse_shen.<log10>)) (shen.pair (hd Parse_shen.<log10>) (* (shen.expt 10 (shen.hdtl Parse_shen.<log10>)) (shen.pre (reverse (shen.hdtl Parse_shen.<digits>)) 0))) (fail))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<predigits> (shen.<predigits> V1538) (if (not (= (fail) Parse_shen.<predigits>)) (let Parse_shen.<stop> (shen.<stop> Parse_shen.<predigits>) (if (not (= (fail) Parse_shen.<stop>)) (let Parse_shen.<postdigits> (shen.<postdigits> Parse_shen.<stop>) (if (not (= (fail) Parse_shen.<postdigits>)) (shen.pair (hd Parse_shen.<postdigits>) (+ (shen.pre (reverse (shen.hdtl Parse_shen.<predigits>)) 0) (shen.post (shen.hdtl Parse_shen.<postdigits>) 1))) (fail))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<digits> (shen.<digits> V1538) (if (not (= (fail) Parse_shen.<digits>)) (shen.pair (hd Parse_shen.<digits>) (shen.pre (reverse (shen.hdtl Parse_shen.<digits>)) 0)) (fail))) (if (= Result (fail)) (fail) Result)) Result)) Result)) Result)) Result)) Result)))
162
+
163
+ (defun shen.<E> (V1543) (let Result (if (and (cons? (hd V1543)) (= 101 (hd (hd V1543)))) (shen.pair (hd (shen.pair (tl (hd V1543)) (shen.hdtl V1543))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
164
+
165
+ (defun shen.<log10> (V1548) (let Result (let Parse_shen.<minus> (shen.<minus> V1548) (if (not (= (fail) Parse_shen.<minus>)) (let Parse_shen.<digits> (shen.<digits> Parse_shen.<minus>) (if (not (= (fail) Parse_shen.<digits>)) (shen.pair (hd Parse_shen.<digits>) (- 0 (shen.pre (reverse (shen.hdtl Parse_shen.<digits>)) 0))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<digits> (shen.<digits> V1548) (if (not (= (fail) Parse_shen.<digits>)) (shen.pair (hd Parse_shen.<digits>) (shen.pre (reverse (shen.hdtl Parse_shen.<digits>)) 0)) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
166
+
167
+ (defun shen.<plus> (V1553) (let Result (if (cons? (hd V1553)) (let Parse_Byte (hd (hd V1553)) (if (= Parse_Byte 43) (shen.pair (hd (shen.pair (tl (hd V1553)) (shen.hdtl V1553))) Parse_Byte) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
168
+
169
+ (defun shen.<stop> (V1558) (let Result (if (cons? (hd V1558)) (let Parse_Byte (hd (hd V1558)) (if (= Parse_Byte 46) (shen.pair (hd (shen.pair (tl (hd V1558)) (shen.hdtl V1558))) Parse_Byte) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
170
+
171
+ (defun shen.<predigits> (V1563) (let Result (let Parse_shen.<digits> (shen.<digits> V1563) (if (not (= (fail) Parse_shen.<digits>)) (shen.pair (hd Parse_shen.<digits>) (shen.hdtl Parse_shen.<digits>)) (fail))) (if (= Result (fail)) (let Result (let Parse_<e> (<e> V1563) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) ()) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
172
+
173
+ (defun shen.<postdigits> (V1568) (let Result (let Parse_shen.<digits> (shen.<digits> V1568) (if (not (= (fail) Parse_shen.<digits>)) (shen.pair (hd Parse_shen.<digits>) (shen.hdtl Parse_shen.<digits>)) (fail))) (if (= Result (fail)) (fail) Result)))
174
+
175
+ (defun shen.<digits> (V1573) (let Result (let Parse_shen.<digit> (shen.<digit> V1573) (if (not (= (fail) Parse_shen.<digit>)) (let Parse_shen.<digits> (shen.<digits> Parse_shen.<digit>) (if (not (= (fail) Parse_shen.<digits>)) (shen.pair (hd Parse_shen.<digits>) (cons (shen.hdtl Parse_shen.<digit>) (shen.hdtl Parse_shen.<digits>))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<digit> (shen.<digit> V1573) (if (not (= (fail) Parse_shen.<digit>)) (shen.pair (hd Parse_shen.<digit>) (cons (shen.hdtl Parse_shen.<digit>) ())) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
176
+
177
+ (defun shen.<digit> (V1578) (let Result (if (cons? (hd V1578)) (let Parse_X (hd (hd V1578)) (if (shen.numbyte? Parse_X) (shen.pair (hd (shen.pair (tl (hd V1578)) (shen.hdtl V1578))) (shen.byte->digit Parse_X)) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
178
+
179
+ (defun shen.byte->digit (V1579) (cond ((= 48 V1579) 0) ((= 49 V1579) 1) ((= 50 V1579) 2) ((= 51 V1579) 3) ((= 52 V1579) 4) ((= 53 V1579) 5) ((= 54 V1579) 6) ((= 55 V1579) 7) ((= 56 V1579) 8) ((= 57 V1579) 9) (true (shen.sys-error shen.byte->digit))))
180
+
181
+ (defun shen.pre (V1582 V1583) (cond ((= () V1582) 0) ((cons? V1582) (+ (* (shen.expt 10 V1583) (hd V1582)) (shen.pre (tl V1582) (+ V1583 1)))) (true (shen.sys-error shen.pre))))
182
+
183
+ (defun shen.post (V1586 V1587) (cond ((= () V1586) 0) ((cons? V1586) (+ (* (shen.expt 10 (- 0 V1587)) (hd V1586)) (shen.post (tl V1586) (+ V1587 1)))) (true (shen.sys-error shen.post))))
184
+
185
+ (defun shen.expt (V1590 V1591) (cond ((= 0 V1591) 1) ((> V1591 0) (* V1590 (shen.expt V1590 (- V1591 1)))) (true (* 1 (/ (shen.expt V1590 (+ V1591 1)) V1590)))))
186
+
187
+ (defun shen.<st_input1> (V1596) (let Result (let Parse_shen.<st_input> (shen.<st_input> V1596) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (shen.hdtl Parse_shen.<st_input>)) (fail))) (if (= Result (fail)) (fail) Result)))
188
+
189
+ (defun shen.<st_input2> (V1601) (let Result (let Parse_shen.<st_input> (shen.<st_input> V1601) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (shen.hdtl Parse_shen.<st_input>)) (fail))) (if (= Result (fail)) (fail) Result)))
190
+
191
+ (defun shen.<comment> (V1606) (let Result (let Parse_shen.<singleline> (shen.<singleline> V1606) (if (not (= (fail) Parse_shen.<singleline>)) (shen.pair (hd Parse_shen.<singleline>) shen.skip) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<multiline> (shen.<multiline> V1606) (if (not (= (fail) Parse_shen.<multiline>)) (shen.pair (hd Parse_shen.<multiline>) shen.skip) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
192
+
193
+ (defun shen.<singleline> (V1611) (let Result (let Parse_shen.<backslash> (shen.<backslash> V1611) (if (not (= (fail) Parse_shen.<backslash>)) (let Parse_shen.<backslash> (shen.<backslash> Parse_shen.<backslash>) (if (not (= (fail) Parse_shen.<backslash>)) (let Parse_shen.<anysingle> (shen.<anysingle> Parse_shen.<backslash>) (if (not (= (fail) Parse_shen.<anysingle>)) (let Parse_shen.<return> (shen.<return> Parse_shen.<anysingle>) (if (not (= (fail) Parse_shen.<return>)) (shen.pair (hd Parse_shen.<return>) shen.skip) (fail))) (fail))) (fail))) (fail))) (if (= Result (fail)) (fail) Result)))
194
+
195
+ (defun shen.<backslash> (V1616) (let Result (if (and (cons? (hd V1616)) (= 92 (hd (hd V1616)))) (shen.pair (hd (shen.pair (tl (hd V1616)) (shen.hdtl V1616))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
196
+
197
+ (defun shen.<anysingle> (V1621) (let Result (let Parse_shen.<non-return> (shen.<non-return> V1621) (if (not (= (fail) Parse_shen.<non-return>)) (let Parse_shen.<anysingle> (shen.<anysingle> Parse_shen.<non-return>) (if (not (= (fail) Parse_shen.<anysingle>)) (shen.pair (hd Parse_shen.<anysingle>) shen.skip) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_<e> (<e> V1621) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) shen.skip) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
198
+
199
+ (defun shen.<non-return> (V1626) (let Result (if (cons? (hd V1626)) (let Parse_X (hd (hd V1626)) (if (not (element? Parse_X (cons 10 (cons 13 ())))) (shen.pair (hd (shen.pair (tl (hd V1626)) (shen.hdtl V1626))) shen.skip) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
200
+
201
+ (defun shen.<return> (V1631) (let Result (if (cons? (hd V1631)) (let Parse_X (hd (hd V1631)) (if (element? Parse_X (cons 10 (cons 13 ()))) (shen.pair (hd (shen.pair (tl (hd V1631)) (shen.hdtl V1631))) shen.skip) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
202
+
203
+ (defun shen.<multiline> (V1636) (let Result (let Parse_shen.<backslash> (shen.<backslash> V1636) (if (not (= (fail) Parse_shen.<backslash>)) (let Parse_shen.<times> (shen.<times> Parse_shen.<backslash>) (if (not (= (fail) Parse_shen.<times>)) (let Parse_shen.<anymulti> (shen.<anymulti> Parse_shen.<times>) (if (not (= (fail) Parse_shen.<anymulti>)) (shen.pair (hd Parse_shen.<anymulti>) shen.skip) (fail))) (fail))) (fail))) (if (= Result (fail)) (fail) Result)))
204
+
205
+ (defun shen.<times> (V1641) (let Result (if (and (cons? (hd V1641)) (= 42 (hd (hd V1641)))) (shen.pair (hd (shen.pair (tl (hd V1641)) (shen.hdtl V1641))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
206
+
207
+ (defun shen.<anymulti> (V1646) (let Result (let Parse_shen.<comment> (shen.<comment> V1646) (if (not (= (fail) Parse_shen.<comment>)) (let Parse_shen.<anymulti> (shen.<anymulti> Parse_shen.<comment>) (if (not (= (fail) Parse_shen.<anymulti>)) (shen.pair (hd Parse_shen.<anymulti>) shen.skip) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<times> (shen.<times> V1646) (if (not (= (fail) Parse_shen.<times>)) (let Parse_shen.<backslash> (shen.<backslash> Parse_shen.<times>) (if (not (= (fail) Parse_shen.<backslash>)) (shen.pair (hd Parse_shen.<backslash>) shen.skip) (fail))) (fail))) (if (= Result (fail)) (let Result (if (cons? (hd V1646)) (let Parse_X (hd (hd V1646)) (let Parse_shen.<anymulti> (shen.<anymulti> (shen.pair (tl (hd V1646)) (shen.hdtl V1646))) (if (not (= (fail) Parse_shen.<anymulti>)) (shen.pair (hd Parse_shen.<anymulti>) shen.skip) (fail)))) (fail)) (if (= Result (fail)) (fail) Result)) Result)) Result)))
208
+
209
+ (defun shen.<whitespaces> (V1651) (let Result (let Parse_shen.<whitespace> (shen.<whitespace> V1651) (if (not (= (fail) Parse_shen.<whitespace>)) (let Parse_shen.<whitespaces> (shen.<whitespaces> Parse_shen.<whitespace>) (if (not (= (fail) Parse_shen.<whitespaces>)) (shen.pair (hd Parse_shen.<whitespaces>) shen.skip) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<whitespace> (shen.<whitespace> V1651) (if (not (= (fail) Parse_shen.<whitespace>)) (shen.pair (hd Parse_shen.<whitespace>) shen.skip) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
210
+
211
+ (defun shen.<whitespace> (V1656) (let Result (if (cons? (hd V1656)) (let Parse_X (hd (hd V1656)) (if (let Parse_Case Parse_X (or (= Parse_Case 32) (or (= Parse_Case 13) (or (= Parse_Case 10) (= Parse_Case 9))))) (shen.pair (hd (shen.pair (tl (hd V1656)) (shen.hdtl V1656))) shen.skip) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
212
+
213
+ (defun shen.cons_form (V1657) (cond ((= () V1657) ()) ((and (cons? V1657) (and (cons? (tl V1657)) (and (cons? (tl (tl V1657))) (and (= () (tl (tl (tl V1657)))) (= (hd (tl V1657)) bar!))))) (cons cons (cons (hd V1657) (tl (tl V1657))))) ((cons? V1657) (cons cons (cons (hd V1657) (cons (shen.cons_form (tl V1657)) ())))) (true (shen.sys-error shen.cons_form))))
214
+
215
+ (defun shen.package-macro (V1660 V1661) (cond ((and (cons? V1660) (and (= $ (hd V1660)) (and (cons? (tl V1660)) (= () (tl (tl V1660)))))) (append (explode (hd (tl V1660))) V1661)) ((and (cons? V1660) (and (= package (hd V1660)) (and (cons? (tl V1660)) (and (= null (hd (tl V1660))) (cons? (tl (tl V1660))))))) (append (tl (tl (tl V1660))) V1661)) ((and (cons? V1660) (and (= package (hd V1660)) (and (cons? (tl V1660)) (cons? (tl (tl V1660)))))) (let ListofExceptions (shen.eval-without-macros (hd (tl (tl V1660)))) (let Record (shen.record-exceptions ListofExceptions (hd (tl V1660))) (let PackageNameDot (intern (cn (str (hd (tl V1660))) ".")) (append (shen.packageh PackageNameDot ListofExceptions (tl (tl (tl V1660)))) V1661))))) (true (cons V1660 V1661))))
216
+
217
+ (defun shen.record-exceptions (V1662 V1663) (let CurrExceptions (trap-error (get V1663 shen.external-symbols (value *property-vector*)) (lambda E ())) (let AllExceptions (union V1662 CurrExceptions) (put V1663 shen.external-symbols AllExceptions (value *property-vector*)))))
218
+
219
+ (defun shen.packageh (V1672 V1673 V1674) (cond ((cons? V1674) (cons (shen.packageh V1672 V1673 (hd V1674)) (shen.packageh V1672 V1673 (tl V1674)))) ((or (shen.sysfunc? V1674) (or (variable? V1674) (or (element? V1674 V1673) (or (shen.doubleunderline? V1674) (shen.singleunderline? V1674))))) V1674) ((and (symbol? V1674) (not (shen.prefix? (cons "s" (cons "h" (cons "e" (cons "n" (cons "." ()))))) (explode V1674)))) (concat V1672 V1674)) (true V1674)))
220
+
221
+
222
+
data/shen/release/k_lambda/sequent.kl CHANGED
@@ -1,166 +1,166 @@
1
- "**********************************************************************************
2
- * The License *
3
- * *
4
- * The user is free to produce commercial applications with the software, to *
5
- * distribute these applications in source or binary form, and to charge monies *
6
- * for them as he sees fit and in concordance with the laws of the land subject *
7
- * to the following license. *
8
- * *
9
- * 1. The license applies to all the software and all derived software and *
10
- * must appear on such. *
11
- * *
12
- * 2. It is illegal to distribute the software without this license attached *
13
- * to it and use of the software implies agreement with the license as such. *
14
- * It is illegal for anyone who is not the copyright holder to tamper with *
15
- * or change the license. *
16
- * *
17
- * 3. Neither the names of Lambda Associates or the copyright holder may be used *
18
- * to endorse or promote products built using the software without specific *
19
- * prior written permission from the copyright holder. *
20
- * *
21
- * 4. That possession of this license does not confer on the copyright holder *
22
- * any special contractual obligation towards the user. That in no event *
23
- * shall the copyright holder be liable for any direct, indirect, incidental, *
24
- * special, exemplary or consequential damages (including but not limited *
25
- * to procurement of substitute goods or services, loss of use, data, *
26
- * interruption), however caused and on any theory of liability, whether in *
27
- * contract, strict liability or tort (including negligence) arising in any *
28
- * way out of the use of the software, even if advised of the possibility of *
29
- * such damage. *
30
- * *
31
- * 5. It is permitted for the user to change the software, for the purpose of *
32
- * improving performance, correcting an error, or porting to a new platform, *
33
- * and distribute the derived version of Shen provided the resulting program *
34
- * conforms in all respects to the Shen standard and is issued under that *
35
- * title. The user must make it clear with his distribution that he/she is *
36
- * the author of the changes and what these changes are and why. *
37
- * *
38
- * 6. Derived versions of this software in whatever form are subject to the same *
39
- * restrictions. In particular it is not permitted to make derived copies of *
40
- * this software which do not conform to the Shen standard or appear under a *
41
- * different title. *
42
- * *
43
- * It is permitted to distribute versions of Shen which incorporate libraries, *
44
- * graphics or other facilities which are not part of the Shen standard. *
45
- * *
46
- * For an explication of this license see www.shenlanguage.org/license.htm which *
47
- * explains this license in full. *
48
- * *
49
- *****************************************************************************************
50
- "(defun shen.datatype-error (V1686) (cond ((and (cons? V1686) (and (cons? (tl V1686)) (= () (tl (tl V1686))))) (simple-error (cn "datatype syntax error here:
51
-
52
- " (shen.app (shen.next-50 50 (hd V1686)) "
53
- " shen.a)))) (true (shen.sys-error shen.datatype-error))))
54
-
55
- (defun shen.<datatype-rules> (V1691) (let Result (let Parse_shen.<datatype-rule> (shen.<datatype-rule> V1691) (if (not (= (fail) Parse_shen.<datatype-rule>)) (let Parse_shen.<datatype-rules> (shen.<datatype-rules> Parse_shen.<datatype-rule>) (if (not (= (fail) Parse_shen.<datatype-rules>)) (shen.pair (hd Parse_shen.<datatype-rules>) (cons (shen.hdtl Parse_shen.<datatype-rule>) (shen.hdtl Parse_shen.<datatype-rules>))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_<e> (<e> V1691) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) ()) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
56
-
57
- (defun shen.<datatype-rule> (V1696) (let Result (let Parse_shen.<side-conditions> (shen.<side-conditions> V1696) (if (not (= (fail) Parse_shen.<side-conditions>)) (let Parse_shen.<premises> (shen.<premises> Parse_shen.<side-conditions>) (if (not (= (fail) Parse_shen.<premises>)) (let Parse_shen.<singleunderline> (shen.<singleunderline> Parse_shen.<premises>) (if (not (= (fail) Parse_shen.<singleunderline>)) (let Parse_shen.<conclusion> (shen.<conclusion> Parse_shen.<singleunderline>) (if (not (= (fail) Parse_shen.<conclusion>)) (shen.pair (hd Parse_shen.<conclusion>) (shen.sequent shen.single (cons (shen.hdtl Parse_shen.<side-conditions>) (cons (shen.hdtl Parse_shen.<premises>) (cons (shen.hdtl Parse_shen.<conclusion>) ()))))) (fail))) (fail))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<side-conditions> (shen.<side-conditions> V1696) (if (not (= (fail) Parse_shen.<side-conditions>)) (let Parse_shen.<premises> (shen.<premises> Parse_shen.<side-conditions>) (if (not (= (fail) Parse_shen.<premises>)) (let Parse_shen.<doubleunderline> (shen.<doubleunderline> Parse_shen.<premises>) (if (not (= (fail) Parse_shen.<doubleunderline>)) (let Parse_shen.<conclusion> (shen.<conclusion> Parse_shen.<doubleunderline>) (if (not (= (fail) Parse_shen.<conclusion>)) (shen.pair (hd Parse_shen.<conclusion>) (shen.sequent shen.double (cons (shen.hdtl Parse_shen.<side-conditions>) (cons (shen.hdtl Parse_shen.<premises>) (cons (shen.hdtl Parse_shen.<conclusion>) ()))))) (fail))) (fail))) (fail))) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
58
-
59
- (defun shen.<side-conditions> (V1701) (let Result (let Parse_shen.<side-condition> (shen.<side-condition> V1701) (if (not (= (fail) Parse_shen.<side-condition>)) (let Parse_shen.<side-conditions> (shen.<side-conditions> Parse_shen.<side-condition>) (if (not (= (fail) Parse_shen.<side-conditions>)) (shen.pair (hd Parse_shen.<side-conditions>) (cons (shen.hdtl Parse_shen.<side-condition>) (shen.hdtl Parse_shen.<side-conditions>))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_<e> (<e> V1701) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) ()) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
60
-
61
- (defun shen.<side-condition> (V1706) (let Result (if (and (cons? (hd V1706)) (= if (hd (hd V1706)))) (let Parse_shen.<expr> (shen.<expr> (shen.pair (tl (hd V1706)) (shen.hdtl V1706))) (if (not (= (fail) Parse_shen.<expr>)) (shen.pair (hd Parse_shen.<expr>) (cons if (cons (shen.hdtl Parse_shen.<expr>) ()))) (fail))) (fail)) (if (= Result (fail)) (let Result (if (and (cons? (hd V1706)) (= let (hd (hd V1706)))) (let Parse_shen.<variable?> (shen.<variable?> (shen.pair (tl (hd V1706)) (shen.hdtl V1706))) (if (not (= (fail) Parse_shen.<variable?>)) (let Parse_shen.<expr> (shen.<expr> Parse_shen.<variable?>) (if (not (= (fail) Parse_shen.<expr>)) (shen.pair (hd Parse_shen.<expr>) (cons let (cons (shen.hdtl Parse_shen.<variable?>) (cons (shen.hdtl Parse_shen.<expr>) ())))) (fail))) (fail))) (fail)) (if (= Result (fail)) (fail) Result)) Result)))
62
-
63
- (defun shen.<variable?> (V1711) (let Result (if (cons? (hd V1711)) (let Parse_X (hd (hd V1711)) (if (variable? Parse_X) (shen.pair (hd (shen.pair (tl (hd V1711)) (shen.hdtl V1711))) Parse_X) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
64
-
65
- (defun shen.<expr> (V1716) (let Result (if (cons? (hd V1716)) (let Parse_X (hd (hd V1716)) (if (not (or (element? Parse_X (cons >> (cons ; ()))) (or (shen.singleunderline? Parse_X) (shen.doubleunderline? Parse_X)))) (shen.pair (hd (shen.pair (tl (hd V1716)) (shen.hdtl V1716))) (shen.remove-bar Parse_X)) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
66
-
67
- (defun shen.remove-bar (V1717) (cond ((and (cons? V1717) (and (cons? (tl V1717)) (and (cons? (tl (tl V1717))) (and (= () (tl (tl (tl V1717)))) (= (hd (tl V1717)) bar!))))) (cons (hd V1717) (hd (tl (tl V1717))))) ((cons? V1717) (cons (shen.remove-bar (hd V1717)) (shen.remove-bar (tl V1717)))) (true V1717)))
68
-
69
- (defun shen.<premises> (V1722) (let Result (let Parse_shen.<premise> (shen.<premise> V1722) (if (not (= (fail) Parse_shen.<premise>)) (let Parse_shen.<semicolon-symbol> (shen.<semicolon-symbol> Parse_shen.<premise>) (if (not (= (fail) Parse_shen.<semicolon-symbol>)) (let Parse_shen.<premises> (shen.<premises> Parse_shen.<semicolon-symbol>) (if (not (= (fail) Parse_shen.<premises>)) (shen.pair (hd Parse_shen.<premises>) (cons (shen.hdtl Parse_shen.<premise>) (shen.hdtl Parse_shen.<premises>))) (fail))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_<e> (<e> V1722) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) ()) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
70
-
71
- (defun shen.<semicolon-symbol> (V1727) (let Result (if (cons? (hd V1727)) (let Parse_X (hd (hd V1727)) (if (= Parse_X ;) (shen.pair (hd (shen.pair (tl (hd V1727)) (shen.hdtl V1727))) shen.skip) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
72
-
73
- (defun shen.<premise> (V1732) (let Result (if (and (cons? (hd V1732)) (= ! (hd (hd V1732)))) (shen.pair (hd (shen.pair (tl (hd V1732)) (shen.hdtl V1732))) !) (fail)) (if (= Result (fail)) (let Result (let Parse_shen.<formulae> (shen.<formulae> V1732) (if (not (= (fail) Parse_shen.<formulae>)) (if (and (cons? (hd Parse_shen.<formulae>)) (= >> (hd (hd Parse_shen.<formulae>)))) (let Parse_shen.<formula> (shen.<formula> (shen.pair (tl (hd Parse_shen.<formulae>)) (shen.hdtl Parse_shen.<formulae>))) (if (not (= (fail) Parse_shen.<formula>)) (shen.pair (hd Parse_shen.<formula>) (shen.sequent (shen.hdtl Parse_shen.<formulae>) (shen.hdtl Parse_shen.<formula>))) (fail))) (fail)) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<formula> (shen.<formula> V1732) (if (not (= (fail) Parse_shen.<formula>)) (shen.pair (hd Parse_shen.<formula>) (shen.sequent () (shen.hdtl Parse_shen.<formula>))) (fail))) (if (= Result (fail)) (fail) Result)) Result)) Result)))
74
-
75
- (defun shen.<conclusion> (V1737) (let Result (let Parse_shen.<formulae> (shen.<formulae> V1737) (if (not (= (fail) Parse_shen.<formulae>)) (if (and (cons? (hd Parse_shen.<formulae>)) (= >> (hd (hd Parse_shen.<formulae>)))) (let Parse_shen.<formula> (shen.<formula> (shen.pair (tl (hd Parse_shen.<formulae>)) (shen.hdtl Parse_shen.<formulae>))) (if (not (= (fail) Parse_shen.<formula>)) (let Parse_shen.<semicolon-symbol> (shen.<semicolon-symbol> Parse_shen.<formula>) (if (not (= (fail) Parse_shen.<semicolon-symbol>)) (shen.pair (hd Parse_shen.<semicolon-symbol>) (shen.sequent (shen.hdtl Parse_shen.<formulae>) (shen.hdtl Parse_shen.<formula>))) (fail))) (fail))) (fail)) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<formula> (shen.<formula> V1737) (if (not (= (fail) Parse_shen.<formula>)) (let Parse_shen.<semicolon-symbol> (shen.<semicolon-symbol> Parse_shen.<formula>) (if (not (= (fail) Parse_shen.<semicolon-symbol>)) (shen.pair (hd Parse_shen.<semicolon-symbol>) (shen.sequent () (shen.hdtl Parse_shen.<formula>))) (fail))) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
76
-
77
- (defun shen.sequent (V1738 V1739) (@p V1738 V1739))
78
-
79
- (defun shen.<formulae> (V1744) (let Result (let Parse_shen.<formula> (shen.<formula> V1744) (if (not (= (fail) Parse_shen.<formula>)) (let Parse_shen.<comma-symbol> (shen.<comma-symbol> Parse_shen.<formula>) (if (not (= (fail) Parse_shen.<comma-symbol>)) (let Parse_shen.<formulae> (shen.<formulae> Parse_shen.<comma-symbol>) (if (not (= (fail) Parse_shen.<formulae>)) (shen.pair (hd Parse_shen.<formulae>) (cons (shen.hdtl Parse_shen.<formula>) (shen.hdtl Parse_shen.<formulae>))) (fail))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<formula> (shen.<formula> V1744) (if (not (= (fail) Parse_shen.<formula>)) (shen.pair (hd Parse_shen.<formula>) (cons (shen.hdtl Parse_shen.<formula>) ())) (fail))) (if (= Result (fail)) (let Result (let Parse_<e> (<e> V1744) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) ()) (fail))) (if (= Result (fail)) (fail) Result)) Result)) Result)))
80
-
81
- (defun shen.<comma-symbol> (V1749) (let Result (if (cons? (hd V1749)) (let Parse_X (hd (hd V1749)) (if (= Parse_X (intern ",")) (shen.pair (hd (shen.pair (tl (hd V1749)) (shen.hdtl V1749))) shen.skip) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
82
-
83
- (defun shen.<formula> (V1754) (let Result (let Parse_shen.<expr> (shen.<expr> V1754) (if (not (= (fail) Parse_shen.<expr>)) (if (and (cons? (hd Parse_shen.<expr>)) (= : (hd (hd Parse_shen.<expr>)))) (let Parse_shen.<type> (shen.<type> (shen.pair (tl (hd Parse_shen.<expr>)) (shen.hdtl Parse_shen.<expr>))) (if (not (= (fail) Parse_shen.<type>)) (shen.pair (hd Parse_shen.<type>) (cons (shen.curry (shen.hdtl Parse_shen.<expr>)) (cons : (cons (shen.demodulate (shen.hdtl Parse_shen.<type>)) ())))) (fail))) (fail)) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<expr> (shen.<expr> V1754) (if (not (= (fail) Parse_shen.<expr>)) (shen.pair (hd Parse_shen.<expr>) (shen.hdtl Parse_shen.<expr>)) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
84
-
85
- (defun shen.<type> (V1759) (let Result (let Parse_shen.<expr> (shen.<expr> V1759) (if (not (= (fail) Parse_shen.<expr>)) (shen.pair (hd Parse_shen.<expr>) (shen.curry-type (shen.hdtl Parse_shen.<expr>))) (fail))) (if (= Result (fail)) (fail) Result)))
86
-
87
- (defun shen.<doubleunderline> (V1764) (let Result (if (cons? (hd V1764)) (let Parse_X (hd (hd V1764)) (if (shen.doubleunderline? Parse_X) (shen.pair (hd (shen.pair (tl (hd V1764)) (shen.hdtl V1764))) Parse_X) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
88
-
89
- (defun shen.<singleunderline> (V1769) (let Result (if (cons? (hd V1769)) (let Parse_X (hd (hd V1769)) (if (shen.singleunderline? Parse_X) (shen.pair (hd (shen.pair (tl (hd V1769)) (shen.hdtl V1769))) Parse_X) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
90
-
91
- (defun shen.singleunderline? (V1770) (and (symbol? V1770) (shen.sh? (str V1770))))
92
-
93
- (defun shen.sh? (V1771) (cond ((= "_" V1771) true) (true (and (= (pos V1771 0) "_") (shen.sh? (tlstr V1771))))))
94
-
95
- (defun shen.doubleunderline? (V1772) (and (symbol? V1772) (shen.dh? (str V1772))))
96
-
97
- (defun shen.dh? (V1773) (cond ((= "=" V1773) true) (true (and (= (pos V1773 0) "=") (shen.dh? (tlstr V1773))))))
98
-
99
- (defun shen.process-datatype (V1774 V1775) (shen.remember-datatype (shen.s-prolog (shen.rules->horn-clauses V1774 V1775))))
100
-
101
- (defun shen.remember-datatype (V1780) (cond ((cons? V1780) (do (set shen.*datatypes* (adjoin (hd V1780) (value shen.*datatypes*))) (do (set shen.*alldatatypes* (adjoin (hd V1780) (value shen.*alldatatypes*))) (hd V1780)))) (true (shen.sys-error shen.remember-datatype))))
102
-
103
- (defun shen.rules->horn-clauses (V1783 V1784) (cond ((= () V1784) ()) ((and (cons? V1784) (and (tuple? (hd V1784)) (= shen.single (fst (hd V1784))))) (cons (shen.rule->horn-clause V1783 (snd (hd V1784))) (shen.rules->horn-clauses V1783 (tl V1784)))) ((and (cons? V1784) (and (tuple? (hd V1784)) (= shen.double (fst (hd V1784))))) (shen.rules->horn-clauses V1783 (append (shen.double->singles (snd (hd V1784))) (tl V1784)))) (true (shen.sys-error shen.rules->horn-clauses))))
104
-
105
- (defun shen.double->singles (V1785) (cons (shen.right-rule V1785) (cons (shen.left-rule V1785) ())))
106
-
107
- (defun shen.right-rule (V1786) (@p shen.single V1786))
108
-
109
- (defun shen.left-rule (V1787) (cond ((and (cons? V1787) (and (cons? (tl V1787)) (and (cons? (tl (tl V1787))) (and (tuple? (hd (tl (tl V1787)))) (and (= () (fst (hd (tl (tl V1787))))) (= () (tl (tl (tl V1787))))))))) (let Q (gensym Qv) (let NewConclusion (@p (cons (snd (hd (tl (tl V1787)))) ()) Q) (let NewPremises (cons (@p (map (lambda X1675 (shen.right->left X1675)) (hd (tl V1787))) Q) ()) (@p shen.single (cons (hd V1787) (cons NewPremises (cons NewConclusion ())))))))) (true (shen.sys-error shen.left-rule))))
110
-
111
- (defun shen.right->left (V1792) (cond ((and (tuple? V1792) (= () (fst V1792))) (snd V1792)) (true (simple-error "syntax error with ==========
112
- "))))
113
-
114
- (defun shen.rule->horn-clause (V1793 V1794) (cond ((and (cons? V1794) (and (cons? (tl V1794)) (and (cons? (tl (tl V1794))) (and (tuple? (hd (tl (tl V1794)))) (= () (tl (tl (tl V1794)))))))) (cons (shen.rule->horn-clause-head V1793 (snd (hd (tl (tl V1794))))) (cons :- (cons (shen.rule->horn-clause-body (hd V1794) (hd (tl V1794)) (fst (hd (tl (tl V1794))))) ())))) (true (shen.sys-error shen.rule->horn-clause))))
115
-
116
- (defun shen.rule->horn-clause-head (V1795 V1796) (cons V1795 (cons (shen.mode-ify V1796) (cons Context_1957 ()))))
117
-
118
- (defun shen.mode-ify (V1797) (cond ((and (cons? V1797) (and (cons? (tl V1797)) (and (= : (hd (tl V1797))) (and (cons? (tl (tl V1797))) (= () (tl (tl (tl V1797)))))))) (cons mode (cons (cons (hd V1797) (cons : (cons (cons mode (cons (hd (tl (tl V1797))) (cons + ()))) ()))) (cons - ())))) (true V1797)))
119
-
120
- (defun shen.rule->horn-clause-body (V1798 V1799 V1800) (let Variables (map (lambda X1676 (shen.extract_vars X1676)) V1800) (let Predicates (map (lambda X (gensym shen.cl)) V1800) (let SearchLiterals (shen.construct-search-literals Predicates Variables Context_1957 Context1_1957) (let SearchClauses (shen.construct-search-clauses Predicates V1800 Variables) (let SideLiterals (shen.construct-side-literals V1798) (let PremissLiterals (map (lambda X (shen.construct-premiss-literal X (empty? V1800))) V1799) (append SearchLiterals (append SideLiterals PremissLiterals)))))))))
121
-
122
- (defun shen.construct-search-literals (V1805 V1806 V1807 V1808) (cond ((and (= () V1805) (= () V1806)) ()) (true (shen.csl-help V1805 V1806 V1807 V1808))))
123
-
124
- (defun shen.csl-help (V1811 V1812 V1813 V1814) (cond ((and (= () V1811) (= () V1812)) (cons (cons bind (cons ContextOut_1957 (cons V1813 ()))) ())) ((and (cons? V1811) (cons? V1812)) (cons (cons (hd V1811) (cons V1813 (cons V1814 (hd V1812)))) (shen.csl-help (tl V1811) (tl V1812) V1814 (gensym Context)))) (true (shen.sys-error shen.csl-help))))
125
-
126
- (defun shen.construct-search-clauses (V1815 V1816 V1817) (cond ((and (= () V1815) (and (= () V1816) (= () V1817))) shen.skip) ((and (cons? V1815) (and (cons? V1816) (cons? V1817))) (do (shen.construct-search-clause (hd V1815) (hd V1816) (hd V1817)) (shen.construct-search-clauses (tl V1815) (tl V1816) (tl V1817)))) (true (shen.sys-error shen.construct-search-clauses))))
127
-
128
- (defun shen.construct-search-clause (V1818 V1819 V1820) (shen.s-prolog (cons (shen.construct-base-search-clause V1818 V1819 V1820) (cons (shen.construct-recursive-search-clause V1818 V1819 V1820) ()))))
129
-
130
- (defun shen.construct-base-search-clause (V1821 V1822 V1823) (cons (cons V1821 (cons (cons (shen.mode-ify V1822) In_1957) (cons In_1957 V1823))) (cons :- (cons () ()))))
131
-
132
- (defun shen.construct-recursive-search-clause (V1824 V1825 V1826) (cons (cons V1824 (cons (cons Assumption_1957 Assumptions_1957) (cons (cons Assumption_1957 Out_1957) V1826))) (cons :- (cons (cons (cons V1824 (cons Assumptions_1957 (cons Out_1957 V1826))) ()) ()))))
133
-
134
- (defun shen.construct-side-literals (V1831) (cond ((= () V1831) ()) ((and (cons? V1831) (and (cons? (hd V1831)) (and (= if (hd (hd V1831))) (and (cons? (tl (hd V1831))) (= () (tl (tl (hd V1831)))))))) (cons (cons when (tl (hd V1831))) (shen.construct-side-literals (tl V1831)))) ((and (cons? V1831) (and (cons? (hd V1831)) (and (= let (hd (hd V1831))) (and (cons? (tl (hd V1831))) (and (cons? (tl (tl (hd V1831)))) (= () (tl (tl (tl (hd V1831)))))))))) (cons (cons is (tl (hd V1831))) (shen.construct-side-literals (tl V1831)))) ((cons? V1831) (shen.construct-side-literals (tl V1831))) (true (shen.sys-error shen.construct-side-literals))))
135
-
136
- (defun shen.construct-premiss-literal (V1836 V1837) (cond ((tuple? V1836) (cons shen.t* (cons (shen.recursive_cons_form (snd V1836)) (cons (shen.construct-context V1837 (fst V1836)) ())))) ((= ! V1836) (cons cut (cons Throwcontrol ()))) (true (shen.sys-error shen.construct-premiss-literal))))
137
-
138
- (defun shen.construct-context (V1838 V1839) (cond ((and (= true V1838) (= () V1839)) Context_1957) ((and (= false V1838) (= () V1839)) ContextOut_1957) ((cons? V1839) (cons cons (cons (shen.recursive_cons_form (hd V1839)) (cons (shen.construct-context V1838 (tl V1839)) ())))) (true (shen.sys-error shen.construct-context))))
139
-
140
- (defun shen.recursive_cons_form (V1840) (cond ((cons? V1840) (cons cons (cons (shen.recursive_cons_form (hd V1840)) (cons (shen.recursive_cons_form (tl V1840)) ())))) (true V1840)))
141
-
142
- (defun preclude (V1841) (shen.preclude-h (map (lambda X1677 (shen.intern-type X1677)) V1841)))
143
-
144
- (defun shen.preclude-h (V1842) (let FilterDatatypes (set shen.*datatypes* (difference (value shen.*datatypes*) V1842)) (value shen.*datatypes*)))
145
-
146
- (defun include (V1843) (shen.include-h (map (lambda X1678 (shen.intern-type X1678)) V1843)))
147
-
148
- (defun shen.include-h (V1844) (let ValidTypes (intersection V1844 (value shen.*alldatatypes*)) (let NewDatatypes (set shen.*datatypes* (union ValidTypes (value shen.*datatypes*))) (value shen.*datatypes*))))
149
-
150
- (defun preclude-all-but (V1845) (shen.preclude-h (difference (value shen.*alldatatypes*) (map (lambda X1679 (shen.intern-type X1679)) V1845))))
151
-
152
- (defun include-all-but (V1846) (shen.include-h (difference (value shen.*alldatatypes*) (map (lambda X1680 (shen.intern-type X1680)) V1846))))
153
-
154
- (defun shen.synonyms-help (V1851) (cond ((= () V1851) (shen.demodulation-function (value shen.*tc*) (mapcan (lambda X1681 (shen.demod-rule X1681)) (value shen.*synonyms*)))) ((and (cons? V1851) (cons? (tl V1851))) (let Vs (difference (shen.extract_vars (hd (tl V1851))) (shen.extract_vars (hd V1851))) (if (empty? Vs) (do (shen.pushnew (cons (hd V1851) (cons (hd (tl V1851)) ())) shen.*synonyms*) (shen.synonyms-help (tl (tl V1851)))) (shen.free_variable_warnings (hd (tl V1851)) Vs)))) (true (simple-error "odd number of synonyms
155
- "))))
156
-
157
- (defun shen.pushnew (V1852 V1853) (if (element? V1852 (value V1853)) (value V1853) (set V1853 (cons V1852 (value V1853)))))
158
-
159
- (defun shen.demod-rule (V1854) (cond ((and (cons? V1854) (and (cons? (tl V1854)) (= () (tl (tl V1854))))) (cons (shen.rcons_form (hd V1854)) (cons -> (cons (shen.rcons_form (hd (tl V1854))) ())))) (true (shen.sys-error shen.demod-rule))))
160
-
161
- (defun shen.demodulation-function (V1855 V1856) (do (tc -) (do (eval (cons define (cons shen.demod (append V1856 (shen.default-rule))))) (do (if V1855 (tc +) shen.skip) synonyms))))
162
-
163
- (defun shen.default-rule () (cons X (cons -> (cons X ()))))
164
-
165
-
166
-
1
+ "**********************************************************************************
2
+ * The License *
3
+ * *
4
+ * The user is free to produce commercial applications with the software, to *
5
+ * distribute these applications in source or binary form, and to charge monies *
6
+ * for them as he sees fit and in concordance with the laws of the land subject *
7
+ * to the following license. *
8
+ * *
9
+ * 1. The license applies to all the software and all derived software and *
10
+ * must appear on such. *
11
+ * *
12
+ * 2. It is illegal to distribute the software without this license attached *
13
+ * to it and use of the software implies agreement with the license as such. *
14
+ * It is illegal for anyone who is not the copyright holder to tamper with *
15
+ * or change the license. *
16
+ * *
17
+ * 3. Neither the names of Lambda Associates or the copyright holder may be used *
18
+ * to endorse or promote products built using the software without specific *
19
+ * prior written permission from the copyright holder. *
20
+ * *
21
+ * 4. That possession of this license does not confer on the copyright holder *
22
+ * any special contractual obligation towards the user. That in no event *
23
+ * shall the copyright holder be liable for any direct, indirect, incidental, *
24
+ * special, exemplary or consequential damages (including but not limited *
25
+ * to procurement of substitute goods or services, loss of use, data, *
26
+ * interruption), however caused and on any theory of liability, whether in *
27
+ * contract, strict liability or tort (including negligence) arising in any *
28
+ * way out of the use of the software, even if advised of the possibility of *
29
+ * such damage. *
30
+ * *
31
+ * 5. It is permitted for the user to change the software, for the purpose of *
32
+ * improving performance, correcting an error, or porting to a new platform, *
33
+ * and distribute the derived version of Shen provided the resulting program *
34
+ * conforms in all respects to the Shen standard and is issued under that *
35
+ * title. The user must make it clear with his distribution that he/she is *
36
+ * the author of the changes and what these changes are and why. *
37
+ * *
38
+ * 6. Derived versions of this software in whatever form are subject to the same *
39
+ * restrictions. In particular it is not permitted to make derived copies of *
40
+ * this software which do not conform to the Shen standard or appear under a *
41
+ * different title. *
42
+ * *
43
+ * It is permitted to distribute versions of Shen which incorporate libraries, *
44
+ * graphics or other facilities which are not part of the Shen standard. *
45
+ * *
46
+ * For an explication of this license see www.shenlanguage.org/license.htm which *
47
+ * explains this license in full. *
48
+ * *
49
+ *****************************************************************************************
50
+ "(defun shen.datatype-error (V1686) (cond ((and (cons? V1686) (and (cons? (tl V1686)) (= () (tl (tl V1686))))) (simple-error (cn "datatype syntax error here:
51
+
52
+ " (shen.app (shen.next-50 50 (hd V1686)) "
53
+ " shen.a)))) (true (shen.sys-error shen.datatype-error))))
54
+
55
+ (defun shen.<datatype-rules> (V1691) (let Result (let Parse_shen.<datatype-rule> (shen.<datatype-rule> V1691) (if (not (= (fail) Parse_shen.<datatype-rule>)) (let Parse_shen.<datatype-rules> (shen.<datatype-rules> Parse_shen.<datatype-rule>) (if (not (= (fail) Parse_shen.<datatype-rules>)) (shen.pair (hd Parse_shen.<datatype-rules>) (cons (shen.hdtl Parse_shen.<datatype-rule>) (shen.hdtl Parse_shen.<datatype-rules>))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_<e> (<e> V1691) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) ()) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
56
+
57
+ (defun shen.<datatype-rule> (V1696) (let Result (let Parse_shen.<side-conditions> (shen.<side-conditions> V1696) (if (not (= (fail) Parse_shen.<side-conditions>)) (let Parse_shen.<premises> (shen.<premises> Parse_shen.<side-conditions>) (if (not (= (fail) Parse_shen.<premises>)) (let Parse_shen.<singleunderline> (shen.<singleunderline> Parse_shen.<premises>) (if (not (= (fail) Parse_shen.<singleunderline>)) (let Parse_shen.<conclusion> (shen.<conclusion> Parse_shen.<singleunderline>) (if (not (= (fail) Parse_shen.<conclusion>)) (shen.pair (hd Parse_shen.<conclusion>) (shen.sequent shen.single (cons (shen.hdtl Parse_shen.<side-conditions>) (cons (shen.hdtl Parse_shen.<premises>) (cons (shen.hdtl Parse_shen.<conclusion>) ()))))) (fail))) (fail))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<side-conditions> (shen.<side-conditions> V1696) (if (not (= (fail) Parse_shen.<side-conditions>)) (let Parse_shen.<premises> (shen.<premises> Parse_shen.<side-conditions>) (if (not (= (fail) Parse_shen.<premises>)) (let Parse_shen.<doubleunderline> (shen.<doubleunderline> Parse_shen.<premises>) (if (not (= (fail) Parse_shen.<doubleunderline>)) (let Parse_shen.<conclusion> (shen.<conclusion> Parse_shen.<doubleunderline>) (if (not (= (fail) Parse_shen.<conclusion>)) (shen.pair (hd Parse_shen.<conclusion>) (shen.sequent shen.double (cons (shen.hdtl Parse_shen.<side-conditions>) (cons (shen.hdtl Parse_shen.<premises>) (cons (shen.hdtl Parse_shen.<conclusion>) ()))))) (fail))) (fail))) (fail))) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
58
+
59
+ (defun shen.<side-conditions> (V1701) (let Result (let Parse_shen.<side-condition> (shen.<side-condition> V1701) (if (not (= (fail) Parse_shen.<side-condition>)) (let Parse_shen.<side-conditions> (shen.<side-conditions> Parse_shen.<side-condition>) (if (not (= (fail) Parse_shen.<side-conditions>)) (shen.pair (hd Parse_shen.<side-conditions>) (cons (shen.hdtl Parse_shen.<side-condition>) (shen.hdtl Parse_shen.<side-conditions>))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_<e> (<e> V1701) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) ()) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
60
+
61
+ (defun shen.<side-condition> (V1706) (let Result (if (and (cons? (hd V1706)) (= if (hd (hd V1706)))) (let Parse_shen.<expr> (shen.<expr> (shen.pair (tl (hd V1706)) (shen.hdtl V1706))) (if (not (= (fail) Parse_shen.<expr>)) (shen.pair (hd Parse_shen.<expr>) (cons if (cons (shen.hdtl Parse_shen.<expr>) ()))) (fail))) (fail)) (if (= Result (fail)) (let Result (if (and (cons? (hd V1706)) (= let (hd (hd V1706)))) (let Parse_shen.<variable?> (shen.<variable?> (shen.pair (tl (hd V1706)) (shen.hdtl V1706))) (if (not (= (fail) Parse_shen.<variable?>)) (let Parse_shen.<expr> (shen.<expr> Parse_shen.<variable?>) (if (not (= (fail) Parse_shen.<expr>)) (shen.pair (hd Parse_shen.<expr>) (cons let (cons (shen.hdtl Parse_shen.<variable?>) (cons (shen.hdtl Parse_shen.<expr>) ())))) (fail))) (fail))) (fail)) (if (= Result (fail)) (fail) Result)) Result)))
62
+
63
+ (defun shen.<variable?> (V1711) (let Result (if (cons? (hd V1711)) (let Parse_X (hd (hd V1711)) (if (variable? Parse_X) (shen.pair (hd (shen.pair (tl (hd V1711)) (shen.hdtl V1711))) Parse_X) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
64
+
65
+ (defun shen.<expr> (V1716) (let Result (if (cons? (hd V1716)) (let Parse_X (hd (hd V1716)) (if (not (or (element? Parse_X (cons >> (cons ; ()))) (or (shen.singleunderline? Parse_X) (shen.doubleunderline? Parse_X)))) (shen.pair (hd (shen.pair (tl (hd V1716)) (shen.hdtl V1716))) (shen.remove-bar Parse_X)) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
66
+
67
+ (defun shen.remove-bar (V1717) (cond ((and (cons? V1717) (and (cons? (tl V1717)) (and (cons? (tl (tl V1717))) (and (= () (tl (tl (tl V1717)))) (= (hd (tl V1717)) bar!))))) (cons (hd V1717) (hd (tl (tl V1717))))) ((cons? V1717) (cons (shen.remove-bar (hd V1717)) (shen.remove-bar (tl V1717)))) (true V1717)))
68
+
69
+ (defun shen.<premises> (V1722) (let Result (let Parse_shen.<premise> (shen.<premise> V1722) (if (not (= (fail) Parse_shen.<premise>)) (let Parse_shen.<semicolon-symbol> (shen.<semicolon-symbol> Parse_shen.<premise>) (if (not (= (fail) Parse_shen.<semicolon-symbol>)) (let Parse_shen.<premises> (shen.<premises> Parse_shen.<semicolon-symbol>) (if (not (= (fail) Parse_shen.<premises>)) (shen.pair (hd Parse_shen.<premises>) (cons (shen.hdtl Parse_shen.<premise>) (shen.hdtl Parse_shen.<premises>))) (fail))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_<e> (<e> V1722) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) ()) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
70
+
71
+ (defun shen.<semicolon-symbol> (V1727) (let Result (if (cons? (hd V1727)) (let Parse_X (hd (hd V1727)) (if (= Parse_X ;) (shen.pair (hd (shen.pair (tl (hd V1727)) (shen.hdtl V1727))) shen.skip) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
72
+
73
+ (defun shen.<premise> (V1732) (let Result (if (and (cons? (hd V1732)) (= ! (hd (hd V1732)))) (shen.pair (hd (shen.pair (tl (hd V1732)) (shen.hdtl V1732))) !) (fail)) (if (= Result (fail)) (let Result (let Parse_shen.<formulae> (shen.<formulae> V1732) (if (not (= (fail) Parse_shen.<formulae>)) (if (and (cons? (hd Parse_shen.<formulae>)) (= >> (hd (hd Parse_shen.<formulae>)))) (let Parse_shen.<formula> (shen.<formula> (shen.pair (tl (hd Parse_shen.<formulae>)) (shen.hdtl Parse_shen.<formulae>))) (if (not (= (fail) Parse_shen.<formula>)) (shen.pair (hd Parse_shen.<formula>) (shen.sequent (shen.hdtl Parse_shen.<formulae>) (shen.hdtl Parse_shen.<formula>))) (fail))) (fail)) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<formula> (shen.<formula> V1732) (if (not (= (fail) Parse_shen.<formula>)) (shen.pair (hd Parse_shen.<formula>) (shen.sequent () (shen.hdtl Parse_shen.<formula>))) (fail))) (if (= Result (fail)) (fail) Result)) Result)) Result)))
74
+
75
+ (defun shen.<conclusion> (V1737) (let Result (let Parse_shen.<formulae> (shen.<formulae> V1737) (if (not (= (fail) Parse_shen.<formulae>)) (if (and (cons? (hd Parse_shen.<formulae>)) (= >> (hd (hd Parse_shen.<formulae>)))) (let Parse_shen.<formula> (shen.<formula> (shen.pair (tl (hd Parse_shen.<formulae>)) (shen.hdtl Parse_shen.<formulae>))) (if (not (= (fail) Parse_shen.<formula>)) (let Parse_shen.<semicolon-symbol> (shen.<semicolon-symbol> Parse_shen.<formula>) (if (not (= (fail) Parse_shen.<semicolon-symbol>)) (shen.pair (hd Parse_shen.<semicolon-symbol>) (shen.sequent (shen.hdtl Parse_shen.<formulae>) (shen.hdtl Parse_shen.<formula>))) (fail))) (fail))) (fail)) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<formula> (shen.<formula> V1737) (if (not (= (fail) Parse_shen.<formula>)) (let Parse_shen.<semicolon-symbol> (shen.<semicolon-symbol> Parse_shen.<formula>) (if (not (= (fail) Parse_shen.<semicolon-symbol>)) (shen.pair (hd Parse_shen.<semicolon-symbol>) (shen.sequent () (shen.hdtl Parse_shen.<formula>))) (fail))) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
76
+
77
+ (defun shen.sequent (V1738 V1739) (@p V1738 V1739))
78
+
79
+ (defun shen.<formulae> (V1744) (let Result (let Parse_shen.<formula> (shen.<formula> V1744) (if (not (= (fail) Parse_shen.<formula>)) (let Parse_shen.<comma-symbol> (shen.<comma-symbol> Parse_shen.<formula>) (if (not (= (fail) Parse_shen.<comma-symbol>)) (let Parse_shen.<formulae> (shen.<formulae> Parse_shen.<comma-symbol>) (if (not (= (fail) Parse_shen.<formulae>)) (shen.pair (hd Parse_shen.<formulae>) (cons (shen.hdtl Parse_shen.<formula>) (shen.hdtl Parse_shen.<formulae>))) (fail))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<formula> (shen.<formula> V1744) (if (not (= (fail) Parse_shen.<formula>)) (shen.pair (hd Parse_shen.<formula>) (cons (shen.hdtl Parse_shen.<formula>) ())) (fail))) (if (= Result (fail)) (let Result (let Parse_<e> (<e> V1744) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) ()) (fail))) (if (= Result (fail)) (fail) Result)) Result)) Result)))
80
+
81
+ (defun shen.<comma-symbol> (V1749) (let Result (if (cons? (hd V1749)) (let Parse_X (hd (hd V1749)) (if (= Parse_X (intern ",")) (shen.pair (hd (shen.pair (tl (hd V1749)) (shen.hdtl V1749))) shen.skip) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
82
+
83
+ (defun shen.<formula> (V1754) (let Result (let Parse_shen.<expr> (shen.<expr> V1754) (if (not (= (fail) Parse_shen.<expr>)) (if (and (cons? (hd Parse_shen.<expr>)) (= : (hd (hd Parse_shen.<expr>)))) (let Parse_shen.<type> (shen.<type> (shen.pair (tl (hd Parse_shen.<expr>)) (shen.hdtl Parse_shen.<expr>))) (if (not (= (fail) Parse_shen.<type>)) (shen.pair (hd Parse_shen.<type>) (cons (shen.curry (shen.hdtl Parse_shen.<expr>)) (cons : (cons (shen.demodulate (shen.hdtl Parse_shen.<type>)) ())))) (fail))) (fail)) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<expr> (shen.<expr> V1754) (if (not (= (fail) Parse_shen.<expr>)) (shen.pair (hd Parse_shen.<expr>) (shen.hdtl Parse_shen.<expr>)) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
84
+
85
+ (defun shen.<type> (V1759) (let Result (let Parse_shen.<expr> (shen.<expr> V1759) (if (not (= (fail) Parse_shen.<expr>)) (shen.pair (hd Parse_shen.<expr>) (shen.curry-type (shen.hdtl Parse_shen.<expr>))) (fail))) (if (= Result (fail)) (fail) Result)))
86
+
87
+ (defun shen.<doubleunderline> (V1764) (let Result (if (cons? (hd V1764)) (let Parse_X (hd (hd V1764)) (if (shen.doubleunderline? Parse_X) (shen.pair (hd (shen.pair (tl (hd V1764)) (shen.hdtl V1764))) Parse_X) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
88
+
89
+ (defun shen.<singleunderline> (V1769) (let Result (if (cons? (hd V1769)) (let Parse_X (hd (hd V1769)) (if (shen.singleunderline? Parse_X) (shen.pair (hd (shen.pair (tl (hd V1769)) (shen.hdtl V1769))) Parse_X) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
90
+
91
+ (defun shen.singleunderline? (V1770) (and (symbol? V1770) (shen.sh? (str V1770))))
92
+
93
+ (defun shen.sh? (V1771) (cond ((= "_" V1771) true) (true (and (= (pos V1771 0) "_") (shen.sh? (tlstr V1771))))))
94
+
95
+ (defun shen.doubleunderline? (V1772) (and (symbol? V1772) (shen.dh? (str V1772))))
96
+
97
+ (defun shen.dh? (V1773) (cond ((= "=" V1773) true) (true (and (= (pos V1773 0) "=") (shen.dh? (tlstr V1773))))))
98
+
99
+ (defun shen.process-datatype (V1774 V1775) (shen.remember-datatype (shen.s-prolog (shen.rules->horn-clauses V1774 V1775))))
100
+
101
+ (defun shen.remember-datatype (V1780) (cond ((cons? V1780) (do (set shen.*datatypes* (adjoin (hd V1780) (value shen.*datatypes*))) (do (set shen.*alldatatypes* (adjoin (hd V1780) (value shen.*alldatatypes*))) (hd V1780)))) (true (shen.sys-error shen.remember-datatype))))
102
+
103
+ (defun shen.rules->horn-clauses (V1783 V1784) (cond ((= () V1784) ()) ((and (cons? V1784) (and (tuple? (hd V1784)) (= shen.single (fst (hd V1784))))) (cons (shen.rule->horn-clause V1783 (snd (hd V1784))) (shen.rules->horn-clauses V1783 (tl V1784)))) ((and (cons? V1784) (and (tuple? (hd V1784)) (= shen.double (fst (hd V1784))))) (shen.rules->horn-clauses V1783 (append (shen.double->singles (snd (hd V1784))) (tl V1784)))) (true (shen.sys-error shen.rules->horn-clauses))))
104
+
105
+ (defun shen.double->singles (V1785) (cons (shen.right-rule V1785) (cons (shen.left-rule V1785) ())))
106
+
107
+ (defun shen.right-rule (V1786) (@p shen.single V1786))
108
+
109
+ (defun shen.left-rule (V1787) (cond ((and (cons? V1787) (and (cons? (tl V1787)) (and (cons? (tl (tl V1787))) (and (tuple? (hd (tl (tl V1787)))) (and (= () (fst (hd (tl (tl V1787))))) (= () (tl (tl (tl V1787))))))))) (let Q (gensym Qv) (let NewConclusion (@p (cons (snd (hd (tl (tl V1787)))) ()) Q) (let NewPremises (cons (@p (map (lambda X1675 (shen.right->left X1675)) (hd (tl V1787))) Q) ()) (@p shen.single (cons (hd V1787) (cons NewPremises (cons NewConclusion ())))))))) (true (shen.sys-error shen.left-rule))))
110
+
111
+ (defun shen.right->left (V1792) (cond ((and (tuple? V1792) (= () (fst V1792))) (snd V1792)) (true (simple-error "syntax error with ==========
112
+ "))))
113
+
114
+ (defun shen.rule->horn-clause (V1793 V1794) (cond ((and (cons? V1794) (and (cons? (tl V1794)) (and (cons? (tl (tl V1794))) (and (tuple? (hd (tl (tl V1794)))) (= () (tl (tl (tl V1794)))))))) (cons (shen.rule->horn-clause-head V1793 (snd (hd (tl (tl V1794))))) (cons :- (cons (shen.rule->horn-clause-body (hd V1794) (hd (tl V1794)) (fst (hd (tl (tl V1794))))) ())))) (true (shen.sys-error shen.rule->horn-clause))))
115
+
116
+ (defun shen.rule->horn-clause-head (V1795 V1796) (cons V1795 (cons (shen.mode-ify V1796) (cons Context_1957 ()))))
117
+
118
+ (defun shen.mode-ify (V1797) (cond ((and (cons? V1797) (and (cons? (tl V1797)) (and (= : (hd (tl V1797))) (and (cons? (tl (tl V1797))) (= () (tl (tl (tl V1797)))))))) (cons mode (cons (cons (hd V1797) (cons : (cons (cons mode (cons (hd (tl (tl V1797))) (cons + ()))) ()))) (cons - ())))) (true V1797)))
119
+
120
+ (defun shen.rule->horn-clause-body (V1798 V1799 V1800) (let Variables (map (lambda X1676 (shen.extract_vars X1676)) V1800) (let Predicates (map (lambda X (gensym shen.cl)) V1800) (let SearchLiterals (shen.construct-search-literals Predicates Variables Context_1957 Context1_1957) (let SearchClauses (shen.construct-search-clauses Predicates V1800 Variables) (let SideLiterals (shen.construct-side-literals V1798) (let PremissLiterals (map (lambda X (shen.construct-premiss-literal X (empty? V1800))) V1799) (append SearchLiterals (append SideLiterals PremissLiterals)))))))))
121
+
122
+ (defun shen.construct-search-literals (V1805 V1806 V1807 V1808) (cond ((and (= () V1805) (= () V1806)) ()) (true (shen.csl-help V1805 V1806 V1807 V1808))))
123
+
124
+ (defun shen.csl-help (V1811 V1812 V1813 V1814) (cond ((and (= () V1811) (= () V1812)) (cons (cons bind (cons ContextOut_1957 (cons V1813 ()))) ())) ((and (cons? V1811) (cons? V1812)) (cons (cons (hd V1811) (cons V1813 (cons V1814 (hd V1812)))) (shen.csl-help (tl V1811) (tl V1812) V1814 (gensym Context)))) (true (shen.sys-error shen.csl-help))))
125
+
126
+ (defun shen.construct-search-clauses (V1815 V1816 V1817) (cond ((and (= () V1815) (and (= () V1816) (= () V1817))) shen.skip) ((and (cons? V1815) (and (cons? V1816) (cons? V1817))) (do (shen.construct-search-clause (hd V1815) (hd V1816) (hd V1817)) (shen.construct-search-clauses (tl V1815) (tl V1816) (tl V1817)))) (true (shen.sys-error shen.construct-search-clauses))))
127
+
128
+ (defun shen.construct-search-clause (V1818 V1819 V1820) (shen.s-prolog (cons (shen.construct-base-search-clause V1818 V1819 V1820) (cons (shen.construct-recursive-search-clause V1818 V1819 V1820) ()))))
129
+
130
+ (defun shen.construct-base-search-clause (V1821 V1822 V1823) (cons (cons V1821 (cons (cons (shen.mode-ify V1822) In_1957) (cons In_1957 V1823))) (cons :- (cons () ()))))
131
+
132
+ (defun shen.construct-recursive-search-clause (V1824 V1825 V1826) (cons (cons V1824 (cons (cons Assumption_1957 Assumptions_1957) (cons (cons Assumption_1957 Out_1957) V1826))) (cons :- (cons (cons (cons V1824 (cons Assumptions_1957 (cons Out_1957 V1826))) ()) ()))))
133
+
134
+ (defun shen.construct-side-literals (V1831) (cond ((= () V1831) ()) ((and (cons? V1831) (and (cons? (hd V1831)) (and (= if (hd (hd V1831))) (and (cons? (tl (hd V1831))) (= () (tl (tl (hd V1831)))))))) (cons (cons when (tl (hd V1831))) (shen.construct-side-literals (tl V1831)))) ((and (cons? V1831) (and (cons? (hd V1831)) (and (= let (hd (hd V1831))) (and (cons? (tl (hd V1831))) (and (cons? (tl (tl (hd V1831)))) (= () (tl (tl (tl (hd V1831)))))))))) (cons (cons is (tl (hd V1831))) (shen.construct-side-literals (tl V1831)))) ((cons? V1831) (shen.construct-side-literals (tl V1831))) (true (shen.sys-error shen.construct-side-literals))))
135
+
136
+ (defun shen.construct-premiss-literal (V1836 V1837) (cond ((tuple? V1836) (cons shen.t* (cons (shen.recursive_cons_form (snd V1836)) (cons (shen.construct-context V1837 (fst V1836)) ())))) ((= ! V1836) (cons cut (cons Throwcontrol ()))) (true (shen.sys-error shen.construct-premiss-literal))))
137
+
138
+ (defun shen.construct-context (V1838 V1839) (cond ((and (= true V1838) (= () V1839)) Context_1957) ((and (= false V1838) (= () V1839)) ContextOut_1957) ((cons? V1839) (cons cons (cons (shen.recursive_cons_form (hd V1839)) (cons (shen.construct-context V1838 (tl V1839)) ())))) (true (shen.sys-error shen.construct-context))))
139
+
140
+ (defun shen.recursive_cons_form (V1840) (cond ((cons? V1840) (cons cons (cons (shen.recursive_cons_form (hd V1840)) (cons (shen.recursive_cons_form (tl V1840)) ())))) (true V1840)))
141
+
142
+ (defun preclude (V1841) (shen.preclude-h (map (lambda X1677 (shen.intern-type X1677)) V1841)))
143
+
144
+ (defun shen.preclude-h (V1842) (let FilterDatatypes (set shen.*datatypes* (difference (value shen.*datatypes*) V1842)) (value shen.*datatypes*)))
145
+
146
+ (defun include (V1843) (shen.include-h (map (lambda X1678 (shen.intern-type X1678)) V1843)))
147
+
148
+ (defun shen.include-h (V1844) (let ValidTypes (intersection V1844 (value shen.*alldatatypes*)) (let NewDatatypes (set shen.*datatypes* (union ValidTypes (value shen.*datatypes*))) (value shen.*datatypes*))))
149
+
150
+ (defun preclude-all-but (V1845) (shen.preclude-h (difference (value shen.*alldatatypes*) (map (lambda X1679 (shen.intern-type X1679)) V1845))))
151
+
152
+ (defun include-all-but (V1846) (shen.include-h (difference (value shen.*alldatatypes*) (map (lambda X1680 (shen.intern-type X1680)) V1846))))
153
+
154
+ (defun shen.synonyms-help (V1851) (cond ((= () V1851) (shen.demodulation-function (value shen.*tc*) (mapcan (lambda X1681 (shen.demod-rule X1681)) (value shen.*synonyms*)))) ((and (cons? V1851) (cons? (tl V1851))) (let Vs (difference (shen.extract_vars (hd (tl V1851))) (shen.extract_vars (hd V1851))) (if (empty? Vs) (do (shen.pushnew (cons (hd V1851) (cons (hd (tl V1851)) ())) shen.*synonyms*) (shen.synonyms-help (tl (tl V1851)))) (shen.free_variable_warnings (hd (tl V1851)) Vs)))) (true (simple-error "odd number of synonyms
155
+ "))))
156
+
157
+ (defun shen.pushnew (V1852 V1853) (if (element? V1852 (value V1853)) (value V1853) (set V1853 (cons V1852 (value V1853)))))
158
+
159
+ (defun shen.demod-rule (V1854) (cond ((and (cons? V1854) (and (cons? (tl V1854)) (= () (tl (tl V1854))))) (cons (shen.rcons_form (hd V1854)) (cons -> (cons (shen.rcons_form (hd (tl V1854))) ())))) (true (shen.sys-error shen.demod-rule))))
160
+
161
+ (defun shen.demodulation-function (V1855 V1856) (do (tc -) (do (eval (cons define (cons shen.demod (append V1856 (shen.default-rule))))) (do (if V1855 (tc +) shen.skip) synonyms))))
162
+
163
+ (defun shen.default-rule () (cons X (cons -> (cons X ()))))
164
+
165
+
166
+