shen-ruby 0.8.1 → 0.9.0
Sign up to get free protection for your applications and to get access to all the features.
- checksums.yaml +4 -4
- data/HISTORY.md +4 -0
- data/README.md +4 -4
- data/lib/shen_ruby/version.rb +1 -1
- data/shen/release/k_lambda/core.kl +63 -63
- data/shen/release/k_lambda/declarations.kl +59 -10
- data/shen/release/k_lambda/load.kl +15 -15
- data/shen/release/k_lambda/macros.kl +31 -29
- data/shen/release/k_lambda/prolog.kl +97 -97
- data/shen/release/k_lambda/reader.kl +79 -79
- data/shen/release/k_lambda/sequent.kl +60 -54
- data/shen/release/k_lambda/sys.kl +98 -98
- data/shen/release/k_lambda/t-star.kl +47 -47
- data/shen/release/k_lambda/toplevel.kl +21 -21
- data/shen/release/k_lambda/track.kl +25 -25
- data/shen/release/k_lambda/types.kl +4 -8
- data/shen/release/k_lambda/writer.kl +25 -25
- data/shen/release/k_lambda/yacc.kl +32 -26
- data/shen-ruby.gemspec +1 -1
- metadata +3 -3
checksums.yaml
CHANGED
|
@@ -1,7 +1,7 @@
|
|
|
1
1
|
---
|
|
2
2
|
SHA1:
|
|
3
|
-
metadata.gz:
|
|
4
|
-
data.tar.gz:
|
|
3
|
+
metadata.gz: 223aeb7a04b4a6b3edf327821e84ee5db52768e3
|
|
4
|
+
data.tar.gz: 526e3feee2e48f50879d1d81c42b33c76cb9a8bf
|
|
5
5
|
SHA512:
|
|
6
|
-
metadata.gz:
|
|
7
|
-
data.tar.gz:
|
|
6
|
+
metadata.gz: ef6c2bfa79b0b51ecc78ca90d8130a1b2dd93de958d7d20445bf17c8ca9d23d355bfe37b4c718d9506c461e6f781314a97ca4744e76507653d20ac1845455d81
|
|
7
|
+
data.tar.gz: 179ad578053aaddb675bacdf305501845b84ebe123ba4d33b70def82df598f157daae862d87ca59b3f78b90ef670bd35c08e9e673594a88fa34fac76fd4e4245
|
data/HISTORY.md
CHANGED
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 15, which was released in February, 2014.
|
|
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
|
|
|
@@ -14,7 +14,7 @@ ShenRuby 0.1.0 began to satisfy the first goal by providing a Shen REPL accessib
|
|
|
14
14
|
## Installation
|
|
15
15
|
NOTE: ShenRuby requires Ruby 1.9 language features. It has been tested with Ruby 1.9.3 and Ruby 2.0.0. It has been lightly tested with JRuby 1.7.8.
|
|
16
16
|
|
|
17
|
-
ShenRuby 0.
|
|
17
|
+
ShenRuby 0.9.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
|
|
|
@@ -27,9 +27,9 @@ Once the gem has been installed, the Shen REPL can be launched via the `srrepl`
|
|
|
27
27
|
|
|
28
28
|
Shen 2010, copyright (C) 2010 Mark Tarver
|
|
29
29
|
released under the Shen license
|
|
30
|
-
www.shenlanguage.org, version
|
|
30
|
+
www.shenlanguage.org, version 15
|
|
31
31
|
running under Ruby, implementation: ruby 2.0.0
|
|
32
|
-
port 0.
|
|
32
|
+
port 0.9.0 ported by Greg Spurrier
|
|
33
33
|
|
|
34
34
|
|
|
35
35
|
(0-)
|
data/lib/shen_ruby/version.rb
CHANGED
|
@@ -47,134 +47,134 @@
|
|
|
47
47
|
* explains this license in full. *
|
|
48
48
|
* *
|
|
49
49
|
*****************************************************************************************
|
|
50
|
-
"(defun shen.shen->kl (
|
|
50
|
+
"(defun shen.shen->kl (V614 V615) (compile (lambda X608 (shen.<define> X608)) (cons V614 V615) (lambda X (shen.shen-syntax-error V614 X))))
|
|
51
51
|
|
|
52
|
-
(defun shen.shen-syntax-error (
|
|
52
|
+
(defun shen.shen-syntax-error (V616 V617) (simple-error (cn "syntax error in " (shen.app V616 (cn " here:
|
|
53
53
|
|
|
54
|
-
" (shen.app (shen.next-50 50
|
|
54
|
+
" (shen.app (shen.next-50 50 V617) "
|
|
55
55
|
" shen.a)) shen.a))))
|
|
56
56
|
|
|
57
|
-
(defun shen.<define> (
|
|
57
|
+
(defun shen.<define> (V622) (let Result (let Parse_shen.<name> (shen.<name> V622) (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> V622) (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> (V627) (let Result (if (cons? (hd V627)) (let Parse_X (hd (hd V627)) (shen.pair (hd (shen.pair (tl (hd V627)) (shen.hdtl V627))) (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? (V628) (element? V628 (get (intern "shen") shen.external-symbols (value *property-vector*))))
|
|
63
63
|
|
|
64
|
-
(defun shen.<signature> (
|
|
64
|
+
(defun shen.<signature> (V633) (let Result (if (and (cons? (hd V633)) (= { (hd (hd V633)))) (let Parse_shen.<signature-help> (shen.<signature-help> (shen.pair (tl (hd V633)) (shen.hdtl V633))) (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 (V634) (cond ((and (cons? V634) (and (cons? (tl V634)) (and (= --> (hd (tl V634))) (and (cons? (tl (tl V634))) (and (cons? (tl (tl (tl V634)))) (= --> (hd (tl (tl (tl V634)))))))))) (shen.curry-type (cons (hd V634) (cons --> (cons (tl (tl V634)) ()))))) ((and (cons? V634) (and (cons? (tl V634)) (and (= * (hd (tl V634))) (and (cons? (tl (tl V634))) (and (cons? (tl (tl (tl V634)))) (= * (hd (tl (tl (tl V634)))))))))) (shen.curry-type (cons (hd V634) (cons * (cons (tl (tl V634)) ()))))) ((cons? V634) (map (lambda X609 (shen.curry-type X609)) V634)) (true V634)))
|
|
67
67
|
|
|
68
|
-
(defun shen.<signature-help> (
|
|
68
|
+
(defun shen.<signature-help> (V639) (let Result (if (cons? (hd V639)) (let Parse_X (hd (hd V639)) (let Parse_shen.<signature-help> (shen.<signature-help> (shen.pair (tl (hd V639)) (shen.hdtl V639))) (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> V639) (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> (V644) (let Result (let Parse_shen.<rule> (shen.<rule> V644) (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> V644) (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> (V649) (let Result (let Parse_shen.<patterns> (shen.<patterns> V649) (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> V649) (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> V649) (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> V649) (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 (V650 V651) (if (V650 V651) (fail) V651))
|
|
75
75
|
|
|
76
|
-
(defun shen.succeeds? (
|
|
76
|
+
(defun shen.succeeds? (V656) (cond ((= V656 (fail)) false) (true true)))
|
|
77
77
|
|
|
78
|
-
(defun shen.<patterns> (
|
|
78
|
+
(defun shen.<patterns> (V661) (let Result (let Parse_shen.<pattern> (shen.<pattern> V661) (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> V661) (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> (V666) (let Result (if (and (cons? (hd V666)) (cons? (hd (hd V666)))) (shen.snd-or-fail (if (and (cons? (hd (shen.pair (hd (hd V666)) (shen.hdtl V666)))) (= @p (hd (hd (shen.pair (hd (hd V666)) (shen.hdtl V666)))))) (let Parse_shen.<pattern1> (shen.<pattern1> (shen.pair (tl (hd (shen.pair (hd (hd V666)) (shen.hdtl V666)))) (shen.hdtl (shen.pair (hd (hd V666)) (shen.hdtl V666))))) (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 V666)) (shen.hdtl V666))) (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 V666)) (cons? (hd (hd V666)))) (shen.snd-or-fail (if (and (cons? (hd (shen.pair (hd (hd V666)) (shen.hdtl V666)))) (= cons (hd (hd (shen.pair (hd (hd V666)) (shen.hdtl V666)))))) (let Parse_shen.<pattern1> (shen.<pattern1> (shen.pair (tl (hd (shen.pair (hd (hd V666)) (shen.hdtl V666)))) (shen.hdtl (shen.pair (hd (hd V666)) (shen.hdtl V666))))) (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 V666)) (shen.hdtl V666))) (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 V666)) (cons? (hd (hd V666)))) (shen.snd-or-fail (if (and (cons? (hd (shen.pair (hd (hd V666)) (shen.hdtl V666)))) (= @v (hd (hd (shen.pair (hd (hd V666)) (shen.hdtl V666)))))) (let Parse_shen.<pattern1> (shen.<pattern1> (shen.pair (tl (hd (shen.pair (hd (hd V666)) (shen.hdtl V666)))) (shen.hdtl (shen.pair (hd (hd V666)) (shen.hdtl V666))))) (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 V666)) (shen.hdtl V666))) (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 V666)) (cons? (hd (hd V666)))) (shen.snd-or-fail (if (and (cons? (hd (shen.pair (hd (hd V666)) (shen.hdtl V666)))) (= @s (hd (hd (shen.pair (hd (hd V666)) (shen.hdtl V666)))))) (let Parse_shen.<pattern1> (shen.<pattern1> (shen.pair (tl (hd (shen.pair (hd (hd V666)) (shen.hdtl V666)))) (shen.hdtl (shen.pair (hd (hd V666)) (shen.hdtl V666))))) (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 V666)) (shen.hdtl V666))) (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 V666)) (cons? (hd (hd V666)))) (shen.snd-or-fail (if (and (cons? (hd (shen.pair (hd (hd V666)) (shen.hdtl V666)))) (= vector (hd (hd (shen.pair (hd (hd V666)) (shen.hdtl V666)))))) (if (and (cons? (hd (shen.pair (tl (hd (shen.pair (hd (hd V666)) (shen.hdtl V666)))) (shen.hdtl (shen.pair (hd (hd V666)) (shen.hdtl V666)))))) (= 0 (hd (hd (shen.pair (tl (hd (shen.pair (hd (hd V666)) (shen.hdtl V666)))) (shen.hdtl (shen.pair (hd (hd V666)) (shen.hdtl V666)))))))) (shen.pair (hd (shen.pair (tl (hd (shen.pair (tl (hd (shen.pair (hd (hd V666)) (shen.hdtl V666)))) (shen.hdtl (shen.pair (hd (hd V666)) (shen.hdtl V666)))))) (shen.hdtl (shen.pair (tl (hd (shen.pair (hd (hd V666)) (shen.hdtl V666)))) (shen.hdtl (shen.pair (hd (hd V666)) (shen.hdtl V666))))))) (shen.pair (hd (shen.pair (tl (hd V666)) (shen.hdtl V666))) (cons vector (cons 0 ())))) (fail)) (fail))) (fail)) (if (= Result (fail)) (let Result (if (cons? (hd V666)) (let Parse_X (hd (hd V666)) (if (cons? Parse_X) (shen.pair (hd (shen.pair (tl (hd V666)) (shen.hdtl V666))) (shen.constructor-error Parse_X)) (fail))) (fail)) (if (= Result (fail)) (let Result (let Parse_shen.<simple_pattern> (shen.<simple_pattern> V666) (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 (V667) (simple-error (shen.app V667 " is not a legitimate constructor
|
|
83
83
|
" shen.a)))
|
|
84
84
|
|
|
85
|
-
(defun shen.<simple_pattern> (
|
|
85
|
+
(defun shen.<simple_pattern> (V672) (let Result (if (cons? (hd V672)) (let Parse_X (hd (hd V672)) (if (= Parse_X _) (shen.pair (hd (shen.pair (tl (hd V672)) (shen.hdtl V672))) (gensym Parse_Y)) (fail))) (fail)) (if (= Result (fail)) (let Result (if (cons? (hd V672)) (let Parse_X (hd (hd V672)) (if (not (element? Parse_X (cons -> (cons <- ())))) (shen.pair (hd (shen.pair (tl (hd V672)) (shen.hdtl V672))) Parse_X) (fail))) (fail)) (if (= Result (fail)) (fail) Result)) Result)))
|
|
86
86
|
|
|
87
|
-
(defun shen.<pattern1> (
|
|
87
|
+
(defun shen.<pattern1> (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)))
|
|
88
88
|
|
|
89
|
-
(defun shen.<pattern2> (
|
|
89
|
+
(defun shen.<pattern2> (V682) (let Result (let Parse_shen.<pattern> (shen.<pattern> V682) (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> (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)))
|
|
92
92
|
|
|
93
|
-
(defun shen.<guard> (
|
|
93
|
+
(defun shen.<guard> (V692) (let Result (if (cons? (hd V692)) (let Parse_X (hd (hd V692)) (shen.pair (hd (shen.pair (tl (hd V692)) (shen.hdtl V692))) Parse_X)) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
94
94
|
|
|
95
|
-
(defun shen.compile_to_machine_code (
|
|
95
|
+
(defun shen.compile_to_machine_code (V693 V694) (let Lambda+ (shen.compile_to_lambda+ V693 V694) (let KL (shen.compile_to_kl V693 Lambda+) (let Record (shen.record-source V693 KL) KL))))
|
|
96
96
|
|
|
97
|
-
(defun shen.record-source (
|
|
97
|
+
(defun shen.record-source (V697 V698) (cond ((value shen.*installing-kl*) shen.skip) (true (put V697 shen.source V698 (value *property-vector*)))))
|
|
98
98
|
|
|
99
|
-
(defun shen.compile_to_lambda+ (
|
|
99
|
+
(defun shen.compile_to_lambda+ (V699 V700) (let Arity (shen.aritycheck V699 V700) (let Free (map (lambda Rule (shen.free_variable_check V699 Rule)) V700) (let Variables (shen.parameters Arity) (let Strip (map (lambda X610 (shen.strip-protect X610)) V700) (let Abstractions (map (lambda X611 (shen.abstract_rule X611)) 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 (V701 V702) (cond ((and (cons? V702) (and (cons? (tl V702)) (= () (tl (tl V702))))) (let Bound (shen.extract_vars (hd V702)) (let Free (shen.extract_free_vars Bound (hd (tl V702))) (shen.free_variable_warnings V701 Free)))) (true (shen.sys-error shen.free_variable_check))))
|
|
102
102
|
|
|
103
|
-
(defun shen.extract_vars (
|
|
103
|
+
(defun shen.extract_vars (V703) (cond ((variable? V703) (cons V703 ())) ((cons? V703) (union (shen.extract_vars (hd V703)) (shen.extract_vars (tl V703)))) (true ())))
|
|
104
104
|
|
|
105
|
-
(defun shen.extract_free_vars (
|
|
105
|
+
(defun shen.extract_free_vars (V713 V714) (cond ((and (cons? V714) (and (cons? (tl V714)) (and (= () (tl (tl V714))) (= (hd V714) protect)))) ()) ((and (variable? V714) (not (element? V714 V713))) (cons V714 ())) ((and (cons? V714) (and (= lambda (hd V714)) (and (cons? (tl V714)) (and (cons? (tl (tl V714))) (= () (tl (tl (tl V714)))))))) (shen.extract_free_vars (cons (hd (tl V714)) V713) (hd (tl (tl V714))))) ((and (cons? V714) (and (= let (hd V714)) (and (cons? (tl V714)) (and (cons? (tl (tl V714))) (and (cons? (tl (tl (tl V714)))) (= () (tl (tl (tl (tl V714)))))))))) (union (shen.extract_free_vars V713 (hd (tl (tl V714)))) (shen.extract_free_vars (cons (hd (tl V714)) V713) (hd (tl (tl (tl V714))))))) ((cons? V714) (union (shen.extract_free_vars V713 (hd V714)) (shen.extract_free_vars V713 (tl V714)))) (true ())))
|
|
106
106
|
|
|
107
|
-
(defun shen.free_variable_warnings (
|
|
107
|
+
(defun shen.free_variable_warnings (V717 V718) (cond ((= () V718) _) (true (simple-error (cn "error: the following variables are free in " (shen.app V717 (cn ": " (shen.app (shen.list_variables V718) "" shen.a)) shen.a))))))
|
|
108
108
|
|
|
109
|
-
(defun shen.list_variables (
|
|
109
|
+
(defun shen.list_variables (V719) (cond ((and (cons? V719) (= () (tl V719))) (cn (str (hd V719)) ".")) ((cons? V719) (cn (str (hd V719)) (cn ", " (shen.list_variables (tl V719))))) (true (shen.sys-error shen.list_variables))))
|
|
110
110
|
|
|
111
|
-
(defun shen.strip-protect (
|
|
111
|
+
(defun shen.strip-protect (V720) (cond ((and (cons? V720) (and (cons? (tl V720)) (and (= () (tl (tl V720))) (= (hd V720) protect)))) (hd (tl V720))) ((cons? V720) (cons (shen.strip-protect (hd V720)) (shen.strip-protect (tl V720)))) (true V720)))
|
|
112
112
|
|
|
113
|
-
(defun shen.linearise (
|
|
113
|
+
(defun shen.linearise (V721) (cond ((and (cons? V721) (and (cons? (tl V721)) (= () (tl (tl V721))))) (shen.linearise_help (shen.flatten (hd V721)) (hd V721) (hd (tl V721)))) (true (shen.sys-error shen.linearise))))
|
|
114
114
|
|
|
115
|
-
(defun shen.flatten (
|
|
115
|
+
(defun shen.flatten (V722) (cond ((= () V722) ()) ((cons? V722) (append (shen.flatten (hd V722)) (shen.flatten (tl V722)))) (true (cons V722 ()))))
|
|
116
116
|
|
|
117
|
-
(defun shen.linearise_help (
|
|
117
|
+
(defun shen.linearise_help (V723 V724 V725) (cond ((= () V723) (cons V724 (cons V725 ()))) ((cons? V723) (if (and (variable? (hd V723)) (element? (hd V723) (tl V723))) (let Var (gensym (hd V723)) (let NewAction (cons where (cons (cons = (cons (hd V723) (cons Var ()))) (cons V725 ()))) (let NewPatts (shen.linearise_X (hd V723) Var V724) (shen.linearise_help (tl V723) NewPatts NewAction)))) (shen.linearise_help (tl V723) V724 V725))) (true (shen.sys-error shen.linearise_help))))
|
|
118
118
|
|
|
119
|
-
(defun shen.linearise_X (
|
|
119
|
+
(defun shen.linearise_X (V734 V735 V736) (cond ((= V736 V734) V735) ((cons? V736) (let L (shen.linearise_X V734 V735 (hd V736)) (if (= L (hd V736)) (cons (hd V736) (shen.linearise_X V734 V735 (tl V736))) (cons L (tl V736))))) (true V736)))
|
|
120
120
|
|
|
121
|
-
(defun shen.aritycheck (
|
|
121
|
+
(defun shen.aritycheck (V738 V739) (cond ((and (cons? V739) (and (cons? (hd V739)) (and (cons? (tl (hd V739))) (and (= () (tl (tl (hd V739)))) (= () (tl V739)))))) (do (shen.aritycheck-action (hd (tl (hd V739)))) (shen.aritycheck-name V738 (arity V738) (length (hd (hd V739)))))) ((and (cons? V739) (and (cons? (hd V739)) (and (cons? (tl (hd V739))) (and (= () (tl (tl (hd V739)))) (and (cons? (tl V739)) (and (cons? (hd (tl V739))) (and (cons? (tl (hd (tl V739)))) (= () (tl (tl (hd (tl V739)))))))))))) (if (= (length (hd (hd V739))) (length (hd (hd (tl V739))))) (do (shen.aritycheck-action (hd (tl (hd V739)))) (shen.aritycheck V738 (tl V739))) (simple-error (cn "arity error in " (shen.app V738 "
|
|
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 (V748 V749 V750) (cond ((= -1 V749) V750) ((= V750 V749) V750) (true (do (shen.prhush (cn "
|
|
125
|
+
warning: changing the arity of " (shen.app V748 " can cause errors.
|
|
126
|
+
" shen.a)) (stoutput)) V750))))
|
|
127
127
|
|
|
128
|
-
(defun shen.aritycheck-action (
|
|
128
|
+
(defun shen.aritycheck-action (V756) (cond ((cons? V756) (do (shen.aah (hd V756) (tl V756)) (map (lambda X612 (shen.aritycheck-action X612)) V756))) (true shen.skip)))
|
|
129
129
|
|
|
130
|
-
(defun shen.aah (
|
|
130
|
+
(defun shen.aah (V757 V758) (let Arity (arity V757) (let Len (length V758) (if (and (> Arity -1) (> Len Arity)) (shen.prhush (cn "warning: " (shen.app V757 (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 (V759) (cond ((and (cons? V759) (and (cons? (tl V759)) (= () (tl (tl V759))))) (shen.abstraction_build (hd V759) (hd (tl V759)))) (true (shen.sys-error shen.abstract_rule))))
|
|
134
134
|
|
|
135
|
-
(defun shen.abstraction_build (
|
|
135
|
+
(defun shen.abstraction_build (V760 V761) (cond ((= () V760) V761) ((cons? V760) (cons /. (cons (hd V760) (cons (shen.abstraction_build (tl V760) V761) ())))) (true (shen.sys-error shen.abstraction_build))))
|
|
136
136
|
|
|
137
|
-
(defun shen.parameters (
|
|
137
|
+
(defun shen.parameters (V762) (cond ((= 0 V762) ()) (true (cons (gensym V) (shen.parameters (- V762 1))))))
|
|
138
138
|
|
|
139
|
-
(defun shen.application_build (
|
|
139
|
+
(defun shen.application_build (V763 V764) (cond ((= () V763) V764) ((cons? V763) (shen.application_build (tl V763) (cons V764 (cons (hd V763) ())))) (true (shen.sys-error shen.application_build))))
|
|
140
140
|
|
|
141
|
-
(defun shen.compile_to_kl (
|
|
141
|
+
(defun shen.compile_to_kl (V765 V766) (cond ((and (cons? V766) (and (cons? (tl V766)) (= () (tl (tl V766))))) (let Arity (shen.store-arity V765 (length (hd V766))) (let Reduce (map (lambda X613 (shen.reduce X613)) (hd (tl V766))) (let CondExpression (shen.cond-expression V765 (hd V766) Reduce) (let TypeTable (if (value shen.*optimise*) (shen.typextable (shen.get-type V765) (hd V766)) shen.skip) (let TypedCondExpression (if (value shen.*optimise*) (shen.assign-types (hd V766) TypeTable CondExpression) CondExpression) (let KL (cons defun (cons V765 (cons (hd V766) (cons TypedCondExpression ())))) KL))))))) (true (shen.sys-error shen.compile_to_kl))))
|
|
142
142
|
|
|
143
|
-
(defun shen.get-type (
|
|
143
|
+
(defun shen.get-type (V771) (cond ((cons? V771) shen.skip) (true (let FType (assoc V771 (value shen.*signedfuncs*)) (if (empty? FType) shen.skip (tl FType))))))
|
|
144
144
|
|
|
145
|
-
(defun shen.typextable (
|
|
145
|
+
(defun shen.typextable (V780 V781) (cond ((and (cons? V780) (and (cons? (tl V780)) (and (= --> (hd (tl V780))) (and (cons? (tl (tl V780))) (and (= () (tl (tl (tl V780)))) (cons? V781)))))) (if (variable? (hd V780)) (shen.typextable (hd (tl (tl V780))) (tl V781)) (cons (cons (hd V781) (hd V780)) (shen.typextable (hd (tl (tl V780))) (tl V781))))) (true ())))
|
|
146
146
|
|
|
147
|
-
(defun shen.assign-types (
|
|
147
|
+
(defun shen.assign-types (V782 V783 V784) (cond ((and (cons? V784) (and (= let (hd V784)) (and (cons? (tl V784)) (and (cons? (tl (tl V784))) (and (cons? (tl (tl (tl V784)))) (= () (tl (tl (tl (tl V784)))))))))) (cons let (cons (hd (tl V784)) (cons (shen.assign-types V782 V783 (hd (tl (tl V784)))) (cons (shen.assign-types (cons (hd (tl V784)) V782) V783 (hd (tl (tl (tl V784))))) ()))))) ((and (cons? V784) (and (= lambda (hd V784)) (and (cons? (tl V784)) (and (cons? (tl (tl V784))) (= () (tl (tl (tl V784)))))))) (cons lambda (cons (hd (tl V784)) (cons (shen.assign-types (cons (hd (tl V784)) V782) V783 (hd (tl (tl V784)))) ())))) ((and (cons? V784) (= cond (hd V784))) (cons cond (map (lambda Y (cons (shen.assign-types V782 V783 (hd Y)) (cons (shen.assign-types V782 V783 (hd (tl Y))) ()))) (tl V784)))) ((cons? V784) (let NewTable (shen.typextable (shen.get-type (hd V784)) (tl V784)) (cons (hd V784) (map (lambda Y (shen.assign-types V782 (append V783 NewTable) Y)) (tl V784))))) (true (let AtomType (assoc V784 V783) (if (cons? AtomType) (cons type (cons V784 (cons (tl AtomType) ()))) (if (element? V784 V782) V784 (shen.atom-type V784)))))))
|
|
148
148
|
|
|
149
|
-
(defun shen.atom-type (
|
|
149
|
+
(defun shen.atom-type (V785) (if (string? V785) (cons type (cons V785 (cons string ()))) (if (number? V785) (cons type (cons V785 (cons number ()))) (if (boolean? V785) (cons type (cons V785 (cons boolean ()))) (if (symbol? V785) (cons type (cons V785 (cons symbol ()))) V785)))))
|
|
150
150
|
|
|
151
|
-
(defun shen.store-arity (
|
|
151
|
+
(defun shen.store-arity (V788 V789) (cond ((value shen.*installing-kl*) shen.skip) (true (put V788 arity V789 (value *property-vector*)))))
|
|
152
152
|
|
|
153
|
-
(defun shen.reduce (
|
|
153
|
+
(defun shen.reduce (V790) (do (set shen.*teststack* ()) (let Result (shen.reduce_help V790) (cons (cons : (cons shen.tests (reverse (value shen.*teststack*)))) (cons Result ())))))
|
|
154
154
|
|
|
155
|
-
(defun shen.reduce_help (
|
|
155
|
+
(defun shen.reduce_help (V791) (cond ((and (cons? V791) (and (cons? (hd V791)) (and (= /. (hd (hd V791))) (and (cons? (tl (hd V791))) (and (cons? (hd (tl (hd V791)))) (and (= cons (hd (hd (tl (hd V791))))) (and (cons? (tl (hd (tl (hd V791))))) (and (cons? (tl (tl (hd (tl (hd V791)))))) (and (= () (tl (tl (tl (hd (tl (hd V791))))))) (and (cons? (tl (tl (hd V791)))) (and (= () (tl (tl (tl (hd V791))))) (and (cons? (tl V791)) (= () (tl (tl V791))))))))))))))) (do (shen.add_test (cons cons? (tl V791))) (let Abstraction (cons /. (cons (hd (tl (hd (tl (hd V791))))) (cons (cons /. (cons (hd (tl (tl (hd (tl (hd V791)))))) (cons (shen.ebr (hd (tl V791)) (hd (tl (hd V791))) (hd (tl (tl (hd V791))))) ()))) ()))) (let Application (cons (cons Abstraction (cons (cons hd (tl V791)) ())) (cons (cons tl (tl V791)) ())) (shen.reduce_help Application))))) ((and (cons? V791) (and (cons? (hd V791)) (and (= /. (hd (hd V791))) (and (cons? (tl (hd V791))) (and (cons? (hd (tl (hd V791)))) (and (= @p (hd (hd (tl (hd V791))))) (and (cons? (tl (hd (tl (hd V791))))) (and (cons? (tl (tl (hd (tl (hd V791)))))) (and (= () (tl (tl (tl (hd (tl (hd V791))))))) (and (cons? (tl (tl (hd V791)))) (and (= () (tl (tl (tl (hd V791))))) (and (cons? (tl V791)) (= () (tl (tl V791))))))))))))))) (do (shen.add_test (cons tuple? (tl V791))) (let Abstraction (cons /. (cons (hd (tl (hd (tl (hd V791))))) (cons (cons /. (cons (hd (tl (tl (hd (tl (hd V791)))))) (cons (shen.ebr (hd (tl V791)) (hd (tl (hd V791))) (hd (tl (tl (hd V791))))) ()))) ()))) (let Application (cons (cons Abstraction (cons (cons fst (tl V791)) ())) (cons (cons snd (tl V791)) ())) (shen.reduce_help Application))))) ((and (cons? V791) (and (cons? (hd V791)) (and (= /. (hd (hd V791))) (and (cons? (tl (hd V791))) (and (cons? (hd (tl (hd V791)))) (and (= @v (hd (hd (tl (hd V791))))) (and (cons? (tl (hd (tl (hd V791))))) (and (cons? (tl (tl (hd (tl (hd V791)))))) (and (= () (tl (tl (tl (hd (tl (hd V791))))))) (and (cons? (tl (tl (hd V791)))) (and (= () (tl (tl (tl (hd V791))))) (and (cons? (tl V791)) (= () (tl (tl V791))))))))))))))) (do (shen.add_test (cons shen.+vector? (tl V791))) (let Abstraction (cons /. (cons (hd (tl (hd (tl (hd V791))))) (cons (cons /. (cons (hd (tl (tl (hd (tl (hd V791)))))) (cons (shen.ebr (hd (tl V791)) (hd (tl (hd V791))) (hd (tl (tl (hd V791))))) ()))) ()))) (let Application (cons (cons Abstraction (cons (cons hdv (tl V791)) ())) (cons (cons tlv (tl V791)) ())) (shen.reduce_help Application))))) ((and (cons? V791) (and (cons? (hd V791)) (and (= /. (hd (hd V791))) (and (cons? (tl (hd V791))) (and (cons? (hd (tl (hd V791)))) (and (= @s (hd (hd (tl (hd V791))))) (and (cons? (tl (hd (tl (hd V791))))) (and (cons? (tl (tl (hd (tl (hd V791)))))) (and (= () (tl (tl (tl (hd (tl (hd V791))))))) (and (cons? (tl (tl (hd V791)))) (and (= () (tl (tl (tl (hd V791))))) (and (cons? (tl V791)) (= () (tl (tl V791))))))))))))))) (do (shen.add_test (cons shen.+string? (tl V791))) (let Abstraction (cons /. (cons (hd (tl (hd (tl (hd V791))))) (cons (cons /. (cons (hd (tl (tl (hd (tl (hd V791)))))) (cons (shen.ebr (hd (tl V791)) (hd (tl (hd V791))) (hd (tl (tl (hd V791))))) ()))) ()))) (let Application (cons (cons Abstraction (cons (cons pos (cons (hd (tl V791)) (cons 0 ()))) ())) (cons (cons tlstr (tl V791)) ())) (shen.reduce_help Application))))) ((and (cons? V791) (and (cons? (hd V791)) (and (= /. (hd (hd V791))) (and (cons? (tl (hd V791))) (and (cons? (tl (tl (hd V791)))) (and (= () (tl (tl (tl (hd V791))))) (and (cons? (tl V791)) (and (= () (tl (tl V791))) (not (variable? (hd (tl (hd V791))))))))))))) (do (shen.add_test (cons = (cons (hd (tl (hd V791))) (tl V791)))) (shen.reduce_help (hd (tl (tl (hd V791))))))) ((and (cons? V791) (and (cons? (hd V791)) (and (= /. (hd (hd V791))) (and (cons? (tl (hd V791))) (and (cons? (tl (tl (hd V791)))) (and (= () (tl (tl (tl (hd V791))))) (and (cons? (tl V791)) (= () (tl (tl V791)))))))))) (shen.reduce_help (shen.ebr (hd (tl V791)) (hd (tl (hd V791))) (hd (tl (tl (hd V791))))))) ((and (cons? V791) (and (= where (hd V791)) (and (cons? (tl V791)) (and (cons? (tl (tl V791))) (= () (tl (tl (tl V791)))))))) (do (shen.add_test (hd (tl V791))) (shen.reduce_help (hd (tl (tl V791)))))) ((and (cons? V791) (and (cons? (tl V791)) (= () (tl (tl V791))))) (let Z (shen.reduce_help (hd V791)) (if (= (hd V791) Z) V791 (shen.reduce_help (cons Z (tl V791)))))) (true V791)))
|
|
156
156
|
|
|
157
|
-
(defun shen.+string? (
|
|
157
|
+
(defun shen.+string? (V792) (cond ((= "" V792) false) (true (string? V792))))
|
|
158
158
|
|
|
159
|
-
(defun shen.+vector (
|
|
159
|
+
(defun shen.+vector (V793) (cond ((= V793 (vector 0)) false) (true (vector? V793))))
|
|
160
160
|
|
|
161
|
-
(defun shen.ebr (
|
|
161
|
+
(defun shen.ebr (V802 V803 V804) (cond ((= V804 V803) V802) ((and (cons? V804) (and (= /. (hd V804)) (and (cons? (tl V804)) (and (cons? (tl (tl V804))) (and (= () (tl (tl (tl V804)))) (> (occurrences V803 (hd (tl V804))) 0)))))) V804) ((and (cons? V804) (and (= let (hd V804)) (and (cons? (tl V804)) (and (cons? (tl (tl V804))) (and (cons? (tl (tl (tl V804)))) (and (= () (tl (tl (tl (tl V804))))) (= (hd (tl V804)) V803))))))) (cons let (cons (hd (tl V804)) (cons (shen.ebr V802 (hd (tl V804)) (hd (tl (tl V804)))) (tl (tl (tl V804))))))) ((cons? V804) (cons (shen.ebr V802 V803 (hd V804)) (shen.ebr V802 V803 (tl V804)))) (true V804)))
|
|
162
162
|
|
|
163
|
-
(defun shen.add_test (
|
|
163
|
+
(defun shen.add_test (V807) (set shen.*teststack* (cons V807 (value shen.*teststack*))))
|
|
164
164
|
|
|
165
|
-
(defun shen.cond-expression (
|
|
165
|
+
(defun shen.cond-expression (V808 V809 V810) (let Err (shen.err-condition V808) (let Cases (shen.case-form V810 Err) (let EncodeChoices (shen.encode-choices Cases V808) (shen.cond-form EncodeChoices)))))
|
|
166
166
|
|
|
167
|
-
(defun shen.cond-form (
|
|
167
|
+
(defun shen.cond-form (V813) (cond ((and (cons? V813) (and (cons? (hd V813)) (and (= true (hd (hd V813))) (and (cons? (tl (hd V813))) (= () (tl (tl (hd V813)))))))) (hd (tl (hd V813)))) (true (cons cond V813))))
|
|
168
168
|
|
|
169
|
-
(defun shen.encode-choices (
|
|
169
|
+
(defun shen.encode-choices (V816 V817) (cond ((= () V816) ()) ((and (cons? V816) (and (cons? (hd V816)) (and (= true (hd (hd V816))) (and (cons? (tl (hd V816))) (and (cons? (hd (tl (hd V816)))) (and (= shen.choicepoint! (hd (hd (tl (hd V816))))) (and (cons? (tl (hd (tl (hd V816))))) (and (= () (tl (tl (hd (tl (hd V816)))))) (and (= () (tl (tl (hd V816)))) (= () (tl V816))))))))))) (cons (cons true (cons (cons let (cons Result (cons (hd (tl (hd (tl (hd V816))))) (cons (cons if (cons (cons = (cons Result (cons (cons fail ()) ()))) (cons (if (value shen.*installing-kl*) (cons shen.sys-error (cons V817 ())) (cons shen.f_error (cons V817 ()))) (cons Result ())))) ())))) ())) ())) ((and (cons? V816) (and (cons? (hd V816)) (and (= true (hd (hd V816))) (and (cons? (tl (hd V816))) (and (cons? (hd (tl (hd V816)))) (and (= shen.choicepoint! (hd (hd (tl (hd V816))))) (and (cons? (tl (hd (tl (hd V816))))) (and (= () (tl (tl (hd (tl (hd V816)))))) (= () (tl (tl (hd V816)))))))))))) (cons (cons true (cons (cons let (cons Result (cons (hd (tl (hd (tl (hd V816))))) (cons (cons if (cons (cons = (cons Result (cons (cons fail ()) ()))) (cons (shen.cond-form (shen.encode-choices (tl V816) V817)) (cons Result ())))) ())))) ())) ())) ((and (cons? V816) (and (cons? (hd V816)) (and (cons? (tl (hd V816))) (and (cons? (hd (tl (hd V816)))) (and (= shen.choicepoint! (hd (hd (tl (hd V816))))) (and (cons? (tl (hd (tl (hd V816))))) (and (= () (tl (tl (hd (tl (hd V816)))))) (= () (tl (tl (hd V816))))))))))) (cons (cons true (cons (cons let (cons Freeze (cons (cons freeze (cons (shen.cond-form (shen.encode-choices (tl V816) V817)) ())) (cons (cons if (cons (hd (hd V816)) (cons (cons let (cons Result (cons (hd (tl (hd (tl (hd V816))))) (cons (cons if (cons (cons = (cons Result (cons (cons fail ()) ()))) (cons (cons thaw (cons Freeze ())) (cons Result ())))) ())))) (cons (cons thaw (cons Freeze ())) ())))) ())))) ())) ())) ((and (cons? V816) (and (cons? (hd V816)) (and (cons? (tl (hd V816))) (= () (tl (tl (hd V816))))))) (cons (hd V816) (shen.encode-choices (tl V816) V817))) (true (shen.sys-error shen.encode-choices))))
|
|
170
170
|
|
|
171
|
-
(defun shen.case-form (
|
|
171
|
+
(defun shen.case-form (V822 V823) (cond ((= () V822) (cons V823 ())) ((and (cons? V822) (and (cons? (hd V822)) (and (cons? (hd (hd V822))) (and (= : (hd (hd (hd V822)))) (and (cons? (tl (hd (hd V822)))) (and (= shen.tests (hd (tl (hd (hd V822))))) (and (= () (tl (tl (hd (hd V822))))) (and (cons? (tl (hd V822))) (and (cons? (hd (tl (hd V822)))) (and (= shen.choicepoint! (hd (hd (tl (hd V822))))) (and (cons? (tl (hd (tl (hd V822))))) (and (= () (tl (tl (hd (tl (hd V822)))))) (= () (tl (tl (hd V822)))))))))))))))) (cons (cons true (tl (hd V822))) (shen.case-form (tl V822) V823))) ((and (cons? V822) (and (cons? (hd V822)) (and (cons? (hd (hd V822))) (and (= : (hd (hd (hd V822)))) (and (cons? (tl (hd (hd V822)))) (and (= shen.tests (hd (tl (hd (hd V822))))) (and (= () (tl (tl (hd (hd V822))))) (and (cons? (tl (hd V822))) (= () (tl (tl (hd V822)))))))))))) (cons (cons true (tl (hd V822))) ())) ((and (cons? V822) (and (cons? (hd V822)) (and (cons? (hd (hd V822))) (and (= : (hd (hd (hd V822)))) (and (cons? (tl (hd (hd V822)))) (and (= shen.tests (hd (tl (hd (hd V822))))) (and (cons? (tl (hd V822))) (= () (tl (tl (hd V822))))))))))) (cons (cons (shen.embed-and (tl (tl (hd (hd V822))))) (tl (hd V822))) (shen.case-form (tl V822) V823))) (true (shen.sys-error shen.case-form))))
|
|
172
172
|
|
|
173
|
-
(defun shen.embed-and (
|
|
173
|
+
(defun shen.embed-and (V824) (cond ((and (cons? V824) (= () (tl V824))) (hd V824)) ((cons? V824) (cons and (cons (hd V824) (cons (shen.embed-and (tl V824)) ())))) (true (shen.sys-error shen.embed-and))))
|
|
174
174
|
|
|
175
|
-
(defun shen.err-condition (
|
|
175
|
+
(defun shen.err-condition (V825) (cons true (cons (cons shen.f_error (cons V825 ())) ())))
|
|
176
176
|
|
|
177
|
-
(defun shen.sys-error (
|
|
177
|
+
(defun shen.sys-error (V826) (simple-error (cn "system function " (shen.app V826 ": unexpected argument
|
|
178
178
|
" shen.a))))
|
|
179
179
|
|
|
180
180
|
|
|
@@ -1,4 +1,53 @@
|
|
|
1
|
-
"
|
|
1
|
+
"**********************************************************************************
|
|
2
|
+
* The License *
|
|
3
|
+
* *
|
|
4
|
+
* The user is free to produce commercial applications with the software, to *
|
|
5
|
+
* distribute these applications in source or binary form, and to charge monies *
|
|
6
|
+
* for them as he sees fit and in concordance with the laws of the land subject *
|
|
7
|
+
* to the following license. *
|
|
8
|
+
* *
|
|
9
|
+
* 1. The license applies to all the software and all derived software and *
|
|
10
|
+
* must appear on such. *
|
|
11
|
+
* *
|
|
12
|
+
* 2. It is illegal to distribute the software without this license attached *
|
|
13
|
+
* to it and use of the software implies agreement with the license as such. *
|
|
14
|
+
* It is illegal for anyone who is not the copyright holder to tamper with *
|
|
15
|
+
* or change the license. *
|
|
16
|
+
* *
|
|
17
|
+
* 3. Neither the names of Lambda Associates or the copyright holder may be used *
|
|
18
|
+
* to endorse or promote products built using the software without specific *
|
|
19
|
+
* prior written permission from the copyright holder. *
|
|
20
|
+
* *
|
|
21
|
+
* 4. That possession of this license does not confer on the copyright holder *
|
|
22
|
+
* any special contractual obligation towards the user. That in no event *
|
|
23
|
+
* shall the copyright holder be liable for any direct, indirect, incidental, *
|
|
24
|
+
* special, exemplary or consequential damages (including but not limited *
|
|
25
|
+
* to procurement of substitute goods or services, loss of use, data, *
|
|
26
|
+
* interruption), however caused and on any theory of liability, whether in *
|
|
27
|
+
* contract, strict liability or tort (including negligence) arising in any *
|
|
28
|
+
* way out of the use of the software, even if advised of the possibility of *
|
|
29
|
+
* such damage. *
|
|
30
|
+
* *
|
|
31
|
+
* 5. It is permitted for the user to change the software, for the purpose of *
|
|
32
|
+
* improving performance, correcting an error, or porting to a new platform, *
|
|
33
|
+
* and distribute the derived version of Shen provided the resulting program *
|
|
34
|
+
* conforms in all respects to the Shen standard and is issued under that *
|
|
35
|
+
* title. The user must make it clear with his distribution that he/she is *
|
|
36
|
+
* the author of the changes and what these changes are and why. *
|
|
37
|
+
* *
|
|
38
|
+
* 6. Derived versions of this software in whatever form are subject to the same *
|
|
39
|
+
* restrictions. In particular it is not permitted to make derived copies of *
|
|
40
|
+
* this software which do not conform to the Shen standard or appear under a *
|
|
41
|
+
* different title. *
|
|
42
|
+
* *
|
|
43
|
+
* It is permitted to distribute versions of Shen which incorporate libraries, *
|
|
44
|
+
* graphics or other facilities which are not part of the Shen standard. *
|
|
45
|
+
* *
|
|
46
|
+
* For an explication of this license see www.shenlanguage.org/license.htm which *
|
|
47
|
+
* explains this license in full. *
|
|
48
|
+
* *
|
|
49
|
+
*****************************************************************************************
|
|
50
|
+
"(set shen.*installing-kl* false)
|
|
2
51
|
|
|
3
52
|
(set shen.*history* ())
|
|
4
53
|
|
|
@@ -60,23 +109,23 @@
|
|
|
60
109
|
|
|
61
110
|
(set shen.*optimise* false)
|
|
62
111
|
|
|
63
|
-
(set *version* "version
|
|
112
|
+
(set *version* "version 15")
|
|
64
113
|
|
|
65
|
-
(defun shen.initialise_arity_table (
|
|
114
|
+
(defun shen.initialise_arity_table (V827) (cond ((= () V827) ()) ((and (cons? V827) (cons? (tl V827))) (let DecArity (put (hd V827) arity (hd (tl V827)) (value *property-vector*)) (shen.initialise_arity_table (tl (tl V827))))) (true (shen.sys-error shen.initialise_arity_table))))
|
|
66
115
|
|
|
67
|
-
(defun arity (
|
|
116
|
+
(defun arity (V828) (trap-error (get V828 arity (value *property-vector*)) (lambda E -1)))
|
|
68
117
|
|
|
69
|
-
(shen.initialise_arity_table (cons absvector (cons 1 (cons adjoin (cons 2 (cons and (cons 2 (cons append (cons 2 (cons arity (cons 1 (cons assoc (cons 2 (cons boolean? (cons 1 (cons cd (cons 1 (cons compile (cons 3 (cons concat (cons 2 (cons cons (cons 2 (cons cons? (cons 1 (cons cn (cons 2 (cons declare (cons 2 (cons destroy (cons 1 (cons difference (cons 2 (cons do (cons 2 (cons element? (cons 2 (cons empty? (cons 1 (cons enable-type-theory (cons 1 (cons interror (cons 2 (cons eval (cons 1 (cons eval-kl (cons 1 (cons explode (cons 1 (cons external (cons 1 (cons fail-if (cons 2 (cons fail (cons 0 (cons fix (cons 2 (cons findall (cons 5 (cons freeze (cons 1 (cons fst (cons 1 (cons gensym (cons 1 (cons get (cons 3 (cons get-time (cons 1 (cons address-> (cons 3 (cons <-address (cons 2 (cons <-vector (cons 2 (cons > (cons 2 (cons >= (cons 2 (cons = (cons 2 (cons hd (cons 1 (cons hdv (cons 1 (cons hdstr (cons 1 (cons head (cons 1 (cons if (cons 3 (cons integer? (cons 1 (cons intern (cons 1 (cons identical (cons 4 (cons inferences (cons 0 (cons input (cons 1 (cons input+ (cons 2 (cons implementation (cons 0 (cons intersection (cons 2 (cons language (cons 0 (cons length (cons 1 (cons lineread (cons 1 (cons load (cons 1 (cons < (cons 2 (cons <= (cons 2 (cons vector (cons 1 (cons macroexpand (cons 1 (cons map (cons 2 (cons mapcan (cons 2 (cons maxinferences (cons 1 (cons not (cons 1 (cons nth (cons 2 (cons n->string (cons 1 (cons number? (cons 1 (cons occurs-check (cons 1 (cons occurrences (cons 2 (cons occurs-check (cons 1 (cons optimise (cons 1 (cons or (cons 2 (cons os (cons 0 (cons package (cons 3 (cons port (cons 0 (cons porters (cons 0 (cons pos (cons 2 (cons print (cons 1 (cons profile (cons 1 (cons profile-results (cons 1 (cons pr (cons 2 (cons ps (cons 1 (cons preclude (cons 1 (cons preclude-all-but (cons 1 (cons protect (cons 1 (cons address-> (cons 3 (cons put (cons 4 (cons shen.reassemble (cons 2 (cons read-file-as-string (cons 1 (cons read-file (cons 1 (cons read (cons 1 (cons read-byte (cons 1 (cons read-from-string (cons 1 (cons release (cons 0 (cons remove (cons 2 (cons reverse (cons 1 (cons set (cons 2 (cons simple-error (cons 1 (cons snd (cons 1 (cons specialise (cons 1 (cons spy (cons 1 (cons step (cons 1 (cons stinput (cons 0 (cons stoutput (cons 0 (cons string->n (cons 1 (cons string->symbol (cons 1 (cons string? (cons 1 (cons shen.strong-warning (cons 1 (cons subst (cons 3 (cons sum (cons 1 (cons symbol? (cons 1 (cons tail (cons 1 (cons tl (cons 1 (cons tc (cons 1 (cons tc? (cons 0 (cons thaw (cons 1 (cons tlstr (cons 1 (cons track (cons 1 (cons trap-error (cons 2 (cons tuple? (cons 1 (cons type (cons 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 0 (cons warn (cons 1 (cons write-byte (cons 2 (cons write-to-file (cons 2 (cons y-or-n? (cons 1 (cons + (cons 2 (cons * (cons 2 (cons / (cons 2 (cons - (cons 2 (cons == (cons 2 (cons <e> (cons 1 (cons @p (cons 2 (cons @v (cons 2 (cons @s (cons 2 (cons preclude (cons 1 (cons include (cons 1 (cons preclude-all-but (cons 1 (cons include-all-but (cons 1 (cons where (cons 2 ())))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
|
|
118
|
+
(shen.initialise_arity_table (cons absvector (cons 1 (cons adjoin (cons 2 (cons and (cons 2 (cons append (cons 2 (cons arity (cons 1 (cons assoc (cons 2 (cons boolean? (cons 1 (cons cd (cons 1 (cons compile (cons 3 (cons concat (cons 2 (cons cons (cons 2 (cons cons? (cons 1 (cons cn (cons 2 (cons declare (cons 2 (cons destroy (cons 1 (cons difference (cons 2 (cons do (cons 2 (cons element? (cons 2 (cons empty? (cons 1 (cons enable-type-theory (cons 1 (cons interror (cons 2 (cons eval (cons 1 (cons eval-kl (cons 1 (cons explode (cons 1 (cons external (cons 1 (cons fail-if (cons 2 (cons fail (cons 0 (cons fix (cons 2 (cons findall (cons 5 (cons freeze (cons 1 (cons fst (cons 1 (cons gensym (cons 1 (cons get (cons 3 (cons get-time (cons 1 (cons address-> (cons 3 (cons <-address (cons 2 (cons <-vector (cons 2 (cons > (cons 2 (cons >= (cons 2 (cons = (cons 2 (cons hd (cons 1 (cons hdv (cons 1 (cons hdstr (cons 1 (cons head (cons 1 (cons if (cons 3 (cons integer? (cons 1 (cons intern (cons 1 (cons identical (cons 4 (cons inferences (cons 0 (cons input (cons 1 (cons input+ (cons 2 (cons implementation (cons 0 (cons intersection (cons 2 (cons kill (cons 0 (cons language (cons 0 (cons length (cons 1 (cons lineread (cons 1 (cons load (cons 1 (cons < (cons 2 (cons <= (cons 2 (cons vector (cons 1 (cons macroexpand (cons 1 (cons map (cons 2 (cons mapcan (cons 2 (cons maxinferences (cons 1 (cons not (cons 1 (cons nth (cons 2 (cons n->string (cons 1 (cons number? (cons 1 (cons occurs-check (cons 1 (cons occurrences (cons 2 (cons occurs-check (cons 1 (cons optimise (cons 1 (cons or (cons 2 (cons os (cons 0 (cons package (cons 3 (cons port (cons 0 (cons porters (cons 0 (cons pos (cons 2 (cons print (cons 1 (cons profile (cons 1 (cons profile-results (cons 1 (cons pr (cons 2 (cons ps (cons 1 (cons preclude (cons 1 (cons preclude-all-but (cons 1 (cons protect (cons 1 (cons address-> (cons 3 (cons put (cons 4 (cons shen.reassemble (cons 2 (cons read-file-as-string (cons 1 (cons read-file (cons 1 (cons read (cons 1 (cons read-byte (cons 1 (cons read-from-string (cons 1 (cons release (cons 0 (cons remove (cons 2 (cons reverse (cons 1 (cons set (cons 2 (cons simple-error (cons 1 (cons snd (cons 1 (cons specialise (cons 1 (cons spy (cons 1 (cons step (cons 1 (cons stinput (cons 0 (cons stoutput (cons 0 (cons string->n (cons 1 (cons string->symbol (cons 1 (cons string? (cons 1 (cons shen.strong-warning (cons 1 (cons subst (cons 3 (cons sum (cons 1 (cons symbol? (cons 1 (cons tail (cons 1 (cons tl (cons 1 (cons tc (cons 1 (cons tc? (cons 0 (cons thaw (cons 1 (cons tlstr (cons 1 (cons track (cons 1 (cons trap-error (cons 2 (cons tuple? (cons 1 (cons type (cons 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 0 (cons warn (cons 1 (cons write-byte (cons 2 (cons write-to-file (cons 2 (cons y-or-n? (cons 1 (cons + (cons 2 (cons * (cons 2 (cons / (cons 2 (cons - (cons 2 (cons == (cons 2 (cons <e> (cons 1 (cons @p (cons 2 (cons @v (cons 2 (cons @s (cons 2 (cons preclude (cons 1 (cons include (cons 1 (cons preclude-all-but (cons 1 (cons include-all-but (cons 1 (cons where (cons 2 ())))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
|
|
70
119
|
|
|
71
|
-
(defun systemf (
|
|
120
|
+
(defun systemf (V829) (let Shen (intern "shen") (let External (get Shen shen.external-symbols (value *property-vector*)) (put Shen shen.external-symbols (adjoin V829 External) (value *property-vector*)))))
|
|
72
121
|
|
|
73
|
-
(defun adjoin (
|
|
122
|
+
(defun adjoin (V830 V831) (if (element? V830 V831) V831 (cons V830 V831)))
|
|
74
123
|
|
|
75
|
-
(put (intern "shen") shen.external-symbols (cons ! (cons } (cons { (cons --> (cons <-- (cons && (cons : (cons ; (cons :- (cons := (cons _ (cons *language* (cons *implementation* (cons *stinput* (cons *home-directory* (cons *version* (cons *maximum-print-sequence-size* (cons *macros* (cons *os* (cons *release* (cons *property-vector* (cons @v (cons @p (cons @s (cons *port* (cons *porters* (cons *hush* (cons <- (cons -> (cons <e> (cons == (cons = (cons >= (cons > (cons /. (cons =! (cons $ (cons - (cons / (cons * (cons + (cons <= (cons < (cons >> (cons (vector 0) (cons ==> (cons y-or-n? (cons write-to-file (cons write-byte (cons where (cons when (cons warn (cons version (cons verified (cons variable? (cons value (cons vector-> (cons <-vector (cons vector (cons vector? (cons unspecialise (cons untrack (cons unit (cons shen.unix (cons union (cons unify (cons unify! (cons unprofile (cons undefmacro (cons return (cons type (cons tuple? (cons true (cons trap-error (cons track (cons time (cons thaw (cons tc? (cons tc (cons tl (cons tlstr (cons tlv (cons tail (cons systemf (cons synonyms (cons symbol (cons symbol? (cons string->symbol (cons subst (cons string? (cons string->n (cons stream (cons string (cons stinput (cons stoutput (cons step (cons spy (cons specialise (cons snd (cons simple-error (cons set (cons save (cons str (cons run (cons reverse (cons remove (cons release (cons read (cons read+ (cons read-file (cons read-file-as-bytelist (cons read-file-as-string (cons read-byte (cons read-from-string (cons quit (cons put (cons preclude (cons preclude-all-but (cons ps (cons prolog? (cons protect (cons profile-results (cons profile (cons print (cons pr (cons pos (cons porters (cons port (cons package (cons output (cons out (cons os (cons or (cons open (cons occurrences (cons occurs-check (cons n->string (cons number? (cons number (cons null (cons nth (cons not (cons nl (cons mode (cons macro (cons macroexpand (cons maxinferences (cons mapcan (cons map (cons make-string (cons load (cons loaded (cons list (cons lineread (cons limit (cons length (cons let (cons lazy (cons lambda (cons language (cons is (cons intersection (cons inferences (cons intern (cons integer? (cons input (cons input+ (cons include (cons include-all-but (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*))
|
|
124
|
+
(put (intern "shen") shen.external-symbols (cons ! (cons } (cons { (cons --> (cons <-- (cons && (cons : (cons ; (cons :- (cons := (cons _ (cons *language* (cons *implementation* (cons *stinput* (cons *home-directory* (cons *version* (cons *maximum-print-sequence-size* (cons *macros* (cons *os* (cons *release* (cons *property-vector* (cons @v (cons @p (cons @s (cons *port* (cons *porters* (cons *hush* (cons <- (cons -> (cons <e> (cons == (cons = (cons >= (cons > (cons /. (cons =! (cons $ (cons - (cons / (cons * (cons + (cons <= (cons < (cons >> (cons (vector 0) (cons ==> (cons y-or-n? (cons write-to-file (cons write-byte (cons where (cons when (cons warn (cons version (cons verified (cons variable? (cons value (cons vector-> (cons <-vector (cons vector (cons vector? (cons unspecialise (cons untrack (cons unit (cons shen.unix (cons union (cons unify (cons unify! (cons unprofile (cons undefmacro (cons return (cons type (cons tuple? (cons true (cons trap-error (cons track (cons time (cons thaw (cons tc? (cons tc (cons tl (cons tlstr (cons tlv (cons tail (cons systemf (cons synonyms (cons symbol (cons symbol? (cons string->symbol (cons subst (cons string? (cons string->n (cons stream (cons string (cons stinput (cons stoutput (cons step (cons spy (cons specialise (cons snd (cons simple-error (cons set (cons save (cons str (cons run (cons reverse (cons remove (cons release (cons read (cons read+ (cons read-file (cons read-file-as-bytelist (cons read-file-as-string (cons read-byte (cons read-from-string (cons quit (cons put (cons preclude (cons preclude-all-but (cons ps (cons prolog? (cons protect (cons profile-results (cons profile (cons print (cons pr (cons pos (cons porters (cons port (cons package (cons output (cons out (cons os (cons or (cons open (cons occurrences (cons occurs-check (cons n->string (cons number? (cons number (cons null (cons nth (cons not (cons nl (cons mode (cons macro (cons macroexpand (cons maxinferences (cons mapcan (cons map (cons make-string (cons load (cons loaded (cons list (cons lineread (cons limit (cons length (cons let (cons lazy (cons lambda (cons language (cons kill (cons is (cons intersection (cons inferences (cons intern (cons integer? (cons input (cons input+ (cons include (cons include-all-but (cons 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*))
|
|
76
125
|
|
|
77
|
-
(defun specialise (
|
|
126
|
+
(defun specialise (V832) (do (set shen.*special* (cons V832 (value shen.*special*))) V832))
|
|
78
127
|
|
|
79
|
-
(defun unspecialise (
|
|
128
|
+
(defun unspecialise (V833) (do (set shen.*special* (remove V833 (value shen.*special*))) V833))
|
|
80
129
|
|
|
81
130
|
|
|
82
131
|
|