"Copyright (c) 2015, Mark Tarver All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. The name of Mark Tarver may not be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY Mark Tarver ''AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL Mark Tarver BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE." (defun shen.read-char-code (V2227) (read-byte V2227)) (defun read-file-as-bytelist (V2229) (shen.read-file-as-Xlist V2229 (lambda S (read-byte S)))) (defun shen.read-file-as-charlist (V2231) (shen.read-file-as-Xlist V2231 (lambda S (shen.read-char-code S)))) (defun shen.read-file-as-Xlist (V2234 V2235) (let Stream (open V2234 in) (let X (V2235 Stream) (let Xs (shen.read-file-as-Xlist-help Stream V2235 X ()) (let Close (close Stream) (reverse Xs)))))) (defun shen.read-file-as-Xlist-help (V2240 V2241 V2242 V2243) (cond ((= -1 V2242) V2243) (true (shen.read-file-as-Xlist-help V2240 V2241 (V2241 V2240) (cons V2242 V2243))))) (defun read-file-as-string (V2245) (let Stream (open V2245 in) (shen.rfas-h Stream (shen.read-char-code Stream) ""))) (defun shen.rfas-h (V2249 V2250 V2251) (cond ((= -1 V2250) (do (close V2249) V2251)) (true (shen.rfas-h V2249 (shen.read-char-code V2249) (cn V2251 (n->string V2250)))))) (defun input (V2253) (eval-kl (read V2253))) (defun input+ (V2256 V2257) (let Mono? (shen.monotype V2256) (let Input (read V2257) (if (= false (shen.typecheck Input (shen.demodulate V2256))) (simple-error (cn "type error: " (shen.app Input (cn " is not of type " (shen.app V2256 " " shen.r)) shen.r))) (eval-kl Input))))) (defun shen.monotype (V2259) (cond ((cons? V2259) (map (lambda Z (shen.monotype Z)) V2259)) (true (if (variable? V2259) (simple-error (cn "input+ expects a monotype: not " (shen.app V2259 " " shen.a))) V2259)))) (defun read (V2261) (hd (shen.read-loop V2261 (shen.read-char-code V2261) ()))) (defun it () (value shen.*it*)) (defun shen.read-loop (V2269 V2270 V2271) (cond ((= 94 V2270) (simple-error "read aborted")) ((= -1 V2270) (if (empty? V2271) (simple-error "error: empty stream") (compile (lambda X (shen. X)) V2271 (lambda E E)))) ((shen.terminator? V2270) (let AllChars (append V2271 (cons V2270 ())) (let It (shen.record-it AllChars) (let Read (compile (lambda X (shen. X)) AllChars (lambda E shen.nextbyte)) (if (or (= Read shen.nextbyte) (empty? Read)) (shen.read-loop V2269 (shen.read-char-code V2269) AllChars) Read))))) (true (shen.read-loop V2269 (shen.read-char-code V2269) (append V2271 (cons V2270 ())))))) (defun shen.terminator? (V2273) (element? V2273 (cons 9 (cons 10 (cons 13 (cons 32 (cons 34 (cons 41 (cons 93 ()))))))))) (defun lineread (V2275) (shen.lineread-loop (shen.read-char-code V2275) () V2275)) (defun shen.lineread-loop (V2280 V2281 V2282) (cond ((= -1 V2280) (if (empty? V2281) (simple-error "empty stream") (compile (lambda X (shen. X)) V2281 (lambda E E)))) ((= V2280 (shen.hat)) (simple-error "line read aborted")) ((element? V2280 (cons (shen.newline) (cons (shen.carriage-return) ()))) (let Line (compile (lambda X (shen. X)) V2281 (lambda E shen.nextline)) (let It (shen.record-it V2281) (if (or (= Line shen.nextline) (empty? Line)) (shen.lineread-loop (shen.read-char-code V2282) (append V2281 (cons V2280 ())) V2282) Line)))) (true (shen.lineread-loop (shen.read-char-code V2282) (append V2281 (cons V2280 ())) V2282)))) (defun shen.record-it (V2284) (let TrimLeft (shen.trim-whitespace V2284) (let TrimRight (shen.trim-whitespace (reverse TrimLeft)) (let Trimmed (reverse TrimRight) (shen.record-it-h Trimmed))))) (defun shen.trim-whitespace (V2286) (cond ((and (cons? V2286) (element? (hd V2286) (cons 9 (cons 10 (cons 13 (cons 32 ())))))) (shen.trim-whitespace (tl V2286))) (true V2286))) (defun shen.record-it-h (V2288) (do (set shen.*it* (shen.cn-all (map (lambda X (n->string X)) V2288))) V2288)) (defun shen.cn-all (V2290) (cond ((= () V2290) "") ((cons? V2290) (cn (hd V2290) (shen.cn-all (tl V2290)))) (true (shen.f_error shen.cn-all)))) (defun read-file (V2292) (let Charlist (shen.read-file-as-charlist V2292) (compile (lambda X (shen. X)) Charlist (lambda X (shen.read-error X))))) (defun read-from-string (V2294) (let Ns (map (lambda X (string->n X)) (explode V2294)) (compile (lambda X (shen. X)) Ns (lambda X (shen.read-error X))))) (defun shen.read-error (V2302) (cond ((and (cons? V2302) (and (cons? (hd V2302)) (and (cons? (tl V2302)) (= () (tl (tl V2302)))))) (simple-error (cn "read error here: " (shen.app (shen.compress-50 50 (hd V2302)) " " shen.a)))) (true (simple-error "read error ")))) (defun shen.compress-50 (V2309 V2310) (cond ((= () V2310) "") ((= 0 V2309) "") ((cons? V2310) (cn (n->string (hd V2310)) (shen.compress-50 (- V2309 1) (tl V2310)))) (true (shen.f_error shen.compress-50)))) (defun shen. (V2312) (let YaccParse (let Parse_shen. (shen. V2312) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (macroexpand (shen.cons_form (shen.hdtl Parse_shen.))) (shen.hdtl Parse_shen.))) (fail))) (fail))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V2312) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.package-macro (macroexpand (shen.hdtl Parse_shen.)) (shen.hdtl Parse_shen.))) (fail))) (fail))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V2312) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons { (shen.hdtl Parse_shen.))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V2312) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons } (shen.hdtl Parse_shen.))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V2312) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons bar! (shen.hdtl Parse_shen.))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V2312) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons ; (shen.hdtl Parse_shen.))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V2312) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons := (shen.hdtl Parse_shen.))) (fail))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V2312) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons :- (shen.hdtl Parse_shen.))) (fail))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V2312) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons : (shen.hdtl Parse_shen.))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V2312) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (intern ",") (shen.hdtl Parse_shen.))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V2312) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.hdtl Parse_shen.)) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V2312) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (macroexpand (shen.hdtl Parse_shen.)) (shen.hdtl Parse_shen.))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V2312) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.hdtl Parse_shen.)) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_ ( V2312) (if (not (= (fail) Parse_)) (shen.pair (hd Parse_) ()) (fail))) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse))) (defun shen. (V2315) (if (and (cons? (hd V2315)) (= 91 (shen.hdhd V2315))) (let NewStream2313 (shen.pair (shen.tlhd V2315) (shen.hdtl V2315)) (shen.pair (hd NewStream2313) shen.skip)) (fail))) (defun shen. (V2318) (if (and (cons? (hd V2318)) (= 93 (shen.hdhd V2318))) (let NewStream2316 (shen.pair (shen.tlhd V2318) (shen.hdtl V2318)) (shen.pair (hd NewStream2316) shen.skip)) (fail))) (defun shen. (V2321) (if (and (cons? (hd V2321)) (= 123 (shen.hdhd V2321))) (let NewStream2319 (shen.pair (shen.tlhd V2321) (shen.hdtl V2321)) (shen.pair (hd NewStream2319) shen.skip)) (fail))) (defun shen. (V2324) (if (and (cons? (hd V2324)) (= 125 (shen.hdhd V2324))) (let NewStream2322 (shen.pair (shen.tlhd V2324) (shen.hdtl V2324)) (shen.pair (hd NewStream2322) shen.skip)) (fail))) (defun shen. (V2327) (if (and (cons? (hd V2327)) (= 124 (shen.hdhd V2327))) (let NewStream2325 (shen.pair (shen.tlhd V2327) (shen.hdtl V2327)) (shen.pair (hd NewStream2325) shen.skip)) (fail))) (defun shen. (V2330) (if (and (cons? (hd V2330)) (= 59 (shen.hdhd V2330))) (let NewStream2328 (shen.pair (shen.tlhd V2330) (shen.hdtl V2330)) (shen.pair (hd NewStream2328) shen.skip)) (fail))) (defun shen. (V2333) (if (and (cons? (hd V2333)) (= 58 (shen.hdhd V2333))) (let NewStream2331 (shen.pair (shen.tlhd V2333) (shen.hdtl V2333)) (shen.pair (hd NewStream2331) shen.skip)) (fail))) (defun shen. (V2336) (if (and (cons? (hd V2336)) (= 44 (shen.hdhd V2336))) (let NewStream2334 (shen.pair (shen.tlhd V2336) (shen.hdtl V2336)) (shen.pair (hd NewStream2334) shen.skip)) (fail))) (defun shen. (V2339) (if (and (cons? (hd V2339)) (= 61 (shen.hdhd V2339))) (let NewStream2337 (shen.pair (shen.tlhd V2339) (shen.hdtl V2339)) (shen.pair (hd NewStream2337) shen.skip)) (fail))) (defun shen. (V2342) (if (and (cons? (hd V2342)) (= 45 (shen.hdhd V2342))) (let NewStream2340 (shen.pair (shen.tlhd V2342) (shen.hdtl V2342)) (shen.pair (hd NewStream2340) shen.skip)) (fail))) (defun shen. (V2345) (if (and (cons? (hd V2345)) (= 40 (shen.hdhd V2345))) (let NewStream2343 (shen.pair (shen.tlhd V2345) (shen.hdtl V2345)) (shen.pair (hd NewStream2343) shen.skip)) (fail))) (defun shen. (V2348) (if (and (cons? (hd V2348)) (= 41 (shen.hdhd V2348))) (let NewStream2346 (shen.pair (shen.tlhd V2348) (shen.hdtl V2348)) (shen.pair (hd NewStream2346) shen.skip)) (fail))) (defun shen. (V2350) (let YaccParse (let Parse_shen. (shen. V2350) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.control-chars (shen.hdtl Parse_shen.))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V2350) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.hdtl Parse_shen.)) (fail))) (if (= YaccParse (fail)) (let Parse_shen. (shen. V2350) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (if (= (shen.hdtl Parse_shen.) "<>") (cons vector (cons 0 ())) (intern (shen.hdtl Parse_shen.)))) (fail))) YaccParse)) YaccParse))) (defun shen.control-chars (V2352) (cond ((= () V2352) "") ((and (cons? V2352) (and (= "c" (hd V2352)) (and (cons? (tl V2352)) (= "#" (hd (tl V2352)))))) (let CodePoint (shen.code-point (tl (tl V2352))) (let AfterCodePoint (shen.after-codepoint (tl (tl V2352))) (@s (n->string (shen.decimalise CodePoint)) (shen.control-chars AfterCodePoint))))) ((cons? V2352) (@s (hd V2352) (shen.control-chars (tl V2352)))) (true (shen.f_error shen.control-chars)))) (defun shen.code-point (V2356) (cond ((and (cons? V2356) (= ";" (hd V2356))) "") ((and (cons? V2356) (element? (hd V2356) (cons "0" (cons "1" (cons "2" (cons "3" (cons "4" (cons "5" (cons "6" (cons "7" (cons "8" (cons "9" (cons "0" ()))))))))))))) (cons (hd V2356) (shen.code-point (tl V2356)))) (true (simple-error (cn "code point parse error " (shen.app V2356 " " shen.a)))))) (defun shen.after-codepoint (V2362) (cond ((= () V2362) ()) ((and (cons? V2362) (= ";" (hd V2362))) (tl V2362)) ((cons? V2362) (shen.after-codepoint (tl V2362))) (true (shen.f_error shen.after-codepoint)))) (defun shen.decimalise (V2364) (shen.pre (reverse (shen.digits->integers V2364)) 0)) (defun shen.digits->integers (V2370) (cond ((and (cons? V2370) (= "0" (hd V2370))) (cons 0 (shen.digits->integers (tl V2370)))) ((and (cons? V2370) (= "1" (hd V2370))) (cons 1 (shen.digits->integers (tl V2370)))) ((and (cons? V2370) (= "2" (hd V2370))) (cons 2 (shen.digits->integers (tl V2370)))) ((and (cons? V2370) (= "3" (hd V2370))) (cons 3 (shen.digits->integers (tl V2370)))) ((and (cons? V2370) (= "4" (hd V2370))) (cons 4 (shen.digits->integers (tl V2370)))) ((and (cons? V2370) (= "5" (hd V2370))) (cons 5 (shen.digits->integers (tl V2370)))) ((and (cons? V2370) (= "6" (hd V2370))) (cons 6 (shen.digits->integers (tl V2370)))) ((and (cons? V2370) (= "7" (hd V2370))) (cons 7 (shen.digits->integers (tl V2370)))) ((and (cons? V2370) (= "8" (hd V2370))) (cons 8 (shen.digits->integers (tl V2370)))) ((and (cons? V2370) (= "9" (hd V2370))) (cons 9 (shen.digits->integers (tl V2370)))) (true ()))) (defun shen. (V2372) (let Parse_shen. (shen. V2372) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (@s (shen.hdtl Parse_shen.) (shen.hdtl Parse_shen.))) (fail))) (fail)))) (defun shen. (V2374) (let YaccParse (let Parse_shen. (shen. V2374) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (@s (shen.hdtl Parse_shen.) (shen.hdtl Parse_shen.))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_ ( V2374) (if (not (= (fail) Parse_)) (shen.pair (hd Parse_) "") (fail))) YaccParse))) (defun shen. (V2376) (let YaccParse (let Parse_shen. (shen. V2376) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.hdtl Parse_shen.)) (fail))) (if (= YaccParse (fail)) (let Parse_shen. (shen. V2376) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.hdtl Parse_shen.)) (fail))) YaccParse))) (defun shen. (V2378) (if (cons? (hd V2378)) (let Parse_Char (shen.hdhd V2378) (if (shen.numbyte? Parse_Char) (shen.pair (hd (shen.pair (shen.tlhd V2378) (shen.hdtl V2378))) (n->string Parse_Char)) (fail))) (fail))) (defun shen.numbyte? (V2384) (cond ((= 48 V2384) true) ((= 49 V2384) true) ((= 50 V2384) true) ((= 51 V2384) true) ((= 52 V2384) true) ((= 53 V2384) true) ((= 54 V2384) true) ((= 55 V2384) true) ((= 56 V2384) true) ((= 57 V2384) true) (true false))) (defun shen. (V2386) (if (cons? (hd V2386)) (let Parse_Char (shen.hdhd V2386) (if (shen.symbol-code? Parse_Char) (shen.pair (hd (shen.pair (shen.tlhd V2386) (shen.hdtl V2386))) (n->string Parse_Char)) (fail))) (fail))) (defun shen.symbol-code? (V2388) (or (= V2388 126) (or (and (> V2388 94) (< V2388 123)) (or (and (> V2388 59) (< V2388 91)) (or (and (> V2388 41) (and (< V2388 58) (not (= V2388 44)))) (or (and (> V2388 34) (< V2388 40)) (= V2388 33))))))) (defun shen. (V2390) (let Parse_shen. (shen. V2390) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.hdtl Parse_shen.)) (fail))) (fail))) (fail)))) (defun shen. (V2392) (if (cons? (hd V2392)) (let Parse_Char (shen.hdhd V2392) (if (= Parse_Char 34) (shen.pair (hd (shen.pair (shen.tlhd V2392) (shen.hdtl V2392))) Parse_Char) (fail))) (fail))) (defun shen. (V2394) (let YaccParse (let Parse_shen. (shen. V2394) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (shen.hdtl Parse_shen.) (shen.hdtl Parse_shen.))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_ ( V2394) (if (not (= (fail) Parse_)) (shen.pair (hd Parse_) ()) (fail))) YaccParse))) (defun shen. (V2396) (if (cons? (hd V2396)) (let Parse_Char (shen.hdhd V2396) (shen.pair (hd (shen.pair (shen.tlhd V2396) (shen.hdtl V2396))) (n->string Parse_Char))) (fail))) (defun shen. (V2398) (if (cons? (hd V2398)) (let Parse_Char (shen.hdhd V2398) (if (not (= Parse_Char 34)) (shen.pair (hd (shen.pair (shen.tlhd V2398) (shen.hdtl V2398))) (n->string Parse_Char)) (fail))) (fail))) (defun shen. (V2400) (let YaccParse (let Parse_shen. (shen. V2400) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (- 0 (shen.hdtl Parse_shen.))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V2400) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.hdtl Parse_shen.)) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V2400) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (* (shen.expt 10 (shen.hdtl Parse_shen.)) (+ (shen.pre (reverse (shen.hdtl Parse_shen.)) 0) (shen.post (shen.hdtl Parse_shen.) 1)))) (fail))) (fail))) (fail))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V2400) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (* (shen.expt 10 (shen.hdtl Parse_shen.)) (shen.pre (reverse (shen.hdtl Parse_shen.)) 0))) (fail))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V2400) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (+ (shen.pre (reverse (shen.hdtl Parse_shen.)) 0) (shen.post (shen.hdtl Parse_shen.) 1))) (fail))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_shen. (shen. V2400) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.pre (reverse (shen.hdtl Parse_shen.)) 0)) (fail))) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse))) (defun shen. (V2403) (if (and (cons? (hd V2403)) (= 101 (shen.hdhd V2403))) (let NewStream2401 (shen.pair (shen.tlhd V2403) (shen.hdtl V2403)) (shen.pair (hd NewStream2401) shen.skip)) (fail))) (defun shen. (V2405) (let YaccParse (let Parse_shen. (shen. V2405) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (- 0 (shen.pre (reverse (shen.hdtl Parse_shen.)) 0))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_shen. (shen. V2405) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.pre (reverse (shen.hdtl Parse_shen.)) 0)) (fail))) YaccParse))) (defun shen. (V2407) (if (cons? (hd V2407)) (let Parse_Char (shen.hdhd V2407) (if (= Parse_Char 43) (shen.pair (hd (shen.pair (shen.tlhd V2407) (shen.hdtl V2407))) Parse_Char) (fail))) (fail))) (defun shen. (V2409) (if (cons? (hd V2409)) (let Parse_Char (shen.hdhd V2409) (if (= Parse_Char 46) (shen.pair (hd (shen.pair (shen.tlhd V2409) (shen.hdtl V2409))) Parse_Char) (fail))) (fail))) (defun shen. (V2411) (let YaccParse (let Parse_shen. (shen. V2411) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.hdtl Parse_shen.)) (fail))) (if (= YaccParse (fail)) (let Parse_ ( V2411) (if (not (= (fail) Parse_)) (shen.pair (hd Parse_) ()) (fail))) YaccParse))) (defun shen. (V2413) (let Parse_shen. (shen. V2413) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.hdtl Parse_shen.)) (fail)))) (defun shen. (V2415) (let YaccParse (let Parse_shen. (shen. V2415) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (shen.hdtl Parse_shen.) (shen.hdtl Parse_shen.))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_shen. (shen. V2415) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (shen.hdtl Parse_shen.) ())) (fail))) YaccParse))) (defun shen. (V2417) (if (cons? (hd V2417)) (let Parse_X (shen.hdhd V2417) (if (shen.numbyte? Parse_X) (shen.pair (hd (shen.pair (shen.tlhd V2417) (shen.hdtl V2417))) (shen.byte->digit Parse_X)) (fail))) (fail))) (defun shen.byte->digit (V2419) (cond ((= 48 V2419) 0) ((= 49 V2419) 1) ((= 50 V2419) 2) ((= 51 V2419) 3) ((= 52 V2419) 4) ((= 53 V2419) 5) ((= 54 V2419) 6) ((= 55 V2419) 7) ((= 56 V2419) 8) ((= 57 V2419) 9) (true (shen.f_error shen.byte->digit)))) (defun shen.pre (V2424 V2425) (cond ((= () V2424) 0) ((cons? V2424) (+ (* (shen.expt 10 V2425) (hd V2424)) (shen.pre (tl V2424) (+ V2425 1)))) (true (shen.f_error shen.pre)))) (defun shen.post (V2430 V2431) (cond ((= () V2430) 0) ((cons? V2430) (+ (* (shen.expt 10 (- 0 V2431)) (hd V2430)) (shen.post (tl V2430) (+ V2431 1)))) (true (shen.f_error shen.post)))) (defun shen.expt (V2436 V2437) (cond ((= 0 V2437) 1) ((> V2437 0) (* V2436 (shen.expt V2436 (- V2437 1)))) (true (* 1.000000000000000 (/ (shen.expt V2436 (+ V2437 1)) V2436))))) (defun shen. (V2439) (let Parse_shen. (shen. V2439) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.hdtl Parse_shen.)) (fail)))) (defun shen. (V2441) (let Parse_shen. (shen. V2441) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.hdtl Parse_shen.)) (fail)))) (defun shen. (V2443) (let YaccParse (let Parse_shen. (shen. V2443) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) shen.skip) (fail))) (if (= YaccParse (fail)) (let Parse_shen. (shen. V2443) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) shen.skip) (fail))) YaccParse))) (defun shen. (V2445) (let Parse_shen. (shen. V2445) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) shen.skip) (fail))) (fail))) (fail))) (fail)))) (defun shen. (V2448) (if (and (cons? (hd V2448)) (= 92 (shen.hdhd V2448))) (let NewStream2446 (shen.pair (shen.tlhd V2448) (shen.hdtl V2448)) (shen.pair (hd NewStream2446) shen.skip)) (fail))) (defun shen. (V2450) (let YaccParse (let Parse_shen. (shen. V2450) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) shen.skip) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_ ( V2450) (if (not (= (fail) Parse_)) (shen.pair (hd Parse_) shen.skip) (fail))) YaccParse))) (defun shen. (V2452) (if (cons? (hd V2452)) (let Parse_X (shen.hdhd V2452) (if (not (element? Parse_X (cons 10 (cons 13 ())))) (shen.pair (hd (shen.pair (shen.tlhd V2452) (shen.hdtl V2452))) shen.skip) (fail))) (fail))) (defun shen. (V2454) (if (cons? (hd V2454)) (let Parse_X (shen.hdhd V2454) (if (element? Parse_X (cons 10 (cons 13 ()))) (shen.pair (hd (shen.pair (shen.tlhd V2454) (shen.hdtl V2454))) shen.skip) (fail))) (fail))) (defun shen. (V2456) (let Parse_shen. (shen. V2456) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) shen.skip) (fail))) (fail))) (fail)))) (defun shen. (V2459) (if (and (cons? (hd V2459)) (= 42 (shen.hdhd V2459))) (let NewStream2457 (shen.pair (shen.tlhd V2459) (shen.hdtl V2459)) (shen.pair (hd NewStream2457) shen.skip)) (fail))) (defun shen. (V2461) (let YaccParse (let Parse_shen. (shen. V2461) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) shen.skip) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V2461) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) shen.skip) (fail))) (fail))) (if (= YaccParse (fail)) (if (cons? (hd V2461)) (let Parse_X (shen.hdhd V2461) (let Parse_shen. (shen. (shen.pair (shen.tlhd V2461) (shen.hdtl V2461))) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) shen.skip) (fail)))) (fail)) YaccParse)) YaccParse))) (defun shen. (V2463) (let YaccParse (let Parse_shen. (shen. V2463) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) shen.skip) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_shen. (shen. V2463) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) shen.skip) (fail))) YaccParse))) (defun shen. (V2465) (if (cons? (hd V2465)) (let Parse_X (shen.hdhd V2465) (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 (shen.tlhd V2465) (shen.hdtl V2465))) shen.skip) (fail))) (fail))) (defun shen.cons_form (V2467) (cond ((= () V2467) ()) ((and (cons? V2467) (and (cons? (tl V2467)) (and (cons? (tl (tl V2467))) (and (= () (tl (tl (tl V2467)))) (= (hd (tl V2467)) bar!))))) (cons cons (cons (hd V2467) (tl (tl V2467))))) ((cons? V2467) (cons cons (cons (hd V2467) (cons (shen.cons_form (tl V2467)) ())))) (true (shen.f_error shen.cons_form)))) (defun shen.package-macro (V2472 V2473) (cond ((and (cons? V2472) (and (= $ (hd V2472)) (and (cons? (tl V2472)) (= () (tl (tl V2472)))))) (append (explode (hd (tl V2472))) V2473)) ((and (cons? V2472) (and (= package (hd V2472)) (and (cons? (tl V2472)) (and (= null (hd (tl V2472))) (cons? (tl (tl V2472))))))) (append (tl (tl (tl V2472))) V2473)) ((and (cons? V2472) (and (= package (hd V2472)) (and (cons? (tl V2472)) (cons? (tl (tl V2472)))))) (let ListofExceptions (shen.eval-without-macros (hd (tl (tl V2472)))) (let External (shen.record-exceptions ListofExceptions (hd (tl V2472))) (let PackageNameDot (intern (cn (str (hd (tl V2472))) ".")) (let ExpPackageNameDot (explode PackageNameDot) (let Packaged (shen.packageh PackageNameDot ListofExceptions (tl (tl (tl V2472))) ExpPackageNameDot) (let Internal (shen.record-internal (hd (tl V2472)) (shen.internal-symbols ExpPackageNameDot Packaged)) (append Packaged V2473)))))))) (true (cons V2472 V2473)))) (defun shen.record-exceptions (V2476 V2477) (let CurrExceptions (trap-error (get V2477 shen.external-symbols (value *property-vector*)) (lambda E ())) (let AllExceptions (union V2476 CurrExceptions) (put V2477 shen.external-symbols AllExceptions (value *property-vector*))))) (defun shen.record-internal (V2480 V2481) (put V2480 shen.internal-symbols (union V2481 (trap-error (get V2480 shen.internal-symbols (value *property-vector*)) (lambda E ()))) (value *property-vector*))) (defun shen.internal-symbols (V2492 V2493) (cond ((and (symbol? V2493) (shen.prefix? V2492 (explode V2493))) (cons V2493 ())) ((cons? V2493) (union (shen.internal-symbols V2492 (hd V2493)) (shen.internal-symbols V2492 (tl V2493)))) (true ()))) (defun shen.packageh (V2510 V2511 V2512 V2513) (cond ((cons? V2512) (cons (shen.packageh V2510 V2511 (hd V2512) V2513) (shen.packageh V2510 V2511 (tl V2512) V2513))) ((or (shen.sysfunc? V2512) (or (variable? V2512) (or (element? V2512 V2511) (or (shen.doubleunderline? V2512) (shen.singleunderline? V2512))))) V2512) ((and (symbol? V2512) (let ExplodeX (explode V2512) (and (not (shen.prefix? (cons "s" (cons "h" (cons "e" (cons "n" (cons "." ()))))) ExplodeX)) (not (shen.prefix? V2513 ExplodeX))))) (concat V2510 V2512)) (true V2512)))