shen-ruby 0.13.0 → 0.14.0
Sign up to get free protection for your applications and to get access to all the features.
- checksums.yaml +4 -4
- data/HISTORY.md +7 -0
- data/README.md +5 -5
- data/Rakefile +10 -3
- data/lib/shen_ruby/version.rb +1 -1
- data/shen-ruby.gemspec +2 -2
- data/shen/release/klambda/core.kl +63 -63
- data/shen/release/klambda/declarations.kl +7 -7
- data/shen/release/klambda/load.kl +15 -15
- data/shen/release/klambda/macros.kl +33 -33
- data/shen/release/klambda/prolog.kl +97 -97
- data/shen/release/klambda/reader.kl +83 -83
- data/shen/release/klambda/sequent.kl +55 -55
- data/shen/release/klambda/sys.kl +101 -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 +4 -4
- data/shen/release/klambda/writer.kl +25 -25
- data/shen/release/klambda/yacc.kl +28 -28
- data/shen/release/license.pdf +0 -0
- data/shen/release/test_programs/bubble_version_2.shen +1 -1
- data/shen/release/test_programs/depth_.shen +1 -1
- data/shen/release/test_programs/interpreter.shen +1 -1
- data/shen/release/test_programs/metaprog.shen +1 -1
- data/shen/release/test_programs/semantic_net.shen +1 -1
- data/shen/release/test_programs/tests.shen +12 -12
- metadata +5 -5
checksums.yaml
CHANGED
|
@@ -1,7 +1,7 @@
|
|
|
1
1
|
---
|
|
2
2
|
SHA1:
|
|
3
|
-
metadata.gz:
|
|
4
|
-
data.tar.gz:
|
|
3
|
+
metadata.gz: 684cbc1d3967aa688256276833561b637d06c2b3
|
|
4
|
+
data.tar.gz: 9428d231f9a5385f3a6988136401ea514e61113d
|
|
5
5
|
SHA512:
|
|
6
|
-
metadata.gz:
|
|
7
|
-
data.tar.gz:
|
|
6
|
+
metadata.gz: 425cad6583df00d8124eea52d70bfafc1a09fb4eadf227ef0ba5b945fb28cb47d35ac210e58ea4da9576745eaa3e833de4a408a4789d758ce42743d4b5d4fcee
|
|
7
|
+
data.tar.gz: 59b65656bbb7fd70be508fa17597f4508091c85cbfc0702c18494f7f4e8f1fe100ff12d7cba38a8a31467052820d0e5639cc35baad7ea8b745f704113db47018
|
data/HISTORY.md
CHANGED
|
@@ -1,5 +1,12 @@
|
|
|
1
1
|
# ShenRuby Release History
|
|
2
2
|
|
|
3
|
+
## Not Yet Released
|
|
4
|
+
### Features
|
|
5
|
+
- Upgrade to Shen 17.2
|
|
6
|
+
|
|
7
|
+
### Bug Fixes
|
|
8
|
+
- Evaluating "c#13;" no longer triggers the message "warning: encountered \r in middle of line, treated as a mere space."
|
|
9
|
+
|
|
3
10
|
## 0.13.0 - February 3, 2013
|
|
4
11
|
### Features
|
|
5
12
|
- Upgrade to Shen 17
|
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 17, which was released in February, 2015.
|
|
4
|
+
ShenRuby supports Shen version 17.2, which was released in February, 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
|
|
|
@@ -14,7 +14,7 @@ ShenRuby 0.1.0 began to satisfy the first goal by providing a Shen REPL accessib
|
|
|
14
14
|
## Installation
|
|
15
15
|
NOTE: ShenRuby requires Ruby 1.9 language features. It is tested with Ruby 2.0.0, 2.1.5, and 2.2.0. It has been lightly tested with JRuby 1.7.17. It is functional with Ruby 1.9.3, however its fixed stack size prevents it from passing the Shen Test Suite (see [Setting Stack Size](setting-stack-size) below).
|
|
16
16
|
|
|
17
|
-
ShenRuby 0.
|
|
17
|
+
ShenRuby 0.14.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
|
|
|
@@ -22,12 +22,12 @@ ShenRuby 0.13.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
|
-
Loading.... Completed in 2.
|
|
25
|
+
Loading.... Completed in 2.01 seconds.
|
|
26
26
|
|
|
27
27
|
Shen, copyright (C) 2010-2015 Mark Tarver
|
|
28
|
-
www.shenlanguage.org, Shen 17
|
|
28
|
+
www.shenlanguage.org, Shen 17.2
|
|
29
29
|
running under Ruby, implementation: ruby 2.2.0
|
|
30
|
-
port 0.
|
|
30
|
+
port 0.14.0 ported by Greg Spurrier
|
|
31
31
|
|
|
32
32
|
|
|
33
33
|
(0-)
|
data/Rakefile
CHANGED
|
@@ -14,10 +14,10 @@ SHEN_ZIP = File.join(IMPORT_DIR, 'Shen.zip')
|
|
|
14
14
|
namespace :shen do
|
|
15
15
|
namespace :import do
|
|
16
16
|
task :release => [:remove_old_release, :import_dirs, :cleanup]
|
|
17
|
-
task :import_dirs => [:k_lambda, :test_programs]
|
|
17
|
+
task :import_dirs => [:k_lambda, :license, :test_programs]
|
|
18
18
|
|
|
19
19
|
task :remove_old_release do
|
|
20
|
-
|
|
20
|
+
rm_rf IMPORT_DIR
|
|
21
21
|
rm_rf RELEASE_DIR
|
|
22
22
|
end
|
|
23
23
|
|
|
@@ -33,7 +33,7 @@ namespace :shen do
|
|
|
33
33
|
end
|
|
34
34
|
|
|
35
35
|
task :unzip => SHEN_ZIP do
|
|
36
|
-
|
|
36
|
+
sh "(cd #{IMPORT_DIR}; unzip Shen.zip)"
|
|
37
37
|
end
|
|
38
38
|
|
|
39
39
|
def dst_path(src_root, src_path, dst_root)
|
|
@@ -71,6 +71,13 @@ namespace :shen do
|
|
|
71
71
|
import_dir('KLambda')
|
|
72
72
|
end
|
|
73
73
|
|
|
74
|
+
task :license => [:unzip, RELEASE_DIR] do
|
|
75
|
+
src_root = Dir.glob(File.join('import/Shen *')).first
|
|
76
|
+
%w(BSD license.pdf).each do |file|
|
|
77
|
+
cp File.join(src_root, file), RELEASE_DIR
|
|
78
|
+
end
|
|
79
|
+
end
|
|
80
|
+
|
|
74
81
|
task :test_programs => [:unzip, RELEASE_DIR] do
|
|
75
82
|
import_dir('Test Programs')
|
|
76
83
|
fix_load_paths(File.join(RELEASE_DIR, 'test_programs/tests.shen'))
|
data/lib/shen_ruby/version.rb
CHANGED
data/shen-ruby.gemspec
CHANGED
|
@@ -12,11 +12,11 @@ Gem::Specification.new do |s|
|
|
|
12
12
|
s.email = ["greg@sourcematters.org"]
|
|
13
13
|
s.homepage = "https://github.com/gregspurrier/shen-ruby"
|
|
14
14
|
s.summary = %q{ShenRuby is a Ruby port of the Shen programming language}
|
|
15
|
-
s.description = %q{ShenRuby is a port of the Shen programming language to Ruby. It currently supports Shen version 17.}
|
|
15
|
+
s.description = %q{ShenRuby is a port of the Shen programming language to Ruby. It currently supports Shen version 17.2.}
|
|
16
16
|
|
|
17
17
|
s.required_ruby_version = ">= 1.9.3"
|
|
18
18
|
|
|
19
|
-
s.add_runtime_dependency 'klam', '0.0.
|
|
19
|
+
s.add_runtime_dependency 'klam', '0.0.7', '0.0.7'
|
|
20
20
|
|
|
21
21
|
s.add_development_dependency 'rake', '~> 10.4.2', '>= 10.4.2'
|
|
22
22
|
s.add_development_dependency 'rspec', '~> 3.1', '>= 3.1.0'
|
|
@@ -23,134 +23,134 @@ 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 (V560 V561) (compile (lambda V553 (shen.<define> V553)) (cons V560 V561) (lambda X (shen.shen-syntax-error V560 X))))
|
|
27
27
|
|
|
28
|
-
(defun shen.shen-syntax-error (
|
|
28
|
+
(defun shen.shen-syntax-error (V562 V563) (simple-error (cn "syntax error in " (shen.app V562 (cn " here:
|
|
29
29
|
|
|
30
|
-
" (shen.app (shen.next-50 50
|
|
30
|
+
" (shen.app (shen.next-50 50 V563) "
|
|
31
31
|
" shen.a)) shen.a))))
|
|
32
32
|
|
|
33
|
-
(defun shen.<define> (
|
|
33
|
+
(defun shen.<define> (V564) (let YaccParse (let Parse_shen.<name> (shen.<name> V564) (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> V564) (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> (V565) (if (cons? (hd V565)) (let Parse_X (hd (hd V565)) (shen.pair (hd (shen.pair (tl (hd V565)) (shen.hdtl V565))) (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? (V566) (element? V566 (get (intern "shen") shen.external-symbols (value *property-vector*))))
|
|
39
39
|
|
|
40
|
-
(defun shen.<signature> (
|
|
40
|
+
(defun shen.<signature> (V567) (if (and (cons? (hd V567)) (= { (hd (hd V567)))) (let Parse_shen.<signature-help> (shen.<signature-help> (shen.pair (tl (hd V567)) (shen.hdtl V567))) (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 (V568) (cond ((and (cons? V568) (and (cons? (tl V568)) (and (= --> (hd (tl V568))) (and (cons? (tl (tl V568))) (and (cons? (tl (tl (tl V568)))) (= --> (hd (tl (tl (tl V568)))))))))) (shen.curry-type (cons (hd V568) (cons --> (cons (tl (tl V568)) ()))))) ((and (cons? V568) (and (cons? (tl V568)) (and (= * (hd (tl V568))) (and (cons? (tl (tl V568))) (and (cons? (tl (tl (tl V568)))) (= * (hd (tl (tl (tl V568)))))))))) (shen.curry-type (cons (hd V568) (cons * (cons (tl (tl V568)) ()))))) ((cons? V568) (map (lambda V554 (shen.curry-type V554)) V568)) (true V568)))
|
|
43
43
|
|
|
44
|
-
(defun shen.<signature-help> (
|
|
44
|
+
(defun shen.<signature-help> (V569) (let YaccParse (if (cons? (hd V569)) (let Parse_X (hd (hd V569)) (let Parse_shen.<signature-help> (shen.<signature-help> (shen.pair (tl (hd V569)) (shen.hdtl V569))) (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> V569) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) ()) (fail))) YaccParse)))
|
|
45
45
|
|
|
46
|
-
(defun shen.<rules> (
|
|
46
|
+
(defun shen.<rules> (V570) (let YaccParse (let Parse_shen.<rule> (shen.<rule> V570) (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> V570) (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> (V571) (let YaccParse (let Parse_shen.<patterns> (shen.<patterns> V571) (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> V571) (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> V571) (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> V571) (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 (V572 V573) (if (V572 V573) (fail) V573))
|
|
51
51
|
|
|
52
|
-
(defun shen.succeeds? (
|
|
52
|
+
(defun shen.succeeds? (V578) (cond ((= V578 (fail)) false) (true true)))
|
|
53
53
|
|
|
54
|
-
(defun shen.<patterns> (
|
|
54
|
+
(defun shen.<patterns> (V579) (let YaccParse (let Parse_shen.<pattern> (shen.<pattern> V579) (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> V579) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) ()) (fail))) YaccParse)))
|
|
55
55
|
|
|
56
|
-
(defun shen.<pattern> (
|
|
56
|
+
(defun shen.<pattern> (V585) (let YaccParse (if (and (cons? (hd V585)) (cons? (hd (hd V585)))) (if (and (cons? (hd (shen.pair (hd (hd V585)) (hd (tl V585))))) (= @p (hd (hd (shen.pair (hd (hd V585)) (hd (tl V585))))))) (let Parse_shen.<pattern1> (shen.<pattern1> (shen.pair (tl (hd (shen.pair (hd (hd V585)) (hd (tl V585))))) (shen.hdtl (shen.pair (hd (hd V585)) (hd (tl V585)))))) (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 V585)) (hd (tl V585)))) (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 V585)) (cons? (hd (hd V585)))) (if (and (cons? (hd (shen.pair (hd (hd V585)) (hd (tl V585))))) (= cons (hd (hd (shen.pair (hd (hd V585)) (hd (tl V585))))))) (let Parse_shen.<pattern1> (shen.<pattern1> (shen.pair (tl (hd (shen.pair (hd (hd V585)) (hd (tl V585))))) (shen.hdtl (shen.pair (hd (hd V585)) (hd (tl V585)))))) (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 V585)) (hd (tl V585)))) (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 V585)) (cons? (hd (hd V585)))) (if (and (cons? (hd (shen.pair (hd (hd V585)) (hd (tl V585))))) (= @v (hd (hd (shen.pair (hd (hd V585)) (hd (tl V585))))))) (let Parse_shen.<pattern1> (shen.<pattern1> (shen.pair (tl (hd (shen.pair (hd (hd V585)) (hd (tl V585))))) (shen.hdtl (shen.pair (hd (hd V585)) (hd (tl V585)))))) (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 V585)) (hd (tl V585)))) (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 V585)) (cons? (hd (hd V585)))) (if (and (cons? (hd (shen.pair (hd (hd V585)) (hd (tl V585))))) (= @s (hd (hd (shen.pair (hd (hd V585)) (hd (tl V585))))))) (let Parse_shen.<pattern1> (shen.<pattern1> (shen.pair (tl (hd (shen.pair (hd (hd V585)) (hd (tl V585))))) (shen.hdtl (shen.pair (hd (hd V585)) (hd (tl V585)))))) (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 V585)) (hd (tl V585)))) (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 V585)) (cons? (hd (hd V585)))) (if (and (cons? (hd (shen.pair (hd (hd V585)) (hd (tl V585))))) (= vector (hd (hd (shen.pair (hd (hd V585)) (hd (tl V585))))))) (if (and (cons? (hd (shen.pair (tl (hd (shen.pair (hd (hd V585)) (hd (tl V585))))) (shen.hdtl (shen.pair (hd (hd V585)) (hd (tl V585))))))) (= 0 (hd (hd (shen.pair (tl (hd (shen.pair (hd (hd V585)) (hd (tl V585))))) (shen.hdtl (shen.pair (hd (hd V585)) (hd (tl V585))))))))) (shen.pair (hd (shen.pair (tl (hd V585)) (hd (tl V585)))) (cons vector (cons 0 ()))) (fail)) (fail)) (fail)) (if (= YaccParse (fail)) (let YaccParse (if (cons? (hd V585)) (let Parse_X (hd (hd V585)) (if (cons? Parse_X) (shen.pair (hd (shen.pair (tl (hd V585)) (shen.hdtl V585))) (shen.constructor-error Parse_X)) (fail))) (fail)) (if (= YaccParse (fail)) (let Parse_shen.<simple_pattern> (shen.<simple_pattern> V585) (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 (V586) (simple-error (shen.app V586 " is not a legitimate constructor
|
|
59
59
|
" shen.a)))
|
|
60
60
|
|
|
61
|
-
(defun shen.<simple_pattern> (
|
|
61
|
+
(defun shen.<simple_pattern> (V587) (let YaccParse (if (cons? (hd V587)) (let Parse_X (hd (hd V587)) (if (= Parse_X _) (shen.pair (hd (shen.pair (tl (hd V587)) (shen.hdtl V587))) (gensym Parse_Y)) (fail))) (fail)) (if (= YaccParse (fail)) (if (cons? (hd V587)) (let Parse_X (hd (hd V587)) (if (not (element? Parse_X (cons -> (cons <- ())))) (shen.pair (hd (shen.pair (tl (hd V587)) (shen.hdtl V587))) Parse_X) (fail))) (fail)) YaccParse)))
|
|
62
62
|
|
|
63
|
-
(defun shen.<pattern1> (
|
|
63
|
+
(defun shen.<pattern1> (V588) (let Parse_shen.<pattern> (shen.<pattern> V588) (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> (V589) (let Parse_shen.<pattern> (shen.<pattern> V589) (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> (V590) (if (cons? (hd V590)) (let Parse_X (hd (hd V590)) (shen.pair (hd (shen.pair (tl (hd V590)) (shen.hdtl V590))) Parse_X)) (fail)))
|
|
68
68
|
|
|
69
|
-
(defun shen.<guard> (
|
|
69
|
+
(defun shen.<guard> (V591) (if (cons? (hd V591)) (let Parse_X (hd (hd V591)) (shen.pair (hd (shen.pair (tl (hd V591)) (shen.hdtl V591))) Parse_X)) (fail)))
|
|
70
70
|
|
|
71
|
-
(defun shen.compile_to_machine_code (
|
|
71
|
+
(defun shen.compile_to_machine_code (V592 V593) (let Lambda+ (shen.compile_to_lambda+ V592 V593) (let KL (shen.compile_to_kl V592 Lambda+) (let Record (shen.record-source V592 KL) KL))))
|
|
72
72
|
|
|
73
|
-
(defun shen.record-source (
|
|
73
|
+
(defun shen.record-source (V596 V597) (cond ((value shen.*installing-kl*) shen.skip) (true (put V596 shen.source V597 (value *property-vector*)))))
|
|
74
74
|
|
|
75
|
-
(defun shen.compile_to_lambda+ (
|
|
75
|
+
(defun shen.compile_to_lambda+ (V598 V599) (let Arity (shen.aritycheck V598 V599) (let Free (map (lambda Rule (shen.free_variable_check V598 Rule)) V599) (let Variables (shen.parameters Arity) (let Strip (map (lambda V555 (shen.strip-protect V555)) V599) (let Abstractions (map (lambda V556 (shen.abstract_rule V556)) Strip) (let Applications (map (lambda X (shen.application_build Variables X)) Abstractions) (cons Variables (cons Applications ())))))))))
|
|
76
76
|
|
|
77
|
-
(defun shen.free_variable_check (
|
|
77
|
+
(defun shen.free_variable_check (V600 V601) (cond ((and (cons? V601) (and (cons? (tl V601)) (= () (tl (tl V601))))) (let Bound (shen.extract_vars (hd V601)) (let Free (shen.extract_free_vars Bound (hd (tl V601))) (shen.free_variable_warnings V600 Free)))) (true (shen.f_error shen.free_variable_check))))
|
|
78
78
|
|
|
79
|
-
(defun shen.extract_vars (
|
|
79
|
+
(defun shen.extract_vars (V602) (cond ((variable? V602) (cons V602 ())) ((cons? V602) (union (shen.extract_vars (hd V602)) (shen.extract_vars (tl V602)))) (true ())))
|
|
80
80
|
|
|
81
|
-
(defun shen.extract_free_vars (
|
|
81
|
+
(defun shen.extract_free_vars (V612 V613) (cond ((and (cons? V613) (and (cons? (tl V613)) (and (= () (tl (tl V613))) (= (hd V613) protect)))) ()) ((and (variable? V613) (not (element? V613 V612))) (cons V613 ())) ((and (cons? V613) (and (= lambda (hd V613)) (and (cons? (tl V613)) (and (cons? (tl (tl V613))) (= () (tl (tl (tl V613)))))))) (shen.extract_free_vars (cons (hd (tl V613)) V612) (hd (tl (tl V613))))) ((and (cons? V613) (and (= let (hd V613)) (and (cons? (tl V613)) (and (cons? (tl (tl V613))) (and (cons? (tl (tl (tl V613)))) (= () (tl (tl (tl (tl V613)))))))))) (union (shen.extract_free_vars V612 (hd (tl (tl V613)))) (shen.extract_free_vars (cons (hd (tl V613)) V612) (hd (tl (tl (tl V613))))))) ((cons? V613) (union (shen.extract_free_vars V612 (hd V613)) (shen.extract_free_vars V612 (tl V613)))) (true ())))
|
|
82
82
|
|
|
83
|
-
(defun shen.free_variable_warnings (
|
|
83
|
+
(defun shen.free_variable_warnings (V616 V617) (cond ((= () V617) _) (true (simple-error (cn "error: the following variables are free in " (shen.app V616 (cn ": " (shen.app (shen.list_variables V617) "" shen.a)) shen.a))))))
|
|
84
84
|
|
|
85
|
-
(defun shen.list_variables (
|
|
85
|
+
(defun shen.list_variables (V618) (cond ((and (cons? V618) (= () (tl V618))) (cn (str (hd V618)) ".")) ((cons? V618) (cn (str (hd V618)) (cn ", " (shen.list_variables (tl V618))))) (true (shen.f_error shen.list_variables))))
|
|
86
86
|
|
|
87
|
-
(defun shen.strip-protect (
|
|
87
|
+
(defun shen.strip-protect (V619) (cond ((and (cons? V619) (and (cons? (tl V619)) (and (= () (tl (tl V619))) (= (hd V619) protect)))) (shen.strip-protect (hd (tl V619)))) ((cons? V619) (map (lambda V557 (shen.strip-protect V557)) V619)) (true V619)))
|
|
88
88
|
|
|
89
|
-
(defun shen.linearise (
|
|
89
|
+
(defun shen.linearise (V620) (cond ((and (cons? V620) (and (cons? (tl V620)) (= () (tl (tl V620))))) (shen.linearise_help (shen.flatten (hd V620)) (hd V620) (hd (tl V620)))) (true (shen.f_error shen.linearise))))
|
|
90
90
|
|
|
91
|
-
(defun shen.flatten (
|
|
91
|
+
(defun shen.flatten (V621) (cond ((= () V621) ()) ((cons? V621) (append (shen.flatten (hd V621)) (shen.flatten (tl V621)))) (true (cons V621 ()))))
|
|
92
92
|
|
|
93
|
-
(defun shen.linearise_help (
|
|
93
|
+
(defun shen.linearise_help (V622 V623 V624) (cond ((= () V622) (cons V623 (cons V624 ()))) ((cons? V622) (if (and (variable? (hd V622)) (element? (hd V622) (tl V622))) (let Var (gensym (hd V622)) (let NewAction (cons where (cons (cons = (cons (hd V622) (cons Var ()))) (cons V624 ()))) (let NewPatts (shen.linearise_X (hd V622) Var V623) (shen.linearise_help (tl V622) NewPatts NewAction)))) (shen.linearise_help (tl V622) V623 V624))) (true (shen.f_error shen.linearise_help))))
|
|
94
94
|
|
|
95
|
-
(defun shen.linearise_X (
|
|
95
|
+
(defun shen.linearise_X (V634 V635 V636) (cond ((= V636 V634) V635) ((cons? V636) (let L (shen.linearise_X V634 V635 (hd V636)) (if (= L (hd V636)) (cons (hd V636) (shen.linearise_X V634 V635 (tl V636))) (cons L (tl V636))))) (true V636)))
|
|
96
96
|
|
|
97
|
-
(defun shen.aritycheck (
|
|
97
|
+
(defun shen.aritycheck (V637 V638) (cond ((and (cons? V638) (and (cons? (hd V638)) (and (cons? (tl (hd V638))) (and (= () (tl (tl (hd V638)))) (= () (tl V638)))))) (do (shen.aritycheck-action (hd (tl (hd V638)))) (shen.aritycheck-name V637 (arity V637) (length (hd (hd V638)))))) ((and (cons? V638) (and (cons? (hd V638)) (and (cons? (tl (hd V638))) (and (= () (tl (tl (hd V638)))) (and (cons? (tl V638)) (and (cons? (hd (tl V638))) (and (cons? (tl (hd (tl V638)))) (= () (tl (tl (hd (tl V638)))))))))))) (if (= (length (hd (hd V638))) (length (hd (hd (tl V638))))) (do (shen.aritycheck-action (hd (tl (hd V638)))) (shen.aritycheck V637 (tl V638))) (simple-error (cn "arity error in " (shen.app V637 "
|
|
98
98
|
" shen.a))))) (true (shen.f_error shen.aritycheck))))
|
|
99
99
|
|
|
100
|
-
(defun shen.aritycheck-name (
|
|
101
|
-
warning: changing the arity of " (shen.app
|
|
102
|
-
" shen.a)) (stoutput))
|
|
100
|
+
(defun shen.aritycheck-name (V648 V649 V650) (cond ((= -1 V649) V650) ((= V650 V649) V650) (true (do (shen.prhush (cn "
|
|
101
|
+
warning: changing the arity of " (shen.app V648 " can cause errors.
|
|
102
|
+
" shen.a)) (stoutput)) V650))))
|
|
103
103
|
|
|
104
|
-
(defun shen.aritycheck-action (
|
|
104
|
+
(defun shen.aritycheck-action (V655) (cond ((cons? V655) (do (shen.aah (hd V655) (tl V655)) (map (lambda V558 (shen.aritycheck-action V558)) V655))) (true shen.skip)))
|
|
105
105
|
|
|
106
|
-
(defun shen.aah (
|
|
106
|
+
(defun shen.aah (V656 V657) (let Arity (arity V656) (let Len (length V657) (if (and (> Arity -1) (> Len Arity)) (shen.prhush (cn "warning: " (shen.app V656 (cn " might not like " (shen.app Len (cn " argument" (shen.app (if (> Len 1) "s" "") ".
|
|
107
107
|
" shen.a)) shen.a)) shen.a)) (stoutput)) shen.skip))))
|
|
108
108
|
|
|
109
|
-
(defun shen.abstract_rule (
|
|
109
|
+
(defun shen.abstract_rule (V658) (cond ((and (cons? V658) (and (cons? (tl V658)) (= () (tl (tl V658))))) (shen.abstraction_build (hd V658) (hd (tl V658)))) (true (shen.f_error shen.abstract_rule))))
|
|
110
110
|
|
|
111
|
-
(defun shen.abstraction_build (
|
|
111
|
+
(defun shen.abstraction_build (V659 V660) (cond ((= () V659) V660) ((cons? V659) (cons /. (cons (hd V659) (cons (shen.abstraction_build (tl V659) V660) ())))) (true (shen.f_error shen.abstraction_build))))
|
|
112
112
|
|
|
113
|
-
(defun shen.parameters (
|
|
113
|
+
(defun shen.parameters (V661) (cond ((= 0 V661) ()) (true (cons (gensym V) (shen.parameters (- V661 1))))))
|
|
114
114
|
|
|
115
|
-
(defun shen.application_build (
|
|
115
|
+
(defun shen.application_build (V662 V663) (cond ((= () V662) V663) ((cons? V662) (shen.application_build (tl V662) (cons V663 (cons (hd V662) ())))) (true (shen.f_error shen.application_build))))
|
|
116
116
|
|
|
117
|
-
(defun shen.compile_to_kl (
|
|
117
|
+
(defun shen.compile_to_kl (V664 V665) (cond ((and (cons? V665) (and (cons? (tl V665)) (= () (tl (tl V665))))) (let Arity (shen.store-arity V664 (length (hd V665))) (let Reduce (map (lambda V559 (shen.reduce V559)) (hd (tl V665))) (let CondExpression (shen.cond-expression V664 (hd V665) Reduce) (let TypeTable (if (value shen.*optimise*) (shen.typextable (shen.get-type V664) (hd V665)) shen.skip) (let TypedCondExpression (if (value shen.*optimise*) (shen.assign-types (hd V665) TypeTable CondExpression) CondExpression) (let KL (cons defun (cons V664 (cons (hd V665) (cons TypedCondExpression ())))) KL))))))) (true (shen.f_error shen.compile_to_kl))))
|
|
118
118
|
|
|
119
|
-
(defun shen.get-type (
|
|
119
|
+
(defun shen.get-type (V670) (cond ((cons? V670) shen.skip) (true (let FType (assoc V670 (value shen.*signedfuncs*)) (if (empty? FType) shen.skip (tl FType))))))
|
|
120
120
|
|
|
121
|
-
(defun shen.typextable (
|
|
121
|
+
(defun shen.typextable (V679 V680) (cond ((and (cons? V679) (and (cons? (tl V679)) (and (= --> (hd (tl V679))) (and (cons? (tl (tl V679))) (and (= () (tl (tl (tl V679)))) (cons? V680)))))) (if (variable? (hd V679)) (shen.typextable (hd (tl (tl V679))) (tl V680)) (cons (cons (hd V680) (hd V679)) (shen.typextable (hd (tl (tl V679))) (tl V680))))) (true ())))
|
|
122
122
|
|
|
123
|
-
(defun shen.assign-types (
|
|
123
|
+
(defun shen.assign-types (V681 V682 V683) (cond ((and (cons? V683) (and (= let (hd V683)) (and (cons? (tl V683)) (and (cons? (tl (tl V683))) (and (cons? (tl (tl (tl V683)))) (= () (tl (tl (tl (tl V683)))))))))) (cons let (cons (hd (tl V683)) (cons (shen.assign-types V681 V682 (hd (tl (tl V683)))) (cons (shen.assign-types (cons (hd (tl V683)) V681) V682 (hd (tl (tl (tl V683))))) ()))))) ((and (cons? V683) (and (= lambda (hd V683)) (and (cons? (tl V683)) (and (cons? (tl (tl V683))) (= () (tl (tl (tl V683)))))))) (cons lambda (cons (hd (tl V683)) (cons (shen.assign-types (cons (hd (tl V683)) V681) V682 (hd (tl (tl V683)))) ())))) ((and (cons? V683) (= cond (hd V683))) (cons cond (map (lambda Y (cons (shen.assign-types V681 V682 (hd Y)) (cons (shen.assign-types V681 V682 (hd (tl Y))) ()))) (tl V683)))) ((cons? V683) (let NewTable (shen.typextable (shen.get-type (hd V683)) (tl V683)) (cons (hd V683) (map (lambda Y (shen.assign-types V681 (append V682 NewTable) Y)) (tl V683))))) (true (let AtomType (assoc V683 V682) (if (cons? AtomType) (cons type (cons V683 (cons (tl AtomType) ()))) (if (element? V683 V681) V683 (shen.atom-type V683)))))))
|
|
124
124
|
|
|
125
|
-
(defun shen.atom-type (
|
|
125
|
+
(defun shen.atom-type (V684) (if (string? V684) (cons type (cons V684 (cons string ()))) (if (number? V684) (cons type (cons V684 (cons number ()))) (if (boolean? V684) (cons type (cons V684 (cons boolean ()))) (if (symbol? V684) (cons type (cons V684 (cons symbol ()))) V684)))))
|
|
126
126
|
|
|
127
|
-
(defun shen.store-arity (
|
|
127
|
+
(defun shen.store-arity (V687 V688) (cond ((value shen.*installing-kl*) shen.skip) (true (put V687 arity V688 (value *property-vector*)))))
|
|
128
128
|
|
|
129
|
-
(defun shen.reduce (
|
|
129
|
+
(defun shen.reduce (V689) (do (set shen.*teststack* ()) (let Result (shen.reduce_help V689) (cons (cons : (cons shen.tests (reverse (value shen.*teststack*)))) (cons Result ())))))
|
|
130
130
|
|
|
131
|
-
(defun shen.reduce_help (
|
|
131
|
+
(defun shen.reduce_help (V690) (cond ((and (cons? V690) (and (cons? (hd V690)) (and (= /. (hd (hd V690))) (and (cons? (tl (hd V690))) (and (cons? (hd (tl (hd V690)))) (and (= cons (hd (hd (tl (hd V690))))) (and (cons? (tl (hd (tl (hd V690))))) (and (cons? (tl (tl (hd (tl (hd V690)))))) (and (= () (tl (tl (tl (hd (tl (hd V690))))))) (and (cons? (tl (tl (hd V690)))) (and (= () (tl (tl (tl (hd V690))))) (and (cons? (tl V690)) (= () (tl (tl V690))))))))))))))) (do (shen.add_test (cons cons? (tl V690))) (let Abstraction (cons /. (cons (hd (tl (hd (tl (hd V690))))) (cons (cons /. (cons (hd (tl (tl (hd (tl (hd V690)))))) (cons (shen.ebr (hd (tl V690)) (hd (tl (hd V690))) (hd (tl (tl (hd V690))))) ()))) ()))) (let Application (cons (cons Abstraction (cons (cons hd (tl V690)) ())) (cons (cons tl (tl V690)) ())) (shen.reduce_help Application))))) ((and (cons? V690) (and (cons? (hd V690)) (and (= /. (hd (hd V690))) (and (cons? (tl (hd V690))) (and (cons? (hd (tl (hd V690)))) (and (= @p (hd (hd (tl (hd V690))))) (and (cons? (tl (hd (tl (hd V690))))) (and (cons? (tl (tl (hd (tl (hd V690)))))) (and (= () (tl (tl (tl (hd (tl (hd V690))))))) (and (cons? (tl (tl (hd V690)))) (and (= () (tl (tl (tl (hd V690))))) (and (cons? (tl V690)) (= () (tl (tl V690))))))))))))))) (do (shen.add_test (cons tuple? (tl V690))) (let Abstraction (cons /. (cons (hd (tl (hd (tl (hd V690))))) (cons (cons /. (cons (hd (tl (tl (hd (tl (hd V690)))))) (cons (shen.ebr (hd (tl V690)) (hd (tl (hd V690))) (hd (tl (tl (hd V690))))) ()))) ()))) (let Application (cons (cons Abstraction (cons (cons fst (tl V690)) ())) (cons (cons snd (tl V690)) ())) (shen.reduce_help Application))))) ((and (cons? V690) (and (cons? (hd V690)) (and (= /. (hd (hd V690))) (and (cons? (tl (hd V690))) (and (cons? (hd (tl (hd V690)))) (and (= @v (hd (hd (tl (hd V690))))) (and (cons? (tl (hd (tl (hd V690))))) (and (cons? (tl (tl (hd (tl (hd V690)))))) (and (= () (tl (tl (tl (hd (tl (hd V690))))))) (and (cons? (tl (tl (hd V690)))) (and (= () (tl (tl (tl (hd V690))))) (and (cons? (tl V690)) (= () (tl (tl V690))))))))))))))) (do (shen.add_test (cons shen.+vector? (tl V690))) (let Abstraction (cons /. (cons (hd (tl (hd (tl (hd V690))))) (cons (cons /. (cons (hd (tl (tl (hd (tl (hd V690)))))) (cons (shen.ebr (hd (tl V690)) (hd (tl (hd V690))) (hd (tl (tl (hd V690))))) ()))) ()))) (let Application (cons (cons Abstraction (cons (cons hdv (tl V690)) ())) (cons (cons tlv (tl V690)) ())) (shen.reduce_help Application))))) ((and (cons? V690) (and (cons? (hd V690)) (and (= /. (hd (hd V690))) (and (cons? (tl (hd V690))) (and (cons? (hd (tl (hd V690)))) (and (= @s (hd (hd (tl (hd V690))))) (and (cons? (tl (hd (tl (hd V690))))) (and (cons? (tl (tl (hd (tl (hd V690)))))) (and (= () (tl (tl (tl (hd (tl (hd V690))))))) (and (cons? (tl (tl (hd V690)))) (and (= () (tl (tl (tl (hd V690))))) (and (cons? (tl V690)) (= () (tl (tl V690))))))))))))))) (do (shen.add_test (cons shen.+string? (tl V690))) (let Abstraction (cons /. (cons (hd (tl (hd (tl (hd V690))))) (cons (cons /. (cons (hd (tl (tl (hd (tl (hd V690)))))) (cons (shen.ebr (hd (tl V690)) (hd (tl (hd V690))) (hd (tl (tl (hd V690))))) ()))) ()))) (let Application (cons (cons Abstraction (cons (cons pos (cons (hd (tl V690)) (cons 0 ()))) ())) (cons (cons tlstr (tl V690)) ())) (shen.reduce_help Application))))) ((and (cons? V690) (and (cons? (hd V690)) (and (= /. (hd (hd V690))) (and (cons? (tl (hd V690))) (and (cons? (tl (tl (hd V690)))) (and (= () (tl (tl (tl (hd V690))))) (and (cons? (tl V690)) (and (= () (tl (tl V690))) (not (variable? (hd (tl (hd V690))))))))))))) (do (shen.add_test (cons = (cons (hd (tl (hd V690))) (tl V690)))) (shen.reduce_help (hd (tl (tl (hd V690))))))) ((and (cons? V690) (and (cons? (hd V690)) (and (= /. (hd (hd V690))) (and (cons? (tl (hd V690))) (and (cons? (tl (tl (hd V690)))) (and (= () (tl (tl (tl (hd V690))))) (and (cons? (tl V690)) (= () (tl (tl V690)))))))))) (shen.reduce_help (shen.ebr (hd (tl V690)) (hd (tl (hd V690))) (hd (tl (tl (hd V690))))))) ((and (cons? V690) (and (= where (hd V690)) (and (cons? (tl V690)) (and (cons? (tl (tl V690))) (= () (tl (tl (tl V690)))))))) (do (shen.add_test (hd (tl V690))) (shen.reduce_help (hd (tl (tl V690)))))) ((and (cons? V690) (and (cons? (tl V690)) (= () (tl (tl V690))))) (let Z (shen.reduce_help (hd V690)) (if (= (hd V690) Z) V690 (shen.reduce_help (cons Z (tl V690)))))) (true V690)))
|
|
132
132
|
|
|
133
|
-
(defun shen.+string? (
|
|
133
|
+
(defun shen.+string? (V691) (cond ((= "" V691) false) (true (string? V691))))
|
|
134
134
|
|
|
135
|
-
(defun shen.+vector (
|
|
135
|
+
(defun shen.+vector (V692) (cond ((= V692 (vector 0)) false) (true (vector? V692))))
|
|
136
136
|
|
|
137
|
-
(defun shen.ebr (
|
|
137
|
+
(defun shen.ebr (V703 V704 V705) (cond ((= V705 V704) V703) ((and (cons? V705) (and (= /. (hd V705)) (and (cons? (tl V705)) (and (cons? (tl (tl V705))) (and (= () (tl (tl (tl V705)))) (> (occurrences V704 (hd (tl V705))) 0)))))) V705) ((and (cons? V705) (and (= let (hd V705)) (and (cons? (tl V705)) (and (cons? (tl (tl V705))) (and (cons? (tl (tl (tl V705)))) (and (= () (tl (tl (tl (tl V705))))) (= (hd (tl V705)) V704))))))) (cons let (cons (hd (tl V705)) (cons (shen.ebr V703 (hd (tl V705)) (hd (tl (tl V705)))) (tl (tl (tl V705))))))) ((cons? V705) (cons (shen.ebr V703 V704 (hd V705)) (shen.ebr V703 V704 (tl V705)))) (true V705)))
|
|
138
138
|
|
|
139
|
-
(defun shen.add_test (
|
|
139
|
+
(defun shen.add_test (V706) (set shen.*teststack* (cons V706 (value shen.*teststack*))))
|
|
140
140
|
|
|
141
|
-
(defun shen.cond-expression (
|
|
141
|
+
(defun shen.cond-expression (V707 V708 V709) (let Err (shen.err-condition V707) (let Cases (shen.case-form V709 Err) (let EncodeChoices (shen.encode-choices Cases V707) (shen.cond-form EncodeChoices)))))
|
|
142
142
|
|
|
143
|
-
(defun shen.cond-form (
|
|
143
|
+
(defun shen.cond-form (V712) (cond ((and (cons? V712) (and (cons? (hd V712)) (and (= true (hd (hd V712))) (and (cons? (tl (hd V712))) (= () (tl (tl (hd V712)))))))) (hd (tl (hd V712)))) (true (cons cond V712))))
|
|
144
144
|
|
|
145
|
-
(defun shen.encode-choices (
|
|
145
|
+
(defun shen.encode-choices (V715 V716) (cond ((= () V715) ()) ((and (cons? V715) (and (cons? (hd V715)) (and (= true (hd (hd V715))) (and (cons? (tl (hd V715))) (and (cons? (hd (tl (hd V715)))) (and (= shen.choicepoint! (hd (hd (tl (hd V715))))) (and (cons? (tl (hd (tl (hd V715))))) (and (= () (tl (tl (hd (tl (hd V715)))))) (and (= () (tl (tl (hd V715)))) (= () (tl V715))))))))))) (cons (cons true (cons (cons let (cons Result (cons (hd (tl (hd (tl (hd V715))))) (cons (cons if (cons (cons = (cons Result (cons (cons fail ()) ()))) (cons (if (value shen.*installing-kl*) (cons shen.sys-error (cons V716 ())) (cons shen.f_error (cons V716 ()))) (cons Result ())))) ())))) ())) ())) ((and (cons? V715) (and (cons? (hd V715)) (and (= true (hd (hd V715))) (and (cons? (tl (hd V715))) (and (cons? (hd (tl (hd V715)))) (and (= shen.choicepoint! (hd (hd (tl (hd V715))))) (and (cons? (tl (hd (tl (hd V715))))) (and (= () (tl (tl (hd (tl (hd V715)))))) (= () (tl (tl (hd V715)))))))))))) (cons (cons true (cons (cons let (cons Result (cons (hd (tl (hd (tl (hd V715))))) (cons (cons if (cons (cons = (cons Result (cons (cons fail ()) ()))) (cons (shen.cond-form (shen.encode-choices (tl V715) V716)) (cons Result ())))) ())))) ())) ())) ((and (cons? V715) (and (cons? (hd V715)) (and (cons? (tl (hd V715))) (and (cons? (hd (tl (hd V715)))) (and (= shen.choicepoint! (hd (hd (tl (hd V715))))) (and (cons? (tl (hd (tl (hd V715))))) (and (= () (tl (tl (hd (tl (hd V715)))))) (= () (tl (tl (hd V715))))))))))) (cons (cons true (cons (cons let (cons Freeze (cons (cons freeze (cons (shen.cond-form (shen.encode-choices (tl V715) V716)) ())) (cons (cons if (cons (hd (hd V715)) (cons (cons let (cons Result (cons (hd (tl (hd (tl (hd V715))))) (cons (cons if (cons (cons = (cons Result (cons (cons fail ()) ()))) (cons (cons thaw (cons Freeze ())) (cons Result ())))) ())))) (cons (cons thaw (cons Freeze ())) ())))) ())))) ())) ())) ((and (cons? V715) (and (cons? (hd V715)) (and (cons? (tl (hd V715))) (= () (tl (tl (hd V715))))))) (cons (hd V715) (shen.encode-choices (tl V715) V716))) (true (shen.f_error shen.encode-choices))))
|
|
146
146
|
|
|
147
|
-
(defun shen.case-form (
|
|
147
|
+
(defun shen.case-form (V721 V722) (cond ((= () V721) (cons V722 ())) ((and (cons? V721) (and (cons? (hd V721)) (and (cons? (hd (hd V721))) (and (= : (hd (hd (hd V721)))) (and (cons? (tl (hd (hd V721)))) (and (= shen.tests (hd (tl (hd (hd V721))))) (and (= () (tl (tl (hd (hd V721))))) (and (cons? (tl (hd V721))) (and (cons? (hd (tl (hd V721)))) (and (= shen.choicepoint! (hd (hd (tl (hd V721))))) (and (cons? (tl (hd (tl (hd V721))))) (and (= () (tl (tl (hd (tl (hd V721)))))) (= () (tl (tl (hd V721)))))))))))))))) (cons (cons true (tl (hd V721))) (shen.case-form (tl V721) V722))) ((and (cons? V721) (and (cons? (hd V721)) (and (cons? (hd (hd V721))) (and (= : (hd (hd (hd V721)))) (and (cons? (tl (hd (hd V721)))) (and (= shen.tests (hd (tl (hd (hd V721))))) (and (= () (tl (tl (hd (hd V721))))) (and (cons? (tl (hd V721))) (= () (tl (tl (hd V721)))))))))))) (cons (cons true (tl (hd V721))) ())) ((and (cons? V721) (and (cons? (hd V721)) (and (cons? (hd (hd V721))) (and (= : (hd (hd (hd V721)))) (and (cons? (tl (hd (hd V721)))) (and (= shen.tests (hd (tl (hd (hd V721))))) (and (cons? (tl (hd V721))) (= () (tl (tl (hd V721))))))))))) (cons (cons (shen.embed-and (tl (tl (hd (hd V721))))) (tl (hd V721))) (shen.case-form (tl V721) V722))) (true (shen.f_error shen.case-form))))
|
|
148
148
|
|
|
149
|
-
(defun shen.embed-and (
|
|
149
|
+
(defun shen.embed-and (V723) (cond ((and (cons? V723) (= () (tl V723))) (hd V723)) ((cons? V723) (cons and (cons (hd V723) (cons (shen.embed-and (tl V723)) ())))) (true (shen.f_error shen.embed-and))))
|
|
150
150
|
|
|
151
|
-
(defun shen.err-condition (
|
|
151
|
+
(defun shen.err-condition (V724) (cons true (cons (cons shen.f_error (cons V724 ())) ())))
|
|
152
152
|
|
|
153
|
-
(defun shen.sys-error (
|
|
153
|
+
(defun shen.sys-error (V725) (simple-error (cn "system function " (shen.app V725 ": unexpected argument
|
|
154
154
|
" shen.a))))
|
|
155
155
|
|
|
156
156
|
|
|
@@ -87,23 +87,23 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE."
|
|
|
87
87
|
|
|
88
88
|
(set shen.*optimise* false)
|
|
89
89
|
|
|
90
|
-
(set *version* "Shen 17")
|
|
90
|
+
(set *version* "Shen 17.2")
|
|
91
91
|
|
|
92
|
-
(defun shen.initialise_arity_table (
|
|
92
|
+
(defun shen.initialise_arity_table (V726) (cond ((= () V726) ()) ((and (cons? V726) (cons? (tl V726))) (let DecArity (put (hd V726) arity (hd (tl V726)) (value *property-vector*)) (shen.initialise_arity_table (tl (tl V726))))) (true (shen.f_error shen.initialise_arity_table))))
|
|
93
93
|
|
|
94
|
-
(defun arity (
|
|
94
|
+
(defun arity (V727) (trap-error (get V727 arity (value *property-vector*)) (lambda E -1)))
|
|
95
95
|
|
|
96
96
|
(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 shen.interror (cons 2 (cons eval (cons 1 (cons eval-kl (cons 1 (cons explode (cons 1 (cons external (cons 1 (cons fail-if (cons 2 (cons fail (cons 0 (cons fix (cons 2 (cons findall (cons 5 (cons freeze (cons 1 (cons fst (cons 1 (cons gensym (cons 1 (cons get (cons 3 (cons get-time (cons 1 (cons address-> (cons 3 (cons <-address (cons 2 (cons <-vector (cons 2 (cons > (cons 2 (cons >= (cons 2 (cons = (cons 2 (cons hd (cons 1 (cons hdv (cons 1 (cons hdstr (cons 1 (cons head (cons 1 (cons if (cons 3 (cons integer? (cons 1 (cons intern (cons 1 (cons identical (cons 4 (cons inferences (cons 0 (cons input (cons 1 (cons input+ (cons 2 (cons implementation (cons 0 (cons intersection (cons 2 (cons it (cons 0 (cons kill (cons 0 (cons language (cons 0 (cons length (cons 1 (cons lineread (cons 1 (cons load (cons 1 (cons < (cons 2 (cons <= (cons 2 (cons vector (cons 1 (cons macroexpand (cons 1 (cons map (cons 2 (cons mapcan (cons 2 (cons maxinferences (cons 1 (cons not (cons 1 (cons nth (cons 2 (cons n->string (cons 1 (cons number? (cons 1 (cons occurs-check (cons 1 (cons occurrences (cons 2 (cons occurs-check (cons 1 (cons optimise (cons 1 (cons or (cons 2 (cons os (cons 0 (cons package (cons 3 (cons package? (cons 1 (cons port (cons 0 (cons porters (cons 0 (cons pos (cons 2 (cons print (cons 1 (cons profile (cons 1 (cons profile-results (cons 1 (cons pr (cons 2 (cons ps (cons 1 (cons preclude (cons 1 (cons preclude-all-but (cons 1 (cons protect (cons 1 (cons address-> (cons 3 (cons put (cons 4 (cons shen.reassemble (cons 2 (cons read-file-as-string (cons 1 (cons read-file (cons 1 (cons read (cons 1 (cons read-byte (cons 1 (cons read-from-string (cons 1 (cons release (cons 0 (cons remove (cons 2 (cons require (cons 3 (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 subst (cons 3 (cons sum (cons 1 (cons symbol? (cons 1 (cons tail (cons 1 (cons tl (cons 1 (cons tc (cons 1 (cons tc? (cons 0 (cons thaw (cons 1 (cons tlstr (cons 1 (cons track (cons 1 (cons trap-error (cons 2 (cons tuple? (cons 1 (cons type (cons 2 (cons return (cons 3 (cons undefmacro (cons 1 (cons unput (cons 3 (cons unprofile (cons 1 (cons unify (cons 4 (cons unify! (cons 4 (cons union (cons 2 (cons untrack (cons 1 (cons unspecialise (cons 1 (cons undefmacro (cons 1 (cons vector (cons 1 (cons vector-> (cons 3 (cons value (cons 1 (cons variable? (cons 1 (cons version (cons 0 (cons 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 ())))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
|
|
97
97
|
|
|
98
|
-
(defun systemf (
|
|
98
|
+
(defun systemf (V728) (let Shen (intern "shen") (let External (get Shen shen.external-symbols (value *property-vector*)) (let Place (put Shen shen.external-symbols (adjoin V728 External) (value *property-vector*)) V728))))
|
|
99
99
|
|
|
100
|
-
(defun adjoin (
|
|
100
|
+
(defun adjoin (V729 V730) (if (element? V729 V730) V730 (cons V729 V730)))
|
|
101
101
|
|
|
102
102
|
(put (intern "shen") shen.external-symbols (cons ! (cons } (cons { (cons --> (cons <-- (cons && (cons : (cons ; (cons :- (cons := (cons _ (cons *language* (cons *implementation* (cons *stinput* (cons *stoutput* (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 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 unput (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 sum (cons subst (cons string? (cons string->n (cons stream (cons string (cons stinput (cons stoutput (cons step (cons spy (cons specialise (cons snd (cons simple-error (cons set (cons save (cons str (cons run (cons reverse (cons remove (cons release (cons read (cons read-file (cons require (cons read-file-as-bytelist (cons read-file-as-string (cons read-byte (cons read-from-string (cons package? (cons put (cons preclude (cons preclude-all-but (cons ps (cons prolog? (cons protect (cons profile-results (cons profile (cons print (cons pr (cons pos (cons porters (cons port (cons package (cons output (cons out (cons os (cons or (cons optimise (cons open (cons occurrences (cons occurs-check (cons n->string (cons number? (cons number (cons null (cons nth (cons not (cons nl (cons mode (cons macroexpand (cons maxinferences (cons mapcan (cons map (cons make-string (cons load (cons loaded (cons list (cons lineread (cons limit (cons length (cons let (cons lazy (cons lambda (cons language (cons kill (cons is (cons intersection (cons inferences (cons intern (cons integer? (cons input (cons input+ (cons include (cons include-all-but (cons it (cons in (cons implementation (cons if (cons identical (cons head (cons hd (cons hdv (cons hdstr (cons hash (cons get (cons get-time (cons gensym (cons function (cons fst (cons freeze (cons fix (cons file (cons fail (cons fail-if (cons fwhen (cons findall (cons false (cons enable-type-theory (cons explode (cons external (cons exception (cons eval-kl (cons eval (cons error-to-string (cons error (cons empty? (cons element? (cons do (cons difference (cons destroy (cons defun (cons define (cons defmacro (cons defcc (cons defprolog (cons declare (cons datatype (cons cut (cons cn (cons cons? (cons cons (cons cond (cons concat (cons compile (cons cd (cons cases (cons call (cons close (cons bind (cons bound? (cons boolean? (cons boolean (cons bar! (cons assoc (cons arity (cons append (cons and (cons adjoin (cons <-address (cons address-> (cons absvector? (cons absvector (cons abort ()))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) (value *property-vector*))
|
|
103
103
|
|
|
104
|
-
(defun specialise (
|
|
104
|
+
(defun specialise (V731) (do (set shen.*special* (cons V731 (value shen.*special*))) V731))
|
|
105
105
|
|
|
106
|
-
(defun unspecialise (
|
|
106
|
+
(defun unspecialise (V732) (do (set shen.*special* (remove V732 (value shen.*special*))) V732))
|
|
107
107
|
|
|
108
108
|
|
|
109
109
|
|
|
@@ -23,37 +23,37 @@ 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 load (
|
|
26
|
+
(defun load (V738) (let Load (let Start (get-time run) (let Result (shen.load-help (value shen.*tc*) (read-file V738)) (let Finish (get-time run) (let Time (- Finish Start) (let Message (shen.prhush (cn "
|
|
27
27
|
run time: " (cn (str Time) " secs
|
|
28
28
|
")) (stoutput)) Result))))) (let Infs (if (value shen.*tc*) (shen.prhush (cn "
|
|
29
29
|
typechecked in " (shen.app (inferences) " inferences
|
|
30
30
|
" shen.a)) (stoutput)) shen.skip) loaded)))
|
|
31
31
|
|
|
32
|
-
(defun shen.load-help (
|
|
33
|
-
" shen.s) (stoutput)))
|
|
32
|
+
(defun shen.load-help (V743 V744) (cond ((= false V743) (map (lambda X (shen.prhush (shen.app (shen.eval-without-macros X) "
|
|
33
|
+
" shen.s) (stoutput))) V744)) (true (let RemoveSynonyms (mapcan (lambda V733 (shen.remove-synonyms V733)) V744) (let Table (mapcan (lambda V734 (shen.typetable V734)) RemoveSynonyms) (let Assume (map (lambda V735 (shen.assumetype V735)) Table) (trap-error (map (lambda V736 (shen.typecheck-and-load V736)) RemoveSynonyms) (lambda E (shen.unwind-types E Table)))))))))
|
|
34
34
|
|
|
35
|
-
(defun shen.remove-synonyms (
|
|
35
|
+
(defun shen.remove-synonyms (V745) (cond ((and (cons? V745) (= shen.synonyms-help (hd V745))) (do (eval V745) ())) (true (cons V745 ()))))
|
|
36
36
|
|
|
37
|
-
(defun shen.typecheck-and-load (
|
|
37
|
+
(defun shen.typecheck-and-load (V746) (do (nl 1) (shen.typecheck-and-evaluate V746 (gensym A))))
|
|
38
38
|
|
|
39
|
-
(defun shen.typetable (
|
|
40
|
-
" shen.a)))) (cons (cons (hd (tl
|
|
39
|
+
(defun shen.typetable (V751) (cond ((and (cons? V751) (and (= define (hd V751)) (cons? (tl V751)))) (let Sig (compile (lambda V737 (shen.<sig+rest> V737)) (tl (tl V751)) (lambda E (simple-error (shen.app (hd (tl V751)) " lacks a proper signature.
|
|
40
|
+
" shen.a)))) (cons (cons (hd (tl V751)) Sig) ()))) (true ())))
|
|
41
41
|
|
|
42
|
-
(defun shen.assumetype (
|
|
42
|
+
(defun shen.assumetype (V752) (cond ((cons? V752) (declare (hd V752) (tl V752))) (true (shen.f_error shen.assumetype))))
|
|
43
43
|
|
|
44
|
-
(defun shen.unwind-types (
|
|
44
|
+
(defun shen.unwind-types (V757 V758) (cond ((= () V758) (simple-error (error-to-string V757))) ((and (cons? V758) (cons? (hd V758))) (do (shen.remtype (hd (hd V758))) (shen.unwind-types V757 (tl V758)))) (true (shen.f_error shen.unwind-types))))
|
|
45
45
|
|
|
46
|
-
(defun shen.remtype (
|
|
46
|
+
(defun shen.remtype (V759) (set shen.*signedfuncs* (shen.removetype V759 (value shen.*signedfuncs*))))
|
|
47
47
|
|
|
48
|
-
(defun shen.removetype (
|
|
48
|
+
(defun shen.removetype (V765 V766) (cond ((= () V766) ()) ((and (cons? V766) (and (cons? (hd V766)) (= (hd (hd V766)) V765))) (shen.removetype (hd (hd V766)) (tl V766))) ((cons? V766) (cons (hd V766) (shen.removetype V765 (tl V766)))) (true (shen.f_error shen.removetype))))
|
|
49
49
|
|
|
50
|
-
(defun shen.<sig+rest> (
|
|
50
|
+
(defun shen.<sig+rest> (V767) (let Parse_shen.<signature> (shen.<signature> V767) (if (not (= (fail) Parse_shen.<signature>)) (let Parse_shen.<!> (shen.<!> Parse_shen.<signature>) (if (not (= (fail) Parse_shen.<!>)) (shen.pair (hd Parse_shen.<!>) (shen.hdtl Parse_shen.<signature>)) (fail))) (fail))))
|
|
51
51
|
|
|
52
|
-
(defun write-to-file (
|
|
52
|
+
(defun write-to-file (V768 V769) (let Stream (open V768 out) (let String (if (string? V769) (shen.app V769 "
|
|
53
53
|
|
|
54
|
-
" shen.a) (shen.app
|
|
54
|
+
" shen.a) (shen.app V769 "
|
|
55
55
|
|
|
56
|
-
" shen.s)) (let Write (pr String Stream) (let Close (close Stream)
|
|
56
|
+
" shen.s)) (let Write (pr String Stream) (let Close (close Stream) V769)))))
|
|
57
57
|
|
|
58
58
|
|
|
59
59
|
|
|
@@ -23,69 +23,69 @@ 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 macroexpand (
|
|
26
|
+
(defun macroexpand (V773) (let Y (shen.compose (value *macros*) V773) (if (= V773 Y) V773 (shen.walk (lambda V770 (macroexpand V770)) Y))))
|
|
27
27
|
|
|
28
|
-
(defun shen.error-macro (
|
|
28
|
+
(defun shen.error-macro (V774) (cond ((and (cons? V774) (and (= error (hd V774)) (cons? (tl V774)))) (cons simple-error (cons (shen.mkstr (hd (tl V774)) (tl (tl V774))) ()))) (true V774)))
|
|
29
29
|
|
|
30
|
-
(defun shen.output-macro (
|
|
30
|
+
(defun shen.output-macro (V775) (cond ((and (cons? V775) (and (= output (hd V775)) (cons? (tl V775)))) (cons shen.prhush (cons (shen.mkstr (hd (tl V775)) (tl (tl V775))) (cons (cons stoutput ()) ())))) ((and (cons? V775) (and (= pr (hd V775)) (and (cons? (tl V775)) (= () (tl (tl V775)))))) (cons pr (cons (hd (tl V775)) (cons (cons stoutput ()) ())))) (true V775)))
|
|
31
31
|
|
|
32
|
-
(defun shen.make-string-macro (
|
|
32
|
+
(defun shen.make-string-macro (V776) (cond ((and (cons? V776) (and (= make-string (hd V776)) (cons? (tl V776)))) (shen.mkstr (hd (tl V776)) (tl (tl V776)))) (true V776)))
|
|
33
33
|
|
|
34
|
-
(defun shen.input-macro (
|
|
34
|
+
(defun shen.input-macro (V777) (cond ((and (cons? V777) (and (= lineread (hd V777)) (= () (tl V777)))) (cons lineread (cons (cons stinput ()) ()))) ((and (cons? V777) (and (= input (hd V777)) (= () (tl V777)))) (cons input (cons (cons stinput ()) ()))) ((and (cons? V777) (and (= read (hd V777)) (= () (tl V777)))) (cons read (cons (cons stinput ()) ()))) ((and (cons? V777) (and (= input+ (hd V777)) (and (cons? (tl V777)) (= () (tl (tl V777)))))) (cons input+ (cons (hd (tl V777)) (cons (cons stinput ()) ())))) ((and (cons? V777) (and (= read-byte (hd V777)) (= () (tl V777)))) (cons read-byte (cons (cons stinput ()) ()))) (true V777)))
|
|
35
35
|
|
|
36
|
-
(defun shen.compose (
|
|
36
|
+
(defun shen.compose (V778 V779) (cond ((= () V778) V779) ((cons? V778) (shen.compose (tl V778) ((hd V778) V779))) (true (shen.f_error shen.compose))))
|
|
37
37
|
|
|
38
|
-
(defun shen.compile-macro (
|
|
38
|
+
(defun shen.compile-macro (V780) (cond ((and (cons? V780) (and (= compile (hd V780)) (and (cons? (tl V780)) (and (cons? (tl (tl V780))) (= () (tl (tl (tl V780)))))))) (cons compile (cons (hd (tl V780)) (cons (hd (tl (tl V780))) (cons (cons lambda (cons E (cons (cons if (cons (cons cons? (cons E ())) (cons (cons error (cons "parse error here: ~S~%" (cons E ()))) (cons (cons error (cons "parse error~%" ())) ())))) ()))) ()))))) (true V780)))
|
|
39
39
|
|
|
40
|
-
(defun shen.prolog-macro (
|
|
40
|
+
(defun shen.prolog-macro (V781) (cond ((and (cons? V781) (= prolog? (hd V781))) (let F (gensym shen.f) (let Receive (shen.receive-terms (tl V781)) (let PrologDef (eval (append (cons defprolog (cons F ())) (append Receive (append (cons <-- ()) (append (shen.pass-literals (tl V781)) (cons ; ())))))) (let Query (cons F (append Receive (cons (cons shen.start-new-prolog-process ()) (cons (cons freeze (cons true ())) ())))) Query))))) (true V781)))
|
|
41
41
|
|
|
42
|
-
(defun shen.receive-terms (
|
|
42
|
+
(defun shen.receive-terms (V786) (cond ((= () V786) ()) ((and (cons? V786) (and (cons? (hd V786)) (and (= shen.receive (hd (hd V786))) (and (cons? (tl (hd V786))) (= () (tl (tl (hd V786)))))))) (cons (hd (tl (hd V786))) (shen.receive-terms (tl V786)))) ((cons? V786) (shen.receive-terms (tl V786))) (true (shen.f_error shen.receive-terms))))
|
|
43
43
|
|
|
44
|
-
(defun shen.pass-literals (
|
|
44
|
+
(defun shen.pass-literals (V789) (cond ((= () V789) ()) ((and (cons? V789) (and (cons? (hd V789)) (and (= shen.receive (hd (hd V789))) (and (cons? (tl (hd V789))) (= () (tl (tl (hd V789)))))))) (shen.pass-literals (tl V789))) ((cons? V789) (cons (hd V789) (shen.pass-literals (tl V789)))) (true (shen.f_error shen.pass-literals))))
|
|
45
45
|
|
|
46
|
-
(defun shen.defprolog-macro (
|
|
46
|
+
(defun shen.defprolog-macro (V790) (cond ((and (cons? V790) (and (= defprolog (hd V790)) (cons? (tl V790)))) (compile (lambda V771 (shen.<defprolog> V771)) (tl V790) (lambda Y (shen.prolog-error (hd (tl V790)) Y)))) (true V790)))
|
|
47
47
|
|
|
48
|
-
(defun shen.datatype-macro (
|
|
48
|
+
(defun shen.datatype-macro (V791) (cond ((and (cons? V791) (and (= datatype (hd V791)) (cons? (tl V791)))) (cons shen.process-datatype (cons (shen.intern-type (hd (tl V791))) (cons (cons compile (cons (cons function (cons shen.<datatype-rules> ())) (cons (shen.rcons_form (tl (tl V791))) (cons (cons function (cons shen.datatype-error ())) ())))) ())))) (true V791)))
|
|
49
49
|
|
|
50
|
-
(defun shen.intern-type (
|
|
50
|
+
(defun shen.intern-type (V792) (intern (cn "type#" (str V792))))
|
|
51
51
|
|
|
52
|
-
(defun shen.@s-macro (
|
|
52
|
+
(defun shen.@s-macro (V793) (cond ((and (cons? V793) (and (= @s (hd V793)) (and (cons? (tl V793)) (and (cons? (tl (tl V793))) (cons? (tl (tl (tl V793)))))))) (cons @s (cons (hd (tl V793)) (cons (shen.@s-macro (cons @s (tl (tl V793)))) ())))) ((and (cons? V793) (and (= @s (hd V793)) (and (cons? (tl V793)) (and (cons? (tl (tl V793))) (and (= () (tl (tl (tl V793)))) (string? (hd (tl V793)))))))) (let E (explode (hd (tl V793))) (if (> (length E) 1) (shen.@s-macro (cons @s (append E (tl (tl V793))))) V793))) (true V793)))
|
|
53
53
|
|
|
54
|
-
(defun shen.synonyms-macro (
|
|
54
|
+
(defun shen.synonyms-macro (V794) (cond ((and (cons? V794) (= synonyms (hd V794))) (cons shen.synonyms-help (cons (shen.rcons_form (shen.curry-synonyms (tl V794))) ()))) (true V794)))
|
|
55
55
|
|
|
56
|
-
(defun shen.curry-synonyms (
|
|
56
|
+
(defun shen.curry-synonyms (V795) (map (lambda V772 (shen.curry-type V772)) V795))
|
|
57
57
|
|
|
58
|
-
(defun shen.nl-macro (
|
|
58
|
+
(defun shen.nl-macro (V796) (cond ((and (cons? V796) (and (= nl (hd V796)) (= () (tl V796)))) (cons nl (cons 1 ()))) (true V796)))
|
|
59
59
|
|
|
60
|
-
(defun shen.assoc-macro (
|
|
60
|
+
(defun shen.assoc-macro (V797) (cond ((and (cons? V797) (and (cons? (tl V797)) (and (cons? (tl (tl V797))) (and (cons? (tl (tl (tl V797)))) (element? (hd V797) (cons @p (cons @v (cons append (cons and (cons or (cons + (cons * (cons do ()))))))))))))) (cons (hd V797) (cons (hd (tl V797)) (cons (shen.assoc-macro (cons (hd V797) (tl (tl V797)))) ())))) (true V797)))
|
|
61
61
|
|
|
62
|
-
(defun shen.let-macro (
|
|
62
|
+
(defun shen.let-macro (V798) (cond ((and (cons? V798) (and (= let (hd V798)) (and (cons? (tl V798)) (and (cons? (tl (tl V798))) (and (cons? (tl (tl (tl V798)))) (cons? (tl (tl (tl (tl V798)))))))))) (cons let (cons (hd (tl V798)) (cons (hd (tl (tl V798))) (cons (shen.let-macro (cons let (tl (tl (tl V798))))) ()))))) (true V798)))
|
|
63
63
|
|
|
64
|
-
(defun shen.abs-macro (
|
|
64
|
+
(defun shen.abs-macro (V799) (cond ((and (cons? V799) (and (= /. (hd V799)) (and (cons? (tl V799)) (and (cons? (tl (tl V799))) (cons? (tl (tl (tl V799)))))))) (cons lambda (cons (hd (tl V799)) (cons (shen.abs-macro (cons /. (tl (tl V799)))) ())))) ((and (cons? V799) (and (= /. (hd V799)) (and (cons? (tl V799)) (and (cons? (tl (tl V799))) (= () (tl (tl (tl V799)))))))) (cons lambda (tl V799))) (true V799)))
|
|
65
65
|
|
|
66
|
-
(defun shen.cases-macro (
|
|
67
|
-
")) (true
|
|
66
|
+
(defun shen.cases-macro (V802) (cond ((and (cons? V802) (and (= cases (hd V802)) (and (cons? (tl V802)) (and (= true (hd (tl V802))) (cons? (tl (tl V802))))))) (hd (tl (tl V802)))) ((and (cons? V802) (and (= cases (hd V802)) (and (cons? (tl V802)) (and (cons? (tl (tl V802))) (= () (tl (tl (tl V802)))))))) (cons if (cons (hd (tl V802)) (cons (hd (tl (tl V802))) (cons (cons simple-error (cons "error: cases exhausted" ())) ()))))) ((and (cons? V802) (and (= cases (hd V802)) (and (cons? (tl V802)) (cons? (tl (tl V802)))))) (cons if (cons (hd (tl V802)) (cons (hd (tl (tl V802))) (cons (shen.cases-macro (cons cases (tl (tl (tl V802))))) ()))))) ((and (cons? V802) (and (= cases (hd V802)) (and (cons? (tl V802)) (= () (tl (tl V802)))))) (simple-error "error: odd number of case elements
|
|
67
|
+
")) (true V802)))
|
|
68
68
|
|
|
69
|
-
(defun shen.timer-macro (
|
|
69
|
+
(defun shen.timer-macro (V803) (cond ((and (cons? V803) (and (= time (hd V803)) (and (cons? (tl V803)) (= () (tl (tl V803)))))) (shen.let-macro (cons let (cons Start (cons (cons get-time (cons run ())) (cons Result (cons (hd (tl V803)) (cons Finish (cons (cons get-time (cons run ())) (cons Time (cons (cons - (cons Finish (cons Start ()))) (cons Message (cons (cons shen.prhush (cons (cons cn (cons "
|
|
70
70
|
run time: " (cons (cons cn (cons (cons str (cons Time ())) (cons " secs
|
|
71
|
-
" ()))) ()))) (cons (cons stoutput ()) ()))) (cons Result ())))))))))))))) (true
|
|
71
|
+
" ()))) ()))) (cons (cons stoutput ()) ()))) (cons Result ())))))))))))))) (true V803)))
|
|
72
72
|
|
|
73
|
-
(defun shen.tuple-up (
|
|
73
|
+
(defun shen.tuple-up (V804) (cond ((cons? V804) (cons @p (cons (hd V804) (cons (shen.tuple-up (tl V804)) ())))) (true V804)))
|
|
74
74
|
|
|
75
|
-
(defun shen.put/get-macro (
|
|
75
|
+
(defun shen.put/get-macro (V805) (cond ((and (cons? V805) (and (= put (hd V805)) (and (cons? (tl V805)) (and (cons? (tl (tl V805))) (and (cons? (tl (tl (tl V805)))) (= () (tl (tl (tl (tl V805)))))))))) (cons put (cons (hd (tl V805)) (cons (hd (tl (tl V805))) (cons (hd (tl (tl (tl V805)))) (cons (cons value (cons *property-vector* ())) ())))))) ((and (cons? V805) (and (= get (hd V805)) (and (cons? (tl V805)) (and (cons? (tl (tl V805))) (= () (tl (tl (tl V805)))))))) (cons get (cons (hd (tl V805)) (cons (hd (tl (tl V805))) (cons (cons value (cons *property-vector* ())) ()))))) ((and (cons? V805) (and (= unput (hd V805)) (and (cons? (tl V805)) (and (cons? (tl (tl V805))) (= () (tl (tl (tl V805)))))))) (cons unput (cons (hd (tl V805)) (cons (hd (tl (tl V805))) (cons (cons value (cons *property-vector* ())) ()))))) (true V805)))
|
|
76
76
|
|
|
77
|
-
(defun shen.function-macro (
|
|
77
|
+
(defun shen.function-macro (V806) (cond ((and (cons? V806) (and (= function (hd V806)) (and (cons? (tl V806)) (= () (tl (tl V806)))))) (shen.function-abstraction (hd (tl V806)) (arity (hd (tl V806))))) (true V806)))
|
|
78
78
|
|
|
79
|
-
(defun shen.function-abstraction (
|
|
79
|
+
(defun shen.function-abstraction (V807 V808) (cond ((= 0 V808) (cons freeze (cons V807 ()))) ((= -1 V808) (shen.function-abstraction-help V807 1 ())) (true (shen.function-abstraction-help V807 V808 ()))))
|
|
80
80
|
|
|
81
|
-
(defun shen.function-abstraction-help (
|
|
81
|
+
(defun shen.function-abstraction-help (V809 V810 V811) (cond ((= 0 V810) (cons V809 V811)) (true (let X (gensym V) (cons /. (cons X (cons (shen.function-abstraction-help V809 (- V810 1) (append V811 (cons X ()))) ())))))))
|
|
82
82
|
|
|
83
|
-
(defun undefmacro (
|
|
83
|
+
(defun undefmacro (V812) (let MacroReg (value shen.*macroreg*) (let Pos (shen.findpos V812 MacroReg) (let Remove1 (set shen.*macroreg* (remove V812 MacroReg)) (let Remove2 (set *macros* (shen.remove-nth Pos (value *macros*))) V812)))))
|
|
84
84
|
|
|
85
|
-
(defun shen.findpos (
|
|
86
|
-
" shen.a))) ((and (cons?
|
|
85
|
+
(defun shen.findpos (V820 V821) (cond ((= () V821) (simple-error (shen.app V820 " is not a macro
|
|
86
|
+
" shen.a))) ((and (cons? V821) (= (hd V821) V820)) 1) ((cons? V821) (+ 1 (shen.findpos V820 (tl V821)))) (true (shen.f_error shen.findpos))))
|
|
87
87
|
|
|
88
|
-
(defun shen.remove-nth (
|
|
88
|
+
(defun shen.remove-nth (V824 V825) (cond ((and (= 1 V824) (cons? V825)) (tl V825)) ((cons? V825) (cons (hd V825) (shen.remove-nth (- V824 1) (tl V825)))) (true (shen.f_error shen.remove-nth))))
|
|
89
89
|
|
|
90
90
|
|
|
91
91
|
|