shen-ruby 0.14.0 → 0.15.0
Sign up to get free protection for your applications and to get access to all the features.
- checksums.yaml +4 -4
- data/.travis.yml +1 -1
- data/HISTORY.md +6 -3
- data/README.md +10 -7
- data/bin/shen-ruby +21 -0
- data/bin/shen_ruby +21 -0
- data/lib/shen_ruby/converters.rb +2 -4
- data/lib/shen_ruby/shen.rb +1 -1
- data/lib/shen_ruby/version.rb +1 -1
- data/shen/release/klambda/core.kl +67 -63
- data/shen/release/klambda/declarations.kl +92 -84
- data/shen/release/klambda/load.kl +15 -15
- data/shen/release/klambda/macros.kl +34 -33
- data/shen/release/klambda/prolog.kl +96 -98
- data/shen/release/klambda/reader.kl +83 -83
- data/shen/release/klambda/sequent.kl +55 -55
- data/shen/release/klambda/sys.kl +106 -101
- data/shen/release/klambda/t-star.kl +41 -41
- data/shen/release/klambda/toplevel.kl +21 -21
- data/shen/release/klambda/track.kl +25 -25
- data/shen/release/klambda/types.kl +6 -4
- data/shen/release/klambda/writer.kl +25 -25
- data/shen/release/klambda/yacc.kl +28 -28
- data/shen-ruby.gemspec +3 -3
- metadata +9 -5
checksums.yaml
CHANGED
|
@@ -1,7 +1,7 @@
|
|
|
1
1
|
---
|
|
2
2
|
SHA1:
|
|
3
|
-
metadata.gz:
|
|
4
|
-
data.tar.gz:
|
|
3
|
+
metadata.gz: f381d80e5e8c9c146296ca0e845fb4a49ff27126
|
|
4
|
+
data.tar.gz: 437fe5e43da5ab851519ee279bb72a2128778060
|
|
5
5
|
SHA512:
|
|
6
|
-
metadata.gz:
|
|
7
|
-
data.tar.gz:
|
|
6
|
+
metadata.gz: a1ced5ed4e8fc01bf4ac200270b3f403a0698ce7e9947b2a5e8766291e3407684441a122dde8f6e1d79a956e0dc46c7b775e13a8ce8ba5e04a329e259e972786
|
|
7
|
+
data.tar.gz: 6edca0f42ba32be1ca4185f5c3472f403fb9a68ced4df92f4d5b86520887dd6eca03be4d23eda084c77290d7017b7043b7e9f768f3af82cf6feeea9f203d18d9
|
data/.travis.yml
CHANGED
data/HISTORY.md
CHANGED
|
@@ -1,13 +1,16 @@
|
|
|
1
1
|
# ShenRuby Release History
|
|
2
2
|
|
|
3
|
-
##
|
|
3
|
+
## 0.15.0 - March 31, 2015
|
|
4
4
|
### Features
|
|
5
|
-
-
|
|
5
|
+
- Added `shen-ruby` executable for running ShenRuby programs outside of REPL
|
|
6
|
+
- Including support for shebang scripts
|
|
7
|
+
- Upgrade to Shen 18.1
|
|
8
|
+
- Upgrade to Klam 0.0.9 for performance improvements
|
|
6
9
|
|
|
7
10
|
### Bug Fixes
|
|
8
11
|
- Evaluating "c#13;" no longer triggers the message "warning: encountered \r in middle of line, treated as a mere space."
|
|
9
12
|
|
|
10
|
-
## 0.13.0 - February 3,
|
|
13
|
+
## 0.13.0 - February 3, 2015
|
|
11
14
|
### Features
|
|
12
15
|
- Upgrade to Shen 17
|
|
13
16
|
- Shen is now BSD-licenesed, making ShenRuby BSD/MIT licenesed
|
data/README.md
CHANGED
|
@@ -1,7 +1,7 @@
|
|
|
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 18.1, which was released in March, 2015.
|
|
5
5
|
|
|
6
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
|
|
|
@@ -22,12 +22,13 @@ ShenRuby 0.14.0 is the current release. To install it as a gem, use the followin
|
|
|
22
22
|
|
|
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 1.51 seconds.
|
|
26
27
|
|
|
27
28
|
Shen, copyright (C) 2010-2015 Mark Tarver
|
|
28
|
-
www.shenlanguage.org, Shen
|
|
29
|
-
running under Ruby, implementation: ruby 2.2.
|
|
30
|
-
port 0.
|
|
29
|
+
www.shenlanguage.org, Shen 18.1
|
|
30
|
+
running under Ruby, implementation: ruby 2.2.1
|
|
31
|
+
port 0.15.0 ported by Greg Spurrier
|
|
31
32
|
|
|
32
33
|
|
|
33
34
|
(0-)
|
|
@@ -61,6 +62,9 @@ To exit the Shen REPL, execute the `quit` function:
|
|
|
61
62
|
(4-) (quit)
|
|
62
63
|
%
|
|
63
64
|
|
|
65
|
+
## Running ShenRuby Programs Without a REPL
|
|
66
|
+
Then `shen-ruby` command (or `shen_ruby`, if you prefer) can be used to run ShenRuby programs without starting a REPL.
|
|
67
|
+
|
|
64
68
|
## Ruby<->Shen Interop
|
|
65
69
|
Bidirectional interaction between Ruby and Shen is a primary goal of ShenRuby. The following sections describe the currently supported means of collaboration between Shen and Ruby.
|
|
66
70
|
|
|
@@ -164,7 +168,7 @@ In addition to normal arguments, Ruby methods may also accept blocks. A block ar
|
|
|
164
168
|
|
|
165
169
|
For example, to print each character of a string on a separate line using Shen's `pr` and `nl` system functions:
|
|
166
170
|
|
|
167
|
-
(rb.each_char "hello" &
|
|
171
|
+
(rb.each_char "hello" & (/. X (do (pr X) (nl))))
|
|
168
172
|
|
|
169
173
|
Or, to sum the elements of a list using Ruby's `Enumerable#reduce`:
|
|
170
174
|
|
|
@@ -205,7 +209,6 @@ The following resources may be helpful for those wanting to learn more about the
|
|
|
205
209
|
|
|
206
210
|
The following features and improvements are among those planned for ShenRuby as it approaches its 1.0 release:
|
|
207
211
|
|
|
208
|
-
- Support for command-line Shen scripts that under ShenRuby
|
|
209
212
|
- Support for Rubinius
|
|
210
213
|
- Thread-safe `ShenRuby::Shen` instances
|
|
211
214
|
|
data/bin/shen-ruby
ADDED
|
@@ -0,0 +1,21 @@
|
|
|
1
|
+
#!/usr/bin/env ruby
|
|
2
|
+
require 'rubygems'
|
|
3
|
+
require 'shen_ruby'
|
|
4
|
+
|
|
5
|
+
if ARGV.size > 0
|
|
6
|
+
infile = File.open(ARGV[0])
|
|
7
|
+
else
|
|
8
|
+
infile = STDIN
|
|
9
|
+
end
|
|
10
|
+
|
|
11
|
+
first_two = infile.read(2)
|
|
12
|
+
if first_two == '#!'
|
|
13
|
+
# Discard shebang line
|
|
14
|
+
infile.readline
|
|
15
|
+
else
|
|
16
|
+
infile.ungetc(first_two[1])
|
|
17
|
+
infile.ungetc(first_two[0])
|
|
18
|
+
end
|
|
19
|
+
|
|
20
|
+
shen = ShenRuby::Shen.new
|
|
21
|
+
shen.eval_string(infile.read)
|
data/bin/shen_ruby
ADDED
|
@@ -0,0 +1,21 @@
|
|
|
1
|
+
#!/usr/bin/env ruby
|
|
2
|
+
require 'rubygems'
|
|
3
|
+
require 'shen_ruby'
|
|
4
|
+
|
|
5
|
+
if ARGV.size > 0
|
|
6
|
+
infile = File.open(ARGV[0])
|
|
7
|
+
else
|
|
8
|
+
infile = STDIN
|
|
9
|
+
end
|
|
10
|
+
|
|
11
|
+
first_two = infile.read(2)
|
|
12
|
+
if first_two == '#!'
|
|
13
|
+
# Discard shebang line
|
|
14
|
+
infile.readline
|
|
15
|
+
else
|
|
16
|
+
infile.ungetc(first_two[1])
|
|
17
|
+
infile.ungetc(first_two[0])
|
|
18
|
+
end
|
|
19
|
+
|
|
20
|
+
shen = ShenRuby::Shen.new
|
|
21
|
+
shen.eval_string(infile.read)
|
data/lib/shen_ruby/converters.rb
CHANGED
data/lib/shen_ruby/shen.rb
CHANGED
data/lib/shen_ruby/version.rb
CHANGED
|
@@ -23,134 +23,138 @@ ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
|
|
|
23
23
|
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
|
|
24
24
|
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE."
|
|
25
25
|
|
|
26
|
-
(defun shen.shen->kl (
|
|
26
|
+
(defun shen.shen->kl (V15953 V15954) (compile (lambda X (shen.<define> X)) (cons V15953 V15954) (lambda X (shen.shen-syntax-error V15953 X))))
|
|
27
27
|
|
|
28
|
-
(defun shen.shen-syntax-error (
|
|
28
|
+
(defun shen.shen-syntax-error (V15957 V15958) (simple-error (cn "syntax error in " (shen.app V15957 (cn " here:
|
|
29
29
|
|
|
30
|
-
" (shen.app (shen.next-50 50
|
|
30
|
+
" (shen.app (shen.next-50 50 V15958) "
|
|
31
31
|
" shen.a)) shen.a))))
|
|
32
32
|
|
|
33
|
-
(defun shen.<define> (
|
|
33
|
+
(defun shen.<define> (V15960) (let YaccParse (let Parse_shen.<name> (shen.<name> V15960) (if (not (= (fail) Parse_shen.<name>)) (let Parse_shen.<signature> (shen.<signature> Parse_shen.<name>) (if (not (= (fail) Parse_shen.<signature>)) (let Parse_shen.<rules> (shen.<rules> Parse_shen.<signature>) (if (not (= (fail) Parse_shen.<rules>)) (shen.pair (hd Parse_shen.<rules>) (shen.compile_to_machine_code (shen.hdtl Parse_shen.<name>) (shen.hdtl Parse_shen.<rules>))) (fail))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_shen.<name> (shen.<name> V15960) (if (not (= (fail) Parse_shen.<name>)) (let Parse_shen.<rules> (shen.<rules> Parse_shen.<name>) (if (not (= (fail) Parse_shen.<rules>)) (shen.pair (hd Parse_shen.<rules>) (shen.compile_to_machine_code (shen.hdtl Parse_shen.<name>) (shen.hdtl Parse_shen.<rules>))) (fail))) (fail))) YaccParse)))
|
|
34
34
|
|
|
35
|
-
(defun shen.<name> (
|
|
35
|
+
(defun shen.<name> (V15962) (if (cons? (hd V15962)) (let Parse_X (hd (hd V15962)) (shen.pair (hd (shen.pair (tl (hd V15962)) (shen.hdtl V15962))) (if (and (symbol? Parse_X) (not (shen.sysfunc? Parse_X))) Parse_X (simple-error (shen.app Parse_X " is not a legitimate function name.
|
|
36
36
|
" shen.a))))) (fail)))
|
|
37
37
|
|
|
38
|
-
(defun shen.sysfunc? (
|
|
38
|
+
(defun shen.sysfunc? (V15964) (element? V15964 (get (intern "shen") shen.external-symbols (value *property-vector*))))
|
|
39
39
|
|
|
40
|
-
(defun shen.<signature> (
|
|
40
|
+
(defun shen.<signature> (V15966) (if (and (cons? (hd V15966)) (= { (hd (hd V15966)))) (let Parse_shen.<signature-help> (shen.<signature-help> (shen.pair (tl (hd V15966)) (shen.hdtl V15966))) (if (not (= (fail) Parse_shen.<signature-help>)) (if (and (cons? (hd Parse_shen.<signature-help>)) (= } (hd (hd Parse_shen.<signature-help>)))) (shen.pair (hd (shen.pair (tl (hd Parse_shen.<signature-help>)) (shen.hdtl Parse_shen.<signature-help>))) (shen.demodulate (shen.curry-type (shen.hdtl Parse_shen.<signature-help>)))) (fail)) (fail))) (fail)))
|
|
41
41
|
|
|
42
|
-
(defun shen.curry-type (
|
|
42
|
+
(defun shen.curry-type (V15968) (cond ((and (cons? V15968) (and (cons? (tl V15968)) (and (= --> (hd (tl V15968))) (and (cons? (tl (tl V15968))) (and (cons? (tl (tl (tl V15968)))) (= --> (hd (tl (tl (tl V15968)))))))))) (shen.curry-type (cons (hd V15968) (cons --> (cons (tl (tl V15968)) ()))))) ((and (cons? V15968) (and (cons? (tl V15968)) (and (= * (hd (tl V15968))) (and (cons? (tl (tl V15968))) (and (cons? (tl (tl (tl V15968)))) (= * (hd (tl (tl (tl V15968)))))))))) (shen.curry-type (cons (hd V15968) (cons * (cons (tl (tl V15968)) ()))))) ((cons? V15968) (map (lambda Z (shen.curry-type Z)) V15968)) (true V15968)))
|
|
43
43
|
|
|
44
|
-
(defun shen.<signature-help> (
|
|
44
|
+
(defun shen.<signature-help> (V15970) (let YaccParse (if (cons? (hd V15970)) (let Parse_X (hd (hd V15970)) (let Parse_shen.<signature-help> (shen.<signature-help> (shen.pair (tl (hd V15970)) (shen.hdtl V15970))) (if (not (= (fail) Parse_shen.<signature-help>)) (if (not (element? Parse_X (cons { (cons } ())))) (shen.pair (hd Parse_shen.<signature-help>) (cons Parse_X (shen.hdtl Parse_shen.<signature-help>))) (fail)) (fail)))) (fail)) (if (= YaccParse (fail)) (let Parse_<e> (<e> V15970) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) ()) (fail))) YaccParse)))
|
|
45
45
|
|
|
46
|
-
(defun shen.<rules> (
|
|
46
|
+
(defun shen.<rules> (V15972) (let YaccParse (let Parse_shen.<rule> (shen.<rule> V15972) (if (not (= (fail) Parse_shen.<rule>)) (let Parse_shen.<rules> (shen.<rules> Parse_shen.<rule>) (if (not (= (fail) Parse_shen.<rules>)) (shen.pair (hd Parse_shen.<rules>) (cons (shen.linearise (shen.hdtl Parse_shen.<rule>)) (shen.hdtl Parse_shen.<rules>))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_shen.<rule> (shen.<rule> V15972) (if (not (= (fail) Parse_shen.<rule>)) (shen.pair (hd Parse_shen.<rule>) (cons (shen.linearise (shen.hdtl Parse_shen.<rule>)) ())) (fail))) YaccParse)))
|
|
47
47
|
|
|
48
|
-
(defun shen.<rule> (
|
|
48
|
+
(defun shen.<rule> (V15974) (let YaccParse (let Parse_shen.<patterns> (shen.<patterns> V15974) (if (not (= (fail) Parse_shen.<patterns>)) (if (and (cons? (hd Parse_shen.<patterns>)) (= -> (hd (hd Parse_shen.<patterns>)))) (let Parse_shen.<action> (shen.<action> (shen.pair (tl (hd Parse_shen.<patterns>)) (shen.hdtl Parse_shen.<patterns>))) (if (not (= (fail) Parse_shen.<action>)) (if (and (cons? (hd Parse_shen.<action>)) (= where (hd (hd Parse_shen.<action>)))) (let Parse_shen.<guard> (shen.<guard> (shen.pair (tl (hd Parse_shen.<action>)) (shen.hdtl Parse_shen.<action>))) (if (not (= (fail) Parse_shen.<guard>)) (shen.pair (hd Parse_shen.<guard>) (cons (shen.hdtl Parse_shen.<patterns>) (cons (cons where (cons (shen.hdtl Parse_shen.<guard>) (cons (shen.hdtl Parse_shen.<action>) ()))) ()))) (fail))) (fail)) (fail))) (fail)) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen.<patterns> (shen.<patterns> V15974) (if (not (= (fail) Parse_shen.<patterns>)) (if (and (cons? (hd Parse_shen.<patterns>)) (= -> (hd (hd Parse_shen.<patterns>)))) (let Parse_shen.<action> (shen.<action> (shen.pair (tl (hd Parse_shen.<patterns>)) (shen.hdtl Parse_shen.<patterns>))) (if (not (= (fail) Parse_shen.<action>)) (shen.pair (hd Parse_shen.<action>) (cons (shen.hdtl Parse_shen.<patterns>) (cons (shen.hdtl Parse_shen.<action>) ()))) (fail))) (fail)) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen.<patterns> (shen.<patterns> V15974) (if (not (= (fail) Parse_shen.<patterns>)) (if (and (cons? (hd Parse_shen.<patterns>)) (= <- (hd (hd Parse_shen.<patterns>)))) (let Parse_shen.<action> (shen.<action> (shen.pair (tl (hd Parse_shen.<patterns>)) (shen.hdtl Parse_shen.<patterns>))) (if (not (= (fail) Parse_shen.<action>)) (if (and (cons? (hd Parse_shen.<action>)) (= where (hd (hd Parse_shen.<action>)))) (let Parse_shen.<guard> (shen.<guard> (shen.pair (tl (hd Parse_shen.<action>)) (shen.hdtl Parse_shen.<action>))) (if (not (= (fail) Parse_shen.<guard>)) (shen.pair (hd Parse_shen.<guard>) (cons (shen.hdtl Parse_shen.<patterns>) (cons (cons where (cons (shen.hdtl Parse_shen.<guard>) (cons (cons shen.choicepoint! (cons (shen.hdtl Parse_shen.<action>) ())) ()))) ()))) (fail))) (fail)) (fail))) (fail)) (fail))) (if (= YaccParse (fail)) (let Parse_shen.<patterns> (shen.<patterns> V15974) (if (not (= (fail) Parse_shen.<patterns>)) (if (and (cons? (hd Parse_shen.<patterns>)) (= <- (hd (hd Parse_shen.<patterns>)))) (let Parse_shen.<action> (shen.<action> (shen.pair (tl (hd Parse_shen.<patterns>)) (shen.hdtl Parse_shen.<patterns>))) (if (not (= (fail) Parse_shen.<action>)) (shen.pair (hd Parse_shen.<action>) (cons (shen.hdtl Parse_shen.<patterns>) (cons (cons shen.choicepoint! (cons (shen.hdtl Parse_shen.<action>) ())) ()))) (fail))) (fail)) (fail))) YaccParse)) YaccParse)) YaccParse)))
|
|
49
49
|
|
|
50
|
-
(defun shen.fail_if (
|
|
50
|
+
(defun shen.fail_if (V15977 V15978) (if (V15977 V15978) (fail) V15978))
|
|
51
51
|
|
|
52
|
-
(defun shen.succeeds? (
|
|
52
|
+
(defun shen.succeeds? (V15984) (cond ((= V15984 (fail)) false) (true true)))
|
|
53
53
|
|
|
54
|
-
(defun shen.<patterns> (
|
|
54
|
+
(defun shen.<patterns> (V15986) (let YaccParse (let Parse_shen.<pattern> (shen.<pattern> V15986) (if (not (= (fail) Parse_shen.<pattern>)) (let Parse_shen.<patterns> (shen.<patterns> Parse_shen.<pattern>) (if (not (= (fail) Parse_shen.<patterns>)) (shen.pair (hd Parse_shen.<patterns>) (cons (shen.hdtl Parse_shen.<pattern>) (shen.hdtl Parse_shen.<patterns>))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_<e> (<e> V15986) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) ()) (fail))) YaccParse)))
|
|
55
55
|
|
|
56
|
-
(defun shen.<pattern> (
|
|
56
|
+
(defun shen.<pattern> (V15993) (let YaccParse (if (and (cons? (hd V15993)) (cons? (hd (hd V15993)))) (if (and (cons? (hd (shen.pair (hd (hd V15993)) (hd (tl V15993))))) (= @p (hd (hd (shen.pair (hd (hd V15993)) (hd (tl V15993))))))) (let Parse_shen.<pattern1> (shen.<pattern1> (shen.pair (tl (hd (shen.pair (hd (hd V15993)) (hd (tl V15993))))) (shen.hdtl (shen.pair (hd (hd V15993)) (hd (tl V15993)))))) (if (not (= (fail) Parse_shen.<pattern1>)) (let Parse_shen.<pattern2> (shen.<pattern2> Parse_shen.<pattern1>) (if (not (= (fail) Parse_shen.<pattern2>)) (shen.pair (hd (shen.pair (tl (hd V15993)) (hd (tl V15993)))) (cons @p (cons (shen.hdtl Parse_shen.<pattern1>) (cons (shen.hdtl Parse_shen.<pattern2>) ())))) (fail))) (fail))) (fail)) (fail)) (if (= YaccParse (fail)) (let YaccParse (if (and (cons? (hd V15993)) (cons? (hd (hd V15993)))) (if (and (cons? (hd (shen.pair (hd (hd V15993)) (hd (tl V15993))))) (= cons (hd (hd (shen.pair (hd (hd V15993)) (hd (tl V15993))))))) (let Parse_shen.<pattern1> (shen.<pattern1> (shen.pair (tl (hd (shen.pair (hd (hd V15993)) (hd (tl V15993))))) (shen.hdtl (shen.pair (hd (hd V15993)) (hd (tl V15993)))))) (if (not (= (fail) Parse_shen.<pattern1>)) (let Parse_shen.<pattern2> (shen.<pattern2> Parse_shen.<pattern1>) (if (not (= (fail) Parse_shen.<pattern2>)) (shen.pair (hd (shen.pair (tl (hd V15993)) (hd (tl V15993)))) (cons cons (cons (shen.hdtl Parse_shen.<pattern1>) (cons (shen.hdtl Parse_shen.<pattern2>) ())))) (fail))) (fail))) (fail)) (fail)) (if (= YaccParse (fail)) (let YaccParse (if (and (cons? (hd V15993)) (cons? (hd (hd V15993)))) (if (and (cons? (hd (shen.pair (hd (hd V15993)) (hd (tl V15993))))) (= @v (hd (hd (shen.pair (hd (hd V15993)) (hd (tl V15993))))))) (let Parse_shen.<pattern1> (shen.<pattern1> (shen.pair (tl (hd (shen.pair (hd (hd V15993)) (hd (tl V15993))))) (shen.hdtl (shen.pair (hd (hd V15993)) (hd (tl V15993)))))) (if (not (= (fail) Parse_shen.<pattern1>)) (let Parse_shen.<pattern2> (shen.<pattern2> Parse_shen.<pattern1>) (if (not (= (fail) Parse_shen.<pattern2>)) (shen.pair (hd (shen.pair (tl (hd V15993)) (hd (tl V15993)))) (cons @v (cons (shen.hdtl Parse_shen.<pattern1>) (cons (shen.hdtl Parse_shen.<pattern2>) ())))) (fail))) (fail))) (fail)) (fail)) (if (= YaccParse (fail)) (let YaccParse (if (and (cons? (hd V15993)) (cons? (hd (hd V15993)))) (if (and (cons? (hd (shen.pair (hd (hd V15993)) (hd (tl V15993))))) (= @s (hd (hd (shen.pair (hd (hd V15993)) (hd (tl V15993))))))) (let Parse_shen.<pattern1> (shen.<pattern1> (shen.pair (tl (hd (shen.pair (hd (hd V15993)) (hd (tl V15993))))) (shen.hdtl (shen.pair (hd (hd V15993)) (hd (tl V15993)))))) (if (not (= (fail) Parse_shen.<pattern1>)) (let Parse_shen.<pattern2> (shen.<pattern2> Parse_shen.<pattern1>) (if (not (= (fail) Parse_shen.<pattern2>)) (shen.pair (hd (shen.pair (tl (hd V15993)) (hd (tl V15993)))) (cons @s (cons (shen.hdtl Parse_shen.<pattern1>) (cons (shen.hdtl Parse_shen.<pattern2>) ())))) (fail))) (fail))) (fail)) (fail)) (if (= YaccParse (fail)) (let YaccParse (if (and (cons? (hd V15993)) (cons? (hd (hd V15993)))) (if (and (cons? (hd (shen.pair (hd (hd V15993)) (hd (tl V15993))))) (= vector (hd (hd (shen.pair (hd (hd V15993)) (hd (tl V15993))))))) (if (and (cons? (hd (shen.pair (tl (hd (shen.pair (hd (hd V15993)) (hd (tl V15993))))) (shen.hdtl (shen.pair (hd (hd V15993)) (hd (tl V15993))))))) (= 0 (hd (hd (shen.pair (tl (hd (shen.pair (hd (hd V15993)) (hd (tl V15993))))) (shen.hdtl (shen.pair (hd (hd V15993)) (hd (tl V15993))))))))) (shen.pair (hd (shen.pair (tl (hd V15993)) (hd (tl V15993)))) (cons vector (cons 0 ()))) (fail)) (fail)) (fail)) (if (= YaccParse (fail)) (let YaccParse (if (cons? (hd V15993)) (let Parse_X (hd (hd V15993)) (if (cons? Parse_X) (shen.pair (hd (shen.pair (tl (hd V15993)) (shen.hdtl V15993))) (shen.constructor-error Parse_X)) (fail))) (fail)) (if (= YaccParse (fail)) (let Parse_shen.<simple_pattern> (shen.<simple_pattern> V15993) (if (not (= (fail) Parse_shen.<simple_pattern>)) (shen.pair (hd Parse_shen.<simple_pattern>) (shen.hdtl Parse_shen.<simple_pattern>)) (fail))) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)))
|
|
57
57
|
|
|
58
|
-
(defun shen.constructor-error (
|
|
58
|
+
(defun shen.constructor-error (V15995) (simple-error (shen.app V15995 " is not a legitimate constructor
|
|
59
59
|
" shen.a)))
|
|
60
60
|
|
|
61
|
-
(defun shen.<simple_pattern> (
|
|
61
|
+
(defun shen.<simple_pattern> (V15997) (let YaccParse (if (cons? (hd V15997)) (let Parse_X (hd (hd V15997)) (if (= Parse_X _) (shen.pair (hd (shen.pair (tl (hd V15997)) (shen.hdtl V15997))) (gensym Parse_Y)) (fail))) (fail)) (if (= YaccParse (fail)) (if (cons? (hd V15997)) (let Parse_X (hd (hd V15997)) (if (not (element? Parse_X (cons -> (cons <- ())))) (shen.pair (hd (shen.pair (tl (hd V15997)) (shen.hdtl V15997))) Parse_X) (fail))) (fail)) YaccParse)))
|
|
62
62
|
|
|
63
|
-
(defun shen.<pattern1> (
|
|
63
|
+
(defun shen.<pattern1> (V15999) (let Parse_shen.<pattern> (shen.<pattern> V15999) (if (not (= (fail) Parse_shen.<pattern>)) (shen.pair (hd Parse_shen.<pattern>) (shen.hdtl Parse_shen.<pattern>)) (fail))))
|
|
64
64
|
|
|
65
|
-
(defun shen.<pattern2> (
|
|
65
|
+
(defun shen.<pattern2> (V16001) (let Parse_shen.<pattern> (shen.<pattern> V16001) (if (not (= (fail) Parse_shen.<pattern>)) (shen.pair (hd Parse_shen.<pattern>) (shen.hdtl Parse_shen.<pattern>)) (fail))))
|
|
66
66
|
|
|
67
|
-
(defun shen.<action> (
|
|
67
|
+
(defun shen.<action> (V16003) (if (cons? (hd V16003)) (let Parse_X (hd (hd V16003)) (shen.pair (hd (shen.pair (tl (hd V16003)) (shen.hdtl V16003))) Parse_X)) (fail)))
|
|
68
68
|
|
|
69
|
-
(defun shen.<guard> (
|
|
69
|
+
(defun shen.<guard> (V16005) (if (cons? (hd V16005)) (let Parse_X (hd (hd V16005)) (shen.pair (hd (shen.pair (tl (hd V16005)) (shen.hdtl V16005))) Parse_X)) (fail)))
|
|
70
70
|
|
|
71
|
-
(defun shen.compile_to_machine_code (
|
|
71
|
+
(defun shen.compile_to_machine_code (V16008 V16009) (let Lambda+ (shen.compile_to_lambda+ V16008 V16009) (let KL (shen.compile_to_kl V16008 Lambda+) (let Record (shen.record-source V16008 KL) KL))))
|
|
72
72
|
|
|
73
|
-
(defun shen.record-source (
|
|
73
|
+
(defun shen.record-source (V16014 V16015) (cond ((value shen.*installing-kl*) shen.skip) (true (put V16014 shen.source V16015 (value *property-vector*)))))
|
|
74
74
|
|
|
75
|
-
(defun shen.compile_to_lambda+ (
|
|
75
|
+
(defun shen.compile_to_lambda+ (V16018 V16019) (let Arity (shen.aritycheck V16018 V16019) (let UpDateSymbolTable (shen.update-symbol-table V16018 Arity) (let Free (map (lambda Rule (shen.free_variable_check V16018 Rule)) V16019) (let Variables (shen.parameters Arity) (let Strip (map (lambda X (shen.strip-protect X)) V16019) (let Abstractions (map (lambda X (shen.abstract_rule X)) Strip) (let Applications (map (lambda X (shen.application_build Variables X)) Abstractions) (cons Variables (cons Applications ()))))))))))
|
|
76
76
|
|
|
77
|
-
(defun shen.
|
|
77
|
+
(defun shen.update-symbol-table (V16022 V16023) (set shen.*symbol-table* (shen.update-symbol-table-h V16022 V16023 (value shen.*symbol-table*) ())))
|
|
78
78
|
|
|
79
|
-
(defun shen.
|
|
79
|
+
(defun shen.update-symbol-table-h (V16031 V16032 V16033 V16034) (cond ((= () V16033) (let NewEntry (cons V16031 (eval-kl (shen.lambda-form V16031 V16032))) (cons NewEntry V16034))) ((and (cons? V16033) (and (cons? (hd V16033)) (= (hd (hd V16033)) V16031))) (let ChangedEntry (cons (hd (hd V16033)) (eval-kl (shen.lambda-form (hd (hd V16033)) V16032))) (append (tl V16033) (cons ChangedEntry V16034)))) ((cons? V16033) (shen.update-symbol-table-h V16031 V16032 (tl V16033) (cons (hd V16033) V16034))) (true (shen.f_error shen.update-symbol-table-h))))
|
|
80
80
|
|
|
81
|
-
(defun shen.
|
|
81
|
+
(defun shen.free_variable_check (V16037 V16038) (cond ((and (cons? V16038) (and (cons? (tl V16038)) (= () (tl (tl V16038))))) (let Bound (shen.extract_vars (hd V16038)) (let Free (shen.extract_free_vars Bound (hd (tl V16038))) (shen.free_variable_warnings V16037 Free)))) (true (shen.f_error shen.free_variable_check))))
|
|
82
82
|
|
|
83
|
-
(defun shen.
|
|
83
|
+
(defun shen.extract_vars (V16040) (cond ((variable? V16040) (cons V16040 ())) ((cons? V16040) (union (shen.extract_vars (hd V16040)) (shen.extract_vars (tl V16040)))) (true ())))
|
|
84
84
|
|
|
85
|
-
(defun shen.
|
|
85
|
+
(defun shen.extract_free_vars (V16052 V16053) (cond ((and (cons? V16053) (and (cons? (tl V16053)) (and (= () (tl (tl V16053))) (= (hd V16053) protect)))) ()) ((and (variable? V16053) (not (element? V16053 V16052))) (cons V16053 ())) ((and (cons? V16053) (and (= lambda (hd V16053)) (and (cons? (tl V16053)) (and (cons? (tl (tl V16053))) (= () (tl (tl (tl V16053)))))))) (shen.extract_free_vars (cons (hd (tl V16053)) V16052) (hd (tl (tl V16053))))) ((and (cons? V16053) (and (= let (hd V16053)) (and (cons? (tl V16053)) (and (cons? (tl (tl V16053))) (and (cons? (tl (tl (tl V16053)))) (= () (tl (tl (tl (tl V16053)))))))))) (union (shen.extract_free_vars V16052 (hd (tl (tl V16053)))) (shen.extract_free_vars (cons (hd (tl V16053)) V16052) (hd (tl (tl (tl V16053))))))) ((cons? V16053) (union (shen.extract_free_vars V16052 (hd V16053)) (shen.extract_free_vars V16052 (tl V16053)))) (true ())))
|
|
86
86
|
|
|
87
|
-
(defun shen.
|
|
87
|
+
(defun shen.free_variable_warnings (V16058 V16059) (cond ((= () V16059) _) (true (simple-error (cn "error: the following variables are free in " (shen.app V16058 (cn ": " (shen.app (shen.list_variables V16059) "" shen.a)) shen.a))))))
|
|
88
88
|
|
|
89
|
-
(defun shen.
|
|
89
|
+
(defun shen.list_variables (V16061) (cond ((and (cons? V16061) (= () (tl V16061))) (cn (str (hd V16061)) ".")) ((cons? V16061) (cn (str (hd V16061)) (cn ", " (shen.list_variables (tl V16061))))) (true (shen.f_error shen.list_variables))))
|
|
90
90
|
|
|
91
|
-
(defun shen.
|
|
91
|
+
(defun shen.strip-protect (V16063) (cond ((and (cons? V16063) (and (cons? (tl V16063)) (and (= () (tl (tl V16063))) (= (hd V16063) protect)))) (shen.strip-protect (hd (tl V16063)))) ((cons? V16063) (map (lambda Z (shen.strip-protect Z)) V16063)) (true V16063)))
|
|
92
92
|
|
|
93
|
-
(defun shen.
|
|
93
|
+
(defun shen.linearise (V16065) (cond ((and (cons? V16065) (and (cons? (tl V16065)) (= () (tl (tl V16065))))) (shen.linearise_help (shen.flatten (hd V16065)) (hd V16065) (hd (tl V16065)))) (true (shen.f_error shen.linearise))))
|
|
94
94
|
|
|
95
|
-
(defun shen.
|
|
95
|
+
(defun shen.flatten (V16067) (cond ((= () V16067) ()) ((cons? V16067) (append (shen.flatten (hd V16067)) (shen.flatten (tl V16067)))) (true (cons V16067 ()))))
|
|
96
96
|
|
|
97
|
-
(defun shen.
|
|
97
|
+
(defun shen.linearise_help (V16071 V16072 V16073) (cond ((= () V16071) (cons V16072 (cons V16073 ()))) ((cons? V16071) (if (and (variable? (hd V16071)) (element? (hd V16071) (tl V16071))) (let Var (gensym (hd V16071)) (let NewAction (cons where (cons (cons = (cons (hd V16071) (cons Var ()))) (cons V16073 ()))) (let NewPatts (shen.linearise_X (hd V16071) Var V16072) (shen.linearise_help (tl V16071) NewPatts NewAction)))) (shen.linearise_help (tl V16071) V16072 V16073))) (true (shen.f_error shen.linearise_help))))
|
|
98
|
+
|
|
99
|
+
(defun shen.linearise_X (V16086 V16087 V16088) (cond ((= V16088 V16086) V16087) ((cons? V16088) (let L (shen.linearise_X V16086 V16087 (hd V16088)) (if (= L (hd V16088)) (cons (hd V16088) (shen.linearise_X V16086 V16087 (tl V16088))) (cons L (tl V16088))))) (true V16088)))
|
|
100
|
+
|
|
101
|
+
(defun shen.aritycheck (V16091 V16092) (cond ((and (cons? V16092) (and (cons? (hd V16092)) (and (cons? (tl (hd V16092))) (and (= () (tl (tl (hd V16092)))) (= () (tl V16092)))))) (do (shen.aritycheck-action (hd (tl (hd V16092)))) (shen.aritycheck-name V16091 (arity V16091) (length (hd (hd V16092)))))) ((and (cons? V16092) (and (cons? (hd V16092)) (and (cons? (tl (hd V16092))) (and (= () (tl (tl (hd V16092)))) (and (cons? (tl V16092)) (and (cons? (hd (tl V16092))) (and (cons? (tl (hd (tl V16092)))) (= () (tl (tl (hd (tl V16092)))))))))))) (if (= (length (hd (hd V16092))) (length (hd (hd (tl V16092))))) (do (shen.aritycheck-action (hd (tl (hd V16092)))) (shen.aritycheck V16091 (tl V16092))) (simple-error (cn "arity error in " (shen.app V16091 "
|
|
98
102
|
" shen.a))))) (true (shen.f_error shen.aritycheck))))
|
|
99
103
|
|
|
100
|
-
(defun shen.aritycheck-name (
|
|
101
|
-
warning: changing the arity of " (shen.app
|
|
102
|
-
" shen.a)) (stoutput))
|
|
104
|
+
(defun shen.aritycheck-name (V16105 V16106 V16107) (cond ((= -1 V16106) V16107) ((= V16107 V16106) V16107) (true (do (shen.prhush (cn "
|
|
105
|
+
warning: changing the arity of " (shen.app V16105 " can cause errors.
|
|
106
|
+
" shen.a)) (stoutput)) V16107))))
|
|
103
107
|
|
|
104
|
-
(defun shen.aritycheck-action (
|
|
108
|
+
(defun shen.aritycheck-action (V16113) (cond ((cons? V16113) (do (shen.aah (hd V16113) (tl V16113)) (map (lambda Y (shen.aritycheck-action Y)) V16113))) (true shen.skip)))
|
|
105
109
|
|
|
106
|
-
(defun shen.aah (
|
|
110
|
+
(defun shen.aah (V16116 V16117) (let Arity (arity V16116) (let Len (length V16117) (if (and (> Arity -1) (> Len Arity)) (shen.prhush (cn "warning: " (shen.app V16116 (cn " might not like " (shen.app Len (cn " argument" (shen.app (if (> Len 1) "s" "") ".
|
|
107
111
|
" shen.a)) shen.a)) shen.a)) (stoutput)) shen.skip))))
|
|
108
112
|
|
|
109
|
-
(defun shen.abstract_rule (
|
|
113
|
+
(defun shen.abstract_rule (V16119) (cond ((and (cons? V16119) (and (cons? (tl V16119)) (= () (tl (tl V16119))))) (shen.abstraction_build (hd V16119) (hd (tl V16119)))) (true (shen.f_error shen.abstract_rule))))
|
|
110
114
|
|
|
111
|
-
(defun shen.abstraction_build (
|
|
115
|
+
(defun shen.abstraction_build (V16122 V16123) (cond ((= () V16122) V16123) ((cons? V16122) (cons /. (cons (hd V16122) (cons (shen.abstraction_build (tl V16122) V16123) ())))) (true (shen.f_error shen.abstraction_build))))
|
|
112
116
|
|
|
113
|
-
(defun shen.parameters (
|
|
117
|
+
(defun shen.parameters (V16125) (cond ((= 0 V16125) ()) (true (cons (gensym V) (shen.parameters (- V16125 1))))))
|
|
114
118
|
|
|
115
|
-
(defun shen.application_build (
|
|
119
|
+
(defun shen.application_build (V16128 V16129) (cond ((= () V16128) V16129) ((cons? V16128) (shen.application_build (tl V16128) (cons V16129 (cons (hd V16128) ())))) (true (shen.f_error shen.application_build))))
|
|
116
120
|
|
|
117
|
-
(defun shen.compile_to_kl (
|
|
121
|
+
(defun shen.compile_to_kl (V16132 V16133) (cond ((and (cons? V16133) (and (cons? (tl V16133)) (= () (tl (tl V16133))))) (let Arity (shen.store-arity V16132 (length (hd V16133))) (let Reduce (map (lambda X (shen.reduce X)) (hd (tl V16133))) (let CondExpression (shen.cond-expression V16132 (hd V16133) Reduce) (let TypeTable (if (value shen.*optimise*) (shen.typextable (shen.get-type V16132) (hd V16133)) shen.skip) (let TypedCondExpression (if (value shen.*optimise*) (shen.assign-types (hd V16133) TypeTable CondExpression) CondExpression) (let KL (cons defun (cons V16132 (cons (hd V16133) (cons TypedCondExpression ())))) KL))))))) (true (shen.f_error shen.compile_to_kl))))
|
|
118
122
|
|
|
119
|
-
(defun shen.get-type (
|
|
123
|
+
(defun shen.get-type (V16139) (cond ((cons? V16139) shen.skip) (true (let FType (assoc V16139 (value shen.*signedfuncs*)) (if (empty? FType) shen.skip (tl FType))))))
|
|
120
124
|
|
|
121
|
-
(defun shen.typextable (
|
|
125
|
+
(defun shen.typextable (V16150 V16151) (cond ((and (cons? V16150) (and (cons? (tl V16150)) (and (= --> (hd (tl V16150))) (and (cons? (tl (tl V16150))) (and (= () (tl (tl (tl V16150)))) (cons? V16151)))))) (if (variable? (hd V16150)) (shen.typextable (hd (tl (tl V16150))) (tl V16151)) (cons (cons (hd V16151) (hd V16150)) (shen.typextable (hd (tl (tl V16150))) (tl V16151))))) (true ())))
|
|
122
126
|
|
|
123
|
-
(defun shen.assign-types (
|
|
127
|
+
(defun shen.assign-types (V16155 V16156 V16157) (cond ((and (cons? V16157) (and (= let (hd V16157)) (and (cons? (tl V16157)) (and (cons? (tl (tl V16157))) (and (cons? (tl (tl (tl V16157)))) (= () (tl (tl (tl (tl V16157)))))))))) (cons let (cons (hd (tl V16157)) (cons (shen.assign-types V16155 V16156 (hd (tl (tl V16157)))) (cons (shen.assign-types (cons (hd (tl V16157)) V16155) V16156 (hd (tl (tl (tl V16157))))) ()))))) ((and (cons? V16157) (and (= lambda (hd V16157)) (and (cons? (tl V16157)) (and (cons? (tl (tl V16157))) (= () (tl (tl (tl V16157)))))))) (cons lambda (cons (hd (tl V16157)) (cons (shen.assign-types (cons (hd (tl V16157)) V16155) V16156 (hd (tl (tl V16157)))) ())))) ((and (cons? V16157) (= cond (hd V16157))) (cons cond (map (lambda Y (cons (shen.assign-types V16155 V16156 (hd Y)) (cons (shen.assign-types V16155 V16156 (hd (tl Y))) ()))) (tl V16157)))) ((cons? V16157) (let NewTable (shen.typextable (shen.get-type (hd V16157)) (tl V16157)) (cons (hd V16157) (map (lambda Y (shen.assign-types V16155 (append V16156 NewTable) Y)) (tl V16157))))) (true (let AtomType (assoc V16157 V16156) (if (cons? AtomType) (cons type (cons V16157 (cons (tl AtomType) ()))) (if (element? V16157 V16155) V16157 (shen.atom-type V16157)))))))
|
|
124
128
|
|
|
125
|
-
(defun shen.atom-type (
|
|
129
|
+
(defun shen.atom-type (V16159) (if (string? V16159) (cons type (cons V16159 (cons string ()))) (if (number? V16159) (cons type (cons V16159 (cons number ()))) (if (boolean? V16159) (cons type (cons V16159 (cons boolean ()))) (if (symbol? V16159) (cons type (cons V16159 (cons symbol ()))) V16159)))))
|
|
126
130
|
|
|
127
|
-
(defun shen.store-arity (
|
|
131
|
+
(defun shen.store-arity (V16164 V16165) (cond ((value shen.*installing-kl*) shen.skip) (true (put V16164 arity V16165 (value *property-vector*)))))
|
|
128
132
|
|
|
129
|
-
(defun shen.reduce (
|
|
133
|
+
(defun shen.reduce (V16167) (do (set shen.*teststack* ()) (let Result (shen.reduce_help V16167) (cons (cons : (cons shen.tests (reverse (value shen.*teststack*)))) (cons Result ())))))
|
|
130
134
|
|
|
131
|
-
(defun shen.reduce_help (
|
|
135
|
+
(defun shen.reduce_help (V16169) (cond ((and (cons? V16169) (and (cons? (hd V16169)) (and (= /. (hd (hd V16169))) (and (cons? (tl (hd V16169))) (and (cons? (hd (tl (hd V16169)))) (and (= cons (hd (hd (tl (hd V16169))))) (and (cons? (tl (hd (tl (hd V16169))))) (and (cons? (tl (tl (hd (tl (hd V16169)))))) (and (= () (tl (tl (tl (hd (tl (hd V16169))))))) (and (cons? (tl (tl (hd V16169)))) (and (= () (tl (tl (tl (hd V16169))))) (and (cons? (tl V16169)) (= () (tl (tl V16169))))))))))))))) (do (shen.add_test (cons cons? (tl V16169))) (let Abstraction (cons /. (cons (hd (tl (hd (tl (hd V16169))))) (cons (cons /. (cons (hd (tl (tl (hd (tl (hd V16169)))))) (cons (shen.ebr (hd (tl V16169)) (hd (tl (hd V16169))) (hd (tl (tl (hd V16169))))) ()))) ()))) (let Application (cons (cons Abstraction (cons (cons hd (tl V16169)) ())) (cons (cons tl (tl V16169)) ())) (shen.reduce_help Application))))) ((and (cons? V16169) (and (cons? (hd V16169)) (and (= /. (hd (hd V16169))) (and (cons? (tl (hd V16169))) (and (cons? (hd (tl (hd V16169)))) (and (= @p (hd (hd (tl (hd V16169))))) (and (cons? (tl (hd (tl (hd V16169))))) (and (cons? (tl (tl (hd (tl (hd V16169)))))) (and (= () (tl (tl (tl (hd (tl (hd V16169))))))) (and (cons? (tl (tl (hd V16169)))) (and (= () (tl (tl (tl (hd V16169))))) (and (cons? (tl V16169)) (= () (tl (tl V16169))))))))))))))) (do (shen.add_test (cons tuple? (tl V16169))) (let Abstraction (cons /. (cons (hd (tl (hd (tl (hd V16169))))) (cons (cons /. (cons (hd (tl (tl (hd (tl (hd V16169)))))) (cons (shen.ebr (hd (tl V16169)) (hd (tl (hd V16169))) (hd (tl (tl (hd V16169))))) ()))) ()))) (let Application (cons (cons Abstraction (cons (cons fst (tl V16169)) ())) (cons (cons snd (tl V16169)) ())) (shen.reduce_help Application))))) ((and (cons? V16169) (and (cons? (hd V16169)) (and (= /. (hd (hd V16169))) (and (cons? (tl (hd V16169))) (and (cons? (hd (tl (hd V16169)))) (and (= @v (hd (hd (tl (hd V16169))))) (and (cons? (tl (hd (tl (hd V16169))))) (and (cons? (tl (tl (hd (tl (hd V16169)))))) (and (= () (tl (tl (tl (hd (tl (hd V16169))))))) (and (cons? (tl (tl (hd V16169)))) (and (= () (tl (tl (tl (hd V16169))))) (and (cons? (tl V16169)) (= () (tl (tl V16169))))))))))))))) (do (shen.add_test (cons shen.+vector? (tl V16169))) (let Abstraction (cons /. (cons (hd (tl (hd (tl (hd V16169))))) (cons (cons /. (cons (hd (tl (tl (hd (tl (hd V16169)))))) (cons (shen.ebr (hd (tl V16169)) (hd (tl (hd V16169))) (hd (tl (tl (hd V16169))))) ()))) ()))) (let Application (cons (cons Abstraction (cons (cons hdv (tl V16169)) ())) (cons (cons tlv (tl V16169)) ())) (shen.reduce_help Application))))) ((and (cons? V16169) (and (cons? (hd V16169)) (and (= /. (hd (hd V16169))) (and (cons? (tl (hd V16169))) (and (cons? (hd (tl (hd V16169)))) (and (= @s (hd (hd (tl (hd V16169))))) (and (cons? (tl (hd (tl (hd V16169))))) (and (cons? (tl (tl (hd (tl (hd V16169)))))) (and (= () (tl (tl (tl (hd (tl (hd V16169))))))) (and (cons? (tl (tl (hd V16169)))) (and (= () (tl (tl (tl (hd V16169))))) (and (cons? (tl V16169)) (= () (tl (tl V16169))))))))))))))) (do (shen.add_test (cons shen.+string? (tl V16169))) (let Abstraction (cons /. (cons (hd (tl (hd (tl (hd V16169))))) (cons (cons /. (cons (hd (tl (tl (hd (tl (hd V16169)))))) (cons (shen.ebr (hd (tl V16169)) (hd (tl (hd V16169))) (hd (tl (tl (hd V16169))))) ()))) ()))) (let Application (cons (cons Abstraction (cons (cons pos (cons (hd (tl V16169)) (cons 0 ()))) ())) (cons (cons tlstr (tl V16169)) ())) (shen.reduce_help Application))))) ((and (cons? V16169) (and (cons? (hd V16169)) (and (= /. (hd (hd V16169))) (and (cons? (tl (hd V16169))) (and (cons? (tl (tl (hd V16169)))) (and (= () (tl (tl (tl (hd V16169))))) (and (cons? (tl V16169)) (and (= () (tl (tl V16169))) (not (variable? (hd (tl (hd V16169))))))))))))) (do (shen.add_test (cons = (cons (hd (tl (hd V16169))) (tl V16169)))) (shen.reduce_help (hd (tl (tl (hd V16169))))))) ((and (cons? V16169) (and (cons? (hd V16169)) (and (= /. (hd (hd V16169))) (and (cons? (tl (hd V16169))) (and (cons? (tl (tl (hd V16169)))) (and (= () (tl (tl (tl (hd V16169))))) (and (cons? (tl V16169)) (= () (tl (tl V16169)))))))))) (shen.reduce_help (shen.ebr (hd (tl V16169)) (hd (tl (hd V16169))) (hd (tl (tl (hd V16169))))))) ((and (cons? V16169) (and (= where (hd V16169)) (and (cons? (tl V16169)) (and (cons? (tl (tl V16169))) (= () (tl (tl (tl V16169)))))))) (do (shen.add_test (hd (tl V16169))) (shen.reduce_help (hd (tl (tl V16169)))))) ((and (cons? V16169) (and (cons? (tl V16169)) (= () (tl (tl V16169))))) (let Z (shen.reduce_help (hd V16169)) (if (= (hd V16169) Z) V16169 (shen.reduce_help (cons Z (tl V16169)))))) (true V16169)))
|
|
132
136
|
|
|
133
|
-
(defun shen.+string? (
|
|
137
|
+
(defun shen.+string? (V16171) (cond ((= "" V16171) false) (true (string? V16171))))
|
|
134
138
|
|
|
135
|
-
(defun shen.+vector (
|
|
139
|
+
(defun shen.+vector (V16173) (cond ((= V16173 (vector 0)) false) (true (vector? V16173))))
|
|
136
140
|
|
|
137
|
-
(defun shen.ebr (
|
|
141
|
+
(defun shen.ebr (V16187 V16188 V16189) (cond ((= V16189 V16188) V16187) ((and (cons? V16189) (and (= /. (hd V16189)) (and (cons? (tl V16189)) (and (cons? (tl (tl V16189))) (and (= () (tl (tl (tl V16189)))) (> (occurrences V16188 (hd (tl V16189))) 0)))))) V16189) ((and (cons? V16189) (and (= let (hd V16189)) (and (cons? (tl V16189)) (and (cons? (tl (tl V16189))) (and (cons? (tl (tl (tl V16189)))) (and (= () (tl (tl (tl (tl V16189))))) (= (hd (tl V16189)) V16188))))))) (cons let (cons (hd (tl V16189)) (cons (shen.ebr V16187 (hd (tl V16189)) (hd (tl (tl V16189)))) (tl (tl (tl V16189))))))) ((cons? V16189) (cons (shen.ebr V16187 V16188 (hd V16189)) (shen.ebr V16187 V16188 (tl V16189)))) (true V16189)))
|
|
138
142
|
|
|
139
|
-
(defun shen.add_test (
|
|
143
|
+
(defun shen.add_test (V16191) (set shen.*teststack* (cons V16191 (value shen.*teststack*))))
|
|
140
144
|
|
|
141
|
-
(defun shen.cond-expression (
|
|
145
|
+
(defun shen.cond-expression (V16195 V16196 V16197) (let Err (shen.err-condition V16195) (let Cases (shen.case-form V16197 Err) (let EncodeChoices (shen.encode-choices Cases V16195) (shen.cond-form EncodeChoices)))))
|
|
142
146
|
|
|
143
|
-
(defun shen.cond-form (
|
|
147
|
+
(defun shen.cond-form (V16201) (cond ((and (cons? V16201) (and (cons? (hd V16201)) (and (= true (hd (hd V16201))) (and (cons? (tl (hd V16201))) (= () (tl (tl (hd V16201)))))))) (hd (tl (hd V16201)))) (true (cons cond V16201))))
|
|
144
148
|
|
|
145
|
-
(defun shen.encode-choices (
|
|
149
|
+
(defun shen.encode-choices (V16206 V16207) (cond ((= () V16206) ()) ((and (cons? V16206) (and (cons? (hd V16206)) (and (= true (hd (hd V16206))) (and (cons? (tl (hd V16206))) (and (cons? (hd (tl (hd V16206)))) (and (= shen.choicepoint! (hd (hd (tl (hd V16206))))) (and (cons? (tl (hd (tl (hd V16206))))) (and (= () (tl (tl (hd (tl (hd V16206)))))) (and (= () (tl (tl (hd V16206)))) (= () (tl V16206))))))))))) (cons (cons true (cons (cons let (cons Result (cons (hd (tl (hd (tl (hd V16206))))) (cons (cons if (cons (cons = (cons Result (cons (cons fail ()) ()))) (cons (if (value shen.*installing-kl*) (cons shen.sys-error (cons V16207 ())) (cons shen.f_error (cons V16207 ()))) (cons Result ())))) ())))) ())) ())) ((and (cons? V16206) (and (cons? (hd V16206)) (and (= true (hd (hd V16206))) (and (cons? (tl (hd V16206))) (and (cons? (hd (tl (hd V16206)))) (and (= shen.choicepoint! (hd (hd (tl (hd V16206))))) (and (cons? (tl (hd (tl (hd V16206))))) (and (= () (tl (tl (hd (tl (hd V16206)))))) (= () (tl (tl (hd V16206)))))))))))) (cons (cons true (cons (cons let (cons Result (cons (hd (tl (hd (tl (hd V16206))))) (cons (cons if (cons (cons = (cons Result (cons (cons fail ()) ()))) (cons (shen.cond-form (shen.encode-choices (tl V16206) V16207)) (cons Result ())))) ())))) ())) ())) ((and (cons? V16206) (and (cons? (hd V16206)) (and (cons? (tl (hd V16206))) (and (cons? (hd (tl (hd V16206)))) (and (= shen.choicepoint! (hd (hd (tl (hd V16206))))) (and (cons? (tl (hd (tl (hd V16206))))) (and (= () (tl (tl (hd (tl (hd V16206)))))) (= () (tl (tl (hd V16206))))))))))) (cons (cons true (cons (cons let (cons Freeze (cons (cons freeze (cons (shen.cond-form (shen.encode-choices (tl V16206) V16207)) ())) (cons (cons if (cons (hd (hd V16206)) (cons (cons let (cons Result (cons (hd (tl (hd (tl (hd V16206))))) (cons (cons if (cons (cons = (cons Result (cons (cons fail ()) ()))) (cons (cons thaw (cons Freeze ())) (cons Result ())))) ())))) (cons (cons thaw (cons Freeze ())) ())))) ())))) ())) ())) ((and (cons? V16206) (and (cons? (hd V16206)) (and (cons? (tl (hd V16206))) (= () (tl (tl (hd V16206))))))) (cons (hd V16206) (shen.encode-choices (tl V16206) V16207))) (true (shen.f_error shen.encode-choices))))
|
|
146
150
|
|
|
147
|
-
(defun shen.case-form (
|
|
151
|
+
(defun shen.case-form (V16214 V16215) (cond ((= () V16214) (cons V16215 ())) ((and (cons? V16214) (and (cons? (hd V16214)) (and (cons? (hd (hd V16214))) (and (= : (hd (hd (hd V16214)))) (and (cons? (tl (hd (hd V16214)))) (and (= shen.tests (hd (tl (hd (hd V16214))))) (and (= () (tl (tl (hd (hd V16214))))) (and (cons? (tl (hd V16214))) (and (cons? (hd (tl (hd V16214)))) (and (= shen.choicepoint! (hd (hd (tl (hd V16214))))) (and (cons? (tl (hd (tl (hd V16214))))) (and (= () (tl (tl (hd (tl (hd V16214)))))) (= () (tl (tl (hd V16214)))))))))))))))) (cons (cons true (tl (hd V16214))) (shen.case-form (tl V16214) V16215))) ((and (cons? V16214) (and (cons? (hd V16214)) (and (cons? (hd (hd V16214))) (and (= : (hd (hd (hd V16214)))) (and (cons? (tl (hd (hd V16214)))) (and (= shen.tests (hd (tl (hd (hd V16214))))) (and (= () (tl (tl (hd (hd V16214))))) (and (cons? (tl (hd V16214))) (= () (tl (tl (hd V16214)))))))))))) (cons (cons true (tl (hd V16214))) ())) ((and (cons? V16214) (and (cons? (hd V16214)) (and (cons? (hd (hd V16214))) (and (= : (hd (hd (hd V16214)))) (and (cons? (tl (hd (hd V16214)))) (and (= shen.tests (hd (tl (hd (hd V16214))))) (and (cons? (tl (hd V16214))) (= () (tl (tl (hd V16214))))))))))) (cons (cons (shen.embed-and (tl (tl (hd (hd V16214))))) (tl (hd V16214))) (shen.case-form (tl V16214) V16215))) (true (shen.f_error shen.case-form))))
|
|
148
152
|
|
|
149
|
-
(defun shen.embed-and (
|
|
153
|
+
(defun shen.embed-and (V16217) (cond ((and (cons? V16217) (= () (tl V16217))) (hd V16217)) ((cons? V16217) (cons and (cons (hd V16217) (cons (shen.embed-and (tl V16217)) ())))) (true (shen.f_error shen.embed-and))))
|
|
150
154
|
|
|
151
|
-
(defun shen.err-condition (
|
|
155
|
+
(defun shen.err-condition (V16219) (cons true (cons (cons shen.f_error (cons V16219 ())) ())))
|
|
152
156
|
|
|
153
|
-
(defun shen.sys-error (
|
|
157
|
+
(defun shen.sys-error (V16221) (simple-error (cn "system function " (shen.app V16221 ": unexpected argument
|
|
154
158
|
" shen.a))))
|
|
155
159
|
|
|
156
160
|
|