shen-ruby 0.4.1 → 0.5.0
Sign up to get free protection for your applications and to get access to all the features.
- data/HISTORY.md +8 -0
- data/MIT_LICENSE.txt +1 -1
- data/README.md +4 -3
- data/lib/kl/primitives/vectors.rb +1 -0
- data/lib/shen_ruby/version.rb +1 -1
- data/shen-ruby.gemspec +1 -1
- data/shen/release/k_lambda/core.kl +67 -59
- data/shen/release/k_lambda/declarations.kl +13 -9
- data/shen/release/k_lambda/load.kl +17 -15
- data/shen/release/k_lambda/macros.kl +33 -31
- data/shen/release/k_lambda/prolog.kl +97 -97
- data/shen/release/k_lambda/reader.kl +71 -63
- data/shen/release/k_lambda/sequent.kl +55 -51
- data/shen/release/k_lambda/sys.kl +107 -102
- data/shen/release/k_lambda/t-star.kl +51 -55
- data/shen/release/k_lambda/toplevel.kl +30 -29
- data/shen/release/k_lambda/track.kl +25 -25
- data/shen/release/k_lambda/types.kl +10 -6
- data/shen/release/k_lambda/writer.kl +24 -20
- data/shen/release/k_lambda/yacc.kl +28 -26
- metadata +3 -3
|
@@ -47,206 +47,206 @@
|
|
|
47
47
|
* explains this license in full. *
|
|
48
48
|
* *
|
|
49
49
|
*****************************************************************************************
|
|
50
|
-
"(defun shen.<defprolog> (
|
|
50
|
+
"(defun shen.<defprolog> (V927) (let Result (let Parse_shen.<predicate*> (shen.<predicate*> V927) (if (not (= (fail) Parse_shen.<predicate*>)) (let Parse_shen.<clauses*> (shen.<clauses*> Parse_shen.<predicate*>) (if (not (= (fail) Parse_shen.<clauses*>)) (shen.pair (hd Parse_shen.<clauses*>) (hd (shen.prolog->shen (map (lambda Parse_X (shen.insert-predicate (shen.hdtl Parse_shen.<predicate*>) Parse_X)) (shen.hdtl Parse_shen.<clauses*>))))) (fail))) (fail))) (if (= Result (fail)) (fail) Result)))
|
|
51
51
|
|
|
52
|
-
(defun shen.prolog-error (
|
|
52
|
+
(defun shen.prolog-error (V934 V935) (cond ((and (cons? V935) (and (cons? (tl V935)) (= () (tl (tl V935))))) (simple-error (cn "prolog syntax error in " (shen.app V934 (cn " here:
|
|
53
53
|
|
|
54
|
-
" (shen.app (shen.next-50 50 (hd
|
|
55
|
-
" shen.a)) shen.a)))) (true (simple-error (cn "prolog syntax error in " (shen.app
|
|
54
|
+
" (shen.app (shen.next-50 50 (hd V935)) "
|
|
55
|
+
" shen.a)) shen.a)))) (true (simple-error (cn "prolog syntax error in " (shen.app V934 "
|
|
56
56
|
" shen.a))))))
|
|
57
57
|
|
|
58
|
-
(defun shen.next-50 (
|
|
58
|
+
(defun shen.next-50 (V940 V941) (cond ((= () V941) "") ((= 0 V940) "") ((cons? V941) (cn (shen.decons-string (hd V941)) (shen.next-50 (- V940 1) (tl V941)))) (true (shen.sys-error shen.next-50))))
|
|
59
59
|
|
|
60
|
-
(defun shen.decons-string (
|
|
60
|
+
(defun shen.decons-string (V942) (cond ((and (cons? V942) (and (= cons (hd V942)) (and (cons? (tl V942)) (and (cons? (tl (tl V942))) (= () (tl (tl (tl V942)))))))) (shen.app (shen.eval-cons V942) " " shen.s)) (true (shen.app V942 " " shen.r))))
|
|
61
61
|
|
|
62
|
-
(defun shen.insert-predicate (
|
|
62
|
+
(defun shen.insert-predicate (V943 V944) (cond ((and (cons? V944) (and (cons? (tl V944)) (= () (tl (tl V944))))) (cons (cons V943 (hd V944)) (cons :- (tl V944)))) (true (shen.sys-error shen.insert-predicate))))
|
|
63
63
|
|
|
64
|
-
(defun shen.<predicate*> (
|
|
64
|
+
(defun shen.<predicate*> (V949) (let Result (if (cons? (hd V949)) (let Parse_X (hd (hd V949)) (shen.pair (hd (shen.pair (tl (hd V949)) (shen.hdtl V949))) Parse_X)) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
65
65
|
|
|
66
|
-
(defun shen.<clauses*> (
|
|
66
|
+
(defun shen.<clauses*> (V954) (let Result (let Parse_shen.<clause*> (shen.<clause*> V954) (if (not (= (fail) Parse_shen.<clause*>)) (let Parse_shen.<clauses*> (shen.<clauses*> Parse_shen.<clause*>) (if (not (= (fail) Parse_shen.<clauses*>)) (shen.pair (hd Parse_shen.<clauses*>) (cons (shen.hdtl Parse_shen.<clause*>) (shen.hdtl Parse_shen.<clauses*>))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_<e> (<e> V954) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) (append (shen.hdtl Parse_<e>) ())) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
|
|
67
67
|
|
|
68
|
-
(defun shen.<clause*> (
|
|
68
|
+
(defun shen.<clause*> (V959) (let Result (let Parse_shen.<head*> (shen.<head*> V959) (if (not (= (fail) Parse_shen.<head*>)) (if (and (cons? (hd Parse_shen.<head*>)) (= <-- (hd (hd Parse_shen.<head*>)))) (let Parse_shen.<body*> (shen.<body*> (shen.pair (tl (hd Parse_shen.<head*>)) (shen.hdtl Parse_shen.<head*>))) (if (not (= (fail) Parse_shen.<body*>)) (let Parse_shen.<end*> (shen.<end*> Parse_shen.<body*>) (if (not (= (fail) Parse_shen.<end*>)) (shen.pair (hd Parse_shen.<end*>) (cons (shen.hdtl Parse_shen.<head*>) (cons (shen.hdtl Parse_shen.<body*>) ()))) (fail))) (fail))) (fail)) (fail))) (if (= Result (fail)) (fail) Result)))
|
|
69
69
|
|
|
70
|
-
(defun shen.<head*> (
|
|
70
|
+
(defun shen.<head*> (V964) (let Result (let Parse_shen.<term*> (shen.<term*> V964) (if (not (= (fail) Parse_shen.<term*>)) (let Parse_shen.<head*> (shen.<head*> Parse_shen.<term*>) (if (not (= (fail) Parse_shen.<head*>)) (shen.pair (hd Parse_shen.<head*>) (cons (shen.hdtl Parse_shen.<term*>) (shen.hdtl Parse_shen.<head*>))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_<e> (<e> V964) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) (append (shen.hdtl Parse_<e>) ())) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
|
|
71
71
|
|
|
72
|
-
(defun shen.<term*> (
|
|
72
|
+
(defun shen.<term*> (V969) (let Result (if (cons? (hd V969)) (let Parse_X (hd (hd V969)) (if (and (not (= <-- Parse_X)) (shen.legitimate-term? Parse_X)) (shen.pair (hd (shen.pair (tl (hd V969)) (shen.hdtl V969))) (shen.eval-cons Parse_X)) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
73
73
|
|
|
74
|
-
(defun shen.legitimate-term? (
|
|
74
|
+
(defun shen.legitimate-term? (V974) (cond ((and (cons? V974) (and (= cons (hd V974)) (and (cons? (tl V974)) (and (cons? (tl (tl V974))) (= () (tl (tl (tl V974)))))))) (and (shen.legitimate-term? (hd (tl V974))) (shen.legitimate-term? (hd (tl (tl V974)))))) ((and (cons? V974) (and (= mode (hd V974)) (and (cons? (tl V974)) (and (cons? (tl (tl V974))) (and (= + (hd (tl (tl V974)))) (= () (tl (tl (tl V974))))))))) (shen.legitimate-term? (hd (tl V974)))) ((and (cons? V974) (and (= mode (hd V974)) (and (cons? (tl V974)) (and (cons? (tl (tl V974))) (and (= - (hd (tl (tl V974)))) (= () (tl (tl (tl V974))))))))) (shen.legitimate-term? (hd (tl V974)))) ((cons? V974) false) (true true)))
|
|
75
75
|
|
|
76
|
-
(defun shen.eval-cons (
|
|
76
|
+
(defun shen.eval-cons (V975) (cond ((and (cons? V975) (and (= cons (hd V975)) (and (cons? (tl V975)) (and (cons? (tl (tl V975))) (= () (tl (tl (tl V975)))))))) (cons (shen.eval-cons (hd (tl V975))) (shen.eval-cons (hd (tl (tl V975)))))) ((and (cons? V975) (and (= mode (hd V975)) (and (cons? (tl V975)) (and (cons? (tl (tl V975))) (= () (tl (tl (tl V975)))))))) (cons mode (cons (shen.eval-cons (hd (tl V975))) (tl (tl V975))))) (true V975)))
|
|
77
77
|
|
|
78
|
-
(defun shen.<body*> (
|
|
78
|
+
(defun shen.<body*> (V980) (let Result (let Parse_shen.<literal*> (shen.<literal*> V980) (if (not (= (fail) Parse_shen.<literal*>)) (let Parse_shen.<body*> (shen.<body*> Parse_shen.<literal*>) (if (not (= (fail) Parse_shen.<body*>)) (shen.pair (hd Parse_shen.<body*>) (cons (shen.hdtl Parse_shen.<literal*>) (shen.hdtl Parse_shen.<body*>))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_<e> (<e> V980) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) (append (shen.hdtl Parse_<e>) ())) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
|
|
79
79
|
|
|
80
|
-
(defun shen.<literal*> (
|
|
80
|
+
(defun shen.<literal*> (V985) (let Result (if (and (cons? (hd V985)) (= ! (hd (hd V985)))) (shen.pair (hd (shen.pair (tl (hd V985)) (shen.hdtl V985))) (cons cut (cons (intern "Throwcontrol") ()))) (fail)) (if (= Result (fail)) (let Result (if (cons? (hd V985)) (let Parse_X (hd (hd V985)) (if (cons? Parse_X) (shen.pair (hd (shen.pair (tl (hd V985)) (shen.hdtl V985))) Parse_X) (fail))) (fail)) (if (= Result (fail)) (fail) Result)) Result)))
|
|
81
81
|
|
|
82
|
-
(defun shen.<end*> (
|
|
82
|
+
(defun shen.<end*> (V990) (let Result (if (cons? (hd V990)) (let Parse_X (hd (hd V990)) (if (= Parse_X ;) (shen.pair (hd (shen.pair (tl (hd V990)) (shen.hdtl V990))) Parse_X) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
83
83
|
|
|
84
|
-
(defun cut (
|
|
84
|
+
(defun cut (V991 V992 V993) (let Result (thaw V993) (if (= Result false) V991 Result)))
|
|
85
85
|
|
|
86
|
-
(defun shen.insert_modes (
|
|
86
|
+
(defun shen.insert_modes (V994) (cond ((and (cons? V994) (and (= mode (hd V994)) (and (cons? (tl V994)) (and (cons? (tl (tl V994))) (= () (tl (tl (tl V994)))))))) V994) ((= () V994) ()) ((cons? V994) (cons (cons mode (cons (hd V994) (cons + ()))) (cons mode (cons (shen.insert_modes (tl V994)) (cons - ()))))) (true V994)))
|
|
87
87
|
|
|
88
|
-
(defun shen.s-prolog (
|
|
88
|
+
(defun shen.s-prolog (V995) (map (lambda V921 (eval V921)) (shen.prolog->shen V995)))
|
|
89
89
|
|
|
90
|
-
(defun shen.prolog->shen (
|
|
90
|
+
(defun shen.prolog->shen (V996) (map shen.compile_prolog_procedure (shen.group_clauses (map shen.s-prolog_clause (mapcan shen.head_abstraction V996)))))
|
|
91
91
|
|
|
92
|
-
(defun shen.s-prolog_clause (
|
|
92
|
+
(defun shen.s-prolog_clause (V997) (cond ((and (cons? V997) (and (cons? (tl V997)) (and (= :- (hd (tl V997))) (and (cons? (tl (tl V997))) (= () (tl (tl (tl V997)))))))) (cons (hd V997) (cons :- (cons (map shen.s-prolog_literal (hd (tl (tl V997)))) ())))) (true (shen.sys-error shen.s-prolog_clause))))
|
|
93
93
|
|
|
94
|
-
(defun shen.head_abstraction (
|
|
94
|
+
(defun shen.head_abstraction (V998) (cond ((and (cons? V998) (and (cons? (tl V998)) (and (= :- (hd (tl V998))) (and (cons? (tl (tl V998))) (and (= () (tl (tl (tl V998)))) (< (shen.complexity_head (hd V998)) (value shen.*maxcomplexity*))))))) (cons V998 ())) ((and (cons? V998) (and (cons? (hd V998)) (and (cons? (tl V998)) (and (= :- (hd (tl V998))) (and (cons? (tl (tl V998))) (= () (tl (tl (tl V998))))))))) (let Terms (map (lambda Y (gensym V)) (tl (hd V998))) (let XTerms (shen.rcons_form (shen.remove_modes (tl (hd V998)))) (let Literal (cons unify (cons (shen.cons_form Terms) (cons XTerms ()))) (let Clause (cons (cons (hd (hd V998)) Terms) (cons :- (cons (cons Literal (hd (tl (tl V998)))) ()))) (cons Clause ())))))) (true (shen.sys-error shen.head_abstraction))))
|
|
95
95
|
|
|
96
|
-
(defun shen.complexity_head (
|
|
96
|
+
(defun shen.complexity_head (V1003) (cond ((cons? V1003) (shen.product (map shen.complexity (tl V1003)))) (true (shen.sys-error shen.complexity_head))))
|
|
97
97
|
|
|
98
|
-
(defun shen.complexity (
|
|
98
|
+
(defun shen.complexity (V1011) (cond ((and (cons? V1011) (and (= mode (hd V1011)) (and (cons? (tl V1011)) (and (cons? (hd (tl V1011))) (and (= mode (hd (hd (tl V1011)))) (and (cons? (tl (hd (tl V1011)))) (and (cons? (tl (tl (hd (tl V1011))))) (and (= () (tl (tl (tl (hd (tl V1011)))))) (and (cons? (tl (tl V1011))) (= () (tl (tl (tl V1011))))))))))))) (shen.complexity (hd (tl V1011)))) ((and (cons? V1011) (and (= mode (hd V1011)) (and (cons? (tl V1011)) (and (cons? (hd (tl V1011))) (and (cons? (tl (tl V1011))) (and (= + (hd (tl (tl V1011)))) (= () (tl (tl (tl V1011)))))))))) (* 2 (* (shen.complexity (cons mode (cons (hd (hd (tl V1011))) (tl (tl V1011))))) (shen.complexity (cons mode (cons (tl (hd (tl V1011))) (tl (tl V1011)))))))) ((and (cons? V1011) (and (= mode (hd V1011)) (and (cons? (tl V1011)) (and (cons? (hd (tl V1011))) (and (cons? (tl (tl V1011))) (and (= - (hd (tl (tl V1011)))) (= () (tl (tl (tl V1011)))))))))) (* (shen.complexity (cons mode (cons (hd (hd (tl V1011))) (tl (tl V1011))))) (shen.complexity (cons mode (cons (tl (hd (tl V1011))) (tl (tl V1011))))))) ((and (cons? V1011) (and (= mode (hd V1011)) (and (cons? (tl V1011)) (and (cons? (tl (tl V1011))) (and (= () (tl (tl (tl V1011)))) (variable? (hd (tl V1011)))))))) 1) ((and (cons? V1011) (and (= mode (hd V1011)) (and (cons? (tl V1011)) (and (cons? (tl (tl V1011))) (and (= + (hd (tl (tl V1011)))) (= () (tl (tl (tl V1011))))))))) 2) ((and (cons? V1011) (and (= mode (hd V1011)) (and (cons? (tl V1011)) (and (cons? (tl (tl V1011))) (and (= - (hd (tl (tl V1011)))) (= () (tl (tl (tl V1011))))))))) 1) (true (shen.complexity (cons mode (cons V1011 (cons + ())))))))
|
|
99
99
|
|
|
100
|
-
(defun shen.product (
|
|
100
|
+
(defun shen.product (V1012) (cond ((= () V1012) 1) ((cons? V1012) (* (hd V1012) (shen.product (tl V1012)))) (true (shen.sys-error shen.product))))
|
|
101
101
|
|
|
102
|
-
(defun shen.s-prolog_literal (
|
|
102
|
+
(defun shen.s-prolog_literal (V1013) (cond ((and (cons? V1013) (and (= is (hd V1013)) (and (cons? (tl V1013)) (and (cons? (tl (tl V1013))) (= () (tl (tl (tl V1013)))))))) (cons bind (cons (hd (tl V1013)) (cons (shen.insert_deref (hd (tl (tl V1013)))) ())))) ((and (cons? V1013) (and (= when (hd V1013)) (and (cons? (tl V1013)) (= () (tl (tl V1013)))))) (cons fwhen (cons (shen.insert_deref (hd (tl V1013))) ()))) ((and (cons? V1013) (and (= bind (hd V1013)) (and (cons? (tl V1013)) (and (cons? (tl (tl V1013))) (= () (tl (tl (tl V1013)))))))) (cons bind (cons (hd (tl V1013)) (cons (shen.insert_lazyderef (hd (tl (tl V1013)))) ())))) ((and (cons? V1013) (and (= fwhen (hd V1013)) (and (cons? (tl V1013)) (= () (tl (tl V1013)))))) (cons fwhen (cons (shen.insert_lazyderef (hd (tl V1013))) ()))) ((cons? V1013) (cons (shen.m_prolog_to_s-prolog_predicate (hd V1013)) (tl V1013))) (true (shen.sys-error shen.s-prolog_literal))))
|
|
103
103
|
|
|
104
|
-
(defun shen.insert_deref (
|
|
104
|
+
(defun shen.insert_deref (V1014) (cond ((variable? V1014) (cons shen.deref (cons V1014 (cons ProcessN ())))) ((cons? V1014) (cons (shen.insert_deref (hd V1014)) (shen.insert_deref (tl V1014)))) (true V1014)))
|
|
105
105
|
|
|
106
|
-
(defun shen.insert_lazyderef (
|
|
106
|
+
(defun shen.insert_lazyderef (V1015) (cond ((variable? V1015) (cons shen.lazyderef (cons V1015 (cons ProcessN ())))) ((cons? V1015) (cons (shen.insert_lazyderef (hd V1015)) (shen.insert_lazyderef (tl V1015)))) (true V1015)))
|
|
107
107
|
|
|
108
|
-
(defun shen.m_prolog_to_s-prolog_predicate (
|
|
108
|
+
(defun shen.m_prolog_to_s-prolog_predicate (V1016) (cond ((= = V1016) unify) ((= =! V1016) unify!) ((= == V1016) identical) (true V1016)))
|
|
109
109
|
|
|
110
|
-
(defun shen.group_clauses (
|
|
110
|
+
(defun shen.group_clauses (V1017) (cond ((= () V1017) ()) ((cons? V1017) (let Group (shen.collect (lambda X (shen.same_predicate? (hd V1017) X)) V1017) (let Rest (difference V1017 Group) (cons Group (shen.group_clauses Rest))))) (true (shen.sys-error shen.group_clauses))))
|
|
111
111
|
|
|
112
|
-
(defun shen.collect (
|
|
112
|
+
(defun shen.collect (V1020 V1021) (cond ((= () V1021) ()) ((cons? V1021) (if (V1020 (hd V1021)) (cons (hd V1021) (shen.collect V1020 (tl V1021))) (shen.collect V1020 (tl V1021)))) (true (shen.sys-error shen.collect))))
|
|
113
113
|
|
|
114
|
-
(defun shen.same_predicate? (
|
|
114
|
+
(defun shen.same_predicate? (V1038 V1039) (cond ((and (cons? V1038) (and (cons? (hd V1038)) (and (cons? V1039) (cons? (hd V1039))))) (= (hd (hd V1038)) (hd (hd V1039)))) (true (shen.sys-error shen.same_predicate?))))
|
|
115
115
|
|
|
116
|
-
(defun shen.compile_prolog_procedure (
|
|
116
|
+
(defun shen.compile_prolog_procedure (V1040) (let F (shen.procedure_name V1040) (let Shen (shen.clauses-to-shen F V1040) Shen)))
|
|
117
117
|
|
|
118
|
-
(defun shen.procedure_name (
|
|
118
|
+
(defun shen.procedure_name (V1053) (cond ((and (cons? V1053) (and (cons? (hd V1053)) (cons? (hd (hd V1053))))) (hd (hd (hd V1053)))) (true (shen.sys-error shen.procedure_name))))
|
|
119
119
|
|
|
120
|
-
(defun shen.clauses-to-shen (
|
|
120
|
+
(defun shen.clauses-to-shen (V1054 V1055) (let Linear (map shen.linearise-clause V1055) (let Arity (shen.prolog-aritycheck V1054 (map (lambda V922 (head V922)) V1055)) (let Parameters (shen.parameters Arity) (let AUM_instructions (map (lambda X (shen.aum X Parameters)) Linear) (let Code (shen.catch-cut (shen.nest-disjunct (map shen.aum_to_shen AUM_instructions))) (let ShenDef (cons define (cons V1054 (append Parameters (append (cons ProcessN (cons Continuation ())) (cons -> (cons Code ())))))) ShenDef)))))))
|
|
121
121
|
|
|
122
|
-
(defun shen.catch-cut (
|
|
122
|
+
(defun shen.catch-cut (V1056) (cond ((not (shen.occurs? cut V1056)) V1056) (true (cons let (cons Throwcontrol (cons (cons shen.catchpoint ()) (cons (cons shen.cutpoint (cons Throwcontrol (cons V1056 ()))) ())))))))
|
|
123
123
|
|
|
124
124
|
(defun shen.catchpoint () (set shen.*catch* (+ 1 (value shen.*catch*))))
|
|
125
125
|
|
|
126
|
-
(defun shen.cutpoint (
|
|
126
|
+
(defun shen.cutpoint (V1061 V1062) (cond ((= V1062 V1061) false) (true V1062)))
|
|
127
127
|
|
|
128
|
-
(defun shen.nest-disjunct (
|
|
128
|
+
(defun shen.nest-disjunct (V1064) (cond ((and (cons? V1064) (= () (tl V1064))) (hd V1064)) ((cons? V1064) (shen.lisp-or (hd V1064) (shen.nest-disjunct (tl V1064)))) (true (shen.sys-error shen.nest-disjunct))))
|
|
129
129
|
|
|
130
|
-
(defun shen.lisp-or (
|
|
130
|
+
(defun shen.lisp-or (V1065 V1066) (cons let (cons Case (cons V1065 (cons (cons if (cons (cons = (cons Case (cons false ()))) (cons V1066 (cons Case ())))) ())))))
|
|
131
131
|
|
|
132
|
-
(defun shen.prolog-aritycheck (
|
|
132
|
+
(defun shen.prolog-aritycheck (V1069 V1070) (cond ((and (cons? V1070) (= () (tl V1070))) (- (length (hd V1070)) 1)) ((and (cons? V1070) (cons? (tl V1070))) (if (= (length (hd V1070)) (length (hd (tl V1070)))) (shen.prolog-aritycheck V1069 (tl V1070)) (simple-error (cn "arity error in prolog procedure " (shen.app (cons V1069 ()) "
|
|
133
133
|
" shen.a))))) (true (shen.sys-error shen.prolog-aritycheck))))
|
|
134
134
|
|
|
135
|
-
(defun shen.linearise-clause (
|
|
135
|
+
(defun shen.linearise-clause (V1071) (cond ((and (cons? V1071) (and (cons? (tl V1071)) (and (= :- (hd (tl V1071))) (and (cons? (tl (tl V1071))) (= () (tl (tl (tl V1071)))))))) (let Linear (shen.linearise (cons (hd V1071) (tl (tl V1071)))) (shen.clause_form Linear))) (true (shen.sys-error shen.linearise-clause))))
|
|
136
136
|
|
|
137
|
-
(defun shen.clause_form (
|
|
137
|
+
(defun shen.clause_form (V1072) (cond ((and (cons? V1072) (and (cons? (tl V1072)) (= () (tl (tl V1072))))) (cons (shen.explicit_modes (hd V1072)) (cons :- (cons (shen.cf_help (hd (tl V1072))) ())))) (true (shen.sys-error shen.clause_form))))
|
|
138
138
|
|
|
139
|
-
(defun shen.explicit_modes (
|
|
139
|
+
(defun shen.explicit_modes (V1073) (cond ((cons? V1073) (cons (hd V1073) (map shen.em_help (tl V1073)))) (true (shen.sys-error shen.explicit_modes))))
|
|
140
140
|
|
|
141
|
-
(defun shen.em_help (
|
|
141
|
+
(defun shen.em_help (V1074) (cond ((and (cons? V1074) (and (= mode (hd V1074)) (and (cons? (tl V1074)) (and (cons? (tl (tl V1074))) (= () (tl (tl (tl V1074)))))))) V1074) (true (cons mode (cons V1074 (cons + ()))))))
|
|
142
142
|
|
|
143
|
-
(defun shen.cf_help (
|
|
143
|
+
(defun shen.cf_help (V1075) (cond ((and (cons? V1075) (and (= where (hd V1075)) (and (cons? (tl V1075)) (and (cons? (hd (tl V1075))) (and (= = (hd (hd (tl V1075)))) (and (cons? (tl (hd (tl V1075)))) (and (cons? (tl (tl (hd (tl V1075))))) (and (= () (tl (tl (tl (hd (tl V1075)))))) (and (cons? (tl (tl V1075))) (= () (tl (tl (tl V1075))))))))))))) (cons (cons (if (value shen.*occurs*) unify! unify) (tl (hd (tl V1075)))) (shen.cf_help (hd (tl (tl V1075)))))) (true V1075)))
|
|
144
144
|
|
|
145
|
-
(defun occurs-check (
|
|
145
|
+
(defun occurs-check (V1080) (cond ((= + V1080) (set shen.*occurs* true)) ((= - V1080) (set shen.*occurs* false)) (true (simple-error "occurs-check expects + or -
|
|
146
146
|
"))))
|
|
147
147
|
|
|
148
|
-
(defun shen.aum (
|
|
148
|
+
(defun shen.aum (V1081 V1082) (cond ((and (cons? V1081) (and (cons? (hd V1081)) (and (cons? (tl V1081)) (and (= :- (hd (tl V1081))) (and (cons? (tl (tl V1081))) (= () (tl (tl (tl V1081))))))))) (let MuApplication (shen.make_mu_application (cons shen.mu (cons (tl (hd V1081)) (cons (shen.continuation_call (tl (hd V1081)) (hd (tl (tl V1081)))) ()))) V1082) (shen.mu_reduction MuApplication +))) (true (shen.sys-error shen.aum))))
|
|
149
149
|
|
|
150
|
-
(defun shen.continuation_call (
|
|
150
|
+
(defun shen.continuation_call (V1083 V1084) (let VTerms (cons ProcessN (shen.extract_vars V1083)) (let VBody (shen.extract_vars V1084) (let Free (remove Throwcontrol (difference VBody VTerms)) (shen.cc_help Free V1084)))))
|
|
151
151
|
|
|
152
|
-
(defun remove (
|
|
152
|
+
(defun remove (V1085 V1086) (shen.remove-h V1085 V1086 ()))
|
|
153
153
|
|
|
154
|
-
(defun shen.remove-h (
|
|
154
|
+
(defun shen.remove-h (V1089 V1090 V1091) (cond ((= () V1090) (reverse V1091)) ((and (cons? V1090) (= (hd V1090) V1089)) (shen.remove-h (hd V1090) (tl V1090) V1091)) ((cons? V1090) (shen.remove-h V1089 (tl V1090) (cons (hd V1090) V1091))) (true (shen.sys-error shen.remove-h))))
|
|
155
155
|
|
|
156
|
-
(defun shen.cc_help (
|
|
156
|
+
(defun shen.cc_help (V1093 V1094) (cond ((and (= () V1093) (= () V1094)) (cons shen.pop (cons shen.the (cons shen.stack ())))) ((= () V1094) (cons shen.rename (cons shen.the (cons shen.variables (cons in (cons V1093 (cons and (cons shen.then (cons (cons shen.pop (cons shen.the (cons shen.stack ()))) ()))))))))) ((= () V1093) (cons call (cons shen.the (cons shen.continuation (cons V1094 ()))))) (true (cons shen.rename (cons shen.the (cons shen.variables (cons in (cons V1093 (cons and (cons shen.then (cons (cons call (cons shen.the (cons shen.continuation (cons V1094 ())))) ())))))))))))
|
|
157
157
|
|
|
158
|
-
(defun shen.make_mu_application (
|
|
158
|
+
(defun shen.make_mu_application (V1095 V1096) (cond ((and (cons? V1095) (and (= shen.mu (hd V1095)) (and (cons? (tl V1095)) (and (= () (hd (tl V1095))) (and (cons? (tl (tl V1095))) (and (= () (tl (tl (tl V1095)))) (= () V1096))))))) (hd (tl (tl V1095)))) ((and (cons? V1095) (and (= shen.mu (hd V1095)) (and (cons? (tl V1095)) (and (cons? (hd (tl V1095))) (and (cons? (tl (tl V1095))) (and (= () (tl (tl (tl V1095)))) (cons? V1096))))))) (cons (cons shen.mu (cons (hd (hd (tl V1095))) (cons (shen.make_mu_application (cons shen.mu (cons (tl (hd (tl V1095))) (tl (tl V1095)))) (tl V1096)) ()))) (cons (hd V1096) ()))) (true (shen.sys-error shen.make_mu_application))))
|
|
159
159
|
|
|
160
|
-
(defun shen.mu_reduction (
|
|
160
|
+
(defun shen.mu_reduction (V1103 V1104) (cond ((and (cons? V1103) (and (cons? (hd V1103)) (and (= shen.mu (hd (hd V1103))) (and (cons? (tl (hd V1103))) (and (cons? (hd (tl (hd V1103)))) (and (= mode (hd (hd (tl (hd V1103))))) (and (cons? (tl (hd (tl (hd V1103))))) (and (cons? (tl (tl (hd (tl (hd V1103)))))) (and (= () (tl (tl (tl (hd (tl (hd V1103))))))) (and (cons? (tl (tl (hd V1103)))) (and (= () (tl (tl (tl (hd V1103))))) (and (cons? (tl V1103)) (= () (tl (tl V1103))))))))))))))) (shen.mu_reduction (cons (cons shen.mu (cons (hd (tl (hd (tl (hd V1103))))) (tl (tl (hd V1103))))) (tl V1103)) (hd (tl (tl (hd (tl (hd V1103)))))))) ((and (cons? V1103) (and (cons? (hd V1103)) (and (= shen.mu (hd (hd V1103))) (and (cons? (tl (hd V1103))) (and (cons? (tl (tl (hd V1103)))) (and (= () (tl (tl (tl (hd V1103))))) (and (cons? (tl V1103)) (and (= () (tl (tl V1103))) (= _ (hd (tl (hd V1103)))))))))))) (shen.mu_reduction (hd (tl (tl (hd V1103)))) V1104)) ((and (cons? V1103) (and (cons? (hd V1103)) (and (= shen.mu (hd (hd V1103))) (and (cons? (tl (hd V1103))) (and (cons? (tl (tl (hd V1103)))) (and (= () (tl (tl (tl (hd V1103))))) (and (cons? (tl V1103)) (and (= () (tl (tl V1103))) (shen.ephemeral_variable? (hd (tl (hd V1103))) (hd (tl V1103))))))))))) (subst (hd (tl V1103)) (hd (tl (hd V1103))) (shen.mu_reduction (hd (tl (tl (hd V1103)))) V1104))) ((and (cons? V1103) (and (cons? (hd V1103)) (and (= shen.mu (hd (hd V1103))) (and (cons? (tl (hd V1103))) (and (cons? (tl (tl (hd V1103)))) (and (= () (tl (tl (tl (hd V1103))))) (and (cons? (tl V1103)) (and (= () (tl (tl V1103))) (variable? (hd (tl (hd V1103)))))))))))) (cons let (cons (hd (tl (hd V1103))) (cons shen.be (cons (hd (tl V1103)) (cons in (cons (shen.mu_reduction (hd (tl (tl (hd V1103)))) V1104) ()))))))) ((and (cons? V1103) (and (cons? (hd V1103)) (and (= shen.mu (hd (hd V1103))) (and (cons? (tl (hd V1103))) (and (cons? (tl (tl (hd V1103)))) (and (= () (tl (tl (tl (hd V1103))))) (and (cons? (tl V1103)) (and (= () (tl (tl V1103))) (and (= - V1104) (shen.prolog_constant? (hd (tl (hd V1103))))))))))))) (let Z (gensym V) (cons let (cons Z (cons shen.be (cons (cons shen.the (cons shen.result (cons shen.of (cons shen.dereferencing (tl V1103))))) (cons in (cons (cons if (cons (cons Z (cons is (cons identical (cons shen.to (cons (hd (tl (hd V1103))) ()))))) (cons shen.then (cons (shen.mu_reduction (hd (tl (tl (hd V1103)))) -) (cons shen.else (cons shen.failed! ())))))) ())))))))) ((and (cons? V1103) (and (cons? (hd V1103)) (and (= shen.mu (hd (hd V1103))) (and (cons? (tl (hd V1103))) (and (cons? (tl (tl (hd V1103)))) (and (= () (tl (tl (tl (hd V1103))))) (and (cons? (tl V1103)) (and (= () (tl (tl V1103))) (and (= + V1104) (shen.prolog_constant? (hd (tl (hd V1103))))))))))))) (let Z (gensym V) (cons let (cons Z (cons shen.be (cons (cons shen.the (cons shen.result (cons shen.of (cons shen.dereferencing (tl V1103))))) (cons in (cons (cons if (cons (cons Z (cons is (cons identical (cons shen.to (cons (hd (tl (hd V1103))) ()))))) (cons shen.then (cons (shen.mu_reduction (hd (tl (tl (hd V1103)))) +) (cons shen.else (cons (cons if (cons (cons Z (cons is (cons shen.a (cons shen.variable ())))) (cons shen.then (cons (cons bind (cons Z (cons shen.to (cons (hd (tl (hd V1103))) (cons in (cons (shen.mu_reduction (hd (tl (tl (hd V1103)))) +) ())))))) (cons shen.else (cons shen.failed! ())))))) ())))))) ())))))))) ((and (cons? V1103) (and (cons? (hd V1103)) (and (= shen.mu (hd (hd V1103))) (and (cons? (tl (hd V1103))) (and (cons? (hd (tl (hd V1103)))) (and (cons? (tl (tl (hd V1103)))) (and (= () (tl (tl (tl (hd V1103))))) (and (cons? (tl V1103)) (and (= () (tl (tl V1103))) (= - V1104)))))))))) (let Z (gensym V) (cons let (cons Z (cons shen.be (cons (cons shen.the (cons shen.result (cons shen.of (cons shen.dereferencing (tl V1103))))) (cons in (cons (cons if (cons (cons Z (cons is (cons shen.a (cons shen.non-empty (cons list ()))))) (cons shen.then (cons (shen.mu_reduction (cons (cons shen.mu (cons (hd (hd (tl (hd V1103)))) (cons (cons (cons shen.mu (cons (tl (hd (tl (hd V1103)))) (tl (tl (hd V1103))))) (cons (cons shen.the (cons tail (cons shen.of (cons Z ())))) ())) ()))) (cons (cons shen.the (cons head (cons shen.of (cons Z ())))) ())) -) (cons shen.else (cons shen.failed! ())))))) ())))))))) ((and (cons? V1103) (and (cons? (hd V1103)) (and (= shen.mu (hd (hd V1103))) (and (cons? (tl (hd V1103))) (and (cons? (hd (tl (hd V1103)))) (and (cons? (tl (tl (hd V1103)))) (and (= () (tl (tl (tl (hd V1103))))) (and (cons? (tl V1103)) (and (= () (tl (tl V1103))) (= + V1104)))))))))) (let Z (gensym V) (cons let (cons Z (cons shen.be (cons (cons shen.the (cons shen.result (cons shen.of (cons shen.dereferencing (tl V1103))))) (cons in (cons (cons if (cons (cons Z (cons is (cons shen.a (cons shen.non-empty (cons list ()))))) (cons shen.then (cons (shen.mu_reduction (cons (cons shen.mu (cons (hd (hd (tl (hd V1103)))) (cons (cons (cons shen.mu (cons (tl (hd (tl (hd V1103)))) (tl (tl (hd V1103))))) (cons (cons shen.the (cons tail (cons shen.of (cons Z ())))) ())) ()))) (cons (cons shen.the (cons head (cons shen.of (cons Z ())))) ())) +) (cons shen.else (cons (cons if (cons (cons Z (cons is (cons shen.a (cons shen.variable ())))) (cons shen.then (cons (cons shen.rename (cons shen.the (cons shen.variables (cons in (cons (shen.extract_vars (hd (tl (hd V1103)))) (cons and (cons shen.then (cons (cons bind (cons Z (cons shen.to (cons (shen.rcons_form (shen.remove_modes (hd (tl (hd V1103))))) (cons in (cons (shen.mu_reduction (hd (tl (tl (hd V1103)))) +) ())))))) ())))))))) (cons shen.else (cons shen.failed! ())))))) ())))))) ())))))))) (true V1103)))
|
|
161
161
|
|
|
162
|
-
(defun shen.rcons_form (
|
|
162
|
+
(defun shen.rcons_form (V1105) (cond ((cons? V1105) (cons cons (cons (shen.rcons_form (hd V1105)) (cons (shen.rcons_form (tl V1105)) ())))) (true V1105)))
|
|
163
163
|
|
|
164
|
-
(defun shen.remove_modes (
|
|
164
|
+
(defun shen.remove_modes (V1106) (cond ((and (cons? V1106) (and (= mode (hd V1106)) (and (cons? (tl V1106)) (and (cons? (tl (tl V1106))) (and (= + (hd (tl (tl V1106)))) (= () (tl (tl (tl V1106))))))))) (shen.remove_modes (hd (tl V1106)))) ((and (cons? V1106) (and (= mode (hd V1106)) (and (cons? (tl V1106)) (and (cons? (tl (tl V1106))) (and (= - (hd (tl (tl V1106)))) (= () (tl (tl (tl V1106))))))))) (shen.remove_modes (hd (tl V1106)))) ((cons? V1106) (cons (shen.remove_modes (hd V1106)) (shen.remove_modes (tl V1106)))) (true V1106)))
|
|
165
165
|
|
|
166
|
-
(defun shen.ephemeral_variable? (
|
|
166
|
+
(defun shen.ephemeral_variable? (V1107 V1108) (and (variable? V1107) (variable? V1108)))
|
|
167
167
|
|
|
168
|
-
(defun shen.prolog_constant? (
|
|
168
|
+
(defun shen.prolog_constant? (V1117) (cond ((cons? V1117) false) (true true)))
|
|
169
169
|
|
|
170
|
-
(defun shen.aum_to_shen (
|
|
170
|
+
(defun shen.aum_to_shen (V1118) (cond ((and (cons? V1118) (and (= let (hd V1118)) (and (cons? (tl V1118)) (and (cons? (tl (tl V1118))) (and (= shen.be (hd (tl (tl V1118)))) (and (cons? (tl (tl (tl V1118)))) (and (cons? (tl (tl (tl (tl V1118))))) (and (= in (hd (tl (tl (tl (tl V1118)))))) (and (cons? (tl (tl (tl (tl (tl V1118)))))) (= () (tl (tl (tl (tl (tl (tl V1118)))))))))))))))) (cons let (cons (hd (tl V1118)) (cons (shen.aum_to_shen (hd (tl (tl (tl V1118))))) (cons (shen.aum_to_shen (hd (tl (tl (tl (tl (tl V1118))))))) ()))))) ((and (cons? V1118) (and (= shen.the (hd V1118)) (and (cons? (tl V1118)) (and (= shen.result (hd (tl V1118))) (and (cons? (tl (tl V1118))) (and (= shen.of (hd (tl (tl V1118)))) (and (cons? (tl (tl (tl V1118)))) (and (= shen.dereferencing (hd (tl (tl (tl V1118))))) (and (cons? (tl (tl (tl (tl V1118))))) (= () (tl (tl (tl (tl (tl V1118))))))))))))))) (cons shen.lazyderef (cons (shen.aum_to_shen (hd (tl (tl (tl (tl V1118)))))) (cons ProcessN ())))) ((and (cons? V1118) (and (= if (hd V1118)) (and (cons? (tl V1118)) (and (cons? (tl (tl V1118))) (and (= shen.then (hd (tl (tl V1118)))) (and (cons? (tl (tl (tl V1118)))) (and (cons? (tl (tl (tl (tl V1118))))) (and (= shen.else (hd (tl (tl (tl (tl V1118)))))) (and (cons? (tl (tl (tl (tl (tl V1118)))))) (= () (tl (tl (tl (tl (tl (tl V1118)))))))))))))))) (cons if (cons (shen.aum_to_shen (hd (tl V1118))) (cons (shen.aum_to_shen (hd (tl (tl (tl V1118))))) (cons (shen.aum_to_shen (hd (tl (tl (tl (tl (tl V1118))))))) ()))))) ((and (cons? V1118) (and (cons? (tl V1118)) (and (= is (hd (tl V1118))) (and (cons? (tl (tl V1118))) (and (= shen.a (hd (tl (tl V1118)))) (and (cons? (tl (tl (tl V1118)))) (and (= shen.variable (hd (tl (tl (tl V1118))))) (= () (tl (tl (tl (tl V1118)))))))))))) (cons shen.pvar? (cons (hd V1118) ()))) ((and (cons? V1118) (and (cons? (tl V1118)) (and (= is (hd (tl V1118))) (and (cons? (tl (tl V1118))) (and (= shen.a (hd (tl (tl V1118)))) (and (cons? (tl (tl (tl V1118)))) (and (= shen.non-empty (hd (tl (tl (tl V1118))))) (and (cons? (tl (tl (tl (tl V1118))))) (and (= list (hd (tl (tl (tl (tl V1118)))))) (= () (tl (tl (tl (tl (tl V1118))))))))))))))) (cons cons? (cons (hd V1118) ()))) ((and (cons? V1118) (and (= shen.rename (hd V1118)) (and (cons? (tl V1118)) (and (= shen.the (hd (tl V1118))) (and (cons? (tl (tl V1118))) (and (= shen.variables (hd (tl (tl V1118)))) (and (cons? (tl (tl (tl V1118)))) (and (= in (hd (tl (tl (tl V1118))))) (and (cons? (tl (tl (tl (tl V1118))))) (and (= () (hd (tl (tl (tl (tl V1118)))))) (and (cons? (tl (tl (tl (tl (tl V1118)))))) (and (= and (hd (tl (tl (tl (tl (tl V1118))))))) (and (cons? (tl (tl (tl (tl (tl (tl V1118))))))) (and (= shen.then (hd (tl (tl (tl (tl (tl (tl V1118)))))))) (and (cons? (tl (tl (tl (tl (tl (tl (tl V1118)))))))) (= () (tl (tl (tl (tl (tl (tl (tl (tl V1118)))))))))))))))))))))))) (shen.aum_to_shen (hd (tl (tl (tl (tl (tl (tl (tl V1118)))))))))) ((and (cons? V1118) (and (= shen.rename (hd V1118)) (and (cons? (tl V1118)) (and (= shen.the (hd (tl V1118))) (and (cons? (tl (tl V1118))) (and (= shen.variables (hd (tl (tl V1118)))) (and (cons? (tl (tl (tl V1118)))) (and (= in (hd (tl (tl (tl V1118))))) (and (cons? (tl (tl (tl (tl V1118))))) (and (cons? (hd (tl (tl (tl (tl V1118)))))) (and (cons? (tl (tl (tl (tl (tl V1118)))))) (and (= and (hd (tl (tl (tl (tl (tl V1118))))))) (and (cons? (tl (tl (tl (tl (tl (tl V1118))))))) (and (= shen.then (hd (tl (tl (tl (tl (tl (tl V1118)))))))) (and (cons? (tl (tl (tl (tl (tl (tl (tl V1118)))))))) (= () (tl (tl (tl (tl (tl (tl (tl (tl V1118)))))))))))))))))))))))) (cons let (cons (hd (hd (tl (tl (tl (tl V1118)))))) (cons (cons shen.newpv (cons ProcessN ())) (cons (shen.aum_to_shen (cons shen.rename (cons shen.the (cons shen.variables (cons in (cons (tl (hd (tl (tl (tl (tl V1118)))))) (tl (tl (tl (tl (tl V1118))))))))))) ()))))) ((and (cons? V1118) (and (= bind (hd V1118)) (and (cons? (tl V1118)) (and (cons? (tl (tl V1118))) (and (= shen.to (hd (tl (tl V1118)))) (and (cons? (tl (tl (tl V1118)))) (and (cons? (tl (tl (tl (tl V1118))))) (and (= in (hd (tl (tl (tl (tl V1118)))))) (and (cons? (tl (tl (tl (tl (tl V1118)))))) (= () (tl (tl (tl (tl (tl (tl V1118)))))))))))))))) (cons do (cons (cons shen.bindv (cons (hd (tl V1118)) (cons (shen.chwild (hd (tl (tl (tl V1118))))) (cons ProcessN ())))) (cons (cons let (cons Result (cons (shen.aum_to_shen (hd (tl (tl (tl (tl (tl V1118))))))) (cons (cons do (cons (cons shen.unbindv (cons (hd (tl V1118)) (cons ProcessN ()))) (cons Result ()))) ())))) ())))) ((and (cons? V1118) (and (cons? (tl V1118)) (and (= is (hd (tl V1118))) (and (cons? (tl (tl V1118))) (and (= identical (hd (tl (tl V1118)))) (and (cons? (tl (tl (tl V1118)))) (and (= shen.to (hd (tl (tl (tl V1118))))) (and (cons? (tl (tl (tl (tl V1118))))) (= () (tl (tl (tl (tl (tl V1118)))))))))))))) (cons = (cons (hd (tl (tl (tl (tl V1118))))) (cons (hd V1118) ())))) ((= shen.failed! V1118) false) ((and (cons? V1118) (and (= shen.the (hd V1118)) (and (cons? (tl V1118)) (and (= head (hd (tl V1118))) (and (cons? (tl (tl V1118))) (and (= shen.of (hd (tl (tl V1118)))) (and (cons? (tl (tl (tl V1118)))) (= () (tl (tl (tl (tl V1118)))))))))))) (cons hd (tl (tl (tl V1118))))) ((and (cons? V1118) (and (= shen.the (hd V1118)) (and (cons? (tl V1118)) (and (= tail (hd (tl V1118))) (and (cons? (tl (tl V1118))) (and (= shen.of (hd (tl (tl V1118)))) (and (cons? (tl (tl (tl V1118)))) (= () (tl (tl (tl (tl V1118)))))))))))) (cons tl (tl (tl (tl V1118))))) ((and (cons? V1118) (and (= shen.pop (hd V1118)) (and (cons? (tl V1118)) (and (= shen.the (hd (tl V1118))) (and (cons? (tl (tl V1118))) (and (= shen.stack (hd (tl (tl V1118)))) (= () (tl (tl (tl V1118)))))))))) (cons do (cons (cons shen.incinfs ()) (cons (cons thaw (cons Continuation ())) ())))) ((and (cons? V1118) (and (= call (hd V1118)) (and (cons? (tl V1118)) (and (= shen.the (hd (tl V1118))) (and (cons? (tl (tl V1118))) (and (= shen.continuation (hd (tl (tl V1118)))) (and (cons? (tl (tl (tl V1118)))) (= () (tl (tl (tl (tl V1118)))))))))))) (cons do (cons (cons shen.incinfs ()) (cons (shen.call_the_continuation (shen.chwild (hd (tl (tl (tl V1118))))) ProcessN Continuation) ())))) (true V1118)))
|
|
171
171
|
|
|
172
|
-
(defun shen.chwild (
|
|
172
|
+
(defun shen.chwild (V1119) (cond ((= V1119 _) (cons shen.newpv (cons ProcessN ()))) ((cons? V1119) (map shen.chwild V1119)) (true V1119)))
|
|
173
173
|
|
|
174
|
-
(defun shen.newpv (
|
|
174
|
+
(defun shen.newpv (V1120) (let Count+1 (+ (<-address (value shen.*varcounter*) V1120) 1) (let IncVar (address-> (value shen.*varcounter*) V1120 Count+1) (let Vector (<-address (value shen.*prologvectors*) V1120) (let ResizeVectorIfNeeded (if (= Count+1 (limit Vector)) (shen.resizeprocessvector V1120 Count+1) shen.skip) (shen.mk-pvar Count+1))))))
|
|
175
175
|
|
|
176
|
-
(defun shen.resizeprocessvector (
|
|
176
|
+
(defun shen.resizeprocessvector (V1121 V1122) (let Vector (<-address (value shen.*prologvectors*) V1121) (let BigVector (shen.resize-vector Vector (+ V1122 V1122) shen.-null-) (address-> (value shen.*prologvectors*) V1121 BigVector))))
|
|
177
177
|
|
|
178
|
-
(defun shen.resize-vector (
|
|
178
|
+
(defun shen.resize-vector (V1123 V1124 V1125) (let BigVector (address-> (absvector (+ 1 V1124)) 0 V1124) (shen.copy-vector V1123 BigVector (limit V1123) V1124 V1125)))
|
|
179
179
|
|
|
180
|
-
(defun shen.copy-vector (
|
|
180
|
+
(defun shen.copy-vector (V1126 V1127 V1128 V1129 V1130) (shen.copy-vector-stage-2 (+ 1 V1128) (+ V1129 1) V1130 (shen.copy-vector-stage-1 1 V1126 V1127 (+ 1 V1128))))
|
|
181
181
|
|
|
182
|
-
(defun shen.copy-vector-stage-1 (
|
|
182
|
+
(defun shen.copy-vector-stage-1 (V1133 V1134 V1135 V1136) (cond ((= V1136 V1133) V1135) (true (shen.copy-vector-stage-1 (+ 1 V1133) V1134 (address-> V1135 V1133 (<-address V1134 V1133)) V1136))))
|
|
183
183
|
|
|
184
|
-
(defun shen.copy-vector-stage-2 (
|
|
184
|
+
(defun shen.copy-vector-stage-2 (V1140 V1141 V1142 V1143) (cond ((= V1141 V1140) V1143) (true (shen.copy-vector-stage-2 (+ V1140 1) V1141 V1142 (address-> V1143 V1140 V1142)))))
|
|
185
185
|
|
|
186
|
-
(defun shen.mk-pvar (
|
|
186
|
+
(defun shen.mk-pvar (V1145) (address-> (address-> (absvector 2) 0 shen.pvar) 1 V1145))
|
|
187
187
|
|
|
188
|
-
(defun shen.pvar? (
|
|
188
|
+
(defun shen.pvar? (V1146) (and (absvector? V1146) (= (<-address V1146 0) shen.pvar)))
|
|
189
189
|
|
|
190
|
-
(defun shen.bindv (
|
|
190
|
+
(defun shen.bindv (V1147 V1148 V1149) (let Vector (<-address (value shen.*prologvectors*) V1149) (address-> Vector (<-address V1147 1) V1148)))
|
|
191
191
|
|
|
192
|
-
(defun shen.unbindv (
|
|
192
|
+
(defun shen.unbindv (V1150 V1151) (let Vector (<-address (value shen.*prologvectors*) V1151) (address-> Vector (<-address V1150 1) shen.-null-)))
|
|
193
193
|
|
|
194
194
|
(defun shen.incinfs () (set shen.*infs* (+ 1 (value shen.*infs*))))
|
|
195
195
|
|
|
196
|
-
(defun shen.call_the_continuation (
|
|
196
|
+
(defun shen.call_the_continuation (V1152 V1153 V1154) (cond ((and (cons? V1152) (and (cons? (hd V1152)) (= () (tl V1152)))) (cons (hd (hd V1152)) (append (tl (hd V1152)) (cons V1153 (cons V1154 ()))))) ((and (cons? V1152) (cons? (hd V1152))) (let NewContinuation (shen.newcontinuation (tl V1152) V1153 V1154) (cons (hd (hd V1152)) (append (tl (hd V1152)) (cons V1153 (cons NewContinuation ())))))) (true (shen.sys-error shen.call_the_continuation))))
|
|
197
197
|
|
|
198
|
-
(defun shen.newcontinuation (
|
|
198
|
+
(defun shen.newcontinuation (V1155 V1156 V1157) (cond ((= () V1155) V1157) ((and (cons? V1155) (cons? (hd V1155))) (cons freeze (cons (cons (hd (hd V1155)) (append (tl (hd V1155)) (cons V1156 (cons (shen.newcontinuation (tl V1155) V1156 V1157) ())))) ()))) (true (shen.sys-error shen.newcontinuation))))
|
|
199
199
|
|
|
200
|
-
(defun return (
|
|
200
|
+
(defun return (V1162 V1163 V1164) (shen.deref V1162 V1163))
|
|
201
201
|
|
|
202
|
-
(defun shen.measure&return (
|
|
203
|
-
" shen.a) (stoutput)) (shen.deref
|
|
202
|
+
(defun shen.measure&return (V1169 V1170 V1171) (do (shen.prhush (shen.app (value shen.*infs*) " inferences
|
|
203
|
+
" shen.a) (stoutput)) (shen.deref V1169 V1170)))
|
|
204
204
|
|
|
205
|
-
(defun unify (
|
|
205
|
+
(defun unify (V1172 V1173 V1174 V1175) (shen.lzy= (shen.lazyderef V1172 V1174) (shen.lazyderef V1173 V1174) V1174 V1175))
|
|
206
206
|
|
|
207
|
-
(defun shen.lzy= (
|
|
207
|
+
(defun shen.lzy= (V1192 V1193 V1194 V1195) (cond ((= V1193 V1192) (thaw V1195)) ((shen.pvar? V1192) (bind V1192 V1193 V1194 V1195)) ((shen.pvar? V1193) (bind V1193 V1192 V1194 V1195)) ((and (cons? V1192) (cons? V1193)) (shen.lzy= (shen.lazyderef (hd V1192) V1194) (shen.lazyderef (hd V1193) V1194) V1194 (freeze (shen.lzy= (shen.lazyderef (tl V1192) V1194) (shen.lazyderef (tl V1193) V1194) V1194 V1195)))) (true false)))
|
|
208
208
|
|
|
209
|
-
(defun shen.deref (
|
|
209
|
+
(defun shen.deref (V1197 V1198) (cond ((cons? V1197) (cons (shen.deref (hd V1197) V1198) (shen.deref (tl V1197) V1198))) (true (if (shen.pvar? V1197) (let Value (shen.valvector V1197 V1198) (if (= Value shen.-null-) V1197 (shen.deref Value V1198))) V1197))))
|
|
210
210
|
|
|
211
|
-
(defun shen.lazyderef (
|
|
211
|
+
(defun shen.lazyderef (V1199 V1200) (if (shen.pvar? V1199) (let Value (shen.valvector V1199 V1200) (if (= Value shen.-null-) V1199 (shen.lazyderef Value V1200))) V1199))
|
|
212
212
|
|
|
213
|
-
(defun shen.valvector (
|
|
213
|
+
(defun shen.valvector (V1201 V1202) (<-address (<-address (value shen.*prologvectors*) V1202) (<-address V1201 1)))
|
|
214
214
|
|
|
215
|
-
(defun unify! (
|
|
215
|
+
(defun unify! (V1203 V1204 V1205 V1206) (shen.lzy=! (shen.lazyderef V1203 V1205) (shen.lazyderef V1204 V1205) V1205 V1206))
|
|
216
216
|
|
|
217
|
-
(defun shen.lzy=! (
|
|
217
|
+
(defun shen.lzy=! (V1223 V1224 V1225 V1226) (cond ((= V1224 V1223) (thaw V1226)) ((and (shen.pvar? V1223) (not (shen.occurs? V1223 (shen.deref V1224 V1225)))) (bind V1223 V1224 V1225 V1226)) ((and (shen.pvar? V1224) (not (shen.occurs? V1224 (shen.deref V1223 V1225)))) (bind V1224 V1223 V1225 V1226)) ((and (cons? V1223) (cons? V1224)) (shen.lzy=! (shen.lazyderef (hd V1223) V1225) (shen.lazyderef (hd V1224) V1225) V1225 (freeze (shen.lzy=! (shen.lazyderef (tl V1223) V1225) (shen.lazyderef (tl V1224) V1225) V1225 V1226)))) (true false)))
|
|
218
218
|
|
|
219
|
-
(defun shen.occurs? (
|
|
219
|
+
(defun shen.occurs? (V1236 V1237) (cond ((= V1237 V1236) true) ((cons? V1237) (or (shen.occurs? V1236 (hd V1237)) (shen.occurs? V1236 (tl V1237)))) (true false)))
|
|
220
220
|
|
|
221
|
-
(defun identical (
|
|
221
|
+
(defun identical (V1239 V1240 V1241 V1242) (shen.lzy== (shen.lazyderef V1239 V1241) (shen.lazyderef V1240 V1241) V1241 V1242))
|
|
222
222
|
|
|
223
|
-
(defun shen.lzy== (
|
|
223
|
+
(defun shen.lzy== (V1259 V1260 V1261 V1262) (cond ((= V1260 V1259) (thaw V1262)) ((and (cons? V1259) (cons? V1260)) (shen.lzy== (shen.lazyderef (hd V1259) V1261) (shen.lazyderef (hd V1260) V1261) V1261 (freeze (shen.lzy== (tl V1259) (tl V1260) V1261 V1262)))) (true false)))
|
|
224
224
|
|
|
225
|
-
(defun shen.pvar (
|
|
225
|
+
(defun shen.pvar (V1264) (cn "Var" (shen.app (<-address V1264 1) "" shen.a)))
|
|
226
226
|
|
|
227
|
-
(defun bind (
|
|
227
|
+
(defun bind (V1265 V1266 V1267 V1268) (do (shen.bindv V1265 V1266 V1267) (let Result (thaw V1268) (do (shen.unbindv V1265 V1267) Result))))
|
|
228
228
|
|
|
229
|
-
(defun fwhen (
|
|
229
|
+
(defun fwhen (V1283 V1284 V1285) (cond ((= true V1283) (thaw V1285)) ((= false V1283) false) (true (simple-error (cn "fwhen expects a boolean: not " (shen.app V1283 "%" shen.s))))))
|
|
230
230
|
|
|
231
|
-
(defun call (
|
|
231
|
+
(defun call (V1298 V1299 V1300) (cond ((cons? V1298) (shen.call-help (shen.m_prolog_to_s-prolog_predicate (shen.lazyderef (hd V1298) V1299)) (tl V1298) V1299 V1300)) (true false)))
|
|
232
232
|
|
|
233
|
-
(defun shen.call-help (
|
|
233
|
+
(defun shen.call-help (V1301 V1302 V1303 V1304) (cond ((= () V1302) (V1301 V1303 V1304)) ((cons? V1302) (shen.call-help (V1301 (hd V1302)) (tl V1302) V1303 V1304)) (true (shen.sys-error shen.call-help))))
|
|
234
234
|
|
|
235
|
-
(defun shen.intprolog (
|
|
235
|
+
(defun shen.intprolog (V1305) (cond ((and (cons? V1305) (cons? (hd V1305))) (let ProcessN (shen.start-new-prolog-process) (shen.intprolog-help (hd (hd V1305)) (shen.insert-prolog-variables (cons (tl (hd V1305)) (cons (tl V1305) ())) ProcessN) ProcessN))) (true (shen.sys-error shen.intprolog))))
|
|
236
236
|
|
|
237
|
-
(defun shen.intprolog-help (
|
|
237
|
+
(defun shen.intprolog-help (V1306 V1307 V1308) (cond ((and (cons? V1307) (and (cons? (tl V1307)) (= () (tl (tl V1307))))) (shen.intprolog-help-help V1306 (hd V1307) (hd (tl V1307)) V1308)) (true (shen.sys-error shen.intprolog-help))))
|
|
238
238
|
|
|
239
|
-
(defun shen.intprolog-help-help (
|
|
239
|
+
(defun shen.intprolog-help-help (V1309 V1310 V1311 V1312) (cond ((= () V1310) (V1309 V1312 (freeze (shen.call-rest V1311 V1312)))) ((cons? V1310) (shen.intprolog-help-help (V1309 (hd V1310)) (tl V1310) V1311 V1312)) (true (shen.sys-error shen.intprolog-help-help))))
|
|
240
240
|
|
|
241
|
-
(defun shen.call-rest (
|
|
241
|
+
(defun shen.call-rest (V1315 V1316) (cond ((= () V1315) true) ((and (cons? V1315) (and (cons? (hd V1315)) (cons? (tl (hd V1315))))) (shen.call-rest (cons (cons ((hd (hd V1315)) (hd (tl (hd V1315)))) (tl (tl (hd V1315)))) (tl V1315)) V1316)) ((and (cons? V1315) (and (cons? (hd V1315)) (= () (tl (hd V1315))))) ((hd (hd V1315)) V1316 (freeze (shen.call-rest (tl V1315) V1316)))) (true (shen.sys-error shen.call-rest))))
|
|
242
242
|
|
|
243
243
|
(defun shen.start-new-prolog-process () (let IncrementProcessCounter (set shen.*process-counter* (+ 1 (value shen.*process-counter*))) (shen.initialise-prolog IncrementProcessCounter)))
|
|
244
244
|
|
|
245
|
-
(defun shen.insert-prolog-variables (
|
|
245
|
+
(defun shen.insert-prolog-variables (V1317 V1318) (shen.insert-prolog-variables-help V1317 (shen.flatten V1317) V1318))
|
|
246
246
|
|
|
247
|
-
(defun shen.insert-prolog-variables-help (
|
|
247
|
+
(defun shen.insert-prolog-variables-help (V1323 V1324 V1325) (cond ((= () V1324) V1323) ((and (cons? V1324) (variable? (hd V1324))) (let V (shen.newpv V1325) (let XV/Y (subst V (hd V1324) V1323) (let Z-Y (remove (hd V1324) (tl V1324)) (shen.insert-prolog-variables-help XV/Y Z-Y V1325))))) ((cons? V1324) (shen.insert-prolog-variables-help V1323 (tl V1324) V1325)) (true (shen.sys-error shen.insert-prolog-variables-help))))
|
|
248
248
|
|
|
249
|
-
(defun shen.initialise-prolog (
|
|
249
|
+
(defun shen.initialise-prolog (V1326) (let Vector (address-> (value shen.*prologvectors*) V1326 (shen.fillvector (vector 10) 1 10 shen.-null-)) (let Counter (address-> (value shen.*varcounter*) V1326 1) V1326)))
|
|
250
250
|
|
|
251
251
|
|
|
252
252
|
|
|
@@ -49,134 +49,142 @@
|
|
|
49
49
|
*****************************************************************************************
|
|
50
50
|
"(defun lineread () (shen.lineread-loop (read-byte (stinput)) ()))
|
|
51
51
|
|
|
52
|
-
(defun shen.lineread-loop (
|
|
52
|
+
(defun shen.lineread-loop (V1329 V1330) (cond ((= V1329 (shen.hat)) (simple-error "line read aborted")) ((element? V1329 (cons (shen.newline) (cons (shen.carriage-return) ()))) (let Line (compile shen.<st_input> V1330 (lambda E shen.nextline)) (if (or (= Line shen.nextline) (empty? Line)) (shen.lineread-loop (read-byte (stinput)) (append V1330 (cons V1329 ()))) Line))) (true (shen.lineread-loop (read-byte (stinput)) (append V1330 (cons V1329 ()))))))
|
|
53
53
|
|
|
54
|
-
(defun read-file (
|
|
54
|
+
(defun read-file (V1331) (let Bytelist (read-file-as-bytelist V1331) (compile shen.<st_input> Bytelist shen.read-error)))
|
|
55
55
|
|
|
56
|
-
(defun shen.read-error (
|
|
56
|
+
(defun shen.read-error (V1338) (cond ((and (cons? V1338) (and (cons? (hd V1338)) (and (cons? (tl V1338)) (= () (tl (tl V1338)))))) (simple-error (cn "read error here:
|
|
57
57
|
|
|
58
|
-
" (shen.app (shen.compress-50 50 (hd
|
|
58
|
+
" (shen.app (shen.compress-50 50 (hd V1338)) "
|
|
59
59
|
" shen.a)))) (true (simple-error "read error
|
|
60
60
|
"))))
|
|
61
61
|
|
|
62
|
-
(defun shen.compress-50 (
|
|
62
|
+
(defun shen.compress-50 (V1343 V1344) (cond ((= () V1344) "") ((= 0 V1343) "") ((cons? V1344) (cn (n->string (hd V1344)) (shen.compress-50 (- V1343 1) (tl V1344)))) (true (shen.sys-error shen.compress-50))))
|
|
63
63
|
|
|
64
|
-
(defun shen.<st_input> (
|
|
64
|
+
(defun shen.<st_input> (V1349) (let Result (let Parse_shen.<lsb> (shen.<lsb> V1349) (if (not (= (fail) Parse_shen.<lsb>)) (let Parse_shen.<st_input1> (shen.<st_input1> Parse_shen.<lsb>) (if (not (= (fail) Parse_shen.<st_input1>)) (let Parse_shen.<rsb> (shen.<rsb> Parse_shen.<st_input1>) (if (not (= (fail) Parse_shen.<rsb>)) (let Parse_shen.<st_input2> (shen.<st_input2> Parse_shen.<rsb>) (if (not (= (fail) Parse_shen.<st_input2>)) (shen.pair (hd Parse_shen.<st_input2>) (cons (macroexpand (shen.cons_form (shen.hdtl Parse_shen.<st_input1>))) (shen.hdtl Parse_shen.<st_input2>))) (fail))) (fail))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<lrb> (shen.<lrb> V1349) (if (not (= (fail) Parse_shen.<lrb>)) (let Parse_shen.<st_input1> (shen.<st_input1> Parse_shen.<lrb>) (if (not (= (fail) Parse_shen.<st_input1>)) (let Parse_shen.<rrb> (shen.<rrb> Parse_shen.<st_input1>) (if (not (= (fail) Parse_shen.<rrb>)) (let Parse_shen.<st_input2> (shen.<st_input2> Parse_shen.<rrb>) (if (not (= (fail) Parse_shen.<st_input2>)) (shen.pair (hd Parse_shen.<st_input2>) (shen.package-macro (macroexpand (shen.hdtl Parse_shen.<st_input1>)) (shen.hdtl Parse_shen.<st_input2>))) (fail))) (fail))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<lcurly> (shen.<lcurly> V1349) (if (not (= (fail) Parse_shen.<lcurly>)) (let Parse_shen.<st_input> (shen.<st_input> Parse_shen.<lcurly>) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (cons { (shen.hdtl Parse_shen.<st_input>))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<rcurly> (shen.<rcurly> V1349) (if (not (= (fail) Parse_shen.<rcurly>)) (let Parse_shen.<st_input> (shen.<st_input> Parse_shen.<rcurly>) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (cons } (shen.hdtl Parse_shen.<st_input>))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<bar> (shen.<bar> V1349) (if (not (= (fail) Parse_shen.<bar>)) (let Parse_shen.<st_input> (shen.<st_input> Parse_shen.<bar>) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (cons bar! (shen.hdtl Parse_shen.<st_input>))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<semicolon> (shen.<semicolon> V1349) (if (not (= (fail) Parse_shen.<semicolon>)) (let Parse_shen.<st_input> (shen.<st_input> Parse_shen.<semicolon>) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (cons ; (shen.hdtl Parse_shen.<st_input>))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<colon> (shen.<colon> V1349) (if (not (= (fail) Parse_shen.<colon>)) (let Parse_shen.<equal> (shen.<equal> Parse_shen.<colon>) (if (not (= (fail) Parse_shen.<equal>)) (let Parse_shen.<st_input> (shen.<st_input> Parse_shen.<equal>) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (cons := (shen.hdtl Parse_shen.<st_input>))) (fail))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<colon> (shen.<colon> V1349) (if (not (= (fail) Parse_shen.<colon>)) (let Parse_shen.<minus> (shen.<minus> Parse_shen.<colon>) (if (not (= (fail) Parse_shen.<minus>)) (let Parse_shen.<st_input> (shen.<st_input> Parse_shen.<minus>) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (cons :- (shen.hdtl Parse_shen.<st_input>))) (fail))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<colon> (shen.<colon> V1349) (if (not (= (fail) Parse_shen.<colon>)) (let Parse_shen.<st_input> (shen.<st_input> Parse_shen.<colon>) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (cons : (shen.hdtl Parse_shen.<st_input>))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<comma> (shen.<comma> V1349) (if (not (= (fail) Parse_shen.<comma>)) (let Parse_shen.<st_input> (shen.<st_input> Parse_shen.<comma>) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (cons (intern ",") (shen.hdtl Parse_shen.<st_input>))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<comment> (shen.<comment> V1349) (if (not (= (fail) Parse_shen.<comment>)) (let Parse_shen.<st_input> (shen.<st_input> Parse_shen.<comment>) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (shen.hdtl Parse_shen.<st_input>)) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<atom> (shen.<atom> V1349) (if (not (= (fail) Parse_shen.<atom>)) (let Parse_shen.<st_input> (shen.<st_input> Parse_shen.<atom>) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (cons (macroexpand (shen.hdtl Parse_shen.<atom>)) (shen.hdtl Parse_shen.<st_input>))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<whitespaces> (shen.<whitespaces> V1349) (if (not (= (fail) Parse_shen.<whitespaces>)) (let Parse_shen.<st_input> (shen.<st_input> Parse_shen.<whitespaces>) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (shen.hdtl Parse_shen.<st_input>)) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_<e> (<e> V1349) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) ()) (fail))) (if (= Result (fail)) (fail) Result)) Result)) Result)) Result)) Result)) Result)) Result)) Result)) Result)) Result)) Result)) Result)) Result)) Result)))
|
|
65
65
|
|
|
66
|
-
(defun shen.<lsb> (
|
|
66
|
+
(defun shen.<lsb> (V1354) (let Result (if (and (cons? (hd V1354)) (= 91 (hd (hd V1354)))) (shen.pair (hd (shen.pair (tl (hd V1354)) (shen.hdtl V1354))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
67
67
|
|
|
68
|
-
(defun shen.<rsb> (
|
|
68
|
+
(defun shen.<rsb> (V1359) (let Result (if (and (cons? (hd V1359)) (= 93 (hd (hd V1359)))) (shen.pair (hd (shen.pair (tl (hd V1359)) (shen.hdtl V1359))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
69
69
|
|
|
70
|
-
(defun shen.<lcurly> (
|
|
70
|
+
(defun shen.<lcurly> (V1364) (let Result (if (and (cons? (hd V1364)) (= 123 (hd (hd V1364)))) (shen.pair (hd (shen.pair (tl (hd V1364)) (shen.hdtl V1364))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
71
71
|
|
|
72
|
-
(defun shen.<rcurly> (
|
|
72
|
+
(defun shen.<rcurly> (V1369) (let Result (if (and (cons? (hd V1369)) (= 125 (hd (hd V1369)))) (shen.pair (hd (shen.pair (tl (hd V1369)) (shen.hdtl V1369))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
73
73
|
|
|
74
|
-
(defun shen.<bar> (
|
|
74
|
+
(defun shen.<bar> (V1374) (let Result (if (and (cons? (hd V1374)) (= 124 (hd (hd V1374)))) (shen.pair (hd (shen.pair (tl (hd V1374)) (shen.hdtl V1374))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
75
75
|
|
|
76
|
-
(defun shen.<semicolon> (
|
|
76
|
+
(defun shen.<semicolon> (V1379) (let Result (if (and (cons? (hd V1379)) (= 59 (hd (hd V1379)))) (shen.pair (hd (shen.pair (tl (hd V1379)) (shen.hdtl V1379))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
77
77
|
|
|
78
|
-
(defun shen.<colon> (
|
|
78
|
+
(defun shen.<colon> (V1384) (let Result (if (and (cons? (hd V1384)) (= 58 (hd (hd V1384)))) (shen.pair (hd (shen.pair (tl (hd V1384)) (shen.hdtl V1384))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
79
79
|
|
|
80
|
-
(defun shen.<comma> (
|
|
80
|
+
(defun shen.<comma> (V1389) (let Result (if (and (cons? (hd V1389)) (= 44 (hd (hd V1389)))) (shen.pair (hd (shen.pair (tl (hd V1389)) (shen.hdtl V1389))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
81
81
|
|
|
82
|
-
(defun shen.<equal> (
|
|
82
|
+
(defun shen.<equal> (V1394) (let Result (if (and (cons? (hd V1394)) (= 61 (hd (hd V1394)))) (shen.pair (hd (shen.pair (tl (hd V1394)) (shen.hdtl V1394))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
83
83
|
|
|
84
|
-
(defun shen.<minus> (
|
|
84
|
+
(defun shen.<minus> (V1399) (let Result (if (and (cons? (hd V1399)) (= 45 (hd (hd V1399)))) (shen.pair (hd (shen.pair (tl (hd V1399)) (shen.hdtl V1399))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
85
85
|
|
|
86
|
-
(defun shen.<lrb> (
|
|
86
|
+
(defun shen.<lrb> (V1404) (let Result (if (and (cons? (hd V1404)) (= 40 (hd (hd V1404)))) (shen.pair (hd (shen.pair (tl (hd V1404)) (shen.hdtl V1404))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
87
87
|
|
|
88
|
-
(defun shen.<rrb> (
|
|
88
|
+
(defun shen.<rrb> (V1409) (let Result (if (and (cons? (hd V1409)) (= 41 (hd (hd V1409)))) (shen.pair (hd (shen.pair (tl (hd V1409)) (shen.hdtl V1409))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
89
89
|
|
|
90
|
-
(defun shen.<atom> (
|
|
90
|
+
(defun shen.<atom> (V1414) (let Result (let Parse_shen.<str> (shen.<str> V1414) (if (not (= (fail) Parse_shen.<str>)) (shen.pair (hd Parse_shen.<str>) (shen.control-chars (shen.hdtl Parse_shen.<str>))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<number> (shen.<number> V1414) (if (not (= (fail) Parse_shen.<number>)) (shen.pair (hd Parse_shen.<number>) (shen.hdtl Parse_shen.<number>)) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<sym> (shen.<sym> V1414) (if (not (= (fail) Parse_shen.<sym>)) (shen.pair (hd Parse_shen.<sym>) (if (= (shen.hdtl Parse_shen.<sym>) "<>") (cons vector (cons 0 ())) (intern (shen.hdtl Parse_shen.<sym>)))) (fail))) (if (= Result (fail)) (fail) Result)) Result)) Result)))
|
|
91
91
|
|
|
92
|
-
(defun shen.control-chars (
|
|
92
|
+
(defun shen.control-chars (V1415) (cond ((= () V1415) "") ((and (cons? V1415) (and (= "c" (hd V1415)) (and (cons? (tl V1415)) (= "#" (hd (tl V1415)))))) (let CodePoint (shen.code-point (tl (tl V1415))) (let AfterCodePoint (shen.after-codepoint (tl (tl V1415))) (@s (n->string (shen.decimalise CodePoint)) (shen.control-chars AfterCodePoint))))) ((cons? V1415) (@s (hd V1415) (shen.control-chars (tl V1415)))) (true (shen.sys-error shen.control-chars))))
|
|
93
93
|
|
|
94
|
-
(defun shen.code-point (
|
|
94
|
+
(defun shen.code-point (V1418) (cond ((and (cons? V1418) (= ";" (hd V1418))) "") ((and (cons? V1418) (element? (hd V1418) (cons "0" (cons "1" (cons "2" (cons "3" (cons "4" (cons "5" (cons "6" (cons "7" (cons "8" (cons "9" (cons "0" ()))))))))))))) (cons (hd V1418) (shen.code-point (tl V1418)))) (true (simple-error (cn "code point parse error " (shen.app V1418 "
|
|
95
95
|
" shen.a))))))
|
|
96
96
|
|
|
97
|
-
(defun shen.after-codepoint (
|
|
97
|
+
(defun shen.after-codepoint (V1423) (cond ((= () V1423) ()) ((and (cons? V1423) (= ";" (hd V1423))) (tl V1423)) ((cons? V1423) (shen.after-codepoint (tl V1423))) (true (shen.sys-error shen.after-codepoint))))
|
|
98
98
|
|
|
99
|
-
(defun shen.decimalise (
|
|
99
|
+
(defun shen.decimalise (V1424) (shen.pre (reverse (shen.digits->integers V1424)) 0))
|
|
100
100
|
|
|
101
|
-
(defun shen.digits->integers (
|
|
101
|
+
(defun shen.digits->integers (V1429) (cond ((and (cons? V1429) (= "0" (hd V1429))) (cons 0 (shen.digits->integers (tl V1429)))) ((and (cons? V1429) (= "1" (hd V1429))) (cons 1 (shen.digits->integers (tl V1429)))) ((and (cons? V1429) (= "2" (hd V1429))) (cons 2 (shen.digits->integers (tl V1429)))) ((and (cons? V1429) (= "3" (hd V1429))) (cons 3 (shen.digits->integers (tl V1429)))) ((and (cons? V1429) (= "4" (hd V1429))) (cons 4 (shen.digits->integers (tl V1429)))) ((and (cons? V1429) (= "5" (hd V1429))) (cons 5 (shen.digits->integers (tl V1429)))) ((and (cons? V1429) (= "6" (hd V1429))) (cons 6 (shen.digits->integers (tl V1429)))) ((and (cons? V1429) (= "7" (hd V1429))) (cons 7 (shen.digits->integers (tl V1429)))) ((and (cons? V1429) (= "8" (hd V1429))) (cons 8 (shen.digits->integers (tl V1429)))) ((and (cons? V1429) (= "9" (hd V1429))) (cons 9 (shen.digits->integers (tl V1429)))) (true ())))
|
|
102
102
|
|
|
103
|
-
(defun shen.<sym> (
|
|
103
|
+
(defun shen.<sym> (V1434) (let Result (let Parse_shen.<alpha> (shen.<alpha> V1434) (if (not (= (fail) Parse_shen.<alpha>)) (let Parse_shen.<alphanums> (shen.<alphanums> Parse_shen.<alpha>) (if (not (= (fail) Parse_shen.<alphanums>)) (shen.pair (hd Parse_shen.<alphanums>) (@s (shen.hdtl Parse_shen.<alpha>) (shen.hdtl Parse_shen.<alphanums>))) (fail))) (fail))) (if (= Result (fail)) (fail) Result)))
|
|
104
104
|
|
|
105
|
-
(defun shen.<alphanums> (
|
|
105
|
+
(defun shen.<alphanums> (V1439) (let Result (let Parse_shen.<alphanum> (shen.<alphanum> V1439) (if (not (= (fail) Parse_shen.<alphanum>)) (let Parse_shen.<alphanums> (shen.<alphanums> Parse_shen.<alphanum>) (if (not (= (fail) Parse_shen.<alphanums>)) (shen.pair (hd Parse_shen.<alphanums>) (@s (shen.hdtl Parse_shen.<alphanum>) (shen.hdtl Parse_shen.<alphanums>))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_<e> (<e> V1439) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) "") (fail))) (if (= Result (fail)) (fail) Result)) Result)))
|
|
106
106
|
|
|
107
|
-
(defun shen.<alphanum> (
|
|
107
|
+
(defun shen.<alphanum> (V1444) (let Result (let Parse_shen.<alpha> (shen.<alpha> V1444) (if (not (= (fail) Parse_shen.<alpha>)) (shen.pair (hd Parse_shen.<alpha>) (shen.hdtl Parse_shen.<alpha>)) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<num> (shen.<num> V1444) (if (not (= (fail) Parse_shen.<num>)) (shen.pair (hd Parse_shen.<num>) (shen.hdtl Parse_shen.<num>)) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
|
|
108
108
|
|
|
109
|
-
(defun shen.<num> (
|
|
109
|
+
(defun shen.<num> (V1449) (let Result (if (cons? (hd V1449)) (let Parse_Byte (hd (hd V1449)) (if (shen.numbyte? Parse_Byte) (shen.pair (hd (shen.pair (tl (hd V1449)) (shen.hdtl V1449))) (n->string Parse_Byte)) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
110
110
|
|
|
111
|
-
(defun shen.numbyte? (
|
|
111
|
+
(defun shen.numbyte? (V1454) (cond ((= 48 V1454) true) ((= 49 V1454) true) ((= 50 V1454) true) ((= 51 V1454) true) ((= 52 V1454) true) ((= 53 V1454) true) ((= 54 V1454) true) ((= 55 V1454) true) ((= 56 V1454) true) ((= 57 V1454) true) (true false)))
|
|
112
112
|
|
|
113
|
-
(defun shen.<alpha> (
|
|
113
|
+
(defun shen.<alpha> (V1459) (let Result (if (cons? (hd V1459)) (let Parse_Byte (hd (hd V1459)) (if (shen.symbol-code? Parse_Byte) (shen.pair (hd (shen.pair (tl (hd V1459)) (shen.hdtl V1459))) (n->string Parse_Byte)) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
114
114
|
|
|
115
|
-
(defun shen.symbol-code? (
|
|
115
|
+
(defun shen.symbol-code? (V1460) (or (= V1460 126) (or (and (> V1460 94) (< V1460 123)) (or (and (> V1460 59) (< V1460 91)) (or (and (> V1460 41) (and (< V1460 58) (not (= V1460 44)))) (or (and (> V1460 34) (< V1460 40)) (= V1460 33)))))))
|
|
116
116
|
|
|
117
|
-
(defun shen.<str> (
|
|
117
|
+
(defun shen.<str> (V1465) (let Result (let Parse_shen.<dbq> (shen.<dbq> V1465) (if (not (= (fail) Parse_shen.<dbq>)) (let Parse_shen.<strcontents> (shen.<strcontents> Parse_shen.<dbq>) (if (not (= (fail) Parse_shen.<strcontents>)) (let Parse_shen.<dbq> (shen.<dbq> Parse_shen.<strcontents>) (if (not (= (fail) Parse_shen.<dbq>)) (shen.pair (hd Parse_shen.<dbq>) (shen.hdtl Parse_shen.<strcontents>)) (fail))) (fail))) (fail))) (if (= Result (fail)) (fail) Result)))
|
|
118
118
|
|
|
119
|
-
(defun shen.<dbq> (
|
|
119
|
+
(defun shen.<dbq> (V1470) (let Result (if (cons? (hd V1470)) (let Parse_Byte (hd (hd V1470)) (if (= Parse_Byte 34) (shen.pair (hd (shen.pair (tl (hd V1470)) (shen.hdtl V1470))) Parse_Byte) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
120
120
|
|
|
121
|
-
(defun shen.<strcontents> (
|
|
121
|
+
(defun shen.<strcontents> (V1475) (let Result (let Parse_shen.<strc> (shen.<strc> V1475) (if (not (= (fail) Parse_shen.<strc>)) (let Parse_shen.<strcontents> (shen.<strcontents> Parse_shen.<strc>) (if (not (= (fail) Parse_shen.<strcontents>)) (shen.pair (hd Parse_shen.<strcontents>) (cons (shen.hdtl Parse_shen.<strc>) (shen.hdtl Parse_shen.<strcontents>))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_<e> (<e> V1475) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) ()) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
|
|
122
122
|
|
|
123
|
-
(defun shen.<byte> (
|
|
123
|
+
(defun shen.<byte> (V1480) (let Result (if (cons? (hd V1480)) (let Parse_Byte (hd (hd V1480)) (shen.pair (hd (shen.pair (tl (hd V1480)) (shen.hdtl V1480))) (n->string Parse_Byte))) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
124
124
|
|
|
125
|
-
(defun shen.<strc> (
|
|
125
|
+
(defun shen.<strc> (V1485) (let Result (if (cons? (hd V1485)) (let Parse_Byte (hd (hd V1485)) (if (not (= Parse_Byte 34)) (shen.pair (hd (shen.pair (tl (hd V1485)) (shen.hdtl V1485))) (n->string Parse_Byte)) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
126
126
|
|
|
127
|
-
(defun shen.<
|
|
127
|
+
(defun shen.<number> (V1490) (let Result (let Parse_shen.<minus> (shen.<minus> V1490) (if (not (= (fail) Parse_shen.<minus>)) (let Parse_shen.<number> (shen.<number> Parse_shen.<minus>) (if (not (= (fail) Parse_shen.<number>)) (shen.pair (hd Parse_shen.<number>) (- 0 (shen.hdtl Parse_shen.<number>))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<plus> (shen.<plus> V1490) (if (not (= (fail) Parse_shen.<plus>)) (let Parse_shen.<number> (shen.<number> Parse_shen.<plus>) (if (not (= (fail) Parse_shen.<number>)) (shen.pair (hd Parse_shen.<number>) (shen.hdtl Parse_shen.<number>)) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<predigits> (shen.<predigits> V1490) (if (not (= (fail) Parse_shen.<predigits>)) (let Parse_shen.<stop> (shen.<stop> Parse_shen.<predigits>) (if (not (= (fail) Parse_shen.<stop>)) (let Parse_shen.<postdigits> (shen.<postdigits> Parse_shen.<stop>) (if (not (= (fail) Parse_shen.<postdigits>)) (let Parse_shen.<E> (shen.<E> Parse_shen.<postdigits>) (if (not (= (fail) Parse_shen.<E>)) (let Parse_shen.<log10> (shen.<log10> Parse_shen.<E>) (if (not (= (fail) Parse_shen.<log10>)) (shen.pair (hd Parse_shen.<log10>) (* (shen.expt 10 (shen.hdtl Parse_shen.<log10>)) (+ (shen.pre (reverse (shen.hdtl Parse_shen.<predigits>)) 0) (shen.post (shen.hdtl Parse_shen.<postdigits>) 1)))) (fail))) (fail))) (fail))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<digits> (shen.<digits> V1490) (if (not (= (fail) Parse_shen.<digits>)) (let Parse_shen.<E> (shen.<E> Parse_shen.<digits>) (if (not (= (fail) Parse_shen.<E>)) (let Parse_shen.<log10> (shen.<log10> Parse_shen.<E>) (if (not (= (fail) Parse_shen.<log10>)) (shen.pair (hd Parse_shen.<log10>) (* (shen.expt 10 (shen.hdtl Parse_shen.<log10>)) (shen.pre (reverse (shen.hdtl Parse_shen.<digits>)) 0))) (fail))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<predigits> (shen.<predigits> V1490) (if (not (= (fail) Parse_shen.<predigits>)) (let Parse_shen.<stop> (shen.<stop> Parse_shen.<predigits>) (if (not (= (fail) Parse_shen.<stop>)) (let Parse_shen.<postdigits> (shen.<postdigits> Parse_shen.<stop>) (if (not (= (fail) Parse_shen.<postdigits>)) (shen.pair (hd Parse_shen.<postdigits>) (+ (shen.pre (reverse (shen.hdtl Parse_shen.<predigits>)) 0) (shen.post (shen.hdtl Parse_shen.<postdigits>) 1))) (fail))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<digits> (shen.<digits> V1490) (if (not (= (fail) Parse_shen.<digits>)) (shen.pair (hd Parse_shen.<digits>) (shen.pre (reverse (shen.hdtl Parse_shen.<digits>)) 0)) (fail))) (if (= Result (fail)) (fail) Result)) Result)) Result)) Result)) Result)) Result)))
|
|
128
128
|
|
|
129
|
-
(defun shen.<
|
|
129
|
+
(defun shen.<E> (V1495) (let Result (if (and (cons? (hd V1495)) (= 101 (hd (hd V1495)))) (shen.pair (hd (shen.pair (tl (hd V1495)) (shen.hdtl V1495))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
130
130
|
|
|
131
|
-
(defun shen.<
|
|
131
|
+
(defun shen.<log10> (V1500) (let Result (let Parse_shen.<minus> (shen.<minus> V1500) (if (not (= (fail) Parse_shen.<minus>)) (let Parse_shen.<digits> (shen.<digits> Parse_shen.<minus>) (if (not (= (fail) Parse_shen.<digits>)) (shen.pair (hd Parse_shen.<digits>) (- 0 (shen.pre (reverse (shen.hdtl Parse_shen.<digits>)) 0))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<digits> (shen.<digits> V1500) (if (not (= (fail) Parse_shen.<digits>)) (shen.pair (hd Parse_shen.<digits>) (shen.pre (reverse (shen.hdtl Parse_shen.<digits>)) 0)) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
|
|
132
132
|
|
|
133
|
-
(defun shen.<
|
|
133
|
+
(defun shen.<plus> (V1505) (let Result (if (cons? (hd V1505)) (let Parse_Byte (hd (hd V1505)) (if (= Parse_Byte 43) (shen.pair (hd (shen.pair (tl (hd V1505)) (shen.hdtl V1505))) Parse_Byte) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
134
134
|
|
|
135
|
-
(defun shen.<
|
|
135
|
+
(defun shen.<stop> (V1510) (let Result (if (cons? (hd V1510)) (let Parse_Byte (hd (hd V1510)) (if (= Parse_Byte 46) (shen.pair (hd (shen.pair (tl (hd V1510)) (shen.hdtl V1510))) Parse_Byte) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
136
136
|
|
|
137
|
-
(defun shen.<
|
|
137
|
+
(defun shen.<predigits> (V1515) (let Result (let Parse_shen.<digits> (shen.<digits> V1515) (if (not (= (fail) Parse_shen.<digits>)) (shen.pair (hd Parse_shen.<digits>) (shen.hdtl Parse_shen.<digits>)) (fail))) (if (= Result (fail)) (let Result (let Parse_<e> (<e> V1515) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) ()) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
|
|
138
138
|
|
|
139
|
-
(defun shen.<
|
|
139
|
+
(defun shen.<postdigits> (V1520) (let Result (let Parse_shen.<digits> (shen.<digits> V1520) (if (not (= (fail) Parse_shen.<digits>)) (shen.pair (hd Parse_shen.<digits>) (shen.hdtl Parse_shen.<digits>)) (fail))) (if (= Result (fail)) (fail) Result)))
|
|
140
140
|
|
|
141
|
-
(defun shen.<
|
|
141
|
+
(defun shen.<digits> (V1525) (let Result (let Parse_shen.<digit> (shen.<digit> V1525) (if (not (= (fail) Parse_shen.<digit>)) (let Parse_shen.<digits> (shen.<digits> Parse_shen.<digit>) (if (not (= (fail) Parse_shen.<digits>)) (shen.pair (hd Parse_shen.<digits>) (cons (shen.hdtl Parse_shen.<digit>) (shen.hdtl Parse_shen.<digits>))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<digit> (shen.<digit> V1525) (if (not (= (fail) Parse_shen.<digit>)) (shen.pair (hd Parse_shen.<digit>) (cons (shen.hdtl Parse_shen.<digit>) ())) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
|
|
142
142
|
|
|
143
|
-
(defun shen.<
|
|
143
|
+
(defun shen.<digit> (V1530) (let Result (if (cons? (hd V1530)) (let Parse_X (hd (hd V1530)) (if (shen.numbyte? Parse_X) (shen.pair (hd (shen.pair (tl (hd V1530)) (shen.hdtl V1530))) (shen.byte->digit Parse_X)) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
144
144
|
|
|
145
|
-
(defun shen
|
|
145
|
+
(defun shen.byte->digit (V1531) (cond ((= 48 V1531) 0) ((= 49 V1531) 1) ((= 50 V1531) 2) ((= 51 V1531) 3) ((= 52 V1531) 4) ((= 53 V1531) 5) ((= 54 V1531) 6) ((= 55 V1531) 7) ((= 56 V1531) 8) ((= 57 V1531) 9) (true (shen.sys-error shen.byte->digit))))
|
|
146
146
|
|
|
147
|
-
(defun shen.
|
|
147
|
+
(defun shen.pre (V1534 V1535) (cond ((= () V1534) 0) ((cons? V1534) (+ (* (shen.expt 10 V1535) (hd V1534)) (shen.pre (tl V1534) (+ V1535 1)))) (true (shen.sys-error shen.pre))))
|
|
148
148
|
|
|
149
|
-
(defun shen.
|
|
149
|
+
(defun shen.post (V1538 V1539) (cond ((= () V1538) 0) ((cons? V1538) (+ (* (shen.expt 10 (- 0 V1539)) (hd V1538)) (shen.post (tl V1538) (+ V1539 1)))) (true (shen.sys-error shen.post))))
|
|
150
150
|
|
|
151
|
-
(defun shen.
|
|
151
|
+
(defun shen.expt (V1542 V1543) (cond ((= 0 V1543) 1) ((> V1543 0) (* V1542 (shen.expt V1542 (- V1543 1)))) (true (* 1 (/ (shen.expt V1542 (+ V1543 1)) V1542)))))
|
|
152
152
|
|
|
153
|
-
(defun shen
|
|
153
|
+
(defun shen.<st_input1> (V1548) (let Result (let Parse_shen.<st_input> (shen.<st_input> V1548) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (shen.hdtl Parse_shen.<st_input>)) (fail))) (if (= Result (fail)) (fail) Result)))
|
|
154
154
|
|
|
155
|
-
(defun shen.<
|
|
155
|
+
(defun shen.<st_input2> (V1553) (let Result (let Parse_shen.<st_input> (shen.<st_input> V1553) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (shen.hdtl Parse_shen.<st_input>)) (fail))) (if (= Result (fail)) (fail) Result)))
|
|
156
156
|
|
|
157
|
-
(defun shen.<
|
|
157
|
+
(defun shen.<comment> (V1558) (let Result (let Parse_shen.<singleline> (shen.<singleline> V1558) (if (not (= (fail) Parse_shen.<singleline>)) (shen.pair (hd Parse_shen.<singleline>) shen.skip) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<multiline> (shen.<multiline> V1558) (if (not (= (fail) Parse_shen.<multiline>)) (shen.pair (hd Parse_shen.<multiline>) shen.skip) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
|
|
158
158
|
|
|
159
|
-
(defun shen.<
|
|
159
|
+
(defun shen.<singleline> (V1563) (let Result (let Parse_shen.<backslash> (shen.<backslash> V1563) (if (not (= (fail) Parse_shen.<backslash>)) (let Parse_shen.<backslash> (shen.<backslash> Parse_shen.<backslash>) (if (not (= (fail) Parse_shen.<backslash>)) (let Parse_shen.<anysingle> (shen.<anysingle> Parse_shen.<backslash>) (if (not (= (fail) Parse_shen.<anysingle>)) (let Parse_shen.<return> (shen.<return> Parse_shen.<anysingle>) (if (not (= (fail) Parse_shen.<return>)) (shen.pair (hd Parse_shen.<return>) shen.skip) (fail))) (fail))) (fail))) (fail))) (if (= Result (fail)) (fail) Result)))
|
|
160
160
|
|
|
161
|
-
(defun shen.<
|
|
161
|
+
(defun shen.<backslash> (V1568) (let Result (if (and (cons? (hd V1568)) (= 92 (hd (hd V1568)))) (shen.pair (hd (shen.pair (tl (hd V1568)) (shen.hdtl V1568))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
162
162
|
|
|
163
|
-
(defun shen.<
|
|
163
|
+
(defun shen.<anysingle> (V1573) (let Result (let Parse_shen.<non-return> (shen.<non-return> V1573) (if (not (= (fail) Parse_shen.<non-return>)) (let Parse_shen.<anysingle> (shen.<anysingle> Parse_shen.<non-return>) (if (not (= (fail) Parse_shen.<anysingle>)) (shen.pair (hd Parse_shen.<anysingle>) shen.skip) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_<e> (<e> V1573) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) shen.skip) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
|
|
164
164
|
|
|
165
|
-
(defun shen.<
|
|
165
|
+
(defun shen.<non-return> (V1578) (let Result (if (cons? (hd V1578)) (let Parse_X (hd (hd V1578)) (if (not (element? Parse_X (cons 10 (cons 13 ())))) (shen.pair (hd (shen.pair (tl (hd V1578)) (shen.hdtl V1578))) shen.skip) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
166
166
|
|
|
167
|
-
(defun shen.<
|
|
167
|
+
(defun shen.<return> (V1583) (let Result (if (cons? (hd V1583)) (let Parse_X (hd (hd V1583)) (if (element? Parse_X (cons 10 (cons 13 ()))) (shen.pair (hd (shen.pair (tl (hd V1583)) (shen.hdtl V1583))) shen.skip) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
168
168
|
|
|
169
|
-
(defun shen.<
|
|
169
|
+
(defun shen.<multiline> (V1588) (let Result (let Parse_shen.<backslash> (shen.<backslash> V1588) (if (not (= (fail) Parse_shen.<backslash>)) (let Parse_shen.<times> (shen.<times> Parse_shen.<backslash>) (if (not (= (fail) Parse_shen.<times>)) (let Parse_shen.<anymulti> (shen.<anymulti> Parse_shen.<times>) (if (not (= (fail) Parse_shen.<anymulti>)) (shen.pair (hd Parse_shen.<anymulti>) shen.skip) (fail))) (fail))) (fail))) (if (= Result (fail)) (fail) Result)))
|
|
170
170
|
|
|
171
|
-
(defun shen
|
|
171
|
+
(defun shen.<times> (V1593) (let Result (if (and (cons? (hd V1593)) (= 42 (hd (hd V1593)))) (shen.pair (hd (shen.pair (tl (hd V1593)) (shen.hdtl V1593))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
172
172
|
|
|
173
|
-
(defun shen
|
|
173
|
+
(defun shen.<anymulti> (V1598) (let Result (let Parse_shen.<comment> (shen.<comment> V1598) (if (not (= (fail) Parse_shen.<comment>)) (let Parse_shen.<anymulti> (shen.<anymulti> Parse_shen.<comment>) (if (not (= (fail) Parse_shen.<anymulti>)) (shen.pair (hd Parse_shen.<anymulti>) shen.skip) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<times> (shen.<times> V1598) (if (not (= (fail) Parse_shen.<times>)) (let Parse_shen.<backslash> (shen.<backslash> Parse_shen.<times>) (if (not (= (fail) Parse_shen.<backslash>)) (shen.pair (hd Parse_shen.<backslash>) shen.skip) (fail))) (fail))) (if (= Result (fail)) (let Result (if (cons? (hd V1598)) (let Parse_X (hd (hd V1598)) (let Parse_shen.<anymulti> (shen.<anymulti> (shen.pair (tl (hd V1598)) (shen.hdtl V1598))) (if (not (= (fail) Parse_shen.<anymulti>)) (shen.pair (hd Parse_shen.<anymulti>) shen.skip) (fail)))) (fail)) (if (= Result (fail)) (fail) Result)) Result)) Result)))
|
|
174
174
|
|
|
175
|
-
(defun shen
|
|
175
|
+
(defun shen.<whitespaces> (V1603) (let Result (let Parse_shen.<whitespace> (shen.<whitespace> V1603) (if (not (= (fail) Parse_shen.<whitespace>)) (let Parse_shen.<whitespaces> (shen.<whitespaces> Parse_shen.<whitespace>) (if (not (= (fail) Parse_shen.<whitespaces>)) (shen.pair (hd Parse_shen.<whitespaces>) shen.skip) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<whitespace> (shen.<whitespace> V1603) (if (not (= (fail) Parse_shen.<whitespace>)) (shen.pair (hd Parse_shen.<whitespace>) shen.skip) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
|
|
176
176
|
|
|
177
|
-
(defun shen
|
|
177
|
+
(defun shen.<whitespace> (V1608) (let Result (if (cons? (hd V1608)) (let Parse_X (hd (hd V1608)) (if (let Parse_Case Parse_X (or (= Parse_Case 32) (or (= Parse_Case 13) (or (= Parse_Case 10) (= Parse_Case 9))))) (shen.pair (hd (shen.pair (tl (hd V1608)) (shen.hdtl V1608))) shen.skip) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
178
178
|
|
|
179
|
-
(defun
|
|
179
|
+
(defun shen.cons_form (V1609) (cond ((= () V1609) ()) ((and (cons? V1609) (and (cons? (tl V1609)) (and (cons? (tl (tl V1609))) (and (= () (tl (tl (tl V1609)))) (= (hd (tl V1609)) bar!))))) (cons cons (cons (hd V1609) (tl (tl V1609))))) ((cons? V1609) (cons cons (cons (hd V1609) (cons (shen.cons_form (tl V1609)) ())))) (true (shen.sys-error shen.cons_form))))
|
|
180
|
+
|
|
181
|
+
(defun shen.package-macro (V1612 V1613) (cond ((and (cons? V1612) (and (= $ (hd V1612)) (and (cons? (tl V1612)) (= () (tl (tl V1612)))))) (append (explode (hd (tl V1612))) V1613)) ((and (cons? V1612) (and (= package (hd V1612)) (and (cons? (tl V1612)) (and (= null (hd (tl V1612))) (cons? (tl (tl V1612))))))) (append (tl (tl (tl V1612))) V1613)) ((and (cons? V1612) (and (= package (hd V1612)) (and (cons? (tl V1612)) (cons? (tl (tl V1612)))))) (let ListofExceptions (shen.eval-without-macros (hd (tl (tl V1612)))) (let Record (shen.record-exceptions ListofExceptions (hd (tl V1612))) (let PackageNameDot (intern (cn (str (hd (tl V1612))) ".")) (append (shen.packageh PackageNameDot ListofExceptions (tl (tl (tl V1612)))) V1613))))) (true (cons V1612 V1613))))
|
|
182
|
+
|
|
183
|
+
(defun shen.record-exceptions (V1614 V1615) (let CurrExceptions (trap-error (get V1615 shen.external-symbols (value *property-vector*)) (lambda E ())) (let AllExceptions (union V1614 CurrExceptions) (put V1615 shen.external-symbols AllExceptions (value *property-vector*)))))
|
|
184
|
+
|
|
185
|
+
(defun shen.packageh (V1624 V1625 V1626) (cond ((cons? V1626) (cons (shen.packageh V1624 V1625 (hd V1626)) (shen.packageh V1624 V1625 (tl V1626)))) ((or (shen.sysfunc? V1626) (or (variable? V1626) (or (element? V1626 V1625) (or (shen.doubleunderline? V1626) (shen.singleunderline? V1626))))) V1626) ((and (symbol? V1626) (not (shen.prefix? (cons "s" (cons "h" (cons "e" (cons "n" (cons "." ()))))) (explode V1626)))) (concat V1624 V1626)) (true V1626)))
|
|
186
|
+
|
|
187
|
+
(defun read-from-string (V1627) (let Ns (map (lambda V1327 (string->n V1327)) (explode V1627)) (compile shen.<st_input> Ns shen.read-error)))
|
|
180
188
|
|
|
181
189
|
|
|
182
190
|
|