shen-ruby 0.14.0 → 0.15.0
Sign up to get free protection for your applications and to get access to all the features.
- checksums.yaml +4 -4
- data/.travis.yml +1 -1
- data/HISTORY.md +6 -3
- data/README.md +10 -7
- data/bin/shen-ruby +21 -0
- data/bin/shen_ruby +21 -0
- data/lib/shen_ruby/converters.rb +2 -4
- data/lib/shen_ruby/shen.rb +1 -1
- data/lib/shen_ruby/version.rb +1 -1
- data/shen/release/klambda/core.kl +67 -63
- data/shen/release/klambda/declarations.kl +92 -84
- data/shen/release/klambda/load.kl +15 -15
- data/shen/release/klambda/macros.kl +34 -33
- data/shen/release/klambda/prolog.kl +96 -98
- data/shen/release/klambda/reader.kl +83 -83
- data/shen/release/klambda/sequent.kl +55 -55
- data/shen/release/klambda/sys.kl +106 -101
- data/shen/release/klambda/t-star.kl +41 -41
- data/shen/release/klambda/toplevel.kl +21 -21
- data/shen/release/klambda/track.kl +25 -25
- data/shen/release/klambda/types.kl +6 -4
- data/shen/release/klambda/writer.kl +25 -25
- data/shen/release/klambda/yacc.kl +28 -28
- data/shen-ruby.gemspec +3 -3
- metadata +9 -5
|
@@ -23,87 +23,95 @@ ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
|
|
|
23
23
|
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
|
|
24
24
|
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE."
|
|
25
25
|
|
|
26
|
-
(set shen.*installing-kl* false)
|
|
27
|
-
|
|
28
|
-
(set shen.*history* ())
|
|
29
|
-
|
|
30
|
-
(set shen.*tc* false)
|
|
31
|
-
|
|
32
|
-
(set *property-vector* (vector 20000))
|
|
33
|
-
|
|
34
|
-
(set shen.*process-counter* 0)
|
|
35
|
-
|
|
36
|
-
(set shen.*varcounter* (vector 1000))
|
|
37
|
-
|
|
38
|
-
(set shen.*prologvectors* (vector 1000))
|
|
39
|
-
|
|
40
|
-
(set shen.*macroreg* (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.input-macro (cons shen.error-macro (cons shen.prolog-macro (cons shen.synonyms-macro (cons shen.nl-macro (cons shen.@s-macro (cons shen.defprolog-macro (cons shen.function-macro ())))))))))))))))))))
|
|
41
|
-
|
|
42
|
-
(set *macros* (cons (lambda X (shen.timer-macro X)) (cons (lambda X (shen.cases-macro X)) (cons (lambda X (shen.abs-macro X)) (cons (lambda X (shen.put/get-macro X)) (cons (lambda X (shen.compile-macro X)) (cons (lambda X (shen.datatype-macro X)) (cons (lambda X (shen.let-macro X)) (cons (lambda X (shen.assoc-macro X)) (cons (lambda X (shen.make-string-macro X)) (cons (lambda X (shen.output-macro X)) (cons (lambda X (shen.input-macro X)) (cons (lambda X (shen.error-macro X)) (cons (lambda X (shen.prolog-macro X)) (cons (lambda X (shen.synonyms-macro X)) (cons (lambda X (shen.nl-macro X)) (cons (lambda X (shen.@s-macro X)) (cons (lambda X (shen.defprolog-macro X)) (cons (lambda X (shen.function-macro X)) ())))))))))))))))))))
|
|
43
|
-
|
|
44
|
-
(set *home-directory* ())
|
|
45
|
-
|
|
46
|
-
(set shen.*gensym* 0)
|
|
47
|
-
|
|
48
|
-
(set shen.*tracking* ())
|
|
49
|
-
|
|
50
|
-
(set *home-directory* "")
|
|
51
|
-
|
|
52
|
-
(set shen.*alphabet* (cons A (cons B (cons C (cons D (cons E (cons F (cons G (cons H (cons I (cons J (cons K (cons L (cons M (cons N (cons O (cons P (cons Q (cons R (cons S (cons T (cons U (cons V (cons W (cons X (cons Y (cons Z ())))))))))))))))))))))))))))
|
|
53
|
-
|
|
54
|
-
(set shen.*special* (cons @p (cons @s (cons @v (cons cons (cons lambda (cons let (cons where (cons set (cons open ()))))))))))
|
|
55
|
-
|
|
56
|
-
(set shen.*extraspecial* (cons define (cons shen.process-datatype (cons input+ (cons defcc (cons shen.read+ (cons defmacro ())))))))
|
|
57
|
-
|
|
58
|
-
(set shen.*spy* false)
|
|
59
|
-
|
|
60
|
-
(set shen.*datatypes* ())
|
|
61
|
-
|
|
62
|
-
(set shen.*alldatatypes* ())
|
|
63
|
-
|
|
64
|
-
(set shen.*shen-type-theory-enabled?* true)
|
|
65
|
-
|
|
66
|
-
(set shen.*synonyms* ())
|
|
67
|
-
|
|
68
|
-
(set shen.*system* ())
|
|
69
|
-
|
|
70
|
-
(set shen.*signedfuncs* ())
|
|
71
|
-
|
|
72
|
-
(set shen.*maxcomplexity* 128)
|
|
73
|
-
|
|
74
|
-
(set shen.*occurs* true)
|
|
75
|
-
|
|
76
|
-
(set shen.*maxinferences* 1000000)
|
|
77
|
-
|
|
78
|
-
(set *maximum-print-sequence-size* 20)
|
|
79
|
-
|
|
80
|
-
(set shen.*catch* 0)
|
|
81
|
-
|
|
82
|
-
(set shen.*call* 0)
|
|
83
|
-
|
|
84
|
-
(set shen.*infs* 0)
|
|
85
|
-
|
|
86
|
-
(set *hush* false)
|
|
87
|
-
|
|
88
|
-
(set shen.*optimise* false)
|
|
89
|
-
|
|
90
|
-
(set *version* "Shen
|
|
91
|
-
|
|
92
|
-
(defun shen.initialise_arity_table (
|
|
93
|
-
|
|
94
|
-
(defun arity (
|
|
95
|
-
|
|
96
|
-
(shen.initialise_arity_table (cons absvector (cons 1 (cons adjoin (cons 2 (cons and (cons 2 (cons append (cons 2 (cons arity (cons 1 (cons assoc (cons 2 (cons boolean? (cons 1 (cons cd (cons 1 (cons compile (cons 3 (cons concat (cons 2 (cons cons (cons 2 (cons cons? (cons 1 (cons cn (cons 2 (cons declare (cons 2 (cons destroy (cons 1 (cons difference (cons 2 (cons do (cons 2 (cons element? (cons 2 (cons empty? (cons 1 (cons enable-type-theory (cons 1 (cons shen.interror (cons 2 (cons eval (cons 1 (cons eval-kl (cons 1 (cons explode (cons 1 (cons external (cons 1 (cons fail-if (cons 2 (cons fail (cons 0 (cons fix (cons 2 (cons findall (cons 5 (cons freeze (cons 1 (cons fst (cons 1 (cons gensym (cons 1 (cons get (cons 3 (cons get-time (cons 1 (cons address-> (cons 3 (cons <-address (cons 2 (cons <-vector (cons 2 (cons > (cons 2 (cons >= (cons 2 (cons = (cons 2 (cons hd (cons 1 (cons hdv (cons 1 (cons hdstr (cons 1 (cons head (cons 1 (cons if (cons 3 (cons integer? (cons 1 (cons intern (cons 1 (cons identical (cons 4 (cons inferences (cons 0 (cons input (cons 1 (cons input+ (cons 2 (cons implementation (cons 0 (cons intersection (cons 2 (cons it (cons 0 (cons kill (cons 0 (cons language (cons 0 (cons length (cons 1 (cons lineread (cons 1 (cons load (cons 1 (cons < (cons 2 (cons <= (cons 2 (cons vector (cons 1 (cons macroexpand (cons 1 (cons map (cons 2 (cons mapcan (cons 2 (cons maxinferences (cons 1 (cons not (cons 1 (cons nth (cons 2 (cons n->string (cons 1 (cons number? (cons 1 (cons occurs-check (cons 1 (cons occurrences (cons 2 (cons occurs-check (cons 1 (cons optimise (cons 1 (cons or (cons 2 (cons os (cons 0 (cons package (cons 3 (cons package? (cons 1 (cons port (cons 0 (cons porters (cons 0 (cons pos (cons 2 (cons print (cons 1 (cons profile (cons 1 (cons profile-results (cons 1 (cons pr (cons 2 (cons ps (cons 1 (cons preclude (cons 1 (cons preclude-all-but (cons 1 (cons protect (cons 1 (cons address-> (cons 3 (cons put (cons 4 (cons shen.reassemble (cons 2 (cons read-file-as-string (cons 1 (cons read-file (cons 1 (cons read (cons 1 (cons read-byte (cons 1 (cons read-from-string (cons 1 (cons release (cons 0 (cons remove (cons 2 (cons require (cons 3 (cons reverse (cons 1 (cons set (cons 2 (cons simple-error (cons 1 (cons snd (cons 1 (cons specialise (cons 1 (cons spy (cons 1 (cons step (cons 1 (cons stinput (cons 0 (cons stoutput (cons 0 (cons string->n (cons 1 (cons string->symbol (cons 1 (cons string? (cons 1 (cons subst (cons 3 (cons sum (cons 1 (cons symbol? (cons 1 (cons tail (cons 1 (cons tl (cons 1 (cons tc (cons 1 (cons tc? (cons 0 (cons thaw (cons 1 (cons tlstr (cons 1 (cons track (cons 1 (cons trap-error (cons 2 (cons tuple? (cons 1 (cons type (cons 2 (cons return (cons 3 (cons undefmacro (cons 1 (cons unput (cons 3 (cons unprofile (cons 1 (cons unify (cons 4 (cons unify! (cons 4 (cons union (cons 2 (cons untrack (cons 1 (cons unspecialise (cons 1 (cons undefmacro (cons 1 (cons vector (cons 1 (cons vector-> (cons 3 (cons value (cons 1 (cons variable? (cons 1 (cons version (cons 0 (cons write-byte (cons 2 (cons write-to-file (cons 2 (cons y-or-n? (cons 1 (cons + (cons 2 (cons * (cons 2 (cons / (cons 2 (cons - (cons 2 (cons == (cons 2 (cons <e> (cons 1 (cons @p (cons 2 (cons @v (cons 2 (cons @s (cons 2 (cons preclude (cons 1 (cons include (cons 1 (cons preclude-all-but (cons 1 (cons include-all-but (cons 1 (cons where (cons 2 ())))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
|
|
97
|
-
|
|
98
|
-
(defun systemf (
|
|
99
|
-
|
|
100
|
-
(defun adjoin (
|
|
101
|
-
|
|
102
|
-
(put (intern "shen") shen.external-symbols (cons ! (cons } (cons { (cons --> (cons <-- (cons && (cons : (cons ; (cons :- (cons := (cons _ (cons *language* (cons *implementation* (cons *stinput* (cons *stoutput* (cons *home-directory* (cons *version* (cons *maximum-print-sequence-size* (cons *macros* (cons *os* (cons *release* (cons *property-vector* (cons @v (cons @p (cons @s (cons *port* (cons *porters* (cons *hush* (cons <- (cons -> (cons <e> (cons == (cons = (cons >= (cons > (cons /. (cons =! (cons $ (cons - (cons / (cons * (cons + (cons <= (cons < (cons >> (cons (vector 0) (cons y-or-n? (cons write-to-file (cons write-byte (cons where (cons when (cons warn (cons version (cons verified (cons variable? (cons value (cons vector-> (cons <-vector (cons vector (cons vector? (cons unspecialise (cons untrack (cons unit (cons shen.unix (cons union (cons unify (cons unify! (cons unput (cons unprofile (cons undefmacro (cons return (cons type (cons tuple? (cons true (cons trap-error (cons track (cons time (cons thaw (cons tc? (cons tc (cons tl (cons tlstr (cons tlv (cons tail (cons systemf (cons synonyms (cons symbol (cons symbol? (cons string->symbol (cons sum (cons subst (cons string? (cons string->n (cons stream (cons string (cons stinput (cons stoutput (cons step (cons spy (cons specialise (cons snd (cons simple-error (cons set (cons save (cons str (cons run (cons reverse (cons remove (cons release (cons read (cons read-file (cons require (cons read-file-as-bytelist (cons read-file-as-string (cons read-byte (cons read-from-string (cons package? (cons put (cons preclude (cons preclude-all-but (cons ps (cons prolog? (cons protect (cons profile-results (cons profile (cons print (cons pr (cons pos (cons porters (cons port (cons package (cons output (cons out (cons os (cons or (cons optimise (cons open (cons occurrences (cons occurs-check (cons n->string (cons number? (cons number (cons null (cons nth (cons not (cons nl (cons mode (cons macroexpand (cons maxinferences (cons mapcan (cons map (cons make-string (cons load (cons loaded (cons list (cons lineread (cons limit (cons length (cons let (cons lazy (cons lambda (cons language (cons kill (cons is (cons intersection (cons inferences (cons intern (cons integer? (cons input (cons input+ (cons include (cons include-all-but (cons it (cons in (cons implementation (cons if (cons identical (cons head (cons hd (cons hdv (cons hdstr (cons hash (cons get (cons get-time (cons gensym (cons function (cons fst (cons freeze (cons fix (cons file (cons fail (cons fail-if (cons fwhen (cons findall (cons false (cons enable-type-theory (cons explode (cons external (cons exception (cons eval-kl (cons eval (cons error-to-string (cons error (cons empty? (cons element? (cons do (cons difference (cons destroy (cons defun (cons define (cons defmacro (cons defcc (cons defprolog (cons declare (cons datatype (cons cut (cons cn (cons cons? (cons cons (cons cond (cons concat (cons compile (cons cd (cons cases (cons call (cons close (cons bind (cons bound? (cons boolean? (cons boolean (cons bar! (cons assoc (cons arity (cons append (cons and (cons adjoin (cons <-address (cons address-> (cons absvector? (cons absvector (cons abort ()))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) (value *property-vector*))
|
|
103
|
-
|
|
104
|
-
(defun
|
|
105
|
-
|
|
106
|
-
(defun
|
|
107
|
-
|
|
108
|
-
|
|
109
|
-
|
|
26
|
+
(set shen.*installing-kl* false)
|
|
27
|
+
|
|
28
|
+
(set shen.*history* ())
|
|
29
|
+
|
|
30
|
+
(set shen.*tc* false)
|
|
31
|
+
|
|
32
|
+
(set *property-vector* (vector 20000))
|
|
33
|
+
|
|
34
|
+
(set shen.*process-counter* 0)
|
|
35
|
+
|
|
36
|
+
(set shen.*varcounter* (vector 1000))
|
|
37
|
+
|
|
38
|
+
(set shen.*prologvectors* (vector 1000))
|
|
39
|
+
|
|
40
|
+
(set shen.*macroreg* (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.input-macro (cons shen.error-macro (cons shen.prolog-macro (cons shen.synonyms-macro (cons shen.nl-macro (cons shen.@s-macro (cons shen.defprolog-macro (cons shen.function-macro ())))))))))))))))))))
|
|
41
|
+
|
|
42
|
+
(set *macros* (cons (lambda X (shen.timer-macro X)) (cons (lambda X (shen.cases-macro X)) (cons (lambda X (shen.abs-macro X)) (cons (lambda X (shen.put/get-macro X)) (cons (lambda X (shen.compile-macro X)) (cons (lambda X (shen.datatype-macro X)) (cons (lambda X (shen.let-macro X)) (cons (lambda X (shen.assoc-macro X)) (cons (lambda X (shen.make-string-macro X)) (cons (lambda X (shen.output-macro X)) (cons (lambda X (shen.input-macro X)) (cons (lambda X (shen.error-macro X)) (cons (lambda X (shen.prolog-macro X)) (cons (lambda X (shen.synonyms-macro X)) (cons (lambda X (shen.nl-macro X)) (cons (lambda X (shen.@s-macro X)) (cons (lambda X (shen.defprolog-macro X)) (cons (lambda X (shen.function-macro X)) ())))))))))))))))))))
|
|
43
|
+
|
|
44
|
+
(set *home-directory* ())
|
|
45
|
+
|
|
46
|
+
(set shen.*gensym* 0)
|
|
47
|
+
|
|
48
|
+
(set shen.*tracking* ())
|
|
49
|
+
|
|
50
|
+
(set *home-directory* "")
|
|
51
|
+
|
|
52
|
+
(set shen.*alphabet* (cons A (cons B (cons C (cons D (cons E (cons F (cons G (cons H (cons I (cons J (cons K (cons L (cons M (cons N (cons O (cons P (cons Q (cons R (cons S (cons T (cons U (cons V (cons W (cons X (cons Y (cons Z ())))))))))))))))))))))))))))
|
|
53
|
+
|
|
54
|
+
(set shen.*special* (cons @p (cons @s (cons @v (cons cons (cons lambda (cons let (cons where (cons set (cons open ()))))))))))
|
|
55
|
+
|
|
56
|
+
(set shen.*extraspecial* (cons define (cons shen.process-datatype (cons input+ (cons defcc (cons shen.read+ (cons defmacro ())))))))
|
|
57
|
+
|
|
58
|
+
(set shen.*spy* false)
|
|
59
|
+
|
|
60
|
+
(set shen.*datatypes* ())
|
|
61
|
+
|
|
62
|
+
(set shen.*alldatatypes* ())
|
|
63
|
+
|
|
64
|
+
(set shen.*shen-type-theory-enabled?* true)
|
|
65
|
+
|
|
66
|
+
(set shen.*synonyms* ())
|
|
67
|
+
|
|
68
|
+
(set shen.*system* ())
|
|
69
|
+
|
|
70
|
+
(set shen.*signedfuncs* ())
|
|
71
|
+
|
|
72
|
+
(set shen.*maxcomplexity* 128)
|
|
73
|
+
|
|
74
|
+
(set shen.*occurs* true)
|
|
75
|
+
|
|
76
|
+
(set shen.*maxinferences* 1000000)
|
|
77
|
+
|
|
78
|
+
(set *maximum-print-sequence-size* 20)
|
|
79
|
+
|
|
80
|
+
(set shen.*catch* 0)
|
|
81
|
+
|
|
82
|
+
(set shen.*call* 0)
|
|
83
|
+
|
|
84
|
+
(set shen.*infs* 0)
|
|
85
|
+
|
|
86
|
+
(set *hush* false)
|
|
87
|
+
|
|
88
|
+
(set shen.*optimise* false)
|
|
89
|
+
|
|
90
|
+
(set *version* "Shen 18.1")
|
|
91
|
+
|
|
92
|
+
(defun shen.initialise_arity_table (V16223) (cond ((= () V16223) ()) ((and (cons? V16223) (cons? (tl V16223))) (let DecArity (put (hd V16223) arity (hd (tl V16223)) (value *property-vector*)) (shen.initialise_arity_table (tl (tl V16223))))) (true (shen.f_error shen.initialise_arity_table))))
|
|
93
|
+
|
|
94
|
+
(defun arity (V16225) (trap-error (get V16225 arity (value *property-vector*)) (lambda E -1)))
|
|
95
|
+
|
|
96
|
+
(shen.initialise_arity_table (cons abort (cons 0 (cons absvector? (cons 1 (cons absvector (cons 1 (cons adjoin (cons 2 (cons and (cons 2 (cons append (cons 2 (cons arity (cons 1 (cons assoc (cons 2 (cons boolean? (cons 1 (cons cd (cons 1 (cons compile (cons 3 (cons concat (cons 2 (cons cons (cons 2 (cons cons? (cons 1 (cons cn (cons 2 (cons declare (cons 2 (cons destroy (cons 1 (cons difference (cons 2 (cons do (cons 2 (cons element? (cons 2 (cons empty? (cons 1 (cons enable-type-theory (cons 1 (cons shen.interror (cons 2 (cons eval (cons 1 (cons eval-kl (cons 1 (cons explode (cons 1 (cons external (cons 1 (cons fail-if (cons 2 (cons fail (cons 0 (cons fix (cons 2 (cons findall (cons 5 (cons freeze (cons 1 (cons fst (cons 1 (cons gensym (cons 1 (cons get (cons 3 (cons get-time (cons 1 (cons address-> (cons 3 (cons <-address (cons 2 (cons <-vector (cons 2 (cons > (cons 2 (cons >= (cons 2 (cons = (cons 2 (cons hd (cons 1 (cons hdv (cons 1 (cons hdstr (cons 1 (cons head (cons 1 (cons if (cons 3 (cons integer? (cons 1 (cons intern (cons 1 (cons identical (cons 4 (cons inferences (cons 0 (cons input (cons 1 (cons input+ (cons 2 (cons implementation (cons 0 (cons intersection (cons 2 (cons it (cons 0 (cons kill (cons 0 (cons language (cons 0 (cons length (cons 1 (cons lineread (cons 1 (cons load (cons 1 (cons < (cons 2 (cons <= (cons 2 (cons vector (cons 1 (cons macroexpand (cons 1 (cons map (cons 2 (cons mapcan (cons 2 (cons maxinferences (cons 1 (cons not (cons 1 (cons nth (cons 2 (cons n->string (cons 1 (cons number? (cons 1 (cons occurs-check (cons 1 (cons occurrences (cons 2 (cons occurs-check (cons 1 (cons optimise (cons 1 (cons or (cons 2 (cons os (cons 0 (cons package (cons 3 (cons package? (cons 1 (cons port (cons 0 (cons porters (cons 0 (cons pos (cons 2 (cons print (cons 1 (cons profile (cons 1 (cons profile-results (cons 1 (cons pr (cons 2 (cons ps (cons 1 (cons preclude (cons 1 (cons preclude-all-but (cons 1 (cons protect (cons 1 (cons address-> (cons 3 (cons put (cons 4 (cons shen.reassemble (cons 2 (cons read-file-as-string (cons 1 (cons read-file (cons 1 (cons read (cons 1 (cons read-byte (cons 1 (cons read-from-string (cons 1 (cons release (cons 0 (cons remove (cons 2 (cons require (cons 3 (cons reverse (cons 1 (cons set (cons 2 (cons simple-error (cons 1 (cons snd (cons 1 (cons specialise (cons 1 (cons spy (cons 1 (cons step (cons 1 (cons stinput (cons 0 (cons stoutput (cons 0 (cons string->n (cons 1 (cons string->symbol (cons 1 (cons string? (cons 1 (cons subst (cons 3 (cons sum (cons 1 (cons symbol? (cons 1 (cons tail (cons 1 (cons tl (cons 1 (cons tc (cons 1 (cons tc? (cons 0 (cons thaw (cons 1 (cons tlstr (cons 1 (cons track (cons 1 (cons trap-error (cons 2 (cons tuple? (cons 1 (cons type (cons 2 (cons return (cons 3 (cons undefmacro (cons 1 (cons unput (cons 3 (cons unprofile (cons 1 (cons unify (cons 4 (cons unify! (cons 4 (cons union (cons 2 (cons untrack (cons 1 (cons unspecialise (cons 1 (cons undefmacro (cons 1 (cons vector (cons 1 (cons vector-> (cons 3 (cons value (cons 1 (cons variable? (cons 1 (cons version (cons 0 (cons write-byte (cons 2 (cons write-to-file (cons 2 (cons y-or-n? (cons 1 (cons + (cons 2 (cons * (cons 2 (cons / (cons 2 (cons - (cons 2 (cons == (cons 2 (cons <e> (cons 1 (cons @p (cons 2 (cons @v (cons 2 (cons @s (cons 2 (cons preclude (cons 1 (cons include (cons 1 (cons preclude-all-but (cons 1 (cons include-all-but (cons 1 (cons where (cons 2 ())))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
|
|
97
|
+
|
|
98
|
+
(defun systemf (V16227) (let Shen (intern "shen") (let External (get Shen shen.external-symbols (value *property-vector*)) (let Place (put Shen shen.external-symbols (adjoin V16227 External) (value *property-vector*)) V16227))))
|
|
99
|
+
|
|
100
|
+
(defun adjoin (V16230 V16231) (if (element? V16230 V16231) V16231 (cons V16230 V16231)))
|
|
101
|
+
|
|
102
|
+
(put (intern "shen") shen.external-symbols (cons ! (cons } (cons { (cons --> (cons <-- (cons && (cons : (cons ; (cons :- (cons := (cons _ (cons *language* (cons *implementation* (cons *stinput* (cons *stoutput* (cons *home-directory* (cons *version* (cons *maximum-print-sequence-size* (cons *macros* (cons *os* (cons *release* (cons *property-vector* (cons @v (cons @p (cons @s (cons *port* (cons *porters* (cons *hush* (cons <- (cons -> (cons <e> (cons == (cons = (cons >= (cons > (cons /. (cons =! (cons $ (cons - (cons / (cons * (cons + (cons <= (cons < (cons >> (cons (vector 0) (cons y-or-n? (cons write-to-file (cons write-byte (cons where (cons when (cons warn (cons version (cons verified (cons variable? (cons value (cons vector-> (cons <-vector (cons vector (cons vector? (cons unspecialise (cons untrack (cons unit (cons shen.unix (cons union (cons unify (cons unify! (cons unput (cons unprofile (cons undefmacro (cons return (cons type (cons tuple? (cons true (cons trap-error (cons track (cons time (cons thaw (cons tc? (cons tc (cons tl (cons tlstr (cons tlv (cons tail (cons systemf (cons synonyms (cons symbol (cons symbol? (cons string->symbol (cons sum (cons subst (cons string? (cons string->n (cons stream (cons string (cons stinput (cons stoutput (cons step (cons spy (cons specialise (cons snd (cons simple-error (cons set (cons save (cons str (cons run (cons reverse (cons remove (cons release (cons read (cons read-file (cons require (cons read-file-as-bytelist (cons read-file-as-string (cons read-byte (cons read-from-string (cons package? (cons put (cons preclude (cons preclude-all-but (cons ps (cons prolog? (cons protect (cons profile-results (cons profile (cons print (cons pr (cons pos (cons porters (cons port (cons package (cons output (cons out (cons os (cons or (cons optimise (cons open (cons occurrences (cons occurs-check (cons n->string (cons number? (cons number (cons null (cons nth (cons not (cons nl (cons mode (cons macroexpand (cons maxinferences (cons mapcan (cons map (cons make-string (cons load (cons loaded (cons list (cons lineread (cons limit (cons length (cons let (cons lazy (cons lambda (cons language (cons kill (cons is (cons intersection (cons inferences (cons intern (cons integer? (cons input (cons input+ (cons include (cons include-all-but (cons it (cons in (cons implementation (cons if (cons identical (cons head (cons hd (cons hdv (cons hdstr (cons hash (cons get (cons get-time (cons gensym (cons function (cons fst (cons freeze (cons fix (cons file (cons fail (cons fail-if (cons fwhen (cons findall (cons false (cons enable-type-theory (cons explode (cons external (cons exception (cons eval-kl (cons eval (cons error-to-string (cons error (cons empty? (cons element? (cons do (cons difference (cons destroy (cons defun (cons define (cons defmacro (cons defcc (cons defprolog (cons declare (cons datatype (cons cut (cons cn (cons cons? (cons cons (cons cond (cons concat (cons compile (cons cd (cons cases (cons call (cons close (cons bind (cons bound? (cons boolean? (cons boolean (cons bar! (cons assoc (cons arity (cons append (cons and (cons adjoin (cons <-address (cons address-> (cons absvector? (cons absvector (cons abort ()))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) (value *property-vector*))
|
|
103
|
+
|
|
104
|
+
(defun shen.symbol-table-entry (V16233) (let ArityF (arity V16233) (if (= ArityF -1) () (if (= ArityF 0) () (cons (cons V16233 (eval-kl (shen.lambda-form V16233 ArityF))) ())))))
|
|
105
|
+
|
|
106
|
+
(defun shen.lambda-form (V16236 V16237) (cond ((= 0 V16237) V16236) (true (let X (gensym V) (cons lambda (cons X (cons (shen.lambda-form (shen.add-end V16236 X) (- V16237 1)) ())))))))
|
|
107
|
+
|
|
108
|
+
(defun shen.add-end (V16240 V16241) (cond ((cons? V16240) (append V16240 (cons V16241 ()))) (true (cons V16240 (cons V16241 ())))))
|
|
109
|
+
|
|
110
|
+
(set shen.*symbol-table* (cons (cons shen.datatype-error (lambda X (shen.datatype-error X))) (cons (cons shen.tuple (lambda X (shen.tuple X))) (cons (cons shen.pvar (lambda X (shen.pvar X))) (mapcan (lambda X (shen.symbol-table-entry X)) (external (intern "shen")))))))
|
|
111
|
+
|
|
112
|
+
(defun specialise (V16243) (do (set shen.*special* (cons V16243 (value shen.*special*))) V16243))
|
|
113
|
+
|
|
114
|
+
(defun unspecialise (V16245) (do (set shen.*special* (remove V16245 (value shen.*special*))) V16245))
|
|
115
|
+
|
|
116
|
+
|
|
117
|
+
|
|
@@ -23,37 +23,37 @@ ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
|
|
|
23
23
|
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
|
|
24
24
|
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE."
|
|
25
25
|
|
|
26
|
-
(defun load (
|
|
26
|
+
(defun load (V16247) (let Load (let Start (get-time run) (let Result (shen.load-help (value shen.*tc*) (read-file V16247)) (let Finish (get-time run) (let Time (- Finish Start) (let Message (shen.prhush (cn "
|
|
27
27
|
run time: " (cn (str Time) " secs
|
|
28
28
|
")) (stoutput)) Result))))) (let Infs (if (value shen.*tc*) (shen.prhush (cn "
|
|
29
29
|
typechecked in " (shen.app (inferences) " inferences
|
|
30
30
|
" shen.a)) (stoutput)) shen.skip) loaded)))
|
|
31
31
|
|
|
32
|
-
(defun shen.load-help (
|
|
33
|
-
" shen.s) (stoutput)))
|
|
32
|
+
(defun shen.load-help (V16254 V16255) (cond ((= false V16254) (map (lambda X (shen.prhush (shen.app (shen.eval-without-macros X) "
|
|
33
|
+
" shen.s) (stoutput))) V16255)) (true (let RemoveSynonyms (mapcan (lambda X (shen.remove-synonyms X)) V16255) (let Table (mapcan (lambda X (shen.typetable X)) RemoveSynonyms) (let Assume (map (lambda X (shen.assumetype X)) Table) (trap-error (map (lambda X (shen.typecheck-and-load X)) RemoveSynonyms) (lambda E (shen.unwind-types E Table)))))))))
|
|
34
34
|
|
|
35
|
-
(defun shen.remove-synonyms (
|
|
35
|
+
(defun shen.remove-synonyms (V16257) (cond ((and (cons? V16257) (= shen.synonyms-help (hd V16257))) (do (eval V16257) ())) (true (cons V16257 ()))))
|
|
36
36
|
|
|
37
|
-
(defun shen.typecheck-and-load (
|
|
37
|
+
(defun shen.typecheck-and-load (V16259) (do (nl 1) (shen.typecheck-and-evaluate V16259 (gensym A))))
|
|
38
38
|
|
|
39
|
-
(defun shen.typetable (
|
|
40
|
-
" shen.a)))) (cons (cons (hd (tl
|
|
39
|
+
(defun shen.typetable (V16265) (cond ((and (cons? V16265) (and (= define (hd V16265)) (cons? (tl V16265)))) (let Sig (compile (lambda Y (shen.<sig+rest> Y)) (tl (tl V16265)) (lambda E (simple-error (shen.app (hd (tl V16265)) " lacks a proper signature.
|
|
40
|
+
" shen.a)))) (cons (cons (hd (tl V16265)) Sig) ()))) (true ())))
|
|
41
41
|
|
|
42
|
-
(defun shen.assumetype (
|
|
42
|
+
(defun shen.assumetype (V16267) (cond ((cons? V16267) (declare (hd V16267) (tl V16267))) (true (shen.f_error shen.assumetype))))
|
|
43
43
|
|
|
44
|
-
(defun shen.unwind-types (
|
|
44
|
+
(defun shen.unwind-types (V16274 V16275) (cond ((= () V16275) (simple-error (error-to-string V16274))) ((and (cons? V16275) (cons? (hd V16275))) (do (shen.remtype (hd (hd V16275))) (shen.unwind-types V16274 (tl V16275)))) (true (shen.f_error shen.unwind-types))))
|
|
45
45
|
|
|
46
|
-
(defun shen.remtype (
|
|
46
|
+
(defun shen.remtype (V16277) (set shen.*signedfuncs* (shen.removetype V16277 (value shen.*signedfuncs*))))
|
|
47
47
|
|
|
48
|
-
(defun shen.removetype (
|
|
48
|
+
(defun shen.removetype (V16285 V16286) (cond ((= () V16286) ()) ((and (cons? V16286) (and (cons? (hd V16286)) (= (hd (hd V16286)) V16285))) (shen.removetype (hd (hd V16286)) (tl V16286))) ((cons? V16286) (cons (hd V16286) (shen.removetype V16285 (tl V16286)))) (true (shen.f_error shen.removetype))))
|
|
49
49
|
|
|
50
|
-
(defun shen.<sig+rest> (
|
|
50
|
+
(defun shen.<sig+rest> (V16288) (let Parse_shen.<signature> (shen.<signature> V16288) (if (not (= (fail) Parse_shen.<signature>)) (let Parse_shen.<!> (shen.<!> Parse_shen.<signature>) (if (not (= (fail) Parse_shen.<!>)) (shen.pair (hd Parse_shen.<!>) (shen.hdtl Parse_shen.<signature>)) (fail))) (fail))))
|
|
51
51
|
|
|
52
|
-
(defun write-to-file (
|
|
52
|
+
(defun write-to-file (V16291 V16292) (let Stream (open V16291 out) (let String (if (string? V16292) (shen.app V16292 "
|
|
53
53
|
|
|
54
|
-
" shen.a) (shen.app
|
|
54
|
+
" shen.a) (shen.app V16292 "
|
|
55
55
|
|
|
56
|
-
" shen.s)) (let Write (pr String Stream) (let Close (close Stream)
|
|
56
|
+
" shen.s)) (let Write (pr String Stream) (let Close (close Stream) V16292)))))
|
|
57
57
|
|
|
58
58
|
|
|
59
59
|
|
|
@@ -23,69 +23,70 @@ ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
|
|
|
23
23
|
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
|
|
24
24
|
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE."
|
|
25
25
|
|
|
26
|
-
(defun macroexpand (
|
|
26
|
+
(defun macroexpand (V16294) (let Y (shen.compose (value *macros*) V16294) (if (= V16294 Y) V16294 (shen.walk (lambda Z (macroexpand Z)) Y))))
|
|
27
27
|
|
|
28
|
-
(defun shen.error-macro (
|
|
28
|
+
(defun shen.error-macro (V16296) (cond ((and (cons? V16296) (and (= error (hd V16296)) (cons? (tl V16296)))) (cons simple-error (cons (shen.mkstr (hd (tl V16296)) (tl (tl V16296))) ()))) (true V16296)))
|
|
29
29
|
|
|
30
|
-
(defun shen.output-macro (
|
|
30
|
+
(defun shen.output-macro (V16298) (cond ((and (cons? V16298) (and (= output (hd V16298)) (cons? (tl V16298)))) (cons shen.prhush (cons (shen.mkstr (hd (tl V16298)) (tl (tl V16298))) (cons (cons stoutput ()) ())))) ((and (cons? V16298) (and (= pr (hd V16298)) (and (cons? (tl V16298)) (= () (tl (tl V16298)))))) (cons pr (cons (hd (tl V16298)) (cons (cons stoutput ()) ())))) (true V16298)))
|
|
31
31
|
|
|
32
|
-
(defun shen.make-string-macro (
|
|
32
|
+
(defun shen.make-string-macro (V16300) (cond ((and (cons? V16300) (and (= make-string (hd V16300)) (cons? (tl V16300)))) (shen.mkstr (hd (tl V16300)) (tl (tl V16300)))) (true V16300)))
|
|
33
33
|
|
|
34
|
-
(defun shen.input-macro (
|
|
34
|
+
(defun shen.input-macro (V16302) (cond ((and (cons? V16302) (and (= lineread (hd V16302)) (= () (tl V16302)))) (cons lineread (cons (cons stinput ()) ()))) ((and (cons? V16302) (and (= input (hd V16302)) (= () (tl V16302)))) (cons input (cons (cons stinput ()) ()))) ((and (cons? V16302) (and (= read (hd V16302)) (= () (tl V16302)))) (cons read (cons (cons stinput ()) ()))) ((and (cons? V16302) (and (= input+ (hd V16302)) (and (cons? (tl V16302)) (= () (tl (tl V16302)))))) (cons input+ (cons (hd (tl V16302)) (cons (cons stinput ()) ())))) ((and (cons? V16302) (and (= read-byte (hd V16302)) (= () (tl V16302)))) (cons read-byte (cons (cons stinput ()) ()))) (true V16302)))
|
|
35
35
|
|
|
36
|
-
(defun shen.compose (
|
|
36
|
+
(defun shen.compose (V16305 V16306) (cond ((= () V16305) V16306) ((cons? V16305) (shen.compose (tl V16305) ((hd V16305) V16306))) (true (shen.f_error shen.compose))))
|
|
37
37
|
|
|
38
|
-
(defun shen.compile-macro (
|
|
38
|
+
(defun shen.compile-macro (V16308) (cond ((and (cons? V16308) (and (= compile (hd V16308)) (and (cons? (tl V16308)) (and (cons? (tl (tl V16308))) (= () (tl (tl (tl V16308)))))))) (cons compile (cons (hd (tl V16308)) (cons (hd (tl (tl V16308))) (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 V16308)))
|
|
39
39
|
|
|
40
|
-
(defun shen.prolog-macro (
|
|
40
|
+
(defun shen.prolog-macro (V16310) (cond ((and (cons? V16310) (= prolog? (hd V16310))) (let F (gensym shen.f) (let Receive (shen.receive-terms (tl V16310)) (let PrologDef (eval (append (cons defprolog (cons F ())) (append Receive (append (cons <-- ()) (append (shen.pass-literals (tl V16310)) (cons ; ())))))) (let Query (cons F (append Receive (cons (cons shen.start-new-prolog-process ()) (cons (cons freeze (cons true ())) ())))) Query))))) (true V16310)))
|
|
41
41
|
|
|
42
|
-
(defun shen.receive-terms (
|
|
42
|
+
(defun shen.receive-terms (V16316) (cond ((= () V16316) ()) ((and (cons? V16316) (and (cons? (hd V16316)) (and (= shen.receive (hd (hd V16316))) (and (cons? (tl (hd V16316))) (= () (tl (tl (hd V16316)))))))) (cons (hd (tl (hd V16316))) (shen.receive-terms (tl V16316)))) ((cons? V16316) (shen.receive-terms (tl V16316))) (true (shen.f_error shen.receive-terms))))
|
|
43
43
|
|
|
44
|
-
(defun shen.pass-literals (
|
|
44
|
+
(defun shen.pass-literals (V16320) (cond ((= () V16320) ()) ((and (cons? V16320) (and (cons? (hd V16320)) (and (= shen.receive (hd (hd V16320))) (and (cons? (tl (hd V16320))) (= () (tl (tl (hd V16320)))))))) (shen.pass-literals (tl V16320))) ((cons? V16320) (cons (hd V16320) (shen.pass-literals (tl V16320)))) (true (shen.f_error shen.pass-literals))))
|
|
45
45
|
|
|
46
|
-
(defun shen.defprolog-macro (
|
|
46
|
+
(defun shen.defprolog-macro (V16322) (cond ((and (cons? V16322) (and (= defprolog (hd V16322)) (cons? (tl V16322)))) (compile (lambda Y (shen.<defprolog> Y)) (tl V16322) (lambda Y (shen.prolog-error (hd (tl V16322)) Y)))) (true V16322)))
|
|
47
47
|
|
|
48
|
-
(defun shen.datatype-macro (
|
|
48
|
+
(defun shen.datatype-macro (V16324) (cond ((and (cons? V16324) (and (= datatype (hd V16324)) (cons? (tl V16324)))) (cons shen.process-datatype (cons (shen.intern-type (hd (tl V16324))) (cons (cons compile (cons (cons lambda (cons X (cons (cons shen.<datatype-rules> (cons X ())) ()))) (cons (shen.rcons_form (tl (tl V16324))) (cons (cons function (cons shen.datatype-error ())) ())))) ())))) (true V16324)))
|
|
49
49
|
|
|
50
|
-
(defun shen.intern-type (
|
|
50
|
+
(defun shen.intern-type (V16326) (intern (cn "type#" (str V16326))))
|
|
51
51
|
|
|
52
|
-
(defun shen.@s-macro (
|
|
52
|
+
(defun shen.@s-macro (V16328) (cond ((and (cons? V16328) (and (= @s (hd V16328)) (and (cons? (tl V16328)) (and (cons? (tl (tl V16328))) (cons? (tl (tl (tl V16328)))))))) (cons @s (cons (hd (tl V16328)) (cons (shen.@s-macro (cons @s (tl (tl V16328)))) ())))) ((and (cons? V16328) (and (= @s (hd V16328)) (and (cons? (tl V16328)) (and (cons? (tl (tl V16328))) (and (= () (tl (tl (tl V16328)))) (string? (hd (tl V16328)))))))) (let E (explode (hd (tl V16328))) (if (> (length E) 1) (shen.@s-macro (cons @s (append E (tl (tl V16328))))) V16328))) (true V16328)))
|
|
53
53
|
|
|
54
|
-
(defun shen.synonyms-macro (
|
|
54
|
+
(defun shen.synonyms-macro (V16330) (cond ((and (cons? V16330) (= synonyms (hd V16330))) (cons shen.synonyms-help (cons (shen.rcons_form (shen.curry-synonyms (tl V16330))) ()))) (true V16330)))
|
|
55
55
|
|
|
56
|
-
(defun shen.curry-synonyms (
|
|
56
|
+
(defun shen.curry-synonyms (V16332) (map (lambda X (shen.curry-type X)) V16332))
|
|
57
57
|
|
|
58
|
-
(defun shen.nl-macro (
|
|
58
|
+
(defun shen.nl-macro (V16334) (cond ((and (cons? V16334) (and (= nl (hd V16334)) (= () (tl V16334)))) (cons nl (cons 1 ()))) (true V16334)))
|
|
59
59
|
|
|
60
|
-
(defun shen.assoc-macro (
|
|
60
|
+
(defun shen.assoc-macro (V16336) (cond ((and (cons? V16336) (and (cons? (tl V16336)) (and (cons? (tl (tl V16336))) (and (cons? (tl (tl (tl V16336)))) (element? (hd V16336) (cons @p (cons @v (cons append (cons and (cons or (cons + (cons * (cons do ()))))))))))))) (cons (hd V16336) (cons (hd (tl V16336)) (cons (shen.assoc-macro (cons (hd V16336) (tl (tl V16336)))) ())))) (true V16336)))
|
|
61
61
|
|
|
62
|
-
(defun shen.let-macro (
|
|
62
|
+
(defun shen.let-macro (V16338) (cond ((and (cons? V16338) (and (= let (hd V16338)) (and (cons? (tl V16338)) (and (cons? (tl (tl V16338))) (and (cons? (tl (tl (tl V16338)))) (cons? (tl (tl (tl (tl V16338)))))))))) (cons let (cons (hd (tl V16338)) (cons (hd (tl (tl V16338))) (cons (shen.let-macro (cons let (tl (tl (tl V16338))))) ()))))) (true V16338)))
|
|
63
63
|
|
|
64
|
-
(defun shen.abs-macro (
|
|
64
|
+
(defun shen.abs-macro (V16340) (cond ((and (cons? V16340) (and (= /. (hd V16340)) (and (cons? (tl V16340)) (and (cons? (tl (tl V16340))) (cons? (tl (tl (tl V16340)))))))) (cons lambda (cons (hd (tl V16340)) (cons (shen.abs-macro (cons /. (tl (tl V16340)))) ())))) ((and (cons? V16340) (and (= /. (hd V16340)) (and (cons? (tl V16340)) (and (cons? (tl (tl V16340))) (= () (tl (tl (tl V16340)))))))) (cons lambda (tl V16340))) (true V16340)))
|
|
65
65
|
|
|
66
|
-
(defun shen.cases-macro (
|
|
67
|
-
")) (true
|
|
66
|
+
(defun shen.cases-macro (V16344) (cond ((and (cons? V16344) (and (= cases (hd V16344)) (and (cons? (tl V16344)) (and (= true (hd (tl V16344))) (cons? (tl (tl V16344))))))) (hd (tl (tl V16344)))) ((and (cons? V16344) (and (= cases (hd V16344)) (and (cons? (tl V16344)) (and (cons? (tl (tl V16344))) (= () (tl (tl (tl V16344)))))))) (cons if (cons (hd (tl V16344)) (cons (hd (tl (tl V16344))) (cons (cons simple-error (cons "error: cases exhausted" ())) ()))))) ((and (cons? V16344) (and (= cases (hd V16344)) (and (cons? (tl V16344)) (cons? (tl (tl V16344)))))) (cons if (cons (hd (tl V16344)) (cons (hd (tl (tl V16344))) (cons (shen.cases-macro (cons cases (tl (tl (tl V16344))))) ()))))) ((and (cons? V16344) (and (= cases (hd V16344)) (and (cons? (tl V16344)) (= () (tl (tl V16344)))))) (simple-error "error: odd number of case elements
|
|
67
|
+
")) (true V16344)))
|
|
68
68
|
|
|
69
|
-
(defun shen.timer-macro (
|
|
69
|
+
(defun shen.timer-macro (V16346) (cond ((and (cons? V16346) (and (= time (hd V16346)) (and (cons? (tl V16346)) (= () (tl (tl V16346)))))) (shen.let-macro (cons let (cons Start (cons (cons get-time (cons run ())) (cons Result (cons (hd (tl V16346)) (cons Finish (cons (cons get-time (cons run ())) (cons Time (cons (cons - (cons Finish (cons Start ()))) (cons Message (cons (cons shen.prhush (cons (cons cn (cons "
|
|
70
70
|
run time: " (cons (cons cn (cons (cons str (cons Time ())) (cons " secs
|
|
71
|
-
" ()))) ()))) (cons (cons stoutput ()) ()))) (cons Result ())))))))))))))) (true
|
|
71
|
+
" ()))) ()))) (cons (cons stoutput ()) ()))) (cons Result ())))))))))))))) (true V16346)))
|
|
72
72
|
|
|
73
|
-
(defun shen.tuple-up (
|
|
73
|
+
(defun shen.tuple-up (V16348) (cond ((cons? V16348) (cons @p (cons (hd V16348) (cons (shen.tuple-up (tl V16348)) ())))) (true V16348)))
|
|
74
74
|
|
|
75
|
-
(defun shen.put/get-macro (
|
|
75
|
+
(defun shen.put/get-macro (V16350) (cond ((and (cons? V16350) (and (= put (hd V16350)) (and (cons? (tl V16350)) (and (cons? (tl (tl V16350))) (and (cons? (tl (tl (tl V16350)))) (= () (tl (tl (tl (tl V16350)))))))))) (cons put (cons (hd (tl V16350)) (cons (hd (tl (tl V16350))) (cons (hd (tl (tl (tl V16350)))) (cons (cons value (cons *property-vector* ())) ())))))) ((and (cons? V16350) (and (= get (hd V16350)) (and (cons? (tl V16350)) (and (cons? (tl (tl V16350))) (= () (tl (tl (tl V16350)))))))) (cons get (cons (hd (tl V16350)) (cons (hd (tl (tl V16350))) (cons (cons value (cons *property-vector* ())) ()))))) ((and (cons? V16350) (and (= unput (hd V16350)) (and (cons? (tl V16350)) (and (cons? (tl (tl V16350))) (= () (tl (tl (tl V16350)))))))) (cons unput (cons (hd (tl V16350)) (cons (hd (tl (tl V16350))) (cons (cons value (cons *property-vector* ())) ()))))) (true V16350)))
|
|
76
76
|
|
|
77
|
-
(defun shen.function-macro (
|
|
77
|
+
(defun shen.function-macro (V16352) (cond ((and (cons? V16352) (and (= function (hd V16352)) (and (cons? (tl V16352)) (= () (tl (tl V16352)))))) (shen.function-abstraction (hd (tl V16352)) (arity (hd (tl V16352))))) (true V16352)))
|
|
78
78
|
|
|
79
|
-
(defun shen.function-abstraction (
|
|
79
|
+
(defun shen.function-abstraction (V16355 V16356) (cond ((= 0 V16356) (simple-error (shen.app V16355 " has no lambda form
|
|
80
|
+
" shen.a))) ((= -1 V16356) (cons function (cons V16355 ()))) (true (shen.function-abstraction-help V16355 V16356 ()))))
|
|
80
81
|
|
|
81
|
-
(defun shen.function-abstraction-help (
|
|
82
|
+
(defun shen.function-abstraction-help (V16360 V16361 V16362) (cond ((= 0 V16361) (cons V16360 V16362)) (true (let X (gensym V) (cons /. (cons X (cons (shen.function-abstraction-help V16360 (- V16361 1) (append V16362 (cons X ()))) ())))))))
|
|
82
83
|
|
|
83
|
-
(defun undefmacro (
|
|
84
|
+
(defun undefmacro (V16364) (let MacroReg (value shen.*macroreg*) (let Pos (shen.findpos V16364 MacroReg) (let Remove1 (set shen.*macroreg* (remove V16364 MacroReg)) (let Remove2 (set *macros* (shen.remove-nth Pos (value *macros*))) V16364)))))
|
|
84
85
|
|
|
85
|
-
(defun shen.findpos (
|
|
86
|
-
" shen.a))) ((and (cons?
|
|
86
|
+
(defun shen.findpos (V16374 V16375) (cond ((= () V16375) (simple-error (shen.app V16374 " is not a macro
|
|
87
|
+
" shen.a))) ((and (cons? V16375) (= (hd V16375) V16374)) 1) ((cons? V16375) (+ 1 (shen.findpos V16374 (tl V16375)))) (true (shen.f_error shen.findpos))))
|
|
87
88
|
|
|
88
|
-
(defun shen.remove-nth (
|
|
89
|
+
(defun shen.remove-nth (V16380 V16381) (cond ((and (= 1 V16380) (cons? V16381)) (tl V16381)) ((cons? V16381) (cons (hd V16381) (shen.remove-nth (- V16380 1) (tl V16381)))) (true (shen.f_error shen.remove-nth))))
|
|
89
90
|
|
|
90
91
|
|
|
91
92
|
|