shen-ruby 0.13.0 → 0.14.0
Sign up to get free protection for your applications and to get access to all the features.
- checksums.yaml +4 -4
- data/HISTORY.md +7 -0
- data/README.md +5 -5
- data/Rakefile +10 -3
- data/lib/shen_ruby/version.rb +1 -1
- data/shen-ruby.gemspec +2 -2
- data/shen/release/klambda/core.kl +63 -63
- data/shen/release/klambda/declarations.kl +7 -7
- data/shen/release/klambda/load.kl +15 -15
- data/shen/release/klambda/macros.kl +33 -33
- data/shen/release/klambda/prolog.kl +97 -97
- data/shen/release/klambda/reader.kl +83 -83
- data/shen/release/klambda/sequent.kl +55 -55
- data/shen/release/klambda/sys.kl +101 -101
- data/shen/release/klambda/t-star.kl +41 -41
- data/shen/release/klambda/toplevel.kl +21 -21
- data/shen/release/klambda/track.kl +25 -25
- data/shen/release/klambda/types.kl +4 -4
- data/shen/release/klambda/writer.kl +25 -25
- data/shen/release/klambda/yacc.kl +28 -28
- data/shen/release/license.pdf +0 -0
- data/shen/release/test_programs/bubble_version_2.shen +1 -1
- data/shen/release/test_programs/depth_.shen +1 -1
- data/shen/release/test_programs/interpreter.shen +1 -1
- data/shen/release/test_programs/metaprog.shen +1 -1
- data/shen/release/test_programs/semantic_net.shen +1 -1
- data/shen/release/test_programs/tests.shen +12 -12
- metadata +5 -5
|
@@ -23,206 +23,206 @@ ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
|
|
|
23
23
|
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
|
|
24
24
|
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE."
|
|
25
25
|
|
|
26
|
-
(defun shen.<defprolog> (
|
|
26
|
+
(defun shen.<defprolog> (V837) (let Parse_shen.<predicate*> (shen.<predicate*> V837) (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))))
|
|
27
27
|
|
|
28
|
-
(defun shen.prolog-error (
|
|
28
|
+
(defun shen.prolog-error (V844 V845) (cond ((and (cons? V845) (and (cons? (tl V845)) (= () (tl (tl V845))))) (simple-error (cn "prolog syntax error in " (shen.app V844 (cn " here:
|
|
29
29
|
|
|
30
|
-
" (shen.app (shen.next-50 50 (hd
|
|
31
|
-
" shen.a)) shen.a)))) (true (simple-error (cn "prolog syntax error in " (shen.app
|
|
30
|
+
" (shen.app (shen.next-50 50 (hd V845)) "
|
|
31
|
+
" shen.a)) shen.a)))) (true (simple-error (cn "prolog syntax error in " (shen.app V844 "
|
|
32
32
|
" shen.a))))))
|
|
33
33
|
|
|
34
|
-
(defun shen.next-50 (
|
|
34
|
+
(defun shen.next-50 (V850 V851) (cond ((= () V851) "") ((= 0 V850) "") ((cons? V851) (cn (shen.decons-string (hd V851)) (shen.next-50 (- V850 1) (tl V851)))) (true (shen.f_error shen.next-50))))
|
|
35
35
|
|
|
36
|
-
(defun shen.decons-string (
|
|
36
|
+
(defun shen.decons-string (V852) (cond ((and (cons? V852) (and (= cons (hd V852)) (and (cons? (tl V852)) (and (cons? (tl (tl V852))) (= () (tl (tl (tl V852)))))))) (shen.app (shen.eval-cons V852) " " shen.s)) (true (shen.app V852 " " shen.r))))
|
|
37
37
|
|
|
38
|
-
(defun shen.insert-predicate (
|
|
38
|
+
(defun shen.insert-predicate (V853 V854) (cond ((and (cons? V854) (and (cons? (tl V854)) (= () (tl (tl V854))))) (cons (cons V853 (hd V854)) (cons :- (tl V854)))) (true (shen.f_error shen.insert-predicate))))
|
|
39
39
|
|
|
40
|
-
(defun shen.<predicate*> (
|
|
40
|
+
(defun shen.<predicate*> (V855) (if (cons? (hd V855)) (let Parse_X (hd (hd V855)) (shen.pair (hd (shen.pair (tl (hd V855)) (shen.hdtl V855))) Parse_X)) (fail)))
|
|
41
41
|
|
|
42
|
-
(defun shen.<clauses*> (
|
|
42
|
+
(defun shen.<clauses*> (V856) (let YaccParse (let Parse_shen.<clause*> (shen.<clause*> V856) (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 (= YaccParse (fail)) (let Parse_<e> (<e> V856) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) ()) (fail))) YaccParse)))
|
|
43
43
|
|
|
44
|
-
(defun shen.<clause*> (
|
|
44
|
+
(defun shen.<clause*> (V857) (let Parse_shen.<head*> (shen.<head*> V857) (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))))
|
|
45
45
|
|
|
46
|
-
(defun shen.<head*> (
|
|
46
|
+
(defun shen.<head*> (V858) (let YaccParse (let Parse_shen.<term*> (shen.<term*> V858) (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 (= YaccParse (fail)) (let Parse_<e> (<e> V858) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) ()) (fail))) YaccParse)))
|
|
47
47
|
|
|
48
|
-
(defun shen.<term*> (
|
|
48
|
+
(defun shen.<term*> (V859) (if (cons? (hd V859)) (let Parse_X (hd (hd V859)) (if (and (not (= <-- Parse_X)) (shen.legitimate-term? Parse_X)) (shen.pair (hd (shen.pair (tl (hd V859)) (shen.hdtl V859))) (shen.eval-cons Parse_X)) (fail))) (fail)))
|
|
49
49
|
|
|
50
|
-
(defun shen.legitimate-term? (
|
|
50
|
+
(defun shen.legitimate-term? (V864) (cond ((and (cons? V864) (and (= cons (hd V864)) (and (cons? (tl V864)) (and (cons? (tl (tl V864))) (= () (tl (tl (tl V864)))))))) (and (shen.legitimate-term? (hd (tl V864))) (shen.legitimate-term? (hd (tl (tl V864)))))) ((and (cons? V864) (and (= mode (hd V864)) (and (cons? (tl V864)) (and (cons? (tl (tl V864))) (and (= + (hd (tl (tl V864)))) (= () (tl (tl (tl V864))))))))) (shen.legitimate-term? (hd (tl V864)))) ((and (cons? V864) (and (= mode (hd V864)) (and (cons? (tl V864)) (and (cons? (tl (tl V864))) (and (= - (hd (tl (tl V864)))) (= () (tl (tl (tl V864))))))))) (shen.legitimate-term? (hd (tl V864)))) ((cons? V864) false) (true true)))
|
|
51
51
|
|
|
52
|
-
(defun shen.eval-cons (
|
|
52
|
+
(defun shen.eval-cons (V865) (cond ((and (cons? V865) (and (= cons (hd V865)) (and (cons? (tl V865)) (and (cons? (tl (tl V865))) (= () (tl (tl (tl V865)))))))) (cons (shen.eval-cons (hd (tl V865))) (shen.eval-cons (hd (tl (tl V865)))))) ((and (cons? V865) (and (= mode (hd V865)) (and (cons? (tl V865)) (and (cons? (tl (tl V865))) (= () (tl (tl (tl V865)))))))) (cons mode (cons (shen.eval-cons (hd (tl V865))) (tl (tl V865))))) (true V865)))
|
|
53
53
|
|
|
54
|
-
(defun shen.<body*> (
|
|
54
|
+
(defun shen.<body*> (V866) (let YaccParse (let Parse_shen.<literal*> (shen.<literal*> V866) (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 (= YaccParse (fail)) (let Parse_<e> (<e> V866) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) ()) (fail))) YaccParse)))
|
|
55
55
|
|
|
56
|
-
(defun shen.<literal*> (
|
|
56
|
+
(defun shen.<literal*> (V867) (let YaccParse (if (and (cons? (hd V867)) (= ! (hd (hd V867)))) (shen.pair (hd (shen.pair (tl (hd V867)) (shen.hdtl V867))) (cons cut (cons (intern "Throwcontrol") ()))) (fail)) (if (= YaccParse (fail)) (if (cons? (hd V867)) (let Parse_X (hd (hd V867)) (if (cons? Parse_X) (shen.pair (hd (shen.pair (tl (hd V867)) (shen.hdtl V867))) Parse_X) (fail))) (fail)) YaccParse)))
|
|
57
57
|
|
|
58
|
-
(defun shen.<end*> (
|
|
58
|
+
(defun shen.<end*> (V868) (if (cons? (hd V868)) (let Parse_X (hd (hd V868)) (if (= Parse_X ;) (shen.pair (hd (shen.pair (tl (hd V868)) (shen.hdtl V868))) Parse_X) (fail))) (fail)))
|
|
59
59
|
|
|
60
|
-
(defun cut (
|
|
60
|
+
(defun cut (V869 V870 V871) (let Result (thaw V871) (if (= Result false) V869 Result)))
|
|
61
61
|
|
|
62
|
-
(defun shen.insert_modes (
|
|
62
|
+
(defun shen.insert_modes (V872) (cond ((and (cons? V872) (and (= mode (hd V872)) (and (cons? (tl V872)) (and (cons? (tl (tl V872))) (= () (tl (tl (tl V872)))))))) V872) ((= () V872) ()) ((cons? V872) (cons (cons mode (cons (hd V872) (cons + ()))) (cons mode (cons (shen.insert_modes (tl V872)) (cons - ()))))) (true V872)))
|
|
63
63
|
|
|
64
|
-
(defun shen.s-prolog (
|
|
64
|
+
(defun shen.s-prolog (V873) (map (lambda V826 (eval V826)) (shen.prolog->shen V873)))
|
|
65
65
|
|
|
66
|
-
(defun shen.prolog->shen (
|
|
66
|
+
(defun shen.prolog->shen (V874) (map (lambda V829 (shen.compile_prolog_procedure V829)) (shen.group_clauses (map (lambda V828 (shen.s-prolog_clause V828)) (mapcan (lambda V827 (shen.head_abstraction V827)) V874)))))
|
|
67
67
|
|
|
68
|
-
(defun shen.s-prolog_clause (
|
|
68
|
+
(defun shen.s-prolog_clause (V875) (cond ((and (cons? V875) (and (cons? (tl V875)) (and (= :- (hd (tl V875))) (and (cons? (tl (tl V875))) (= () (tl (tl (tl V875)))))))) (cons (hd V875) (cons :- (cons (map (lambda V830 (shen.s-prolog_literal V830)) (hd (tl (tl V875)))) ())))) (true (shen.f_error shen.s-prolog_clause))))
|
|
69
69
|
|
|
70
|
-
(defun shen.head_abstraction (
|
|
70
|
+
(defun shen.head_abstraction (V876) (cond ((and (cons? V876) (and (cons? (tl V876)) (and (= :- (hd (tl V876))) (and (cons? (tl (tl V876))) (and (= () (tl (tl (tl V876)))) (< (shen.complexity_head (hd V876)) (value shen.*maxcomplexity*))))))) (cons V876 ())) ((and (cons? V876) (and (cons? (hd V876)) (and (cons? (tl V876)) (and (= :- (hd (tl V876))) (and (cons? (tl (tl V876))) (= () (tl (tl (tl V876))))))))) (let Terms (map (lambda Y (gensym V)) (tl (hd V876))) (let XTerms (shen.rcons_form (shen.remove_modes (tl (hd V876)))) (let Literal (cons unify (cons (shen.cons_form Terms) (cons XTerms ()))) (let Clause (cons (cons (hd (hd V876)) Terms) (cons :- (cons (cons Literal (hd (tl (tl V876)))) ()))) (cons Clause ())))))) (true (shen.f_error shen.head_abstraction))))
|
|
71
71
|
|
|
72
|
-
(defun shen.complexity_head (
|
|
72
|
+
(defun shen.complexity_head (V881) (cond ((cons? V881) (shen.product (map (lambda V831 (shen.complexity V831)) (tl V881)))) (true (shen.f_error shen.complexity_head))))
|
|
73
73
|
|
|
74
|
-
(defun shen.complexity (
|
|
74
|
+
(defun shen.complexity (V889) (cond ((and (cons? V889) (and (= mode (hd V889)) (and (cons? (tl V889)) (and (cons? (hd (tl V889))) (and (= mode (hd (hd (tl V889)))) (and (cons? (tl (hd (tl V889)))) (and (cons? (tl (tl (hd (tl V889))))) (and (= () (tl (tl (tl (hd (tl V889)))))) (and (cons? (tl (tl V889))) (= () (tl (tl (tl V889))))))))))))) (shen.complexity (hd (tl V889)))) ((and (cons? V889) (and (= mode (hd V889)) (and (cons? (tl V889)) (and (cons? (hd (tl V889))) (and (cons? (tl (tl V889))) (and (= + (hd (tl (tl V889)))) (= () (tl (tl (tl V889)))))))))) (* 2 (* (shen.complexity (cons mode (cons (hd (hd (tl V889))) (tl (tl V889))))) (shen.complexity (cons mode (cons (tl (hd (tl V889))) (tl (tl V889)))))))) ((and (cons? V889) (and (= mode (hd V889)) (and (cons? (tl V889)) (and (cons? (hd (tl V889))) (and (cons? (tl (tl V889))) (and (= - (hd (tl (tl V889)))) (= () (tl (tl (tl V889)))))))))) (* (shen.complexity (cons mode (cons (hd (hd (tl V889))) (tl (tl V889))))) (shen.complexity (cons mode (cons (tl (hd (tl V889))) (tl (tl V889))))))) ((and (cons? V889) (and (= mode (hd V889)) (and (cons? (tl V889)) (and (cons? (tl (tl V889))) (and (= () (tl (tl (tl V889)))) (variable? (hd (tl V889)))))))) 1) ((and (cons? V889) (and (= mode (hd V889)) (and (cons? (tl V889)) (and (cons? (tl (tl V889))) (and (= + (hd (tl (tl V889)))) (= () (tl (tl (tl V889))))))))) 2) ((and (cons? V889) (and (= mode (hd V889)) (and (cons? (tl V889)) (and (cons? (tl (tl V889))) (and (= - (hd (tl (tl V889)))) (= () (tl (tl (tl V889))))))))) 1) (true (shen.complexity (cons mode (cons V889 (cons + ())))))))
|
|
75
75
|
|
|
76
|
-
(defun shen.product (
|
|
76
|
+
(defun shen.product (V890) (cond ((= () V890) 1) ((cons? V890) (* (hd V890) (shen.product (tl V890)))) (true (shen.f_error shen.product))))
|
|
77
77
|
|
|
78
|
-
(defun shen.s-prolog_literal (
|
|
78
|
+
(defun shen.s-prolog_literal (V891) (cond ((and (cons? V891) (and (= is (hd V891)) (and (cons? (tl V891)) (and (cons? (tl (tl V891))) (= () (tl (tl (tl V891)))))))) (cons bind (cons (hd (tl V891)) (cons (shen.insert_deref (hd (tl (tl V891)))) ())))) ((and (cons? V891) (and (= when (hd V891)) (and (cons? (tl V891)) (= () (tl (tl V891)))))) (cons fwhen (cons (shen.insert_deref (hd (tl V891))) ()))) ((and (cons? V891) (and (= bind (hd V891)) (and (cons? (tl V891)) (and (cons? (tl (tl V891))) (= () (tl (tl (tl V891)))))))) (cons bind (cons (hd (tl V891)) (cons (shen.insert_lazyderef (hd (tl (tl V891)))) ())))) ((and (cons? V891) (and (= fwhen (hd V891)) (and (cons? (tl V891)) (= () (tl (tl V891)))))) (cons fwhen (cons (shen.insert_lazyderef (hd (tl V891))) ()))) ((cons? V891) V891) (true (shen.f_error shen.s-prolog_literal))))
|
|
79
79
|
|
|
80
|
-
(defun shen.insert_deref (
|
|
80
|
+
(defun shen.insert_deref (V892) (cond ((variable? V892) (cons shen.deref (cons V892 (cons ProcessN ())))) ((cons? V892) (cons (shen.insert_deref (hd V892)) (shen.insert_deref (tl V892)))) (true V892)))
|
|
81
81
|
|
|
82
|
-
(defun shen.insert_lazyderef (
|
|
82
|
+
(defun shen.insert_lazyderef (V893) (cond ((variable? V893) (cons shen.lazyderef (cons V893 (cons ProcessN ())))) ((cons? V893) (cons (shen.insert_lazyderef (hd V893)) (shen.insert_lazyderef (tl V893)))) (true V893)))
|
|
83
83
|
|
|
84
|
-
(defun shen.m_prolog_to_s-prolog_predicate (
|
|
84
|
+
(defun shen.m_prolog_to_s-prolog_predicate (V894) (cond ((= = V894) unify) ((= =! V894) unify!) ((= == V894) identical) (true V894)))
|
|
85
85
|
|
|
86
|
-
(defun shen.group_clauses (
|
|
86
|
+
(defun shen.group_clauses (V895) (cond ((= () V895) ()) ((cons? V895) (let Group (shen.collect (lambda X (shen.same_predicate? (hd V895) X)) V895) (let Rest (difference V895 Group) (cons Group (shen.group_clauses Rest))))) (true (shen.f_error shen.group_clauses))))
|
|
87
87
|
|
|
88
|
-
(defun shen.collect (
|
|
88
|
+
(defun shen.collect (V898 V899) (cond ((= () V899) ()) ((cons? V899) (if (V898 (hd V899)) (cons (hd V899) (shen.collect V898 (tl V899))) (shen.collect V898 (tl V899)))) (true (shen.f_error shen.collect))))
|
|
89
89
|
|
|
90
|
-
(defun shen.same_predicate? (
|
|
90
|
+
(defun shen.same_predicate? (V916 V917) (cond ((and (cons? V916) (and (cons? (hd V916)) (and (cons? V917) (cons? (hd V917))))) (= (hd (hd V916)) (hd (hd V917)))) (true (shen.f_error shen.same_predicate?))))
|
|
91
91
|
|
|
92
|
-
(defun shen.compile_prolog_procedure (
|
|
92
|
+
(defun shen.compile_prolog_procedure (V918) (let F (shen.procedure_name V918) (let Shen (shen.clauses-to-shen F V918) Shen)))
|
|
93
93
|
|
|
94
|
-
(defun shen.procedure_name (
|
|
94
|
+
(defun shen.procedure_name (V931) (cond ((and (cons? V931) (and (cons? (hd V931)) (cons? (hd (hd V931))))) (hd (hd (hd V931)))) (true (shen.f_error shen.procedure_name))))
|
|
95
95
|
|
|
96
|
-
(defun shen.clauses-to-shen (
|
|
96
|
+
(defun shen.clauses-to-shen (V932 V933) (let Linear (map (lambda V832 (shen.linearise-clause V832)) V933) (let Arity (shen.prolog-aritycheck V932 (map (lambda V833 (head V833)) V933)) (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 (lambda V834 (shen.aum_to_shen V834)) AUM_instructions))) (let ShenDef (cons define (cons V932 (append Parameters (append (cons ProcessN (cons Continuation ())) (cons -> (cons Code ())))))) ShenDef)))))))
|
|
97
97
|
|
|
98
|
-
(defun shen.catch-cut (
|
|
98
|
+
(defun shen.catch-cut (V934) (cond ((not (shen.occurs? cut V934)) V934) (true (cons let (cons Throwcontrol (cons (cons shen.catchpoint ()) (cons (cons shen.cutpoint (cons Throwcontrol (cons V934 ()))) ())))))))
|
|
99
99
|
|
|
100
100
|
(defun shen.catchpoint () (set shen.*catch* (+ 1 (value shen.*catch*))))
|
|
101
101
|
|
|
102
|
-
(defun shen.cutpoint (
|
|
102
|
+
(defun shen.cutpoint (V940 V941) (cond ((= V941 V940) false) (true V941)))
|
|
103
103
|
|
|
104
|
-
(defun shen.nest-disjunct (
|
|
104
|
+
(defun shen.nest-disjunct (V942) (cond ((and (cons? V942) (= () (tl V942))) (hd V942)) ((cons? V942) (shen.lisp-or (hd V942) (shen.nest-disjunct (tl V942)))) (true (shen.f_error shen.nest-disjunct))))
|
|
105
105
|
|
|
106
|
-
(defun shen.lisp-or (
|
|
106
|
+
(defun shen.lisp-or (V943 V944) (cons let (cons Case (cons V943 (cons (cons if (cons (cons = (cons Case (cons false ()))) (cons V944 (cons Case ())))) ())))))
|
|
107
107
|
|
|
108
|
-
(defun shen.prolog-aritycheck (
|
|
108
|
+
(defun shen.prolog-aritycheck (V947 V948) (cond ((and (cons? V948) (= () (tl V948))) (- (length (hd V948)) 1)) ((and (cons? V948) (cons? (tl V948))) (if (= (length (hd V948)) (length (hd (tl V948)))) (shen.prolog-aritycheck V947 (tl V948)) (simple-error (cn "arity error in prolog procedure " (shen.app (cons V947 ()) "
|
|
109
109
|
" shen.a))))) (true (shen.f_error shen.prolog-aritycheck))))
|
|
110
110
|
|
|
111
|
-
(defun shen.linearise-clause (
|
|
111
|
+
(defun shen.linearise-clause (V949) (cond ((and (cons? V949) (and (cons? (tl V949)) (and (= :- (hd (tl V949))) (and (cons? (tl (tl V949))) (= () (tl (tl (tl V949)))))))) (let Linear (shen.linearise (cons (hd V949) (tl (tl V949)))) (shen.clause_form Linear))) (true (shen.f_error shen.linearise-clause))))
|
|
112
112
|
|
|
113
|
-
(defun shen.clause_form (
|
|
113
|
+
(defun shen.clause_form (V950) (cond ((and (cons? V950) (and (cons? (tl V950)) (= () (tl (tl V950))))) (cons (shen.explicit_modes (hd V950)) (cons :- (cons (shen.cf_help (hd (tl V950))) ())))) (true (shen.f_error shen.clause_form))))
|
|
114
114
|
|
|
115
|
-
(defun shen.explicit_modes (
|
|
115
|
+
(defun shen.explicit_modes (V951) (cond ((cons? V951) (cons (hd V951) (map (lambda V835 (shen.em_help V835)) (tl V951)))) (true (shen.f_error shen.explicit_modes))))
|
|
116
116
|
|
|
117
|
-
(defun shen.em_help (
|
|
117
|
+
(defun shen.em_help (V952) (cond ((and (cons? V952) (and (= mode (hd V952)) (and (cons? (tl V952)) (and (cons? (tl (tl V952))) (= () (tl (tl (tl V952)))))))) V952) (true (cons mode (cons V952 (cons + ()))))))
|
|
118
118
|
|
|
119
|
-
(defun shen.cf_help (
|
|
119
|
+
(defun shen.cf_help (V953) (cond ((and (cons? V953) (and (= where (hd V953)) (and (cons? (tl V953)) (and (cons? (hd (tl V953))) (and (= = (hd (hd (tl V953)))) (and (cons? (tl (hd (tl V953)))) (and (cons? (tl (tl (hd (tl V953))))) (and (= () (tl (tl (tl (hd (tl V953)))))) (and (cons? (tl (tl V953))) (= () (tl (tl (tl V953))))))))))))) (cons (cons (if (value shen.*occurs*) unify! unify) (tl (hd (tl V953)))) (shen.cf_help (hd (tl (tl V953)))))) (true V953)))
|
|
120
120
|
|
|
121
|
-
(defun occurs-check (
|
|
121
|
+
(defun occurs-check (V958) (cond ((= + V958) (set shen.*occurs* true)) ((= - V958) (set shen.*occurs* false)) (true (simple-error "occurs-check expects + or -
|
|
122
122
|
"))))
|
|
123
123
|
|
|
124
|
-
(defun shen.aum (
|
|
124
|
+
(defun shen.aum (V959 V960) (cond ((and (cons? V959) (and (cons? (hd V959)) (and (cons? (tl V959)) (and (= :- (hd (tl V959))) (and (cons? (tl (tl V959))) (= () (tl (tl (tl V959))))))))) (let MuApplication (shen.make_mu_application (cons shen.mu (cons (tl (hd V959)) (cons (shen.continuation_call (tl (hd V959)) (hd (tl (tl V959)))) ()))) V960) (shen.mu_reduction MuApplication +))) (true (shen.f_error shen.aum))))
|
|
125
125
|
|
|
126
|
-
(defun shen.continuation_call (
|
|
126
|
+
(defun shen.continuation_call (V961 V962) (let VTerms (cons ProcessN (shen.extract_vars V961)) (let VBody (shen.extract_vars V962) (let Free (remove Throwcontrol (difference VBody VTerms)) (shen.cc_help Free V962)))))
|
|
127
127
|
|
|
128
|
-
(defun remove (
|
|
128
|
+
(defun remove (V963 V964) (shen.remove-h V963 V964 ()))
|
|
129
129
|
|
|
130
|
-
(defun shen.remove-h (
|
|
130
|
+
(defun shen.remove-h (V968 V969 V970) (cond ((= () V969) (reverse V970)) ((and (cons? V969) (= (hd V969) V968)) (shen.remove-h (hd V969) (tl V969) V970)) ((cons? V969) (shen.remove-h V968 (tl V969) (cons (hd V969) V970))) (true (shen.f_error shen.remove-h))))
|
|
131
131
|
|
|
132
|
-
(defun shen.cc_help (
|
|
132
|
+
(defun shen.cc_help (V971 V972) (cond ((and (= () V971) (= () V972)) (cons shen.pop (cons shen.the (cons shen.stack ())))) ((= () V972) (cons shen.rename (cons shen.the (cons shen.variables (cons in (cons V971 (cons and (cons shen.then (cons (cons shen.pop (cons shen.the (cons shen.stack ()))) ()))))))))) ((= () V971) (cons call (cons shen.the (cons shen.continuation (cons V972 ()))))) (true (cons shen.rename (cons shen.the (cons shen.variables (cons in (cons V971 (cons and (cons shen.then (cons (cons call (cons shen.the (cons shen.continuation (cons V972 ())))) ())))))))))))
|
|
133
133
|
|
|
134
|
-
(defun shen.make_mu_application (
|
|
134
|
+
(defun shen.make_mu_application (V973 V974) (cond ((and (cons? V973) (and (= shen.mu (hd V973)) (and (cons? (tl V973)) (and (= () (hd (tl V973))) (and (cons? (tl (tl V973))) (and (= () (tl (tl (tl V973)))) (= () V974))))))) (hd (tl (tl V973)))) ((and (cons? V973) (and (= shen.mu (hd V973)) (and (cons? (tl V973)) (and (cons? (hd (tl V973))) (and (cons? (tl (tl V973))) (and (= () (tl (tl (tl V973)))) (cons? V974))))))) (cons (cons shen.mu (cons (hd (hd (tl V973))) (cons (shen.make_mu_application (cons shen.mu (cons (tl (hd (tl V973))) (tl (tl V973)))) (tl V974)) ()))) (cons (hd V974) ()))) (true (shen.f_error shen.make_mu_application))))
|
|
135
135
|
|
|
136
|
-
(defun shen.mu_reduction (
|
|
136
|
+
(defun shen.mu_reduction (V981 V982) (cond ((and (cons? V981) (and (cons? (hd V981)) (and (= shen.mu (hd (hd V981))) (and (cons? (tl (hd V981))) (and (cons? (hd (tl (hd V981)))) (and (= mode (hd (hd (tl (hd V981))))) (and (cons? (tl (hd (tl (hd V981))))) (and (cons? (tl (tl (hd (tl (hd V981)))))) (and (= () (tl (tl (tl (hd (tl (hd V981))))))) (and (cons? (tl (tl (hd V981)))) (and (= () (tl (tl (tl (hd V981))))) (and (cons? (tl V981)) (= () (tl (tl V981))))))))))))))) (shen.mu_reduction (cons (cons shen.mu (cons (hd (tl (hd (tl (hd V981))))) (tl (tl (hd V981))))) (tl V981)) (hd (tl (tl (hd (tl (hd V981)))))))) ((and (cons? V981) (and (cons? (hd V981)) (and (= shen.mu (hd (hd V981))) (and (cons? (tl (hd V981))) (and (cons? (tl (tl (hd V981)))) (and (= () (tl (tl (tl (hd V981))))) (and (cons? (tl V981)) (and (= () (tl (tl V981))) (= _ (hd (tl (hd V981)))))))))))) (shen.mu_reduction (hd (tl (tl (hd V981)))) V982)) ((and (cons? V981) (and (cons? (hd V981)) (and (= shen.mu (hd (hd V981))) (and (cons? (tl (hd V981))) (and (cons? (tl (tl (hd V981)))) (and (= () (tl (tl (tl (hd V981))))) (and (cons? (tl V981)) (and (= () (tl (tl V981))) (shen.ephemeral_variable? (hd (tl (hd V981))) (hd (tl V981))))))))))) (subst (hd (tl V981)) (hd (tl (hd V981))) (shen.mu_reduction (hd (tl (tl (hd V981)))) V982))) ((and (cons? V981) (and (cons? (hd V981)) (and (= shen.mu (hd (hd V981))) (and (cons? (tl (hd V981))) (and (cons? (tl (tl (hd V981)))) (and (= () (tl (tl (tl (hd V981))))) (and (cons? (tl V981)) (and (= () (tl (tl V981))) (variable? (hd (tl (hd V981)))))))))))) (cons let (cons (hd (tl (hd V981))) (cons shen.be (cons (hd (tl V981)) (cons in (cons (shen.mu_reduction (hd (tl (tl (hd V981)))) V982) ()))))))) ((and (cons? V981) (and (cons? (hd V981)) (and (= shen.mu (hd (hd V981))) (and (cons? (tl (hd V981))) (and (cons? (tl (tl (hd V981)))) (and (= () (tl (tl (tl (hd V981))))) (and (cons? (tl V981)) (and (= () (tl (tl V981))) (and (= - V982) (shen.prolog_constant? (hd (tl (hd V981))))))))))))) (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 V981))))) (cons in (cons (cons if (cons (cons Z (cons is (cons identical (cons shen.to (cons (hd (tl (hd V981))) ()))))) (cons shen.then (cons (shen.mu_reduction (hd (tl (tl (hd V981)))) -) (cons shen.else (cons shen.failed! ())))))) ())))))))) ((and (cons? V981) (and (cons? (hd V981)) (and (= shen.mu (hd (hd V981))) (and (cons? (tl (hd V981))) (and (cons? (tl (tl (hd V981)))) (and (= () (tl (tl (tl (hd V981))))) (and (cons? (tl V981)) (and (= () (tl (tl V981))) (and (= + V982) (shen.prolog_constant? (hd (tl (hd V981))))))))))))) (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 V981))))) (cons in (cons (cons if (cons (cons Z (cons is (cons identical (cons shen.to (cons (hd (tl (hd V981))) ()))))) (cons shen.then (cons (shen.mu_reduction (hd (tl (tl (hd V981)))) +) (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 V981))) (cons in (cons (shen.mu_reduction (hd (tl (tl (hd V981)))) +) ())))))) (cons shen.else (cons shen.failed! ())))))) ())))))) ())))))))) ((and (cons? V981) (and (cons? (hd V981)) (and (= shen.mu (hd (hd V981))) (and (cons? (tl (hd V981))) (and (cons? (hd (tl (hd V981)))) (and (cons? (tl (tl (hd V981)))) (and (= () (tl (tl (tl (hd V981))))) (and (cons? (tl V981)) (and (= () (tl (tl V981))) (= - V982)))))))))) (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 V981))))) (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 V981)))) (cons (cons (cons shen.mu (cons (tl (hd (tl (hd V981)))) (tl (tl (hd V981))))) (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? V981) (and (cons? (hd V981)) (and (= shen.mu (hd (hd V981))) (and (cons? (tl (hd V981))) (and (cons? (hd (tl (hd V981)))) (and (cons? (tl (tl (hd V981)))) (and (= () (tl (tl (tl (hd V981))))) (and (cons? (tl V981)) (and (= () (tl (tl V981))) (= + V982)))))))))) (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 V981))))) (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 V981)))) (cons (cons (cons shen.mu (cons (tl (hd (tl (hd V981)))) (tl (tl (hd V981))))) (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 V981)))) (cons and (cons shen.then (cons (cons bind (cons Z (cons shen.to (cons (shen.rcons_form (shen.remove_modes (hd (tl (hd V981))))) (cons in (cons (shen.mu_reduction (hd (tl (tl (hd V981)))) +) ())))))) ())))))))) (cons shen.else (cons shen.failed! ())))))) ())))))) ())))))))) (true V981)))
|
|
137
137
|
|
|
138
|
-
(defun shen.rcons_form (
|
|
138
|
+
(defun shen.rcons_form (V983) (cond ((cons? V983) (cons cons (cons (shen.rcons_form (hd V983)) (cons (shen.rcons_form (tl V983)) ())))) (true V983)))
|
|
139
139
|
|
|
140
|
-
(defun shen.remove_modes (
|
|
140
|
+
(defun shen.remove_modes (V984) (cond ((and (cons? V984) (and (= mode (hd V984)) (and (cons? (tl V984)) (and (cons? (tl (tl V984))) (and (= + (hd (tl (tl V984)))) (= () (tl (tl (tl V984))))))))) (shen.remove_modes (hd (tl V984)))) ((and (cons? V984) (and (= mode (hd V984)) (and (cons? (tl V984)) (and (cons? (tl (tl V984))) (and (= - (hd (tl (tl V984)))) (= () (tl (tl (tl V984))))))))) (shen.remove_modes (hd (tl V984)))) ((cons? V984) (cons (shen.remove_modes (hd V984)) (shen.remove_modes (tl V984)))) (true V984)))
|
|
141
141
|
|
|
142
|
-
(defun shen.ephemeral_variable? (
|
|
142
|
+
(defun shen.ephemeral_variable? (V985 V986) (and (variable? V985) (variable? V986)))
|
|
143
143
|
|
|
144
|
-
(defun shen.prolog_constant? (
|
|
144
|
+
(defun shen.prolog_constant? (V995) (cond ((cons? V995) false) (true true)))
|
|
145
145
|
|
|
146
|
-
(defun shen.aum_to_shen (
|
|
146
|
+
(defun shen.aum_to_shen (V996) (cond ((and (cons? V996) (and (= let (hd V996)) (and (cons? (tl V996)) (and (cons? (tl (tl V996))) (and (= shen.be (hd (tl (tl V996)))) (and (cons? (tl (tl (tl V996)))) (and (cons? (tl (tl (tl (tl V996))))) (and (= in (hd (tl (tl (tl (tl V996)))))) (and (cons? (tl (tl (tl (tl (tl V996)))))) (= () (tl (tl (tl (tl (tl (tl V996)))))))))))))))) (cons let (cons (hd (tl V996)) (cons (shen.aum_to_shen (hd (tl (tl (tl V996))))) (cons (shen.aum_to_shen (hd (tl (tl (tl (tl (tl V996))))))) ()))))) ((and (cons? V996) (and (= shen.the (hd V996)) (and (cons? (tl V996)) (and (= shen.result (hd (tl V996))) (and (cons? (tl (tl V996))) (and (= shen.of (hd (tl (tl V996)))) (and (cons? (tl (tl (tl V996)))) (and (= shen.dereferencing (hd (tl (tl (tl V996))))) (and (cons? (tl (tl (tl (tl V996))))) (= () (tl (tl (tl (tl (tl V996))))))))))))))) (cons shen.lazyderef (cons (shen.aum_to_shen (hd (tl (tl (tl (tl V996)))))) (cons ProcessN ())))) ((and (cons? V996) (and (= if (hd V996)) (and (cons? (tl V996)) (and (cons? (tl (tl V996))) (and (= shen.then (hd (tl (tl V996)))) (and (cons? (tl (tl (tl V996)))) (and (cons? (tl (tl (tl (tl V996))))) (and (= shen.else (hd (tl (tl (tl (tl V996)))))) (and (cons? (tl (tl (tl (tl (tl V996)))))) (= () (tl (tl (tl (tl (tl (tl V996)))))))))))))))) (cons if (cons (shen.aum_to_shen (hd (tl V996))) (cons (shen.aum_to_shen (hd (tl (tl (tl V996))))) (cons (shen.aum_to_shen (hd (tl (tl (tl (tl (tl V996))))))) ()))))) ((and (cons? V996) (and (cons? (tl V996)) (and (= is (hd (tl V996))) (and (cons? (tl (tl V996))) (and (= shen.a (hd (tl (tl V996)))) (and (cons? (tl (tl (tl V996)))) (and (= shen.variable (hd (tl (tl (tl V996))))) (= () (tl (tl (tl (tl V996)))))))))))) (cons shen.pvar? (cons (hd V996) ()))) ((and (cons? V996) (and (cons? (tl V996)) (and (= is (hd (tl V996))) (and (cons? (tl (tl V996))) (and (= shen.a (hd (tl (tl V996)))) (and (cons? (tl (tl (tl V996)))) (and (= shen.non-empty (hd (tl (tl (tl V996))))) (and (cons? (tl (tl (tl (tl V996))))) (and (= list (hd (tl (tl (tl (tl V996)))))) (= () (tl (tl (tl (tl (tl V996))))))))))))))) (cons cons? (cons (hd V996) ()))) ((and (cons? V996) (and (= shen.rename (hd V996)) (and (cons? (tl V996)) (and (= shen.the (hd (tl V996))) (and (cons? (tl (tl V996))) (and (= shen.variables (hd (tl (tl V996)))) (and (cons? (tl (tl (tl V996)))) (and (= in (hd (tl (tl (tl V996))))) (and (cons? (tl (tl (tl (tl V996))))) (and (= () (hd (tl (tl (tl (tl V996)))))) (and (cons? (tl (tl (tl (tl (tl V996)))))) (and (= and (hd (tl (tl (tl (tl (tl V996))))))) (and (cons? (tl (tl (tl (tl (tl (tl V996))))))) (and (= shen.then (hd (tl (tl (tl (tl (tl (tl V996)))))))) (and (cons? (tl (tl (tl (tl (tl (tl (tl V996)))))))) (= () (tl (tl (tl (tl (tl (tl (tl (tl V996)))))))))))))))))))))))) (shen.aum_to_shen (hd (tl (tl (tl (tl (tl (tl (tl V996)))))))))) ((and (cons? V996) (and (= shen.rename (hd V996)) (and (cons? (tl V996)) (and (= shen.the (hd (tl V996))) (and (cons? (tl (tl V996))) (and (= shen.variables (hd (tl (tl V996)))) (and (cons? (tl (tl (tl V996)))) (and (= in (hd (tl (tl (tl V996))))) (and (cons? (tl (tl (tl (tl V996))))) (and (cons? (hd (tl (tl (tl (tl V996)))))) (and (cons? (tl (tl (tl (tl (tl V996)))))) (and (= and (hd (tl (tl (tl (tl (tl V996))))))) (and (cons? (tl (tl (tl (tl (tl (tl V996))))))) (and (= shen.then (hd (tl (tl (tl (tl (tl (tl V996)))))))) (and (cons? (tl (tl (tl (tl (tl (tl (tl V996)))))))) (= () (tl (tl (tl (tl (tl (tl (tl (tl V996)))))))))))))))))))))))) (cons let (cons (hd (hd (tl (tl (tl (tl V996)))))) (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 V996)))))) (tl (tl (tl (tl (tl V996))))))))))) ()))))) ((and (cons? V996) (and (= bind (hd V996)) (and (cons? (tl V996)) (and (cons? (tl (tl V996))) (and (= shen.to (hd (tl (tl V996)))) (and (cons? (tl (tl (tl V996)))) (and (cons? (tl (tl (tl (tl V996))))) (and (= in (hd (tl (tl (tl (tl V996)))))) (and (cons? (tl (tl (tl (tl (tl V996)))))) (= () (tl (tl (tl (tl (tl (tl V996)))))))))))))))) (cons do (cons (cons shen.bindv (cons (hd (tl V996)) (cons (shen.chwild (hd (tl (tl (tl V996))))) (cons ProcessN ())))) (cons (cons let (cons Result (cons (shen.aum_to_shen (hd (tl (tl (tl (tl (tl V996))))))) (cons (cons do (cons (cons shen.unbindv (cons (hd (tl V996)) (cons ProcessN ()))) (cons Result ()))) ())))) ())))) ((and (cons? V996) (and (cons? (tl V996)) (and (= is (hd (tl V996))) (and (cons? (tl (tl V996))) (and (= identical (hd (tl (tl V996)))) (and (cons? (tl (tl (tl V996)))) (and (= shen.to (hd (tl (tl (tl V996))))) (and (cons? (tl (tl (tl (tl V996))))) (= () (tl (tl (tl (tl (tl V996)))))))))))))) (cons = (cons (hd (tl (tl (tl (tl V996))))) (cons (hd V996) ())))) ((= shen.failed! V996) false) ((and (cons? V996) (and (= shen.the (hd V996)) (and (cons? (tl V996)) (and (= head (hd (tl V996))) (and (cons? (tl (tl V996))) (and (= shen.of (hd (tl (tl V996)))) (and (cons? (tl (tl (tl V996)))) (= () (tl (tl (tl (tl V996)))))))))))) (cons hd (tl (tl (tl V996))))) ((and (cons? V996) (and (= shen.the (hd V996)) (and (cons? (tl V996)) (and (= tail (hd (tl V996))) (and (cons? (tl (tl V996))) (and (= shen.of (hd (tl (tl V996)))) (and (cons? (tl (tl (tl V996)))) (= () (tl (tl (tl (tl V996)))))))))))) (cons tl (tl (tl (tl V996))))) ((and (cons? V996) (and (= shen.pop (hd V996)) (and (cons? (tl V996)) (and (= shen.the (hd (tl V996))) (and (cons? (tl (tl V996))) (and (= shen.stack (hd (tl (tl V996)))) (= () (tl (tl (tl V996)))))))))) (cons do (cons (cons shen.incinfs ()) (cons (cons thaw (cons Continuation ())) ())))) ((and (cons? V996) (and (= call (hd V996)) (and (cons? (tl V996)) (and (= shen.the (hd (tl V996))) (and (cons? (tl (tl V996))) (and (= shen.continuation (hd (tl (tl V996)))) (and (cons? (tl (tl (tl V996)))) (= () (tl (tl (tl (tl V996)))))))))))) (cons do (cons (cons shen.incinfs ()) (cons (shen.call_the_continuation (shen.chwild (hd (tl (tl (tl V996))))) ProcessN Continuation) ())))) (true V996)))
|
|
147
147
|
|
|
148
|
-
(defun shen.chwild (
|
|
148
|
+
(defun shen.chwild (V997) (cond ((= V997 _) (cons shen.newpv (cons ProcessN ()))) ((cons? V997) (map (lambda V836 (shen.chwild V836)) V997)) (true V997)))
|
|
149
149
|
|
|
150
|
-
(defun shen.newpv (
|
|
150
|
+
(defun shen.newpv (V998) (let Count+1 (+ (<-address (value shen.*varcounter*) V998) 1) (let IncVar (address-> (value shen.*varcounter*) V998 Count+1) (let Vector (<-address (value shen.*prologvectors*) V998) (let ResizeVectorIfNeeded (if (= Count+1 (limit Vector)) (shen.resizeprocessvector V998 Count+1) shen.skip) (shen.mk-pvar Count+1))))))
|
|
151
151
|
|
|
152
|
-
(defun shen.resizeprocessvector (
|
|
152
|
+
(defun shen.resizeprocessvector (V999 V1000) (let Vector (<-address (value shen.*prologvectors*) V999) (let BigVector (shen.resize-vector Vector (+ V1000 V1000) shen.-null-) (address-> (value shen.*prologvectors*) V999 BigVector))))
|
|
153
153
|
|
|
154
|
-
(defun shen.resize-vector (
|
|
154
|
+
(defun shen.resize-vector (V1001 V1002 V1003) (let BigVector (address-> (absvector (+ 1 V1002)) 0 V1002) (shen.copy-vector V1001 BigVector (limit V1001) V1002 V1003)))
|
|
155
155
|
|
|
156
|
-
(defun shen.copy-vector (
|
|
156
|
+
(defun shen.copy-vector (V1004 V1005 V1006 V1007 V1008) (shen.copy-vector-stage-2 (+ 1 V1006) (+ V1007 1) V1008 (shen.copy-vector-stage-1 1 V1004 V1005 (+ 1 V1006))))
|
|
157
157
|
|
|
158
|
-
(defun shen.copy-vector-stage-1 (
|
|
158
|
+
(defun shen.copy-vector-stage-1 (V1012 V1013 V1014 V1015) (cond ((= V1015 V1012) V1014) (true (shen.copy-vector-stage-1 (+ 1 V1012) V1013 (address-> V1014 V1012 (<-address V1013 V1012)) V1015))))
|
|
159
159
|
|
|
160
|
-
(defun shen.copy-vector-stage-2 (
|
|
160
|
+
(defun shen.copy-vector-stage-2 (V1019 V1020 V1021 V1022) (cond ((= V1020 V1019) V1022) (true (shen.copy-vector-stage-2 (+ V1019 1) V1020 V1021 (address-> V1022 V1019 V1021)))))
|
|
161
161
|
|
|
162
|
-
(defun shen.mk-pvar (
|
|
162
|
+
(defun shen.mk-pvar (V1023) (address-> (address-> (absvector 2) 0 shen.pvar) 1 V1023))
|
|
163
163
|
|
|
164
|
-
(defun shen.pvar? (
|
|
164
|
+
(defun shen.pvar? (V1024) (trap-error (and (absvector? V1024) (= (<-address V1024 0) shen.pvar)) (lambda E false)))
|
|
165
165
|
|
|
166
|
-
(defun shen.bindv (
|
|
166
|
+
(defun shen.bindv (V1025 V1026 V1027) (let Vector (<-address (value shen.*prologvectors*) V1027) (address-> Vector (<-address V1025 1) V1026)))
|
|
167
167
|
|
|
168
|
-
(defun shen.unbindv (
|
|
168
|
+
(defun shen.unbindv (V1028 V1029) (let Vector (<-address (value shen.*prologvectors*) V1029) (address-> Vector (<-address V1028 1) shen.-null-)))
|
|
169
169
|
|
|
170
170
|
(defun shen.incinfs () (set shen.*infs* (+ 1 (value shen.*infs*))))
|
|
171
171
|
|
|
172
|
-
(defun shen.call_the_continuation (
|
|
172
|
+
(defun shen.call_the_continuation (V1030 V1031 V1032) (cond ((and (cons? V1030) (and (cons? (hd V1030)) (= () (tl V1030)))) (cons (hd (hd V1030)) (append (tl (hd V1030)) (cons V1031 (cons V1032 ()))))) ((and (cons? V1030) (cons? (hd V1030))) (let NewContinuation (shen.newcontinuation (tl V1030) V1031 V1032) (cons (hd (hd V1030)) (append (tl (hd V1030)) (cons V1031 (cons NewContinuation ())))))) (true (shen.f_error shen.call_the_continuation))))
|
|
173
173
|
|
|
174
|
-
(defun shen.newcontinuation (
|
|
174
|
+
(defun shen.newcontinuation (V1033 V1034 V1035) (cond ((= () V1033) V1035) ((and (cons? V1033) (cons? (hd V1033))) (cons freeze (cons (cons (hd (hd V1033)) (append (tl (hd V1033)) (cons V1034 (cons (shen.newcontinuation (tl V1033) V1034 V1035) ())))) ()))) (true (shen.f_error shen.newcontinuation))))
|
|
175
175
|
|
|
176
|
-
(defun return (
|
|
176
|
+
(defun return (V1040 V1041 V1042) (shen.deref V1040 V1041))
|
|
177
177
|
|
|
178
|
-
(defun shen.measure&return (
|
|
179
|
-
" shen.a) (stoutput)) (shen.deref
|
|
178
|
+
(defun shen.measure&return (V1047 V1048 V1049) (do (shen.prhush (shen.app (value shen.*infs*) " inferences
|
|
179
|
+
" shen.a) (stoutput)) (shen.deref V1047 V1048)))
|
|
180
180
|
|
|
181
|
-
(defun unify (
|
|
181
|
+
(defun unify (V1050 V1051 V1052 V1053) (shen.lzy= (shen.lazyderef V1050 V1052) (shen.lazyderef V1051 V1052) V1052 V1053))
|
|
182
182
|
|
|
183
|
-
(defun shen.lzy= (
|
|
183
|
+
(defun shen.lzy= (V1071 V1072 V1073 V1074) (cond ((= V1072 V1071) (thaw V1074)) ((shen.pvar? V1071) (bind V1071 V1072 V1073 V1074)) ((shen.pvar? V1072) (bind V1072 V1071 V1073 V1074)) ((and (cons? V1071) (cons? V1072)) (shen.lzy= (shen.lazyderef (hd V1071) V1073) (shen.lazyderef (hd V1072) V1073) V1073 (freeze (shen.lzy= (shen.lazyderef (tl V1071) V1073) (shen.lazyderef (tl V1072) V1073) V1073 V1074)))) (true false)))
|
|
184
184
|
|
|
185
|
-
(defun shen.deref (
|
|
185
|
+
(defun shen.deref (V1075 V1076) (cond ((cons? V1075) (cons (shen.deref (hd V1075) V1076) (shen.deref (tl V1075) V1076))) (true (if (shen.pvar? V1075) (let Value (shen.valvector V1075 V1076) (if (= Value shen.-null-) V1075 (shen.deref Value V1076))) V1075))))
|
|
186
186
|
|
|
187
|
-
(defun shen.lazyderef (
|
|
187
|
+
(defun shen.lazyderef (V1077 V1078) (if (shen.pvar? V1077) (let Value (shen.valvector V1077 V1078) (if (= Value shen.-null-) V1077 (shen.lazyderef Value V1078))) V1077))
|
|
188
188
|
|
|
189
|
-
(defun shen.valvector (
|
|
189
|
+
(defun shen.valvector (V1079 V1080) (<-address (<-address (value shen.*prologvectors*) V1080) (<-address V1079 1)))
|
|
190
190
|
|
|
191
|
-
(defun unify! (
|
|
191
|
+
(defun unify! (V1081 V1082 V1083 V1084) (shen.lzy=! (shen.lazyderef V1081 V1083) (shen.lazyderef V1082 V1083) V1083 V1084))
|
|
192
192
|
|
|
193
|
-
(defun shen.lzy=! (
|
|
193
|
+
(defun shen.lzy=! (V1102 V1103 V1104 V1105) (cond ((= V1103 V1102) (thaw V1105)) ((and (shen.pvar? V1102) (not (shen.occurs? V1102 (shen.deref V1103 V1104)))) (bind V1102 V1103 V1104 V1105)) ((and (shen.pvar? V1103) (not (shen.occurs? V1103 (shen.deref V1102 V1104)))) (bind V1103 V1102 V1104 V1105)) ((and (cons? V1102) (cons? V1103)) (shen.lzy=! (shen.lazyderef (hd V1102) V1104) (shen.lazyderef (hd V1103) V1104) V1104 (freeze (shen.lzy=! (shen.lazyderef (tl V1102) V1104) (shen.lazyderef (tl V1103) V1104) V1104 V1105)))) (true false)))
|
|
194
194
|
|
|
195
|
-
(defun shen.occurs? (
|
|
195
|
+
(defun shen.occurs? (V1115 V1116) (cond ((= V1116 V1115) true) ((cons? V1116) (or (shen.occurs? V1115 (hd V1116)) (shen.occurs? V1115 (tl V1116)))) (true false)))
|
|
196
196
|
|
|
197
|
-
(defun identical (
|
|
197
|
+
(defun identical (V1117 V1118 V1119 V1120) (shen.lzy== (shen.lazyderef V1117 V1119) (shen.lazyderef V1118 V1119) V1119 V1120))
|
|
198
198
|
|
|
199
|
-
(defun shen.lzy== (
|
|
199
|
+
(defun shen.lzy== (V1138 V1139 V1140 V1141) (cond ((= V1139 V1138) (thaw V1141)) ((and (cons? V1138) (cons? V1139)) (shen.lzy== (shen.lazyderef (hd V1138) V1140) (shen.lazyderef (hd V1139) V1140) V1140 (freeze (shen.lzy== (tl V1138) (tl V1139) V1140 V1141)))) (true false)))
|
|
200
200
|
|
|
201
|
-
(defun shen.pvar (
|
|
201
|
+
(defun shen.pvar (V1142) (cn "Var" (shen.app (<-address V1142 1) "" shen.a)))
|
|
202
202
|
|
|
203
|
-
(defun bind (
|
|
203
|
+
(defun bind (V1143 V1144 V1145 V1146) (do (shen.bindv V1143 V1144 V1145) (let Result (thaw V1146) (do (shen.unbindv V1143 V1145) Result))))
|
|
204
204
|
|
|
205
|
-
(defun fwhen (
|
|
205
|
+
(defun fwhen (V1161 V1162 V1163) (cond ((= true V1161) (thaw V1163)) ((= false V1161) false) (true (simple-error (cn "fwhen expects a boolean: not " (shen.app V1161 "%" shen.s))))))
|
|
206
206
|
|
|
207
|
-
(defun call (
|
|
207
|
+
(defun call (V1176 V1177 V1178) (cond ((cons? V1176) (shen.call-help (shen.m_prolog_to_s-prolog_predicate (shen.lazyderef (hd V1176) V1177)) (tl V1176) V1177 V1178)) (true false)))
|
|
208
208
|
|
|
209
|
-
(defun shen.call-help (
|
|
209
|
+
(defun shen.call-help (V1179 V1180 V1181 V1182) (cond ((= () V1180) (V1179 V1181 V1182)) ((cons? V1180) (shen.call-help (V1179 (hd V1180)) (tl V1180) V1181 V1182)) (true (shen.f_error shen.call-help))))
|
|
210
210
|
|
|
211
|
-
(defun shen.intprolog (
|
|
211
|
+
(defun shen.intprolog (V1183) (cond ((and (cons? V1183) (cons? (hd V1183))) (let ProcessN (shen.start-new-prolog-process) (shen.intprolog-help (hd (hd V1183)) (shen.insert-prolog-variables (cons (tl (hd V1183)) (cons (tl V1183) ())) ProcessN) ProcessN))) (true (shen.f_error shen.intprolog))))
|
|
212
212
|
|
|
213
|
-
(defun shen.intprolog-help (
|
|
213
|
+
(defun shen.intprolog-help (V1184 V1185 V1186) (cond ((and (cons? V1185) (and (cons? (tl V1185)) (= () (tl (tl V1185))))) (shen.intprolog-help-help V1184 (hd V1185) (hd (tl V1185)) V1186)) (true (shen.f_error shen.intprolog-help))))
|
|
214
214
|
|
|
215
|
-
(defun shen.intprolog-help-help (
|
|
215
|
+
(defun shen.intprolog-help-help (V1187 V1188 V1189 V1190) (cond ((= () V1188) (V1187 V1190 (freeze (shen.call-rest V1189 V1190)))) ((cons? V1188) (shen.intprolog-help-help (V1187 (hd V1188)) (tl V1188) V1189 V1190)) (true (shen.f_error shen.intprolog-help-help))))
|
|
216
216
|
|
|
217
|
-
(defun shen.call-rest (
|
|
217
|
+
(defun shen.call-rest (V1193 V1194) (cond ((= () V1193) true) ((and (cons? V1193) (and (cons? (hd V1193)) (cons? (tl (hd V1193))))) (shen.call-rest (cons (cons ((hd (hd V1193)) (hd (tl (hd V1193)))) (tl (tl (hd V1193)))) (tl V1193)) V1194)) ((and (cons? V1193) (and (cons? (hd V1193)) (= () (tl (hd V1193))))) ((hd (hd V1193)) V1194 (freeze (shen.call-rest (tl V1193) V1194)))) (true (shen.f_error shen.call-rest))))
|
|
218
218
|
|
|
219
219
|
(defun shen.start-new-prolog-process () (let IncrementProcessCounter (set shen.*process-counter* (+ 1 (value shen.*process-counter*))) (shen.initialise-prolog IncrementProcessCounter)))
|
|
220
220
|
|
|
221
|
-
(defun shen.insert-prolog-variables (
|
|
221
|
+
(defun shen.insert-prolog-variables (V1195 V1196) (shen.insert-prolog-variables-help V1195 (shen.flatten V1195) V1196))
|
|
222
222
|
|
|
223
|
-
(defun shen.insert-prolog-variables-help (
|
|
223
|
+
(defun shen.insert-prolog-variables-help (V1201 V1202 V1203) (cond ((= () V1202) V1201) ((and (cons? V1202) (variable? (hd V1202))) (let V (shen.newpv V1203) (let XV/Y (subst V (hd V1202) V1201) (let Z-Y (remove (hd V1202) (tl V1202)) (shen.insert-prolog-variables-help XV/Y Z-Y V1203))))) ((cons? V1202) (shen.insert-prolog-variables-help V1201 (tl V1202) V1203)) (true (shen.f_error shen.insert-prolog-variables-help))))
|
|
224
224
|
|
|
225
|
-
(defun shen.initialise-prolog (
|
|
225
|
+
(defun shen.initialise-prolog (V1204) (let Vector (address-> (value shen.*prologvectors*) V1204 (shen.fillvector (vector 10) 1 10 shen.-null-)) (let Counter (address-> (value shen.*varcounter*) V1204 1) V1204)))
|
|
226
226
|
|
|
227
227
|
|
|
228
228
|
|
|
@@ -23,176 +23,176 @@ 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 read-file-as-bytelist (
|
|
26
|
+
(defun read-file-as-bytelist (V1216) (let Stream (open V1216 in) (let Byte (read-byte Stream) (let Bytes (shen.read-file-as-bytelist-help Stream Byte ()) (let Close (close Stream) (reverse Bytes))))))
|
|
27
27
|
|
|
28
|
-
(defun shen.read-file-as-bytelist-help (
|
|
28
|
+
(defun shen.read-file-as-bytelist-help (V1217 V1218 V1219) (cond ((= -1 V1218) V1219) (true (shen.read-file-as-bytelist-help V1217 (read-byte V1217) (cons V1218 V1219)))))
|
|
29
29
|
|
|
30
|
-
(defun read-file-as-string (
|
|
30
|
+
(defun read-file-as-string (V1220) (let Stream (open V1220 in) (shen.rfas-h Stream (read-byte Stream) "")))
|
|
31
31
|
|
|
32
|
-
(defun shen.rfas-h (
|
|
32
|
+
(defun shen.rfas-h (V1221 V1222 V1223) (cond ((= -1 V1222) (do (close V1221) V1223)) (true (shen.rfas-h V1221 (read-byte V1221) (cn V1223 (n->string V1222))))))
|
|
33
33
|
|
|
34
|
-
(defun input (
|
|
34
|
+
(defun input (V1224) (eval-kl (read V1224)))
|
|
35
35
|
|
|
36
|
-
(defun input+ (
|
|
36
|
+
(defun input+ (V1225 V1226) (let Mono? (shen.monotype V1225) (let Input (read V1226) (if (= false (shen.typecheck Input (shen.demodulate V1225))) (simple-error (cn "type error: " (shen.app Input (cn " is not of type " (shen.app V1225 "
|
|
37
37
|
" shen.r)) shen.r))) (eval-kl Input)))))
|
|
38
38
|
|
|
39
|
-
(defun shen.monotype (
|
|
40
|
-
" shen.a)))
|
|
39
|
+
(defun shen.monotype (V1227) (cond ((cons? V1227) (map (lambda V1205 (shen.monotype V1205)) V1227)) (true (if (variable? V1227) (simple-error (cn "input+ expects a monotype: not " (shen.app V1227 "
|
|
40
|
+
" shen.a))) V1227))))
|
|
41
41
|
|
|
42
|
-
(defun read (
|
|
42
|
+
(defun read (V1228) (hd (shen.read-loop V1228 (read-byte V1228) ())))
|
|
43
43
|
|
|
44
44
|
(defun it () (value shen.*it*))
|
|
45
45
|
|
|
46
|
-
(defun shen.read-loop (
|
|
46
|
+
(defun shen.read-loop (V1233 V1234 V1235) (cond ((= 94 V1234) (simple-error "read aborted")) ((= -1 V1234) (if (empty? V1235) (simple-error "error: empty stream") (compile (lambda V1206 (shen.<st_input> V1206)) V1235 (lambda E E)))) ((shen.terminator? V1234) (let AllBytes (append V1235 (cons V1234 ())) (let It (shen.record-it AllBytes) (let Read (compile (lambda V1207 (shen.<st_input> V1207)) AllBytes (lambda E shen.nextbyte)) (if (or (= Read shen.nextbyte) (empty? Read)) (shen.read-loop V1233 (read-byte V1233) AllBytes) Read))))) (true (shen.read-loop V1233 (read-byte V1233) (append V1235 (cons V1234 ()))))))
|
|
47
47
|
|
|
48
|
-
(defun shen.terminator? (
|
|
48
|
+
(defun shen.terminator? (V1236) (element? V1236 (cons 9 (cons 10 (cons 13 (cons 32 (cons 34 (cons 41 (cons 93 ())))))))))
|
|
49
49
|
|
|
50
|
-
(defun lineread (
|
|
50
|
+
(defun lineread (V1237) (shen.lineread-loop (read-byte V1237) () V1237))
|
|
51
51
|
|
|
52
|
-
(defun shen.lineread-loop (
|
|
52
|
+
(defun shen.lineread-loop (V1239 V1240 V1241) (cond ((= -1 V1239) (if (empty? V1240) (simple-error "empty stream") (compile (lambda V1208 (shen.<st_input> V1208)) V1240 (lambda E E)))) ((= V1239 (shen.hat)) (simple-error "line read aborted")) ((element? V1239 (cons (shen.newline) (cons (shen.carriage-return) ()))) (let Line (compile (lambda V1209 (shen.<st_input> V1209)) V1240 (lambda E shen.nextline)) (let It (shen.record-it V1240) (if (or (= Line shen.nextline) (empty? Line)) (shen.lineread-loop (read-byte V1241) (append V1240 (cons V1239 ())) V1241) Line)))) (true (shen.lineread-loop (read-byte V1241) (append V1240 (cons V1239 ())) V1241))))
|
|
53
53
|
|
|
54
|
-
(defun shen.record-it (
|
|
54
|
+
(defun shen.record-it (V1242) (let TrimLeft (shen.trim-whitespace V1242) (let TrimRight (shen.trim-whitespace (reverse TrimLeft)) (let Trimmed (reverse TrimRight) (shen.record-it-h Trimmed)))))
|
|
55
55
|
|
|
56
|
-
(defun shen.trim-whitespace (
|
|
56
|
+
(defun shen.trim-whitespace (V1243) (cond ((and (cons? V1243) (element? (hd V1243) (cons 9 (cons 10 (cons 13 (cons 32 ())))))) (shen.trim-whitespace (tl V1243))) (true V1243)))
|
|
57
57
|
|
|
58
|
-
(defun shen.record-it-h (
|
|
58
|
+
(defun shen.record-it-h (V1244) (do (set shen.*it* (shen.cn-all (map (lambda V1210 (n->string V1210)) V1244))) V1244))
|
|
59
59
|
|
|
60
|
-
(defun shen.cn-all (
|
|
60
|
+
(defun shen.cn-all (V1245) (cond ((= () V1245) "") ((cons? V1245) (cn (hd V1245) (shen.cn-all (tl V1245)))) (true (shen.f_error shen.cn-all))))
|
|
61
61
|
|
|
62
|
-
(defun read-file (
|
|
62
|
+
(defun read-file (V1246) (let Bytelist (read-file-as-bytelist V1246) (compile (lambda V1212 (shen.<st_input> V1212)) Bytelist (lambda V1211 (shen.read-error V1211)))))
|
|
63
63
|
|
|
64
|
-
(defun read-from-string (
|
|
64
|
+
(defun read-from-string (V1247) (let Ns (map (lambda V1213 (string->n V1213)) (explode V1247)) (compile (lambda V1215 (shen.<st_input> V1215)) Ns (lambda V1214 (shen.read-error V1214)))))
|
|
65
65
|
|
|
66
|
-
(defun shen.read-error (
|
|
66
|
+
(defun shen.read-error (V1254) (cond ((and (cons? V1254) (and (cons? (hd V1254)) (and (cons? (tl V1254)) (= () (tl (tl V1254)))))) (simple-error (cn "read error here:
|
|
67
67
|
|
|
68
|
-
" (shen.app (shen.compress-50 50 (hd
|
|
68
|
+
" (shen.app (shen.compress-50 50 (hd V1254)) "
|
|
69
69
|
" shen.a)))) (true (simple-error "read error
|
|
70
70
|
"))))
|
|
71
71
|
|
|
72
|
-
(defun shen.compress-50 (
|
|
72
|
+
(defun shen.compress-50 (V1259 V1260) (cond ((= () V1260) "") ((= 0 V1259) "") ((cons? V1260) (cn (n->string (hd V1260)) (shen.compress-50 (- V1259 1) (tl V1260)))) (true (shen.f_error shen.compress-50))))
|
|
73
73
|
|
|
74
|
-
(defun shen.<st_input> (
|
|
74
|
+
(defun shen.<st_input> (V1261) (let YaccParse (let Parse_shen.<lsb> (shen.<lsb> V1261) (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 (= YaccParse (fail)) (let YaccParse (let Parse_shen.<lrb> (shen.<lrb> V1261) (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 (= YaccParse (fail)) (let YaccParse (let Parse_shen.<lcurly> (shen.<lcurly> V1261) (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 (= YaccParse (fail)) (let YaccParse (let Parse_shen.<rcurly> (shen.<rcurly> V1261) (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 (= YaccParse (fail)) (let YaccParse (let Parse_shen.<bar> (shen.<bar> V1261) (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 (= YaccParse (fail)) (let YaccParse (let Parse_shen.<semicolon> (shen.<semicolon> V1261) (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 (= YaccParse (fail)) (let YaccParse (let Parse_shen.<colon> (shen.<colon> V1261) (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 (= YaccParse (fail)) (let YaccParse (let Parse_shen.<colon> (shen.<colon> V1261) (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 (= YaccParse (fail)) (let YaccParse (let Parse_shen.<colon> (shen.<colon> V1261) (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 (= YaccParse (fail)) (let YaccParse (let Parse_shen.<comma> (shen.<comma> V1261) (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 (= YaccParse (fail)) (let YaccParse (let Parse_shen.<comment> (shen.<comment> V1261) (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 (= YaccParse (fail)) (let YaccParse (let Parse_shen.<atom> (shen.<atom> V1261) (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 (= YaccParse (fail)) (let YaccParse (let Parse_shen.<whitespaces> (shen.<whitespaces> V1261) (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 (= YaccParse (fail)) (let Parse_<e> (<e> V1261) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) ()) (fail))) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)))
|
|
75
75
|
|
|
76
|
-
(defun shen.<lsb> (
|
|
76
|
+
(defun shen.<lsb> (V1262) (if (and (cons? (hd V1262)) (= 91 (hd (hd V1262)))) (shen.pair (hd (shen.pair (tl (hd V1262)) (shen.hdtl V1262))) shen.skip) (fail)))
|
|
77
77
|
|
|
78
|
-
(defun shen.<rsb> (
|
|
78
|
+
(defun shen.<rsb> (V1263) (if (and (cons? (hd V1263)) (= 93 (hd (hd V1263)))) (shen.pair (hd (shen.pair (tl (hd V1263)) (shen.hdtl V1263))) shen.skip) (fail)))
|
|
79
79
|
|
|
80
|
-
(defun shen.<lcurly> (
|
|
80
|
+
(defun shen.<lcurly> (V1264) (if (and (cons? (hd V1264)) (= 123 (hd (hd V1264)))) (shen.pair (hd (shen.pair (tl (hd V1264)) (shen.hdtl V1264))) shen.skip) (fail)))
|
|
81
81
|
|
|
82
|
-
(defun shen.<rcurly> (
|
|
82
|
+
(defun shen.<rcurly> (V1265) (if (and (cons? (hd V1265)) (= 125 (hd (hd V1265)))) (shen.pair (hd (shen.pair (tl (hd V1265)) (shen.hdtl V1265))) shen.skip) (fail)))
|
|
83
83
|
|
|
84
|
-
(defun shen.<bar> (
|
|
84
|
+
(defun shen.<bar> (V1266) (if (and (cons? (hd V1266)) (= 124 (hd (hd V1266)))) (shen.pair (hd (shen.pair (tl (hd V1266)) (shen.hdtl V1266))) shen.skip) (fail)))
|
|
85
85
|
|
|
86
|
-
(defun shen.<semicolon> (
|
|
86
|
+
(defun shen.<semicolon> (V1267) (if (and (cons? (hd V1267)) (= 59 (hd (hd V1267)))) (shen.pair (hd (shen.pair (tl (hd V1267)) (shen.hdtl V1267))) shen.skip) (fail)))
|
|
87
87
|
|
|
88
|
-
(defun shen.<colon> (
|
|
88
|
+
(defun shen.<colon> (V1268) (if (and (cons? (hd V1268)) (= 58 (hd (hd V1268)))) (shen.pair (hd (shen.pair (tl (hd V1268)) (shen.hdtl V1268))) shen.skip) (fail)))
|
|
89
89
|
|
|
90
|
-
(defun shen.<comma> (
|
|
90
|
+
(defun shen.<comma> (V1269) (if (and (cons? (hd V1269)) (= 44 (hd (hd V1269)))) (shen.pair (hd (shen.pair (tl (hd V1269)) (shen.hdtl V1269))) shen.skip) (fail)))
|
|
91
91
|
|
|
92
|
-
(defun shen.<equal> (
|
|
92
|
+
(defun shen.<equal> (V1270) (if (and (cons? (hd V1270)) (= 61 (hd (hd V1270)))) (shen.pair (hd (shen.pair (tl (hd V1270)) (shen.hdtl V1270))) shen.skip) (fail)))
|
|
93
93
|
|
|
94
|
-
(defun shen.<minus> (
|
|
94
|
+
(defun shen.<minus> (V1271) (if (and (cons? (hd V1271)) (= 45 (hd (hd V1271)))) (shen.pair (hd (shen.pair (tl (hd V1271)) (shen.hdtl V1271))) shen.skip) (fail)))
|
|
95
95
|
|
|
96
|
-
(defun shen.<lrb> (
|
|
96
|
+
(defun shen.<lrb> (V1272) (if (and (cons? (hd V1272)) (= 40 (hd (hd V1272)))) (shen.pair (hd (shen.pair (tl (hd V1272)) (shen.hdtl V1272))) shen.skip) (fail)))
|
|
97
97
|
|
|
98
|
-
(defun shen.<rrb> (
|
|
98
|
+
(defun shen.<rrb> (V1273) (if (and (cons? (hd V1273)) (= 41 (hd (hd V1273)))) (shen.pair (hd (shen.pair (tl (hd V1273)) (shen.hdtl V1273))) shen.skip) (fail)))
|
|
99
99
|
|
|
100
|
-
(defun shen.<atom> (
|
|
100
|
+
(defun shen.<atom> (V1274) (let YaccParse (let Parse_shen.<str> (shen.<str> V1274) (if (not (= (fail) Parse_shen.<str>)) (shen.pair (hd Parse_shen.<str>) (shen.control-chars (shen.hdtl Parse_shen.<str>))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen.<number> (shen.<number> V1274) (if (not (= (fail) Parse_shen.<number>)) (shen.pair (hd Parse_shen.<number>) (shen.hdtl Parse_shen.<number>)) (fail))) (if (= YaccParse (fail)) (let Parse_shen.<sym> (shen.<sym> V1274) (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))) YaccParse)) YaccParse)))
|
|
101
101
|
|
|
102
|
-
(defun shen.control-chars (
|
|
102
|
+
(defun shen.control-chars (V1275) (cond ((= () V1275) "") ((and (cons? V1275) (and (= "c" (hd V1275)) (and (cons? (tl V1275)) (= "#" (hd (tl V1275)))))) (let CodePoint (shen.code-point (tl (tl V1275))) (let AfterCodePoint (shen.after-codepoint (tl (tl V1275))) (@s (n->string (shen.decimalise CodePoint)) (shen.control-chars AfterCodePoint))))) ((cons? V1275) (@s (hd V1275) (shen.control-chars (tl V1275)))) (true (shen.f_error shen.control-chars))))
|
|
103
103
|
|
|
104
|
-
(defun shen.code-point (
|
|
104
|
+
(defun shen.code-point (V1278) (cond ((and (cons? V1278) (= ";" (hd V1278))) "") ((and (cons? V1278) (element? (hd V1278) (cons "0" (cons "1" (cons "2" (cons "3" (cons "4" (cons "5" (cons "6" (cons "7" (cons "8" (cons "9" (cons "0" ()))))))))))))) (cons (hd V1278) (shen.code-point (tl V1278)))) (true (simple-error (cn "code point parse error " (shen.app V1278 "
|
|
105
105
|
" shen.a))))))
|
|
106
106
|
|
|
107
|
-
(defun shen.after-codepoint (
|
|
107
|
+
(defun shen.after-codepoint (V1283) (cond ((= () V1283) ()) ((and (cons? V1283) (= ";" (hd V1283))) (tl V1283)) ((cons? V1283) (shen.after-codepoint (tl V1283))) (true (shen.f_error shen.after-codepoint))))
|
|
108
108
|
|
|
109
|
-
(defun shen.decimalise (
|
|
109
|
+
(defun shen.decimalise (V1284) (shen.pre (reverse (shen.digits->integers V1284)) 0))
|
|
110
110
|
|
|
111
|
-
(defun shen.digits->integers (
|
|
111
|
+
(defun shen.digits->integers (V1289) (cond ((and (cons? V1289) (= "0" (hd V1289))) (cons 0 (shen.digits->integers (tl V1289)))) ((and (cons? V1289) (= "1" (hd V1289))) (cons 1 (shen.digits->integers (tl V1289)))) ((and (cons? V1289) (= "2" (hd V1289))) (cons 2 (shen.digits->integers (tl V1289)))) ((and (cons? V1289) (= "3" (hd V1289))) (cons 3 (shen.digits->integers (tl V1289)))) ((and (cons? V1289) (= "4" (hd V1289))) (cons 4 (shen.digits->integers (tl V1289)))) ((and (cons? V1289) (= "5" (hd V1289))) (cons 5 (shen.digits->integers (tl V1289)))) ((and (cons? V1289) (= "6" (hd V1289))) (cons 6 (shen.digits->integers (tl V1289)))) ((and (cons? V1289) (= "7" (hd V1289))) (cons 7 (shen.digits->integers (tl V1289)))) ((and (cons? V1289) (= "8" (hd V1289))) (cons 8 (shen.digits->integers (tl V1289)))) ((and (cons? V1289) (= "9" (hd V1289))) (cons 9 (shen.digits->integers (tl V1289)))) (true ())))
|
|
112
112
|
|
|
113
|
-
(defun shen.<sym> (
|
|
113
|
+
(defun shen.<sym> (V1290) (let Parse_shen.<alpha> (shen.<alpha> V1290) (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))))
|
|
114
114
|
|
|
115
|
-
(defun shen.<alphanums> (
|
|
115
|
+
(defun shen.<alphanums> (V1291) (let YaccParse (let Parse_shen.<alphanum> (shen.<alphanum> V1291) (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 (= YaccParse (fail)) (let Parse_<e> (<e> V1291) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) "") (fail))) YaccParse)))
|
|
116
116
|
|
|
117
|
-
(defun shen.<alphanum> (
|
|
117
|
+
(defun shen.<alphanum> (V1292) (let YaccParse (let Parse_shen.<alpha> (shen.<alpha> V1292) (if (not (= (fail) Parse_shen.<alpha>)) (shen.pair (hd Parse_shen.<alpha>) (shen.hdtl Parse_shen.<alpha>)) (fail))) (if (= YaccParse (fail)) (let Parse_shen.<num> (shen.<num> V1292) (if (not (= (fail) Parse_shen.<num>)) (shen.pair (hd Parse_shen.<num>) (shen.hdtl Parse_shen.<num>)) (fail))) YaccParse)))
|
|
118
118
|
|
|
119
|
-
(defun shen.<num> (
|
|
119
|
+
(defun shen.<num> (V1293) (if (cons? (hd V1293)) (let Parse_Byte (hd (hd V1293)) (if (shen.numbyte? Parse_Byte) (shen.pair (hd (shen.pair (tl (hd V1293)) (shen.hdtl V1293))) (n->string Parse_Byte)) (fail))) (fail)))
|
|
120
120
|
|
|
121
|
-
(defun shen.numbyte? (
|
|
121
|
+
(defun shen.numbyte? (V1298) (cond ((= 48 V1298) true) ((= 49 V1298) true) ((= 50 V1298) true) ((= 51 V1298) true) ((= 52 V1298) true) ((= 53 V1298) true) ((= 54 V1298) true) ((= 55 V1298) true) ((= 56 V1298) true) ((= 57 V1298) true) (true false)))
|
|
122
122
|
|
|
123
|
-
(defun shen.<alpha> (
|
|
123
|
+
(defun shen.<alpha> (V1299) (if (cons? (hd V1299)) (let Parse_Byte (hd (hd V1299)) (if (shen.symbol-code? Parse_Byte) (shen.pair (hd (shen.pair (tl (hd V1299)) (shen.hdtl V1299))) (n->string Parse_Byte)) (fail))) (fail)))
|
|
124
124
|
|
|
125
|
-
(defun shen.symbol-code? (
|
|
125
|
+
(defun shen.symbol-code? (V1300) (or (= V1300 126) (or (and (> V1300 94) (< V1300 123)) (or (and (> V1300 59) (< V1300 91)) (or (and (> V1300 41) (and (< V1300 58) (not (= V1300 44)))) (or (and (> V1300 34) (< V1300 40)) (= V1300 33)))))))
|
|
126
126
|
|
|
127
|
-
(defun shen.<str> (
|
|
127
|
+
(defun shen.<str> (V1301) (let Parse_shen.<dbq> (shen.<dbq> V1301) (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))))
|
|
128
128
|
|
|
129
|
-
(defun shen.<dbq> (
|
|
129
|
+
(defun shen.<dbq> (V1302) (if (cons? (hd V1302)) (let Parse_Byte (hd (hd V1302)) (if (= Parse_Byte 34) (shen.pair (hd (shen.pair (tl (hd V1302)) (shen.hdtl V1302))) Parse_Byte) (fail))) (fail)))
|
|
130
130
|
|
|
131
|
-
(defun shen.<strcontents> (
|
|
131
|
+
(defun shen.<strcontents> (V1303) (let YaccParse (let Parse_shen.<strc> (shen.<strc> V1303) (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 (= YaccParse (fail)) (let Parse_<e> (<e> V1303) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) ()) (fail))) YaccParse)))
|
|
132
132
|
|
|
133
|
-
(defun shen.<byte> (
|
|
133
|
+
(defun shen.<byte> (V1304) (if (cons? (hd V1304)) (let Parse_Byte (hd (hd V1304)) (shen.pair (hd (shen.pair (tl (hd V1304)) (shen.hdtl V1304))) (n->string Parse_Byte))) (fail)))
|
|
134
134
|
|
|
135
|
-
(defun shen.<strc> (
|
|
135
|
+
(defun shen.<strc> (V1305) (if (cons? (hd V1305)) (let Parse_Byte (hd (hd V1305)) (if (not (= Parse_Byte 34)) (shen.pair (hd (shen.pair (tl (hd V1305)) (shen.hdtl V1305))) (n->string Parse_Byte)) (fail))) (fail)))
|
|
136
136
|
|
|
137
|
-
(defun shen.<number> (
|
|
137
|
+
(defun shen.<number> (V1306) (let YaccParse (let Parse_shen.<minus> (shen.<minus> V1306) (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 (= YaccParse (fail)) (let YaccParse (let Parse_shen.<plus> (shen.<plus> V1306) (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 (= YaccParse (fail)) (let YaccParse (let Parse_shen.<predigits> (shen.<predigits> V1306) (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 (= YaccParse (fail)) (let YaccParse (let Parse_shen.<digits> (shen.<digits> V1306) (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 (= YaccParse (fail)) (let YaccParse (let Parse_shen.<predigits> (shen.<predigits> V1306) (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 (= YaccParse (fail)) (let Parse_shen.<digits> (shen.<digits> V1306) (if (not (= (fail) Parse_shen.<digits>)) (shen.pair (hd Parse_shen.<digits>) (shen.pre (reverse (shen.hdtl Parse_shen.<digits>)) 0)) (fail))) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)))
|
|
138
138
|
|
|
139
|
-
(defun shen.<E> (
|
|
139
|
+
(defun shen.<E> (V1307) (if (and (cons? (hd V1307)) (= 101 (hd (hd V1307)))) (shen.pair (hd (shen.pair (tl (hd V1307)) (shen.hdtl V1307))) shen.skip) (fail)))
|
|
140
140
|
|
|
141
|
-
(defun shen.<log10> (
|
|
141
|
+
(defun shen.<log10> (V1308) (let YaccParse (let Parse_shen.<minus> (shen.<minus> V1308) (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 (= YaccParse (fail)) (let Parse_shen.<digits> (shen.<digits> V1308) (if (not (= (fail) Parse_shen.<digits>)) (shen.pair (hd Parse_shen.<digits>) (shen.pre (reverse (shen.hdtl Parse_shen.<digits>)) 0)) (fail))) YaccParse)))
|
|
142
142
|
|
|
143
|
-
(defun shen.<plus> (
|
|
143
|
+
(defun shen.<plus> (V1309) (if (cons? (hd V1309)) (let Parse_Byte (hd (hd V1309)) (if (= Parse_Byte 43) (shen.pair (hd (shen.pair (tl (hd V1309)) (shen.hdtl V1309))) Parse_Byte) (fail))) (fail)))
|
|
144
144
|
|
|
145
|
-
(defun shen.<stop> (
|
|
145
|
+
(defun shen.<stop> (V1310) (if (cons? (hd V1310)) (let Parse_Byte (hd (hd V1310)) (if (= Parse_Byte 46) (shen.pair (hd (shen.pair (tl (hd V1310)) (shen.hdtl V1310))) Parse_Byte) (fail))) (fail)))
|
|
146
146
|
|
|
147
|
-
(defun shen.<predigits> (
|
|
147
|
+
(defun shen.<predigits> (V1311) (let YaccParse (let Parse_shen.<digits> (shen.<digits> V1311) (if (not (= (fail) Parse_shen.<digits>)) (shen.pair (hd Parse_shen.<digits>) (shen.hdtl Parse_shen.<digits>)) (fail))) (if (= YaccParse (fail)) (let Parse_<e> (<e> V1311) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) ()) (fail))) YaccParse)))
|
|
148
148
|
|
|
149
|
-
(defun shen.<postdigits> (
|
|
149
|
+
(defun shen.<postdigits> (V1312) (let Parse_shen.<digits> (shen.<digits> V1312) (if (not (= (fail) Parse_shen.<digits>)) (shen.pair (hd Parse_shen.<digits>) (shen.hdtl Parse_shen.<digits>)) (fail))))
|
|
150
150
|
|
|
151
|
-
(defun shen.<digits> (
|
|
151
|
+
(defun shen.<digits> (V1313) (let YaccParse (let Parse_shen.<digit> (shen.<digit> V1313) (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 (= YaccParse (fail)) (let Parse_shen.<digit> (shen.<digit> V1313) (if (not (= (fail) Parse_shen.<digit>)) (shen.pair (hd Parse_shen.<digit>) (cons (shen.hdtl Parse_shen.<digit>) ())) (fail))) YaccParse)))
|
|
152
152
|
|
|
153
|
-
(defun shen.<digit> (
|
|
153
|
+
(defun shen.<digit> (V1314) (if (cons? (hd V1314)) (let Parse_X (hd (hd V1314)) (if (shen.numbyte? Parse_X) (shen.pair (hd (shen.pair (tl (hd V1314)) (shen.hdtl V1314))) (shen.byte->digit Parse_X)) (fail))) (fail)))
|
|
154
154
|
|
|
155
|
-
(defun shen.byte->digit (
|
|
155
|
+
(defun shen.byte->digit (V1315) (cond ((= 48 V1315) 0) ((= 49 V1315) 1) ((= 50 V1315) 2) ((= 51 V1315) 3) ((= 52 V1315) 4) ((= 53 V1315) 5) ((= 54 V1315) 6) ((= 55 V1315) 7) ((= 56 V1315) 8) ((= 57 V1315) 9) (true (shen.f_error shen.byte->digit))))
|
|
156
156
|
|
|
157
|
-
(defun shen.pre (
|
|
157
|
+
(defun shen.pre (V1318 V1319) (cond ((= () V1318) 0) ((cons? V1318) (+ (* (shen.expt 10 V1319) (hd V1318)) (shen.pre (tl V1318) (+ V1319 1)))) (true (shen.f_error shen.pre))))
|
|
158
158
|
|
|
159
|
-
(defun shen.post (
|
|
159
|
+
(defun shen.post (V1322 V1323) (cond ((= () V1322) 0) ((cons? V1322) (+ (* (shen.expt 10 (- 0 V1323)) (hd V1322)) (shen.post (tl V1322) (+ V1323 1)))) (true (shen.f_error shen.post))))
|
|
160
160
|
|
|
161
|
-
(defun shen.expt (
|
|
161
|
+
(defun shen.expt (V1326 V1327) (cond ((= 0 V1327) 1) ((> V1327 0) (* V1326 (shen.expt V1326 (- V1327 1)))) (true (* 1.0 (/ (shen.expt V1326 (+ V1327 1)) V1326)))))
|
|
162
162
|
|
|
163
|
-
(defun shen.<st_input1> (
|
|
163
|
+
(defun shen.<st_input1> (V1328) (let Parse_shen.<st_input> (shen.<st_input> V1328) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (shen.hdtl Parse_shen.<st_input>)) (fail))))
|
|
164
164
|
|
|
165
|
-
(defun shen.<st_input2> (
|
|
165
|
+
(defun shen.<st_input2> (V1329) (let Parse_shen.<st_input> (shen.<st_input> V1329) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (shen.hdtl Parse_shen.<st_input>)) (fail))))
|
|
166
166
|
|
|
167
|
-
(defun shen.<comment> (
|
|
167
|
+
(defun shen.<comment> (V1330) (let YaccParse (let Parse_shen.<singleline> (shen.<singleline> V1330) (if (not (= (fail) Parse_shen.<singleline>)) (shen.pair (hd Parse_shen.<singleline>) shen.skip) (fail))) (if (= YaccParse (fail)) (let Parse_shen.<multiline> (shen.<multiline> V1330) (if (not (= (fail) Parse_shen.<multiline>)) (shen.pair (hd Parse_shen.<multiline>) shen.skip) (fail))) YaccParse)))
|
|
168
168
|
|
|
169
|
-
(defun shen.<singleline> (
|
|
169
|
+
(defun shen.<singleline> (V1331) (let Parse_shen.<backslash> (shen.<backslash> V1331) (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))))
|
|
170
170
|
|
|
171
|
-
(defun shen.<backslash> (
|
|
171
|
+
(defun shen.<backslash> (V1332) (if (and (cons? (hd V1332)) (= 92 (hd (hd V1332)))) (shen.pair (hd (shen.pair (tl (hd V1332)) (shen.hdtl V1332))) shen.skip) (fail)))
|
|
172
172
|
|
|
173
|
-
(defun shen.<anysingle> (
|
|
173
|
+
(defun shen.<anysingle> (V1333) (let YaccParse (let Parse_shen.<non-return> (shen.<non-return> V1333) (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 (= YaccParse (fail)) (let Parse_<e> (<e> V1333) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) shen.skip) (fail))) YaccParse)))
|
|
174
174
|
|
|
175
|
-
(defun shen.<non-return> (
|
|
175
|
+
(defun shen.<non-return> (V1334) (if (cons? (hd V1334)) (let Parse_X (hd (hd V1334)) (if (not (element? Parse_X (cons 10 (cons 13 ())))) (shen.pair (hd (shen.pair (tl (hd V1334)) (shen.hdtl V1334))) shen.skip) (fail))) (fail)))
|
|
176
176
|
|
|
177
|
-
(defun shen.<return> (
|
|
177
|
+
(defun shen.<return> (V1335) (if (cons? (hd V1335)) (let Parse_X (hd (hd V1335)) (if (element? Parse_X (cons 10 (cons 13 ()))) (shen.pair (hd (shen.pair (tl (hd V1335)) (shen.hdtl V1335))) shen.skip) (fail))) (fail)))
|
|
178
178
|
|
|
179
|
-
(defun shen.<multiline> (
|
|
179
|
+
(defun shen.<multiline> (V1336) (let Parse_shen.<backslash> (shen.<backslash> V1336) (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))))
|
|
180
180
|
|
|
181
|
-
(defun shen.<times> (
|
|
181
|
+
(defun shen.<times> (V1337) (if (and (cons? (hd V1337)) (= 42 (hd (hd V1337)))) (shen.pair (hd (shen.pair (tl (hd V1337)) (shen.hdtl V1337))) shen.skip) (fail)))
|
|
182
182
|
|
|
183
|
-
(defun shen.<anymulti> (
|
|
183
|
+
(defun shen.<anymulti> (V1338) (let YaccParse (let Parse_shen.<comment> (shen.<comment> V1338) (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 (= YaccParse (fail)) (let YaccParse (let Parse_shen.<times> (shen.<times> V1338) (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 (= YaccParse (fail)) (if (cons? (hd V1338)) (let Parse_X (hd (hd V1338)) (let Parse_shen.<anymulti> (shen.<anymulti> (shen.pair (tl (hd V1338)) (shen.hdtl V1338))) (if (not (= (fail) Parse_shen.<anymulti>)) (shen.pair (hd Parse_shen.<anymulti>) shen.skip) (fail)))) (fail)) YaccParse)) YaccParse)))
|
|
184
184
|
|
|
185
|
-
(defun shen.<whitespaces> (
|
|
185
|
+
(defun shen.<whitespaces> (V1339) (let YaccParse (let Parse_shen.<whitespace> (shen.<whitespace> V1339) (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 (= YaccParse (fail)) (let Parse_shen.<whitespace> (shen.<whitespace> V1339) (if (not (= (fail) Parse_shen.<whitespace>)) (shen.pair (hd Parse_shen.<whitespace>) shen.skip) (fail))) YaccParse)))
|
|
186
186
|
|
|
187
|
-
(defun shen.<whitespace> (
|
|
187
|
+
(defun shen.<whitespace> (V1340) (if (cons? (hd V1340)) (let Parse_X (hd (hd V1340)) (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 V1340)) (shen.hdtl V1340))) shen.skip) (fail))) (fail)))
|
|
188
188
|
|
|
189
|
-
(defun shen.cons_form (
|
|
189
|
+
(defun shen.cons_form (V1341) (cond ((= () V1341) ()) ((and (cons? V1341) (and (cons? (tl V1341)) (and (cons? (tl (tl V1341))) (and (= () (tl (tl (tl V1341)))) (= (hd (tl V1341)) bar!))))) (cons cons (cons (hd V1341) (tl (tl V1341))))) ((cons? V1341) (cons cons (cons (hd V1341) (cons (shen.cons_form (tl V1341)) ())))) (true (shen.f_error shen.cons_form))))
|
|
190
190
|
|
|
191
|
-
(defun shen.package-macro (
|
|
191
|
+
(defun shen.package-macro (V1344 V1345) (cond ((and (cons? V1344) (and (= $ (hd V1344)) (and (cons? (tl V1344)) (= () (tl (tl V1344)))))) (append (explode (hd (tl V1344))) V1345)) ((and (cons? V1344) (and (= package (hd V1344)) (and (cons? (tl V1344)) (and (= null (hd (tl V1344))) (cons? (tl (tl V1344))))))) (append (tl (tl (tl V1344))) V1345)) ((and (cons? V1344) (and (= package (hd V1344)) (and (cons? (tl V1344)) (cons? (tl (tl V1344)))))) (let ListofExceptions (shen.eval-without-macros (hd (tl (tl V1344)))) (let Record (shen.record-exceptions ListofExceptions (hd (tl V1344))) (let PackageNameDot (intern (cn (str (hd (tl V1344))) ".")) (append (shen.packageh PackageNameDot ListofExceptions (tl (tl (tl V1344)))) V1345))))) (true (cons V1344 V1345))))
|
|
192
192
|
|
|
193
|
-
(defun shen.record-exceptions (
|
|
193
|
+
(defun shen.record-exceptions (V1346 V1347) (let CurrExceptions (trap-error (get V1347 shen.external-symbols (value *property-vector*)) (lambda E ())) (let AllExceptions (union V1346 CurrExceptions) (put V1347 shen.external-symbols AllExceptions (value *property-vector*)))))
|
|
194
194
|
|
|
195
|
-
(defun shen.packageh (
|
|
195
|
+
(defun shen.packageh (V1356 V1357 V1358) (cond ((cons? V1358) (cons (shen.packageh V1356 V1357 (hd V1358)) (shen.packageh V1356 V1357 (tl V1358)))) ((or (shen.sysfunc? V1358) (or (variable? V1358) (or (element? V1358 V1357) (or (shen.doubleunderline? V1358) (shen.singleunderline? V1358))))) V1358) ((and (symbol? V1358) (not (shen.prefix? (cons "s" (cons "h" (cons "e" (cons "n" (cons "." ()))))) (explode V1358)))) (concat V1356 V1358)) (true V1358)))
|
|
196
196
|
|
|
197
197
|
|
|
198
198
|
|