shen-ruby 0.5.0 → 0.6.0
Sign up to get free protection for your applications and to get access to all the features.
- data/HISTORY.md +8 -0
- data/README.md +7 -7
- data/k_lambda_spec/primitives/boolean_operations_spec.rb +1 -1
- data/lib/kl/compiler.rb +10 -5
- data/lib/kl/primitives/booleans.rb +4 -0
- data/lib/shen_ruby/version.rb +1 -1
- data/shen-ruby.gemspec +1 -1
- data/shen/release/k_lambda/declarations.kl +3 -3
- data/shen/release/k_lambda/macros.kl +43 -37
- data/shen/release/k_lambda/prolog.kl +97 -97
- data/shen/release/k_lambda/reader.kl +67 -67
- data/shen/release/k_lambda/sequent.kl +53 -53
- data/shen/release/k_lambda/sys.kl +106 -104
- data/shen/release/k_lambda/t-star.kl +50 -50
- data/shen/release/k_lambda/toplevel.kl +23 -23
- data/shen/release/k_lambda/track.kl +25 -25
- data/shen/release/k_lambda/types.kl +9 -7
- data/shen/release/k_lambda/writer.kl +22 -22
- data/shen/release/k_lambda/yacc.kl +32 -28
- metadata +3 -3
|
@@ -49,142 +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 (V1309 V1310) (cond ((= V1309 (shen.hat)) (simple-error "line read aborted")) ((element? V1309 (cons (shen.newline) (cons (shen.carriage-return) ()))) (let Line (compile shen.<st_input> V1310 (lambda E shen.nextline)) (if (or (= Line shen.nextline) (empty? Line)) (shen.lineread-loop (read-byte (stinput)) (append V1310 (cons V1309 ()))) Line))) (true (shen.lineread-loop (read-byte (stinput)) (append V1310 (cons V1309 ()))))))
|
|
53
53
|
|
|
54
|
-
(defun read-file (
|
|
54
|
+
(defun read-file (V1311) (let Bytelist (read-file-as-bytelist V1311) (compile shen.<st_input> Bytelist shen.read-error)))
|
|
55
55
|
|
|
56
|
-
(defun shen.read-error (
|
|
56
|
+
(defun shen.read-error (V1318) (cond ((and (cons? V1318) (and (cons? (hd V1318)) (and (cons? (tl V1318)) (= () (tl (tl V1318)))))) (simple-error (cn "read error here:
|
|
57
57
|
|
|
58
|
-
" (shen.app (shen.compress-50 50 (hd
|
|
58
|
+
" (shen.app (shen.compress-50 50 (hd V1318)) "
|
|
59
59
|
" shen.a)))) (true (simple-error "read error
|
|
60
60
|
"))))
|
|
61
61
|
|
|
62
|
-
(defun shen.compress-50 (
|
|
62
|
+
(defun shen.compress-50 (V1323 V1324) (cond ((= () V1324) "") ((= 0 V1323) "") ((cons? V1324) (cn (n->string (hd V1324)) (shen.compress-50 (- V1323 1) (tl V1324)))) (true (shen.sys-error shen.compress-50))))
|
|
63
63
|
|
|
64
|
-
(defun shen.<st_input> (
|
|
64
|
+
(defun shen.<st_input> (V1329) (let Result (let Parse_shen.<lsb> (shen.<lsb> V1329) (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> V1329) (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> V1329) (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> V1329) (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> V1329) (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> V1329) (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> V1329) (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> V1329) (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> V1329) (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> V1329) (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> V1329) (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> V1329) (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> V1329) (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> V1329) (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> (V1334) (let Result (if (and (cons? (hd V1334)) (= 91 (hd (hd V1334)))) (shen.pair (hd (shen.pair (tl (hd V1334)) (shen.hdtl V1334))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
67
67
|
|
|
68
|
-
(defun shen.<rsb> (
|
|
68
|
+
(defun shen.<rsb> (V1339) (let Result (if (and (cons? (hd V1339)) (= 93 (hd (hd V1339)))) (shen.pair (hd (shen.pair (tl (hd V1339)) (shen.hdtl V1339))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
69
69
|
|
|
70
|
-
(defun shen.<lcurly> (
|
|
70
|
+
(defun shen.<lcurly> (V1344) (let Result (if (and (cons? (hd V1344)) (= 123 (hd (hd V1344)))) (shen.pair (hd (shen.pair (tl (hd V1344)) (shen.hdtl V1344))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
71
71
|
|
|
72
|
-
(defun shen.<rcurly> (
|
|
72
|
+
(defun shen.<rcurly> (V1349) (let Result (if (and (cons? (hd V1349)) (= 125 (hd (hd V1349)))) (shen.pair (hd (shen.pair (tl (hd V1349)) (shen.hdtl V1349))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
73
73
|
|
|
74
|
-
(defun shen.<bar> (
|
|
74
|
+
(defun shen.<bar> (V1354) (let Result (if (and (cons? (hd V1354)) (= 124 (hd (hd V1354)))) (shen.pair (hd (shen.pair (tl (hd V1354)) (shen.hdtl V1354))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
75
75
|
|
|
76
|
-
(defun shen.<semicolon> (
|
|
76
|
+
(defun shen.<semicolon> (V1359) (let Result (if (and (cons? (hd V1359)) (= 59 (hd (hd V1359)))) (shen.pair (hd (shen.pair (tl (hd V1359)) (shen.hdtl V1359))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
77
77
|
|
|
78
|
-
(defun shen.<colon> (
|
|
78
|
+
(defun shen.<colon> (V1364) (let Result (if (and (cons? (hd V1364)) (= 58 (hd (hd V1364)))) (shen.pair (hd (shen.pair (tl (hd V1364)) (shen.hdtl V1364))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
79
79
|
|
|
80
|
-
(defun shen.<comma> (
|
|
80
|
+
(defun shen.<comma> (V1369) (let Result (if (and (cons? (hd V1369)) (= 44 (hd (hd V1369)))) (shen.pair (hd (shen.pair (tl (hd V1369)) (shen.hdtl V1369))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
81
81
|
|
|
82
|
-
(defun shen.<equal> (
|
|
82
|
+
(defun shen.<equal> (V1374) (let Result (if (and (cons? (hd V1374)) (= 61 (hd (hd V1374)))) (shen.pair (hd (shen.pair (tl (hd V1374)) (shen.hdtl V1374))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
83
83
|
|
|
84
|
-
(defun shen.<minus> (
|
|
84
|
+
(defun shen.<minus> (V1379) (let Result (if (and (cons? (hd V1379)) (= 45 (hd (hd V1379)))) (shen.pair (hd (shen.pair (tl (hd V1379)) (shen.hdtl V1379))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
85
85
|
|
|
86
|
-
(defun shen.<lrb> (
|
|
86
|
+
(defun shen.<lrb> (V1384) (let Result (if (and (cons? (hd V1384)) (= 40 (hd (hd V1384)))) (shen.pair (hd (shen.pair (tl (hd V1384)) (shen.hdtl V1384))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
87
87
|
|
|
88
|
-
(defun shen.<rrb> (
|
|
88
|
+
(defun shen.<rrb> (V1389) (let Result (if (and (cons? (hd V1389)) (= 41 (hd (hd V1389)))) (shen.pair (hd (shen.pair (tl (hd V1389)) (shen.hdtl V1389))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
89
89
|
|
|
90
|
-
(defun shen.<atom> (
|
|
90
|
+
(defun shen.<atom> (V1394) (let Result (let Parse_shen.<str> (shen.<str> V1394) (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> V1394) (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> V1394) (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 (V1395) (cond ((= () V1395) "") ((and (cons? V1395) (and (= "c" (hd V1395)) (and (cons? (tl V1395)) (= "#" (hd (tl V1395)))))) (let CodePoint (shen.code-point (tl (tl V1395))) (let AfterCodePoint (shen.after-codepoint (tl (tl V1395))) (@s (n->string (shen.decimalise CodePoint)) (shen.control-chars AfterCodePoint))))) ((cons? V1395) (@s (hd V1395) (shen.control-chars (tl V1395)))) (true (shen.sys-error shen.control-chars))))
|
|
93
93
|
|
|
94
|
-
(defun shen.code-point (
|
|
94
|
+
(defun shen.code-point (V1398) (cond ((and (cons? V1398) (= ";" (hd V1398))) "") ((and (cons? V1398) (element? (hd V1398) (cons "0" (cons "1" (cons "2" (cons "3" (cons "4" (cons "5" (cons "6" (cons "7" (cons "8" (cons "9" (cons "0" ()))))))))))))) (cons (hd V1398) (shen.code-point (tl V1398)))) (true (simple-error (cn "code point parse error " (shen.app V1398 "
|
|
95
95
|
" shen.a))))))
|
|
96
96
|
|
|
97
|
-
(defun shen.after-codepoint (
|
|
97
|
+
(defun shen.after-codepoint (V1403) (cond ((= () V1403) ()) ((and (cons? V1403) (= ";" (hd V1403))) (tl V1403)) ((cons? V1403) (shen.after-codepoint (tl V1403))) (true (shen.sys-error shen.after-codepoint))))
|
|
98
98
|
|
|
99
|
-
(defun shen.decimalise (
|
|
99
|
+
(defun shen.decimalise (V1404) (shen.pre (reverse (shen.digits->integers V1404)) 0))
|
|
100
100
|
|
|
101
|
-
(defun shen.digits->integers (
|
|
101
|
+
(defun shen.digits->integers (V1409) (cond ((and (cons? V1409) (= "0" (hd V1409))) (cons 0 (shen.digits->integers (tl V1409)))) ((and (cons? V1409) (= "1" (hd V1409))) (cons 1 (shen.digits->integers (tl V1409)))) ((and (cons? V1409) (= "2" (hd V1409))) (cons 2 (shen.digits->integers (tl V1409)))) ((and (cons? V1409) (= "3" (hd V1409))) (cons 3 (shen.digits->integers (tl V1409)))) ((and (cons? V1409) (= "4" (hd V1409))) (cons 4 (shen.digits->integers (tl V1409)))) ((and (cons? V1409) (= "5" (hd V1409))) (cons 5 (shen.digits->integers (tl V1409)))) ((and (cons? V1409) (= "6" (hd V1409))) (cons 6 (shen.digits->integers (tl V1409)))) ((and (cons? V1409) (= "7" (hd V1409))) (cons 7 (shen.digits->integers (tl V1409)))) ((and (cons? V1409) (= "8" (hd V1409))) (cons 8 (shen.digits->integers (tl V1409)))) ((and (cons? V1409) (= "9" (hd V1409))) (cons 9 (shen.digits->integers (tl V1409)))) (true ())))
|
|
102
102
|
|
|
103
|
-
(defun shen.<sym> (
|
|
103
|
+
(defun shen.<sym> (V1414) (let Result (let Parse_shen.<alpha> (shen.<alpha> V1414) (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> (V1419) (let Result (let Parse_shen.<alphanum> (shen.<alphanum> V1419) (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> V1419) (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> (V1424) (let Result (let Parse_shen.<alpha> (shen.<alpha> V1424) (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> V1424) (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> (V1429) (let Result (if (cons? (hd V1429)) (let Parse_Byte (hd (hd V1429)) (if (shen.numbyte? Parse_Byte) (shen.pair (hd (shen.pair (tl (hd V1429)) (shen.hdtl V1429))) (n->string Parse_Byte)) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
110
110
|
|
|
111
|
-
(defun shen.numbyte? (
|
|
111
|
+
(defun shen.numbyte? (V1434) (cond ((= 48 V1434) true) ((= 49 V1434) true) ((= 50 V1434) true) ((= 51 V1434) true) ((= 52 V1434) true) ((= 53 V1434) true) ((= 54 V1434) true) ((= 55 V1434) true) ((= 56 V1434) true) ((= 57 V1434) true) (true false)))
|
|
112
112
|
|
|
113
|
-
(defun shen.<alpha> (
|
|
113
|
+
(defun shen.<alpha> (V1439) (let Result (if (cons? (hd V1439)) (let Parse_Byte (hd (hd V1439)) (if (shen.symbol-code? Parse_Byte) (shen.pair (hd (shen.pair (tl (hd V1439)) (shen.hdtl V1439))) (n->string Parse_Byte)) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
114
114
|
|
|
115
|
-
(defun shen.symbol-code? (
|
|
115
|
+
(defun shen.symbol-code? (V1440) (or (= V1440 126) (or (and (> V1440 94) (< V1440 123)) (or (and (> V1440 59) (< V1440 91)) (or (and (> V1440 41) (and (< V1440 58) (not (= V1440 44)))) (or (and (> V1440 34) (< V1440 40)) (= V1440 33)))))))
|
|
116
116
|
|
|
117
|
-
(defun shen.<str> (
|
|
117
|
+
(defun shen.<str> (V1445) (let Result (let Parse_shen.<dbq> (shen.<dbq> V1445) (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> (V1450) (let Result (if (cons? (hd V1450)) (let Parse_Byte (hd (hd V1450)) (if (= Parse_Byte 34) (shen.pair (hd (shen.pair (tl (hd V1450)) (shen.hdtl V1450))) Parse_Byte) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
120
120
|
|
|
121
|
-
(defun shen.<strcontents> (
|
|
121
|
+
(defun shen.<strcontents> (V1455) (let Result (let Parse_shen.<strc> (shen.<strc> V1455) (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> V1455) (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> (V1460) (let Result (if (cons? (hd V1460)) (let Parse_Byte (hd (hd V1460)) (shen.pair (hd (shen.pair (tl (hd V1460)) (shen.hdtl V1460))) (n->string Parse_Byte))) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
124
124
|
|
|
125
|
-
(defun shen.<strc> (
|
|
125
|
+
(defun shen.<strc> (V1465) (let Result (if (cons? (hd V1465)) (let Parse_Byte (hd (hd V1465)) (if (not (= Parse_Byte 34)) (shen.pair (hd (shen.pair (tl (hd V1465)) (shen.hdtl V1465))) (n->string Parse_Byte)) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
126
126
|
|
|
127
|
-
(defun shen.<number> (
|
|
127
|
+
(defun shen.<number> (V1470) (let Result (let Parse_shen.<minus> (shen.<minus> V1470) (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> V1470) (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> V1470) (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> V1470) (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> V1470) (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> V1470) (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.<E> (
|
|
129
|
+
(defun shen.<E> (V1475) (let Result (if (and (cons? (hd V1475)) (= 101 (hd (hd V1475)))) (shen.pair (hd (shen.pair (tl (hd V1475)) (shen.hdtl V1475))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
130
130
|
|
|
131
|
-
(defun shen.<log10> (
|
|
131
|
+
(defun shen.<log10> (V1480) (let Result (let Parse_shen.<minus> (shen.<minus> V1480) (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> V1480) (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.<plus> (
|
|
133
|
+
(defun shen.<plus> (V1485) (let Result (if (cons? (hd V1485)) (let Parse_Byte (hd (hd V1485)) (if (= Parse_Byte 43) (shen.pair (hd (shen.pair (tl (hd V1485)) (shen.hdtl V1485))) Parse_Byte) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
134
134
|
|
|
135
|
-
(defun shen.<stop> (
|
|
135
|
+
(defun shen.<stop> (V1490) (let Result (if (cons? (hd V1490)) (let Parse_Byte (hd (hd V1490)) (if (= Parse_Byte 46) (shen.pair (hd (shen.pair (tl (hd V1490)) (shen.hdtl V1490))) Parse_Byte) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
136
136
|
|
|
137
|
-
(defun shen.<predigits> (
|
|
137
|
+
(defun shen.<predigits> (V1495) (let Result (let Parse_shen.<digits> (shen.<digits> V1495) (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> V1495) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) ()) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
|
|
138
138
|
|
|
139
|
-
(defun shen.<postdigits> (
|
|
139
|
+
(defun shen.<postdigits> (V1500) (let Result (let Parse_shen.<digits> (shen.<digits> V1500) (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.<digits> (
|
|
141
|
+
(defun shen.<digits> (V1505) (let Result (let Parse_shen.<digit> (shen.<digit> V1505) (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> V1505) (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.<digit> (
|
|
143
|
+
(defun shen.<digit> (V1510) (let Result (if (cons? (hd V1510)) (let Parse_X (hd (hd V1510)) (if (shen.numbyte? Parse_X) (shen.pair (hd (shen.pair (tl (hd V1510)) (shen.hdtl V1510))) (shen.byte->digit Parse_X)) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
144
144
|
|
|
145
|
-
(defun shen.byte->digit (
|
|
145
|
+
(defun shen.byte->digit (V1511) (cond ((= 48 V1511) 0) ((= 49 V1511) 1) ((= 50 V1511) 2) ((= 51 V1511) 3) ((= 52 V1511) 4) ((= 53 V1511) 5) ((= 54 V1511) 6) ((= 55 V1511) 7) ((= 56 V1511) 8) ((= 57 V1511) 9) (true (shen.sys-error shen.byte->digit))))
|
|
146
146
|
|
|
147
|
-
(defun shen.pre (
|
|
147
|
+
(defun shen.pre (V1514 V1515) (cond ((= () V1514) 0) ((cons? V1514) (+ (* (shen.expt 10 V1515) (hd V1514)) (shen.pre (tl V1514) (+ V1515 1)))) (true (shen.sys-error shen.pre))))
|
|
148
148
|
|
|
149
|
-
(defun shen.post (
|
|
149
|
+
(defun shen.post (V1518 V1519) (cond ((= () V1518) 0) ((cons? V1518) (+ (* (shen.expt 10 (- 0 V1519)) (hd V1518)) (shen.post (tl V1518) (+ V1519 1)))) (true (shen.sys-error shen.post))))
|
|
150
150
|
|
|
151
|
-
(defun shen.expt (
|
|
151
|
+
(defun shen.expt (V1522 V1523) (cond ((= 0 V1523) 1) ((> V1523 0) (* V1522 (shen.expt V1522 (- V1523 1)))) (true (* 1 (/ (shen.expt V1522 (+ V1523 1)) V1522)))))
|
|
152
152
|
|
|
153
|
-
(defun shen.<st_input1> (
|
|
153
|
+
(defun shen.<st_input1> (V1528) (let Result (let Parse_shen.<st_input> (shen.<st_input> V1528) (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.<st_input2> (
|
|
155
|
+
(defun shen.<st_input2> (V1533) (let Result (let Parse_shen.<st_input> (shen.<st_input> V1533) (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.<comment> (
|
|
157
|
+
(defun shen.<comment> (V1538) (let Result (let Parse_shen.<singleline> (shen.<singleline> V1538) (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> V1538) (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.<singleline> (
|
|
159
|
+
(defun shen.<singleline> (V1543) (let Result (let Parse_shen.<backslash> (shen.<backslash> V1543) (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.<backslash> (
|
|
161
|
+
(defun shen.<backslash> (V1548) (let Result (if (and (cons? (hd V1548)) (= 92 (hd (hd V1548)))) (shen.pair (hd (shen.pair (tl (hd V1548)) (shen.hdtl V1548))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
162
162
|
|
|
163
|
-
(defun shen.<anysingle> (
|
|
163
|
+
(defun shen.<anysingle> (V1553) (let Result (let Parse_shen.<non-return> (shen.<non-return> V1553) (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> V1553) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) shen.skip) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
|
|
164
164
|
|
|
165
|
-
(defun shen.<non-return> (
|
|
165
|
+
(defun shen.<non-return> (V1558) (let Result (if (cons? (hd V1558)) (let Parse_X (hd (hd V1558)) (if (not (element? Parse_X (cons 10 (cons 13 ())))) (shen.pair (hd (shen.pair (tl (hd V1558)) (shen.hdtl V1558))) shen.skip) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
166
166
|
|
|
167
|
-
(defun shen.<return> (
|
|
167
|
+
(defun shen.<return> (V1563) (let Result (if (cons? (hd V1563)) (let Parse_X (hd (hd V1563)) (if (element? Parse_X (cons 10 (cons 13 ()))) (shen.pair (hd (shen.pair (tl (hd V1563)) (shen.hdtl V1563))) shen.skip) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
168
168
|
|
|
169
|
-
(defun shen.<multiline> (
|
|
169
|
+
(defun shen.<multiline> (V1568) (let Result (let Parse_shen.<backslash> (shen.<backslash> V1568) (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.<times> (
|
|
171
|
+
(defun shen.<times> (V1573) (let Result (if (and (cons? (hd V1573)) (= 42 (hd (hd V1573)))) (shen.pair (hd (shen.pair (tl (hd V1573)) (shen.hdtl V1573))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
172
172
|
|
|
173
|
-
(defun shen.<anymulti> (
|
|
173
|
+
(defun shen.<anymulti> (V1578) (let Result (let Parse_shen.<comment> (shen.<comment> V1578) (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> V1578) (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 V1578)) (let Parse_X (hd (hd V1578)) (let Parse_shen.<anymulti> (shen.<anymulti> (shen.pair (tl (hd V1578)) (shen.hdtl V1578))) (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.<whitespaces> (
|
|
175
|
+
(defun shen.<whitespaces> (V1583) (let Result (let Parse_shen.<whitespace> (shen.<whitespace> V1583) (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> V1583) (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.<whitespace> (
|
|
177
|
+
(defun shen.<whitespace> (V1588) (let Result (if (cons? (hd V1588)) (let Parse_X (hd (hd V1588)) (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 V1588)) (shen.hdtl V1588))) shen.skip) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
178
178
|
|
|
179
|
-
(defun shen.cons_form (
|
|
179
|
+
(defun shen.cons_form (V1589) (cond ((= () V1589) ()) ((and (cons? V1589) (and (cons? (tl V1589)) (and (cons? (tl (tl V1589))) (and (= () (tl (tl (tl V1589)))) (= (hd (tl V1589)) bar!))))) (cons cons (cons (hd V1589) (tl (tl V1589))))) ((cons? V1589) (cons cons (cons (hd V1589) (cons (shen.cons_form (tl V1589)) ())))) (true (shen.sys-error shen.cons_form))))
|
|
180
180
|
|
|
181
|
-
(defun shen.package-macro (
|
|
181
|
+
(defun shen.package-macro (V1592 V1593) (cond ((and (cons? V1592) (and (= $ (hd V1592)) (and (cons? (tl V1592)) (= () (tl (tl V1592)))))) (append (explode (hd (tl V1592))) V1593)) ((and (cons? V1592) (and (= package (hd V1592)) (and (cons? (tl V1592)) (and (= null (hd (tl V1592))) (cons? (tl (tl V1592))))))) (append (tl (tl (tl V1592))) V1593)) ((and (cons? V1592) (and (= package (hd V1592)) (and (cons? (tl V1592)) (cons? (tl (tl V1592)))))) (let ListofExceptions (shen.eval-without-macros (hd (tl (tl V1592)))) (let Record (shen.record-exceptions ListofExceptions (hd (tl V1592))) (let PackageNameDot (intern (cn (str (hd (tl V1592))) ".")) (append (shen.packageh PackageNameDot ListofExceptions (tl (tl (tl V1592)))) V1593))))) (true (cons V1592 V1593))))
|
|
182
182
|
|
|
183
|
-
(defun shen.record-exceptions (
|
|
183
|
+
(defun shen.record-exceptions (V1594 V1595) (let CurrExceptions (trap-error (get V1595 shen.external-symbols (value *property-vector*)) (lambda E ())) (let AllExceptions (union V1594 CurrExceptions) (put V1595 shen.external-symbols AllExceptions (value *property-vector*)))))
|
|
184
184
|
|
|
185
|
-
(defun shen.packageh (
|
|
185
|
+
(defun shen.packageh (V1604 V1605 V1606) (cond ((cons? V1606) (cons (shen.packageh V1604 V1605 (hd V1606)) (shen.packageh V1604 V1605 (tl V1606)))) ((or (shen.sysfunc? V1606) (or (variable? V1606) (or (element? V1606 V1605) (or (shen.doubleunderline? V1606) (shen.singleunderline? V1606))))) V1606) ((and (symbol? V1606) (not (shen.prefix? (cons "s" (cons "h" (cons "e" (cons "n" (cons "." ()))))) (explode V1606)))) (concat V1604 V1606)) (true V1606)))
|
|
186
186
|
|
|
187
|
-
(defun read-from-string (
|
|
187
|
+
(defun read-from-string (V1607) (let Ns (map (lambda V1307 (string->n V1307)) (explode V1607)) (compile shen.<st_input> Ns shen.read-error)))
|
|
188
188
|
|
|
189
189
|
|
|
190
190
|
|
|
@@ -47,114 +47,114 @@
|
|
|
47
47
|
* explains this license in full. *
|
|
48
48
|
* *
|
|
49
49
|
*****************************************************************************************
|
|
50
|
-
"(defun shen.datatype-error (
|
|
50
|
+
"(defun shen.datatype-error (V1612) (cond ((and (cons? V1612) (and (cons? (tl V1612)) (= () (tl (tl V1612))))) (simple-error (cn "datatype syntax error here:
|
|
51
51
|
|
|
52
|
-
" (shen.app (shen.next-50 50 (hd
|
|
52
|
+
" (shen.app (shen.next-50 50 (hd V1612)) "
|
|
53
53
|
" shen.a)))) (true (shen.sys-error shen.datatype-error))))
|
|
54
54
|
|
|
55
|
-
(defun shen.<datatype-rules> (
|
|
55
|
+
(defun shen.<datatype-rules> (V1617) (let Result (let Parse_shen.<datatype-rule> (shen.<datatype-rule> V1617) (if (not (= (fail) Parse_shen.<datatype-rule>)) (let Parse_shen.<datatype-rules> (shen.<datatype-rules> Parse_shen.<datatype-rule>) (if (not (= (fail) Parse_shen.<datatype-rules>)) (shen.pair (hd Parse_shen.<datatype-rules>) (cons (shen.hdtl Parse_shen.<datatype-rule>) (shen.hdtl Parse_shen.<datatype-rules>))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_<e> (<e> V1617) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) ()) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
|
|
56
56
|
|
|
57
|
-
(defun shen.<datatype-rule> (
|
|
57
|
+
(defun shen.<datatype-rule> (V1622) (let Result (let Parse_shen.<side-conditions> (shen.<side-conditions> V1622) (if (not (= (fail) Parse_shen.<side-conditions>)) (let Parse_shen.<premises> (shen.<premises> Parse_shen.<side-conditions>) (if (not (= (fail) Parse_shen.<premises>)) (let Parse_shen.<singleunderline> (shen.<singleunderline> Parse_shen.<premises>) (if (not (= (fail) Parse_shen.<singleunderline>)) (let Parse_shen.<conclusion> (shen.<conclusion> Parse_shen.<singleunderline>) (if (not (= (fail) Parse_shen.<conclusion>)) (shen.pair (hd Parse_shen.<conclusion>) (shen.sequent shen.single (cons (shen.hdtl Parse_shen.<side-conditions>) (cons (shen.hdtl Parse_shen.<premises>) (cons (shen.hdtl Parse_shen.<conclusion>) ()))))) (fail))) (fail))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<side-conditions> (shen.<side-conditions> V1622) (if (not (= (fail) Parse_shen.<side-conditions>)) (let Parse_shen.<premises> (shen.<premises> Parse_shen.<side-conditions>) (if (not (= (fail) Parse_shen.<premises>)) (let Parse_shen.<doubleunderline> (shen.<doubleunderline> Parse_shen.<premises>) (if (not (= (fail) Parse_shen.<doubleunderline>)) (let Parse_shen.<conclusion> (shen.<conclusion> Parse_shen.<doubleunderline>) (if (not (= (fail) Parse_shen.<conclusion>)) (shen.pair (hd Parse_shen.<conclusion>) (shen.sequent shen.double (cons (shen.hdtl Parse_shen.<side-conditions>) (cons (shen.hdtl Parse_shen.<premises>) (cons (shen.hdtl Parse_shen.<conclusion>) ()))))) (fail))) (fail))) (fail))) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
|
|
58
58
|
|
|
59
|
-
(defun shen.<side-conditions> (
|
|
59
|
+
(defun shen.<side-conditions> (V1627) (let Result (let Parse_shen.<side-condition> (shen.<side-condition> V1627) (if (not (= (fail) Parse_shen.<side-condition>)) (let Parse_shen.<side-conditions> (shen.<side-conditions> Parse_shen.<side-condition>) (if (not (= (fail) Parse_shen.<side-conditions>)) (shen.pair (hd Parse_shen.<side-conditions>) (cons (shen.hdtl Parse_shen.<side-condition>) (shen.hdtl Parse_shen.<side-conditions>))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_<e> (<e> V1627) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) ()) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
|
|
60
60
|
|
|
61
|
-
(defun shen.<side-condition> (
|
|
61
|
+
(defun shen.<side-condition> (V1632) (let Result (if (and (cons? (hd V1632)) (= if (hd (hd V1632)))) (let Parse_shen.<expr> (shen.<expr> (shen.pair (tl (hd V1632)) (shen.hdtl V1632))) (if (not (= (fail) Parse_shen.<expr>)) (shen.pair (hd Parse_shen.<expr>) (cons if (cons (shen.hdtl Parse_shen.<expr>) ()))) (fail))) (fail)) (if (= Result (fail)) (let Result (if (and (cons? (hd V1632)) (= let (hd (hd V1632)))) (let Parse_shen.<variable?> (shen.<variable?> (shen.pair (tl (hd V1632)) (shen.hdtl V1632))) (if (not (= (fail) Parse_shen.<variable?>)) (let Parse_shen.<expr> (shen.<expr> Parse_shen.<variable?>) (if (not (= (fail) Parse_shen.<expr>)) (shen.pair (hd Parse_shen.<expr>) (cons let (cons (shen.hdtl Parse_shen.<variable?>) (cons (shen.hdtl Parse_shen.<expr>) ())))) (fail))) (fail))) (fail)) (if (= Result (fail)) (fail) Result)) Result)))
|
|
62
62
|
|
|
63
|
-
(defun shen.<variable?> (
|
|
63
|
+
(defun shen.<variable?> (V1637) (let Result (if (cons? (hd V1637)) (let Parse_X (hd (hd V1637)) (if (variable? Parse_X) (shen.pair (hd (shen.pair (tl (hd V1637)) (shen.hdtl V1637))) Parse_X) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
64
64
|
|
|
65
|
-
(defun shen.<expr> (
|
|
65
|
+
(defun shen.<expr> (V1642) (let Result (if (cons? (hd V1642)) (let Parse_X (hd (hd V1642)) (if (not (or (element? Parse_X (cons >> (cons ; ()))) (or (shen.singleunderline? Parse_X) (shen.doubleunderline? Parse_X)))) (shen.pair (hd (shen.pair (tl (hd V1642)) (shen.hdtl V1642))) (shen.remove-bar Parse_X)) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
66
66
|
|
|
67
|
-
(defun shen.remove-bar (
|
|
67
|
+
(defun shen.remove-bar (V1643) (cond ((and (cons? V1643) (and (cons? (tl V1643)) (and (cons? (tl (tl V1643))) (and (= () (tl (tl (tl V1643)))) (= (hd (tl V1643)) bar!))))) (cons (hd V1643) (hd (tl (tl V1643))))) ((cons? V1643) (cons (shen.remove-bar (hd V1643)) (shen.remove-bar (tl V1643)))) (true V1643)))
|
|
68
68
|
|
|
69
|
-
(defun shen.<premises> (
|
|
69
|
+
(defun shen.<premises> (V1648) (let Result (let Parse_shen.<premise> (shen.<premise> V1648) (if (not (= (fail) Parse_shen.<premise>)) (let Parse_shen.<semicolon-symbol> (shen.<semicolon-symbol> Parse_shen.<premise>) (if (not (= (fail) Parse_shen.<semicolon-symbol>)) (let Parse_shen.<premises> (shen.<premises> Parse_shen.<semicolon-symbol>) (if (not (= (fail) Parse_shen.<premises>)) (shen.pair (hd Parse_shen.<premises>) (cons (shen.hdtl Parse_shen.<premise>) (shen.hdtl Parse_shen.<premises>))) (fail))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_<e> (<e> V1648) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) ()) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
|
|
70
70
|
|
|
71
|
-
(defun shen.<semicolon-symbol> (
|
|
71
|
+
(defun shen.<semicolon-symbol> (V1653) (let Result (if (cons? (hd V1653)) (let Parse_X (hd (hd V1653)) (if (= Parse_X ;) (shen.pair (hd (shen.pair (tl (hd V1653)) (shen.hdtl V1653))) shen.skip) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
72
72
|
|
|
73
|
-
(defun shen.<premise> (
|
|
73
|
+
(defun shen.<premise> (V1658) (let Result (if (and (cons? (hd V1658)) (= ! (hd (hd V1658)))) (shen.pair (hd (shen.pair (tl (hd V1658)) (shen.hdtl V1658))) !) (fail)) (if (= Result (fail)) (let Result (let Parse_shen.<formulae> (shen.<formulae> V1658) (if (not (= (fail) Parse_shen.<formulae>)) (if (and (cons? (hd Parse_shen.<formulae>)) (= >> (hd (hd Parse_shen.<formulae>)))) (let Parse_shen.<formula> (shen.<formula> (shen.pair (tl (hd Parse_shen.<formulae>)) (shen.hdtl Parse_shen.<formulae>))) (if (not (= (fail) Parse_shen.<formula>)) (shen.pair (hd Parse_shen.<formula>) (shen.sequent (shen.hdtl Parse_shen.<formulae>) (shen.hdtl Parse_shen.<formula>))) (fail))) (fail)) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<formula> (shen.<formula> V1658) (if (not (= (fail) Parse_shen.<formula>)) (shen.pair (hd Parse_shen.<formula>) (shen.sequent () (shen.hdtl Parse_shen.<formula>))) (fail))) (if (= Result (fail)) (fail) Result)) Result)) Result)))
|
|
74
74
|
|
|
75
|
-
(defun shen.<conclusion> (
|
|
75
|
+
(defun shen.<conclusion> (V1663) (let Result (let Parse_shen.<formulae> (shen.<formulae> V1663) (if (not (= (fail) Parse_shen.<formulae>)) (if (and (cons? (hd Parse_shen.<formulae>)) (= >> (hd (hd Parse_shen.<formulae>)))) (let Parse_shen.<formula> (shen.<formula> (shen.pair (tl (hd Parse_shen.<formulae>)) (shen.hdtl Parse_shen.<formulae>))) (if (not (= (fail) Parse_shen.<formula>)) (let Parse_shen.<semicolon-symbol> (shen.<semicolon-symbol> Parse_shen.<formula>) (if (not (= (fail) Parse_shen.<semicolon-symbol>)) (shen.pair (hd Parse_shen.<semicolon-symbol>) (shen.sequent (shen.hdtl Parse_shen.<formulae>) (shen.hdtl Parse_shen.<formula>))) (fail))) (fail))) (fail)) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<formula> (shen.<formula> V1663) (if (not (= (fail) Parse_shen.<formula>)) (let Parse_shen.<semicolon-symbol> (shen.<semicolon-symbol> Parse_shen.<formula>) (if (not (= (fail) Parse_shen.<semicolon-symbol>)) (shen.pair (hd Parse_shen.<semicolon-symbol>) (shen.sequent () (shen.hdtl Parse_shen.<formula>))) (fail))) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
|
|
76
76
|
|
|
77
|
-
(defun shen.sequent (
|
|
77
|
+
(defun shen.sequent (V1664 V1665) (@p V1664 V1665))
|
|
78
78
|
|
|
79
|
-
(defun shen.<formulae> (
|
|
79
|
+
(defun shen.<formulae> (V1670) (let Result (let Parse_shen.<formula> (shen.<formula> V1670) (if (not (= (fail) Parse_shen.<formula>)) (let Parse_shen.<comma-symbol> (shen.<comma-symbol> Parse_shen.<formula>) (if (not (= (fail) Parse_shen.<comma-symbol>)) (let Parse_shen.<formulae> (shen.<formulae> Parse_shen.<comma-symbol>) (if (not (= (fail) Parse_shen.<formulae>)) (shen.pair (hd Parse_shen.<formulae>) (cons (shen.hdtl Parse_shen.<formula>) (shen.hdtl Parse_shen.<formulae>))) (fail))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<formula> (shen.<formula> V1670) (if (not (= (fail) Parse_shen.<formula>)) (shen.pair (hd Parse_shen.<formula>) (cons (shen.hdtl Parse_shen.<formula>) ())) (fail))) (if (= Result (fail)) (let Result (let Parse_<e> (<e> V1670) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) ()) (fail))) (if (= Result (fail)) (fail) Result)) Result)) Result)))
|
|
80
80
|
|
|
81
|
-
(defun shen.<comma-symbol> (
|
|
81
|
+
(defun shen.<comma-symbol> (V1675) (let Result (if (cons? (hd V1675)) (let Parse_X (hd (hd V1675)) (if (= Parse_X (intern ",")) (shen.pair (hd (shen.pair (tl (hd V1675)) (shen.hdtl V1675))) shen.skip) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
82
82
|
|
|
83
|
-
(defun shen.<formula> (
|
|
83
|
+
(defun shen.<formula> (V1680) (let Result (let Parse_shen.<expr> (shen.<expr> V1680) (if (not (= (fail) Parse_shen.<expr>)) (if (and (cons? (hd Parse_shen.<expr>)) (= : (hd (hd Parse_shen.<expr>)))) (let Parse_shen.<type> (shen.<type> (shen.pair (tl (hd Parse_shen.<expr>)) (shen.hdtl Parse_shen.<expr>))) (if (not (= (fail) Parse_shen.<type>)) (shen.pair (hd Parse_shen.<type>) (cons (shen.curry (shen.hdtl Parse_shen.<expr>)) (cons : (cons (shen.demodulate (shen.hdtl Parse_shen.<type>)) ())))) (fail))) (fail)) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<expr> (shen.<expr> V1680) (if (not (= (fail) Parse_shen.<expr>)) (shen.pair (hd Parse_shen.<expr>) (shen.hdtl Parse_shen.<expr>)) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
|
|
84
84
|
|
|
85
|
-
(defun shen.<type> (
|
|
85
|
+
(defun shen.<type> (V1685) (let Result (let Parse_shen.<expr> (shen.<expr> V1685) (if (not (= (fail) Parse_shen.<expr>)) (shen.pair (hd Parse_shen.<expr>) (shen.curry-type (shen.hdtl Parse_shen.<expr>))) (fail))) (if (= Result (fail)) (fail) Result)))
|
|
86
86
|
|
|
87
|
-
(defun shen.<doubleunderline> (
|
|
87
|
+
(defun shen.<doubleunderline> (V1690) (let Result (if (cons? (hd V1690)) (let Parse_X (hd (hd V1690)) (if (shen.doubleunderline? Parse_X) (shen.pair (hd (shen.pair (tl (hd V1690)) (shen.hdtl V1690))) Parse_X) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
88
88
|
|
|
89
|
-
(defun shen.<singleunderline> (
|
|
89
|
+
(defun shen.<singleunderline> (V1695) (let Result (if (cons? (hd V1695)) (let Parse_X (hd (hd V1695)) (if (shen.singleunderline? Parse_X) (shen.pair (hd (shen.pair (tl (hd V1695)) (shen.hdtl V1695))) Parse_X) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
90
90
|
|
|
91
|
-
(defun shen.singleunderline? (
|
|
91
|
+
(defun shen.singleunderline? (V1696) (and (symbol? V1696) (shen.sh? (str V1696))))
|
|
92
92
|
|
|
93
|
-
(defun shen.sh? (
|
|
93
|
+
(defun shen.sh? (V1697) (cond ((= "_" V1697) true) (true (and (= (pos V1697 0) "_") (shen.sh? (tlstr V1697))))))
|
|
94
94
|
|
|
95
|
-
(defun shen.doubleunderline? (
|
|
95
|
+
(defun shen.doubleunderline? (V1698) (and (symbol? V1698) (shen.dh? (str V1698))))
|
|
96
96
|
|
|
97
|
-
(defun shen.dh? (
|
|
97
|
+
(defun shen.dh? (V1699) (cond ((= "=" V1699) true) (true (and (= (pos V1699 0) "=") (shen.dh? (tlstr V1699))))))
|
|
98
98
|
|
|
99
|
-
(defun shen.process-datatype (
|
|
99
|
+
(defun shen.process-datatype (V1700 V1701) (shen.remember-datatype (shen.s-prolog (shen.rules->horn-clauses V1700 V1701))))
|
|
100
100
|
|
|
101
|
-
(defun shen.remember-datatype (
|
|
101
|
+
(defun shen.remember-datatype (V1706) (cond ((cons? V1706) (do (set shen.*datatypes* (adjoin (hd V1706) (value shen.*datatypes*))) (do (set shen.*alldatatypes* (adjoin (hd V1706) (value shen.*alldatatypes*))) (hd V1706)))) (true (shen.sys-error shen.remember-datatype))))
|
|
102
102
|
|
|
103
|
-
(defun shen.rules->horn-clauses (
|
|
103
|
+
(defun shen.rules->horn-clauses (V1709 V1710) (cond ((= () V1710) ()) ((and (cons? V1710) (and (tuple? (hd V1710)) (= shen.single (fst (hd V1710))))) (cons (shen.rule->horn-clause V1709 (snd (hd V1710))) (shen.rules->horn-clauses V1709 (tl V1710)))) ((and (cons? V1710) (and (tuple? (hd V1710)) (= shen.double (fst (hd V1710))))) (shen.rules->horn-clauses V1709 (append (shen.double->singles (snd (hd V1710))) (tl V1710)))) (true (shen.sys-error shen.rules->horn-clauses))))
|
|
104
104
|
|
|
105
|
-
(defun shen.double->singles (
|
|
105
|
+
(defun shen.double->singles (V1711) (cons (shen.right-rule V1711) (cons (shen.left-rule V1711) ())))
|
|
106
106
|
|
|
107
|
-
(defun shen.right-rule (
|
|
107
|
+
(defun shen.right-rule (V1712) (@p shen.single V1712))
|
|
108
108
|
|
|
109
|
-
(defun shen.left-rule (
|
|
109
|
+
(defun shen.left-rule (V1713) (cond ((and (cons? V1713) (and (cons? (tl V1713)) (and (cons? (tl (tl V1713))) (and (tuple? (hd (tl (tl V1713)))) (and (= () (fst (hd (tl (tl V1713))))) (= () (tl (tl (tl V1713))))))))) (let Q (gensym Qv) (let NewConclusion (@p (cons (snd (hd (tl (tl V1713)))) ()) Q) (let NewPremises (cons (@p (map shen.right->left (hd (tl V1713))) Q) ()) (@p shen.single (cons (hd V1713) (cons NewPremises (cons NewConclusion ())))))))) (true (shen.sys-error shen.left-rule))))
|
|
110
110
|
|
|
111
|
-
(defun shen.right->left (
|
|
111
|
+
(defun shen.right->left (V1718) (cond ((and (tuple? V1718) (= () (fst V1718))) (snd V1718)) (true (simple-error "syntax error with ==========
|
|
112
112
|
"))))
|
|
113
113
|
|
|
114
|
-
(defun shen.rule->horn-clause (
|
|
114
|
+
(defun shen.rule->horn-clause (V1719 V1720) (cond ((and (cons? V1720) (and (cons? (tl V1720)) (and (cons? (tl (tl V1720))) (and (tuple? (hd (tl (tl V1720)))) (= () (tl (tl (tl V1720)))))))) (cons (shen.rule->horn-clause-head V1719 (snd (hd (tl (tl V1720))))) (cons :- (cons (shen.rule->horn-clause-body (hd V1720) (hd (tl V1720)) (fst (hd (tl (tl V1720))))) ())))) (true (shen.sys-error shen.rule->horn-clause))))
|
|
115
115
|
|
|
116
|
-
(defun shen.rule->horn-clause-head (
|
|
116
|
+
(defun shen.rule->horn-clause-head (V1721 V1722) (cons V1721 (cons (shen.mode-ify V1722) (cons Context_1957 ()))))
|
|
117
117
|
|
|
118
|
-
(defun shen.mode-ify (
|
|
118
|
+
(defun shen.mode-ify (V1723) (cond ((and (cons? V1723) (and (cons? (tl V1723)) (and (= : (hd (tl V1723))) (and (cons? (tl (tl V1723))) (= () (tl (tl (tl V1723)))))))) (cons mode (cons (cons (hd V1723) (cons : (cons (cons mode (cons (hd (tl (tl V1723))) (cons + ()))) ()))) (cons - ())))) (true V1723)))
|
|
119
119
|
|
|
120
|
-
(defun shen.rule->horn-clause-body (
|
|
120
|
+
(defun shen.rule->horn-clause-body (V1724 V1725 V1726) (let Variables (map shen.extract_vars V1726) (let Predicates (map (lambda X (gensym shen.cl)) V1726) (let SearchLiterals (shen.construct-search-literals Predicates Variables Context_1957 Context1_1957) (let SearchClauses (shen.construct-search-clauses Predicates V1726 Variables) (let SideLiterals (shen.construct-side-literals V1724) (let PremissLiterals (map (lambda X (shen.construct-premiss-literal X (empty? V1726))) V1725) (append SearchLiterals (append SideLiterals PremissLiterals)))))))))
|
|
121
121
|
|
|
122
|
-
(defun shen.construct-search-literals (
|
|
122
|
+
(defun shen.construct-search-literals (V1731 V1732 V1733 V1734) (cond ((and (= () V1731) (= () V1732)) ()) (true (shen.csl-help V1731 V1732 V1733 V1734))))
|
|
123
123
|
|
|
124
|
-
(defun shen.csl-help (
|
|
124
|
+
(defun shen.csl-help (V1737 V1738 V1739 V1740) (cond ((and (= () V1737) (= () V1738)) (cons (cons bind (cons ContextOut_1957 (cons V1739 ()))) ())) ((and (cons? V1737) (cons? V1738)) (cons (cons (hd V1737) (cons V1739 (cons V1740 (hd V1738)))) (shen.csl-help (tl V1737) (tl V1738) V1740 (gensym Context)))) (true (shen.sys-error shen.csl-help))))
|
|
125
125
|
|
|
126
|
-
(defun shen.construct-search-clauses (
|
|
126
|
+
(defun shen.construct-search-clauses (V1741 V1742 V1743) (cond ((and (= () V1741) (and (= () V1742) (= () V1743))) shen.skip) ((and (cons? V1741) (and (cons? V1742) (cons? V1743))) (do (shen.construct-search-clause (hd V1741) (hd V1742) (hd V1743)) (shen.construct-search-clauses (tl V1741) (tl V1742) (tl V1743)))) (true (shen.sys-error shen.construct-search-clauses))))
|
|
127
127
|
|
|
128
|
-
(defun shen.construct-search-clause (
|
|
128
|
+
(defun shen.construct-search-clause (V1744 V1745 V1746) (shen.s-prolog (cons (shen.construct-base-search-clause V1744 V1745 V1746) (cons (shen.construct-recursive-search-clause V1744 V1745 V1746) ()))))
|
|
129
129
|
|
|
130
|
-
(defun shen.construct-base-search-clause (
|
|
130
|
+
(defun shen.construct-base-search-clause (V1747 V1748 V1749) (cons (cons V1747 (cons (cons (shen.mode-ify V1748) In_1957) (cons In_1957 V1749))) (cons :- (cons () ()))))
|
|
131
131
|
|
|
132
|
-
(defun shen.construct-recursive-search-clause (
|
|
132
|
+
(defun shen.construct-recursive-search-clause (V1750 V1751 V1752) (cons (cons V1750 (cons (cons Assumption_1957 Assumptions_1957) (cons (cons Assumption_1957 Out_1957) V1752))) (cons :- (cons (cons (cons V1750 (cons Assumptions_1957 (cons Out_1957 V1752))) ()) ()))))
|
|
133
133
|
|
|
134
|
-
(defun shen.construct-side-literals (
|
|
134
|
+
(defun shen.construct-side-literals (V1757) (cond ((= () V1757) ()) ((and (cons? V1757) (and (cons? (hd V1757)) (and (= if (hd (hd V1757))) (and (cons? (tl (hd V1757))) (= () (tl (tl (hd V1757)))))))) (cons (cons when (tl (hd V1757))) (shen.construct-side-literals (tl V1757)))) ((and (cons? V1757) (and (cons? (hd V1757)) (and (= let (hd (hd V1757))) (and (cons? (tl (hd V1757))) (and (cons? (tl (tl (hd V1757)))) (= () (tl (tl (tl (hd V1757)))))))))) (cons (cons is (tl (hd V1757))) (shen.construct-side-literals (tl V1757)))) ((cons? V1757) (shen.construct-side-literals (tl V1757))) (true (shen.sys-error shen.construct-side-literals))))
|
|
135
135
|
|
|
136
|
-
(defun shen.construct-premiss-literal (
|
|
136
|
+
(defun shen.construct-premiss-literal (V1762 V1763) (cond ((tuple? V1762) (cons shen.t* (cons (shen.recursive_cons_form (snd V1762)) (cons (shen.construct-context V1763 (fst V1762)) ())))) ((= ! V1762) (cons cut (cons Throwcontrol ()))) (true (shen.sys-error shen.construct-premiss-literal))))
|
|
137
137
|
|
|
138
|
-
(defun shen.construct-context (
|
|
138
|
+
(defun shen.construct-context (V1764 V1765) (cond ((and (= true V1764) (= () V1765)) Context_1957) ((and (= false V1764) (= () V1765)) ContextOut_1957) ((cons? V1765) (cons cons (cons (shen.recursive_cons_form (hd V1765)) (cons (shen.construct-context V1764 (tl V1765)) ())))) (true (shen.sys-error shen.construct-context))))
|
|
139
139
|
|
|
140
|
-
(defun shen.recursive_cons_form (
|
|
140
|
+
(defun shen.recursive_cons_form (V1766) (cond ((cons? V1766) (cons cons (cons (shen.recursive_cons_form (hd V1766)) (cons (shen.recursive_cons_form (tl V1766)) ())))) (true V1766)))
|
|
141
141
|
|
|
142
|
-
(defun preclude (
|
|
142
|
+
(defun preclude (V1767) (shen.preclude-h (map shen.intern-type V1767)))
|
|
143
143
|
|
|
144
|
-
(defun shen.preclude-h (
|
|
144
|
+
(defun shen.preclude-h (V1768) (let FilterDatatypes (set shen.*datatypes* (difference (value shen.*datatypes*) V1768)) (value shen.*datatypes*)))
|
|
145
145
|
|
|
146
|
-
(defun include (
|
|
146
|
+
(defun include (V1769) (shen.include-h (map shen.intern-type V1769)))
|
|
147
147
|
|
|
148
|
-
(defun shen.include-h (
|
|
148
|
+
(defun shen.include-h (V1770) (let ValidTypes (intersection V1770 (value shen.*alldatatypes*)) (let NewDatatypes (set shen.*datatypes* (union ValidTypes (value shen.*datatypes*))) (value shen.*datatypes*))))
|
|
149
149
|
|
|
150
|
-
(defun preclude-all-but (
|
|
150
|
+
(defun preclude-all-but (V1771) (shen.preclude-h (difference (value shen.*alldatatypes*) (map shen.intern-type V1771))))
|
|
151
151
|
|
|
152
|
-
(defun include-all-but (
|
|
152
|
+
(defun include-all-but (V1772) (shen.include-h (difference (value shen.*alldatatypes*) (map shen.intern-type V1772))))
|
|
153
153
|
|
|
154
|
-
(defun shen.synonyms-help (
|
|
154
|
+
(defun shen.synonyms-help (V1777) (cond ((= () V1777) synonyms) ((and (cons? V1777) (cons? (tl V1777))) (do (shen.pushnew (cons (hd V1777) (shen.curry-type (hd (tl V1777)))) shen.*synonyms*) (shen.synonyms-help (tl (tl V1777))))) (true (simple-error (cn "odd number of synonyms
|
|
155
155
|
" "")))))
|
|
156
156
|
|
|
157
|
-
(defun shen.pushnew (
|
|
157
|
+
(defun shen.pushnew (V1778 V1779) (if (element? V1778 (value V1779)) (value V1779) (set V1779 (cons V1778 (value V1779)))))
|
|
158
158
|
|
|
159
159
|
|
|
160
160
|
|
|
@@ -47,198 +47,200 @@
|
|
|
47
47
|
* explains this license in full. *
|
|
48
48
|
* *
|
|
49
49
|
*****************************************************************************************
|
|
50
|
-
"(defun thaw (
|
|
50
|
+
"(defun thaw (V1782) (V1782))
|
|
51
51
|
|
|
52
|
-
(defun eval (
|
|
52
|
+
(defun eval (V1783) (let Macroexpand (shen.walk (lambda V1780 (macroexpand V1780)) V1783) (if (shen.packaged? Macroexpand) (map shen.eval-without-macros (shen.package-contents Macroexpand)) (shen.eval-without-macros Macroexpand))))
|
|
53
53
|
|
|
54
|
-
(defun shen.eval-without-macros (
|
|
54
|
+
(defun shen.eval-without-macros (V1784) (eval-kl (shen.elim-def (shen.proc-input+ V1784))))
|
|
55
55
|
|
|
56
|
-
(defun shen.proc-input+ (
|
|
56
|
+
(defun shen.proc-input+ (V1785) (cond ((and (cons? V1785) (and (= input+ (hd V1785)) (and (cons? (tl V1785)) (and (cons? (tl (tl V1785))) (= () (tl (tl (tl V1785)))))))) (cons input+ (cons (hd (tl V1785)) (cons (shen.rcons_form (hd (tl (tl V1785)))) ())))) ((and (cons? V1785) (and (= read+ (hd V1785)) (and (cons? (tl V1785)) (and (cons? (tl (tl V1785))) (= () (tl (tl (tl V1785)))))))) (cons read+ (cons (hd (tl V1785)) (cons (shen.rcons_form (hd (tl (tl V1785)))) ())))) ((cons? V1785) (map shen.proc-input+ V1785)) (true V1785)))
|
|
57
57
|
|
|
58
|
-
(defun shen.elim-
|
|
58
|
+
(defun shen.elim-def (V1786) (cond ((and (cons? V1786) (and (= define (hd V1786)) (cons? (tl V1786)))) (shen.shen->kl (hd (tl V1786)) (tl (tl V1786)))) ((and (cons? V1786) (and (= defmacro (hd V1786)) (cons? (tl V1786)))) (let Default (cons X (cons -> (cons X ()))) (let Def (shen.elim-def (cons define (cons (hd (tl V1786)) (append (tl (tl V1786)) Default)))) (let MacroAdd (shen.add-macro (hd (tl V1786))) Def)))) ((and (cons? V1786) (and (= defcc (hd V1786)) (cons? (tl V1786)))) (shen.elim-def (shen.yacc V1786))) ((cons? V1786) (map shen.elim-def V1786)) (true V1786)))
|
|
59
59
|
|
|
60
|
-
(defun shen.
|
|
60
|
+
(defun shen.add-macro (V1787) (set *macros* (adjoin V1787 (value *macros*))))
|
|
61
61
|
|
|
62
|
-
(defun
|
|
62
|
+
(defun shen.packaged? (V1794) (cond ((and (cons? V1794) (and (= package (hd V1794)) (and (cons? (tl V1794)) (cons? (tl (tl V1794)))))) true) (true false)))
|
|
63
|
+
|
|
64
|
+
(defun external (V1795) (trap-error (get V1795 shen.external-symbols (value *property-vector*)) (lambda E (simple-error (cn "package " (shen.app V1795 " has not been used.
|
|
63
65
|
" shen.a))))))
|
|
64
66
|
|
|
65
|
-
(defun shen.package-contents (
|
|
67
|
+
(defun shen.package-contents (V1798) (cond ((and (cons? V1798) (and (= package (hd V1798)) (and (cons? (tl V1798)) (and (= null (hd (tl V1798))) (cons? (tl (tl V1798))))))) (tl (tl (tl V1798)))) ((and (cons? V1798) (and (= package (hd V1798)) (and (cons? (tl V1798)) (cons? (tl (tl V1798)))))) (shen.packageh (hd (tl V1798)) (hd (tl (tl V1798))) (tl (tl (tl V1798))))) (true (shen.sys-error shen.package-contents))))
|
|
66
68
|
|
|
67
|
-
(defun shen.walk (
|
|
69
|
+
(defun shen.walk (V1799 V1800) (cond ((cons? V1800) (V1799 (map (lambda Z (shen.walk V1799 Z)) V1800))) (true (V1799 V1800))))
|
|
68
70
|
|
|
69
|
-
(defun compile (
|
|
71
|
+
(defun compile (V1801 V1802 V1803) (let O (V1801 (cons V1802 (cons () ()))) (if (or (= (fail) O) (not (empty? (hd O)))) (V1803 O) (shen.hdtl O))))
|
|
70
72
|
|
|
71
|
-
(defun fail-if (
|
|
73
|
+
(defun fail-if (V1804 V1805) (if (V1804 V1805) (fail) V1805))
|
|
72
74
|
|
|
73
|
-
(defun @s (
|
|
75
|
+
(defun @s (V1806 V1807) (cn V1806 V1807))
|
|
74
76
|
|
|
75
|
-
(defun tc? (
|
|
77
|
+
(defun tc? () (value shen.*tc*))
|
|
76
78
|
|
|
77
|
-
(defun ps (
|
|
79
|
+
(defun ps (V1808) (trap-error (get V1808 shen.source (value *property-vector*)) (lambda E (simple-error (shen.app V1808 " not found.
|
|
78
80
|
" shen.a)))))
|
|
79
81
|
|
|
80
82
|
(defun stinput () (value *stinput*))
|
|
81
83
|
|
|
82
|
-
(defun shen.+vector? (
|
|
84
|
+
(defun shen.+vector? (V1809) (and (absvector? V1809) (> (<-address V1809 0) 0)))
|
|
83
85
|
|
|
84
|
-
(defun vector (
|
|
86
|
+
(defun vector (V1810) (let Vector (absvector (+ V1810 1)) (let ZeroStamp (address-> Vector 0 V1810) (let Standard (if (= V1810 0) ZeroStamp (shen.fillvector ZeroStamp 1 V1810 (fail))) Standard))))
|
|
85
87
|
|
|
86
|
-
(defun shen.fillvector (
|
|
88
|
+
(defun shen.fillvector (V1811 V1812 V1813 V1814) (cond ((= V1813 V1812) (address-> V1811 V1813 V1814)) (true (shen.fillvector (address-> V1811 V1812 V1814) (+ 1 V1812) V1813 V1814))))
|
|
87
89
|
|
|
88
|
-
(defun vector? (
|
|
90
|
+
(defun vector? (V1816) (and (absvector? V1816) (trap-error (>= (<-address V1816 0) 0) (lambda E false))))
|
|
89
91
|
|
|
90
|
-
(defun vector-> (
|
|
91
|
-
") (address->
|
|
92
|
+
(defun vector-> (V1817 V1818 V1819) (if (= V1818 0) (simple-error "cannot access 0th element of a vector
|
|
93
|
+
") (address-> V1817 V1818 V1819)))
|
|
92
94
|
|
|
93
|
-
(defun <-vector (
|
|
94
|
-
") (let VectorElement (<-address
|
|
95
|
+
(defun <-vector (V1820 V1821) (if (= V1821 0) (simple-error "cannot access 0th element of a vector
|
|
96
|
+
") (let VectorElement (<-address V1820 V1821) (if (= VectorElement (fail)) (simple-error "vector element not found
|
|
95
97
|
") VectorElement))))
|
|
96
98
|
|
|
97
|
-
(defun shen.posint? (
|
|
99
|
+
(defun shen.posint? (V1822) (and (integer? V1822) (>= V1822 0)))
|
|
98
100
|
|
|
99
|
-
(defun limit (
|
|
101
|
+
(defun limit (V1823) (<-address V1823 0))
|
|
100
102
|
|
|
101
|
-
(defun symbol? (
|
|
103
|
+
(defun symbol? (V1824) (cond ((or (boolean? V1824) (or (number? V1824) (string? V1824))) false) (true (trap-error (let String (str V1824) (shen.analyse-symbol? String)) (lambda E false)))))
|
|
102
104
|
|
|
103
|
-
(defun shen.analyse-symbol? (
|
|
105
|
+
(defun shen.analyse-symbol? (V1825) (cond ((shen.+string? V1825) (and (shen.alpha? (pos V1825 0)) (shen.alphanums? (tlstr V1825)))) (true (shen.sys-error shen.analyse-symbol?))))
|
|
104
106
|
|
|
105
|
-
(defun shen.alpha? (
|
|
107
|
+
(defun shen.alpha? (V1826) (element? V1826 (cons "A" (cons "B" (cons "C" (cons "D" (cons "E" (cons "F" (cons "G" (cons "H" (cons "I" (cons "J" (cons "K" (cons "L" (cons "M" (cons "N" (cons "O" (cons "P" (cons "Q" (cons "R" (cons "S" (cons "T" (cons "U" (cons "V" (cons "W" (cons "X" (cons "Y" (cons "Z" (cons "a" (cons "b" (cons "c" (cons "d" (cons "e" (cons "f" (cons "g" (cons "h" (cons "i" (cons "j" (cons "k" (cons "l" (cons "m" (cons "n" (cons "o" (cons "p" (cons "q" (cons "r" (cons "s" (cons "t" (cons "u" (cons "v" (cons "w" (cons "x" (cons "y" (cons "z" (cons "=" (cons "*" (cons "/" (cons "+" (cons "-" (cons "_" (cons "?" (cons "$" (cons "!" (cons "@" (cons "~" (cons ">" (cons "<" (cons "&" (cons "%" (cons "{" (cons "}" (cons ":" (cons ";" (cons "`" (cons "#" (cons "'" (cons "." ())))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
|
|
106
108
|
|
|
107
|
-
(defun shen.alphanums? (
|
|
109
|
+
(defun shen.alphanums? (V1827) (cond ((= "" V1827) true) ((shen.+string? V1827) (and (shen.alphanum? (pos V1827 0)) (shen.alphanums? (tlstr V1827)))) (true (shen.sys-error shen.alphanums?))))
|
|
108
110
|
|
|
109
|
-
(defun shen.alphanum? (
|
|
111
|
+
(defun shen.alphanum? (V1828) (or (shen.alpha? V1828) (shen.digit? V1828)))
|
|
110
112
|
|
|
111
|
-
(defun shen.digit? (
|
|
113
|
+
(defun shen.digit? (V1829) (element? V1829 (cons "1" (cons "2" (cons "3" (cons "4" (cons "5" (cons "6" (cons "7" (cons "8" (cons "9" (cons "0" ()))))))))))))
|
|
112
114
|
|
|
113
|
-
(defun variable? (
|
|
115
|
+
(defun variable? (V1830) (cond ((or (boolean? V1830) (or (number? V1830) (string? V1830))) false) (true (trap-error (let String (str V1830) (shen.analyse-variable? String)) (lambda E false)))))
|
|
114
116
|
|
|
115
|
-
(defun shen.analyse-variable? (
|
|
117
|
+
(defun shen.analyse-variable? (V1831) (cond ((shen.+string? V1831) (and (shen.uppercase? (pos V1831 0)) (shen.alphanums? (tlstr V1831)))) (true (shen.sys-error shen.analyse-variable?))))
|
|
116
118
|
|
|
117
|
-
(defun shen.uppercase? (
|
|
119
|
+
(defun shen.uppercase? (V1832) (element? V1832 (cons "A" (cons "B" (cons "C" (cons "D" (cons "E" (cons "F" (cons "G" (cons "H" (cons "I" (cons "J" (cons "K" (cons "L" (cons "M" (cons "N" (cons "O" (cons "P" (cons "Q" (cons "R" (cons "S" (cons "T" (cons "U" (cons "V" (cons "W" (cons "X" (cons "Y" (cons "Z" ()))))))))))))))))))))))))))))
|
|
118
120
|
|
|
119
|
-
(defun gensym (
|
|
121
|
+
(defun gensym (V1833) (concat V1833 (set shen.*gensym* (+ 1 (value shen.*gensym*)))))
|
|
120
122
|
|
|
121
|
-
(defun concat (
|
|
123
|
+
(defun concat (V1834 V1835) (intern (cn (str V1834) (str V1835))))
|
|
122
124
|
|
|
123
|
-
(defun @p (
|
|
125
|
+
(defun @p (V1836 V1837) (let Vector (absvector 3) (let Tag (address-> Vector 0 shen.tuple) (let Fst (address-> Vector 1 V1836) (let Snd (address-> Vector 2 V1837) Vector)))))
|
|
124
126
|
|
|
125
|
-
(defun fst (
|
|
127
|
+
(defun fst (V1838) (<-address V1838 1))
|
|
126
128
|
|
|
127
|
-
(defun snd (
|
|
129
|
+
(defun snd (V1839) (<-address V1839 2))
|
|
128
130
|
|
|
129
|
-
(defun tuple? (
|
|
131
|
+
(defun tuple? (V1840) (trap-error (and (absvector? V1840) (= shen.tuple (<-address V1840 0))) (lambda E false)))
|
|
130
132
|
|
|
131
|
-
(defun append (
|
|
133
|
+
(defun append (V1841 V1842) (cond ((= () V1841) V1842) ((cons? V1841) (cons (hd V1841) (append (tl V1841) V1842))) (true (shen.sys-error append))))
|
|
132
134
|
|
|
133
|
-
(defun @v (
|
|
135
|
+
(defun @v (V1843 V1844) (let Limit (limit V1844) (let NewVector (vector (+ Limit 1)) (let X+NewVector (vector-> NewVector 1 V1843) (if (= Limit 0) X+NewVector (shen.@v-help V1844 1 Limit X+NewVector))))))
|
|
134
136
|
|
|
135
|
-
(defun shen.@v-help (
|
|
137
|
+
(defun shen.@v-help (V1845 V1846 V1847 V1848) (cond ((= V1847 V1846) (shen.copyfromvector V1845 V1848 V1847 (+ V1847 1))) (true (shen.@v-help V1845 (+ V1846 1) V1847 (shen.copyfromvector V1845 V1848 V1846 (+ V1846 1))))))
|
|
136
138
|
|
|
137
|
-
(defun shen.copyfromvector (
|
|
139
|
+
(defun shen.copyfromvector (V1850 V1851 V1852 V1853) (trap-error (vector-> V1851 V1853 (<-vector V1850 V1852)) (lambda E V1851)))
|
|
138
140
|
|
|
139
|
-
(defun hdv (
|
|
141
|
+
(defun hdv (V1854) (trap-error (<-vector V1854 1) (lambda E (simple-error (cn "hdv needs a non-empty vector as an argument; not " (shen.app V1854 "
|
|
140
142
|
" shen.s))))))
|
|
141
143
|
|
|
142
|
-
(defun tlv (
|
|
143
|
-
") (if (= Limit 1) (vector 0) (let NewVector (vector (- Limit 1)) (shen.tlv-help
|
|
144
|
+
(defun tlv (V1855) (let Limit (limit V1855) (if (= Limit 0) (simple-error "cannot take the tail of the empty vector
|
|
145
|
+
") (if (= Limit 1) (vector 0) (let NewVector (vector (- Limit 1)) (shen.tlv-help V1855 2 Limit (vector (- Limit 1))))))))
|
|
144
146
|
|
|
145
|
-
(defun shen.tlv-help (
|
|
147
|
+
(defun shen.tlv-help (V1856 V1857 V1858 V1859) (cond ((= V1858 V1857) (shen.copyfromvector V1856 V1859 V1858 (- V1858 1))) (true (shen.tlv-help V1856 (+ V1857 1) V1858 (shen.copyfromvector V1856 V1859 V1857 (- V1857 1))))))
|
|
146
148
|
|
|
147
|
-
(defun assoc (
|
|
149
|
+
(defun assoc (V1869 V1870) (cond ((= () V1870) ()) ((and (cons? V1870) (and (cons? (hd V1870)) (= (hd (hd V1870)) V1869))) (hd V1870)) ((cons? V1870) (assoc V1869 (tl V1870))) (true (shen.sys-error assoc))))
|
|
148
150
|
|
|
149
|
-
(defun boolean? (
|
|
151
|
+
(defun boolean? (V1876) (cond ((= true V1876) true) ((= false V1876) true) (true false)))
|
|
150
152
|
|
|
151
|
-
(defun nl (
|
|
152
|
-
" (stoutput)) (nl (-
|
|
153
|
+
(defun nl (V1877) (cond ((= 0 V1877) 0) (true (do (shen.prhush "
|
|
154
|
+
" (stoutput)) (nl (- V1877 1))))))
|
|
153
155
|
|
|
154
|
-
(defun difference (
|
|
156
|
+
(defun difference (V1880 V1881) (cond ((= () V1880) ()) ((cons? V1880) (if (element? (hd V1880) V1881) (difference (tl V1880) V1881) (cons (hd V1880) (difference (tl V1880) V1881)))) (true (shen.sys-error difference))))
|
|
155
157
|
|
|
156
|
-
(defun do (
|
|
158
|
+
(defun do (V1882 V1883) V1883)
|
|
157
159
|
|
|
158
|
-
(defun element? (
|
|
160
|
+
(defun element? (V1892 V1893) (cond ((= () V1893) false) ((and (cons? V1893) (= (hd V1893) V1892)) true) ((cons? V1893) (element? V1892 (tl V1893))) (true (shen.sys-error element?))))
|
|
159
161
|
|
|
160
|
-
(defun empty? (
|
|
162
|
+
(defun empty? (V1899) (cond ((= () V1899) true) (true false)))
|
|
161
163
|
|
|
162
|
-
(defun fix (
|
|
164
|
+
(defun fix (V1900 V1901) (shen.fix-help V1900 V1901 (V1900 V1901)))
|
|
163
165
|
|
|
164
|
-
(defun shen.fix-help (
|
|
166
|
+
(defun shen.fix-help (V1908 V1909 V1910) (cond ((= V1910 V1909) V1910) (true (shen.fix-help V1908 V1910 (V1908 V1910)))))
|
|
165
167
|
|
|
166
|
-
(defun put (
|
|
168
|
+
(defun put (V1912 V1913 V1914 V1915) (let N (hash V1912 (limit V1915)) (let Entry (trap-error (<-vector V1915 N) (lambda E ())) (let Change (vector-> V1915 N (shen.change-pointer-value V1912 V1913 V1914 Entry)) V1914))))
|
|
167
169
|
|
|
168
|
-
(defun shen.change-pointer-value (
|
|
170
|
+
(defun shen.change-pointer-value (V1918 V1919 V1920 V1921) (cond ((= () V1921) (cons (cons (cons V1918 (cons V1919 ())) V1920) ())) ((and (cons? V1921) (and (cons? (hd V1921)) (and (cons? (hd (hd V1921))) (and (cons? (tl (hd (hd V1921)))) (and (= () (tl (tl (hd (hd V1921))))) (and (= (hd (tl (hd (hd V1921)))) V1919) (= (hd (hd (hd V1921))) V1918))))))) (cons (cons (hd (hd V1921)) V1920) (tl V1921))) ((cons? V1921) (cons (hd V1921) (shen.change-pointer-value V1918 V1919 V1920 (tl V1921)))) (true (shen.sys-error shen.change-pointer-value))))
|
|
169
171
|
|
|
170
|
-
(defun get (
|
|
171
|
-
"))) (let Result (assoc (cons
|
|
172
|
+
(defun get (V1924 V1925 V1926) (let N (hash V1924 (limit V1926)) (let Entry (trap-error (<-vector V1926 N) (lambda E (simple-error "pointer not found
|
|
173
|
+
"))) (let Result (assoc (cons V1924 (cons V1925 ())) Entry) (if (empty? Result) (simple-error "value not found
|
|
172
174
|
") (tl Result))))))
|
|
173
175
|
|
|
174
|
-
(defun hash (
|
|
176
|
+
(defun hash (V1927 V1928) (let Hash (shen.mod (shen.sum (map (lambda V1781 (string->n V1781)) (explode V1927))) V1928) (if (= 0 Hash) 1 Hash)))
|
|
175
177
|
|
|
176
|
-
(defun shen.mod (
|
|
178
|
+
(defun shen.mod (V1929 V1930) (shen.modh V1929 (shen.multiples V1929 (cons V1930 ()))))
|
|
177
179
|
|
|
178
|
-
(defun shen.multiples (
|
|
180
|
+
(defun shen.multiples (V1931 V1932) (cond ((and (cons? V1932) (> (hd V1932) V1931)) (tl V1932)) ((cons? V1932) (shen.multiples V1931 (cons (* 2 (hd V1932)) V1932))) (true (shen.sys-error shen.multiples))))
|
|
179
181
|
|
|
180
|
-
(defun shen.modh (
|
|
182
|
+
(defun shen.modh (V1935 V1936) (cond ((= 0 V1935) 0) ((= () V1936) V1935) ((and (cons? V1936) (> (hd V1936) V1935)) (if (empty? (tl V1936)) V1935 (shen.modh V1935 (tl V1936)))) ((cons? V1936) (shen.modh (- V1935 (hd V1936)) V1936)) (true (shen.sys-error shen.modh))))
|
|
181
183
|
|
|
182
|
-
(defun shen.sum (
|
|
184
|
+
(defun shen.sum (V1937) (cond ((= () V1937) 0) ((cons? V1937) (+ (hd V1937) (shen.sum (tl V1937)))) (true (shen.sys-error shen.sum))))
|
|
183
185
|
|
|
184
|
-
(defun head (
|
|
186
|
+
(defun head (V1944) (cond ((cons? V1944) (hd V1944)) (true (simple-error "head expects a non-empty list"))))
|
|
185
187
|
|
|
186
|
-
(defun tail (
|
|
188
|
+
(defun tail (V1951) (cond ((cons? V1951) (tl V1951)) (true (simple-error "tail expects a non-empty list"))))
|
|
187
189
|
|
|
188
|
-
(defun hdstr (
|
|
190
|
+
(defun hdstr (V1952) (pos V1952 0))
|
|
189
191
|
|
|
190
|
-
(defun intersection (
|
|
192
|
+
(defun intersection (V1955 V1956) (cond ((= () V1955) ()) ((cons? V1955) (if (element? (hd V1955) V1956) (cons (hd V1955) (intersection (tl V1955) V1956)) (intersection (tl V1955) V1956))) (true (shen.sys-error intersection))))
|
|
191
193
|
|
|
192
|
-
(defun reverse (
|
|
194
|
+
(defun reverse (V1957) (shen.reverse_help V1957 ()))
|
|
193
195
|
|
|
194
|
-
(defun shen.reverse_help (
|
|
196
|
+
(defun shen.reverse_help (V1958 V1959) (cond ((= () V1958) V1959) ((cons? V1958) (shen.reverse_help (tl V1958) (cons (hd V1958) V1959))) (true (shen.sys-error shen.reverse_help))))
|
|
195
197
|
|
|
196
|
-
(defun union (
|
|
198
|
+
(defun union (V1960 V1961) (cond ((= () V1960) V1961) ((cons? V1960) (if (element? (hd V1960) V1961) (union (tl V1960) V1961) (cons (hd V1960) (union (tl V1960) V1961)))) (true (shen.sys-error union))))
|
|
197
199
|
|
|
198
|
-
(defun y-or-n? (
|
|
199
|
-
" (stoutput)) (y-or-n?
|
|
200
|
+
(defun y-or-n? (V1962) (let Message (shen.prhush (shen.proc-nl V1962) (stoutput)) (let Y-or-N (shen.prhush " (y/n) " (stoutput)) (let Input (shen.app (input) "" shen.s) (if (= "y" Input) true (if (= "n" Input) false (do (shen.prhush "please answer y or n
|
|
201
|
+
" (stoutput)) (y-or-n? V1962))))))))
|
|
200
202
|
|
|
201
|
-
(defun not (
|
|
203
|
+
(defun not (V1963) (if V1963 false true))
|
|
202
204
|
|
|
203
|
-
(defun subst (
|
|
205
|
+
(defun subst (V1972 V1973 V1974) (cond ((= V1974 V1973) V1972) ((cons? V1974) (cons (subst V1972 V1973 (hd V1974)) (subst V1972 V1973 (tl V1974)))) (true V1974)))
|
|
204
206
|
|
|
205
|
-
(defun explode (
|
|
207
|
+
(defun explode (V1976) (shen.explode-h (shen.app V1976 "" shen.a)))
|
|
206
208
|
|
|
207
|
-
(defun shen.explode-h (
|
|
209
|
+
(defun shen.explode-h (V1977) (cond ((= "" V1977) ()) ((shen.+string? V1977) (cons (pos V1977 0) (shen.explode-h (tlstr V1977)))) (true (shen.sys-error shen.explode-h))))
|
|
208
210
|
|
|
209
|
-
(defun cd (
|
|
211
|
+
(defun cd (V1978) (set *home-directory* (if (= V1978 "") "" (shen.app V1978 "/" shen.a))))
|
|
210
212
|
|
|
211
|
-
(defun map (
|
|
213
|
+
(defun map (V1979 V1980) (shen.map-h V1979 V1980 ()))
|
|
212
214
|
|
|
213
|
-
(defun shen.map-h (
|
|
215
|
+
(defun shen.map-h (V1983 V1984 V1985) (cond ((= () V1984) (reverse V1985)) ((cons? V1984) (shen.map-h V1983 (tl V1984) (cons (V1983 (hd V1984)) V1985))) (true (shen.sys-error shen.map-h))))
|
|
214
216
|
|
|
215
|
-
(defun length (
|
|
217
|
+
(defun length (V1986) (shen.length-h V1986 0))
|
|
216
218
|
|
|
217
|
-
(defun shen.length-h (
|
|
219
|
+
(defun shen.length-h (V1987 V1988) (cond ((= () V1987) V1988) (true (shen.length-h (tl V1987) (+ V1988 1)))))
|
|
218
220
|
|
|
219
|
-
(defun occurrences (
|
|
221
|
+
(defun occurrences (V1997 V1998) (cond ((= V1998 V1997) 1) ((cons? V1998) (+ (occurrences V1997 (hd V1998)) (occurrences V1997 (tl V1998)))) (true 0)))
|
|
220
222
|
|
|
221
|
-
(defun nth (
|
|
223
|
+
(defun nth (V2006 V2007) (cond ((and (= 1 V2006) (cons? V2007)) (hd V2007)) ((cons? V2007) (nth (- V2006 1) (tl V2007))) (true (shen.sys-error nth))))
|
|
222
224
|
|
|
223
|
-
(defun integer? (
|
|
225
|
+
(defun integer? (V2008) (and (number? V2008) (let Abs (shen.abs V2008) (shen.integer-test? Abs (shen.magless Abs 1)))))
|
|
224
226
|
|
|
225
|
-
(defun shen.abs (
|
|
227
|
+
(defun shen.abs (V2009) (if (> V2009 0) V2009 (- 0 V2009)))
|
|
226
228
|
|
|
227
|
-
(defun shen.magless (
|
|
229
|
+
(defun shen.magless (V2010 V2011) (let Nx2 (* V2011 2) (if (> Nx2 V2010) V2011 (shen.magless V2010 Nx2))))
|
|
228
230
|
|
|
229
|
-
(defun shen.integer-test? (
|
|
231
|
+
(defun shen.integer-test? (V2015 V2016) (cond ((= 0 V2015) true) ((> 1 V2015) false) (true (let Abs-N (- V2015 V2016) (if (> 0 Abs-N) (integer? V2015) (shen.integer-test? Abs-N V2016))))))
|
|
230
232
|
|
|
231
|
-
(defun mapcan (
|
|
233
|
+
(defun mapcan (V2019 V2020) (cond ((= () V2020) ()) ((cons? V2020) (append (V2019 (hd V2020)) (mapcan V2019 (tl V2020)))) (true (shen.sys-error mapcan))))
|
|
232
234
|
|
|
233
|
-
(defun read-file-as-bytelist (
|
|
235
|
+
(defun read-file-as-bytelist (V2021) (let Stream (open file V2021 in) (let Byte (read-byte Stream) (let Bytes (shen.read-file-as-bytelist-help Stream Byte ()) (let Close (close Stream) (reverse Bytes))))))
|
|
234
236
|
|
|
235
|
-
(defun shen.read-file-as-bytelist-help (
|
|
237
|
+
(defun shen.read-file-as-bytelist-help (V2022 V2023 V2024) (cond ((= -1 V2023) V2024) (true (shen.read-file-as-bytelist-help V2022 (read-byte V2022) (cons V2023 V2024)))))
|
|
236
238
|
|
|
237
|
-
(defun read-file-as-string (
|
|
239
|
+
(defun read-file-as-string (V2025) (let Stream (open file V2025 in) (shen.rfas-h Stream (read-byte Stream) "")))
|
|
238
240
|
|
|
239
|
-
(defun shen.rfas-h (
|
|
241
|
+
(defun shen.rfas-h (V2026 V2027 V2028) (cond ((= -1 V2027) (do (close V2026) V2028)) (true (shen.rfas-h V2026 (read-byte V2026) (cn V2028 (n->string V2027))))))
|
|
240
242
|
|
|
241
|
-
(defun == (
|
|
243
|
+
(defun == (V2037 V2038) (cond ((= V2038 V2037) true) (true false)))
|
|
242
244
|
|
|
243
245
|
(defun abort () (simple-error ""))
|
|
244
246
|
|
|
@@ -246,25 +248,25 @@
|
|
|
246
248
|
|
|
247
249
|
(defun input () (eval (read)))
|
|
248
250
|
|
|
249
|
-
(defun input+ (
|
|
251
|
+
(defun input+ (V2044 V2045) (let Input (read) (let Check (shen.typecheck Input V2045) (if (= false Check) (do (shen.prhush (cn "input is not of type " (shen.app V2045 ": please re-enter " shen.r)) (stoutput)) (input+ : V2045)) (eval Input)))))
|
|
250
252
|
|
|
251
|
-
(defun read+ (
|
|
253
|
+
(defun read+ (V2050 V2051) (let Input (read) (let Check (shen.typecheck (shen.rcons_form Input) V2051) (if (= false Check) (do (shen.prhush (cn "input is not of type " (shen.app V2051 ": please re-enter " shen.r)) (stoutput)) (read+ : V2051)) Input))))
|
|
252
254
|
|
|
253
|
-
(defun bound? (
|
|
255
|
+
(defun bound? (V2052) (and (symbol? V2052) (let Val (trap-error (value V2052) (lambda E shen.this-symbol-is-unbound)) (if (= Val shen.this-symbol-is-unbound) false true))))
|
|
254
256
|
|
|
255
|
-
(defun shen.string->bytes (
|
|
257
|
+
(defun shen.string->bytes (V2053) (cond ((= "" V2053) ()) (true (cons (string->n (pos V2053 0)) (shen.string->bytes (tlstr V2053))))))
|
|
256
258
|
|
|
257
|
-
(defun maxinferences (
|
|
259
|
+
(defun maxinferences (V2054) (set shen.*maxinferences* V2054))
|
|
258
260
|
|
|
259
261
|
(defun inferences () (value shen.*infs*))
|
|
260
262
|
|
|
261
|
-
(defun protect (
|
|
263
|
+
(defun protect (V2055) V2055)
|
|
262
264
|
|
|
263
265
|
(defun stoutput () (value *stoutput*))
|
|
264
266
|
|
|
265
|
-
(defun string->symbol (
|
|
267
|
+
(defun string->symbol (V2056) (let Symbol (intern V2056) (if (symbol? Symbol) Symbol (simple-error (cn "cannot intern " (shen.app V2056 " to a symbol" shen.s))))))
|
|
266
268
|
|
|
267
|
-
(defun shen.optimise (
|
|
269
|
+
(defun shen.optimise (V2061) (cond ((= + V2061) (set shen.*optimise* true)) ((= - V2061) (set shen.*optimise* false)) (true (simple-error "optimise expects a + or a -.
|
|
268
270
|
"))))
|
|
269
271
|
|
|
270
272
|
|