shen-ruby 0.4.1 → 0.5.0
Sign up to get free protection for your applications and to get access to all the features.
- data/HISTORY.md +8 -0
- data/MIT_LICENSE.txt +1 -1
- data/README.md +4 -3
- data/lib/kl/primitives/vectors.rb +1 -0
- data/lib/shen_ruby/version.rb +1 -1
- data/shen-ruby.gemspec +1 -1
- data/shen/release/k_lambda/core.kl +67 -59
- data/shen/release/k_lambda/declarations.kl +13 -9
- data/shen/release/k_lambda/load.kl +17 -15
- data/shen/release/k_lambda/macros.kl +33 -31
- data/shen/release/k_lambda/prolog.kl +97 -97
- data/shen/release/k_lambda/reader.kl +71 -63
- data/shen/release/k_lambda/sequent.kl +55 -51
- data/shen/release/k_lambda/sys.kl +107 -102
- data/shen/release/k_lambda/t-star.kl +51 -55
- data/shen/release/k_lambda/toplevel.kl +30 -29
- data/shen/release/k_lambda/track.kl +25 -25
- data/shen/release/k_lambda/types.kl +10 -6
- data/shen/release/k_lambda/writer.kl +24 -20
- data/shen/release/k_lambda/yacc.kl +28 -26
- metadata +3 -3
data/HISTORY.md
CHANGED
|
@@ -1,5 +1,13 @@
|
|
|
1
1
|
# ShenRuby Release History
|
|
2
2
|
|
|
3
|
+
## 0.5.0 - May 12, 2013
|
|
4
|
+
### Features
|
|
5
|
+
- Upgrade to Shen 11
|
|
6
|
+
|
|
7
|
+
### Bug Fixes
|
|
8
|
+
- [KLaSC](https://github.com/gregspurrier/klasc) compliance fixes:
|
|
9
|
+
- absvector now raises an error when applied to a negative number
|
|
10
|
+
|
|
3
11
|
## 0.4.1 - March 21, 2013
|
|
4
12
|
### Features
|
|
5
13
|
- Upgrade to Shen 9.1
|
data/MIT_LICENSE.txt
CHANGED
|
@@ -3,7 +3,7 @@ the 'shen' directory, which is subject to its own license.
|
|
|
3
3
|
|
|
4
4
|
-----
|
|
5
5
|
|
|
6
|
-
Copyright (c) 2012 Greg Spurrier
|
|
6
|
+
Copyright (c) 2012-2013 Greg Spurrier
|
|
7
7
|
|
|
8
8
|
Permission is hereby granted, free of charge, to any person obtaining
|
|
9
9
|
a copy of this software and associated documentation files (the
|
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 11, which was released in May, 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
|
|
|
@@ -26,9 +26,10 @@ Once the gem has been installed, the Shen REPL can be launched via the `srrepl`
|
|
|
26
26
|
Loading.... Completed in 8.61 seconds.
|
|
27
27
|
|
|
28
28
|
Shen 2010, copyright (C) 2010 Mark Tarver
|
|
29
|
-
|
|
29
|
+
released under the Shen license
|
|
30
|
+
www.shenlanguage.org, version 11
|
|
30
31
|
running under Ruby, implementation: ruby 1.9.3
|
|
31
|
-
port 0.
|
|
32
|
+
port 0.5.0 ported by Greg Spurrier
|
|
32
33
|
|
|
33
34
|
|
|
34
35
|
(0-)
|
data/lib/shen_ruby/version.rb
CHANGED
data/shen-ruby.gemspec
CHANGED
|
@@ -12,7 +12,7 @@ Gem::Specification.new do |s|
|
|
|
12
12
|
s.email = ["greg@sourcematters.org"]
|
|
13
13
|
s.homepage = "https://github.com/gregspurrier/shen-ruby"
|
|
14
14
|
s.summary = %q{ShenRuby is a Ruby port of the Shen programming language}
|
|
15
|
-
s.description = %q{ShenRuby is a port of the Shen programming language to Ruby. It currently supports Shen version
|
|
15
|
+
s.description = %q{ShenRuby is a port of the Shen programming language to Ruby. It currently supports Shen version 11.}
|
|
16
16
|
|
|
17
17
|
s.required_ruby_version = ">= 1.9.3"
|
|
18
18
|
|
|
@@ -47,126 +47,134 @@
|
|
|
47
47
|
* explains this license in full. *
|
|
48
48
|
* *
|
|
49
49
|
*****************************************************************************************
|
|
50
|
-
"(defun shen.shen->kl (
|
|
50
|
+
"(defun shen.shen->kl (V607 V608) (compile shen.<define> (cons V607 V608) (lambda X (shen.shen-syntax-error V607 X))))
|
|
51
51
|
|
|
52
|
-
(defun shen.shen-syntax-error (
|
|
52
|
+
(defun shen.shen-syntax-error (V609 V610) (simple-error (cn "syntax error in " (shen.app V609 (cn " here:
|
|
53
53
|
|
|
54
|
-
" (shen.app (shen.next-50 50
|
|
54
|
+
" (shen.app (shen.next-50 50 V610) "
|
|
55
55
|
" shen.a)) shen.a))))
|
|
56
56
|
|
|
57
|
-
(defun shen.<define> (
|
|
57
|
+
(defun shen.<define> (V615) (let Result (let Parse_shen.<name> (shen.<name> V615) (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 (= Result (fail)) (let Result (let Parse_shen.<name> (shen.<name> V615) (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))) (if (= Result (fail)) (fail) Result)) Result)))
|
|
58
58
|
|
|
59
|
-
(defun shen.<name> (
|
|
59
|
+
(defun shen.<name> (V620) (let Result (if (cons? (hd V620)) (let Parse_X (hd (hd V620)) (shen.pair (hd (shen.pair (tl (hd V620)) (shen.hdtl V620))) (if (and (symbol? Parse_X) (not (shen.sysfunc? Parse_X))) Parse_X (simple-error (shen.app Parse_X " is not a legitimate function name.
|
|
60
60
|
" shen.a))))) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
61
61
|
|
|
62
|
-
(defun shen.sysfunc? (
|
|
62
|
+
(defun shen.sysfunc? (V621) (element? V621 (get (intern "shen") shen.external-symbols (value *property-vector*))))
|
|
63
63
|
|
|
64
|
-
(defun shen.<signature> (
|
|
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 (V629) (cond ((and (cons? V629) (and (cons? (tl V629)) (and (= --> (hd (tl V629))) (and (cons? (tl (tl V629))) (and (cons? (tl (tl (tl V629)))) (= --> (hd (tl (tl (tl V629)))))))))) (shen.curry-type (cons (hd V629) (cons --> (cons (tl (tl V629)) ()))))) ((and (cons? V629) (and (= cons (hd V629)) (and (cons? (tl V629)) (and (cons? (tl (tl V629))) (= () (tl (tl (tl V629)))))))) (cons list (cons (shen.curry-type (hd (tl V629))) ()))) ((and (cons? V629) (and (cons? (tl V629)) (and (= * (hd (tl V629))) (and (cons? (tl (tl V629))) (and (cons? (tl (tl (tl V629)))) (= * (hd (tl (tl (tl V629)))))))))) (shen.curry-type (cons (hd V629) (cons * (cons (tl (tl V629)) ()))))) ((cons? V629) (map shen.curry-type V629)) (true V629)))
|
|
67
67
|
|
|
68
|
-
(defun shen.<signature-help> (
|
|
68
|
+
(defun shen.<signature-help> (V634) (let Result (if (cons? (hd V634)) (let Parse_X (hd (hd V634)) (let Parse_shen.<signature-help> (shen.<signature-help> (shen.pair (tl (hd V634)) (shen.hdtl V634))) (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> V634) (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> (V639) (let Result (let Parse_shen.<rule> (shen.<rule> V639) (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> V639) (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> (V644) (let Result (let Parse_shen.<patterns> (shen.<patterns> V644) (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> V644) (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> V644) (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> V644) (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 (V645 V646) (if (V645 V646) (fail) V646))
|
|
75
75
|
|
|
76
|
-
(defun shen.succeeds? (
|
|
76
|
+
(defun shen.succeeds? (V651) (cond ((= V651 (fail)) false) (true true)))
|
|
77
77
|
|
|
78
|
-
(defun shen.<patterns> (
|
|
78
|
+
(defun shen.<patterns> (V656) (let Result (let Parse_shen.<pattern> (shen.<pattern> V656) (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> V656) (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> (V661) (let Result (if (and (cons? (hd V661)) (cons? (hd (hd V661)))) (shen.snd-or-fail (if (and (cons? (hd (shen.pair (hd (hd V661)) (shen.hdtl V661)))) (= @p (hd (hd (shen.pair (hd (hd V661)) (shen.hdtl V661)))))) (let Parse_shen.<pattern1> (shen.<pattern1> (shen.pair (tl (hd (shen.pair (hd (hd V661)) (shen.hdtl V661)))) (shen.hdtl (shen.pair (hd (hd V661)) (shen.hdtl V661))))) (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 V661)) (shen.hdtl V661))) (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 V661)) (cons? (hd (hd V661)))) (shen.snd-or-fail (if (and (cons? (hd (shen.pair (hd (hd V661)) (shen.hdtl V661)))) (= cons (hd (hd (shen.pair (hd (hd V661)) (shen.hdtl V661)))))) (let Parse_shen.<pattern1> (shen.<pattern1> (shen.pair (tl (hd (shen.pair (hd (hd V661)) (shen.hdtl V661)))) (shen.hdtl (shen.pair (hd (hd V661)) (shen.hdtl V661))))) (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 V661)) (shen.hdtl V661))) (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 V661)) (cons? (hd (hd V661)))) (shen.snd-or-fail (if (and (cons? (hd (shen.pair (hd (hd V661)) (shen.hdtl V661)))) (= @v (hd (hd (shen.pair (hd (hd V661)) (shen.hdtl V661)))))) (let Parse_shen.<pattern1> (shen.<pattern1> (shen.pair (tl (hd (shen.pair (hd (hd V661)) (shen.hdtl V661)))) (shen.hdtl (shen.pair (hd (hd V661)) (shen.hdtl V661))))) (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 V661)) (shen.hdtl V661))) (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 V661)) (cons? (hd (hd V661)))) (shen.snd-or-fail (if (and (cons? (hd (shen.pair (hd (hd V661)) (shen.hdtl V661)))) (= @s (hd (hd (shen.pair (hd (hd V661)) (shen.hdtl V661)))))) (let Parse_shen.<pattern1> (shen.<pattern1> (shen.pair (tl (hd (shen.pair (hd (hd V661)) (shen.hdtl V661)))) (shen.hdtl (shen.pair (hd (hd V661)) (shen.hdtl V661))))) (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 V661)) (shen.hdtl V661))) (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 V661)) (cons? (hd (hd V661)))) (shen.snd-or-fail (if (and (cons? (hd (shen.pair (hd (hd V661)) (shen.hdtl V661)))) (= vector (hd (hd (shen.pair (hd (hd V661)) (shen.hdtl V661)))))) (if (and (cons? (hd (shen.pair (tl (hd (shen.pair (hd (hd V661)) (shen.hdtl V661)))) (shen.hdtl (shen.pair (hd (hd V661)) (shen.hdtl V661)))))) (= 0 (hd (hd (shen.pair (tl (hd (shen.pair (hd (hd V661)) (shen.hdtl V661)))) (shen.hdtl (shen.pair (hd (hd V661)) (shen.hdtl V661)))))))) (shen.pair (hd (shen.pair (tl (hd (shen.pair (tl (hd (shen.pair (hd (hd V661)) (shen.hdtl V661)))) (shen.hdtl (shen.pair (hd (hd V661)) (shen.hdtl V661)))))) (shen.hdtl (shen.pair (tl (hd (shen.pair (hd (hd V661)) (shen.hdtl V661)))) (shen.hdtl (shen.pair (hd (hd V661)) (shen.hdtl V661))))))) (shen.pair (hd (shen.pair (tl (hd V661)) (shen.hdtl V661))) (cons vector (cons 0 ())))) (fail)) (fail))) (fail)) (if (= Result (fail)) (let Result (if (cons? (hd V661)) (let Parse_X (hd (hd V661)) (if (cons? Parse_X) (shen.pair (hd (shen.pair (tl (hd V661)) (shen.hdtl V661))) (shen.constructor-error Parse_X)) (fail))) (fail)) (if (= Result (fail)) (let Result (let Parse_shen.<simple_pattern> (shen.<simple_pattern> V661) (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 (V662) (simple-error (shen.app V662 " is not a legitimate constructor
|
|
83
83
|
" shen.a)))
|
|
84
84
|
|
|
85
|
-
(defun shen.<simple_pattern> (
|
|
85
|
+
(defun shen.<simple_pattern> (V667) (let Result (if (cons? (hd V667)) (let Parse_X (hd (hd V667)) (if (= Parse_X _) (shen.pair (hd (shen.pair (tl (hd V667)) (shen.hdtl V667))) (gensym Parse_Y)) (fail))) (fail)) (if (= Result (fail)) (let Result (if (cons? (hd V667)) (let Parse_X (hd (hd V667)) (if (not (element? Parse_X (cons -> (cons <- ())))) (shen.pair (hd (shen.pair (tl (hd V667)) (shen.hdtl V667))) Parse_X) (fail))) (fail)) (if (= Result (fail)) (fail) Result)) Result)))
|
|
86
86
|
|
|
87
|
-
(defun shen.<pattern1> (
|
|
87
|
+
(defun shen.<pattern1> (V672) (let Result (let Parse_shen.<pattern> (shen.<pattern> V672) (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> (V677) (let Result (let Parse_shen.<pattern> (shen.<pattern> V677) (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> (V682) (let Result (if (cons? (hd V682)) (let Parse_X (hd (hd V682)) (shen.pair (hd (shen.pair (tl (hd V682)) (shen.hdtl V682))) Parse_X)) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
92
92
|
|
|
93
|
-
(defun shen.<guard> (
|
|
93
|
+
(defun shen.<guard> (V687) (let Result (if (cons? (hd V687)) (let Parse_X (hd (hd V687)) (shen.pair (hd (shen.pair (tl (hd V687)) (shen.hdtl V687))) Parse_X)) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
94
94
|
|
|
95
|
-
(defun shen.compile_to_machine_code (
|
|
95
|
+
(defun shen.compile_to_machine_code (V688 V689) (let Lambda+ (shen.compile_to_lambda+ V688 V689) (let KL (shen.compile_to_kl V688 Lambda+) (let Record (shen.record-source V688 KL) KL))))
|
|
96
96
|
|
|
97
|
-
(defun shen.record-source (
|
|
97
|
+
(defun shen.record-source (V692 V693) (cond ((value shen.*installing-kl*) shen.skip) (true (put V692 shen.source V693 (value *property-vector*)))))
|
|
98
98
|
|
|
99
|
-
(defun shen.compile_to_lambda+ (
|
|
99
|
+
(defun shen.compile_to_lambda+ (V694 V695) (let Arity (shen.aritycheck V694 V695) (let Free (map (lambda Rule (shen.free_variable_check V694 Rule)) V695) (let Variables (shen.parameters Arity) (let Strip (map shen.strip-protect V695) (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 (V696 V697) (cond ((and (cons? V697) (and (cons? (tl V697)) (= () (tl (tl V697))))) (let Bound (shen.extract_vars (hd V697)) (let Free (shen.extract_free_vars Bound (hd (tl V697))) (shen.free_variable_warnings V696 Free)))) (true (shen.sys-error shen.free_variable_check))))
|
|
102
102
|
|
|
103
|
-
(defun shen.extract_vars (
|
|
103
|
+
(defun shen.extract_vars (V698) (cond ((variable? V698) (cons V698 ())) ((cons? V698) (union (shen.extract_vars (hd V698)) (shen.extract_vars (tl V698)))) (true ())))
|
|
104
104
|
|
|
105
|
-
(defun shen.extract_free_vars (
|
|
105
|
+
(defun shen.extract_free_vars (V708 V709) (cond ((and (cons? V709) (and (cons? (tl V709)) (and (= () (tl (tl V709))) (= (hd V709) protect)))) ()) ((and (variable? V709) (not (element? V709 V708))) (cons V709 ())) ((and (cons? V709) (and (= lambda (hd V709)) (and (cons? (tl V709)) (and (cons? (tl (tl V709))) (= () (tl (tl (tl V709)))))))) (shen.extract_free_vars (cons (hd (tl V709)) V708) (hd (tl (tl V709))))) ((and (cons? V709) (and (= let (hd V709)) (and (cons? (tl V709)) (and (cons? (tl (tl V709))) (and (cons? (tl (tl (tl V709)))) (= () (tl (tl (tl (tl V709)))))))))) (union (shen.extract_free_vars V708 (hd (tl (tl V709)))) (shen.extract_free_vars (cons (hd (tl V709)) V708) (hd (tl (tl (tl V709))))))) ((cons? V709) (union (shen.extract_free_vars V708 (hd V709)) (shen.extract_free_vars V708 (tl V709)))) (true ())))
|
|
106
106
|
|
|
107
|
-
(defun shen.free_variable_warnings (
|
|
107
|
+
(defun shen.free_variable_warnings (V712 V713) (cond ((= () V713) _) (true (simple-error (cn "error: the following variables are free in " (shen.app V712 (cn ": " (shen.app (shen.list_variables V713) "" shen.a)) shen.a))))))
|
|
108
108
|
|
|
109
|
-
(defun shen.list_variables (
|
|
109
|
+
(defun shen.list_variables (V714) (cond ((and (cons? V714) (= () (tl V714))) (cn (str (hd V714)) ".")) ((cons? V714) (cn (str (hd V714)) (cn ", " (shen.list_variables (tl V714))))) (true (shen.sys-error shen.list_variables))))
|
|
110
110
|
|
|
111
|
-
(defun shen.strip-protect (
|
|
111
|
+
(defun shen.strip-protect (V715) (cond ((and (cons? V715) (and (cons? (tl V715)) (and (= () (tl (tl V715))) (= (hd V715) protect)))) (hd (tl V715))) ((cons? V715) (cons (shen.strip-protect (hd V715)) (shen.strip-protect (tl V715)))) (true V715)))
|
|
112
112
|
|
|
113
|
-
(defun shen.linearise (
|
|
113
|
+
(defun shen.linearise (V716) (cond ((and (cons? V716) (and (cons? (tl V716)) (= () (tl (tl V716))))) (shen.linearise_help (shen.flatten (hd V716)) (hd V716) (hd (tl V716)))) (true (shen.sys-error shen.linearise))))
|
|
114
114
|
|
|
115
|
-
(defun shen.flatten (
|
|
115
|
+
(defun shen.flatten (V717) (cond ((= () V717) ()) ((cons? V717) (append (shen.flatten (hd V717)) (shen.flatten (tl V717)))) (true (cons V717 ()))))
|
|
116
116
|
|
|
117
|
-
(defun shen.linearise_help (
|
|
117
|
+
(defun shen.linearise_help (V718 V719 V720) (cond ((= () V718) (cons V719 (cons V720 ()))) ((cons? V718) (if (and (variable? (hd V718)) (element? (hd V718) (tl V718))) (let Var (gensym (hd V718)) (let NewAction (cons where (cons (cons = (cons (hd V718) (cons Var ()))) (cons V720 ()))) (let NewPatts (shen.linearise_X (hd V718) Var V719) (shen.linearise_help (tl V718) NewPatts NewAction)))) (shen.linearise_help (tl V718) V719 V720))) (true (shen.sys-error shen.linearise_help))))
|
|
118
118
|
|
|
119
|
-
(defun shen.linearise_X (
|
|
119
|
+
(defun shen.linearise_X (V729 V730 V731) (cond ((= V731 V729) V730) ((cons? V731) (let L (shen.linearise_X V729 V730 (hd V731)) (if (= L (hd V731)) (cons (hd V731) (shen.linearise_X V729 V730 (tl V731))) (cons L (tl V731))))) (true V731)))
|
|
120
120
|
|
|
121
|
-
(defun shen.aritycheck (
|
|
121
|
+
(defun shen.aritycheck (V733 V734) (cond ((and (cons? V734) (and (cons? (hd V734)) (and (cons? (tl (hd V734))) (and (= () (tl (tl (hd V734)))) (= () (tl V734)))))) (do (shen.aritycheck-action (hd (tl (hd V734)))) (shen.aritycheck-name V733 (arity V733) (length (hd (hd V734)))))) ((and (cons? V734) (and (cons? (hd V734)) (and (cons? (tl (hd V734))) (and (= () (tl (tl (hd V734)))) (and (cons? (tl V734)) (and (cons? (hd (tl V734))) (and (cons? (tl (hd (tl V734)))) (= () (tl (tl (hd (tl V734)))))))))))) (if (= (length (hd (hd V734))) (length (hd (hd (tl V734))))) (do (shen.aritycheck-action (hd (tl (hd V734)))) (shen.aritycheck V733 (tl V734))) (simple-error (cn "arity error in " (shen.app V733 "
|
|
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 (V743 V744 V745) (cond ((= -1 V744) V745) ((= V745 V744) V745) (true (do (shen.prhush (cn "
|
|
125
|
+
warning: changing the arity of " (shen.app V743 " can cause errors.
|
|
126
|
+
" shen.a)) (stoutput)) V745))))
|
|
127
127
|
|
|
128
|
-
(defun shen.aritycheck-action (
|
|
128
|
+
(defun shen.aritycheck-action (V751) (cond ((cons? V751) (do (shen.aah (hd V751) (tl V751)) (map shen.aritycheck-action V751))) (true shen.skip)))
|
|
129
129
|
|
|
130
|
-
(defun shen.aah (
|
|
130
|
+
(defun shen.aah (V752 V753) (let Arity (arity V752) (let Len (length V753) (if (and (> Arity -1) (> Len Arity)) (shen.prhush (cn "warning: " (shen.app V752 (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 (V754) (cond ((and (cons? V754) (and (cons? (tl V754)) (= () (tl (tl V754))))) (shen.abstraction_build (hd V754) (hd (tl V754)))) (true (shen.sys-error shen.abstract_rule))))
|
|
134
134
|
|
|
135
|
-
(defun shen.abstraction_build (
|
|
135
|
+
(defun shen.abstraction_build (V755 V756) (cond ((= () V755) V756) ((cons? V755) (cons /. (cons (hd V755) (cons (shen.abstraction_build (tl V755) V756) ())))) (true (shen.sys-error shen.abstraction_build))))
|
|
136
136
|
|
|
137
|
-
(defun shen.parameters (
|
|
137
|
+
(defun shen.parameters (V757) (cond ((= 0 V757) ()) (true (cons (gensym V) (shen.parameters (- V757 1))))))
|
|
138
138
|
|
|
139
|
-
(defun shen.application_build (
|
|
139
|
+
(defun shen.application_build (V758 V759) (cond ((= () V758) V759) ((cons? V758) (shen.application_build (tl V758) (cons V759 (cons (hd V758) ())))) (true (shen.sys-error shen.application_build))))
|
|
140
140
|
|
|
141
|
-
(defun shen.compile_to_kl (
|
|
141
|
+
(defun shen.compile_to_kl (V760 V761) (cond ((and (cons? V761) (and (cons? (tl V761)) (= () (tl (tl V761))))) (let Arity (shen.store-arity V760 (length (hd V761))) (let Reduce (map shen.reduce (hd (tl V761))) (let CondExpression (shen.cond-expression V760 (hd V761) Reduce) (let TypeTable (if (value shen.*optimise*) (shen.typextable (shen.get-type V760) (hd V761)) shen.skip) (let TypedCondExpression (if (value shen.*optimise*) (shen.assign-types (hd V761) TypeTable CondExpression) CondExpression) (let KL (cons defun (cons V760 (cons (hd V761) (cons TypedCondExpression ())))) KL))))))) (true (shen.sys-error shen.compile_to_kl))))
|
|
142
142
|
|
|
143
|
-
(defun shen.
|
|
143
|
+
(defun shen.get-type (V766) (cond ((cons? V766) shen.skip) (true (let FType (assoc V766 (value shen.*signedfuncs*)) (if (empty? FType) shen.skip (tl FType))))))
|
|
144
144
|
|
|
145
|
-
(defun shen.
|
|
145
|
+
(defun shen.typextable (V775 V776) (cond ((and (cons? V775) (and (cons? (tl V775)) (and (= --> (hd (tl V775))) (and (cons? (tl (tl V775))) (and (= () (tl (tl (tl V775)))) (cons? V776)))))) (if (variable? (hd V775)) (shen.typextable (hd (tl (tl V775))) (tl V776)) (cons (cons (hd V776) (hd V775)) (shen.typextable (hd (tl (tl V775))) (tl V776))))) (true ())))
|
|
146
146
|
|
|
147
|
-
(defun shen.
|
|
147
|
+
(defun shen.assign-types (V777 V778 V779) (cond ((and (cons? V779) (and (= let (hd V779)) (and (cons? (tl V779)) (and (cons? (tl (tl V779))) (and (cons? (tl (tl (tl V779)))) (= () (tl (tl (tl (tl V779)))))))))) (cons let (cons (hd (tl V779)) (cons (shen.assign-types V777 V778 (hd (tl (tl V779)))) (cons (shen.assign-types (cons (hd (tl V779)) V777) V778 (hd (tl (tl (tl V779))))) ()))))) ((and (cons? V779) (and (= lambda (hd V779)) (and (cons? (tl V779)) (and (cons? (tl (tl V779))) (= () (tl (tl (tl V779)))))))) (cons lambda (cons (hd (tl V779)) (cons (shen.assign-types (cons (hd (tl V779)) V777) V778 (hd (tl (tl V779)))) ())))) ((and (cons? V779) (= cond (hd V779))) (cons cond (map (lambda Y (cons (shen.assign-types V777 V778 (hd Y)) (cons (shen.assign-types V777 V778 (hd (tl Y))) ()))) (tl V779)))) ((cons? V779) (let NewTable (shen.typextable (shen.get-type (hd V779)) (tl V779)) (cons (hd V779) (map (lambda Y (shen.assign-types V777 (append V778 NewTable) Y)) (tl V779))))) (true (let AtomType (assoc V779 V778) (if (cons? AtomType) (cons type (cons V779 (cons (tl AtomType) ()))) (if (element? V779 V777) V779 (shen.atom-type V779)))))))
|
|
148
148
|
|
|
149
|
-
(defun shen
|
|
149
|
+
(defun shen.atom-type (V780) (if (string? V780) (cons type (cons V780 (cons string ()))) (if (number? V780) (cons type (cons V780 (cons number ()))) (if (boolean? V780) (cons type (cons V780 (cons boolean ()))) (if (symbol? V780) (cons type (cons V780 (cons symbol ()))) V780)))))
|
|
150
150
|
|
|
151
|
-
(defun shen
|
|
151
|
+
(defun shen.store-arity (V783 V784) (cond ((value shen.*installing-kl*) shen.skip) (true (put V783 arity V784 (value *property-vector*)))))
|
|
152
152
|
|
|
153
|
-
(defun shen.
|
|
153
|
+
(defun shen.reduce (V785) (do (set shen.*teststack* ()) (let Result (shen.reduce_help V785) (cons (cons : (cons shen.tests (reverse (value shen.*teststack*)))) (cons Result ())))))
|
|
154
154
|
|
|
155
|
-
(defun shen.add_test (
|
|
155
|
+
(defun shen.reduce_help (V786) (cond ((and (cons? V786) (and (cons? (hd V786)) (and (= /. (hd (hd V786))) (and (cons? (tl (hd V786))) (and (cons? (hd (tl (hd V786)))) (and (= cons (hd (hd (tl (hd V786))))) (and (cons? (tl (hd (tl (hd V786))))) (and (cons? (tl (tl (hd (tl (hd V786)))))) (and (= () (tl (tl (tl (hd (tl (hd V786))))))) (and (cons? (tl (tl (hd V786)))) (and (= () (tl (tl (tl (hd V786))))) (and (cons? (tl V786)) (= () (tl (tl V786))))))))))))))) (do (shen.add_test (cons cons? (tl V786))) (let Abstraction (cons /. (cons (hd (tl (hd (tl (hd V786))))) (cons (cons /. (cons (hd (tl (tl (hd (tl (hd V786)))))) (cons (shen.ebr (hd (tl V786)) (hd (tl (hd V786))) (hd (tl (tl (hd V786))))) ()))) ()))) (let Application (cons (cons Abstraction (cons (cons hd (tl V786)) ())) (cons (cons tl (tl V786)) ())) (shen.reduce_help Application))))) ((and (cons? V786) (and (cons? (hd V786)) (and (= /. (hd (hd V786))) (and (cons? (tl (hd V786))) (and (cons? (hd (tl (hd V786)))) (and (= @p (hd (hd (tl (hd V786))))) (and (cons? (tl (hd (tl (hd V786))))) (and (cons? (tl (tl (hd (tl (hd V786)))))) (and (= () (tl (tl (tl (hd (tl (hd V786))))))) (and (cons? (tl (tl (hd V786)))) (and (= () (tl (tl (tl (hd V786))))) (and (cons? (tl V786)) (= () (tl (tl V786))))))))))))))) (do (shen.add_test (cons tuple? (tl V786))) (let Abstraction (cons /. (cons (hd (tl (hd (tl (hd V786))))) (cons (cons /. (cons (hd (tl (tl (hd (tl (hd V786)))))) (cons (shen.ebr (hd (tl V786)) (hd (tl (hd V786))) (hd (tl (tl (hd V786))))) ()))) ()))) (let Application (cons (cons Abstraction (cons (cons fst (tl V786)) ())) (cons (cons snd (tl V786)) ())) (shen.reduce_help Application))))) ((and (cons? V786) (and (cons? (hd V786)) (and (= /. (hd (hd V786))) (and (cons? (tl (hd V786))) (and (cons? (hd (tl (hd V786)))) (and (= @v (hd (hd (tl (hd V786))))) (and (cons? (tl (hd (tl (hd V786))))) (and (cons? (tl (tl (hd (tl (hd V786)))))) (and (= () (tl (tl (tl (hd (tl (hd V786))))))) (and (cons? (tl (tl (hd V786)))) (and (= () (tl (tl (tl (hd V786))))) (and (cons? (tl V786)) (= () (tl (tl V786))))))))))))))) (do (shen.add_test (cons shen.+vector? (tl V786))) (let Abstraction (cons /. (cons (hd (tl (hd (tl (hd V786))))) (cons (cons /. (cons (hd (tl (tl (hd (tl (hd V786)))))) (cons (shen.ebr (hd (tl V786)) (hd (tl (hd V786))) (hd (tl (tl (hd V786))))) ()))) ()))) (let Application (cons (cons Abstraction (cons (cons hdv (tl V786)) ())) (cons (cons tlv (tl V786)) ())) (shen.reduce_help Application))))) ((and (cons? V786) (and (cons? (hd V786)) (and (= /. (hd (hd V786))) (and (cons? (tl (hd V786))) (and (cons? (hd (tl (hd V786)))) (and (= @s (hd (hd (tl (hd V786))))) (and (cons? (tl (hd (tl (hd V786))))) (and (cons? (tl (tl (hd (tl (hd V786)))))) (and (= () (tl (tl (tl (hd (tl (hd V786))))))) (and (cons? (tl (tl (hd V786)))) (and (= () (tl (tl (tl (hd V786))))) (and (cons? (tl V786)) (= () (tl (tl V786))))))))))))))) (do (shen.add_test (cons shen.+string? (tl V786))) (let Abstraction (cons /. (cons (hd (tl (hd (tl (hd V786))))) (cons (cons /. (cons (hd (tl (tl (hd (tl (hd V786)))))) (cons (shen.ebr (hd (tl V786)) (hd (tl (hd V786))) (hd (tl (tl (hd V786))))) ()))) ()))) (let Application (cons (cons Abstraction (cons (cons pos (cons (hd (tl V786)) (cons 0 ()))) ())) (cons (cons tlstr (tl V786)) ())) (shen.reduce_help Application))))) ((and (cons? V786) (and (cons? (hd V786)) (and (= /. (hd (hd V786))) (and (cons? (tl (hd V786))) (and (cons? (tl (tl (hd V786)))) (and (= () (tl (tl (tl (hd V786))))) (and (cons? (tl V786)) (and (= () (tl (tl V786))) (not (variable? (hd (tl (hd V786))))))))))))) (do (shen.add_test (cons = (cons (hd (tl (hd V786))) (tl V786)))) (shen.reduce_help (hd (tl (tl (hd V786))))))) ((and (cons? V786) (and (cons? (hd V786)) (and (= /. (hd (hd V786))) (and (cons? (tl (hd V786))) (and (cons? (tl (tl (hd V786)))) (and (= () (tl (tl (tl (hd V786))))) (and (cons? (tl V786)) (= () (tl (tl V786)))))))))) (shen.reduce_help (shen.ebr (hd (tl V786)) (hd (tl (hd V786))) (hd (tl (tl (hd V786))))))) ((and (cons? V786) (and (= where (hd V786)) (and (cons? (tl V786)) (and (cons? (tl (tl V786))) (= () (tl (tl (tl V786)))))))) (do (shen.add_test (hd (tl V786))) (shen.reduce_help (hd (tl (tl V786)))))) ((and (cons? V786) (and (cons? (tl V786)) (= () (tl (tl V786))))) (let Z (shen.reduce_help (hd V786)) (if (= (hd V786) Z) V786 (shen.reduce_help (cons Z (tl V786)))))) (true V786)))
|
|
156
156
|
|
|
157
|
-
(defun shen
|
|
157
|
+
(defun shen.+string? (V787) (cond ((= "" V787) false) (true (string? V787))))
|
|
158
158
|
|
|
159
|
-
(defun shen
|
|
159
|
+
(defun shen.+vector (V788) (cond ((= V788 (vector 0)) false) (true (vector? V788))))
|
|
160
160
|
|
|
161
|
-
(defun shen.
|
|
161
|
+
(defun shen.ebr (V797 V798 V799) (cond ((= V799 V798) V797) ((and (cons? V799) (and (= /. (hd V799)) (and (cons? (tl V799)) (and (cons? (tl (tl V799))) (and (= () (tl (tl (tl V799)))) (> (occurrences V798 (hd (tl V799))) 0)))))) V799) ((and (cons? V799) (and (= let (hd V799)) (and (cons? (tl V799)) (and (cons? (tl (tl V799))) (and (cons? (tl (tl (tl V799)))) (and (= () (tl (tl (tl (tl V799))))) (= (hd (tl V799)) V798))))))) (cons let (cons (hd (tl V799)) (cons (shen.ebr V797 (hd (tl V799)) (hd (tl (tl V799)))) (tl (tl (tl V799))))))) ((cons? V799) (cons (shen.ebr V797 V798 (hd V799)) (shen.ebr V797 V798 (tl V799)))) (true V799)))
|
|
162
162
|
|
|
163
|
-
(defun shen.
|
|
163
|
+
(defun shen.add_test (V802) (set shen.*teststack* (cons V802 (value shen.*teststack*))))
|
|
164
164
|
|
|
165
|
-
(defun shen.
|
|
165
|
+
(defun shen.cond-expression (V803 V804 V805) (let Err (shen.err-condition V803) (let Cases (shen.case-form V805 Err) (let EncodeChoices (shen.encode-choices Cases V803) (shen.cond-form EncodeChoices)))))
|
|
166
166
|
|
|
167
|
-
(defun shen.
|
|
167
|
+
(defun shen.cond-form (V808) (cond ((and (cons? V808) (and (cons? (hd V808)) (and (= true (hd (hd V808))) (and (cons? (tl (hd V808))) (= () (tl (tl (hd V808)))))))) (hd (tl (hd V808)))) (true (cons cond V808))))
|
|
168
168
|
|
|
169
|
-
(defun shen.sys-error (
|
|
169
|
+
(defun shen.encode-choices (V811 V812) (cond ((= () V811) ()) ((and (cons? V811) (and (cons? (hd V811)) (and (= true (hd (hd V811))) (and (cons? (tl (hd V811))) (and (cons? (hd (tl (hd V811)))) (and (= shen.choicepoint! (hd (hd (tl (hd V811))))) (and (cons? (tl (hd (tl (hd V811))))) (and (= () (tl (tl (hd (tl (hd V811)))))) (and (= () (tl (tl (hd V811)))) (= () (tl V811))))))))))) (cons (cons true (cons (cons let (cons Result (cons (hd (tl (hd (tl (hd V811))))) (cons (cons if (cons (cons = (cons Result (cons (cons fail ()) ()))) (cons (if (value shen.*installing-kl*) (cons shen.sys-error (cons V812 ())) (cons shen.f_error (cons V812 ()))) (cons Result ())))) ())))) ())) ())) ((and (cons? V811) (and (cons? (hd V811)) (and (= true (hd (hd V811))) (and (cons? (tl (hd V811))) (and (cons? (hd (tl (hd V811)))) (and (= shen.choicepoint! (hd (hd (tl (hd V811))))) (and (cons? (tl (hd (tl (hd V811))))) (and (= () (tl (tl (hd (tl (hd V811)))))) (= () (tl (tl (hd V811)))))))))))) (cons (cons true (cons (cons let (cons Result (cons (hd (tl (hd (tl (hd V811))))) (cons (cons if (cons (cons = (cons Result (cons (cons fail ()) ()))) (cons (shen.cond-form (shen.encode-choices (tl V811) V812)) (cons Result ())))) ())))) ())) ())) ((and (cons? V811) (and (cons? (hd V811)) (and (cons? (tl (hd V811))) (and (cons? (hd (tl (hd V811)))) (and (= shen.choicepoint! (hd (hd (tl (hd V811))))) (and (cons? (tl (hd (tl (hd V811))))) (and (= () (tl (tl (hd (tl (hd V811)))))) (= () (tl (tl (hd V811))))))))))) (cons (cons true (cons (cons let (cons Freeze (cons (cons freeze (cons (shen.cond-form (shen.encode-choices (tl V811) V812)) ())) (cons (cons if (cons (hd (hd V811)) (cons (cons let (cons Result (cons (hd (tl (hd (tl (hd V811))))) (cons (cons if (cons (cons = (cons Result (cons (cons fail ()) ()))) (cons (cons thaw (cons Freeze ())) (cons Result ())))) ())))) (cons (cons thaw (cons Freeze ())) ())))) ())))) ())) ())) ((and (cons? V811) (and (cons? (hd V811)) (and (cons? (tl (hd V811))) (= () (tl (tl (hd V811))))))) (cons (hd V811) (shen.encode-choices (tl V811) V812))) (true (shen.sys-error shen.encode-choices))))
|
|
170
|
+
|
|
171
|
+
(defun shen.case-form (V817 V818) (cond ((= () V817) (cons V818 ())) ((and (cons? V817) (and (cons? (hd V817)) (and (cons? (hd (hd V817))) (and (= : (hd (hd (hd V817)))) (and (cons? (tl (hd (hd V817)))) (and (= shen.tests (hd (tl (hd (hd V817))))) (and (= () (tl (tl (hd (hd V817))))) (and (cons? (tl (hd V817))) (and (cons? (hd (tl (hd V817)))) (and (= shen.choicepoint! (hd (hd (tl (hd V817))))) (and (cons? (tl (hd (tl (hd V817))))) (and (= () (tl (tl (hd (tl (hd V817)))))) (= () (tl (tl (hd V817)))))))))))))))) (cons (cons true (tl (hd V817))) (shen.case-form (tl V817) V818))) ((and (cons? V817) (and (cons? (hd V817)) (and (cons? (hd (hd V817))) (and (= : (hd (hd (hd V817)))) (and (cons? (tl (hd (hd V817)))) (and (= shen.tests (hd (tl (hd (hd V817))))) (and (= () (tl (tl (hd (hd V817))))) (and (cons? (tl (hd V817))) (= () (tl (tl (hd V817)))))))))))) (cons (cons true (tl (hd V817))) ())) ((and (cons? V817) (and (cons? (hd V817)) (and (cons? (hd (hd V817))) (and (= : (hd (hd (hd V817)))) (and (cons? (tl (hd (hd V817)))) (and (= shen.tests (hd (tl (hd (hd V817))))) (and (cons? (tl (hd V817))) (= () (tl (tl (hd V817))))))))))) (cons (cons (shen.embed-and (tl (tl (hd (hd V817))))) (tl (hd V817))) (shen.case-form (tl V817) V818))) (true (shen.sys-error shen.case-form))))
|
|
172
|
+
|
|
173
|
+
(defun shen.embed-and (V819) (cond ((and (cons? V819) (= () (tl V819))) (hd V819)) ((cons? V819) (cons and (cons (hd V819) (cons (shen.embed-and (tl V819)) ())))) (true (shen.sys-error shen.embed-and))))
|
|
174
|
+
|
|
175
|
+
(defun shen.err-condition (V820) (cons true (cons (cons shen.f_error (cons V820 ())) ())))
|
|
176
|
+
|
|
177
|
+
(defun shen.sys-error (V821) (simple-error (cn "system function " (shen.app V821 ": unexpected argument
|
|
170
178
|
" shen.a))))
|
|
171
179
|
|
|
172
180
|
|
|
@@ -75,7 +75,7 @@
|
|
|
75
75
|
|
|
76
76
|
(set shen.*special* (cons @p (cons @s (cons @v (cons cons (cons lambda (cons let (cons type (cons where (cons set (cons open ())))))))))))
|
|
77
77
|
|
|
78
|
-
(set shen.*extraspecial* (cons define (cons shen.process-datatype (cons input+ (cons defcc ())))))
|
|
78
|
+
(set shen.*extraspecial* (cons define (cons shen.process-datatype (cons input+ (cons defcc (cons read+ ()))))))
|
|
79
79
|
|
|
80
80
|
(set shen.*spy* false)
|
|
81
81
|
|
|
@@ -105,21 +105,25 @@
|
|
|
105
105
|
|
|
106
106
|
(set shen.*infs* 0)
|
|
107
107
|
|
|
108
|
-
(
|
|
108
|
+
(set *hush* false)
|
|
109
109
|
|
|
110
|
-
(
|
|
110
|
+
(set shen.*optimise* false)
|
|
111
111
|
|
|
112
|
-
(shen.initialise_arity_table (
|
|
112
|
+
(defun shen.initialise_arity_table (V822) (cond ((= () V822) ()) ((and (cons? V822) (cons? (tl V822))) (let DecArity (put (hd V822) arity (hd (tl V822)) (value *property-vector*)) (shen.initialise_arity_table (tl (tl V822))))) (true (shen.sys-error shen.initialise_arity_table))))
|
|
113
113
|
|
|
114
|
-
(defun
|
|
114
|
+
(defun arity (V823) (trap-error (get V823 arity (value *property-vector*)) (lambda E -1)))
|
|
115
115
|
|
|
116
|
-
(
|
|
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 length (cons 1 (cons lineread (cons 0 (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-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-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
|
-
(
|
|
118
|
+
(defun systemf (V824) (let Shen (intern "shen") (let External (get Shen shen.external-symbols (value *property-vector*)) (put Shen shen.external-symbols (adjoin V824 External) (value *property-vector*)))))
|
|
119
119
|
|
|
120
|
-
(defun
|
|
120
|
+
(defun adjoin (V825 V826) (if (element? V825 V826) V826 (cons V825 V826)))
|
|
121
121
|
|
|
122
|
-
(
|
|
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 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
|
+
|
|
124
|
+
(defun specialise (V827) (do (set shen.*special* (cons V827 (value shen.*special*))) V827))
|
|
125
|
+
|
|
126
|
+
(defun unspecialise (V828) (do (set shen.*special* (remove V828 (value shen.*special*))) V828))
|
|
123
127
|
|
|
124
128
|
|
|
125
129
|
|
|
@@ -47,36 +47,38 @@
|
|
|
47
47
|
* explains this license in full. *
|
|
48
48
|
* *
|
|
49
49
|
*****************************************************************************************
|
|
50
|
-
"(defun load (
|
|
50
|
+
"(defun load (V829) (let Load (let Start (get-time run) (let Result (shen.load-help (value shen.*tc*) (read-file V829)) (let Finish (get-time run) (let Time (- Finish Start) (let Message (shen.prhush (cn "
|
|
51
51
|
run time: " (cn (str Time) " secs
|
|
52
|
-
")) (stoutput)) Result))))) (let Infs (if (value shen.*tc*) (
|
|
52
|
+
")) (stoutput)) Result))))) (let Infs (if (value shen.*tc*) (shen.prhush (cn "
|
|
53
53
|
typechecked in " (shen.app (inferences) " inferences
|
|
54
54
|
" shen.a)) (stoutput)) shen.skip) loaded)))
|
|
55
55
|
|
|
56
|
-
(defun shen.load-help (
|
|
57
|
-
" shen.s) (stoutput)))
|
|
56
|
+
(defun shen.load-help (V834 V835) (cond ((= false V834) (map (lambda X (shen.prhush (shen.app (shen.eval-without-macros X) "
|
|
57
|
+
" shen.s) (stoutput))) V835)) (true (let RemoveSynonyms (mapcan shen.remove-synonyms V835) (let Table (mapcan shen.typetable RemoveSynonyms) (let Assume (map shen.assumetype Table) (trap-error (map shen.typecheck-and-load RemoveSynonyms) (lambda E (shen.unwind-types E Table)))))))))
|
|
58
58
|
|
|
59
|
-
(defun shen.remove-synonyms (
|
|
59
|
+
(defun shen.remove-synonyms (V836) (cond ((and (cons? V836) (= shen.synonyms-help (hd V836))) (do (eval V836) ())) (true (cons V836 ()))))
|
|
60
60
|
|
|
61
|
-
(defun shen.typecheck-and-load (
|
|
61
|
+
(defun shen.typecheck-and-load (V837) (do (nl 1) (shen.typecheck-and-evaluate V837 (gensym A))))
|
|
62
62
|
|
|
63
|
-
(defun shen.typetable (
|
|
64
|
-
" shen.a)) (cons (cons (hd (tl
|
|
63
|
+
(defun shen.typetable (V846) (cond ((and (cons? V846) (and (= define (hd V846)) (cons? (tl V846)))) (let Sig (compile shen.<sig+rest> (tl (tl V846)) ()) (if (= Sig (fail)) (simple-error (shen.app (hd (tl V846)) " lacks a proper signature.
|
|
64
|
+
" shen.a)) (cons (cons (hd (tl V846)) Sig) ())))) ((and (cons? V846) (and (= defcc (hd V846)) (and (cons? (tl V846)) (and (cons? (tl (tl V846))) (and (= { (hd (tl (tl V846)))) (and (cons? (tl (tl (tl V846)))) (and (cons? (hd (tl (tl (tl V846))))) (and (= list (hd (hd (tl (tl (tl V846)))))) (and (cons? (tl (hd (tl (tl (tl V846)))))) (and (= () (tl (tl (hd (tl (tl (tl V846))))))) (and (cons? (tl (tl (tl (tl V846))))) (and (= ==> (hd (tl (tl (tl (tl V846)))))) (and (cons? (tl (tl (tl (tl (tl V846)))))) (and (cons? (tl (tl (tl (tl (tl (tl V846))))))) (= } (hd (tl (tl (tl (tl (tl (tl V846)))))))))))))))))))))) (cons (cons (hd (tl V846)) (cons (hd (tl (tl (tl V846)))) (cons ==> (cons (hd (tl (tl (tl (tl (tl V846)))))) ())))) ())) ((and (cons? V846) (and (= defcc (hd V846)) (cons? (tl V846)))) (simple-error (shen.app (hd (tl V846)) " lacks a proper signature.
|
|
65
65
|
" shen.a))) (true ())))
|
|
66
66
|
|
|
67
|
-
(defun shen.assumetype (
|
|
67
|
+
(defun shen.assumetype (V847) (cond ((cons? V847) (declare (hd V847) (tl V847))) (true (shen.sys-error shen.assumetype))))
|
|
68
68
|
|
|
69
|
-
(defun shen.unwind-types (
|
|
69
|
+
(defun shen.unwind-types (V852 V853) (cond ((= () V853) (simple-error (error-to-string V852))) ((and (cons? V853) (cons? (hd V853))) (do (shen.remtype (hd (hd V853))) (shen.unwind-types V852 (tl V853)))) (true (shen.sys-error shen.unwind-types))))
|
|
70
70
|
|
|
71
|
-
(defun shen.remtype (
|
|
71
|
+
(defun shen.remtype (V854) (set shen.*signedfuncs* (shen.removetype V854 (value shen.*signedfuncs*))))
|
|
72
72
|
|
|
73
|
-
(defun shen
|
|
73
|
+
(defun shen.removetype (V859 V860) (cond ((= () V860) ()) ((and (cons? V860) (and (cons? (hd V860)) (= (hd (hd V860)) V859))) (shen.removetype (hd (hd V860)) (tl V860))) ((cons? V860) (cons (hd V860) (shen.removetype V859 (tl V860)))) (true (shen.sys-error shen.removetype))))
|
|
74
74
|
|
|
75
|
-
(defun
|
|
75
|
+
(defun shen.<sig+rest> (V866) (let Result (let Parse_shen.<signature> (shen.<signature> V866) (if (not (= (fail) Parse_shen.<signature>)) (let Parse_<!> (<!> Parse_shen.<signature>) (if (not (= (fail) Parse_<!>)) (shen.pair (hd Parse_<!>) (shen.hdtl Parse_shen.<signature>)) (fail))) (fail))) (if (= Result (fail)) (fail) Result)))
|
|
76
76
|
|
|
77
|
-
|
|
77
|
+
(defun write-to-file (V867 V868) (let Stream (open file V867 out) (let String (if (string? V868) (shen.app V868 "
|
|
78
78
|
|
|
79
|
-
" shen.
|
|
79
|
+
" shen.a) (shen.app V868 "
|
|
80
|
+
|
|
81
|
+
" shen.s)) (let Write (pr String Stream) (let Close (close Stream) V868)))))
|
|
80
82
|
|
|
81
83
|
|
|
82
84
|
|
|
@@ -47,68 +47,70 @@
|
|
|
47
47
|
* explains this license in full. *
|
|
48
48
|
* *
|
|
49
49
|
*****************************************************************************************
|
|
50
|
-
"(defun macroexpand (
|
|
50
|
+
"(defun macroexpand (V869) (let Y (shen.compose (value *macros*) V869) (if (= V869 Y) V869 (shen.walk macroexpand Y))))
|
|
51
51
|
|
|
52
52
|
(set *macros* (cons shen.timer-macro (cons shen.cases-macro (cons shen.abs-macro (cons shen.put/get-macro (cons shen.compile-macro (cons shen.datatype-macro (cons shen.let-macro (cons shen.assoc-macro (cons shen.make-string-macro (cons shen.output-macro (cons shen.error-macro (cons shen.prolog-macro (cons shen.synonyms-macro (cons shen.nl-macro (cons shen.@s-macro (cons shen.defmacro-macro (cons shen.defprolog-macro (cons shen.function-macro ())))))))))))))))))))
|
|
53
53
|
|
|
54
|
-
(defun shen.error-macro (
|
|
54
|
+
(defun shen.error-macro (V870) (cond ((and (cons? V870) (and (= error (hd V870)) (cons? (tl V870)))) (cons simple-error (cons (shen.mkstr (hd (tl V870)) (tl (tl V870))) ()))) (true V870)))
|
|
55
55
|
|
|
56
|
-
(defun shen.output-macro (
|
|
56
|
+
(defun shen.output-macro (V871) (cond ((and (cons? V871) (and (= output (hd V871)) (cons? (tl V871)))) (cons shen.prhush (cons (shen.mkstr (hd (tl V871)) (tl (tl V871))) (cons (cons stoutput ()) ())))) (true V871)))
|
|
57
57
|
|
|
58
|
-
(defun shen.make-string-macro (
|
|
58
|
+
(defun shen.make-string-macro (V872) (cond ((and (cons? V872) (and (= make-string (hd V872)) (cons? (tl V872)))) (shen.mkstr (hd (tl V872)) (tl (tl V872)))) (true V872)))
|
|
59
59
|
|
|
60
|
-
(defun shen.compose (
|
|
60
|
+
(defun shen.compose (V873 V874) (cond ((= () V873) V874) ((cons? V873) (shen.compose (tl V873) ((hd V873) V874))) (true (shen.sys-error shen.compose))))
|
|
61
61
|
|
|
62
|
-
(defun shen.compile-macro (
|
|
62
|
+
(defun shen.compile-macro (V875) (cond ((and (cons? V875) (and (= compile (hd V875)) (and (cons? (tl V875)) (and (cons? (tl (tl V875))) (= () (tl (tl (tl V875)))))))) (cons compile (cons (hd (tl V875)) (cons (hd (tl (tl V875))) (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 V875)))
|
|
63
63
|
|
|
64
|
-
(defun shen.prolog-macro (
|
|
64
|
+
(defun shen.prolog-macro (V876) (cond ((and (cons? V876) (= prolog? (hd V876))) (cons shen.intprolog (cons (shen.prolog-form (tl V876)) ()))) (true V876)))
|
|
65
65
|
|
|
66
|
-
(defun shen.defprolog-macro (
|
|
66
|
+
(defun shen.defprolog-macro (V877) (cond ((and (cons? V877) (and (= defprolog (hd V877)) (cons? (tl V877)))) (compile shen.<defprolog> (tl V877) (lambda Y (shen.prolog-error (hd (tl V877)) Y)))) (true V877)))
|
|
67
67
|
|
|
68
|
-
(defun shen.prolog-form (
|
|
68
|
+
(defun shen.prolog-form (V878) (shen.cons_form (map shen.cons_form V878)))
|
|
69
69
|
|
|
70
|
-
(defun shen.datatype-macro (
|
|
70
|
+
(defun shen.datatype-macro (V879) (cond ((and (cons? V879) (and (= datatype (hd V879)) (cons? (tl V879)))) (cons shen.process-datatype (cons (shen.intern-type (hd (tl V879))) (cons (cons compile (cons (cons function (cons shen.<datatype-rules> ())) (cons (shen.rcons_form (tl (tl V879))) (cons (cons function (cons shen.datatype-error ())) ())))) ())))) (true V879)))
|
|
71
71
|
|
|
72
|
-
(defun shen.
|
|
72
|
+
(defun shen.intern-type (V880) (intern (cn "type#" (str V880))))
|
|
73
73
|
|
|
74
|
-
(defun shen
|
|
74
|
+
(defun shen.defmacro-macro (V881) (cond ((and (cons? V881) (and (= defmacro (hd V881)) (cons? (tl V881)))) (let Macro (cons define (cons (hd (tl V881)) (append (tl (tl V881)) (cons X (cons -> (cons X ())))))) (let Declare (cons do (cons (cons set (cons *macros* (cons (cons adjoin (cons (hd (tl V881)) (cons (cons value (cons *macros* ())) ()))) ()))) (cons macro ()))) (let Package (cons package (cons null (cons () (cons Declare (cons Macro ()))))) Package)))) (true V881)))
|
|
75
75
|
|
|
76
|
-
(defun shen.<
|
|
76
|
+
(defun shen.<defmacro> (V886) (let Result (let Parse_shen.<name> (shen.<name> V886) (if (not (= (fail) Parse_shen.<name>)) (let Parse_shen.<macrorules> (shen.<macrorules> Parse_shen.<name>) (if (not (= (fail) Parse_shen.<macrorules>)) (shen.pair (hd Parse_shen.<macrorules>) (cons define (cons (shen.hdtl Parse_shen.<name>) (shen.hdtl Parse_shen.<macrorules>)))) (fail))) (fail))) (if (= Result (fail)) (fail) Result)))
|
|
77
77
|
|
|
78
|
-
(defun shen.<
|
|
78
|
+
(defun shen.<macrorules> (V891) (let Result (let Parse_shen.<macrorule> (shen.<macrorule> V891) (if (not (= (fail) Parse_shen.<macrorule>)) (let Parse_shen.<macrorules> (shen.<macrorules> Parse_shen.<macrorule>) (if (not (= (fail) Parse_shen.<macrorules>)) (shen.pair (hd Parse_shen.<macrorules>) (append (shen.hdtl Parse_shen.<macrorule>) (append (shen.hdtl Parse_shen.<macrorules>) ()))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<macrorule> (shen.<macrorule> V891) (if (not (= (fail) Parse_shen.<macrorule>)) (shen.pair (hd Parse_shen.<macrorule>) (append (shen.hdtl Parse_shen.<macrorule>) (cons Parse_X (cons -> (cons Parse_X ()))))) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
|
|
79
79
|
|
|
80
|
-
(defun shen.<macroaction> (
|
|
80
|
+
(defun shen.<macrorule> (V896) (let Result (let Parse_shen.<patterns> (shen.<patterns> V896) (if (not (= (fail) Parse_shen.<patterns>)) (if (and (cons? (hd Parse_shen.<patterns>)) (= -> (hd (hd Parse_shen.<patterns>)))) (let Parse_shen.<macroaction> (shen.<macroaction> (shen.pair (tl (hd Parse_shen.<patterns>)) (shen.hdtl Parse_shen.<patterns>))) (if (not (= (fail) Parse_shen.<macroaction>)) (if (and (cons? (hd Parse_shen.<macroaction>)) (= where (hd (hd Parse_shen.<macroaction>)))) (let Parse_shen.<guard> (shen.<guard> (shen.pair (tl (hd Parse_shen.<macroaction>)) (shen.hdtl Parse_shen.<macroaction>))) (if (not (= (fail) Parse_shen.<guard>)) (shen.pair (hd Parse_shen.<guard>) (append (shen.hdtl Parse_shen.<patterns>) (cons -> (append (shen.hdtl Parse_shen.<macroaction>) (cons where (append (shen.hdtl Parse_shen.<guard>) ())))))) (fail))) (fail)) (fail))) (fail)) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<patterns> (shen.<patterns> V896) (if (not (= (fail) Parse_shen.<patterns>)) (if (and (cons? (hd Parse_shen.<patterns>)) (= -> (hd (hd Parse_shen.<patterns>)))) (let Parse_shen.<macroaction> (shen.<macroaction> (shen.pair (tl (hd Parse_shen.<patterns>)) (shen.hdtl Parse_shen.<patterns>))) (if (not (= (fail) Parse_shen.<macroaction>)) (shen.pair (hd Parse_shen.<macroaction>) (append (shen.hdtl Parse_shen.<patterns>) (cons -> (append (shen.hdtl Parse_shen.<macroaction>) ())))) (fail))) (fail)) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<patterns> (shen.<patterns> V896) (if (not (= (fail) Parse_shen.<patterns>)) (if (and (cons? (hd Parse_shen.<patterns>)) (= <- (hd (hd Parse_shen.<patterns>)))) (let Parse_shen.<macroaction> (shen.<macroaction> (shen.pair (tl (hd Parse_shen.<patterns>)) (shen.hdtl Parse_shen.<patterns>))) (if (not (= (fail) Parse_shen.<macroaction>)) (if (and (cons? (hd Parse_shen.<macroaction>)) (= where (hd (hd Parse_shen.<macroaction>)))) (let Parse_shen.<guard> (shen.<guard> (shen.pair (tl (hd Parse_shen.<macroaction>)) (shen.hdtl Parse_shen.<macroaction>))) (if (not (= (fail) Parse_shen.<guard>)) (shen.pair (hd Parse_shen.<guard>) (append (shen.hdtl Parse_shen.<patterns>) (cons <- (append (shen.hdtl Parse_shen.<macroaction>) (cons where (append (shen.hdtl Parse_shen.<guard>) ())))))) (fail))) (fail)) (fail))) (fail)) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<patterns> (shen.<patterns> V896) (if (not (= (fail) Parse_shen.<patterns>)) (if (and (cons? (hd Parse_shen.<patterns>)) (= <- (hd (hd Parse_shen.<patterns>)))) (let Parse_shen.<macroaction> (shen.<macroaction> (shen.pair (tl (hd Parse_shen.<patterns>)) (shen.hdtl Parse_shen.<patterns>))) (if (not (= (fail) Parse_shen.<macroaction>)) (shen.pair (hd Parse_shen.<macroaction>) (append (shen.hdtl Parse_shen.<patterns>) (cons <- (append (shen.hdtl Parse_shen.<macroaction>) ())))) (fail))) (fail)) (fail))) (if (= Result (fail)) (fail) Result)) Result)) Result)) Result)))
|
|
81
81
|
|
|
82
|
-
(defun shen
|
|
82
|
+
(defun shen.<macroaction> (V901) (let Result (let Parse_shen.<action> (shen.<action> V901) (if (not (= (fail) Parse_shen.<action>)) (shen.pair (hd Parse_shen.<action>) (cons (cons shen.walk (cons (cons function (cons macroexpand ())) (cons (shen.hdtl Parse_shen.<action>) ()))) ())) (fail))) (if (= Result (fail)) (fail) Result)))
|
|
83
83
|
|
|
84
|
-
(defun shen
|
|
84
|
+
(defun shen.@s-macro (V902) (cond ((and (cons? V902) (and (= @s (hd V902)) (and (cons? (tl V902)) (and (cons? (tl (tl V902))) (cons? (tl (tl (tl V902)))))))) (cons @s (cons (hd (tl V902)) (cons (shen.@s-macro (cons @s (tl (tl V902)))) ())))) ((and (cons? V902) (and (= @s (hd V902)) (and (cons? (tl V902)) (and (cons? (tl (tl V902))) (and (= () (tl (tl (tl V902)))) (string? (hd (tl V902)))))))) (let E (explode (hd (tl V902))) (if (> (length E) 1) (shen.@s-macro (cons @s (append E (tl (tl V902))))) V902))) (true V902)))
|
|
85
85
|
|
|
86
|
-
(defun shen.
|
|
86
|
+
(defun shen.synonyms-macro (V903) (cond ((and (cons? V903) (= synonyms (hd V903))) (cons shen.synonyms-help (cons (shen.rcons_form (tl V903)) ()))) (true V903)))
|
|
87
87
|
|
|
88
|
-
(defun shen.
|
|
88
|
+
(defun shen.nl-macro (V904) (cond ((and (cons? V904) (and (= nl (hd V904)) (= () (tl V904)))) (cons nl (cons 1 ()))) (true V904)))
|
|
89
89
|
|
|
90
|
-
(defun shen.
|
|
90
|
+
(defun shen.assoc-macro (V905) (cond ((and (cons? V905) (and (cons? (tl V905)) (and (cons? (tl (tl V905))) (and (cons? (tl (tl (tl V905)))) (element? (hd V905) (cons @p (cons @v (cons append (cons and (cons or (cons + (cons * (cons do ()))))))))))))) (cons (hd V905) (cons (hd (tl V905)) (cons (shen.assoc-macro (cons (hd V905) (tl (tl V905)))) ())))) (true V905)))
|
|
91
91
|
|
|
92
|
-
(defun shen.
|
|
92
|
+
(defun shen.let-macro (V906) (cond ((and (cons? V906) (and (= let (hd V906)) (and (cons? (tl V906)) (and (cons? (tl (tl V906))) (and (cons? (tl (tl (tl V906)))) (cons? (tl (tl (tl (tl V906)))))))))) (cons let (cons (hd (tl V906)) (cons (hd (tl (tl V906))) (cons (shen.let-macro (cons let (tl (tl (tl V906))))) ()))))) (true V906)))
|
|
93
93
|
|
|
94
|
-
(defun shen.
|
|
95
|
-
")) (true V881)))
|
|
94
|
+
(defun shen.abs-macro (V907) (cond ((and (cons? V907) (and (= /. (hd V907)) (and (cons? (tl V907)) (and (cons? (tl (tl V907))) (cons? (tl (tl (tl V907)))))))) (cons lambda (cons (hd (tl V907)) (cons (shen.abs-macro (cons /. (tl (tl V907)))) ())))) ((and (cons? V907) (and (= /. (hd V907)) (and (cons? (tl V907)) (and (cons? (tl (tl V907))) (= () (tl (tl (tl V907)))))))) (cons lambda (tl V907))) (true V907)))
|
|
96
95
|
|
|
97
|
-
(defun shen.
|
|
96
|
+
(defun shen.cases-macro (V910) (cond ((and (cons? V910) (and (= cases (hd V910)) (and (cons? (tl V910)) (and (= true (hd (tl V910))) (cons? (tl (tl V910))))))) (hd (tl (tl V910)))) ((and (cons? V910) (and (= cases (hd V910)) (and (cons? (tl V910)) (and (cons? (tl (tl V910))) (= () (tl (tl (tl V910)))))))) (cons if (cons (hd (tl V910)) (cons (hd (tl (tl V910))) (cons (cons simple-error (cons "error: cases exhausted" ())) ()))))) ((and (cons? V910) (and (= cases (hd V910)) (and (cons? (tl V910)) (cons? (tl (tl V910)))))) (cons if (cons (hd (tl V910)) (cons (hd (tl (tl V910))) (cons (shen.cases-macro (cons cases (tl (tl (tl V910))))) ()))))) ((and (cons? V910) (and (= cases (hd V910)) (and (cons? (tl V910)) (= () (tl (tl V910)))))) (simple-error "error: odd number of case elements
|
|
97
|
+
")) (true V910)))
|
|
98
|
+
|
|
99
|
+
(defun shen.timer-macro (V911) (cond ((and (cons? V911) (and (= time (hd V911)) (and (cons? (tl V911)) (= () (tl (tl V911)))))) (shen.let-macro (cons let (cons Start (cons (cons get-time (cons run ())) (cons Result (cons (hd (tl V911)) (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 "
|
|
98
100
|
run time: " (cons (cons cn (cons (cons str (cons Time ())) (cons " secs
|
|
99
|
-
" ()))) ()))) (cons (cons stoutput ()) ()))) (cons Result ())))))))))))))) (true
|
|
101
|
+
" ()))) ()))) (cons (cons stoutput ()) ()))) (cons Result ())))))))))))))) (true V911)))
|
|
100
102
|
|
|
101
|
-
(defun shen.tuple-up (
|
|
103
|
+
(defun shen.tuple-up (V912) (cond ((cons? V912) (cons @p (cons (hd V912) (cons (shen.tuple-up (tl V912)) ())))) (true V912)))
|
|
102
104
|
|
|
103
|
-
(defun shen.put/get-macro (
|
|
105
|
+
(defun shen.put/get-macro (V913) (cond ((and (cons? V913) (and (= put (hd V913)) (and (cons? (tl V913)) (and (cons? (tl (tl V913))) (and (cons? (tl (tl (tl V913)))) (= () (tl (tl (tl (tl V913)))))))))) (cons put (cons (hd (tl V913)) (cons (hd (tl (tl V913))) (cons (hd (tl (tl (tl V913)))) (cons (cons value (cons *property-vector* ())) ())))))) ((and (cons? V913) (and (= get (hd V913)) (and (cons? (tl V913)) (and (cons? (tl (tl V913))) (= () (tl (tl (tl V913)))))))) (cons get (cons (hd (tl V913)) (cons (hd (tl (tl V913))) (cons (cons value (cons *property-vector* ())) ()))))) (true V913)))
|
|
104
106
|
|
|
105
|
-
(defun shen.function-macro (
|
|
107
|
+
(defun shen.function-macro (V914) (cond ((and (cons? V914) (and (= function (hd V914)) (and (cons? (tl V914)) (= () (tl (tl V914)))))) (shen.function-abstraction (hd (tl V914)) (arity (hd (tl V914))))) (true V914)))
|
|
106
108
|
|
|
107
|
-
(defun shen.function-abstraction (
|
|
109
|
+
(defun shen.function-abstraction (V915 V916) (cond ((= 0 V916) (cons freeze (cons V915 ()))) ((= -1 V916) V915) (true (shen.function-abstraction-help V915 V916 ()))))
|
|
108
110
|
|
|
109
|
-
(defun shen.function-abstraction-help (
|
|
111
|
+
(defun shen.function-abstraction-help (V917 V918 V919) (cond ((= 0 V918) (cons V917 V919)) (true (let X (gensym V) (cons /. (cons X (cons (shen.function-abstraction-help V917 (- V918 1) (append V919 (cons X ()))) ())))))))
|
|
110
112
|
|
|
111
|
-
(defun undefmacro (
|
|
113
|
+
(defun undefmacro (V920) (do (set *macros* (remove V920 (value *macros*))) V920))
|
|
112
114
|
|
|
113
115
|
|
|
114
116
|
|