shen-ruby 0.6.0 → 0.7.0
Sign up to get free protection for your applications and to get access to all the features.
- checksums.yaml +7 -0
- data/HISTORY.md +10 -0
- data/README.md +19 -17
- data/lib/kl/primitives/streams.rb +7 -17
- data/lib/shen_ruby/version.rb +1 -1
- data/shen/README.txt +1 -1
- data/shen/release/k_lambda/core.kl +56 -56
- data/shen/release/k_lambda/declarations.kl +8 -8
- data/shen/release/k_lambda/load.kl +15 -15
- data/shen/release/k_lambda/macros.kl +30 -28
- data/shen/release/k_lambda/prolog.kl +97 -97
- data/shen/release/k_lambda/reader.kl +91 -69
- data/shen/release/k_lambda/sequent.kl +53 -53
- data/shen/release/k_lambda/sys.kl +92 -108
- data/shen/release/k_lambda/t-star.kl +50 -55
- data/shen/release/k_lambda/toplevel.kl +23 -23
- data/shen/release/k_lambda/types.kl +2 -2
- data/shen/release/k_lambda/writer.kl +28 -22
- data/shen/release/test_programs/interpreter.shen +4 -6
- data/shen/release/test_programs/proof_assistant.shen +3 -3
- data/shen/release/test_programs/whist.shen +2 -2
- data/shen-ruby.gemspec +2 -2
- metadata +9 -13
checksums.yaml
ADDED
|
@@ -0,0 +1,7 @@
|
|
|
1
|
+
---
|
|
2
|
+
SHA1:
|
|
3
|
+
metadata.gz: 6b5c1f5512d88233c44e5b0c849748d47127d291
|
|
4
|
+
data.tar.gz: 84655e2af667611b2bd7a54a1893b798d055ae94
|
|
5
|
+
SHA512:
|
|
6
|
+
metadata.gz: 1c7ec95bdf8959aca387542066d81a60c880d0a12829824c5f5881dcd2d414e2858b593e4577956a297d2c20e75ab969a1197115ea0d358c0f1e210567106614
|
|
7
|
+
data.tar.gz: 3d05dff268f7a351e95acb22c4a0e0dec82d766b9eabd1b54d63162fd9be0d392d540a1ef74ce9920a0fd3f45e3b8671da357fb15378f6662fc81ee45f80accb
|
data/HISTORY.md
CHANGED
|
@@ -1,5 +1,15 @@
|
|
|
1
1
|
# ShenRuby Release History
|
|
2
2
|
|
|
3
|
+
## 0.7.0 - July 3, 2013
|
|
4
|
+
### Features
|
|
5
|
+
- Upgrade to Shen 13
|
|
6
|
+
- `pr` is no longer a K Lambda primitive
|
|
7
|
+
- `write-byte` added as K Lambda primitive
|
|
8
|
+
- `open` no longer takes stream type as its first argument
|
|
9
|
+
|
|
10
|
+
### Misc
|
|
11
|
+
- Clarify license
|
|
12
|
+
|
|
3
13
|
## 0.6.0 - June 11, 2013
|
|
4
14
|
### Features
|
|
5
15
|
- Upgrade to Shen 12
|
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 13, which was released in July, 2013.
|
|
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, a Shen REPL is only a gem install away.
|
|
7
7
|
|
|
@@ -12,9 +12,9 @@ ShenRuby 0.1.0 began to satisfy the first goal by providing a Shen REPL accessib
|
|
|
12
12
|
[](https://travis-ci.org/gregspurrier/shen-ruby)
|
|
13
13
|
|
|
14
14
|
## Installation
|
|
15
|
-
NOTE: ShenRuby requires Ruby 1.9 language features. It has been tested with Ruby 1.9.3
|
|
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 Rubinius 2.0.0-head running in 1.9 mode. It is not yet working under JRuby.
|
|
16
16
|
|
|
17
|
-
ShenRuby 0.
|
|
17
|
+
ShenRuby 0.7.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.6.0 is the current release. To install it as gem, use the following c
|
|
|
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
|
|
27
|
-
|
|
26
|
+
Loading.... Completed in 6.28 seconds.
|
|
27
|
+
|
|
28
28
|
Shen 2010, copyright (C) 2010 Mark Tarver
|
|
29
29
|
released under the Shen license
|
|
30
|
-
www.shenlanguage.org, version
|
|
31
|
-
running under Ruby, implementation: ruby
|
|
32
|
-
port 0.
|
|
30
|
+
www.shenlanguage.org, version 13
|
|
31
|
+
running under Ruby, implementation: ruby 2.0.0
|
|
32
|
+
port 0.7.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 6 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
|
|
|
@@ -44,13 +44,13 @@ Here is an example of defining a recursive factorial function via the REPL and t
|
|
|
44
44
|
0 -> 1
|
|
45
45
|
X -> (* X (factorial (- X 1))))
|
|
46
46
|
factorial
|
|
47
|
-
|
|
47
|
+
|
|
48
48
|
(1-) (factorial 5)
|
|
49
49
|
120
|
|
50
|
-
|
|
50
|
+
|
|
51
51
|
(2-) (factorial 20)
|
|
52
52
|
2432902008176640000
|
|
53
|
-
|
|
53
|
+
|
|
54
54
|
(3-) (factorial 100)
|
|
55
55
|
93326215443944152681699238856266700490715968264381621468592963895217599993229915608941463976156518286253697920827223758251185210916864000000000000000000000000
|
|
56
56
|
|
|
@@ -78,7 +78,7 @@ For example, to add a `divides?` function to an existing Shen environment object
|
|
|
78
78
|
|
|
79
79
|
require 'rubygems'
|
|
80
80
|
require 'shen_ruby'
|
|
81
|
-
|
|
81
|
+
|
|
82
82
|
shen = ShenRuby::Shen.new
|
|
83
83
|
class << shen
|
|
84
84
|
def divides?(a, b)
|
|
@@ -91,7 +91,7 @@ For example, to add a `divides?` function to an existing Shen environment object
|
|
|
91
91
|
|
|
92
92
|
shen.eval_string "(divides? 3 9)"
|
|
93
93
|
# => true
|
|
94
|
-
|
|
94
|
+
|
|
95
95
|
More commonly, though, `eval_string` is used with Shen `define` expressions to extend the environment with new functions that are implemented in Shen. For example, let's add a [Fizz Buzz](http://en.wikipedia.org/wiki/Fizz_buzz) function:
|
|
96
96
|
|
|
97
97
|
shen.eval_string <<-EOS
|
|
@@ -111,7 +111,7 @@ A better way to invoke most Shen functions from Ruby is to simply invoke the cor
|
|
|
111
111
|
For example, to use the `fizz-buzz` function defined in the previous section to compute the first 20 Fizz Buzz values:
|
|
112
112
|
|
|
113
113
|
(1..20).map { |x| shen.fizz_buzz(x) }
|
|
114
|
-
# => ["1", "2", "Fizz", "4", "Buzz", "Fizz", "7", "8", "Fizz", "Buzz", "11", "Fizz", "13", "14", "Fizz Buzz", "16", "17", "Fizz", "19", "Buzz"]
|
|
114
|
+
# => ["1", "2", "Fizz", "4", "Buzz", "Fizz", "7", "8", "Fizz", "Buzz", "11", "Fizz", "13", "14", "Fizz Buzz", "16", "17", "Fizz", "19", "Buzz"]
|
|
115
115
|
|
|
116
116
|
The above example uses Ruby's `map` function, but could also have used Shen's version, relying on ShenRuby's interop features to coerce Ruby arrays to and from Shen lists:
|
|
117
117
|
|
|
@@ -165,6 +165,8 @@ The following people are gratefully acknowledged for their contributions to Shen
|
|
|
165
165
|
- Bruno Deferrari
|
|
166
166
|
|
|
167
167
|
## License
|
|
168
|
-
Shen
|
|
168
|
+
Shen and ShenRuby are released under the Shen License. A copy of the Shen License may be found in [shen/license.txt](https://github.com/gregspurrier/shen-ruby/blob/master/shen/license.txt). A detailed description of the license, along with questions and answers, may be found at http://shenlanguage.org/license.html. In particular, please note that any forks or derivatives of ShenRuby must maintain conformance with the Official Shen Specification.
|
|
169
|
+
|
|
170
|
+
The implementation of Shen, which is found in the [shen/release](https://github.com/gregspurrier/shen-ruby/tree/master/shen) directory, is Copyright (c) 2010-2013 Mark Tarver and may only be used in accordance with the Shen License.
|
|
169
171
|
|
|
170
|
-
The remainder of
|
|
172
|
+
The remainder of the code for ShenRuby is Copyright(c) 2012-2013 Greg Spurrier. It may be used outside of the context of ShenRuby under the terms of the MIT License. A copy of the MIT License may be found in [MIT_LICENSE.txt](https://github.com/gregspurrier/shen-ruby/blob/master/MIT_LICENSE.txt).
|
|
@@ -1,18 +1,6 @@
|
|
|
1
1
|
module Kl
|
|
2
2
|
module Primitives
|
|
3
3
|
module Streams
|
|
4
|
-
def pr(s, stream)
|
|
5
|
-
if stream == STDIN
|
|
6
|
-
# shen-prbytes in toplevel.kl calls pr on *stinput* rather than
|
|
7
|
-
# *stoutput*. As a temporary solution, use the same approach
|
|
8
|
-
# that Bruno Deferrari uses in his Scheme port. See
|
|
9
|
-
# https://groups.google.com/d/topic/qilang/2ixosqX4Too/discussion
|
|
10
|
-
stream = STDOUT if stream == STDIN
|
|
11
|
-
end
|
|
12
|
-
stream.write(s)
|
|
13
|
-
s
|
|
14
|
-
end
|
|
15
|
-
|
|
16
4
|
define_method 'read-byte' do |stream|
|
|
17
5
|
if stream.eof?
|
|
18
6
|
-1
|
|
@@ -21,14 +9,16 @@ module Kl
|
|
|
21
9
|
end
|
|
22
10
|
end
|
|
23
11
|
|
|
24
|
-
|
|
25
|
-
|
|
26
|
-
|
|
27
|
-
|
|
12
|
+
define_method 'write-byte' do |byte, stream|
|
|
13
|
+
stream.putc byte
|
|
14
|
+
byte
|
|
15
|
+
end
|
|
16
|
+
|
|
17
|
+
def open(name, direction)
|
|
28
18
|
File.open(File.expand_path(name, value(:'*home-directory*')),
|
|
29
19
|
direction == :out ? 'w' : 'r')
|
|
30
20
|
end
|
|
31
|
-
|
|
21
|
+
|
|
32
22
|
def close(stream)
|
|
33
23
|
stream.close
|
|
34
24
|
:NIL
|
data/lib/shen_ruby/version.rb
CHANGED
data/shen/README.txt
CHANGED
|
@@ -7,7 +7,7 @@ Directory contents:
|
|
|
7
7
|
|
|
8
8
|
README.txt -- this file
|
|
9
9
|
license.txt -- the Shen license
|
|
10
|
-
release/ -- files extracted directly from the Shen
|
|
10
|
+
release/ -- files extracted directly from the Shen 13 Source
|
|
11
11
|
release. The complete source for the most recent
|
|
12
12
|
release of Shen may be downloaded from
|
|
13
13
|
http://www.shenlanguage.org/Download/index.htm
|
|
@@ -63,118 +63,118 @@
|
|
|
63
63
|
|
|
64
64
|
(defun shen.<signature> (V626) (let Result (if (and (cons? (hd V626)) (= { (hd (hd V626)))) (let Parse_shen.<signature-help> (shen.<signature-help> (shen.pair (tl (hd V626)) (shen.hdtl V626))) (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)) (if (= Result (fail)) (fail) Result)))
|
|
65
65
|
|
|
66
|
-
(defun shen.curry-type (
|
|
66
|
+
(defun shen.curry-type (V627) (cond ((and (cons? V627) (and (cons? (tl V627)) (and (= --> (hd (tl V627))) (and (cons? (tl (tl V627))) (and (cons? (tl (tl (tl V627)))) (= --> (hd (tl (tl (tl V627)))))))))) (shen.curry-type (cons (hd V627) (cons --> (cons (tl (tl V627)) ()))))) ((and (cons? V627) (and (cons? (tl V627)) (and (= * (hd (tl V627))) (and (cons? (tl (tl V627))) (and (cons? (tl (tl (tl V627)))) (= * (hd (tl (tl (tl V627)))))))))) (shen.curry-type (cons (hd V627) (cons * (cons (tl (tl V627)) ()))))) ((cons? V627) (map shen.curry-type V627)) (true V627)))
|
|
67
67
|
|
|
68
|
-
(defun shen.<signature-help> (
|
|
68
|
+
(defun shen.<signature-help> (V632) (let Result (if (cons? (hd V632)) (let Parse_X (hd (hd V632)) (let Parse_shen.<signature-help> (shen.<signature-help> (shen.pair (tl (hd V632)) (shen.hdtl V632))) (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 (= Result (fail)) (let Result (let Parse_<e> (<e> V632) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) ()) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
|
|
69
69
|
|
|
70
|
-
(defun shen.<rules> (
|
|
70
|
+
(defun shen.<rules> (V637) (let Result (let Parse_shen.<rule> (shen.<rule> V637) (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 (= Result (fail)) (let Result (let Parse_shen.<rule> (shen.<rule> V637) (if (not (= (fail) Parse_shen.<rule>)) (shen.pair (hd Parse_shen.<rule>) (cons (shen.linearise (shen.hdtl Parse_shen.<rule>)) ())) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
|
|
71
71
|
|
|
72
|
-
(defun shen.<rule> (
|
|
72
|
+
(defun shen.<rule> (V642) (let Result (let Parse_shen.<patterns> (shen.<patterns> V642) (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 (= Result (fail)) (let Result (let Parse_shen.<patterns> (shen.<patterns> V642) (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 (= Result (fail)) (let Result (let Parse_shen.<patterns> (shen.<patterns> V642) (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 (= Result (fail)) (let Result (let Parse_shen.<patterns> (shen.<patterns> V642) (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))) (if (= Result (fail)) (fail) Result)) Result)) Result)) Result)))
|
|
73
73
|
|
|
74
|
-
(defun shen.fail_if (
|
|
74
|
+
(defun shen.fail_if (V643 V644) (if (V643 V644) (fail) V644))
|
|
75
75
|
|
|
76
|
-
(defun shen.succeeds? (
|
|
76
|
+
(defun shen.succeeds? (V649) (cond ((= V649 (fail)) false) (true true)))
|
|
77
77
|
|
|
78
|
-
(defun shen.<patterns> (
|
|
78
|
+
(defun shen.<patterns> (V654) (let Result (let Parse_shen.<pattern> (shen.<pattern> V654) (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 (= Result (fail)) (let Result (let Parse_<e> (<e> V654) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) ()) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
|
|
79
79
|
|
|
80
|
-
(defun shen.<pattern> (
|
|
80
|
+
(defun shen.<pattern> (V659) (let Result (if (and (cons? (hd V659)) (cons? (hd (hd V659)))) (shen.snd-or-fail (if (and (cons? (hd (shen.pair (hd (hd V659)) (shen.hdtl V659)))) (= @p (hd (hd (shen.pair (hd (hd V659)) (shen.hdtl V659)))))) (let Parse_shen.<pattern1> (shen.<pattern1> (shen.pair (tl (hd (shen.pair (hd (hd V659)) (shen.hdtl V659)))) (shen.hdtl (shen.pair (hd (hd V659)) (shen.hdtl V659))))) (if (not (= (fail) Parse_shen.<pattern1>)) (let Parse_shen.<pattern2> (shen.<pattern2> Parse_shen.<pattern1>) (if (not (= (fail) Parse_shen.<pattern2>)) (shen.pair (hd Parse_shen.<pattern2>) (shen.pair (hd (shen.pair (tl (hd V659)) (shen.hdtl V659))) (cons @p (cons (shen.hdtl Parse_shen.<pattern1>) (cons (shen.hdtl Parse_shen.<pattern2>) ()))))) (fail))) (fail))) (fail))) (fail)) (if (= Result (fail)) (let Result (if (and (cons? (hd V659)) (cons? (hd (hd V659)))) (shen.snd-or-fail (if (and (cons? (hd (shen.pair (hd (hd V659)) (shen.hdtl V659)))) (= cons (hd (hd (shen.pair (hd (hd V659)) (shen.hdtl V659)))))) (let Parse_shen.<pattern1> (shen.<pattern1> (shen.pair (tl (hd (shen.pair (hd (hd V659)) (shen.hdtl V659)))) (shen.hdtl (shen.pair (hd (hd V659)) (shen.hdtl V659))))) (if (not (= (fail) Parse_shen.<pattern1>)) (let Parse_shen.<pattern2> (shen.<pattern2> Parse_shen.<pattern1>) (if (not (= (fail) Parse_shen.<pattern2>)) (shen.pair (hd Parse_shen.<pattern2>) (shen.pair (hd (shen.pair (tl (hd V659)) (shen.hdtl V659))) (cons cons (cons (shen.hdtl Parse_shen.<pattern1>) (cons (shen.hdtl Parse_shen.<pattern2>) ()))))) (fail))) (fail))) (fail))) (fail)) (if (= Result (fail)) (let Result (if (and (cons? (hd V659)) (cons? (hd (hd V659)))) (shen.snd-or-fail (if (and (cons? (hd (shen.pair (hd (hd V659)) (shen.hdtl V659)))) (= @v (hd (hd (shen.pair (hd (hd V659)) (shen.hdtl V659)))))) (let Parse_shen.<pattern1> (shen.<pattern1> (shen.pair (tl (hd (shen.pair (hd (hd V659)) (shen.hdtl V659)))) (shen.hdtl (shen.pair (hd (hd V659)) (shen.hdtl V659))))) (if (not (= (fail) Parse_shen.<pattern1>)) (let Parse_shen.<pattern2> (shen.<pattern2> Parse_shen.<pattern1>) (if (not (= (fail) Parse_shen.<pattern2>)) (shen.pair (hd Parse_shen.<pattern2>) (shen.pair (hd (shen.pair (tl (hd V659)) (shen.hdtl V659))) (cons @v (cons (shen.hdtl Parse_shen.<pattern1>) (cons (shen.hdtl Parse_shen.<pattern2>) ()))))) (fail))) (fail))) (fail))) (fail)) (if (= Result (fail)) (let Result (if (and (cons? (hd V659)) (cons? (hd (hd V659)))) (shen.snd-or-fail (if (and (cons? (hd (shen.pair (hd (hd V659)) (shen.hdtl V659)))) (= @s (hd (hd (shen.pair (hd (hd V659)) (shen.hdtl V659)))))) (let Parse_shen.<pattern1> (shen.<pattern1> (shen.pair (tl (hd (shen.pair (hd (hd V659)) (shen.hdtl V659)))) (shen.hdtl (shen.pair (hd (hd V659)) (shen.hdtl V659))))) (if (not (= (fail) Parse_shen.<pattern1>)) (let Parse_shen.<pattern2> (shen.<pattern2> Parse_shen.<pattern1>) (if (not (= (fail) Parse_shen.<pattern2>)) (shen.pair (hd Parse_shen.<pattern2>) (shen.pair (hd (shen.pair (tl (hd V659)) (shen.hdtl V659))) (cons @s (cons (shen.hdtl Parse_shen.<pattern1>) (cons (shen.hdtl Parse_shen.<pattern2>) ()))))) (fail))) (fail))) (fail))) (fail)) (if (= Result (fail)) (let Result (if (and (cons? (hd V659)) (cons? (hd (hd V659)))) (shen.snd-or-fail (if (and (cons? (hd (shen.pair (hd (hd V659)) (shen.hdtl V659)))) (= vector (hd (hd (shen.pair (hd (hd V659)) (shen.hdtl V659)))))) (if (and (cons? (hd (shen.pair (tl (hd (shen.pair (hd (hd V659)) (shen.hdtl V659)))) (shen.hdtl (shen.pair (hd (hd V659)) (shen.hdtl V659)))))) (= 0 (hd (hd (shen.pair (tl (hd (shen.pair (hd (hd V659)) (shen.hdtl V659)))) (shen.hdtl (shen.pair (hd (hd V659)) (shen.hdtl V659)))))))) (shen.pair (hd (shen.pair (tl (hd (shen.pair (tl (hd (shen.pair (hd (hd V659)) (shen.hdtl V659)))) (shen.hdtl (shen.pair (hd (hd V659)) (shen.hdtl V659)))))) (shen.hdtl (shen.pair (tl (hd (shen.pair (hd (hd V659)) (shen.hdtl V659)))) (shen.hdtl (shen.pair (hd (hd V659)) (shen.hdtl V659))))))) (shen.pair (hd (shen.pair (tl (hd V659)) (shen.hdtl V659))) (cons vector (cons 0 ())))) (fail)) (fail))) (fail)) (if (= Result (fail)) (let Result (if (cons? (hd V659)) (let Parse_X (hd (hd V659)) (if (cons? Parse_X) (shen.pair (hd (shen.pair (tl (hd V659)) (shen.hdtl V659))) (shen.constructor-error Parse_X)) (fail))) (fail)) (if (= Result (fail)) (let Result (let Parse_shen.<simple_pattern> (shen.<simple_pattern> V659) (if (not (= (fail) Parse_shen.<simple_pattern>)) (shen.pair (hd Parse_shen.<simple_pattern>) (shen.hdtl Parse_shen.<simple_pattern>)) (fail))) (if (= Result (fail)) (fail) Result)) Result)) Result)) Result)) Result)) Result)) Result)))
|
|
81
81
|
|
|
82
|
-
(defun shen.constructor-error (
|
|
82
|
+
(defun shen.constructor-error (V660) (simple-error (shen.app V660 " is not a legitimate constructor
|
|
83
83
|
" shen.a)))
|
|
84
84
|
|
|
85
|
-
(defun shen.<simple_pattern> (
|
|
85
|
+
(defun shen.<simple_pattern> (V665) (let Result (if (cons? (hd V665)) (let Parse_X (hd (hd V665)) (if (= Parse_X _) (shen.pair (hd (shen.pair (tl (hd V665)) (shen.hdtl V665))) (gensym Parse_Y)) (fail))) (fail)) (if (= Result (fail)) (let Result (if (cons? (hd V665)) (let Parse_X (hd (hd V665)) (if (not (element? Parse_X (cons -> (cons <- ())))) (shen.pair (hd (shen.pair (tl (hd V665)) (shen.hdtl V665))) Parse_X) (fail))) (fail)) (if (= Result (fail)) (fail) Result)) Result)))
|
|
86
86
|
|
|
87
|
-
(defun shen.<pattern1> (
|
|
87
|
+
(defun shen.<pattern1> (V670) (let Result (let Parse_shen.<pattern> (shen.<pattern> V670) (if (not (= (fail) Parse_shen.<pattern>)) (shen.pair (hd Parse_shen.<pattern>) (shen.hdtl Parse_shen.<pattern>)) (fail))) (if (= Result (fail)) (fail) Result)))
|
|
88
88
|
|
|
89
|
-
(defun shen.<pattern2> (
|
|
89
|
+
(defun shen.<pattern2> (V675) (let Result (let Parse_shen.<pattern> (shen.<pattern> V675) (if (not (= (fail) Parse_shen.<pattern>)) (shen.pair (hd Parse_shen.<pattern>) (shen.hdtl Parse_shen.<pattern>)) (fail))) (if (= Result (fail)) (fail) Result)))
|
|
90
90
|
|
|
91
|
-
(defun shen.<action> (
|
|
91
|
+
(defun shen.<action> (V680) (let Result (if (cons? (hd V680)) (let Parse_X (hd (hd V680)) (shen.pair (hd (shen.pair (tl (hd V680)) (shen.hdtl V680))) Parse_X)) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
92
92
|
|
|
93
|
-
(defun shen.<guard> (
|
|
93
|
+
(defun shen.<guard> (V685) (let Result (if (cons? (hd V685)) (let Parse_X (hd (hd V685)) (shen.pair (hd (shen.pair (tl (hd V685)) (shen.hdtl V685))) Parse_X)) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
94
94
|
|
|
95
|
-
(defun shen.compile_to_machine_code (
|
|
95
|
+
(defun shen.compile_to_machine_code (V686 V687) (let Lambda+ (shen.compile_to_lambda+ V686 V687) (let KL (shen.compile_to_kl V686 Lambda+) (let Record (shen.record-source V686 KL) KL))))
|
|
96
96
|
|
|
97
|
-
(defun shen.record-source (
|
|
97
|
+
(defun shen.record-source (V690 V691) (cond ((value shen.*installing-kl*) shen.skip) (true (put V690 shen.source V691 (value *property-vector*)))))
|
|
98
98
|
|
|
99
|
-
(defun shen.compile_to_lambda+ (
|
|
99
|
+
(defun shen.compile_to_lambda+ (V692 V693) (let Arity (shen.aritycheck V692 V693) (let Free (map (lambda Rule (shen.free_variable_check V692 Rule)) V693) (let Variables (shen.parameters Arity) (let Strip (map shen.strip-protect V693) (let Abstractions (map shen.abstract_rule Strip) (let Applications (map (lambda X (shen.application_build Variables X)) Abstractions) (cons Variables (cons Applications ())))))))))
|
|
100
100
|
|
|
101
|
-
(defun shen.free_variable_check (
|
|
101
|
+
(defun shen.free_variable_check (V694 V695) (cond ((and (cons? V695) (and (cons? (tl V695)) (= () (tl (tl V695))))) (let Bound (shen.extract_vars (hd V695)) (let Free (shen.extract_free_vars Bound (hd (tl V695))) (shen.free_variable_warnings V694 Free)))) (true (shen.sys-error shen.free_variable_check))))
|
|
102
102
|
|
|
103
|
-
(defun shen.extract_vars (
|
|
103
|
+
(defun shen.extract_vars (V696) (cond ((variable? V696) (cons V696 ())) ((cons? V696) (union (shen.extract_vars (hd V696)) (shen.extract_vars (tl V696)))) (true ())))
|
|
104
104
|
|
|
105
|
-
(defun shen.extract_free_vars (
|
|
105
|
+
(defun shen.extract_free_vars (V706 V707) (cond ((and (cons? V707) (and (cons? (tl V707)) (and (= () (tl (tl V707))) (= (hd V707) protect)))) ()) ((and (variable? V707) (not (element? V707 V706))) (cons V707 ())) ((and (cons? V707) (and (= lambda (hd V707)) (and (cons? (tl V707)) (and (cons? (tl (tl V707))) (= () (tl (tl (tl V707)))))))) (shen.extract_free_vars (cons (hd (tl V707)) V706) (hd (tl (tl V707))))) ((and (cons? V707) (and (= let (hd V707)) (and (cons? (tl V707)) (and (cons? (tl (tl V707))) (and (cons? (tl (tl (tl V707)))) (= () (tl (tl (tl (tl V707)))))))))) (union (shen.extract_free_vars V706 (hd (tl (tl V707)))) (shen.extract_free_vars (cons (hd (tl V707)) V706) (hd (tl (tl (tl V707))))))) ((cons? V707) (union (shen.extract_free_vars V706 (hd V707)) (shen.extract_free_vars V706 (tl V707)))) (true ())))
|
|
106
106
|
|
|
107
|
-
(defun shen.free_variable_warnings (
|
|
107
|
+
(defun shen.free_variable_warnings (V710 V711) (cond ((= () V711) _) (true (simple-error (cn "error: the following variables are free in " (shen.app V710 (cn ": " (shen.app (shen.list_variables V711) "" shen.a)) shen.a))))))
|
|
108
108
|
|
|
109
|
-
(defun shen.list_variables (
|
|
109
|
+
(defun shen.list_variables (V712) (cond ((and (cons? V712) (= () (tl V712))) (cn (str (hd V712)) ".")) ((cons? V712) (cn (str (hd V712)) (cn ", " (shen.list_variables (tl V712))))) (true (shen.sys-error shen.list_variables))))
|
|
110
110
|
|
|
111
|
-
(defun shen.strip-protect (
|
|
111
|
+
(defun shen.strip-protect (V713) (cond ((and (cons? V713) (and (cons? (tl V713)) (and (= () (tl (tl V713))) (= (hd V713) protect)))) (hd (tl V713))) ((cons? V713) (cons (shen.strip-protect (hd V713)) (shen.strip-protect (tl V713)))) (true V713)))
|
|
112
112
|
|
|
113
|
-
(defun shen.linearise (
|
|
113
|
+
(defun shen.linearise (V714) (cond ((and (cons? V714) (and (cons? (tl V714)) (= () (tl (tl V714))))) (shen.linearise_help (shen.flatten (hd V714)) (hd V714) (hd (tl V714)))) (true (shen.sys-error shen.linearise))))
|
|
114
114
|
|
|
115
|
-
(defun shen.flatten (
|
|
115
|
+
(defun shen.flatten (V715) (cond ((= () V715) ()) ((cons? V715) (append (shen.flatten (hd V715)) (shen.flatten (tl V715)))) (true (cons V715 ()))))
|
|
116
116
|
|
|
117
|
-
(defun shen.linearise_help (
|
|
117
|
+
(defun shen.linearise_help (V716 V717 V718) (cond ((= () V716) (cons V717 (cons V718 ()))) ((cons? V716) (if (and (variable? (hd V716)) (element? (hd V716) (tl V716))) (let Var (gensym (hd V716)) (let NewAction (cons where (cons (cons = (cons (hd V716) (cons Var ()))) (cons V718 ()))) (let NewPatts (shen.linearise_X (hd V716) Var V717) (shen.linearise_help (tl V716) NewPatts NewAction)))) (shen.linearise_help (tl V716) V717 V718))) (true (shen.sys-error shen.linearise_help))))
|
|
118
118
|
|
|
119
|
-
(defun shen.linearise_X (
|
|
119
|
+
(defun shen.linearise_X (V727 V728 V729) (cond ((= V729 V727) V728) ((cons? V729) (let L (shen.linearise_X V727 V728 (hd V729)) (if (= L (hd V729)) (cons (hd V729) (shen.linearise_X V727 V728 (tl V729))) (cons L (tl V729))))) (true V729)))
|
|
120
120
|
|
|
121
|
-
(defun shen.aritycheck (
|
|
121
|
+
(defun shen.aritycheck (V731 V732) (cond ((and (cons? V732) (and (cons? (hd V732)) (and (cons? (tl (hd V732))) (and (= () (tl (tl (hd V732)))) (= () (tl V732)))))) (do (shen.aritycheck-action (hd (tl (hd V732)))) (shen.aritycheck-name V731 (arity V731) (length (hd (hd V732)))))) ((and (cons? V732) (and (cons? (hd V732)) (and (cons? (tl (hd V732))) (and (= () (tl (tl (hd V732)))) (and (cons? (tl V732)) (and (cons? (hd (tl V732))) (and (cons? (tl (hd (tl V732)))) (= () (tl (tl (hd (tl V732)))))))))))) (if (= (length (hd (hd V732))) (length (hd (hd (tl V732))))) (do (shen.aritycheck-action (hd (tl (hd V732)))) (shen.aritycheck V731 (tl V732))) (simple-error (cn "arity error in " (shen.app V731 "
|
|
122
122
|
" shen.a))))) (true (shen.sys-error shen.aritycheck))))
|
|
123
123
|
|
|
124
|
-
(defun shen.aritycheck-name (
|
|
125
|
-
warning: changing the arity of " (shen.app
|
|
126
|
-
" shen.a)) (stoutput))
|
|
124
|
+
(defun shen.aritycheck-name (V741 V742 V743) (cond ((= -1 V742) V743) ((= V743 V742) V743) (true (do (shen.prhush (cn "
|
|
125
|
+
warning: changing the arity of " (shen.app V741 " can cause errors.
|
|
126
|
+
" shen.a)) (stoutput)) V743))))
|
|
127
127
|
|
|
128
|
-
(defun shen.aritycheck-action (
|
|
128
|
+
(defun shen.aritycheck-action (V749) (cond ((cons? V749) (do (shen.aah (hd V749) (tl V749)) (map shen.aritycheck-action V749))) (true shen.skip)))
|
|
129
129
|
|
|
130
|
-
(defun shen.aah (
|
|
130
|
+
(defun shen.aah (V750 V751) (let Arity (arity V750) (let Len (length V751) (if (and (> Arity -1) (> Len Arity)) (shen.prhush (cn "warning: " (shen.app V750 (cn " might not like " (shen.app Len (cn " argument" (shen.app (if (> Len 1) "s" "") ".
|
|
131
131
|
" shen.a)) shen.a)) shen.a)) (stoutput)) shen.skip))))
|
|
132
132
|
|
|
133
|
-
(defun shen.abstract_rule (
|
|
133
|
+
(defun shen.abstract_rule (V752) (cond ((and (cons? V752) (and (cons? (tl V752)) (= () (tl (tl V752))))) (shen.abstraction_build (hd V752) (hd (tl V752)))) (true (shen.sys-error shen.abstract_rule))))
|
|
134
134
|
|
|
135
|
-
(defun shen.abstraction_build (
|
|
135
|
+
(defun shen.abstraction_build (V753 V754) (cond ((= () V753) V754) ((cons? V753) (cons /. (cons (hd V753) (cons (shen.abstraction_build (tl V753) V754) ())))) (true (shen.sys-error shen.abstraction_build))))
|
|
136
136
|
|
|
137
|
-
(defun shen.parameters (
|
|
137
|
+
(defun shen.parameters (V755) (cond ((= 0 V755) ()) (true (cons (gensym V) (shen.parameters (- V755 1))))))
|
|
138
138
|
|
|
139
|
-
(defun shen.application_build (
|
|
139
|
+
(defun shen.application_build (V756 V757) (cond ((= () V756) V757) ((cons? V756) (shen.application_build (tl V756) (cons V757 (cons (hd V756) ())))) (true (shen.sys-error shen.application_build))))
|
|
140
140
|
|
|
141
|
-
(defun shen.compile_to_kl (
|
|
141
|
+
(defun shen.compile_to_kl (V758 V759) (cond ((and (cons? V759) (and (cons? (tl V759)) (= () (tl (tl V759))))) (let Arity (shen.store-arity V758 (length (hd V759))) (let Reduce (map shen.reduce (hd (tl V759))) (let CondExpression (shen.cond-expression V758 (hd V759) Reduce) (let TypeTable (if (value shen.*optimise*) (shen.typextable (shen.get-type V758) (hd V759)) shen.skip) (let TypedCondExpression (if (value shen.*optimise*) (shen.assign-types (hd V759) TypeTable CondExpression) CondExpression) (let KL (cons defun (cons V758 (cons (hd V759) (cons TypedCondExpression ())))) KL))))))) (true (shen.sys-error shen.compile_to_kl))))
|
|
142
142
|
|
|
143
|
-
(defun shen.get-type (
|
|
143
|
+
(defun shen.get-type (V764) (cond ((cons? V764) shen.skip) (true (let FType (assoc V764 (value shen.*signedfuncs*)) (if (empty? FType) shen.skip (tl FType))))))
|
|
144
144
|
|
|
145
|
-
(defun shen.typextable (
|
|
145
|
+
(defun shen.typextable (V773 V774) (cond ((and (cons? V773) (and (cons? (tl V773)) (and (= --> (hd (tl V773))) (and (cons? (tl (tl V773))) (and (= () (tl (tl (tl V773)))) (cons? V774)))))) (if (variable? (hd V773)) (shen.typextable (hd (tl (tl V773))) (tl V774)) (cons (cons (hd V774) (hd V773)) (shen.typextable (hd (tl (tl V773))) (tl V774))))) (true ())))
|
|
146
146
|
|
|
147
|
-
(defun shen.assign-types (
|
|
147
|
+
(defun shen.assign-types (V775 V776 V777) (cond ((and (cons? V777) (and (= let (hd V777)) (and (cons? (tl V777)) (and (cons? (tl (tl V777))) (and (cons? (tl (tl (tl V777)))) (= () (tl (tl (tl (tl V777)))))))))) (cons let (cons (hd (tl V777)) (cons (shen.assign-types V775 V776 (hd (tl (tl V777)))) (cons (shen.assign-types (cons (hd (tl V777)) V775) V776 (hd (tl (tl (tl V777))))) ()))))) ((and (cons? V777) (and (= lambda (hd V777)) (and (cons? (tl V777)) (and (cons? (tl (tl V777))) (= () (tl (tl (tl V777)))))))) (cons lambda (cons (hd (tl V777)) (cons (shen.assign-types (cons (hd (tl V777)) V775) V776 (hd (tl (tl V777)))) ())))) ((and (cons? V777) (= cond (hd V777))) (cons cond (map (lambda Y (cons (shen.assign-types V775 V776 (hd Y)) (cons (shen.assign-types V775 V776 (hd (tl Y))) ()))) (tl V777)))) ((cons? V777) (let NewTable (shen.typextable (shen.get-type (hd V777)) (tl V777)) (cons (hd V777) (map (lambda Y (shen.assign-types V775 (append V776 NewTable) Y)) (tl V777))))) (true (let AtomType (assoc V777 V776) (if (cons? AtomType) (cons type (cons V777 (cons (tl AtomType) ()))) (if (element? V777 V775) V777 (shen.atom-type V777)))))))
|
|
148
148
|
|
|
149
|
-
(defun shen.atom-type (
|
|
149
|
+
(defun shen.atom-type (V778) (if (string? V778) (cons type (cons V778 (cons string ()))) (if (number? V778) (cons type (cons V778 (cons number ()))) (if (boolean? V778) (cons type (cons V778 (cons boolean ()))) (if (symbol? V778) (cons type (cons V778 (cons symbol ()))) V778)))))
|
|
150
150
|
|
|
151
|
-
(defun shen.store-arity (
|
|
151
|
+
(defun shen.store-arity (V781 V782) (cond ((value shen.*installing-kl*) shen.skip) (true (put V781 arity V782 (value *property-vector*)))))
|
|
152
152
|
|
|
153
|
-
(defun shen.reduce (
|
|
153
|
+
(defun shen.reduce (V783) (do (set shen.*teststack* ()) (let Result (shen.reduce_help V783) (cons (cons : (cons shen.tests (reverse (value shen.*teststack*)))) (cons Result ())))))
|
|
154
154
|
|
|
155
|
-
(defun shen.reduce_help (
|
|
155
|
+
(defun shen.reduce_help (V784) (cond ((and (cons? V784) (and (cons? (hd V784)) (and (= /. (hd (hd V784))) (and (cons? (tl (hd V784))) (and (cons? (hd (tl (hd V784)))) (and (= cons (hd (hd (tl (hd V784))))) (and (cons? (tl (hd (tl (hd V784))))) (and (cons? (tl (tl (hd (tl (hd V784)))))) (and (= () (tl (tl (tl (hd (tl (hd V784))))))) (and (cons? (tl (tl (hd V784)))) (and (= () (tl (tl (tl (hd V784))))) (and (cons? (tl V784)) (= () (tl (tl V784))))))))))))))) (do (shen.add_test (cons cons? (tl V784))) (let Abstraction (cons /. (cons (hd (tl (hd (tl (hd V784))))) (cons (cons /. (cons (hd (tl (tl (hd (tl (hd V784)))))) (cons (shen.ebr (hd (tl V784)) (hd (tl (hd V784))) (hd (tl (tl (hd V784))))) ()))) ()))) (let Application (cons (cons Abstraction (cons (cons hd (tl V784)) ())) (cons (cons tl (tl V784)) ())) (shen.reduce_help Application))))) ((and (cons? V784) (and (cons? (hd V784)) (and (= /. (hd (hd V784))) (and (cons? (tl (hd V784))) (and (cons? (hd (tl (hd V784)))) (and (= @p (hd (hd (tl (hd V784))))) (and (cons? (tl (hd (tl (hd V784))))) (and (cons? (tl (tl (hd (tl (hd V784)))))) (and (= () (tl (tl (tl (hd (tl (hd V784))))))) (and (cons? (tl (tl (hd V784)))) (and (= () (tl (tl (tl (hd V784))))) (and (cons? (tl V784)) (= () (tl (tl V784))))))))))))))) (do (shen.add_test (cons tuple? (tl V784))) (let Abstraction (cons /. (cons (hd (tl (hd (tl (hd V784))))) (cons (cons /. (cons (hd (tl (tl (hd (tl (hd V784)))))) (cons (shen.ebr (hd (tl V784)) (hd (tl (hd V784))) (hd (tl (tl (hd V784))))) ()))) ()))) (let Application (cons (cons Abstraction (cons (cons fst (tl V784)) ())) (cons (cons snd (tl V784)) ())) (shen.reduce_help Application))))) ((and (cons? V784) (and (cons? (hd V784)) (and (= /. (hd (hd V784))) (and (cons? (tl (hd V784))) (and (cons? (hd (tl (hd V784)))) (and (= @v (hd (hd (tl (hd V784))))) (and (cons? (tl (hd (tl (hd V784))))) (and (cons? (tl (tl (hd (tl (hd V784)))))) (and (= () (tl (tl (tl (hd (tl (hd V784))))))) (and (cons? (tl (tl (hd V784)))) (and (= () (tl (tl (tl (hd V784))))) (and (cons? (tl V784)) (= () (tl (tl V784))))))))))))))) (do (shen.add_test (cons shen.+vector? (tl V784))) (let Abstraction (cons /. (cons (hd (tl (hd (tl (hd V784))))) (cons (cons /. (cons (hd (tl (tl (hd (tl (hd V784)))))) (cons (shen.ebr (hd (tl V784)) (hd (tl (hd V784))) (hd (tl (tl (hd V784))))) ()))) ()))) (let Application (cons (cons Abstraction (cons (cons hdv (tl V784)) ())) (cons (cons tlv (tl V784)) ())) (shen.reduce_help Application))))) ((and (cons? V784) (and (cons? (hd V784)) (and (= /. (hd (hd V784))) (and (cons? (tl (hd V784))) (and (cons? (hd (tl (hd V784)))) (and (= @s (hd (hd (tl (hd V784))))) (and (cons? (tl (hd (tl (hd V784))))) (and (cons? (tl (tl (hd (tl (hd V784)))))) (and (= () (tl (tl (tl (hd (tl (hd V784))))))) (and (cons? (tl (tl (hd V784)))) (and (= () (tl (tl (tl (hd V784))))) (and (cons? (tl V784)) (= () (tl (tl V784))))))))))))))) (do (shen.add_test (cons shen.+string? (tl V784))) (let Abstraction (cons /. (cons (hd (tl (hd (tl (hd V784))))) (cons (cons /. (cons (hd (tl (tl (hd (tl (hd V784)))))) (cons (shen.ebr (hd (tl V784)) (hd (tl (hd V784))) (hd (tl (tl (hd V784))))) ()))) ()))) (let Application (cons (cons Abstraction (cons (cons pos (cons (hd (tl V784)) (cons 0 ()))) ())) (cons (cons tlstr (tl V784)) ())) (shen.reduce_help Application))))) ((and (cons? V784) (and (cons? (hd V784)) (and (= /. (hd (hd V784))) (and (cons? (tl (hd V784))) (and (cons? (tl (tl (hd V784)))) (and (= () (tl (tl (tl (hd V784))))) (and (cons? (tl V784)) (and (= () (tl (tl V784))) (not (variable? (hd (tl (hd V784))))))))))))) (do (shen.add_test (cons = (cons (hd (tl (hd V784))) (tl V784)))) (shen.reduce_help (hd (tl (tl (hd V784))))))) ((and (cons? V784) (and (cons? (hd V784)) (and (= /. (hd (hd V784))) (and (cons? (tl (hd V784))) (and (cons? (tl (tl (hd V784)))) (and (= () (tl (tl (tl (hd V784))))) (and (cons? (tl V784)) (= () (tl (tl V784)))))))))) (shen.reduce_help (shen.ebr (hd (tl V784)) (hd (tl (hd V784))) (hd (tl (tl (hd V784))))))) ((and (cons? V784) (and (= where (hd V784)) (and (cons? (tl V784)) (and (cons? (tl (tl V784))) (= () (tl (tl (tl V784)))))))) (do (shen.add_test (hd (tl V784))) (shen.reduce_help (hd (tl (tl V784)))))) ((and (cons? V784) (and (cons? (tl V784)) (= () (tl (tl V784))))) (let Z (shen.reduce_help (hd V784)) (if (= (hd V784) Z) V784 (shen.reduce_help (cons Z (tl V784)))))) (true V784)))
|
|
156
156
|
|
|
157
|
-
(defun shen.+string? (
|
|
157
|
+
(defun shen.+string? (V785) (cond ((= "" V785) false) (true (string? V785))))
|
|
158
158
|
|
|
159
|
-
(defun shen.+vector (
|
|
159
|
+
(defun shen.+vector (V786) (cond ((= V786 (vector 0)) false) (true (vector? V786))))
|
|
160
160
|
|
|
161
|
-
(defun shen.ebr (
|
|
161
|
+
(defun shen.ebr (V795 V796 V797) (cond ((= V797 V796) V795) ((and (cons? V797) (and (= /. (hd V797)) (and (cons? (tl V797)) (and (cons? (tl (tl V797))) (and (= () (tl (tl (tl V797)))) (> (occurrences V796 (hd (tl V797))) 0)))))) V797) ((and (cons? V797) (and (= let (hd V797)) (and (cons? (tl V797)) (and (cons? (tl (tl V797))) (and (cons? (tl (tl (tl V797)))) (and (= () (tl (tl (tl (tl V797))))) (= (hd (tl V797)) V796))))))) (cons let (cons (hd (tl V797)) (cons (shen.ebr V795 (hd (tl V797)) (hd (tl (tl V797)))) (tl (tl (tl V797))))))) ((cons? V797) (cons (shen.ebr V795 V796 (hd V797)) (shen.ebr V795 V796 (tl V797)))) (true V797)))
|
|
162
162
|
|
|
163
|
-
(defun shen.add_test (
|
|
163
|
+
(defun shen.add_test (V800) (set shen.*teststack* (cons V800 (value shen.*teststack*))))
|
|
164
164
|
|
|
165
|
-
(defun shen.cond-expression (
|
|
165
|
+
(defun shen.cond-expression (V801 V802 V803) (let Err (shen.err-condition V801) (let Cases (shen.case-form V803 Err) (let EncodeChoices (shen.encode-choices Cases V801) (shen.cond-form EncodeChoices)))))
|
|
166
166
|
|
|
167
|
-
(defun shen.cond-form (
|
|
167
|
+
(defun shen.cond-form (V806) (cond ((and (cons? V806) (and (cons? (hd V806)) (and (= true (hd (hd V806))) (and (cons? (tl (hd V806))) (= () (tl (tl (hd V806)))))))) (hd (tl (hd V806)))) (true (cons cond V806))))
|
|
168
168
|
|
|
169
|
-
(defun shen.encode-choices (
|
|
169
|
+
(defun shen.encode-choices (V809 V810) (cond ((= () V809) ()) ((and (cons? V809) (and (cons? (hd V809)) (and (= true (hd (hd V809))) (and (cons? (tl (hd V809))) (and (cons? (hd (tl (hd V809)))) (and (= shen.choicepoint! (hd (hd (tl (hd V809))))) (and (cons? (tl (hd (tl (hd V809))))) (and (= () (tl (tl (hd (tl (hd V809)))))) (and (= () (tl (tl (hd V809)))) (= () (tl V809))))))))))) (cons (cons true (cons (cons let (cons Result (cons (hd (tl (hd (tl (hd V809))))) (cons (cons if (cons (cons = (cons Result (cons (cons fail ()) ()))) (cons (if (value shen.*installing-kl*) (cons shen.sys-error (cons V810 ())) (cons shen.f_error (cons V810 ()))) (cons Result ())))) ())))) ())) ())) ((and (cons? V809) (and (cons? (hd V809)) (and (= true (hd (hd V809))) (and (cons? (tl (hd V809))) (and (cons? (hd (tl (hd V809)))) (and (= shen.choicepoint! (hd (hd (tl (hd V809))))) (and (cons? (tl (hd (tl (hd V809))))) (and (= () (tl (tl (hd (tl (hd V809)))))) (= () (tl (tl (hd V809)))))))))))) (cons (cons true (cons (cons let (cons Result (cons (hd (tl (hd (tl (hd V809))))) (cons (cons if (cons (cons = (cons Result (cons (cons fail ()) ()))) (cons (shen.cond-form (shen.encode-choices (tl V809) V810)) (cons Result ())))) ())))) ())) ())) ((and (cons? V809) (and (cons? (hd V809)) (and (cons? (tl (hd V809))) (and (cons? (hd (tl (hd V809)))) (and (= shen.choicepoint! (hd (hd (tl (hd V809))))) (and (cons? (tl (hd (tl (hd V809))))) (and (= () (tl (tl (hd (tl (hd V809)))))) (= () (tl (tl (hd V809))))))))))) (cons (cons true (cons (cons let (cons Freeze (cons (cons freeze (cons (shen.cond-form (shen.encode-choices (tl V809) V810)) ())) (cons (cons if (cons (hd (hd V809)) (cons (cons let (cons Result (cons (hd (tl (hd (tl (hd V809))))) (cons (cons if (cons (cons = (cons Result (cons (cons fail ()) ()))) (cons (cons thaw (cons Freeze ())) (cons Result ())))) ())))) (cons (cons thaw (cons Freeze ())) ())))) ())))) ())) ())) ((and (cons? V809) (and (cons? (hd V809)) (and (cons? (tl (hd V809))) (= () (tl (tl (hd V809))))))) (cons (hd V809) (shen.encode-choices (tl V809) V810))) (true (shen.sys-error shen.encode-choices))))
|
|
170
170
|
|
|
171
|
-
(defun shen.case-form (
|
|
171
|
+
(defun shen.case-form (V815 V816) (cond ((= () V815) (cons V816 ())) ((and (cons? V815) (and (cons? (hd V815)) (and (cons? (hd (hd V815))) (and (= : (hd (hd (hd V815)))) (and (cons? (tl (hd (hd V815)))) (and (= shen.tests (hd (tl (hd (hd V815))))) (and (= () (tl (tl (hd (hd V815))))) (and (cons? (tl (hd V815))) (and (cons? (hd (tl (hd V815)))) (and (= shen.choicepoint! (hd (hd (tl (hd V815))))) (and (cons? (tl (hd (tl (hd V815))))) (and (= () (tl (tl (hd (tl (hd V815)))))) (= () (tl (tl (hd V815)))))))))))))))) (cons (cons true (tl (hd V815))) (shen.case-form (tl V815) V816))) ((and (cons? V815) (and (cons? (hd V815)) (and (cons? (hd (hd V815))) (and (= : (hd (hd (hd V815)))) (and (cons? (tl (hd (hd V815)))) (and (= shen.tests (hd (tl (hd (hd V815))))) (and (= () (tl (tl (hd (hd V815))))) (and (cons? (tl (hd V815))) (= () (tl (tl (hd V815)))))))))))) (cons (cons true (tl (hd V815))) ())) ((and (cons? V815) (and (cons? (hd V815)) (and (cons? (hd (hd V815))) (and (= : (hd (hd (hd V815)))) (and (cons? (tl (hd (hd V815)))) (and (= shen.tests (hd (tl (hd (hd V815))))) (and (cons? (tl (hd V815))) (= () (tl (tl (hd V815))))))))))) (cons (cons (shen.embed-and (tl (tl (hd (hd V815))))) (tl (hd V815))) (shen.case-form (tl V815) V816))) (true (shen.sys-error shen.case-form))))
|
|
172
172
|
|
|
173
|
-
(defun shen.embed-and (
|
|
173
|
+
(defun shen.embed-and (V817) (cond ((and (cons? V817) (= () (tl V817))) (hd V817)) ((cons? V817) (cons and (cons (hd V817) (cons (shen.embed-and (tl V817)) ())))) (true (shen.sys-error shen.embed-and))))
|
|
174
174
|
|
|
175
|
-
(defun shen.err-condition (
|
|
175
|
+
(defun shen.err-condition (V818) (cons true (cons (cons shen.f_error (cons V818 ())) ())))
|
|
176
176
|
|
|
177
|
-
(defun shen.sys-error (
|
|
177
|
+
(defun shen.sys-error (V819) (simple-error (cn "system function " (shen.app V819 ": unexpected argument
|
|
178
178
|
" shen.a))))
|
|
179
179
|
|
|
180
180
|
|
|
@@ -109,21 +109,21 @@
|
|
|
109
109
|
|
|
110
110
|
(set shen.*optimise* false)
|
|
111
111
|
|
|
112
|
-
(defun shen.initialise_arity_table (
|
|
112
|
+
(defun shen.initialise_arity_table (V820) (cond ((= () V820) ()) ((and (cons? V820) (cons? (tl V820))) (let DecArity (put (hd V820) arity (hd (tl V820)) (value *property-vector*)) (shen.initialise_arity_table (tl (tl V820))))) (true (shen.sys-error shen.initialise_arity_table))))
|
|
113
113
|
|
|
114
|
-
(defun arity (
|
|
114
|
+
(defun arity (V821) (trap-error (get V821 arity (value *property-vector*)) (lambda E -1)))
|
|
115
115
|
|
|
116
|
-
(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 intersection (cons 2 (cons kill (cons 0 (cons length (cons 1 (cons lineread (cons
|
|
116
|
+
(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 intersection (cons 2 (cons kill (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 package (cons 3 (cons pos (cons 2 (cons print (cons 1 (cons profile (cons 1 (cons profile-results (cons 0 (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 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 shen.sum (cons 1 (cons symbol? (cons 1 (cons tail (cons 1 (cons tl (cons 1 (cons tc (cons 1 (cons tc? (cons 1 (cons thaw (cons 1 (cons tlstr (cons 1 (cons track (cons 1 (cons trap-error (cons 2 (cons tuple? (cons 1 (cons type (cons 1 (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 1 (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 ())))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
|
|
117
117
|
|
|
118
|
-
(defun systemf (
|
|
118
|
+
(defun systemf (V822) (let Shen (intern "shen") (let External (get Shen shen.external-symbols (value *property-vector*)) (put Shen shen.external-symbols (adjoin V822 External) (value *property-vector*)))))
|
|
119
119
|
|
|
120
|
-
(defun adjoin (
|
|
120
|
+
(defun adjoin (V823 V824) (if (element? V823 V824) V824 (cons V823 V824)))
|
|
121
121
|
|
|
122
|
-
(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 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 read (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 package (cons output (cons out (cons or (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 kill (cons is (cons intersection (cons inferences (cons intern (cons integer? (cons input (cons input+ (cons include (cons include-all-but (cons in (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*))
|
|
122
|
+
(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 read (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 package (cons output (cons out (cons or (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 kill (cons is (cons intersection (cons inferences (cons intern (cons integer? (cons input (cons input+ (cons include (cons include-all-but (cons in (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*))
|
|
123
123
|
|
|
124
|
-
(defun specialise (
|
|
124
|
+
(defun specialise (V825) (do (set shen.*special* (cons V825 (value shen.*special*))) V825))
|
|
125
125
|
|
|
126
|
-
(defun unspecialise (
|
|
126
|
+
(defun unspecialise (V826) (do (set shen.*special* (remove V826 (value shen.*special*))) V826))
|
|
127
127
|
|
|
128
128
|
|
|
129
129
|
|