shen-ruby 0.9.0 → 0.10.0
Sign up to get free protection for your applications and to get access to all the features.
- checksums.yaml +4 -4
- data/HISTORY.md +4 -0
- data/README.md +8 -8
- data/lib/shen_ruby/version.rb +1 -1
- data/shen-ruby.gemspec +1 -1
- data/shen/release/benchmarks/jnk.shen +194 -0
- data/shen/release/k_lambda/declarations.kl +3 -3
- data/shen/release/k_lambda/macros.kl +0 -16
- data/shen/release/k_lambda/prolog.kl +1 -1
- data/shen/release/k_lambda/reader.kl +89 -79
- data/shen/release/k_lambda/sequent.kl +55 -55
- data/shen/release/k_lambda/sys.kl +98 -98
- data/shen/release/k_lambda/t-star.kl +37 -72
- data/shen/release/k_lambda/toplevel.kl +21 -21
- data/shen/release/k_lambda/track.kl +25 -25
- data/shen/release/k_lambda/types.kl +13 -5
- data/shen/release/k_lambda/writer.kl +25 -25
- data/shen/release/k_lambda/yacc.kl +28 -28
- data/shen/release/test_programs/einstein.shen +3 -2
- data/shen/release/test_programs/qmachine.shen +3 -3
- metadata +4 -3
checksums.yaml
CHANGED
@@ -1,7 +1,7 @@
|
|
1
1
|
---
|
2
2
|
SHA1:
|
3
|
-
metadata.gz:
|
4
|
-
data.tar.gz:
|
3
|
+
metadata.gz: 4388a5a344cbc54d04a341a42a341cf05aae8ebc
|
4
|
+
data.tar.gz: 2777d3e71e1f2f90a953487007f4c6b4fdcaf97a
|
5
5
|
SHA512:
|
6
|
-
metadata.gz:
|
7
|
-
data.tar.gz:
|
6
|
+
metadata.gz: 1655075e45839d973a8a5bc310cc7a8399ac155960261e968785932a1cb733082a15d084dd3ea669cfe28fbc64ec19b6af54c59e46542fef0b99489290a8491f
|
7
|
+
data.tar.gz: be259a2837137dd278a3d8c6a9912df4051ed953a82805b5b138b72e1c7e7cd1e4dea991f0655ca63793ae68532025371a65ee67cdca8e276e8a551729b078b3
|
data/HISTORY.md
CHANGED
data/README.md
CHANGED
@@ -1,9 +1,9 @@
|
|
1
1
|
# ShenRuby
|
2
2
|
ShenRuby is a Ruby port of the [Shen](http://shenlanguage.org/) programming language. Shen is a modern, functional Lisp that supports pattern matching, currying, and optional static type checking.
|
3
3
|
|
4
|
-
ShenRuby supports Shen version
|
4
|
+
ShenRuby supports Shen version 16, which was released in September, 2014.
|
5
5
|
|
6
|
-
The ShenRuby project has two primary goals. The first is to be a low barrier-to-entry means for Rubyists to explore Shen. To someone with a working installation of Ruby 1.9.3, a Shen REPL is only a gem install away.
|
6
|
+
The ShenRuby project has two primary goals. The first is to be a low barrier-to-entry means for Rubyists to explore Shen. To someone with a working installation of Ruby 1.9.3 or greater, a Shen REPL is only a gem install away.
|
7
7
|
|
8
8
|
Second, ShenRuby aims to enable hybrid applications implemented using a combination of Ruby and Shen. Ruby methods should be able to invoke functions written in Shen and vice versa. Performance is a secondary part of this goal. It should be good enough that, for most tasks, the choice between Ruby and Shen is based primarily on which language is best suited for solving the problem at hand.
|
9
9
|
|
@@ -14,7 +14,7 @@ ShenRuby 0.1.0 began to satisfy the first goal by providing a Shen REPL accessib
|
|
14
14
|
## Installation
|
15
15
|
NOTE: ShenRuby requires Ruby 1.9 language features. It has been tested with Ruby 1.9.3 and Ruby 2.0.0. It has been lightly tested with JRuby 1.7.8.
|
16
16
|
|
17
|
-
ShenRuby 0.
|
17
|
+
ShenRuby 0.10.0 is the current release. To install it as a gem, use the following command:
|
18
18
|
|
19
19
|
gem install shen-ruby
|
20
20
|
|
@@ -23,18 +23,18 @@ ShenRuby 0.9.0 is the current release. To install it as a gem, use the following
|
|
23
23
|
Once the gem has been installed, the Shen REPL can be launched via the `srrepl` (short for ShenRuby REPL) command. For example:
|
24
24
|
|
25
25
|
% srrepl
|
26
|
-
Loading.... Completed in
|
26
|
+
Loading.... Completed in 7.04 seconds.
|
27
27
|
|
28
28
|
Shen 2010, copyright (C) 2010 Mark Tarver
|
29
29
|
released under the Shen license
|
30
|
-
www.shenlanguage.org, version
|
30
|
+
www.shenlanguage.org, version 16
|
31
31
|
running under Ruby, implementation: ruby 2.0.0
|
32
|
-
port 0.
|
32
|
+
port 0.10.0 ported by Greg Spurrier
|
33
33
|
|
34
34
|
|
35
35
|
(0-)
|
36
36
|
|
37
|
-
Please be patient: the Shen REPL takes a while to load (about
|
37
|
+
Please be patient: the Shen REPL takes a while to load (about 7 seconds on a 2.66 GHz MacBook Pro). This will be addressed in future releases.
|
38
38
|
|
39
39
|
The `(0-)` seen above is the Shen REPL prompt. The number in the prompt increases after each expression that is entered.
|
40
40
|
|
@@ -140,7 +140,7 @@ The following resources may be helpful for those wanting to learn more about the
|
|
140
140
|
- [Learn Shen](http://www.shenlanguage.org/learn-shen/index.html) -- The Shen Website's suggested resources for--and approaches to--learning Shen, including the [Shen in 15 Minutes](http://www.shenlanguage.org/learn-shen/tutorials/shen_in_15mins.html) tutorial for experienced functional programmers.
|
141
141
|
- [The Shen Official Standard](http://www.shenlanguage.org/Documentation/shendoc.htm)
|
142
142
|
- [System Functions and their Types in Shen](http://www.shenlanguage.org/learn-shen/system.pdf) -- A reference for all of the standard Shen functions and their types.
|
143
|
-
- [The Book of Shen](http://www.fast-print.net/bookshop/
|
143
|
+
- [The Book of Shen (Second Edition)](http://www.fast-print.net/bookshop/1506/the-book-of-shen-second-edition) -- The official guide to the Shen programming language.
|
144
144
|
- [Shen Google Group](https://groups.google.com/group/qilang?hl=en) -- This is the online forum for discussions related to Shen.
|
145
145
|
|
146
146
|
## Road Map to 1.0
|
data/lib/shen_ruby/version.rb
CHANGED
data/shen-ruby.gemspec
CHANGED
@@ -12,7 +12,7 @@ Gem::Specification.new do |s|
|
|
12
12
|
s.email = ["greg@sourcematters.org"]
|
13
13
|
s.homepage = "https://github.com/gregspurrier/shen-ruby"
|
14
14
|
s.summary = %q{ShenRuby is a Ruby port of the Shen programming language}
|
15
|
-
s.description = %q{ShenRuby is a port of the Shen programming language to Ruby. It currently supports Shen version
|
15
|
+
s.description = %q{ShenRuby is a port of the Shen programming language to Ruby. It currently supports Shen version 16.}
|
16
16
|
|
17
17
|
s.required_ruby_version = ">= 1.9.3"
|
18
18
|
|
@@ -0,0 +1,194 @@
|
|
1
|
+
(define kl-to-lisp
|
2
|
+
Params Param -> Param where (element? Param Params)
|
3
|
+
Params [type X _] -> (kl-to-lisp Params X)
|
4
|
+
Params [lambda X Y] -> [FUNCTION [LAMBDA [X] (kl-to-lisp [X | Params] Y)]]
|
5
|
+
Params [let X Y Z] -> [LET [[X (kl-to-lisp Params Y)]]
|
6
|
+
(kl-to-lisp [X | Params] Z)]
|
7
|
+
_ [defun F Params Code] -> [DEFUN F Params (kl-to-lisp Params Code)]
|
8
|
+
Params [cond | Cond] -> [COND | (map (/. C (cond_code Params C)) (insert-default Cond))]
|
9
|
+
Params [Param | X] -> (higher-order-code Param
|
10
|
+
(map (/. Y (kl-to-lisp Params Y)) X))
|
11
|
+
where (element? Param Params)
|
12
|
+
Params [[X | Y] | Z] -> (higher-order-code (kl-to-lisp Params [X | Y])
|
13
|
+
(map (/. W (kl-to-lisp Params W)) Z))
|
14
|
+
Params [F | X] -> (assemble-application F
|
15
|
+
(map (/. Y (kl-to-lisp Params Y)) X))
|
16
|
+
where (symbol? F)
|
17
|
+
_ [] -> []
|
18
|
+
_ S -> [QUOTE S] where (or (symbol? S) (boolean? S))
|
19
|
+
_ X -> X)
|
20
|
+
|
21
|
+
(define insert-default
|
22
|
+
[] -> [[true [ERROR "error: cond failure~%"]]]
|
23
|
+
[[true X] | Y] -> [[true X] | Y]
|
24
|
+
[Case | Cases] -> [Case | (insert-default Cases)])
|
25
|
+
|
26
|
+
(define higher-order-code
|
27
|
+
F X -> [let Args [LIST | X]
|
28
|
+
[let NewF [maplispsym F]
|
29
|
+
[trap-error [APPLY NewF Args]
|
30
|
+
[lambda E [COND [[arity-error? F Args]
|
31
|
+
[funcall [EVAL [nest-lambda F NewF]] Args]]
|
32
|
+
[[EQ NewF [QUOTE or]]
|
33
|
+
[funcall [lambda X1 [lambda X2 [or X1 X2]]] Args]]
|
34
|
+
[[EQ NewF [QUOTE and]]
|
35
|
+
[funcall [lambda X1 [lambda X2 [and X1 X2]]] Args]]
|
36
|
+
[[EQ NewF [QUOTE trap-error]]
|
37
|
+
[funcall [lambda X1 [lambda X2 [trap-error X1 X2]]] Args]]
|
38
|
+
[[bad-lambda-call? NewF Args]
|
39
|
+
[funcall NewF Args]]
|
40
|
+
[T [relay-error E]]]]]]])
|
41
|
+
|
42
|
+
(define bad-lambda-call?
|
43
|
+
F Args -> (AND (FUNCTIONP F) (NOT (= (LIST-LENGTH Args) 1))))
|
44
|
+
|
45
|
+
(define relay-error
|
46
|
+
E -> (ERROR (error-to-string E)))
|
47
|
+
|
48
|
+
(define funcall
|
49
|
+
Lambda [] -> Lambda
|
50
|
+
Lambda [X | Y] -> (funcall (FUNCALL Lambda X) Y))
|
51
|
+
|
52
|
+
(define arity-error?
|
53
|
+
F Args -> (AND (SYMBOLP F)
|
54
|
+
(> (trap-error (arity F) (/. E -1)) (LIST-LENGTH Args)))
|
55
|
+
|
56
|
+
(define nest-lambda
|
57
|
+
F NewF -> (nest-lambda-help NewF (trap-error (arity F) (/. E -1))))
|
58
|
+
|
59
|
+
(define nest-lambda-help
|
60
|
+
F -1 -> F
|
61
|
+
F 0 -> F
|
62
|
+
F N -> (let X (gensym (protect Y))
|
63
|
+
[lambda X (nest-lambda-help (add-p F X) (- N 1))]))
|
64
|
+
|
65
|
+
(define add-p
|
66
|
+
[F | X] Y -> (append [F | X] [Y])
|
67
|
+
F X -> [F X])
|
68
|
+
|
69
|
+
(define cond_code
|
70
|
+
Params [Test Result] -> [(lisp_test Params Test)
|
71
|
+
(kl-to-lisp Params Result)])
|
72
|
+
|
73
|
+
(define lisp_test
|
74
|
+
_ true -> T
|
75
|
+
Params [and | Tests] -> [AND | (map (/. X (wrap (kl-to-lisp Params X))) Tests)]
|
76
|
+
Params Test -> (wrap (kl-to-lisp Params Test)))
|
77
|
+
|
78
|
+
(define wrap
|
79
|
+
[cons? X] -> [CONSP X]
|
80
|
+
[string? X] -> [STRINGP X]
|
81
|
+
[number? X] -> [NUMBERP X]
|
82
|
+
[empty? X] -> [NULL X]
|
83
|
+
[and P Q] -> [AND (wrap P) (wrap Q)]
|
84
|
+
[or P Q] -> [OR (wrap P) (wrap Q)]
|
85
|
+
[not P] -> [NOT (wrap P)]
|
86
|
+
[equal? X []] -> [NULL X]
|
87
|
+
[equal? [] X] -> [NULL X]
|
88
|
+
[equal? X [Quote Y]] -> [EQ X [Quote Y]]
|
89
|
+
where (and (= (SYMBOLP Y) T) (= Quote QUOTE))
|
90
|
+
[equal? [Quote Y] X] -> [EQ [Quote Y] X]
|
91
|
+
where (and (= (SYMBOLP Y) T) (= Quote QUOTE))
|
92
|
+
[equal? [fail] X] -> [EQ [fail] X]
|
93
|
+
[equal? X [fail]] -> [EQ X [fail]]
|
94
|
+
[equal? S X] -> [EQUAL S X] where (string? S)
|
95
|
+
[equal? X S] -> [EQUAL X S] where (string? S)
|
96
|
+
[equal? X Y] -> [shen-ABSEQUAL X Y]
|
97
|
+
[shen-+string? [tlstr X]] -> [NOT [STRING-EQUAL [tlstr X] ""]]
|
98
|
+
[shen-pvar? X] -> [AND [ARRAYP X] [NOT [STRINGP X]] [EQ [AREF X 0] [QUOTE shen-pvar]]]
|
99
|
+
[tuple? X] -> [AND [ARRAYP X] [NOT [STRINGP X]] [EQ [AREF X 0] [QUOTE shen-tuple]]]
|
100
|
+
[greater? X Y] -> [> X Y]
|
101
|
+
[greater-than-or-equal-to? X Y] -> [>= X Y]
|
102
|
+
[less? X Y] -> [< X Y]
|
103
|
+
[less-than-or-equal-to? X Y] -> [<= X Y]
|
104
|
+
X -> [wrapper X])
|
105
|
+
|
106
|
+
(define wrapper
|
107
|
+
true -> T
|
108
|
+
false -> []
|
109
|
+
X -> (error "boolean expected: not ~S~%" X))
|
110
|
+
|
111
|
+
(define assemble-application
|
112
|
+
hd [X] -> (protect [CAR X])
|
113
|
+
tl [X] -> (protect [CDR X])
|
114
|
+
cons [X Y] -> (protect [CONS X Y])
|
115
|
+
append [X Y] -> (protect [APPEND X Y])
|
116
|
+
reverse [X] -> (protect [REVERSE X])
|
117
|
+
if [P Q R] -> (protect [IF (wrap P) Q R])
|
118
|
+
+ [1 X] -> [1+ X]
|
119
|
+
+ [X 1] -> [1+ X]
|
120
|
+
- [X 1] -> [1- X]
|
121
|
+
value [[Quote X]] -> X where (= Quote (protect QUOTE))
|
122
|
+
set [[Quote X] [1+ X]] -> [INCF X] where (= Quote (protect QUOTE))
|
123
|
+
set [[Quote X] [1- X]] -> [DECF X] where (= Quote (protect QUOTE))
|
124
|
+
F X -> (let NewF (maplispsym F)
|
125
|
+
Arity (trap-error (arity F) (/. E -1))
|
126
|
+
(if (or (= Arity (length X)) (= Arity -1))
|
127
|
+
[NewF | X]
|
128
|
+
[funcall (nest-lambda F NewF) [(protect LIST) | X]])))
|
129
|
+
|
130
|
+
(define maplispsym
|
131
|
+
= -> equal?
|
132
|
+
> -> greater?
|
133
|
+
< -> less?
|
134
|
+
>= -> greater-than-or-equal-to?
|
135
|
+
<= -> less-than-or-equal-to?
|
136
|
+
+ -> add
|
137
|
+
- -> subtract
|
138
|
+
/ -> divide
|
139
|
+
* -> multiply
|
140
|
+
F -> F)
|
141
|
+
|
142
|
+
(define factorh
|
143
|
+
[Defun F Params [Cond | Code]] -> [Defun F Params [BLOCK [] (process-tree (tree (map returns Code)))]]
|
144
|
+
where (and (= Cond COND) (= Defun DEFUN))
|
145
|
+
Code -> Code)
|
146
|
+
|
147
|
+
(define returns
|
148
|
+
[Test Result] -> [Test [RETURN Result]])
|
149
|
+
|
150
|
+
(define process-tree
|
151
|
+
(@p P Q R no-tag) -> [IF P (optimise-selectors P (process-tree Q)) (process-tree R)]
|
152
|
+
(@p P Q R Tag) -> [TAGBODY [IF P (optimise-selectors P (process-tree Q))] Tag (process-tree R)]
|
153
|
+
Q -> Q where (not (tuple? Q)))
|
154
|
+
|
155
|
+
(define optimise-selectors
|
156
|
+
Test Code -> (optimise-selectors-help (selectors-from Test) Code))
|
157
|
+
|
158
|
+
(define selectors-from
|
159
|
+
[Consp X] -> [[CAR X] [CDR X]] where (= Consp CONSP)
|
160
|
+
[tuple? X] -> [[fst X] [snd X]]
|
161
|
+
_ -> [])
|
162
|
+
|
163
|
+
(define optimise-selectors-help
|
164
|
+
[] Code -> Code
|
165
|
+
[S1 S2] Code -> (let O1 (occurrences S1 Code)
|
166
|
+
O2 (occurrences S2 Code)
|
167
|
+
V1 (gensym V)
|
168
|
+
V2 (gensym V)
|
169
|
+
(if (and (> O1 1) (> O2 1))
|
170
|
+
[LET [[V1 S1] [V2 S2]]
|
171
|
+
(subst V1 S1 (subst V2 S2 Code))]
|
172
|
+
(if (> O1 1)
|
173
|
+
[LET [[V1 S1]] (subst V1 S1 Code)]
|
174
|
+
(if (> O2 1)
|
175
|
+
[LET [[V2 S2]] (subst V2 S2 Code)]
|
176
|
+
Code)))))
|
177
|
+
|
178
|
+
(define tree
|
179
|
+
[[[And P Q] R] | S] -> (let Tag (gensym tag)
|
180
|
+
Left (tree (append (branch-by P [[[And P Q] R] | S]) [[T [GO Tag]]]))
|
181
|
+
Right (tree (branch-by-not P [[[And P Q] R] | S]))
|
182
|
+
(@p P Left Right Tag)) where (= And AND)
|
183
|
+
[[True Q] | _] -> Q where (= True T)
|
184
|
+
[[P Q] | R] -> (@p P Q (tree R) no-tag))
|
185
|
+
|
186
|
+
(define branch-by
|
187
|
+
P [[[And P Q] R] | S] -> [[Q R] | (branch-by P S)] where (= And AND)
|
188
|
+
P [[P R] | S] -> [[T R]]
|
189
|
+
_ Code -> [])
|
190
|
+
|
191
|
+
(define branch-by-not
|
192
|
+
P [[[And P Q] R] | S] -> (branch-by-not P S) where (= And AND)
|
193
|
+
P [[P R] | S] -> S
|
194
|
+
_ Code -> Code)
|
@@ -109,19 +109,19 @@
|
|
109
109
|
|
110
110
|
(set shen.*optimise* false)
|
111
111
|
|
112
|
-
(set *version* "version
|
112
|
+
(set *version* "version 16")
|
113
113
|
|
114
114
|
(defun shen.initialise_arity_table (V827) (cond ((= () V827) ()) ((and (cons? V827) (cons? (tl V827))) (let DecArity (put (hd V827) arity (hd (tl V827)) (value *property-vector*)) (shen.initialise_arity_table (tl (tl V827))))) (true (shen.sys-error shen.initialise_arity_table))))
|
115
115
|
|
116
116
|
(defun arity (V828) (trap-error (get V828 arity (value *property-vector*)) (lambda E -1)))
|
117
117
|
|
118
|
-
(shen.initialise_arity_table (cons absvector (cons 1 (cons adjoin (cons 2 (cons and (cons 2 (cons append (cons 2 (cons arity (cons 1 (cons assoc (cons 2 (cons boolean? (cons 1 (cons cd (cons 1 (cons compile (cons 3 (cons concat (cons 2 (cons cons (cons 2 (cons cons? (cons 1 (cons cn (cons 2 (cons declare (cons 2 (cons destroy (cons 1 (cons difference (cons 2 (cons do (cons 2 (cons element? (cons 2 (cons empty? (cons 1 (cons enable-type-theory (cons 1 (cons interror (cons 2 (cons eval (cons 1 (cons eval-kl (cons 1 (cons explode (cons 1 (cons external (cons 1 (cons fail-if (cons 2 (cons fail (cons 0 (cons fix (cons 2 (cons findall (cons 5 (cons freeze (cons 1 (cons fst (cons 1 (cons gensym (cons 1 (cons get (cons 3 (cons get-time (cons 1 (cons address-> (cons 3 (cons <-address (cons 2 (cons <-vector (cons 2 (cons > (cons 2 (cons >= (cons 2 (cons = (cons 2 (cons hd (cons 1 (cons hdv (cons 1 (cons hdstr (cons 1 (cons head (cons 1 (cons if (cons 3 (cons integer? (cons 1 (cons intern (cons 1 (cons identical (cons 4 (cons inferences (cons 0 (cons input (cons 1 (cons input+ (cons 2 (cons implementation (cons 0 (cons intersection (cons 2 (cons kill (cons 0 (cons language (cons 0 (cons length (cons 1 (cons lineread (cons 1 (cons load (cons 1 (cons < (cons 2 (cons <= (cons 2 (cons vector (cons 1 (cons macroexpand (cons 1 (cons map (cons 2 (cons mapcan (cons 2 (cons maxinferences (cons 1 (cons not (cons 1 (cons nth (cons 2 (cons n->string (cons 1 (cons number? (cons 1 (cons occurs-check (cons 1 (cons occurrences (cons 2 (cons occurs-check (cons 1 (cons optimise (cons 1 (cons or (cons 2 (cons os (cons 0 (cons package (cons 3 (cons port (cons 0 (cons porters (cons 0 (cons pos (cons 2 (cons print (cons 1 (cons profile (cons 1 (cons profile-results (cons 1 (cons pr (cons 2 (cons ps (cons 1 (cons preclude (cons 1 (cons preclude-all-but (cons 1 (cons protect (cons 1 (cons address-> (cons 3 (cons put (cons 4 (cons shen.reassemble (cons 2 (cons read-file-as-string (cons 1 (cons read-file (cons 1 (cons read (cons 1 (cons read-byte (cons 1 (cons read-from-string (cons 1 (cons release (cons 0 (cons remove (cons 2 (cons reverse (cons 1 (cons set (cons 2 (cons simple-error (cons 1 (cons snd (cons 1 (cons specialise (cons 1 (cons spy (cons 1 (cons step (cons 1 (cons stinput (cons 0 (cons stoutput (cons 0 (cons string->n (cons 1 (cons string->symbol (cons 1 (cons string? (cons 1 (cons shen.strong-warning (cons 1 (cons subst (cons 3 (cons sum (cons 1 (cons symbol? (cons 1 (cons tail (cons 1 (cons tl (cons 1 (cons tc (cons 1 (cons tc? (cons 0 (cons thaw (cons 1 (cons tlstr (cons 1 (cons track (cons 1 (cons trap-error (cons 2 (cons tuple? (cons 1 (cons type (cons
|
118
|
+
(shen.initialise_arity_table (cons absvector (cons 1 (cons adjoin (cons 2 (cons and (cons 2 (cons append (cons 2 (cons arity (cons 1 (cons assoc (cons 2 (cons boolean? (cons 1 (cons cd (cons 1 (cons compile (cons 3 (cons concat (cons 2 (cons cons (cons 2 (cons cons? (cons 1 (cons cn (cons 2 (cons declare (cons 2 (cons destroy (cons 1 (cons difference (cons 2 (cons do (cons 2 (cons element? (cons 2 (cons empty? (cons 1 (cons enable-type-theory (cons 1 (cons interror (cons 2 (cons eval (cons 1 (cons eval-kl (cons 1 (cons explode (cons 1 (cons external (cons 1 (cons fail-if (cons 2 (cons fail (cons 0 (cons fix (cons 2 (cons findall (cons 5 (cons freeze (cons 1 (cons fst (cons 1 (cons gensym (cons 1 (cons get (cons 3 (cons get-time (cons 1 (cons address-> (cons 3 (cons <-address (cons 2 (cons <-vector (cons 2 (cons > (cons 2 (cons >= (cons 2 (cons = (cons 2 (cons hd (cons 1 (cons hdv (cons 1 (cons hdstr (cons 1 (cons head (cons 1 (cons if (cons 3 (cons integer? (cons 1 (cons intern (cons 1 (cons identical (cons 4 (cons inferences (cons 0 (cons input (cons 1 (cons input+ (cons 2 (cons implementation (cons 0 (cons intersection (cons 2 (cons it (cons 0 (cons kill (cons 0 (cons language (cons 0 (cons length (cons 1 (cons lineread (cons 1 (cons load (cons 1 (cons < (cons 2 (cons <= (cons 2 (cons vector (cons 1 (cons macroexpand (cons 1 (cons map (cons 2 (cons mapcan (cons 2 (cons maxinferences (cons 1 (cons not (cons 1 (cons nth (cons 2 (cons n->string (cons 1 (cons number? (cons 1 (cons occurs-check (cons 1 (cons occurrences (cons 2 (cons occurs-check (cons 1 (cons optimise (cons 1 (cons or (cons 2 (cons os (cons 0 (cons package (cons 3 (cons port (cons 0 (cons porters (cons 0 (cons pos (cons 2 (cons print (cons 1 (cons profile (cons 1 (cons profile-results (cons 1 (cons pr (cons 2 (cons ps (cons 1 (cons preclude (cons 1 (cons preclude-all-but (cons 1 (cons protect (cons 1 (cons address-> (cons 3 (cons put (cons 4 (cons shen.reassemble (cons 2 (cons read-file-as-string (cons 1 (cons read-file (cons 1 (cons read (cons 1 (cons read-byte (cons 1 (cons read-from-string (cons 1 (cons release (cons 0 (cons remove (cons 2 (cons reverse (cons 1 (cons set (cons 2 (cons simple-error (cons 1 (cons snd (cons 1 (cons specialise (cons 1 (cons spy (cons 1 (cons step (cons 1 (cons stinput (cons 0 (cons stoutput (cons 0 (cons string->n (cons 1 (cons string->symbol (cons 1 (cons string? (cons 1 (cons shen.strong-warning (cons 1 (cons subst (cons 3 (cons sum (cons 1 (cons symbol? (cons 1 (cons tail (cons 1 (cons tl (cons 1 (cons tc (cons 1 (cons tc? (cons 0 (cons thaw (cons 1 (cons tlstr (cons 1 (cons track (cons 1 (cons trap-error (cons 2 (cons tuple? (cons 1 (cons type (cons 2 (cons return (cons 3 (cons undefmacro (cons 1 (cons unprofile (cons 1 (cons unify (cons 4 (cons unify! (cons 4 (cons union (cons 2 (cons untrack (cons 1 (cons unspecialise (cons 1 (cons undefmacro (cons 1 (cons vector (cons 1 (cons vector-> (cons 3 (cons value (cons 1 (cons variable? (cons 1 (cons version (cons 0 (cons warn (cons 1 (cons write-byte (cons 2 (cons write-to-file (cons 2 (cons y-or-n? (cons 1 (cons + (cons 2 (cons * (cons 2 (cons / (cons 2 (cons - (cons 2 (cons == (cons 2 (cons <e> (cons 1 (cons @p (cons 2 (cons @v (cons 2 (cons @s (cons 2 (cons preclude (cons 1 (cons include (cons 1 (cons preclude-all-but (cons 1 (cons include-all-but (cons 1 (cons where (cons 2 ())))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
|
119
119
|
|
120
120
|
(defun systemf (V829) (let Shen (intern "shen") (let External (get Shen shen.external-symbols (value *property-vector*)) (put Shen shen.external-symbols (adjoin V829 External) (value *property-vector*)))))
|
121
121
|
|
122
122
|
(defun adjoin (V830 V831) (if (element? V830 V831) V831 (cons V830 V831)))
|
123
123
|
|
124
|
-
(put (intern "shen") shen.external-symbols (cons ! (cons } (cons { (cons --> (cons <-- (cons && (cons : (cons ; (cons :- (cons := (cons _ (cons *language* (cons *implementation* (cons *stinput* (cons *home-directory* (cons *version* (cons *maximum-print-sequence-size* (cons *macros* (cons *os* (cons *release* (cons *property-vector* (cons @v (cons @p (cons @s (cons *port* (cons *porters* (cons *hush* (cons <- (cons -> (cons <e> (cons == (cons = (cons >= (cons > (cons /. (cons =! (cons $ (cons - (cons / (cons * (cons + (cons <= (cons < (cons >> (cons (vector 0) (cons ==> (cons y-or-n? (cons write-to-file (cons write-byte (cons where (cons when (cons warn (cons version (cons verified (cons variable? (cons value (cons vector-> (cons <-vector (cons vector (cons vector? (cons unspecialise (cons untrack (cons unit (cons shen.unix (cons union (cons unify (cons unify! (cons unprofile (cons undefmacro (cons return (cons type (cons tuple? (cons true (cons trap-error (cons track (cons time (cons thaw (cons tc? (cons tc (cons tl (cons tlstr (cons tlv (cons tail (cons systemf (cons synonyms (cons symbol (cons symbol? (cons string->symbol (cons subst (cons string? (cons string->n (cons stream (cons string (cons stinput (cons stoutput (cons step (cons spy (cons specialise (cons snd (cons simple-error (cons set (cons save (cons str (cons run (cons reverse (cons remove (cons release (cons read (cons read
|
124
|
+
(put (intern "shen") shen.external-symbols (cons ! (cons } (cons { (cons --> (cons <-- (cons && (cons : (cons ; (cons :- (cons := (cons _ (cons *language* (cons *implementation* (cons *stinput* (cons *home-directory* (cons *version* (cons *maximum-print-sequence-size* (cons *macros* (cons *os* (cons *release* (cons *property-vector* (cons @v (cons @p (cons @s (cons *port* (cons *porters* (cons *hush* (cons <- (cons -> (cons <e> (cons == (cons = (cons >= (cons > (cons /. (cons =! (cons $ (cons - (cons / (cons * (cons + (cons <= (cons < (cons >> (cons (vector 0) (cons ==> (cons y-or-n? (cons write-to-file (cons write-byte (cons where (cons when (cons warn (cons version (cons verified (cons variable? (cons value (cons vector-> (cons <-vector (cons vector (cons vector? (cons unspecialise (cons untrack (cons unit (cons shen.unix (cons union (cons unify (cons unify! (cons unprofile (cons undefmacro (cons return (cons type (cons tuple? (cons true (cons trap-error (cons track (cons time (cons thaw (cons tc? (cons tc (cons tl (cons tlstr (cons tlv (cons tail (cons systemf (cons synonyms (cons symbol (cons symbol? (cons string->symbol (cons subst (cons string? (cons string->n (cons stream (cons string (cons stinput (cons stoutput (cons step (cons spy (cons specialise (cons snd (cons simple-error (cons set (cons save (cons str (cons run (cons reverse (cons remove (cons release (cons read (cons read-file (cons read-file-as-bytelist (cons read-file-as-string (cons read-byte (cons read-from-string (cons quit (cons put (cons preclude (cons preclude-all-but (cons ps (cons prolog? (cons protect (cons profile-results (cons profile (cons print (cons pr (cons pos (cons porters (cons port (cons package (cons output (cons out (cons os (cons or (cons optimise (cons open (cons occurrences (cons occurs-check (cons n->string (cons number? (cons number (cons null (cons nth (cons not (cons nl (cons mode (cons macro (cons macroexpand (cons maxinferences (cons mapcan (cons map (cons make-string (cons load (cons loaded (cons list (cons lineread (cons limit (cons length (cons let (cons lazy (cons lambda (cons language (cons kill (cons is (cons intersection (cons inferences (cons intern (cons integer? (cons input (cons input+ (cons include (cons include-all-but (cons it (cons in (cons implementation (cons if (cons identical (cons head (cons hd (cons hdv (cons hdstr (cons hash (cons get (cons get-time (cons gensym (cons function (cons fst (cons freeze (cons fix (cons file (cons fail (cons fail-if (cons fwhen (cons findall (cons false (cons enable-type-theory (cons explode (cons external (cons exception (cons eval-kl (cons eval (cons error-to-string (cons error (cons empty? (cons element? (cons do (cons difference (cons destroy (cons defun (cons define (cons defmacro (cons defcc (cons defprolog (cons declare (cons datatype (cons cut (cons cn (cons cons? (cons cons (cons cond (cons concat (cons compile (cons cd (cons cases (cons call (cons close (cons bind (cons bound? (cons boolean? (cons boolean (cons bar! (cons assoc (cons arity (cons append (cons and (cons adjoin (cons <-address (cons address-> (cons absvector? (cons absvector (cons abort ()))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) (value *property-vector*))
|
125
125
|
|
126
126
|
(defun specialise (V832) (do (set shen.*special* (cons V832 (value shen.*special*))) V832))
|
127
127
|
|
@@ -75,22 +75,6 @@
|
|
75
75
|
|
76
76
|
(defun shen.intern-type (V901) (intern (cn "type#" (str V901))))
|
77
77
|
|
78
|
-
"(defcc <defmacro>
|
79
|
-
<name> <macrorules> := [define <name> | <macrorules>];)
|
80
|
-
|
81
|
-
(defcc <macrorules>
|
82
|
-
<macrorule> <macrorules>;
|
83
|
-
<macrorule> := (append <macrorule> [(protect X) -> (protect X)]);)
|
84
|
-
|
85
|
-
(defcc <macrorule>
|
86
|
-
<patterns> -> <macroaction> where <guard>;
|
87
|
-
<patterns> -> <macroaction>;
|
88
|
-
<patterns> <- <macroaction> where <guard>;
|
89
|
-
<patterns> <- <macroaction>;)
|
90
|
-
|
91
|
-
(defcc <macroaction>
|
92
|
-
<action> := [[walk [function macroexpand] <action>]];)"
|
93
|
-
|
94
78
|
(defun shen.@s-macro (V902) (cond ((and (cons? V902) (and (= @s (hd V902)) (and (cons? (tl V902)) (and (cons? (tl (tl V902))) (cons? (tl (tl (tl V902)))))))) (cons @s (cons (hd (tl V902)) (cons (shen.@s-macro (cons @s (tl (tl V902)))) ())))) ((and (cons? V902) (and (= @s (hd V902)) (and (cons? (tl V902)) (and (cons? (tl (tl V902))) (and (= () (tl (tl (tl V902)))) (string? (hd (tl V902)))))))) (let E (explode (hd (tl V902))) (if (> (length E) 1) (shen.@s-macro (cons @s (append E (tl (tl V902))))) V902))) (true V902)))
|
95
79
|
|
96
80
|
(defun shen.synonyms-macro (V903) (cond ((and (cons? V903) (= synonyms (hd V903))) (cons shen.synonyms-help (cons (shen.rcons_form (shen.curry-synonyms (tl V903))) ()))) (true V903)))
|
@@ -185,7 +185,7 @@
|
|
185
185
|
|
186
186
|
(defun shen.mk-pvar (V1155) (address-> (address-> (absvector 2) 0 shen.pvar) 1 V1155))
|
187
187
|
|
188
|
-
(defun shen.pvar? (V1156) (and (absvector? V1156) (= (<-address V1156 0) shen.pvar)))
|
188
|
+
(defun shen.pvar? (V1156) (trap-error (and (absvector? V1156) (= (<-address V1156 0) shen.pvar)) (lambda E false)))
|
189
189
|
|
190
190
|
(defun shen.bindv (V1157 V1158 V1159) (let Vector (<-address (value shen.*prologvectors*) V1159) (address-> Vector (<-address V1157 1) V1158)))
|
191
191
|
|
@@ -47,166 +47,176 @@
|
|
47
47
|
* explains this license in full. *
|
48
48
|
* *
|
49
49
|
*****************************************************************************************
|
50
|
-
"(defun read-file-as-bytelist (
|
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
51
|
|
52
|
-
(defun shen.read-file-as-bytelist-help (
|
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
53
|
|
54
|
-
(defun read-file-as-string (
|
54
|
+
(defun read-file-as-string (V1352) (let Stream (open V1352 in) (shen.rfas-h Stream (read-byte Stream) "")))
|
55
55
|
|
56
|
-
(defun shen.rfas-h (
|
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
57
|
|
58
|
-
(defun input (
|
58
|
+
(defun input (V1356) (eval-kl (read V1356)))
|
59
59
|
|
60
|
-
(defun input+ (
|
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
61
|
" shen.r)) shen.r))) (eval-kl Input)))))
|
62
62
|
|
63
|
-
(defun shen.monotype (
|
64
|
-
" shen.a)))
|
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
65
|
|
66
|
-
(defun read (
|
66
|
+
(defun read (V1360) (hd (shen.read-loop V1360 (read-byte V1360) ())))
|
67
67
|
|
68
|
-
(defun
|
68
|
+
(defun it () (value shen.*it*))
|
69
69
|
|
70
|
-
(defun shen.
|
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
71
|
|
72
|
-
(defun
|
72
|
+
(defun shen.terminator? (V1368) (element? V1368 (cons 9 (cons 10 (cons 13 (cons 32 (cons 34 (cons 41 (cons 93 ())))))))))
|
73
73
|
|
74
|
-
(defun
|
74
|
+
(defun lineread (V1369) (shen.lineread-loop (read-byte V1369) () V1369))
|
75
75
|
|
76
|
-
(defun
|
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
77
|
|
78
|
-
(defun
|
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
79
|
|
80
|
-
(defun shen.
|
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
81
|
|
82
|
-
|
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)) "
|
83
93
|
" shen.a)))) (true (simple-error "read error
|
84
94
|
"))))
|
85
95
|
|
86
|
-
(defun shen.compress-50 (
|
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))))
|
87
97
|
|
88
|
-
(defun shen.<st_input> (
|
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)))
|
89
99
|
|
90
|
-
(defun shen.<lsb> (
|
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)))
|
91
101
|
|
92
|
-
(defun shen.<rsb> (
|
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)))
|
93
103
|
|
94
|
-
(defun shen.<lcurly> (
|
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)))
|
95
105
|
|
96
|
-
(defun shen.<rcurly> (
|
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)))
|
97
107
|
|
98
|
-
(defun shen.<bar> (
|
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)))
|
99
109
|
|
100
|
-
(defun shen.<semicolon> (
|
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)))
|
101
111
|
|
102
|
-
(defun shen.<colon> (
|
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)))
|
103
113
|
|
104
|
-
(defun shen.<comma> (
|
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)))
|
105
115
|
|
106
|
-
(defun shen.<equal> (
|
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)))
|
107
117
|
|
108
|
-
(defun shen.<minus> (
|
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)))
|
109
119
|
|
110
|
-
(defun shen.<lrb> (
|
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)))
|
111
121
|
|
112
|
-
(defun shen.<rrb> (
|
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)))
|
113
123
|
|
114
|
-
(defun shen.<atom> (
|
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)))
|
115
125
|
|
116
|
-
(defun shen.control-chars (
|
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))))
|
117
127
|
|
118
|
-
(defun shen.code-point (
|
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 "
|
119
129
|
" shen.a))))))
|
120
130
|
|
121
|
-
(defun shen.after-codepoint (
|
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))))
|
122
132
|
|
123
|
-
(defun shen.decimalise (
|
133
|
+
(defun shen.decimalise (V1472) (shen.pre (reverse (shen.digits->integers V1472)) 0))
|
124
134
|
|
125
|
-
(defun shen.digits->integers (
|
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 ())))
|
126
136
|
|
127
|
-
(defun shen.<sym> (
|
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)))
|
128
138
|
|
129
|
-
(defun shen.<alphanums> (
|
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)))
|
130
140
|
|
131
|
-
(defun shen.<alphanum> (
|
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)))
|
132
142
|
|
133
|
-
(defun shen.<num> (
|
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)))
|
134
144
|
|
135
|
-
(defun shen.numbyte? (
|
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)))
|
136
146
|
|
137
|
-
(defun shen.<alpha> (
|
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)))
|
138
148
|
|
139
|
-
(defun shen.symbol-code? (
|
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)))))))
|
140
150
|
|
141
|
-
(defun shen.<str> (
|
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)))
|
142
152
|
|
143
|
-
(defun shen.<dbq> (
|
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)))
|
144
154
|
|
145
|
-
(defun shen.<strcontents> (
|
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)))
|
146
156
|
|
147
|
-
(defun shen.<byte> (
|
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)))
|
148
158
|
|
149
|
-
(defun shen.<strc> (
|
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)))
|
150
160
|
|
151
|
-
(defun shen.<number> (
|
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)))
|
152
162
|
|
153
|
-
(defun shen.<E> (
|
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)))
|
154
164
|
|
155
|
-
(defun shen.<log10> (
|
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)))
|
156
166
|
|
157
|
-
(defun shen.<plus> (
|
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)))
|
158
168
|
|
159
|
-
(defun shen.<stop> (
|
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)))
|
160
170
|
|
161
|
-
(defun shen.<predigits> (
|
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)))
|
162
172
|
|
163
|
-
(defun shen.<postdigits> (
|
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)))
|
164
174
|
|
165
|
-
(defun shen.<digits> (
|
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)))
|
166
176
|
|
167
|
-
(defun shen.<digit> (
|
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)))
|
168
178
|
|
169
|
-
(defun shen.byte->digit (
|
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))))
|
170
180
|
|
171
|
-
(defun shen.pre (
|
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))))
|
172
182
|
|
173
|
-
(defun shen.post (
|
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))))
|
174
184
|
|
175
|
-
(defun shen.expt (
|
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)))))
|
176
186
|
|
177
|
-
(defun shen.<st_input1> (
|
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)))
|
178
188
|
|
179
|
-
(defun shen.<st_input2> (
|
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)))
|
180
190
|
|
181
|
-
(defun shen.<comment> (
|
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)))
|
182
192
|
|
183
|
-
(defun shen.<singleline> (
|
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)))
|
184
194
|
|
185
|
-
(defun shen.<backslash> (
|
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)))
|
186
196
|
|
187
|
-
(defun shen.<anysingle> (
|
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)))
|
188
198
|
|
189
|
-
(defun shen.<non-return> (
|
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)))
|
190
200
|
|
191
|
-
(defun shen.<return> (
|
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)))
|
192
202
|
|
193
|
-
(defun shen.<multiline> (
|
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)))
|
194
204
|
|
195
|
-
(defun shen.<times> (
|
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)))
|
196
206
|
|
197
|
-
(defun shen.<anymulti> (
|
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)))
|
198
208
|
|
199
|
-
(defun shen.<whitespaces> (
|
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)))
|
200
210
|
|
201
|
-
(defun shen.<whitespace> (
|
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)))
|
202
212
|
|
203
|
-
(defun shen.cons_form (
|
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))))
|
204
214
|
|
205
|
-
(defun shen.package-macro (
|
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))))
|
206
216
|
|
207
|
-
(defun shen.record-exceptions (
|
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*)))))
|
208
218
|
|
209
|
-
(defun shen.packageh (
|
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)))
|
210
220
|
|
211
221
|
|
212
222
|
|