shen-ruby 0.7.0 → 0.8.0
Sign up to get free protection for your applications and to get access to all the features.
- data/HISTORY.md +7 -0
- data/README.md +7 -7
- data/lib/shen_ruby/version.rb +1 -1
- data/shen-ruby.gemspec +1 -1
- data/shen/README.txt +1 -1
- data/shen/release/k_lambda/declarations.kl +5 -3
- data/shen/release/k_lambda/load.kl +1 -1
- data/shen/release/k_lambda/macros.kl +23 -21
- data/shen/release/k_lambda/prolog.kl +97 -97
- data/shen/release/k_lambda/reader.kl +79 -79
- data/shen/release/k_lambda/sequent.kl +53 -53
- data/shen/release/k_lambda/sys.kl +112 -98
- data/shen/release/k_lambda/t-star.kl +50 -48
- data/shen/release/k_lambda/toplevel.kl +21 -25
- data/shen/release/k_lambda/track.kl +25 -25
- data/shen/release/k_lambda/types.kl +21 -9
- data/shen/release/k_lambda/writer.kl +25 -25
- data/shen/release/k_lambda/yacc.kl +26 -32
- data/shen/release/test_programs/strings.shen +1 -2
- metadata +12 -8
- checksums.yaml +0 -7
@@ -47,166 +47,166 @@
|
|
47
47
|
* explains this license in full. *
|
48
48
|
* *
|
49
49
|
*****************************************************************************************
|
50
|
-
"(defun read-file-as-bytelist (
|
50
|
+
"(defun read-file-as-bytelist (V1314) (let Stream (open V1314 in) (let Byte (read-byte Stream) (let Bytes (shen.read-file-as-bytelist-help Stream Byte ()) (let Close (close Stream) (reverse Bytes))))))
|
51
51
|
|
52
|
-
(defun shen.read-file-as-bytelist-help (
|
52
|
+
(defun shen.read-file-as-bytelist-help (V1315 V1316 V1317) (cond ((= -1 V1316) V1317) (true (shen.read-file-as-bytelist-help V1315 (read-byte V1315) (cons V1316 V1317)))))
|
53
53
|
|
54
|
-
(defun read-file-as-string (
|
54
|
+
(defun read-file-as-string (V1318) (let Stream (open V1318 in) (shen.rfas-h Stream (read-byte Stream) "")))
|
55
55
|
|
56
|
-
(defun shen.rfas-h (
|
56
|
+
(defun shen.rfas-h (V1319 V1320 V1321) (cond ((= -1 V1320) (do (close V1319) V1321)) (true (shen.rfas-h V1319 (read-byte V1319) (cn V1321 (n->string V1320))))))
|
57
57
|
|
58
|
-
(defun input (
|
58
|
+
(defun input (V1322) (eval-kl (read V1322)))
|
59
59
|
|
60
|
-
(defun input+ (
|
60
|
+
(defun input+ (V1323 V1324) (let Mono? (shen.monotype V1323) (let Input (read V1324) (if (= false (shen.typecheck Input V1323)) (simple-error (cn "type error: " (shen.app Input (cn " is not of type " (shen.app V1323 "
|
61
61
|
" shen.r)) shen.r))) (eval-kl Input)))))
|
62
62
|
|
63
|
-
(defun shen.monotype (
|
64
|
-
" shen.a)))
|
63
|
+
(defun shen.monotype (V1325) (cond ((cons? V1325) (map shen.monotype V1325)) (true (if (variable? V1325) (simple-error (cn "input+ expects a monotype: not " (shen.app V1325 "
|
64
|
+
" shen.a))) V1325))))
|
65
65
|
|
66
|
-
(defun read (
|
66
|
+
(defun read (V1326) (hd (shen.read-loop V1326 (read-byte V1326) ())))
|
67
67
|
|
68
|
-
(defun shen.read-loop (
|
68
|
+
(defun shen.read-loop (V1329 V1330 V1331) (cond ((= -1 V1330) (if (empty? V1331) (simple-error "error: empty stream") (compile shen.<st_input> V1331 (lambda E E)))) ((shen.terminator? V1330) (let AllBytes (append V1331 (cons V1330 ())) (let Read (compile shen.<st_input> AllBytes (lambda E shen.nextbyte)) (if (or (= Read shen.nextbyte) (empty? Read)) (shen.read-loop V1329 (read-byte V1329) AllBytes) Read)))) (true (shen.read-loop V1329 (read-byte V1329) (append V1331 (cons V1330 ()))))))
|
69
69
|
|
70
|
-
(defun shen.terminator? (
|
70
|
+
(defun shen.terminator? (V1332) (element? V1332 (cons 9 (cons 10 (cons 13 (cons 32 (cons 34 (cons 41 (cons 93 ())))))))))
|
71
71
|
|
72
|
-
(defun lineread (
|
72
|
+
(defun lineread (V1333) (shen.lineread-loop (read-byte V1333) () V1333))
|
73
73
|
|
74
|
-
(defun shen.lineread-loop (
|
74
|
+
(defun shen.lineread-loop (V1335 V1336 V1337) (cond ((= -1 V1335) (if (empty? V1336) (simple-error "empty stream") (compile shen.<st_input> V1336 (lambda E E)))) ((= V1335 (shen.hat)) (simple-error "line read aborted")) ((element? V1335 (cons (shen.newline) (cons (shen.carriage-return) ()))) (let Line (compile shen.<st_input> V1336 (lambda E shen.nextline)) (if (or (= Line shen.nextline) (empty? Line)) (shen.lineread-loop (read-byte V1337) (append V1336 (cons V1335 ())) V1337) Line))) (true (shen.lineread-loop (read-byte V1337) (append V1336 (cons V1335 ())) V1337))))
|
75
75
|
|
76
|
-
(defun read-file (
|
76
|
+
(defun read-file (V1338) (let Bytelist (read-file-as-bytelist V1338) (compile shen.<st_input> Bytelist shen.read-error)))
|
77
77
|
|
78
|
-
(defun read-from-string (
|
78
|
+
(defun read-from-string (V1339) (let Ns (map (lambda V1313 (string->n V1313)) (explode V1339)) (compile shen.<st_input> Ns shen.read-error)))
|
79
79
|
|
80
|
-
(defun shen.read-error (
|
80
|
+
(defun shen.read-error (V1346) (cond ((and (cons? V1346) (and (cons? (hd V1346)) (and (cons? (tl V1346)) (= () (tl (tl V1346)))))) (simple-error (cn "read error here:
|
81
81
|
|
82
|
-
" (shen.app (shen.compress-50 50 (hd
|
82
|
+
" (shen.app (shen.compress-50 50 (hd V1346)) "
|
83
83
|
" shen.a)))) (true (simple-error "read error
|
84
84
|
"))))
|
85
85
|
|
86
|
-
(defun shen.compress-50 (
|
86
|
+
(defun shen.compress-50 (V1351 V1352) (cond ((= () V1352) "") ((= 0 V1351) "") ((cons? V1352) (cn (n->string (hd V1352)) (shen.compress-50 (- V1351 1) (tl V1352)))) (true (shen.sys-error shen.compress-50))))
|
87
87
|
|
88
|
-
(defun shen.<st_input> (
|
88
|
+
(defun shen.<st_input> (V1357) (let Result (let Parse_shen.<lsb> (shen.<lsb> V1357) (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> V1357) (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> V1357) (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> V1357) (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> V1357) (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> V1357) (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> V1357) (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> V1357) (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> V1357) (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> V1357) (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> V1357) (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> V1357) (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> V1357) (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> V1357) (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)))
|
89
89
|
|
90
|
-
(defun shen.<lsb> (
|
90
|
+
(defun shen.<lsb> (V1362) (let Result (if (and (cons? (hd V1362)) (= 91 (hd (hd V1362)))) (shen.pair (hd (shen.pair (tl (hd V1362)) (shen.hdtl V1362))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
|
91
91
|
|
92
|
-
(defun shen.<rsb> (
|
92
|
+
(defun shen.<rsb> (V1367) (let Result (if (and (cons? (hd V1367)) (= 93 (hd (hd V1367)))) (shen.pair (hd (shen.pair (tl (hd V1367)) (shen.hdtl V1367))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
|
93
93
|
|
94
|
-
(defun shen.<lcurly> (
|
94
|
+
(defun shen.<lcurly> (V1372) (let Result (if (and (cons? (hd V1372)) (= 123 (hd (hd V1372)))) (shen.pair (hd (shen.pair (tl (hd V1372)) (shen.hdtl V1372))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
|
95
95
|
|
96
|
-
(defun shen.<rcurly> (
|
96
|
+
(defun shen.<rcurly> (V1377) (let Result (if (and (cons? (hd V1377)) (= 125 (hd (hd V1377)))) (shen.pair (hd (shen.pair (tl (hd V1377)) (shen.hdtl V1377))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
|
97
97
|
|
98
|
-
(defun shen.<bar> (
|
98
|
+
(defun shen.<bar> (V1382) (let Result (if (and (cons? (hd V1382)) (= 124 (hd (hd V1382)))) (shen.pair (hd (shen.pair (tl (hd V1382)) (shen.hdtl V1382))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
|
99
99
|
|
100
|
-
(defun shen.<semicolon> (
|
100
|
+
(defun shen.<semicolon> (V1387) (let Result (if (and (cons? (hd V1387)) (= 59 (hd (hd V1387)))) (shen.pair (hd (shen.pair (tl (hd V1387)) (shen.hdtl V1387))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
|
101
101
|
|
102
|
-
(defun shen.<colon> (
|
102
|
+
(defun shen.<colon> (V1392) (let Result (if (and (cons? (hd V1392)) (= 58 (hd (hd V1392)))) (shen.pair (hd (shen.pair (tl (hd V1392)) (shen.hdtl V1392))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
|
103
103
|
|
104
|
-
(defun shen.<comma> (
|
104
|
+
(defun shen.<comma> (V1397) (let Result (if (and (cons? (hd V1397)) (= 44 (hd (hd V1397)))) (shen.pair (hd (shen.pair (tl (hd V1397)) (shen.hdtl V1397))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
|
105
105
|
|
106
|
-
(defun shen.<equal> (
|
106
|
+
(defun shen.<equal> (V1402) (let Result (if (and (cons? (hd V1402)) (= 61 (hd (hd V1402)))) (shen.pair (hd (shen.pair (tl (hd V1402)) (shen.hdtl V1402))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
|
107
107
|
|
108
|
-
(defun shen.<minus> (
|
108
|
+
(defun shen.<minus> (V1407) (let Result (if (and (cons? (hd V1407)) (= 45 (hd (hd V1407)))) (shen.pair (hd (shen.pair (tl (hd V1407)) (shen.hdtl V1407))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
|
109
109
|
|
110
|
-
(defun shen.<lrb> (
|
110
|
+
(defun shen.<lrb> (V1412) (let Result (if (and (cons? (hd V1412)) (= 40 (hd (hd V1412)))) (shen.pair (hd (shen.pair (tl (hd V1412)) (shen.hdtl V1412))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
|
111
111
|
|
112
|
-
(defun shen.<rrb> (
|
112
|
+
(defun shen.<rrb> (V1417) (let Result (if (and (cons? (hd V1417)) (= 41 (hd (hd V1417)))) (shen.pair (hd (shen.pair (tl (hd V1417)) (shen.hdtl V1417))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
|
113
113
|
|
114
|
-
(defun shen.<atom> (
|
114
|
+
(defun shen.<atom> (V1422) (let Result (let Parse_shen.<str> (shen.<str> V1422) (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> V1422) (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> V1422) (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)))
|
115
115
|
|
116
|
-
(defun shen.control-chars (
|
116
|
+
(defun shen.control-chars (V1423) (cond ((= () V1423) "") ((and (cons? V1423) (and (= "c" (hd V1423)) (and (cons? (tl V1423)) (= "#" (hd (tl V1423)))))) (let CodePoint (shen.code-point (tl (tl V1423))) (let AfterCodePoint (shen.after-codepoint (tl (tl V1423))) (@s (n->string (shen.decimalise CodePoint)) (shen.control-chars AfterCodePoint))))) ((cons? V1423) (@s (hd V1423) (shen.control-chars (tl V1423)))) (true (shen.sys-error shen.control-chars))))
|
117
117
|
|
118
|
-
(defun shen.code-point (
|
118
|
+
(defun shen.code-point (V1426) (cond ((and (cons? V1426) (= ";" (hd V1426))) "") ((and (cons? V1426) (element? (hd V1426) (cons "0" (cons "1" (cons "2" (cons "3" (cons "4" (cons "5" (cons "6" (cons "7" (cons "8" (cons "9" (cons "0" ()))))))))))))) (cons (hd V1426) (shen.code-point (tl V1426)))) (true (simple-error (cn "code point parse error " (shen.app V1426 "
|
119
119
|
" shen.a))))))
|
120
120
|
|
121
|
-
(defun shen.after-codepoint (
|
121
|
+
(defun shen.after-codepoint (V1431) (cond ((= () V1431) ()) ((and (cons? V1431) (= ";" (hd V1431))) (tl V1431)) ((cons? V1431) (shen.after-codepoint (tl V1431))) (true (shen.sys-error shen.after-codepoint))))
|
122
122
|
|
123
|
-
(defun shen.decimalise (
|
123
|
+
(defun shen.decimalise (V1432) (shen.pre (reverse (shen.digits->integers V1432)) 0))
|
124
124
|
|
125
|
-
(defun shen.digits->integers (
|
125
|
+
(defun shen.digits->integers (V1437) (cond ((and (cons? V1437) (= "0" (hd V1437))) (cons 0 (shen.digits->integers (tl V1437)))) ((and (cons? V1437) (= "1" (hd V1437))) (cons 1 (shen.digits->integers (tl V1437)))) ((and (cons? V1437) (= "2" (hd V1437))) (cons 2 (shen.digits->integers (tl V1437)))) ((and (cons? V1437) (= "3" (hd V1437))) (cons 3 (shen.digits->integers (tl V1437)))) ((and (cons? V1437) (= "4" (hd V1437))) (cons 4 (shen.digits->integers (tl V1437)))) ((and (cons? V1437) (= "5" (hd V1437))) (cons 5 (shen.digits->integers (tl V1437)))) ((and (cons? V1437) (= "6" (hd V1437))) (cons 6 (shen.digits->integers (tl V1437)))) ((and (cons? V1437) (= "7" (hd V1437))) (cons 7 (shen.digits->integers (tl V1437)))) ((and (cons? V1437) (= "8" (hd V1437))) (cons 8 (shen.digits->integers (tl V1437)))) ((and (cons? V1437) (= "9" (hd V1437))) (cons 9 (shen.digits->integers (tl V1437)))) (true ())))
|
126
126
|
|
127
|
-
(defun shen.<sym> (
|
127
|
+
(defun shen.<sym> (V1442) (let Result (let Parse_shen.<alpha> (shen.<alpha> V1442) (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)))
|
128
128
|
|
129
|
-
(defun shen.<alphanums> (
|
129
|
+
(defun shen.<alphanums> (V1447) (let Result (let Parse_shen.<alphanum> (shen.<alphanum> V1447) (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> V1447) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) "") (fail))) (if (= Result (fail)) (fail) Result)) Result)))
|
130
130
|
|
131
|
-
(defun shen.<alphanum> (
|
131
|
+
(defun shen.<alphanum> (V1452) (let Result (let Parse_shen.<alpha> (shen.<alpha> V1452) (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> V1452) (if (not (= (fail) Parse_shen.<num>)) (shen.pair (hd Parse_shen.<num>) (shen.hdtl Parse_shen.<num>)) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
|
132
132
|
|
133
|
-
(defun shen.<num> (
|
133
|
+
(defun shen.<num> (V1457) (let Result (if (cons? (hd V1457)) (let Parse_Byte (hd (hd V1457)) (if (shen.numbyte? Parse_Byte) (shen.pair (hd (shen.pair (tl (hd V1457)) (shen.hdtl V1457))) (n->string Parse_Byte)) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
|
134
134
|
|
135
|
-
(defun shen.numbyte? (
|
135
|
+
(defun shen.numbyte? (V1462) (cond ((= 48 V1462) true) ((= 49 V1462) true) ((= 50 V1462) true) ((= 51 V1462) true) ((= 52 V1462) true) ((= 53 V1462) true) ((= 54 V1462) true) ((= 55 V1462) true) ((= 56 V1462) true) ((= 57 V1462) true) (true false)))
|
136
136
|
|
137
|
-
(defun shen.<alpha> (
|
137
|
+
(defun shen.<alpha> (V1467) (let Result (if (cons? (hd V1467)) (let Parse_Byte (hd (hd V1467)) (if (shen.symbol-code? Parse_Byte) (shen.pair (hd (shen.pair (tl (hd V1467)) (shen.hdtl V1467))) (n->string Parse_Byte)) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
|
138
138
|
|
139
|
-
(defun shen.symbol-code? (
|
139
|
+
(defun shen.symbol-code? (V1468) (or (= V1468 126) (or (and (> V1468 94) (< V1468 123)) (or (and (> V1468 59) (< V1468 91)) (or (and (> V1468 41) (and (< V1468 58) (not (= V1468 44)))) (or (and (> V1468 34) (< V1468 40)) (= V1468 33)))))))
|
140
140
|
|
141
|
-
(defun shen.<str> (
|
141
|
+
(defun shen.<str> (V1473) (let Result (let Parse_shen.<dbq> (shen.<dbq> V1473) (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)))
|
142
142
|
|
143
|
-
(defun shen.<dbq> (
|
143
|
+
(defun shen.<dbq> (V1478) (let Result (if (cons? (hd V1478)) (let Parse_Byte (hd (hd V1478)) (if (= Parse_Byte 34) (shen.pair (hd (shen.pair (tl (hd V1478)) (shen.hdtl V1478))) Parse_Byte) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
|
144
144
|
|
145
|
-
(defun shen.<strcontents> (
|
145
|
+
(defun shen.<strcontents> (V1483) (let Result (let Parse_shen.<strc> (shen.<strc> V1483) (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> V1483) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) ()) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
|
146
146
|
|
147
|
-
(defun shen.<byte> (
|
147
|
+
(defun shen.<byte> (V1488) (let Result (if (cons? (hd V1488)) (let Parse_Byte (hd (hd V1488)) (shen.pair (hd (shen.pair (tl (hd V1488)) (shen.hdtl V1488))) (n->string Parse_Byte))) (fail)) (if (= Result (fail)) (fail) Result)))
|
148
148
|
|
149
|
-
(defun shen.<strc> (
|
149
|
+
(defun shen.<strc> (V1493) (let Result (if (cons? (hd V1493)) (let Parse_Byte (hd (hd V1493)) (if (not (= Parse_Byte 34)) (shen.pair (hd (shen.pair (tl (hd V1493)) (shen.hdtl V1493))) (n->string Parse_Byte)) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
|
150
150
|
|
151
|
-
(defun shen.<number> (
|
151
|
+
(defun shen.<number> (V1498) (let Result (let Parse_shen.<minus> (shen.<minus> V1498) (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> V1498) (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> V1498) (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> V1498) (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> V1498) (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> V1498) (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)))
|
152
152
|
|
153
|
-
(defun shen.<E> (
|
153
|
+
(defun shen.<E> (V1503) (let Result (if (and (cons? (hd V1503)) (= 101 (hd (hd V1503)))) (shen.pair (hd (shen.pair (tl (hd V1503)) (shen.hdtl V1503))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
|
154
154
|
|
155
|
-
(defun shen.<log10> (
|
155
|
+
(defun shen.<log10> (V1508) (let Result (let Parse_shen.<minus> (shen.<minus> V1508) (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> V1508) (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)))
|
156
156
|
|
157
|
-
(defun shen.<plus> (
|
157
|
+
(defun shen.<plus> (V1513) (let Result (if (cons? (hd V1513)) (let Parse_Byte (hd (hd V1513)) (if (= Parse_Byte 43) (shen.pair (hd (shen.pair (tl (hd V1513)) (shen.hdtl V1513))) Parse_Byte) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
|
158
158
|
|
159
|
-
(defun shen.<stop> (
|
159
|
+
(defun shen.<stop> (V1518) (let Result (if (cons? (hd V1518)) (let Parse_Byte (hd (hd V1518)) (if (= Parse_Byte 46) (shen.pair (hd (shen.pair (tl (hd V1518)) (shen.hdtl V1518))) Parse_Byte) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
|
160
160
|
|
161
|
-
(defun shen.<predigits> (
|
161
|
+
(defun shen.<predigits> (V1523) (let Result (let Parse_shen.<digits> (shen.<digits> V1523) (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> V1523) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) ()) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
|
162
162
|
|
163
|
-
(defun shen.<postdigits> (
|
163
|
+
(defun shen.<postdigits> (V1528) (let Result (let Parse_shen.<digits> (shen.<digits> V1528) (if (not (= (fail) Parse_shen.<digits>)) (shen.pair (hd Parse_shen.<digits>) (shen.hdtl Parse_shen.<digits>)) (fail))) (if (= Result (fail)) (fail) Result)))
|
164
164
|
|
165
|
-
(defun shen.<digits> (
|
165
|
+
(defun shen.<digits> (V1533) (let Result (let Parse_shen.<digit> (shen.<digit> V1533) (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> V1533) (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)))
|
166
166
|
|
167
|
-
(defun shen.<digit> (
|
167
|
+
(defun shen.<digit> (V1538) (let Result (if (cons? (hd V1538)) (let Parse_X (hd (hd V1538)) (if (shen.numbyte? Parse_X) (shen.pair (hd (shen.pair (tl (hd V1538)) (shen.hdtl V1538))) (shen.byte->digit Parse_X)) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
|
168
168
|
|
169
|
-
(defun shen.byte->digit (
|
169
|
+
(defun shen.byte->digit (V1539) (cond ((= 48 V1539) 0) ((= 49 V1539) 1) ((= 50 V1539) 2) ((= 51 V1539) 3) ((= 52 V1539) 4) ((= 53 V1539) 5) ((= 54 V1539) 6) ((= 55 V1539) 7) ((= 56 V1539) 8) ((= 57 V1539) 9) (true (shen.sys-error shen.byte->digit))))
|
170
170
|
|
171
|
-
(defun shen.pre (
|
171
|
+
(defun shen.pre (V1542 V1543) (cond ((= () V1542) 0) ((cons? V1542) (+ (* (shen.expt 10 V1543) (hd V1542)) (shen.pre (tl V1542) (+ V1543 1)))) (true (shen.sys-error shen.pre))))
|
172
172
|
|
173
|
-
(defun shen.post (
|
173
|
+
(defun shen.post (V1546 V1547) (cond ((= () V1546) 0) ((cons? V1546) (+ (* (shen.expt 10 (- 0 V1547)) (hd V1546)) (shen.post (tl V1546) (+ V1547 1)))) (true (shen.sys-error shen.post))))
|
174
174
|
|
175
|
-
(defun shen.expt (
|
175
|
+
(defun shen.expt (V1550 V1551) (cond ((= 0 V1551) 1) ((> V1551 0) (* V1550 (shen.expt V1550 (- V1551 1)))) (true (* 1 (/ (shen.expt V1550 (+ V1551 1)) V1550)))))
|
176
176
|
|
177
|
-
(defun shen.<st_input1> (
|
177
|
+
(defun shen.<st_input1> (V1556) (let Result (let Parse_shen.<st_input> (shen.<st_input> V1556) (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)))
|
178
178
|
|
179
|
-
(defun shen.<st_input2> (
|
179
|
+
(defun shen.<st_input2> (V1561) (let Result (let Parse_shen.<st_input> (shen.<st_input> V1561) (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)))
|
180
180
|
|
181
|
-
(defun shen.<comment> (
|
181
|
+
(defun shen.<comment> (V1566) (let Result (let Parse_shen.<singleline> (shen.<singleline> V1566) (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> V1566) (if (not (= (fail) Parse_shen.<multiline>)) (shen.pair (hd Parse_shen.<multiline>) shen.skip) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
|
182
182
|
|
183
|
-
(defun shen.<singleline> (
|
183
|
+
(defun shen.<singleline> (V1571) (let Result (let Parse_shen.<backslash> (shen.<backslash> V1571) (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)))
|
184
184
|
|
185
|
-
(defun shen.<backslash> (
|
185
|
+
(defun shen.<backslash> (V1576) (let Result (if (and (cons? (hd V1576)) (= 92 (hd (hd V1576)))) (shen.pair (hd (shen.pair (tl (hd V1576)) (shen.hdtl V1576))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
|
186
186
|
|
187
|
-
(defun shen.<anysingle> (
|
187
|
+
(defun shen.<anysingle> (V1581) (let Result (let Parse_shen.<non-return> (shen.<non-return> V1581) (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> V1581) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) shen.skip) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
|
188
188
|
|
189
|
-
(defun shen.<non-return> (
|
189
|
+
(defun shen.<non-return> (V1586) (let Result (if (cons? (hd V1586)) (let Parse_X (hd (hd V1586)) (if (not (element? Parse_X (cons 10 (cons 13 ())))) (shen.pair (hd (shen.pair (tl (hd V1586)) (shen.hdtl V1586))) shen.skip) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
|
190
190
|
|
191
|
-
(defun shen.<return> (
|
191
|
+
(defun shen.<return> (V1591) (let Result (if (cons? (hd V1591)) (let Parse_X (hd (hd V1591)) (if (element? Parse_X (cons 10 (cons 13 ()))) (shen.pair (hd (shen.pair (tl (hd V1591)) (shen.hdtl V1591))) shen.skip) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
|
192
192
|
|
193
|
-
(defun shen.<multiline> (
|
193
|
+
(defun shen.<multiline> (V1596) (let Result (let Parse_shen.<backslash> (shen.<backslash> V1596) (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)))
|
194
194
|
|
195
|
-
(defun shen.<times> (
|
195
|
+
(defun shen.<times> (V1601) (let Result (if (and (cons? (hd V1601)) (= 42 (hd (hd V1601)))) (shen.pair (hd (shen.pair (tl (hd V1601)) (shen.hdtl V1601))) shen.skip) (fail)) (if (= Result (fail)) (fail) Result)))
|
196
196
|
|
197
|
-
(defun shen.<anymulti> (
|
197
|
+
(defun shen.<anymulti> (V1606) (let Result (let Parse_shen.<comment> (shen.<comment> V1606) (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> V1606) (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 V1606)) (let Parse_X (hd (hd V1606)) (let Parse_shen.<anymulti> (shen.<anymulti> (shen.pair (tl (hd V1606)) (shen.hdtl V1606))) (if (not (= (fail) Parse_shen.<anymulti>)) (shen.pair (hd Parse_shen.<anymulti>) shen.skip) (fail)))) (fail)) (if (= Result (fail)) (fail) Result)) Result)) Result)))
|
198
198
|
|
199
|
-
(defun shen.<whitespaces> (
|
199
|
+
(defun shen.<whitespaces> (V1611) (let Result (let Parse_shen.<whitespace> (shen.<whitespace> V1611) (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> V1611) (if (not (= (fail) Parse_shen.<whitespace>)) (shen.pair (hd Parse_shen.<whitespace>) shen.skip) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
|
200
200
|
|
201
|
-
(defun shen.<whitespace> (
|
201
|
+
(defun shen.<whitespace> (V1616) (let Result (if (cons? (hd V1616)) (let Parse_X (hd (hd V1616)) (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 V1616)) (shen.hdtl V1616))) shen.skip) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
|
202
202
|
|
203
|
-
(defun shen.cons_form (
|
203
|
+
(defun shen.cons_form (V1617) (cond ((= () V1617) ()) ((and (cons? V1617) (and (cons? (tl V1617)) (and (cons? (tl (tl V1617))) (and (= () (tl (tl (tl V1617)))) (= (hd (tl V1617)) bar!))))) (cons cons (cons (hd V1617) (tl (tl V1617))))) ((cons? V1617) (cons cons (cons (hd V1617) (cons (shen.cons_form (tl V1617)) ())))) (true (shen.sys-error shen.cons_form))))
|
204
204
|
|
205
|
-
(defun shen.package-macro (
|
205
|
+
(defun shen.package-macro (V1620 V1621) (cond ((and (cons? V1620) (and (= $ (hd V1620)) (and (cons? (tl V1620)) (= () (tl (tl V1620)))))) (append (explode (hd (tl V1620))) V1621)) ((and (cons? V1620) (and (= package (hd V1620)) (and (cons? (tl V1620)) (and (= null (hd (tl V1620))) (cons? (tl (tl V1620))))))) (append (tl (tl (tl V1620))) V1621)) ((and (cons? V1620) (and (= package (hd V1620)) (and (cons? (tl V1620)) (cons? (tl (tl V1620)))))) (let ListofExceptions (shen.eval-without-macros (hd (tl (tl V1620)))) (let Record (shen.record-exceptions ListofExceptions (hd (tl V1620))) (let PackageNameDot (intern (cn (str (hd (tl V1620))) ".")) (append (shen.packageh PackageNameDot ListofExceptions (tl (tl (tl V1620)))) V1621))))) (true (cons V1620 V1621))))
|
206
206
|
|
207
|
-
(defun shen.record-exceptions (
|
207
|
+
(defun shen.record-exceptions (V1622 V1623) (let CurrExceptions (trap-error (get V1623 shen.external-symbols (value *property-vector*)) (lambda E ())) (let AllExceptions (union V1622 CurrExceptions) (put V1623 shen.external-symbols AllExceptions (value *property-vector*)))))
|
208
208
|
|
209
|
-
(defun shen.packageh (
|
209
|
+
(defun shen.packageh (V1632 V1633 V1634) (cond ((cons? V1634) (cons (shen.packageh V1632 V1633 (hd V1634)) (shen.packageh V1632 V1633 (tl V1634)))) ((or (shen.sysfunc? V1634) (or (variable? V1634) (or (element? V1634 V1633) (or (shen.doubleunderline? V1634) (shen.singleunderline? V1634))))) V1634) ((and (symbol? V1634) (not (shen.prefix? (cons "s" (cons "h" (cons "e" (cons "n" (cons "." ()))))) (explode V1634)))) (concat V1632 V1634)) (true V1634)))
|
210
210
|
|
211
211
|
|
212
212
|
|
@@ -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 (V1639) (cond ((and (cons? V1639) (and (cons? (tl V1639)) (= () (tl (tl V1639))))) (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 V1639)) "
|
53
53
|
" shen.a)))) (true (shen.sys-error shen.datatype-error))))
|
54
54
|
|
55
|
-
(defun shen.<datatype-rules> (
|
55
|
+
(defun shen.<datatype-rules> (V1644) (let Result (let Parse_shen.<datatype-rule> (shen.<datatype-rule> V1644) (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> V1644) (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> (V1649) (let Result (let Parse_shen.<side-conditions> (shen.<side-conditions> V1649) (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> V1649) (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> (V1654) (let Result (let Parse_shen.<side-condition> (shen.<side-condition> V1654) (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> V1654) (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> (V1659) (let Result (if (and (cons? (hd V1659)) (= if (hd (hd V1659)))) (let Parse_shen.<expr> (shen.<expr> (shen.pair (tl (hd V1659)) (shen.hdtl V1659))) (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 V1659)) (= let (hd (hd V1659)))) (let Parse_shen.<variable?> (shen.<variable?> (shen.pair (tl (hd V1659)) (shen.hdtl V1659))) (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?> (V1664) (let Result (if (cons? (hd V1664)) (let Parse_X (hd (hd V1664)) (if (variable? Parse_X) (shen.pair (hd (shen.pair (tl (hd V1664)) (shen.hdtl V1664))) Parse_X) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
|
64
64
|
|
65
|
-
(defun shen.<expr> (
|
65
|
+
(defun shen.<expr> (V1669) (let Result (if (cons? (hd V1669)) (let Parse_X (hd (hd V1669)) (if (not (or (element? Parse_X (cons >> (cons ; ()))) (or (shen.singleunderline? Parse_X) (shen.doubleunderline? Parse_X)))) (shen.pair (hd (shen.pair (tl (hd V1669)) (shen.hdtl V1669))) (shen.remove-bar Parse_X)) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
|
66
66
|
|
67
|
-
(defun shen.remove-bar (
|
67
|
+
(defun shen.remove-bar (V1670) (cond ((and (cons? V1670) (and (cons? (tl V1670)) (and (cons? (tl (tl V1670))) (and (= () (tl (tl (tl V1670)))) (= (hd (tl V1670)) bar!))))) (cons (hd V1670) (hd (tl (tl V1670))))) ((cons? V1670) (cons (shen.remove-bar (hd V1670)) (shen.remove-bar (tl V1670)))) (true V1670)))
|
68
68
|
|
69
|
-
(defun shen.<premises> (
|
69
|
+
(defun shen.<premises> (V1675) (let Result (let Parse_shen.<premise> (shen.<premise> V1675) (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> V1675) (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> (V1680) (let Result (if (cons? (hd V1680)) (let Parse_X (hd (hd V1680)) (if (= Parse_X ;) (shen.pair (hd (shen.pair (tl (hd V1680)) (shen.hdtl V1680))) shen.skip) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
|
72
72
|
|
73
|
-
(defun shen.<premise> (
|
73
|
+
(defun shen.<premise> (V1685) (let Result (if (and (cons? (hd V1685)) (= ! (hd (hd V1685)))) (shen.pair (hd (shen.pair (tl (hd V1685)) (shen.hdtl V1685))) !) (fail)) (if (= Result (fail)) (let Result (let Parse_shen.<formulae> (shen.<formulae> V1685) (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> V1685) (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> (V1690) (let Result (let Parse_shen.<formulae> (shen.<formulae> V1690) (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> V1690) (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 (V1691 V1692) (@p V1691 V1692))
|
78
78
|
|
79
|
-
(defun shen.<formulae> (
|
79
|
+
(defun shen.<formulae> (V1697) (let Result (let Parse_shen.<formula> (shen.<formula> V1697) (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> V1697) (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> V1697) (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> (V1702) (let Result (if (cons? (hd V1702)) (let Parse_X (hd (hd V1702)) (if (= Parse_X (intern ",")) (shen.pair (hd (shen.pair (tl (hd V1702)) (shen.hdtl V1702))) shen.skip) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
|
82
82
|
|
83
|
-
(defun shen.<formula> (
|
83
|
+
(defun shen.<formula> (V1707) (let Result (let Parse_shen.<expr> (shen.<expr> V1707) (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> V1707) (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> (V1712) (let Result (let Parse_shen.<expr> (shen.<expr> V1712) (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> (V1717) (let Result (if (cons? (hd V1717)) (let Parse_X (hd (hd V1717)) (if (shen.doubleunderline? Parse_X) (shen.pair (hd (shen.pair (tl (hd V1717)) (shen.hdtl V1717))) Parse_X) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
|
88
88
|
|
89
|
-
(defun shen.<singleunderline> (
|
89
|
+
(defun shen.<singleunderline> (V1722) (let Result (if (cons? (hd V1722)) (let Parse_X (hd (hd V1722)) (if (shen.singleunderline? Parse_X) (shen.pair (hd (shen.pair (tl (hd V1722)) (shen.hdtl V1722))) Parse_X) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
|
90
90
|
|
91
|
-
(defun shen.singleunderline? (
|
91
|
+
(defun shen.singleunderline? (V1723) (and (symbol? V1723) (shen.sh? (str V1723))))
|
92
92
|
|
93
|
-
(defun shen.sh? (
|
93
|
+
(defun shen.sh? (V1724) (cond ((= "_" V1724) true) (true (and (= (pos V1724 0) "_") (shen.sh? (tlstr V1724))))))
|
94
94
|
|
95
|
-
(defun shen.doubleunderline? (
|
95
|
+
(defun shen.doubleunderline? (V1725) (and (symbol? V1725) (shen.dh? (str V1725))))
|
96
96
|
|
97
|
-
(defun shen.dh? (
|
97
|
+
(defun shen.dh? (V1726) (cond ((= "=" V1726) true) (true (and (= (pos V1726 0) "=") (shen.dh? (tlstr V1726))))))
|
98
98
|
|
99
|
-
(defun shen.process-datatype (
|
99
|
+
(defun shen.process-datatype (V1727 V1728) (shen.remember-datatype (shen.s-prolog (shen.rules->horn-clauses V1727 V1728))))
|
100
100
|
|
101
|
-
(defun shen.remember-datatype (
|
101
|
+
(defun shen.remember-datatype (V1733) (cond ((cons? V1733) (do (set shen.*datatypes* (adjoin (hd V1733) (value shen.*datatypes*))) (do (set shen.*alldatatypes* (adjoin (hd V1733) (value shen.*alldatatypes*))) (hd V1733)))) (true (shen.sys-error shen.remember-datatype))))
|
102
102
|
|
103
|
-
(defun shen.rules->horn-clauses (
|
103
|
+
(defun shen.rules->horn-clauses (V1736 V1737) (cond ((= () V1737) ()) ((and (cons? V1737) (and (tuple? (hd V1737)) (= shen.single (fst (hd V1737))))) (cons (shen.rule->horn-clause V1736 (snd (hd V1737))) (shen.rules->horn-clauses V1736 (tl V1737)))) ((and (cons? V1737) (and (tuple? (hd V1737)) (= shen.double (fst (hd V1737))))) (shen.rules->horn-clauses V1736 (append (shen.double->singles (snd (hd V1737))) (tl V1737)))) (true (shen.sys-error shen.rules->horn-clauses))))
|
104
104
|
|
105
|
-
(defun shen.double->singles (
|
105
|
+
(defun shen.double->singles (V1738) (cons (shen.right-rule V1738) (cons (shen.left-rule V1738) ())))
|
106
106
|
|
107
|
-
(defun shen.right-rule (
|
107
|
+
(defun shen.right-rule (V1739) (@p shen.single V1739))
|
108
108
|
|
109
|
-
(defun shen.left-rule (
|
109
|
+
(defun shen.left-rule (V1740) (cond ((and (cons? V1740) (and (cons? (tl V1740)) (and (cons? (tl (tl V1740))) (and (tuple? (hd (tl (tl V1740)))) (and (= () (fst (hd (tl (tl V1740))))) (= () (tl (tl (tl V1740))))))))) (let Q (gensym Qv) (let NewConclusion (@p (cons (snd (hd (tl (tl V1740)))) ()) Q) (let NewPremises (cons (@p (map shen.right->left (hd (tl V1740))) Q) ()) (@p shen.single (cons (hd V1740) (cons NewPremises (cons NewConclusion ())))))))) (true (shen.sys-error shen.left-rule))))
|
110
110
|
|
111
|
-
(defun shen.right->left (
|
111
|
+
(defun shen.right->left (V1745) (cond ((and (tuple? V1745) (= () (fst V1745))) (snd V1745)) (true (simple-error "syntax error with ==========
|
112
112
|
"))))
|
113
113
|
|
114
|
-
(defun shen.rule->horn-clause (
|
114
|
+
(defun shen.rule->horn-clause (V1746 V1747) (cond ((and (cons? V1747) (and (cons? (tl V1747)) (and (cons? (tl (tl V1747))) (and (tuple? (hd (tl (tl V1747)))) (= () (tl (tl (tl V1747)))))))) (cons (shen.rule->horn-clause-head V1746 (snd (hd (tl (tl V1747))))) (cons :- (cons (shen.rule->horn-clause-body (hd V1747) (hd (tl V1747)) (fst (hd (tl (tl V1747))))) ())))) (true (shen.sys-error shen.rule->horn-clause))))
|
115
115
|
|
116
|
-
(defun shen.rule->horn-clause-head (
|
116
|
+
(defun shen.rule->horn-clause-head (V1748 V1749) (cons V1748 (cons (shen.mode-ify V1749) (cons Context_1957 ()))))
|
117
117
|
|
118
|
-
(defun shen.mode-ify (
|
118
|
+
(defun shen.mode-ify (V1750) (cond ((and (cons? V1750) (and (cons? (tl V1750)) (and (= : (hd (tl V1750))) (and (cons? (tl (tl V1750))) (= () (tl (tl (tl V1750)))))))) (cons mode (cons (cons (hd V1750) (cons : (cons (cons mode (cons (hd (tl (tl V1750))) (cons + ()))) ()))) (cons - ())))) (true V1750)))
|
119
119
|
|
120
|
-
(defun shen.rule->horn-clause-body (
|
120
|
+
(defun shen.rule->horn-clause-body (V1751 V1752 V1753) (let Variables (map shen.extract_vars V1753) (let Predicates (map (lambda X (gensym shen.cl)) V1753) (let SearchLiterals (shen.construct-search-literals Predicates Variables Context_1957 Context1_1957) (let SearchClauses (shen.construct-search-clauses Predicates V1753 Variables) (let SideLiterals (shen.construct-side-literals V1751) (let PremissLiterals (map (lambda X (shen.construct-premiss-literal X (empty? V1753))) V1752) (append SearchLiterals (append SideLiterals PremissLiterals)))))))))
|
121
121
|
|
122
|
-
(defun shen.construct-search-literals (
|
122
|
+
(defun shen.construct-search-literals (V1758 V1759 V1760 V1761) (cond ((and (= () V1758) (= () V1759)) ()) (true (shen.csl-help V1758 V1759 V1760 V1761))))
|
123
123
|
|
124
|
-
(defun shen.csl-help (
|
124
|
+
(defun shen.csl-help (V1764 V1765 V1766 V1767) (cond ((and (= () V1764) (= () V1765)) (cons (cons bind (cons ContextOut_1957 (cons V1766 ()))) ())) ((and (cons? V1764) (cons? V1765)) (cons (cons (hd V1764) (cons V1766 (cons V1767 (hd V1765)))) (shen.csl-help (tl V1764) (tl V1765) V1767 (gensym Context)))) (true (shen.sys-error shen.csl-help))))
|
125
125
|
|
126
|
-
(defun shen.construct-search-clauses (
|
126
|
+
(defun shen.construct-search-clauses (V1768 V1769 V1770) (cond ((and (= () V1768) (and (= () V1769) (= () V1770))) shen.skip) ((and (cons? V1768) (and (cons? V1769) (cons? V1770))) (do (shen.construct-search-clause (hd V1768) (hd V1769) (hd V1770)) (shen.construct-search-clauses (tl V1768) (tl V1769) (tl V1770)))) (true (shen.sys-error shen.construct-search-clauses))))
|
127
127
|
|
128
|
-
(defun shen.construct-search-clause (
|
128
|
+
(defun shen.construct-search-clause (V1771 V1772 V1773) (shen.s-prolog (cons (shen.construct-base-search-clause V1771 V1772 V1773) (cons (shen.construct-recursive-search-clause V1771 V1772 V1773) ()))))
|
129
129
|
|
130
|
-
(defun shen.construct-base-search-clause (
|
130
|
+
(defun shen.construct-base-search-clause (V1774 V1775 V1776) (cons (cons V1774 (cons (cons (shen.mode-ify V1775) In_1957) (cons In_1957 V1776))) (cons :- (cons () ()))))
|
131
131
|
|
132
|
-
(defun shen.construct-recursive-search-clause (
|
132
|
+
(defun shen.construct-recursive-search-clause (V1777 V1778 V1779) (cons (cons V1777 (cons (cons Assumption_1957 Assumptions_1957) (cons (cons Assumption_1957 Out_1957) V1779))) (cons :- (cons (cons (cons V1777 (cons Assumptions_1957 (cons Out_1957 V1779))) ()) ()))))
|
133
133
|
|
134
|
-
(defun shen.construct-side-literals (
|
134
|
+
(defun shen.construct-side-literals (V1784) (cond ((= () V1784) ()) ((and (cons? V1784) (and (cons? (hd V1784)) (and (= if (hd (hd V1784))) (and (cons? (tl (hd V1784))) (= () (tl (tl (hd V1784)))))))) (cons (cons when (tl (hd V1784))) (shen.construct-side-literals (tl V1784)))) ((and (cons? V1784) (and (cons? (hd V1784)) (and (= let (hd (hd V1784))) (and (cons? (tl (hd V1784))) (and (cons? (tl (tl (hd V1784)))) (= () (tl (tl (tl (hd V1784)))))))))) (cons (cons is (tl (hd V1784))) (shen.construct-side-literals (tl V1784)))) ((cons? V1784) (shen.construct-side-literals (tl V1784))) (true (shen.sys-error shen.construct-side-literals))))
|
135
135
|
|
136
|
-
(defun shen.construct-premiss-literal (
|
136
|
+
(defun shen.construct-premiss-literal (V1789 V1790) (cond ((tuple? V1789) (cons shen.t* (cons (shen.recursive_cons_form (snd V1789)) (cons (shen.construct-context V1790 (fst V1789)) ())))) ((= ! V1789) (cons cut (cons Throwcontrol ()))) (true (shen.sys-error shen.construct-premiss-literal))))
|
137
137
|
|
138
|
-
(defun shen.construct-context (
|
138
|
+
(defun shen.construct-context (V1791 V1792) (cond ((and (= true V1791) (= () V1792)) Context_1957) ((and (= false V1791) (= () V1792)) ContextOut_1957) ((cons? V1792) (cons cons (cons (shen.recursive_cons_form (hd V1792)) (cons (shen.construct-context V1791 (tl V1792)) ())))) (true (shen.sys-error shen.construct-context))))
|
139
139
|
|
140
|
-
(defun shen.recursive_cons_form (
|
140
|
+
(defun shen.recursive_cons_form (V1793) (cond ((cons? V1793) (cons cons (cons (shen.recursive_cons_form (hd V1793)) (cons (shen.recursive_cons_form (tl V1793)) ())))) (true V1793)))
|
141
141
|
|
142
|
-
(defun preclude (
|
142
|
+
(defun preclude (V1794) (shen.preclude-h (map shen.intern-type V1794)))
|
143
143
|
|
144
|
-
(defun shen.preclude-h (
|
144
|
+
(defun shen.preclude-h (V1795) (let FilterDatatypes (set shen.*datatypes* (difference (value shen.*datatypes*) V1795)) (value shen.*datatypes*)))
|
145
145
|
|
146
|
-
(defun include (
|
146
|
+
(defun include (V1796) (shen.include-h (map shen.intern-type V1796)))
|
147
147
|
|
148
|
-
(defun shen.include-h (
|
148
|
+
(defun shen.include-h (V1797) (let ValidTypes (intersection V1797 (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 (V1798) (shen.preclude-h (difference (value shen.*alldatatypes*) (map shen.intern-type V1798))))
|
151
151
|
|
152
|
-
(defun include-all-but (
|
152
|
+
(defun include-all-but (V1799) (shen.include-h (difference (value shen.*alldatatypes*) (map shen.intern-type V1799))))
|
153
153
|
|
154
|
-
(defun shen.synonyms-help (
|
154
|
+
(defun shen.synonyms-help (V1804) (cond ((= () V1804) synonyms) ((and (cons? V1804) (cons? (tl V1804))) (do (shen.pushnew (cons (hd V1804) (shen.curry-type (hd (tl V1804)))) shen.*synonyms*) (shen.synonyms-help (tl (tl V1804))))) (true (simple-error (cn "odd number of synonyms
|
155
155
|
" "")))))
|
156
156
|
|
157
|
-
(defun shen.pushnew (
|
157
|
+
(defun shen.pushnew (V1805 V1806) (if (element? V1805 (value V1806)) (value V1806) (set V1806 (cons V1805 (value V1806)))))
|
158
158
|
|
159
159
|
|
160
160
|
|
@@ -47,211 +47,225 @@
|
|
47
47
|
* explains this license in full. *
|
48
48
|
* *
|
49
49
|
*****************************************************************************************
|
50
|
-
"(defun thaw (
|
50
|
+
"(defun thaw (V1809) (V1809))
|
51
51
|
|
52
|
-
(defun eval (
|
52
|
+
(defun eval (V1810) (let Macroexpand (shen.walk (lambda V1807 (macroexpand V1807)) V1810) (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 (V1811) (eval-kl (shen.elim-def (shen.proc-input+ V1811))))
|
55
55
|
|
56
|
-
(defun shen.proc-input+ (
|
56
|
+
(defun shen.proc-input+ (V1812) (cond ((and (cons? V1812) (and (= input+ (hd V1812)) (and (cons? (tl V1812)) (and (cons? (tl (tl V1812))) (= () (tl (tl (tl V1812)))))))) (cons input+ (cons (shen.rcons_form (hd (tl V1812))) (tl (tl V1812))))) ((and (cons? V1812) (and (= read+ (hd V1812)) (and (cons? (tl V1812)) (and (cons? (tl (tl V1812))) (= () (tl (tl (tl V1812)))))))) (cons read+ (cons (shen.rcons_form (hd (tl V1812))) (tl (tl V1812))))) ((cons? V1812) (map shen.proc-input+ V1812)) (true V1812)))
|
57
57
|
|
58
|
-
(defun shen.elim-def (
|
58
|
+
(defun shen.elim-def (V1813) (cond ((and (cons? V1813) (and (= define (hd V1813)) (cons? (tl V1813)))) (shen.shen->kl (hd (tl V1813)) (tl (tl V1813)))) ((and (cons? V1813) (and (= defmacro (hd V1813)) (cons? (tl V1813)))) (let Default (cons X (cons -> (cons X ()))) (let Def (shen.elim-def (cons define (cons (hd (tl V1813)) (append (tl (tl V1813)) Default)))) (let MacroAdd (shen.add-macro (hd (tl V1813))) Def)))) ((and (cons? V1813) (and (= defcc (hd V1813)) (cons? (tl V1813)))) (shen.elim-def (shen.yacc V1813))) ((cons? V1813) (map shen.elim-def V1813)) (true V1813)))
|
59
59
|
|
60
|
-
(defun shen.add-macro (
|
60
|
+
(defun shen.add-macro (V1814) (set *macros* (adjoin V1814 (value *macros*))))
|
61
61
|
|
62
|
-
(defun shen.packaged? (
|
62
|
+
(defun shen.packaged? (V1821) (cond ((and (cons? V1821) (and (= package (hd V1821)) (and (cons? (tl V1821)) (cons? (tl (tl V1821)))))) true) (true false)))
|
63
63
|
|
64
|
-
(defun external (
|
64
|
+
(defun external (V1822) (trap-error (get V1822 shen.external-symbols (value *property-vector*)) (lambda E (simple-error (cn "package " (shen.app V1822 " has not been used.
|
65
65
|
" shen.a))))))
|
66
66
|
|
67
|
-
(defun shen.package-contents (
|
67
|
+
(defun shen.package-contents (V1825) (cond ((and (cons? V1825) (and (= package (hd V1825)) (and (cons? (tl V1825)) (and (= null (hd (tl V1825))) (cons? (tl (tl V1825))))))) (tl (tl (tl V1825)))) ((and (cons? V1825) (and (= package (hd V1825)) (and (cons? (tl V1825)) (cons? (tl (tl V1825)))))) (shen.packageh (hd (tl V1825)) (hd (tl (tl V1825))) (tl (tl (tl V1825))))) (true (shen.sys-error shen.package-contents))))
|
68
68
|
|
69
|
-
(defun shen.walk (
|
69
|
+
(defun shen.walk (V1826 V1827) (cond ((cons? V1827) (V1826 (map (lambda Z (shen.walk V1826 Z)) V1827))) (true (V1826 V1827))))
|
70
70
|
|
71
|
-
(defun compile (
|
71
|
+
(defun compile (V1828 V1829 V1830) (let O (V1828 (cons V1829 (cons () ()))) (if (or (= (fail) O) (not (empty? (hd O)))) (V1830 O) (shen.hdtl O))))
|
72
72
|
|
73
|
-
(defun fail-if (
|
73
|
+
(defun fail-if (V1831 V1832) (if (V1831 V1832) (fail) V1832))
|
74
74
|
|
75
|
-
(defun @s (
|
75
|
+
(defun @s (V1833 V1834) (cn V1833 V1834))
|
76
76
|
|
77
77
|
(defun tc? () (value shen.*tc*))
|
78
78
|
|
79
|
-
(defun ps (
|
79
|
+
(defun ps (V1835) (trap-error (get V1835 shen.source (value *property-vector*)) (lambda E (simple-error (shen.app V1835 " not found.
|
80
80
|
" shen.a)))))
|
81
81
|
|
82
82
|
(defun stinput () (value *stinput*))
|
83
83
|
|
84
|
-
(defun shen.+vector? (
|
84
|
+
(defun shen.+vector? (V1836) (and (absvector? V1836) (> (<-address V1836 0) 0)))
|
85
85
|
|
86
|
-
(defun vector (
|
86
|
+
(defun vector (V1837) (let Vector (absvector (+ V1837 1)) (let ZeroStamp (address-> Vector 0 V1837) (let Standard (if (= V1837 0) ZeroStamp (shen.fillvector ZeroStamp 1 V1837 (fail))) Standard))))
|
87
87
|
|
88
|
-
(defun shen.fillvector (
|
88
|
+
(defun shen.fillvector (V1838 V1839 V1840 V1841) (cond ((= V1840 V1839) (address-> V1838 V1840 V1841)) (true (shen.fillvector (address-> V1838 V1839 V1841) (+ 1 V1839) V1840 V1841))))
|
89
89
|
|
90
|
-
(defun vector? (
|
90
|
+
(defun vector? (V1843) (and (absvector? V1843) (trap-error (>= (<-address V1843 0) 0) (lambda E false))))
|
91
91
|
|
92
|
-
(defun vector-> (
|
93
|
-
") (address->
|
92
|
+
(defun vector-> (V1844 V1845 V1846) (if (= V1845 0) (simple-error "cannot access 0th element of a vector
|
93
|
+
") (address-> V1844 V1845 V1846)))
|
94
94
|
|
95
|
-
(defun <-vector (
|
96
|
-
") (let VectorElement (<-address
|
95
|
+
(defun <-vector (V1847 V1848) (if (= V1848 0) (simple-error "cannot access 0th element of a vector
|
96
|
+
") (let VectorElement (<-address V1847 V1848) (if (= VectorElement (fail)) (simple-error "vector element not found
|
97
97
|
") VectorElement))))
|
98
98
|
|
99
|
-
(defun shen.posint? (
|
99
|
+
(defun shen.posint? (V1849) (and (integer? V1849) (>= V1849 0)))
|
100
100
|
|
101
|
-
(defun limit (
|
101
|
+
(defun limit (V1850) (<-address V1850 0))
|
102
102
|
|
103
|
-
(defun symbol? (
|
103
|
+
(defun symbol? (V1851) (cond ((or (boolean? V1851) (or (number? V1851) (string? V1851))) false) (true (trap-error (let String (str V1851) (shen.analyse-symbol? String)) (lambda E false)))))
|
104
104
|
|
105
|
-
(defun shen.analyse-symbol? (
|
105
|
+
(defun shen.analyse-symbol? (V1852) (cond ((shen.+string? V1852) (and (shen.alpha? (pos V1852 0)) (shen.alphanums? (tlstr V1852)))) (true (shen.sys-error shen.analyse-symbol?))))
|
106
106
|
|
107
|
-
(defun shen.alpha? (
|
107
|
+
(defun shen.alpha? (V1853) (element? V1853 (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 "." ())))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
|
108
108
|
|
109
|
-
(defun shen.alphanums? (
|
109
|
+
(defun shen.alphanums? (V1854) (cond ((= "" V1854) true) ((shen.+string? V1854) (and (shen.alphanum? (pos V1854 0)) (shen.alphanums? (tlstr V1854)))) (true (shen.sys-error shen.alphanums?))))
|
110
110
|
|
111
|
-
(defun shen.alphanum? (
|
111
|
+
(defun shen.alphanum? (V1855) (or (shen.alpha? V1855) (shen.digit? V1855)))
|
112
112
|
|
113
|
-
(defun shen.digit? (
|
113
|
+
(defun shen.digit? (V1856) (element? V1856 (cons "1" (cons "2" (cons "3" (cons "4" (cons "5" (cons "6" (cons "7" (cons "8" (cons "9" (cons "0" ()))))))))))))
|
114
114
|
|
115
|
-
(defun variable? (
|
115
|
+
(defun variable? (V1857) (cond ((or (boolean? V1857) (or (number? V1857) (string? V1857))) false) (true (trap-error (let String (str V1857) (shen.analyse-variable? String)) (lambda E false)))))
|
116
116
|
|
117
|
-
(defun shen.analyse-variable? (
|
117
|
+
(defun shen.analyse-variable? (V1858) (cond ((shen.+string? V1858) (and (shen.uppercase? (pos V1858 0)) (shen.alphanums? (tlstr V1858)))) (true (shen.sys-error shen.analyse-variable?))))
|
118
118
|
|
119
|
-
(defun shen.uppercase? (
|
119
|
+
(defun shen.uppercase? (V1859) (element? V1859 (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" ()))))))))))))))))))))))))))))
|
120
120
|
|
121
|
-
(defun gensym (
|
121
|
+
(defun gensym (V1860) (concat V1860 (set shen.*gensym* (+ 1 (value shen.*gensym*)))))
|
122
122
|
|
123
|
-
(defun concat (
|
123
|
+
(defun concat (V1861 V1862) (intern (cn (str V1861) (str V1862))))
|
124
124
|
|
125
|
-
(defun @p (
|
125
|
+
(defun @p (V1863 V1864) (let Vector (absvector 3) (let Tag (address-> Vector 0 shen.tuple) (let Fst (address-> Vector 1 V1863) (let Snd (address-> Vector 2 V1864) Vector)))))
|
126
126
|
|
127
|
-
(defun fst (
|
127
|
+
(defun fst (V1865) (<-address V1865 1))
|
128
128
|
|
129
|
-
(defun snd (
|
129
|
+
(defun snd (V1866) (<-address V1866 2))
|
130
130
|
|
131
|
-
(defun tuple? (
|
131
|
+
(defun tuple? (V1867) (trap-error (and (absvector? V1867) (= shen.tuple (<-address V1867 0))) (lambda E false)))
|
132
132
|
|
133
|
-
(defun append (
|
133
|
+
(defun append (V1868 V1869) (cond ((= () V1868) V1869) ((cons? V1868) (cons (hd V1868) (append (tl V1868) V1869))) (true (shen.sys-error append))))
|
134
134
|
|
135
|
-
(defun @v (
|
135
|
+
(defun @v (V1870 V1871) (let Limit (limit V1871) (let NewVector (vector (+ Limit 1)) (let X+NewVector (vector-> NewVector 1 V1870) (if (= Limit 0) X+NewVector (shen.@v-help V1871 1 Limit X+NewVector))))))
|
136
136
|
|
137
|
-
(defun shen.@v-help (
|
137
|
+
(defun shen.@v-help (V1872 V1873 V1874 V1875) (cond ((= V1874 V1873) (shen.copyfromvector V1872 V1875 V1874 (+ V1874 1))) (true (shen.@v-help V1872 (+ V1873 1) V1874 (shen.copyfromvector V1872 V1875 V1873 (+ V1873 1))))))
|
138
138
|
|
139
|
-
(defun shen.copyfromvector (
|
139
|
+
(defun shen.copyfromvector (V1877 V1878 V1879 V1880) (trap-error (vector-> V1878 V1880 (<-vector V1877 V1879)) (lambda E V1878)))
|
140
140
|
|
141
|
-
(defun hdv (
|
141
|
+
(defun hdv (V1881) (trap-error (<-vector V1881 1) (lambda E (simple-error (cn "hdv needs a non-empty vector as an argument; not " (shen.app V1881 "
|
142
142
|
" shen.s))))))
|
143
143
|
|
144
|
-
(defun tlv (
|
145
|
-
") (if (= Limit 1) (vector 0) (let NewVector (vector (- Limit 1)) (shen.tlv-help
|
144
|
+
(defun tlv (V1882) (let Limit (limit V1882) (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 V1882 2 Limit (vector (- Limit 1))))))))
|
146
146
|
|
147
|
-
(defun shen.tlv-help (
|
147
|
+
(defun shen.tlv-help (V1883 V1884 V1885 V1886) (cond ((= V1885 V1884) (shen.copyfromvector V1883 V1886 V1885 (- V1885 1))) (true (shen.tlv-help V1883 (+ V1884 1) V1885 (shen.copyfromvector V1883 V1886 V1884 (- V1884 1))))))
|
148
148
|
|
149
|
-
(defun assoc (
|
149
|
+
(defun assoc (V1896 V1897) (cond ((= () V1897) ()) ((and (cons? V1897) (and (cons? (hd V1897)) (= (hd (hd V1897)) V1896))) (hd V1897)) ((cons? V1897) (assoc V1896 (tl V1897))) (true (shen.sys-error assoc))))
|
150
150
|
|
151
|
-
(defun boolean? (
|
151
|
+
(defun boolean? (V1903) (cond ((= true V1903) true) ((= false V1903) true) (true false)))
|
152
152
|
|
153
|
-
(defun nl (
|
154
|
-
" (stoutput)) (nl (-
|
153
|
+
(defun nl (V1904) (cond ((= 0 V1904) 0) (true (do (shen.prhush "
|
154
|
+
" (stoutput)) (nl (- V1904 1))))))
|
155
155
|
|
156
|
-
(defun difference (
|
156
|
+
(defun difference (V1907 V1908) (cond ((= () V1907) ()) ((cons? V1907) (if (element? (hd V1907) V1908) (difference (tl V1907) V1908) (cons (hd V1907) (difference (tl V1907) V1908)))) (true (shen.sys-error difference))))
|
157
157
|
|
158
|
-
(defun do (
|
158
|
+
(defun do (V1909 V1910) V1910)
|
159
159
|
|
160
|
-
(defun element? (
|
160
|
+
(defun element? (V1919 V1920) (cond ((= () V1920) false) ((and (cons? V1920) (= (hd V1920) V1919)) true) ((cons? V1920) (element? V1919 (tl V1920))) (true (shen.sys-error element?))))
|
161
161
|
|
162
|
-
(defun empty? (
|
162
|
+
(defun empty? (V1926) (cond ((= () V1926) true) (true false)))
|
163
163
|
|
164
|
-
(defun fix (
|
164
|
+
(defun fix (V1927 V1928) (shen.fix-help V1927 V1928 (V1927 V1928)))
|
165
165
|
|
166
|
-
(defun shen.fix-help (
|
166
|
+
(defun shen.fix-help (V1935 V1936 V1937) (cond ((= V1937 V1936) V1937) (true (shen.fix-help V1935 V1937 (V1935 V1937)))))
|
167
167
|
|
168
|
-
(defun put (
|
168
|
+
(defun put (V1939 V1940 V1941 V1942) (let N (hash V1939 (limit V1942)) (let Entry (trap-error (<-vector V1942 N) (lambda E ())) (let Change (vector-> V1942 N (shen.change-pointer-value V1939 V1940 V1941 Entry)) V1941))))
|
169
169
|
|
170
|
-
(defun shen.change-pointer-value (
|
170
|
+
(defun shen.change-pointer-value (V1945 V1946 V1947 V1948) (cond ((= () V1948) (cons (cons (cons V1945 (cons V1946 ())) V1947) ())) ((and (cons? V1948) (and (cons? (hd V1948)) (and (cons? (hd (hd V1948))) (and (cons? (tl (hd (hd V1948)))) (and (= () (tl (tl (hd (hd V1948))))) (and (= (hd (tl (hd (hd V1948)))) V1946) (= (hd (hd (hd V1948))) V1945))))))) (cons (cons (hd (hd V1948)) V1947) (tl V1948))) ((cons? V1948) (cons (hd V1948) (shen.change-pointer-value V1945 V1946 V1947 (tl V1948)))) (true (shen.sys-error shen.change-pointer-value))))
|
171
171
|
|
172
|
-
(defun get (
|
173
|
-
"))) (let Result (assoc (cons
|
172
|
+
(defun get (V1951 V1952 V1953) (let N (hash V1951 (limit V1953)) (let Entry (trap-error (<-vector V1953 N) (lambda E (simple-error "pointer not found
|
173
|
+
"))) (let Result (assoc (cons V1951 (cons V1952 ())) Entry) (if (empty? Result) (simple-error "value not found
|
174
174
|
") (tl Result))))))
|
175
175
|
|
176
|
-
(defun hash (
|
176
|
+
(defun hash (V1954 V1955) (let Hash (shen.mod (sum (map (lambda V1808 (string->n V1808)) (explode V1954))) V1955) (if (= 0 Hash) 1 Hash)))
|
177
177
|
|
178
|
-
(defun shen.mod (
|
178
|
+
(defun shen.mod (V1956 V1957) (shen.modh V1956 (shen.multiples V1956 (cons V1957 ()))))
|
179
179
|
|
180
|
-
(defun shen.multiples (
|
180
|
+
(defun shen.multiples (V1958 V1959) (cond ((and (cons? V1959) (> (hd V1959) V1958)) (tl V1959)) ((cons? V1959) (shen.multiples V1958 (cons (* 2 (hd V1959)) V1959))) (true (shen.sys-error shen.multiples))))
|
181
181
|
|
182
|
-
(defun shen.modh (
|
182
|
+
(defun shen.modh (V1962 V1963) (cond ((= 0 V1962) 0) ((= () V1963) V1962) ((and (cons? V1963) (> (hd V1963) V1962)) (if (empty? (tl V1963)) V1962 (shen.modh V1962 (tl V1963)))) ((cons? V1963) (shen.modh (- V1962 (hd V1963)) V1963)) (true (shen.sys-error shen.modh))))
|
183
183
|
|
184
|
-
(defun
|
184
|
+
(defun sum (V1964) (cond ((= () V1964) 0) ((cons? V1964) (+ (hd V1964) (sum (tl V1964)))) (true (shen.sys-error sum))))
|
185
185
|
|
186
|
-
(defun head (
|
186
|
+
(defun head (V1971) (cond ((cons? V1971) (hd V1971)) (true (simple-error "head expects a non-empty list"))))
|
187
187
|
|
188
|
-
(defun tail (
|
188
|
+
(defun tail (V1978) (cond ((cons? V1978) (tl V1978)) (true (simple-error "tail expects a non-empty list"))))
|
189
189
|
|
190
|
-
(defun hdstr (
|
190
|
+
(defun hdstr (V1979) (pos V1979 0))
|
191
191
|
|
192
|
-
(defun intersection (
|
192
|
+
(defun intersection (V1982 V1983) (cond ((= () V1982) ()) ((cons? V1982) (if (element? (hd V1982) V1983) (cons (hd V1982) (intersection (tl V1982) V1983)) (intersection (tl V1982) V1983))) (true (shen.sys-error intersection))))
|
193
193
|
|
194
|
-
(defun reverse (
|
194
|
+
(defun reverse (V1984) (shen.reverse_help V1984 ()))
|
195
195
|
|
196
|
-
(defun shen.reverse_help (
|
196
|
+
(defun shen.reverse_help (V1985 V1986) (cond ((= () V1985) V1986) ((cons? V1985) (shen.reverse_help (tl V1985) (cons (hd V1985) V1986))) (true (shen.sys-error shen.reverse_help))))
|
197
197
|
|
198
|
-
(defun union (
|
198
|
+
(defun union (V1987 V1988) (cond ((= () V1987) V1988) ((cons? V1987) (if (element? (hd V1987) V1988) (union (tl V1987) V1988) (cons (hd V1987) (union (tl V1987) V1988)))) (true (shen.sys-error union))))
|
199
199
|
|
200
|
-
(defun y-or-n? (
|
201
|
-
" (stoutput)) (y-or-n?
|
200
|
+
(defun y-or-n? (V1989) (let Message (shen.prhush (shen.proc-nl V1989) (stoutput)) (let Y-or-N (shen.prhush " (y/n) " (stoutput)) (let Input (shen.app (read (stinput)) "" shen.s) (if (= "y" Input) true (if (= "n" Input) false (do (shen.prhush "please answer y or n
|
201
|
+
" (stoutput)) (y-or-n? V1989))))))))
|
202
202
|
|
203
|
-
(defun not (
|
203
|
+
(defun not (V1990) (if V1990 false true))
|
204
204
|
|
205
|
-
(defun subst (
|
205
|
+
(defun subst (V1999 V2000 V2001) (cond ((= V2001 V2000) V1999) ((cons? V2001) (cons (subst V1999 V2000 (hd V2001)) (subst V1999 V2000 (tl V2001)))) (true V2001)))
|
206
206
|
|
207
|
-
(defun explode (
|
207
|
+
(defun explode (V2003) (shen.explode-h (shen.app V2003 "" shen.a)))
|
208
208
|
|
209
|
-
(defun shen.explode-h (
|
209
|
+
(defun shen.explode-h (V2004) (cond ((= "" V2004) ()) ((shen.+string? V2004) (cons (pos V2004 0) (shen.explode-h (tlstr V2004)))) (true (shen.sys-error shen.explode-h))))
|
210
210
|
|
211
|
-
(defun cd (
|
211
|
+
(defun cd (V2005) (set *home-directory* (if (= V2005 "") "" (shen.app V2005 "/" shen.a))))
|
212
212
|
|
213
|
-
(defun map (
|
213
|
+
(defun map (V2006 V2007) (shen.map-h V2006 V2007 ()))
|
214
214
|
|
215
|
-
(defun shen.map-h (
|
215
|
+
(defun shen.map-h (V2010 V2011 V2012) (cond ((= () V2011) (reverse V2012)) ((cons? V2011) (shen.map-h V2010 (tl V2011) (cons (V2010 (hd V2011)) V2012))) (true (shen.sys-error shen.map-h))))
|
216
216
|
|
217
|
-
(defun length (
|
217
|
+
(defun length (V2013) (shen.length-h V2013 0))
|
218
218
|
|
219
|
-
(defun shen.length-h (
|
219
|
+
(defun shen.length-h (V2014 V2015) (cond ((= () V2014) V2015) (true (shen.length-h (tl V2014) (+ V2015 1)))))
|
220
220
|
|
221
|
-
(defun occurrences (
|
221
|
+
(defun occurrences (V2024 V2025) (cond ((= V2025 V2024) 1) ((cons? V2025) (+ (occurrences V2024 (hd V2025)) (occurrences V2024 (tl V2025)))) (true 0)))
|
222
222
|
|
223
|
-
(defun nth (
|
223
|
+
(defun nth (V2033 V2034) (cond ((and (= 1 V2033) (cons? V2034)) (hd V2034)) ((cons? V2034) (nth (- V2033 1) (tl V2034))) (true (shen.sys-error nth))))
|
224
224
|
|
225
|
-
(defun integer? (
|
225
|
+
(defun integer? (V2035) (and (number? V2035) (let Abs (shen.abs V2035) (shen.integer-test? Abs (shen.magless Abs 1)))))
|
226
226
|
|
227
|
-
(defun shen.abs (
|
227
|
+
(defun shen.abs (V2036) (if (> V2036 0) V2036 (- 0 V2036)))
|
228
228
|
|
229
|
-
(defun shen.magless (
|
229
|
+
(defun shen.magless (V2037 V2038) (let Nx2 (* V2038 2) (if (> Nx2 V2037) V2038 (shen.magless V2037 Nx2))))
|
230
230
|
|
231
|
-
(defun shen.integer-test? (
|
231
|
+
(defun shen.integer-test? (V2042 V2043) (cond ((= 0 V2042) true) ((> 1 V2042) false) (true (let Abs-N (- V2042 V2043) (if (> 0 Abs-N) (integer? V2042) (shen.integer-test? Abs-N V2043))))))
|
232
232
|
|
233
|
-
(defun mapcan (
|
233
|
+
(defun mapcan (V2046 V2047) (cond ((= () V2047) ()) ((cons? V2047) (append (V2046 (hd V2047)) (mapcan V2046 (tl V2047)))) (true (shen.sys-error mapcan))))
|
234
234
|
|
235
|
-
(defun == (
|
235
|
+
(defun == (V2056 V2057) (cond ((= V2057 V2056) true) (true false)))
|
236
236
|
|
237
237
|
(defun abort () (simple-error ""))
|
238
238
|
|
239
|
-
(defun bound? (
|
239
|
+
(defun bound? (V2059) (and (symbol? V2059) (let Val (trap-error (value V2059) (lambda E shen.this-symbol-is-unbound)) (if (= Val shen.this-symbol-is-unbound) false true))))
|
240
240
|
|
241
|
-
(defun shen.string->bytes (
|
241
|
+
(defun shen.string->bytes (V2060) (cond ((= "" V2060) ()) (true (cons (string->n (pos V2060 0)) (shen.string->bytes (tlstr V2060))))))
|
242
242
|
|
243
|
-
(defun maxinferences (
|
243
|
+
(defun maxinferences (V2061) (set shen.*maxinferences* V2061))
|
244
244
|
|
245
245
|
(defun inferences () (value shen.*infs*))
|
246
246
|
|
247
|
-
(defun protect (
|
247
|
+
(defun protect (V2062) V2062)
|
248
248
|
|
249
249
|
(defun stoutput () (value *stoutput*))
|
250
250
|
|
251
|
-
(defun string->symbol (
|
251
|
+
(defun string->symbol (V2063) (let Symbol (intern V2063) (if (symbol? Symbol) Symbol (simple-error (cn "cannot intern " (shen.app V2063 " to a symbol" shen.s))))))
|
252
252
|
|
253
|
-
(defun shen.optimise (
|
253
|
+
(defun shen.optimise (V2068) (cond ((= + V2068) (set shen.*optimise* true)) ((= - V2068) (set shen.*optimise* false)) (true (simple-error "optimise expects a + or a -.
|
254
254
|
"))))
|
255
255
|
|
256
|
+
(defun os () (value *os*))
|
257
|
+
|
258
|
+
(defun language () (value *language*))
|
259
|
+
|
260
|
+
(defun version () (value *version*))
|
261
|
+
|
262
|
+
(defun port () (value *port*))
|
263
|
+
|
264
|
+
(defun porters () (value *porters*))
|
265
|
+
|
266
|
+
(defun implementation () (value *implementation*))
|
267
|
+
|
268
|
+
(defun release () (value *release*))
|
269
|
+
|
256
270
|
|
257
271
|
|