shen-ruby 0.3.1 → 0.4.0

Sign up to get free protection for your applications and to get access to all the features.
Files changed (55) hide show
  1. data/.gitignore +2 -0
  2. data/.travis.yml +5 -0
  3. data/Gemfile +2 -2
  4. data/HISTORY.md +12 -0
  5. data/README.md +10 -7
  6. data/Rakefile +92 -0
  7. data/bin/srrepl +2 -2
  8. data/k_lambda_spec/primitives/arithmetic_spec.rb +175 -0
  9. data/k_lambda_spec/primitives/assignments_spec.rb +44 -0
  10. data/k_lambda_spec/primitives/generic_functions_spec.rb +115 -2
  11. data/k_lambda_spec/primitives/lists_spec.rb +40 -0
  12. data/k_lambda_spec/primitives/strings_spec.rb +77 -0
  13. data/k_lambda_spec/primitives/symbols_spec.rb +24 -0
  14. data/k_lambda_spec/primitives/vectors_spec.rb +92 -0
  15. data/k_lambda_spec/support/shared_examples.rb +93 -2
  16. data/k_lambda_spec/tail_recursion_spec.rb +30 -0
  17. data/lib/kl/compiler.rb +19 -33
  18. data/lib/kl/environment.rb +1 -0
  19. data/lib/kl/primitives/assignments.rb +1 -0
  20. data/lib/kl/primitives/generic_functions.rb +7 -0
  21. data/lib/kl/primitives/lists.rb +2 -0
  22. data/lib/kl/primitives/strings.rb +13 -5
  23. data/lib/kl/primitives/symbols.rb +1 -0
  24. data/lib/kl/primitives/vectors.rb +5 -0
  25. data/lib/shen_ruby/version.rb +1 -1
  26. data/shen-ruby.gemspec +1 -1
  27. data/shen/lib/shen_ruby/shen.rb +5 -6
  28. data/shen/release/benchmarks/benchmarks.shen +0 -4
  29. data/shen/release/benchmarks/interpreter.shen +2 -2
  30. data/shen/release/benchmarks/plato.jpg +0 -0
  31. data/shen/release/k_lambda/core.kl +171 -1000
  32. data/shen/release/k_lambda/declarations.kl +90 -992
  33. data/shen/release/k_lambda/load.kl +69 -81
  34. data/shen/release/k_lambda/macros.kl +113 -478
  35. data/shen/release/k_lambda/prolog.kl +250 -1307
  36. data/shen/release/k_lambda/reader.kl +115 -996
  37. data/shen/release/k_lambda/sequent.kl +154 -554
  38. data/shen/release/k_lambda/sys.kl +246 -562
  39. data/shen/release/k_lambda/t-star.kl +114 -3643
  40. data/shen/release/k_lambda/toplevel.kl +136 -221
  41. data/shen/release/k_lambda/track.kl +101 -206
  42. data/shen/release/k_lambda/types.kl +143 -298
  43. data/shen/release/k_lambda/writer.kl +93 -106
  44. data/shen/release/k_lambda/yacc.kl +77 -252
  45. data/shen/release/test_programs/README.shen +1 -1
  46. data/shen/release/test_programs/classes-typed.shen +1 -1
  47. data/shen/release/test_programs/interpreter.shen +2 -2
  48. data/shen/release/test_programs/metaprog.shen +2 -2
  49. data/shen/release/test_programs/prolog.shen +79 -0
  50. data/shen/release/test_programs/structures-typed.shen +2 -2
  51. data/shen/release/test_programs/tests.shen +19 -80
  52. data/shen/release/test_programs/yacc.shen +11 -15
  53. metadata +14 -6
  54. data/Gemfile.lock +0 -20
  55. data/shen/release/benchmarks/br.shen +0 -13
@@ -1,1062 +1,181 @@
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 lineread () (shen.lineread-loop (read-byte (stinput)) ()))
1
51
 
2
- " The License
3
-
4
- The user is free to produce commercial applications with the software, to distribute these applications in source or binary form, and to charge monies for them as he sees fit and in concordance with the laws of the land subject to the following license.
5
-
6
- 1. The license applies to all the software and all derived software and must appear on such.
7
- 2. It is illegal to distribute the software without this license attached to it and use of the software implies agreement
8
- with the license as such. It is illegal for anyone who is not the copyright holder to tamper with or change the license.
9
- 3. Neither the names of Lambda Associates or the copyright holder may be used to endorse or promote products built using
10
- the software without specific prior written permission from the copyright holder.
11
- 4. That possession of this license does not confer on the copyright holder any special contractual obligation towards the user. That in no event shall the copyright holder be liable for any direct, indirect, incidental, special, exemplary or consequential damages (including but not limited to procurement of substitute goods or services, loss of use, data, or profits; or business interruption), however caused and on any theory of liability, whether in contract, strict liability or tort (including negligence) arising in any way out of the use of the software, even if advised of the possibility of such damage.
12
- 5. It is permitted for the user to change the software, for the purpose of improving performance, correcting an error, or porting to a new platform, and distribute the modified version of Shen (hereafter the modified version) provided the resulting program conforms in all respects to the Shen standard and is issued under that title. The user must make it clear with his distribution that he/she is the author of the changes and what these changes are and why.
13
- 6. Derived versions of this software in whatever form are subject to the same restrictions. In particular it is not permitted to make derived copies of this software which do not conform to the Shen standard or appear under a different title.
14
- 7. It is permitted to distribute versions of Shen which incorporate libraries, graphics or other facilities which are not part of the Shen standard.
52
+ (defun shen.lineread-loop (V1300 V1301) (cond ((= V1300 (shen.hat)) (simple-error "line read aborted")) ((element? V1300 (cons (shen.newline) (cons (shen.carriage-return) ()))) (let Line (compile shen.<st_input> V1301 (lambda E shen.nextline)) (if (or (= Line shen.nextline) (empty? Line)) (shen.lineread-loop (read-byte (stinput)) (append V1301 (cons V1300 ()))) Line))) (true (shen.lineread-loop (read-byte (stinput)) (append V1301 (cons V1300 ()))))))
15
53
 
16
- For an explication of this license see http://www.lambdassociates.org/News/june11/license.htm which explains this license in full."
54
+ (defun read-file (V1302) (let Bytelist (read-file-as-bytelist V1302) (compile shen.<st_input> Bytelist shen.read-error)))
17
55
 
18
- (set shen-*symbolcodes* (vector 128))
56
+ (defun shen.read-error (V1303) (simple-error (cn "read error here:
19
57
 
20
- (address-> (value shen-*symbolcodes*) 126 "~")
58
+ " (shen.app (shen.compress-50 50 V1303) "
59
+ " shen.a))))
21
60
 
22
- (address-> (value shen-*symbolcodes*) 122 "z")
61
+ (defun shen.compress-50 (V1308 V1309) (cond ((= () V1309) "") ((= 0 V1308) "") ((cons? V1309) (cn (n->string (hd V1309)) (shen.compress-50 (- V1308 1) (tl V1309)))) (true (shen.sys-error shen.compress-50))))
23
62
 
24
- (address-> (value shen-*symbolcodes*) 121 "y")
63
+ (defun shen.<st_input> (V1314) (let Result (let Parse_shen.<lsb> (shen.<lsb> V1314) (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> V1314) (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> V1314) (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> V1314) (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> V1314) (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> V1314) (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> V1314) (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> V1314) (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> V1314) (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> V1314) (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> V1314) (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> V1314) (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> V1314) (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> V1314) (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)))
25
64
 
26
- (address-> (value shen-*symbolcodes*) 120 "x")
65
+ (defun shen.<lsb> (V1319) (let Result (if (and (cons? (hd V1319)) (= 91 (hd (hd V1319)))) (shen.pair (hd (shen.pair (tl (hd V1319)) (shen.hdtl V1319))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
27
66
 
28
- (address-> (value shen-*symbolcodes*) 119 "w")
67
+ (defun shen.<rsb> (V1324) (let Result (if (and (cons? (hd V1324)) (= 93 (hd (hd V1324)))) (shen.pair (hd (shen.pair (tl (hd V1324)) (shen.hdtl V1324))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
29
68
 
30
- (address-> (value shen-*symbolcodes*) 118 "v")
69
+ (defun shen.<lcurly> (V1329) (let Result (if (and (cons? (hd V1329)) (= 123 (hd (hd V1329)))) (shen.pair (hd (shen.pair (tl (hd V1329)) (shen.hdtl V1329))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
31
70
 
32
- (address-> (value shen-*symbolcodes*) 117 "u")
71
+ (defun shen.<rcurly> (V1334) (let Result (if (and (cons? (hd V1334)) (= 125 (hd (hd V1334)))) (shen.pair (hd (shen.pair (tl (hd V1334)) (shen.hdtl V1334))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
33
72
 
34
- (address-> (value shen-*symbolcodes*) 116 "t")
73
+ (defun shen.<bar> (V1339) (let Result (if (and (cons? (hd V1339)) (= 124 (hd (hd V1339)))) (shen.pair (hd (shen.pair (tl (hd V1339)) (shen.hdtl V1339))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
35
74
 
36
- (address-> (value shen-*symbolcodes*) 115 "s")
75
+ (defun shen.<semicolon> (V1344) (let Result (if (and (cons? (hd V1344)) (= 59 (hd (hd V1344)))) (shen.pair (hd (shen.pair (tl (hd V1344)) (shen.hdtl V1344))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
37
76
 
38
- (address-> (value shen-*symbolcodes*) 114 "r")
77
+ (defun shen.<colon> (V1349) (let Result (if (and (cons? (hd V1349)) (= 58 (hd (hd V1349)))) (shen.pair (hd (shen.pair (tl (hd V1349)) (shen.hdtl V1349))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
39
78
 
40
- (address-> (value shen-*symbolcodes*) 113 "q")
79
+ (defun shen.<comma> (V1354) (let Result (if (and (cons? (hd V1354)) (= 44 (hd (hd V1354)))) (shen.pair (hd (shen.pair (tl (hd V1354)) (shen.hdtl V1354))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
41
80
 
42
- (address-> (value shen-*symbolcodes*) 112 "p")
81
+ (defun shen.<equal> (V1359) (let Result (if (and (cons? (hd V1359)) (= 61 (hd (hd V1359)))) (shen.pair (hd (shen.pair (tl (hd V1359)) (shen.hdtl V1359))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
43
82
 
44
- (address-> (value shen-*symbolcodes*) 111 "o")
83
+ (defun shen.<minus> (V1364) (let Result (if (and (cons? (hd V1364)) (= 45 (hd (hd V1364)))) (shen.pair (hd (shen.pair (tl (hd V1364)) (shen.hdtl V1364))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
45
84
 
46
- (address-> (value shen-*symbolcodes*) 110 "n")
85
+ (defun shen.<lrb> (V1369) (let Result (if (and (cons? (hd V1369)) (= 40 (hd (hd V1369)))) (shen.pair (hd (shen.pair (tl (hd V1369)) (shen.hdtl V1369))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
47
86
 
48
- (address-> (value shen-*symbolcodes*) 109 "m")
87
+ (defun shen.<rrb> (V1374) (let Result (if (and (cons? (hd V1374)) (= 41 (hd (hd V1374)))) (shen.pair (hd (shen.pair (tl (hd V1374)) (shen.hdtl V1374))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
49
88
 
50
- (address-> (value shen-*symbolcodes*) 108 "l")
89
+ (defun shen.<atom> (V1379) (let Result (let Parse_shen.<str> (shen.<str> V1379) (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> V1379) (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> V1379) (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)))
51
90
 
52
- (address-> (value shen-*symbolcodes*) 107 "k")
91
+ (defun shen.control-chars (V1380) (cond ((= () V1380) "") ((and (cons? V1380) (and (= "c" (hd V1380)) (and (cons? (tl V1380)) (= "#" (hd (tl V1380)))))) (let CodePoint (shen.code-point (tl (tl V1380))) (let AfterCodePoint (shen.after-codepoint (tl (tl V1380))) (@s (n->string (shen.decimalise CodePoint)) (shen.control-chars AfterCodePoint))))) ((cons? V1380) (@s (hd V1380) (shen.control-chars (tl V1380)))) (true (shen.sys-error shen.control-chars))))
53
92
 
54
- (address-> (value shen-*symbolcodes*) 106 "j")
93
+ (defun shen.code-point (V1383) (cond ((and (cons? V1383) (= ";" (hd V1383))) "") ((and (cons? V1383) (element? (hd V1383) (cons "0" (cons "1" (cons "2" (cons "3" (cons "4" (cons "5" (cons "6" (cons "7" (cons "8" (cons "9" (cons "0" ()))))))))))))) (cons (hd V1383) (shen.code-point (tl V1383)))) (true (simple-error (cn "code point parse error " (shen.app V1383 "
94
+ " shen.a))))))
55
95
 
56
- (address-> (value shen-*symbolcodes*) 105 "i")
96
+ (defun shen.after-codepoint (V1388) (cond ((= () V1388) ()) ((and (cons? V1388) (= ";" (hd V1388))) (tl V1388)) ((cons? V1388) (shen.after-codepoint (tl V1388))) (true (shen.sys-error shen.after-codepoint))))
57
97
 
58
- (address-> (value shen-*symbolcodes*) 104 "h")
98
+ (defun shen.decimalise (V1389) (shen.pre (reverse (shen.digits->integers V1389)) 0))
59
99
 
60
- (address-> (value shen-*symbolcodes*) 103 "g")
100
+ (defun shen.digits->integers (V1394) (cond ((and (cons? V1394) (= "0" (hd V1394))) (cons 0 (shen.digits->integers (tl V1394)))) ((and (cons? V1394) (= "1" (hd V1394))) (cons 1 (shen.digits->integers (tl V1394)))) ((and (cons? V1394) (= "2" (hd V1394))) (cons 2 (shen.digits->integers (tl V1394)))) ((and (cons? V1394) (= "3" (hd V1394))) (cons 3 (shen.digits->integers (tl V1394)))) ((and (cons? V1394) (= "4" (hd V1394))) (cons 4 (shen.digits->integers (tl V1394)))) ((and (cons? V1394) (= "5" (hd V1394))) (cons 5 (shen.digits->integers (tl V1394)))) ((and (cons? V1394) (= "6" (hd V1394))) (cons 6 (shen.digits->integers (tl V1394)))) ((and (cons? V1394) (= "7" (hd V1394))) (cons 7 (shen.digits->integers (tl V1394)))) ((and (cons? V1394) (= "8" (hd V1394))) (cons 8 (shen.digits->integers (tl V1394)))) ((and (cons? V1394) (= "9" (hd V1394))) (cons 9 (shen.digits->integers (tl V1394)))) (true ())))
61
101
 
62
- (address-> (value shen-*symbolcodes*) 102 "f")
102
+ (defun shen.<sym> (V1399) (let Result (let Parse_shen.<alpha> (shen.<alpha> V1399) (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)))
63
103
 
64
- (address-> (value shen-*symbolcodes*) 101 "e")
104
+ (defun shen.<alphanums> (V1404) (let Result (let Parse_shen.<alphanum> (shen.<alphanum> V1404) (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> V1404) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) "") (fail))) (if (= Result (fail)) (fail) Result)) Result)))
65
105
 
66
- (address-> (value shen-*symbolcodes*) 100 "d")
106
+ (defun shen.<alphanum> (V1409) (let Result (let Parse_shen.<alpha> (shen.<alpha> V1409) (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> V1409) (if (not (= (fail) Parse_shen.<num>)) (shen.pair (hd Parse_shen.<num>) (shen.hdtl Parse_shen.<num>)) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
67
107
 
68
- (address-> (value shen-*symbolcodes*) 99 "c")
108
+ (defun shen.<num> (V1414) (let Result (if (cons? (hd V1414)) (let Parse_Byte (hd (hd V1414)) (if (shen.numbyte? Parse_Byte) (shen.pair (hd (shen.pair (tl (hd V1414)) (shen.hdtl V1414))) (n->string Parse_Byte)) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
69
109
 
70
- (address-> (value shen-*symbolcodes*) 98 "b")
110
+ (defun shen.numbyte? (V1419) (cond ((= 48 V1419) true) ((= 49 V1419) true) ((= 50 V1419) true) ((= 51 V1419) true) ((= 52 V1419) true) ((= 53 V1419) true) ((= 54 V1419) true) ((= 55 V1419) true) ((= 56 V1419) true) ((= 57 V1419) true) (true false)))
71
111
 
72
- (address-> (value shen-*symbolcodes*) 97 "a")
112
+ (defun shen.<alpha> (V1424) (let Result (if (cons? (hd V1424)) (let Parse_Byte (hd (hd V1424)) (if (shen.symbol-code? Parse_Byte) (shen.pair (hd (shen.pair (tl (hd V1424)) (shen.hdtl V1424))) (n->string Parse_Byte)) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
73
113
 
74
- (address-> (value shen-*symbolcodes*) 96 "`")
114
+ (defun shen.symbol-code? (V1425) (or (= V1425 126) (or (and (> V1425 94) (< V1425 123)) (or (and (> V1425 59) (< V1425 91)) (or (and (> V1425 41) (and (< V1425 58) (not (= V1425 44)))) (or (and (> V1425 34) (< V1425 40)) (= V1425 33)))))))
75
115
 
76
- (address-> (value shen-*symbolcodes*) 95 "_")
116
+ (defun shen.<str> (V1430) (let Result (let Parse_shen.<dbq> (shen.<dbq> V1430) (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)))
77
117
 
78
- (address-> (value shen-*symbolcodes*) 90 "Z")
118
+ (defun shen.<dbq> (V1435) (let Result (if (cons? (hd V1435)) (let Parse_Byte (hd (hd V1435)) (if (= Parse_Byte 34) (shen.pair (hd (shen.pair (tl (hd V1435)) (shen.hdtl V1435))) Parse_Byte) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
79
119
 
80
- (address-> (value shen-*symbolcodes*) 89 "Y")
120
+ (defun shen.<strcontents> (V1440) (let Result (let Parse_shen.<strc> (shen.<strc> V1440) (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> V1440) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) ()) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
81
121
 
82
- (address-> (value shen-*symbolcodes*) 88 "X")
122
+ (defun shen.<byte> (V1445) (let Result (if (cons? (hd V1445)) (let Parse_Byte (hd (hd V1445)) (shen.pair (hd (shen.pair (tl (hd V1445)) (shen.hdtl V1445))) (n->string Parse_Byte))) (fail)) (if (= Result (fail)) (fail) Result)))
83
123
 
84
- (address-> (value shen-*symbolcodes*) 87 "W")
124
+ (defun shen.<strc> (V1450) (let Result (if (cons? (hd V1450)) (let Parse_Byte (hd (hd V1450)) (if (not (= Parse_Byte 34)) (shen.pair (hd (shen.pair (tl (hd V1450)) (shen.hdtl V1450))) (n->string Parse_Byte)) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
85
125
 
86
- (address-> (value shen-*symbolcodes*) 86 "V")
126
+ (defun shen.<backslash> (V1455) (let Result (if (cons? (hd V1455)) (let Parse_Byte (hd (hd V1455)) (if (= Parse_Byte 92) (shen.pair (hd (shen.pair (tl (hd V1455)) (shen.hdtl V1455))) (n->string Parse_Byte)) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
87
127
 
88
- (address-> (value shen-*symbolcodes*) 85 "U")
128
+ (defun shen.<number> (V1460) (let Result (let Parse_shen.<minus> (shen.<minus> V1460) (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> V1460) (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> V1460) (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> V1460) (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> V1460) (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> V1460) (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)))
89
129
 
90
- (address-> (value shen-*symbolcodes*) 84 "T")
130
+ (defun shen.<E> (V1465) (let Result (if (and (cons? (hd V1465)) (= 101 (hd (hd V1465)))) (shen.pair (hd (shen.pair (tl (hd V1465)) (shen.hdtl V1465))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
91
131
 
92
- (address-> (value shen-*symbolcodes*) 83 "S")
132
+ (defun shen.<log10> (V1470) (let Result (let Parse_shen.<minus> (shen.<minus> V1470) (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> V1470) (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)))
93
133
 
94
- (address-> (value shen-*symbolcodes*) 82 "R")
134
+ (defun shen.<plus> (V1475) (let Result (if (cons? (hd V1475)) (let Parse_Byte (hd (hd V1475)) (if (= Parse_Byte 43) (shen.pair (hd (shen.pair (tl (hd V1475)) (shen.hdtl V1475))) Parse_Byte) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
95
135
 
96
- (address-> (value shen-*symbolcodes*) 81 "Q")
136
+ (defun shen.<stop> (V1480) (let Result (if (cons? (hd V1480)) (let Parse_Byte (hd (hd V1480)) (if (= Parse_Byte 46) (shen.pair (hd (shen.pair (tl (hd V1480)) (shen.hdtl V1480))) Parse_Byte) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
97
137
 
98
- (address-> (value shen-*symbolcodes*) 80 "P")
138
+ (defun shen.<predigits> (V1485) (let Result (let Parse_shen.<digits> (shen.<digits> V1485) (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> V1485) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) ()) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
99
139
 
100
- (address-> (value shen-*symbolcodes*) 79 "O")
140
+ (defun shen.<postdigits> (V1490) (let Result (let Parse_shen.<digits> (shen.<digits> V1490) (if (not (= (fail) Parse_shen.<digits>)) (shen.pair (hd Parse_shen.<digits>) (shen.hdtl Parse_shen.<digits>)) (fail))) (if (= Result (fail)) (fail) Result)))
101
141
 
102
- (address-> (value shen-*symbolcodes*) 78 "N")
142
+ (defun shen.<digits> (V1495) (let Result (let Parse_shen.<digit> (shen.<digit> V1495) (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> V1495) (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)))
103
143
 
104
- (address-> (value shen-*symbolcodes*) 77 "M")
144
+ (defun shen.<digit> (V1500) (let Result (if (cons? (hd V1500)) (let Parse_X (hd (hd V1500)) (if (shen.numbyte? Parse_X) (shen.pair (hd (shen.pair (tl (hd V1500)) (shen.hdtl V1500))) (shen.byte->digit Parse_X)) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
105
145
 
106
- (address-> (value shen-*symbolcodes*) 76 "L")
146
+ (defun shen.byte->digit (V1501) (cond ((= 48 V1501) 0) ((= 49 V1501) 1) ((= 50 V1501) 2) ((= 51 V1501) 3) ((= 52 V1501) 4) ((= 53 V1501) 5) ((= 54 V1501) 6) ((= 55 V1501) 7) ((= 56 V1501) 8) ((= 57 V1501) 9) (true (shen.sys-error shen.byte->digit))))
107
147
 
108
- (address-> (value shen-*symbolcodes*) 75 "K")
148
+ (defun shen.pre (V1504 V1505) (cond ((= () V1504) 0) ((cons? V1504) (+ (* (shen.expt 10 V1505) (hd V1504)) (shen.pre (tl V1504) (+ V1505 1)))) (true (shen.sys-error shen.pre))))
109
149
 
110
- (address-> (value shen-*symbolcodes*) 74 "J")
150
+ (defun shen.post (V1508 V1509) (cond ((= () V1508) 0) ((cons? V1508) (+ (* (shen.expt 10 (- 0 V1509)) (hd V1508)) (shen.post (tl V1508) (+ V1509 1)))) (true (shen.sys-error shen.post))))
111
151
 
112
- (address-> (value shen-*symbolcodes*) 73 "I")
152
+ (defun shen.expt (V1512 V1513) (cond ((= 0 V1513) 1) ((> V1513 0) (* V1512 (shen.expt V1512 (- V1513 1)))) (true (* 1 (/ (shen.expt V1512 (+ V1513 1)) V1512)))))
113
153
 
114
- (address-> (value shen-*symbolcodes*) 72 "H")
154
+ (defun shen.<st_input1> (V1518) (let Result (let Parse_shen.<st_input> (shen.<st_input> V1518) (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)))
115
155
 
116
- (address-> (value shen-*symbolcodes*) 71 "G")
156
+ (defun shen.<st_input2> (V1523) (let Result (let Parse_shen.<st_input> (shen.<st_input> V1523) (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)))
117
157
 
118
- (address-> (value shen-*symbolcodes*) 70 "F")
158
+ (defun shen.<comment> (V1528) (let Result (let Parse_shen.<backslash> (shen.<backslash> V1528) (if (not (= (fail) Parse_shen.<backslash>)) (let Parse_shen.<times> (shen.<times> Parse_shen.<backslash>) (if (not (= (fail) Parse_shen.<times>)) (let Parse_shen.<any> (shen.<any> Parse_shen.<times>) (if (not (= (fail) Parse_shen.<any>)) (let Parse_shen.<times> (shen.<times> Parse_shen.<any>) (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))) (fail))) (fail))) (fail))) (if (= Result (fail)) (fail) Result)))
119
159
 
120
- (address-> (value shen-*symbolcodes*) 69 "E")
160
+ (defun shen.<times> (V1533) (let Result (if (cons? (hd V1533)) (let Parse_Byte (hd (hd V1533)) (if (= Parse_Byte 42) (shen.pair (hd (shen.pair (tl (hd V1533)) (shen.hdtl V1533))) Parse_Byte) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
121
161
 
122
- (address-> (value shen-*symbolcodes*) 68 "D")
162
+ (defun shen.<any> (V1538) (let Result (let Parse_shen.<comment> (shen.<comment> V1538) (if (not (= (fail) Parse_shen.<comment>)) (let Parse_shen.<any> (shen.<any> Parse_shen.<comment>) (if (not (= (fail) Parse_shen.<any>)) (shen.pair (hd Parse_shen.<any>) shen.skip) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<blah> (shen.<blah> V1538) (if (not (= (fail) Parse_shen.<blah>)) (let Parse_shen.<any> (shen.<any> Parse_shen.<blah>) (if (not (= (fail) Parse_shen.<any>)) (shen.pair (hd Parse_shen.<any>) shen.skip) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_<e> (<e> V1538) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) shen.skip) (fail))) (if (= Result (fail)) (fail) Result)) Result)) Result)))
123
163
 
124
- (address-> (value shen-*symbolcodes*) 67 "C")
164
+ (defun shen.<blah> (V1551) (cond ((and (cons? V1551) (and (cons? (hd V1551)) (and (= 42 (hd (hd V1551))) (and (cons? (tl (hd V1551))) (= 92 (hd (tl (hd V1551)))))))) (fail)) ((and (cons? V1551) (and (cons? (hd V1551)) (and (cons? (tl V1551)) (= () (tl (tl V1551)))))) (cons (tl (hd V1551)) (cons shen.skip ()))) (true (fail))))
125
165
 
126
- (address-> (value shen-*symbolcodes*) 66 "B")
166
+ (defun shen.<whitespaces> (V1556) (let Result (let Parse_shen.<whitespace> (shen.<whitespace> V1556) (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> V1556) (if (not (= (fail) Parse_shen.<whitespace>)) (shen.pair (hd Parse_shen.<whitespace>) shen.skip) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
127
167
 
128
- (address-> (value shen-*symbolcodes*) 65 "A")
168
+ (defun shen.<whitespace> (V1561) (let Result (if (cons? (hd V1561)) (let Parse_X (hd (hd V1561)) (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 V1561)) (shen.hdtl V1561))) shen.skip) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
129
169
 
130
- (address-> (value shen-*symbolcodes*) 64 "@")
170
+ (defun shen.cons_form (V1562) (cond ((= () V1562) ()) ((and (cons? V1562) (and (cons? (tl V1562)) (and (cons? (tl (tl V1562))) (and (= () (tl (tl (tl V1562)))) (= (hd (tl V1562)) bar!))))) (cons cons (cons (hd V1562) (tl (tl V1562))))) ((cons? V1562) (cons cons (cons (hd V1562) (cons (shen.cons_form (tl V1562)) ())))) (true (shen.sys-error shen.cons_form))))
131
171
 
132
- (address-> (value shen-*symbolcodes*) 63 "?")
172
+ (defun shen.package-macro (V1565 V1566) (cond ((and (cons? V1565) (and (= $ (hd V1565)) (and (cons? (tl V1565)) (= () (tl (tl V1565)))))) (append (explode (hd (tl V1565))) V1566)) ((and (cons? V1565) (and (= package (hd V1565)) (and (cons? (tl V1565)) (and (= null (hd (tl V1565))) (cons? (tl (tl V1565))))))) (append (tl (tl (tl V1565))) V1566)) ((and (cons? V1565) (and (= package (hd V1565)) (and (cons? (tl V1565)) (cons? (tl (tl V1565)))))) (let ListofExceptions (shen.eval-without-macros (hd (tl (tl V1565)))) (let Record (shen.record-exceptions ListofExceptions (hd (tl V1565))) (let PackageNameDot (intern (cn (str (hd (tl V1565))) ".")) (append (shen.packageh PackageNameDot ListofExceptions (tl (tl (tl V1565)))) V1566))))) (true (cons V1565 V1566))))
133
173
 
134
- (address-> (value shen-*symbolcodes*) 62 ">")
174
+ (defun shen.record-exceptions (V1567 V1568) (let CurrExceptions (trap-error (get V1568 shen.external-symbols (value *property-vector*)) (lambda E ())) (let AllExceptions (union V1567 CurrExceptions) (put V1568 shen.external-symbols AllExceptions (value *property-vector*)))))
135
175
 
136
- (address-> (value shen-*symbolcodes*) 61 "=")
176
+ (defun shen.packageh (V1577 V1578 V1579) (cond ((cons? V1579) (cons (shen.packageh V1577 V1578 (hd V1579)) (shen.packageh V1577 V1578 (tl V1579)))) ((or (shen.sysfunc? V1579) (or (variable? V1579) (or (element? V1579 V1578) (or (shen.doubleunderline? V1579) (shen.singleunderline? V1579))))) V1579) ((and (symbol? V1579) (not (shen.prefix? (cons "s" (cons "h" (cons "e" (cons "n" (cons "." ()))))) (explode V1579)))) (concat V1577 V1579)) (true V1579)))
137
177
 
138
- (address-> (value shen-*symbolcodes*) 60 "<")
178
+ (defun read-from-string (V1580) (let Ns (map (lambda V1298 (string->n V1298)) (explode V1580)) (compile shen.<st_input> Ns shen.read-error)))
139
179
 
140
- (address-> (value shen-*symbolcodes*) 57 "9")
141
180
 
142
- (address-> (value shen-*symbolcodes*) 56 "8")
143
-
144
- (address-> (value shen-*symbolcodes*) 55 "7")
145
-
146
- (address-> (value shen-*symbolcodes*) 54 "6")
147
-
148
- (address-> (value shen-*symbolcodes*) 53 "5")
149
-
150
- (address-> (value shen-*symbolcodes*) 52 "4")
151
-
152
- (address-> (value shen-*symbolcodes*) 51 "3")
153
-
154
- (address-> (value shen-*symbolcodes*) 50 "2")
155
-
156
- (address-> (value shen-*symbolcodes*) 49 "1")
157
-
158
- (address-> (value shen-*symbolcodes*) 48 "0")
159
-
160
- (address-> (value shen-*symbolcodes*) 47 "/")
161
-
162
- (address-> (value shen-*symbolcodes*) 46 ".")
163
-
164
- (address-> (value shen-*symbolcodes*) 45 "-")
165
-
166
- (address-> (value shen-*symbolcodes*) 43 "+")
167
-
168
- (address-> (value shen-*symbolcodes*) 42 "*")
169
-
170
- (address-> (value shen-*symbolcodes*) 39 "'")
171
-
172
- (address-> (value shen-*symbolcodes*) 38 "&")
173
-
174
- (address-> (value shen-*symbolcodes*) 37 "%")
175
-
176
- (address-> (value shen-*symbolcodes*) 36 "$")
177
-
178
- (address-> (value shen-*symbolcodes*) 35 "#")
179
-
180
- (address-> (value shen-*symbolcodes*) 33 "!")
181
-
182
- (defun lineread () (shen-lineread-loop (read-byte (stinput 0)) ()))
183
-
184
- (defun shen-lineread-loop (V967 V968)
185
- (cond ((= V967 (shen-hat)) (interror "line read aborted" ()))
186
- ((element? V967 (cons (shen-newline) (cons (shen-carriage-return) ())))
187
- (let Line (compile (lambda V969 (shen-<st_input> V969)) V968 ())
188
- (if (or (= Line (fail)) (empty? Line))
189
- (shen-lineread-loop (read-byte (stinput 0)) (append V968 (cons V967 ())))
190
- Line)))
191
- (true
192
- (shen-lineread-loop (read-byte (stinput 0))
193
- (append V968 (cons V967 ()))))))
194
-
195
- (defun read-file (V970)
196
- (let Bytelist (read-file-as-bytelist V970)
197
- (compile (lambda V971 (shen-<st_input> V971)) Bytelist
198
- (lambda V972 (shen-read-error V972)))))
199
-
200
- (defun shen-read-error (V973)
201
- (interror "read error here:~%~% ~A~%" (@p (shen-compress-50 50 V973) ())))
202
-
203
- (defun shen-compress-50 (V978 V979)
204
- (cond ((= () V979) "") ((= 0 V978) "")
205
- ((cons? V979)
206
- (cn (n->string (hd V979)) (shen-compress-50 (- V978 1) (tl V979))))
207
- (true (shen-sys-error shen-compress-50))))
208
-
209
- (defun shen-<st_input> (V980)
210
- (let Result
211
- (let Parse_<lsb> (shen-<lsb> V980)
212
- (if (not (= (fail) Parse_<lsb>))
213
- (let Parse_<st_input1> (shen-<st_input1> Parse_<lsb>)
214
- (if (not (= (fail) Parse_<st_input1>))
215
- (let Parse_<rsb> (shen-<rsb> Parse_<st_input1>)
216
- (if (not (= (fail) Parse_<rsb>))
217
- (let Parse_<st_input2> (shen-<st_input2> Parse_<rsb>)
218
- (if (not (= (fail) Parse_<st_input2>))
219
- (shen-reassemble (fst Parse_<st_input2>)
220
- (cons (macroexpand (shen-cons_form (snd Parse_<st_input1>)))
221
- (snd Parse_<st_input2>)))
222
- (fail)))
223
- (fail)))
224
- (fail)))
225
- (fail)))
226
- (if (= Result (fail))
227
- (let Result
228
- (let Parse_<lrb> (shen-<lrb> V980)
229
- (if (not (= (fail) Parse_<lrb>))
230
- (let Parse_<st_input1> (shen-<st_input1> Parse_<lrb>)
231
- (if (not (= (fail) Parse_<st_input1>))
232
- (let Parse_<rrb> (shen-<rrb> Parse_<st_input1>)
233
- (if (not (= (fail) Parse_<rrb>))
234
- (let Parse_<st_input2> (shen-<st_input2> Parse_<rrb>)
235
- (if (not (= (fail) Parse_<st_input2>))
236
- (shen-reassemble (fst Parse_<st_input2>)
237
- (shen-package-macro (macroexpand (snd Parse_<st_input1>))
238
- (snd Parse_<st_input2>)))
239
- (fail)))
240
- (fail)))
241
- (fail)))
242
- (fail)))
243
- (if (= Result (fail))
244
- (let Result
245
- (let Parse_<lcurly> (shen-<lcurly> V980)
246
- (if (not (= (fail) Parse_<lcurly>))
247
- (let Parse_<st_input> (shen-<st_input> Parse_<lcurly>)
248
- (if (not (= (fail) Parse_<st_input>))
249
- (shen-reassemble (fst Parse_<st_input>)
250
- (cons { (snd Parse_<st_input>)))
251
- (fail)))
252
- (fail)))
253
- (if (= Result (fail))
254
- (let Result
255
- (let Parse_<rcurly> (shen-<rcurly> V980)
256
- (if (not (= (fail) Parse_<rcurly>))
257
- (let Parse_<st_input> (shen-<st_input> Parse_<rcurly>)
258
- (if (not (= (fail) Parse_<st_input>))
259
- (shen-reassemble (fst Parse_<st_input>)
260
- (cons } (snd Parse_<st_input>)))
261
- (fail)))
262
- (fail)))
263
- (if (= Result (fail))
264
- (let Result
265
- (let Parse_<bar> (shen-<bar> V980)
266
- (if (not (= (fail) Parse_<bar>))
267
- (let Parse_<st_input> (shen-<st_input> Parse_<bar>)
268
- (if (not (= (fail) Parse_<st_input>))
269
- (shen-reassemble (fst Parse_<st_input>)
270
- (cons bar! (snd Parse_<st_input>)))
271
- (fail)))
272
- (fail)))
273
- (if (= Result (fail))
274
- (let Result
275
- (let Parse_<semicolon> (shen-<semicolon> V980)
276
- (if (not (= (fail) Parse_<semicolon>))
277
- (let Parse_<st_input> (shen-<st_input> Parse_<semicolon>)
278
- (if (not (= (fail) Parse_<st_input>))
279
- (shen-reassemble (fst Parse_<st_input>)
280
- (cons ; (snd Parse_<st_input>)))
281
- (fail)))
282
- (fail)))
283
- (if (= Result (fail))
284
- (let Result
285
- (let Parse_<colon> (shen-<colon> V980)
286
- (if (not (= (fail) Parse_<colon>))
287
- (let Parse_<equal> (shen-<equal> Parse_<colon>)
288
- (if (not (= (fail) Parse_<equal>))
289
- (let Parse_<st_input> (shen-<st_input> Parse_<equal>)
290
- (if (not (= (fail) Parse_<st_input>))
291
- (shen-reassemble (fst Parse_<st_input>)
292
- (cons := (snd Parse_<st_input>)))
293
- (fail)))
294
- (fail)))
295
- (fail)))
296
- (if (= Result (fail))
297
- (let Result
298
- (let Parse_<colon> (shen-<colon> V980)
299
- (if (not (= (fail) Parse_<colon>))
300
- (let Parse_<minus> (shen-<minus> Parse_<colon>)
301
- (if (not (= (fail) Parse_<minus>))
302
- (let Parse_<st_input> (shen-<st_input> Parse_<minus>)
303
- (if (not (= (fail) Parse_<st_input>))
304
- (shen-reassemble (fst Parse_<st_input>)
305
- (cons :- (snd Parse_<st_input>)))
306
- (fail)))
307
- (fail)))
308
- (fail)))
309
- (if (= Result (fail))
310
- (let Result
311
- (let Parse_<colon> (shen-<colon> V980)
312
- (if (not (= (fail) Parse_<colon>))
313
- (let Parse_<st_input> (shen-<st_input> Parse_<colon>)
314
- (if (not (= (fail) Parse_<st_input>))
315
- (shen-reassemble (fst Parse_<st_input>)
316
- (cons : (snd Parse_<st_input>)))
317
- (fail)))
318
- (fail)))
319
- (if (= Result (fail))
320
- (let Result
321
- (let Parse_<comma> (shen-<comma> V980)
322
- (if (not (= (fail) Parse_<comma>))
323
- (let Parse_<st_input> (shen-<st_input> Parse_<comma>)
324
- (if (not (= (fail) Parse_<st_input>))
325
- (shen-reassemble (fst Parse_<st_input>)
326
- (cons shen- (snd Parse_<st_input>)))
327
- (fail)))
328
- (fail)))
329
- (if (= Result (fail))
330
- (let Result
331
- (let Parse_<comment> (shen-<comment> V980)
332
- (if (not (= (fail) Parse_<comment>))
333
- (let Parse_<st_input> (shen-<st_input> Parse_<comment>)
334
- (if (not (= (fail) Parse_<st_input>))
335
- (shen-reassemble (fst Parse_<st_input>)
336
- (snd Parse_<st_input>))
337
- (fail)))
338
- (fail)))
339
- (if (= Result (fail))
340
- (let Result
341
- (let Parse_<atom> (shen-<atom> V980)
342
- (if (not (= (fail) Parse_<atom>))
343
- (let Parse_<st_input> (shen-<st_input> Parse_<atom>)
344
- (if (not (= (fail) Parse_<st_input>))
345
- (shen-reassemble (fst Parse_<st_input>)
346
- (cons (macroexpand (snd Parse_<atom>))
347
- (snd Parse_<st_input>)))
348
- (fail)))
349
- (fail)))
350
- (if (= Result (fail))
351
- (let Result
352
- (let Parse_<whitespaces> (shen-<whitespaces> V980)
353
- (if (not (= (fail) Parse_<whitespaces>))
354
- (let Parse_<st_input>
355
- (shen-<st_input> Parse_<whitespaces>)
356
- (if (not (= (fail) Parse_<st_input>))
357
- (shen-reassemble (fst Parse_<st_input>)
358
- (snd Parse_<st_input>))
359
- (fail)))
360
- (fail)))
361
- (if (= Result (fail))
362
- (let Result
363
- (let Parse_<e> (<e> V980)
364
- (if (not (= (fail) Parse_<e>))
365
- (shen-reassemble (fst Parse_<e>) ()) (fail)))
366
- (if (= Result (fail)) (fail) Result))
367
- Result))
368
- Result))
369
- Result))
370
- Result))
371
- Result))
372
- Result))
373
- Result))
374
- Result))
375
- Result))
376
- Result))
377
- Result))
378
- Result))
379
- Result)))
380
-
381
- (defun shen-<lsb> (V981)
382
- (let Result
383
- (if (cons? (fst V981))
384
- (shen-reassemble (fst (shen-reassemble (tl (fst V981)) (snd V981)))
385
- (if (= (hd (fst V981)) 91) shen-skip (fail)))
386
- (fail))
387
- (if (= Result (fail)) (fail) Result)))
388
-
389
- (defun shen-<rsb> (V982)
390
- (let Result
391
- (if (cons? (fst V982))
392
- (shen-reassemble (fst (shen-reassemble (tl (fst V982)) (snd V982)))
393
- (if (= (hd (fst V982)) 93) shen-skip (fail)))
394
- (fail))
395
- (if (= Result (fail)) (fail) Result)))
396
-
397
- (defun shen-<lcurly> (V983)
398
- (let Result
399
- (if (cons? (fst V983))
400
- (shen-reassemble (fst (shen-reassemble (tl (fst V983)) (snd V983)))
401
- (if (= (hd (fst V983)) 123) shen-skip (fail)))
402
- (fail))
403
- (if (= Result (fail)) (fail) Result)))
404
-
405
- (defun shen-<rcurly> (V984)
406
- (let Result
407
- (if (cons? (fst V984))
408
- (shen-reassemble (fst (shen-reassemble (tl (fst V984)) (snd V984)))
409
- (if (= (hd (fst V984)) 125) shen-skip (fail)))
410
- (fail))
411
- (if (= Result (fail)) (fail) Result)))
412
-
413
- (defun shen-<bar> (V985)
414
- (let Result
415
- (if (cons? (fst V985))
416
- (shen-reassemble (fst (shen-reassemble (tl (fst V985)) (snd V985)))
417
- (if (= (hd (fst V985)) 124) shen-skip (fail)))
418
- (fail))
419
- (if (= Result (fail)) (fail) Result)))
420
-
421
- (defun shen-<semicolon> (V986)
422
- (let Result
423
- (if (cons? (fst V986))
424
- (shen-reassemble (fst (shen-reassemble (tl (fst V986)) (snd V986)))
425
- (if (= (hd (fst V986)) 59) shen-skip (fail)))
426
- (fail))
427
- (if (= Result (fail)) (fail) Result)))
428
-
429
- (defun shen-<colon> (V987)
430
- (let Result
431
- (if (cons? (fst V987))
432
- (shen-reassemble (fst (shen-reassemble (tl (fst V987)) (snd V987)))
433
- (if (= (hd (fst V987)) 58) shen-skip (fail)))
434
- (fail))
435
- (if (= Result (fail)) (fail) Result)))
436
-
437
- (defun shen-<comma> (V988)
438
- (let Result
439
- (if (cons? (fst V988))
440
- (shen-reassemble (fst (shen-reassemble (tl (fst V988)) (snd V988)))
441
- (if (= (hd (fst V988)) 44) shen-skip (fail)))
442
- (fail))
443
- (if (= Result (fail)) (fail) Result)))
444
-
445
- (defun shen-<equal> (V989)
446
- (let Result
447
- (if (cons? (fst V989))
448
- (shen-reassemble (fst (shen-reassemble (tl (fst V989)) (snd V989)))
449
- (if (= (hd (fst V989)) 61) shen-skip (fail)))
450
- (fail))
451
- (if (= Result (fail)) (fail) Result)))
452
-
453
- (defun shen-<minus> (V990)
454
- (let Result
455
- (if (cons? (fst V990))
456
- (shen-reassemble (fst (shen-reassemble (tl (fst V990)) (snd V990)))
457
- (if (= (hd (fst V990)) 45) shen-skip (fail)))
458
- (fail))
459
- (if (= Result (fail)) (fail) Result)))
460
-
461
- (defun shen-<lrb> (V991)
462
- (let Result
463
- (if (cons? (fst V991))
464
- (shen-reassemble (fst (shen-reassemble (tl (fst V991)) (snd V991)))
465
- (if (= (hd (fst V991)) 40) shen-skip (fail)))
466
- (fail))
467
- (if (= Result (fail)) (fail) Result)))
468
-
469
- (defun shen-<rrb> (V992)
470
- (let Result
471
- (if (cons? (fst V992))
472
- (shen-reassemble (fst (shen-reassemble (tl (fst V992)) (snd V992)))
473
- (if (= (hd (fst V992)) 41) shen-skip (fail)))
474
- (fail))
475
- (if (= Result (fail)) (fail) Result)))
476
-
477
- (defun shen-<atom> (V993)
478
- (let Result
479
- (let Parse_<str> (shen-<str> V993)
480
- (if (not (= (fail) Parse_<str>))
481
- (shen-reassemble (fst Parse_<str>) (shen-control-chars (snd Parse_<str>)))
482
- (fail)))
483
- (if (= Result (fail))
484
- (let Result
485
- (let Parse_<number> (shen-<number> V993)
486
- (if (not (= (fail) Parse_<number>))
487
- (shen-reassemble (fst Parse_<number>) (snd Parse_<number>)) (fail)))
488
- (if (= Result (fail))
489
- (let Result
490
- (let Parse_<sym> (shen-<sym> V993)
491
- (if (not (= (fail) Parse_<sym>))
492
- (shen-reassemble (fst Parse_<sym>) (snd Parse_<sym>)) (fail)))
493
- (if (= Result (fail)) (fail) Result))
494
- Result))
495
- Result)))
496
-
497
- (defun shen-control-chars (V994)
498
- (cond ((= () V994) "")
499
- ((and (cons? V994)
500
- (and (= "c" (hd V994))
501
- (and (cons? (tl V994)) (= "#" (hd (tl V994))))))
502
- (let CodePoint (shen-code-point (tl (tl V994)))
503
- (let AfterCodePoint (shen-after-codepoint (tl (tl V994)))
504
- (@s (n->string (shen-decimalise CodePoint))
505
- (shen-control-chars AfterCodePoint)))))
506
- ((cons? V994) (@s (hd V994) (shen-control-chars (tl V994))))
507
- (true (shen-sys-error shen-control-chars))))
508
-
509
- (defun shen-code-point (V997)
510
- (cond ((and (cons? V997) (= ";" (hd V997))) "")
511
- ((and (cons? V997)
512
- (element? (hd V997)
513
- (cons "0"
514
- (cons "1"
515
- (cons "2"
516
- (cons "3"
517
- (cons "4"
518
- (cons "5"
519
- (cons "6" (cons "7" (cons "8" (cons "9" (cons "0" ())))))))))))))
520
- (cons (hd V997) (shen-code-point (tl V997))))
521
- (true (interror "code point parse error ~A~%" (@p V997 ())))))
522
-
523
- (defun shen-after-codepoint (V1002)
524
- (cond ((= () V1002) ())
525
- ((and (cons? V1002) (= ";" (hd V1002))) (tl V1002))
526
- ((cons? V1002) (shen-after-codepoint (tl V1002)))
527
- (true (shen-sys-error shen-after-codepoint))))
528
-
529
- (defun shen-decimalise (V1003)
530
- (shen-pre (reverse (shen-digits->integers V1003)) 0))
531
-
532
- (defun shen-digits->integers (V1008)
533
- (cond
534
- ((and (cons? V1008) (= "0" (hd V1008)))
535
- (cons 0 (shen-digits->integers (tl V1008))))
536
- ((and (cons? V1008) (= "1" (hd V1008)))
537
- (cons 1 (shen-digits->integers (tl V1008))))
538
- ((and (cons? V1008) (= "2" (hd V1008)))
539
- (cons 2 (shen-digits->integers (tl V1008))))
540
- ((and (cons? V1008) (= "3" (hd V1008)))
541
- (cons 3 (shen-digits->integers (tl V1008))))
542
- ((and (cons? V1008) (= "4" (hd V1008)))
543
- (cons 4 (shen-digits->integers (tl V1008))))
544
- ((and (cons? V1008) (= "5" (hd V1008)))
545
- (cons 5 (shen-digits->integers (tl V1008))))
546
- ((and (cons? V1008) (= "6" (hd V1008)))
547
- (cons 6 (shen-digits->integers (tl V1008))))
548
- ((and (cons? V1008) (= "7" (hd V1008)))
549
- (cons 7 (shen-digits->integers (tl V1008))))
550
- ((and (cons? V1008) (= "8" (hd V1008)))
551
- (cons 8 (shen-digits->integers (tl V1008))))
552
- ((and (cons? V1008) (= "9" (hd V1008)))
553
- (cons 9 (shen-digits->integers (tl V1008))))
554
- (true ())))
555
-
556
- (defun shen-<sym> (V1009)
557
- (let Result
558
- (let Parse_<alpha> (shen-<alpha> V1009)
559
- (if (not (= (fail) Parse_<alpha>))
560
- (let Parse_<symchars> (shen-<symchars> Parse_<alpha>)
561
- (if (not (= (fail) Parse_<symchars>))
562
- (shen-reassemble (fst Parse_<symchars>)
563
- (intern (cn (snd Parse_<alpha>) (snd Parse_<symchars>))))
564
- (fail)))
565
- (fail)))
566
- (if (= Result (fail))
567
- (let Result
568
- (let Parse_<alpha> (shen-<alpha> V1009)
569
- (if (not (= (fail) Parse_<alpha>))
570
- (shen-reassemble (fst Parse_<alpha>) (intern (snd Parse_<alpha>)))
571
- (fail)))
572
- (if (= Result (fail)) (fail) Result))
573
- Result)))
574
-
575
- (defun shen-<symchars> (V1010)
576
- (let Result
577
- (let Parse_<symchar> (shen-<symchar> V1010)
578
- (if (not (= (fail) Parse_<symchar>))
579
- (let Parse_<symchars> (shen-<symchars> Parse_<symchar>)
580
- (if (not (= (fail) Parse_<symchars>))
581
- (shen-reassemble (fst Parse_<symchars>)
582
- (cn (snd Parse_<symchar>) (snd Parse_<symchars>)))
583
- (fail)))
584
- (fail)))
585
- (if (= Result (fail))
586
- (let Result
587
- (let Parse_<symchar> (shen-<symchar> V1010)
588
- (if (not (= (fail) Parse_<symchar>))
589
- (shen-reassemble (fst Parse_<symchar>) (snd Parse_<symchar>)) (fail)))
590
- (if (= Result (fail)) (fail) Result))
591
- Result)))
592
-
593
- (defun shen-<symchar> (V1011)
594
- (let Result
595
- (let Parse_<alpha> (shen-<alpha> V1011)
596
- (if (not (= (fail) Parse_<alpha>))
597
- (shen-reassemble (fst Parse_<alpha>) (snd Parse_<alpha>)) (fail)))
598
- (if (= Result (fail))
599
- (let Result
600
- (let Parse_<digit->string> (shen-<digit->string> V1011)
601
- (if (not (= (fail) Parse_<digit->string>))
602
- (shen-reassemble (fst Parse_<digit->string>) (snd Parse_<digit->string>))
603
- (fail)))
604
- (if (= Result (fail)) (fail) Result))
605
- Result)))
606
-
607
- (defun shen-<digit->string> (V1012)
608
- (let Result
609
- (if (cons? (fst V1012))
610
- (shen-reassemble (fst (shen-reassemble (tl (fst V1012)) (snd V1012)))
611
- (if (shen-digit-byte? (hd (fst V1012))) (n->string (hd (fst V1012)))
612
- (fail)))
613
- (fail))
614
- (if (= Result (fail)) (fail) Result)))
615
-
616
- (defun shen-digit-byte? (V1017)
617
- (cond ((= 48 V1017) true) ((= 49 V1017) true) ((= 50 V1017) true)
618
- ((= 51 V1017) true) ((= 52 V1017) true) ((= 53 V1017) true)
619
- ((= 54 V1017) true) ((= 55 V1017) true) ((= 56 V1017) true)
620
- ((= 57 V1017) true) (true false)))
621
-
622
- (defun shen-<alpha> (V1018)
623
- (let Result
624
- (if (cons? (fst V1018))
625
- (shen-reassemble (fst (shen-reassemble (tl (fst V1018)) (snd V1018)))
626
- (let S (shen-symbol-byte->string (hd (fst V1018)))
627
- (if (= S (fail)) (fail) S)))
628
- (fail))
629
- (if (= Result (fail)) (fail) Result)))
630
-
631
- (defun shen-symbol-byte->string (V1019)
632
- (<-address (value shen-*symbolcodes*) V1019))
633
-
634
- (defun shen-<str> (V1020)
635
- (let Result
636
- (let Parse_<dbq> (shen-<dbq> V1020)
637
- (if (not (= (fail) Parse_<dbq>))
638
- (let Parse_<strcontents> (shen-<strcontents> Parse_<dbq>)
639
- (if (not (= (fail) Parse_<strcontents>))
640
- (let Parse_<dbq> (shen-<dbq> Parse_<strcontents>)
641
- (if (not (= (fail) Parse_<dbq>))
642
- (shen-reassemble (fst Parse_<dbq>) (snd Parse_<strcontents>)) (fail)))
643
- (fail)))
644
- (fail)))
645
- (if (= Result (fail)) (fail) Result)))
646
-
647
- (defun shen-<dbq> (V1021)
648
- (let Result
649
- (if (cons? (fst V1021))
650
- (shen-reassemble (fst (shen-reassemble (tl (fst V1021)) (snd V1021)))
651
- (if (= (hd (fst V1021)) 34) shen-skip (fail)))
652
- (fail))
653
- (if (= Result (fail)) (fail) Result)))
654
-
655
- (defun shen-<strcontents> (V1022)
656
- (let Result
657
- (let Parse_<strc> (shen-<strc> V1022)
658
- (if (not (= (fail) Parse_<strc>))
659
- (let Parse_<strcontents> (shen-<strcontents> Parse_<strc>)
660
- (if (not (= (fail) Parse_<strcontents>))
661
- (shen-reassemble (fst Parse_<strcontents>)
662
- (cons (snd Parse_<strc>) (snd Parse_<strcontents>)))
663
- (fail)))
664
- (fail)))
665
- (if (= Result (fail))
666
- (let Result
667
- (let Parse_<e> (<e> V1022)
668
- (if (not (= (fail) Parse_<e>)) (shen-reassemble (fst Parse_<e>) ())
669
- (fail)))
670
- (if (= Result (fail)) (fail) Result))
671
- Result)))
672
-
673
- (defun shen-<byte> (V1023)
674
- (let Result
675
- (if (cons? (fst V1023))
676
- (shen-reassemble (fst (shen-reassemble (tl (fst V1023)) (snd V1023)))
677
- (n->string (hd (fst V1023))))
678
- (fail))
679
- (if (= Result (fail)) (fail) Result)))
680
-
681
- (defun shen-<strc> (V1024)
682
- (let Result
683
- (if (cons? (fst V1024))
684
- (shen-reassemble (fst (shen-reassemble (tl (fst V1024)) (snd V1024)))
685
- (if (= (hd (fst V1024)) 34) (fail) (n->string (hd (fst V1024)))))
686
- (fail))
687
- (if (= Result (fail)) (fail) Result)))
688
-
689
- (defun shen-<backslash> (V1025)
690
- (let Result
691
- (if (cons? (fst V1025))
692
- (shen-reassemble (fst (shen-reassemble (tl (fst V1025)) (snd V1025)))
693
- (if (= (hd (fst V1025)) 92) shen-skip (fail)))
694
- (fail))
695
- (if (= Result (fail)) (fail) Result)))
696
-
697
- (defun shen-<number> (V1026)
698
- (let Result
699
- (let Parse_<minus> (shen-<minus> V1026)
700
- (if (not (= (fail) Parse_<minus>))
701
- (let Parse_<number> (shen-<number> Parse_<minus>)
702
- (if (not (= (fail) Parse_<number>))
703
- (shen-reassemble (fst Parse_<number>) (- 0 (snd Parse_<number>)))
704
- (fail)))
705
- (fail)))
706
- (if (= Result (fail))
707
- (let Result
708
- (let Parse_<plus> (shen-<plus> V1026)
709
- (if (not (= (fail) Parse_<plus>))
710
- (let Parse_<number> (shen-<number> Parse_<plus>)
711
- (if (not (= (fail) Parse_<number>))
712
- (shen-reassemble (fst Parse_<number>) (snd Parse_<number>)) (fail)))
713
- (fail)))
714
- (if (= Result (fail))
715
- (let Result
716
- (let Parse_<predigits> (shen-<predigits> V1026)
717
- (if (not (= (fail) Parse_<predigits>))
718
- (let Parse_<stop> (shen-<stop> Parse_<predigits>)
719
- (if (not (= (fail) Parse_<stop>))
720
- (let Parse_<postdigits> (shen-<postdigits> Parse_<stop>)
721
- (if (not (= (fail) Parse_<postdigits>))
722
- (let Parse_<E> (shen-<E> Parse_<postdigits>)
723
- (if (not (= (fail) Parse_<E>))
724
- (let Parse_<log10> (shen-<log10> Parse_<E>)
725
- (if (not (= (fail) Parse_<log10>))
726
- (shen-reassemble (fst Parse_<log10>)
727
- (* (shen-expt 10 (snd Parse_<log10>))
728
- (+ (shen-pre (reverse (snd Parse_<predigits>)) 0)
729
- (shen-post (snd Parse_<postdigits>) 1))))
730
- (fail)))
731
- (fail)))
732
- (fail)))
733
- (fail)))
734
- (fail)))
735
- (if (= Result (fail))
736
- (let Result
737
- (let Parse_<digits> (shen-<digits> V1026)
738
- (if (not (= (fail) Parse_<digits>))
739
- (let Parse_<E> (shen-<E> Parse_<digits>)
740
- (if (not (= (fail) Parse_<E>))
741
- (let Parse_<log10> (shen-<log10> Parse_<E>)
742
- (if (not (= (fail) Parse_<log10>))
743
- (shen-reassemble (fst Parse_<log10>)
744
- (* (shen-expt 10 (snd Parse_<log10>))
745
- (shen-pre (reverse (snd Parse_<digits>)) 0)))
746
- (fail)))
747
- (fail)))
748
- (fail)))
749
- (if (= Result (fail))
750
- (let Result
751
- (let Parse_<predigits> (shen-<predigits> V1026)
752
- (if (not (= (fail) Parse_<predigits>))
753
- (let Parse_<stop> (shen-<stop> Parse_<predigits>)
754
- (if (not (= (fail) Parse_<stop>))
755
- (let Parse_<postdigits> (shen-<postdigits> Parse_<stop>)
756
- (if (not (= (fail) Parse_<postdigits>))
757
- (shen-reassemble (fst Parse_<postdigits>)
758
- (+ (shen-pre (reverse (snd Parse_<predigits>)) 0)
759
- (shen-post (snd Parse_<postdigits>) 1)))
760
- (fail)))
761
- (fail)))
762
- (fail)))
763
- (if (= Result (fail))
764
- (let Result
765
- (let Parse_<digits> (shen-<digits> V1026)
766
- (if (not (= (fail) Parse_<digits>))
767
- (shen-reassemble (fst Parse_<digits>)
768
- (shen-pre (reverse (snd Parse_<digits>)) 0))
769
- (fail)))
770
- (if (= Result (fail)) (fail) Result))
771
- Result))
772
- Result))
773
- Result))
774
- Result))
775
- Result)))
776
-
777
- (defun shen-<E> (V1027)
778
- (let Result
779
- (if (and (cons? (fst V1027)) (= 101 (hd (fst V1027))))
780
- (shen-reassemble (fst (shen-reassemble (tl (fst V1027)) (snd V1027)))
781
- (cons 101 ()))
782
- (fail))
783
- (if (= Result (fail)) (fail) Result)))
784
-
785
- (defun shen-<log10> (V1028)
786
- (let Result
787
- (let Parse_<minus> (shen-<minus> V1028)
788
- (if (not (= (fail) Parse_<minus>))
789
- (let Parse_<digits> (shen-<digits> Parse_<minus>)
790
- (if (not (= (fail) Parse_<digits>))
791
- (shen-reassemble (fst Parse_<digits>)
792
- (- 0 (shen-pre (reverse (snd Parse_<digits>)) 0)))
793
- (fail)))
794
- (fail)))
795
- (if (= Result (fail))
796
- (let Result
797
- (let Parse_<digits> (shen-<digits> V1028)
798
- (if (not (= (fail) Parse_<digits>))
799
- (shen-reassemble (fst Parse_<digits>)
800
- (shen-pre (reverse (snd Parse_<digits>)) 0))
801
- (fail)))
802
- (if (= Result (fail)) (fail) Result))
803
- Result)))
804
-
805
- (defun shen-<plus> (V1029)
806
- (let Result
807
- (if (cons? (fst V1029))
808
- (shen-reassemble (fst (shen-reassemble (tl (fst V1029)) (snd V1029)))
809
- (if (= (hd (fst V1029)) 43) shen-skip (fail)))
810
- (fail))
811
- (if (= Result (fail)) (fail) Result)))
812
-
813
- (defun shen-<stop> (V1030)
814
- (let Result
815
- (if (cons? (fst V1030))
816
- (shen-reassemble (fst (shen-reassemble (tl (fst V1030)) (snd V1030)))
817
- (if (= (hd (fst V1030)) 46) shen-skip (fail)))
818
- (fail))
819
- (if (= Result (fail)) (fail) Result)))
820
-
821
- (defun shen-<predigits> (V1031)
822
- (let Result
823
- (let Parse_<digits> (shen-<digits> V1031)
824
- (if (not (= (fail) Parse_<digits>))
825
- (shen-reassemble (fst Parse_<digits>) (snd Parse_<digits>)) (fail)))
826
- (if (= Result (fail))
827
- (let Result
828
- (let Parse_<e> (<e> V1031)
829
- (if (not (= (fail) Parse_<e>)) (shen-reassemble (fst Parse_<e>) ())
830
- (fail)))
831
- (if (= Result (fail)) (fail) Result))
832
- Result)))
833
-
834
- (defun shen-<postdigits> (V1032)
835
- (let Result
836
- (let Parse_<digits> (shen-<digits> V1032)
837
- (if (not (= (fail) Parse_<digits>))
838
- (shen-reassemble (fst Parse_<digits>) (snd Parse_<digits>)) (fail)))
839
- (if (= Result (fail)) (fail) Result)))
840
-
841
- (defun shen-<digits> (V1033)
842
- (let Result
843
- (let Parse_<digit> (shen-<digit> V1033)
844
- (if (not (= (fail) Parse_<digit>))
845
- (let Parse_<digits> (shen-<digits> Parse_<digit>)
846
- (if (not (= (fail) Parse_<digits>))
847
- (shen-reassemble (fst Parse_<digits>)
848
- (cons (snd Parse_<digit>) (snd Parse_<digits>)))
849
- (fail)))
850
- (fail)))
851
- (if (= Result (fail))
852
- (let Result
853
- (let Parse_<digit> (shen-<digit> V1033)
854
- (if (not (= (fail) Parse_<digit>))
855
- (shen-reassemble (fst Parse_<digit>) (cons (snd Parse_<digit>) ()))
856
- (fail)))
857
- (if (= Result (fail)) (fail) Result))
858
- Result)))
859
-
860
- (defun shen-<digit> (V1034)
861
- (let Result
862
- (if (cons? (fst V1034))
863
- (shen-reassemble (fst (shen-reassemble (tl (fst V1034)) (snd V1034)))
864
- (if (shen-digit-byte? (hd (fst V1034))) (shen-byte->digit (hd (fst V1034)))
865
- (fail)))
866
- (fail))
867
- (if (= Result (fail)) (fail) Result)))
868
-
869
- (defun shen-byte->digit (V1035)
870
- (cond ((= 48 V1035) 0) ((= 49 V1035) 1) ((= 50 V1035) 2)
871
- ((= 51 V1035) 3) ((= 52 V1035) 4) ((= 53 V1035) 5)
872
- ((= 54 V1035) 6) ((= 55 V1035) 7) ((= 56 V1035) 8)
873
- ((= 57 V1035) 9) (true (shen-sys-error shen-byte->digit))))
874
-
875
- (defun shen-pre (V1038 V1039)
876
- (cond ((= () V1038) 0)
877
- ((cons? V1038)
878
- (+ (* (shen-expt 10 V1039) (hd V1038)) (shen-pre (tl V1038) (+ V1039 1))))
879
- (true (shen-sys-error shen-pre))))
880
-
881
- (defun shen-post (V1042 V1043)
882
- (cond ((= () V1042) 0)
883
- ((cons? V1042)
884
- (+ (* (shen-expt 10 (- 0 V1043)) (hd V1042))
885
- (shen-post (tl V1042) (+ V1043 1))))
886
- (true (shen-sys-error shen-post))))
887
-
888
- (defun shen-expt (V1046 V1047)
889
- (cond ((= 0 V1047) 1)
890
- ((> V1047 0) (* V1046 (shen-expt V1046 (- V1047 1))))
891
- (true (* 1.0 (/ (shen-expt V1046 (+ V1047 1)) V1046)))))
892
-
893
- (defun shen-<st_input1> (V1048)
894
- (let Result
895
- (let Parse_<st_input> (shen-<st_input> V1048)
896
- (if (not (= (fail) Parse_<st_input>))
897
- (shen-reassemble (fst Parse_<st_input>) (snd Parse_<st_input>)) (fail)))
898
- (if (= Result (fail)) (fail) Result)))
899
-
900
- (defun shen-<st_input2> (V1049)
901
- (let Result
902
- (let Parse_<st_input> (shen-<st_input> V1049)
903
- (if (not (= (fail) Parse_<st_input>))
904
- (shen-reassemble (fst Parse_<st_input>) (snd Parse_<st_input>)) (fail)))
905
- (if (= Result (fail)) (fail) Result)))
906
-
907
- (defun shen-<comment> (V1050)
908
- (let Result
909
- (let Parse_<backslash> (shen-<backslash> V1050)
910
- (if (not (= (fail) Parse_<backslash>))
911
- (let Parse_<times> (shen-<times> Parse_<backslash>)
912
- (if (not (= (fail) Parse_<times>))
913
- (let Parse_<any> (shen-<any> Parse_<times>)
914
- (if (not (= (fail) Parse_<any>))
915
- (let Parse_<times> (shen-<times> Parse_<any>)
916
- (if (not (= (fail) Parse_<times>))
917
- (let Parse_<backslash> (shen-<backslash> Parse_<times>)
918
- (if (not (= (fail) Parse_<backslash>))
919
- (shen-reassemble (fst Parse_<backslash>) shen-skip) (fail)))
920
- (fail)))
921
- (fail)))
922
- (fail)))
923
- (fail)))
924
- (if (= Result (fail)) (fail) Result)))
925
-
926
- (defun shen-<times> (V1051)
927
- (let Result
928
- (if (cons? (fst V1051))
929
- (shen-reassemble (fst (shen-reassemble (tl (fst V1051)) (snd V1051)))
930
- (if (= (hd (fst V1051)) 42) shen-skip (fail)))
931
- (fail))
932
- (if (= Result (fail)) (fail) Result)))
933
-
934
- (defun shen-<any> (V1052)
935
- (let Result
936
- (let Parse_<comment> (shen-<comment> V1052)
937
- (if (not (= (fail) Parse_<comment>))
938
- (let Parse_<any> (shen-<any> Parse_<comment>)
939
- (if (not (= (fail) Parse_<any>))
940
- (shen-reassemble (fst Parse_<any>) shen-skip) (fail)))
941
- (fail)))
942
- (if (= Result (fail))
943
- (let Result
944
- (let Parse_<blah> (shen-<blah> V1052)
945
- (if (not (= (fail) Parse_<blah>))
946
- (let Parse_<any> (shen-<any> Parse_<blah>)
947
- (if (not (= (fail) Parse_<any>))
948
- (shen-reassemble (fst Parse_<any>) shen-skip) (fail)))
949
- (fail)))
950
- (if (= Result (fail))
951
- (let Result
952
- (let Parse_<e> (<e> V1052)
953
- (if (not (= (fail) Parse_<e>))
954
- (shen-reassemble (fst Parse_<e>) shen-skip) (fail)))
955
- (if (= Result (fail)) (fail) Result))
956
- Result))
957
- Result)))
958
-
959
- (defun shen-<blah> (V1053)
960
- (let Result
961
- (if (cons? (fst V1053))
962
- (shen-reassemble (fst (shen-reassemble (tl (fst V1053)) (snd V1053)))
963
- (if (shen-end-of-comment? (fst V1053)) (fail) shen-skip))
964
- (fail))
965
- (if (= Result (fail)) (fail) Result)))
966
-
967
- (defun shen-end-of-comment? (V1060)
968
- (cond
969
- ((and (cons? V1060)
970
- (and (= 42 (hd V1060))
971
- (and (cons? (tl V1060)) (= 92 (hd (tl V1060))))))
972
- true)
973
- (true false)))
974
-
975
- (defun shen-<whitespaces> (V1061)
976
- (let Result
977
- (let Parse_<whitespace> (shen-<whitespace> V1061)
978
- (if (not (= (fail) Parse_<whitespace>))
979
- (let Parse_<whitespaces> (shen-<whitespaces> Parse_<whitespace>)
980
- (if (not (= (fail) Parse_<whitespaces>))
981
- (shen-reassemble (fst Parse_<whitespaces>) shen-skip) (fail)))
982
- (fail)))
983
- (if (= Result (fail))
984
- (let Result
985
- (let Parse_<whitespace> (shen-<whitespace> V1061)
986
- (if (not (= (fail) Parse_<whitespace>))
987
- (shen-reassemble (fst Parse_<whitespace>) shen-skip) (fail)))
988
- (if (= Result (fail)) (fail) Result))
989
- Result)))
990
-
991
- (defun shen-<whitespace> (V1062)
992
- (let Result
993
- (if (cons? (fst V1062))
994
- (shen-reassemble (fst (shen-reassemble (tl (fst V1062)) (snd V1062)))
995
- (let Case (hd (fst V1062))
996
- (if (= Case 32) shen-skip
997
- (if (= Case 13) shen-skip
998
- (if (= Case 10) shen-skip (if (= Case 9) shen-skip (fail)))))))
999
- (fail))
1000
- (if (= Result (fail)) (fail) Result)))
1001
-
1002
- (defun shen-cons_form (V1063)
1003
- (cond ((= () V1063) ())
1004
- ((and (cons? V1063)
1005
- (and (cons? (tl V1063))
1006
- (and (= bar! (hd (tl V1063)))
1007
- (and (cons? (tl (tl V1063))) (= () (tl (tl (tl V1063))))))))
1008
- (cons cons (cons (hd V1063) (tl (tl V1063)))))
1009
- ((cons? V1063)
1010
- (cons cons (cons (hd V1063) (cons (shen-cons_form (tl V1063)) ()))))
1011
- (true (shen-sys-error shen-cons_form))))
1012
-
1013
- (defun shen-package-macro (V1066 V1067)
1014
- (cond
1015
- ((and (cons? V1066)
1016
- (and (= $ (hd V1066))
1017
- (and (cons? (tl V1066)) (= () (tl (tl V1066))))))
1018
- (append (explode (hd (tl V1066))) V1067))
1019
- ((and (cons? V1066)
1020
- (and (= package (hd V1066))
1021
- (and (cons? (tl V1066))
1022
- (and (= null (hd (tl V1066))) (cons? (tl (tl V1066)))))))
1023
- (append (tl (tl (tl V1066))) V1067))
1024
- ((and (cons? V1066)
1025
- (and (= package (hd V1066))
1026
- (and (cons? (tl V1066)) (cons? (tl (tl V1066))))))
1027
- (let ListofExceptions (shen-eval-without-macros (hd (tl (tl V1066))))
1028
- (let Record (shen-record-exceptions ListofExceptions (hd (tl V1066)))
1029
- (append
1030
- (shen-packageh (hd (tl V1066)) ListofExceptions (tl (tl (tl V1066))))
1031
- V1067))))
1032
- (true (cons V1066 V1067))))
1033
-
1034
- (defun shen-record-exceptions (V1068 V1069)
1035
- (let CurrExceptions
1036
- (trap-error (get V1069 shen-external-symbols (value shen-*property-vector*))
1037
- (lambda E ()))
1038
- (let AllExceptions (union V1068 CurrExceptions)
1039
- (put V1069 shen-external-symbols AllExceptions
1040
- (value shen-*property-vector*)))))
1041
-
1042
- (defun shen-packageh (V1078 V1079 V1080)
1043
- (cond
1044
- ((cons? V1080)
1045
- (cons (shen-packageh V1078 V1079 (hd V1080))
1046
- (shen-packageh V1078 V1079 (tl V1080))))
1047
- ((or (shen-sysfunc? V1080)
1048
- (or (variable? V1080)
1049
- (or (element? V1080 V1079)
1050
- (or (shen-doubleunderline? V1080) (shen-singleunderline? V1080)))))
1051
- V1080)
1052
- ((and (symbol? V1080)
1053
- (not
1054
- (shen-prefix? (cons "s" (cons "h" (cons "e" (cons "n" (cons "-" ())))))
1055
- (explode V1080))))
1056
- (concat V1078 V1080))
1057
- (true V1080)))
1058
-
1059
- (defun read-from-string (V466)
1060
- (let Ns (map (lambda V465 (string->n V465)) (explode V466))
1061
- (compile shen-<st_input> Ns shen-read-error)))
1062
181