shen-ruby 0.12.1 → 0.13.0

data/shen/release/klambda/reader.kl

@@ -0,0 +1,198 @@
+"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 read-file-as-bytelist (V1182) (let Stream (open V1182 in) (let Byte (read-byte Stream) (let Bytes (shen.read-file-as-bytelist-help Stream Byte ()) (let Close (close Stream) (reverse Bytes))))))
+
+(defun shen.read-file-as-bytelist-help (V1183 V1184 V1185) (cond ((= -1 V1184) V1185) (true (shen.read-file-as-bytelist-help V1183 (read-byte V1183) (cons V1184 V1185)))))
+
+(defun read-file-as-string (V1186) (let Stream (open V1186 in) (shen.rfas-h Stream (read-byte Stream) "")))
+
+(defun shen.rfas-h (V1187 V1188 V1189) (cond ((= -1 V1188) (do (close V1187) V1189)) (true (shen.rfas-h V1187 (read-byte V1187) (cn V1189 (n->string V1188))))))
+
+(defun input (V1190) (eval-kl (read V1190)))
+
+(defun input+ (V1191 V1192) (let Mono? (shen.monotype V1191) (let Input (read V1192) (if (= false (shen.typecheck Input (shen.demodulate V1191))) (simple-error (cn "type error: " (shen.app Input (cn " is not of type " (shen.app V1191 "
+" shen.r)) shen.r))) (eval-kl Input)))))
+
+(defun shen.monotype (V1193) (cond ((cons? V1193) (map shen.monotype V1193)) (true (if (variable? V1193) (simple-error (cn "input+ expects a monotype: not " (shen.app V1193 "
+" shen.a))) V1193))))
+
+(defun read (V1194) (hd (shen.read-loop V1194 (read-byte V1194) ())))
+
+(defun it () (value shen.*it*))
+
+(defun shen.read-loop (V1199 V1200 V1201) (cond ((= 94 V1200) (simple-error "read aborted")) ((= -1 V1200) (if (empty? V1201) (simple-error "error: empty stream") (compile shen.<st_input> V1201 (lambda E E)))) ((shen.terminator? V1200) (let AllBytes (append V1201 (cons V1200 ())) (let It (shen.record-it AllBytes) (let Read (compile shen.<st_input> AllBytes (lambda E shen.nextbyte)) (if (or (= Read shen.nextbyte) (empty? Read)) (shen.read-loop V1199 (read-byte V1199) AllBytes) Read))))) (true (shen.read-loop V1199 (read-byte V1199) (append V1201 (cons V1200 ()))))))
+
+(defun shen.terminator? (V1202) (element? V1202 (cons 9 (cons 10 (cons 13 (cons 32 (cons 34 (cons 41 (cons 93 ())))))))))
+
+(defun lineread (V1203) (shen.lineread-loop (read-byte V1203) () V1203))
+
+(defun shen.lineread-loop (V1205 V1206 V1207) (cond ((= -1 V1205) (if (empty? V1206) (simple-error "empty stream") (compile shen.<st_input> V1206 (lambda E E)))) ((= V1205 (shen.hat)) (simple-error "line read aborted")) ((element? V1205 (cons (shen.newline) (cons (shen.carriage-return) ()))) (let Line (compile shen.<st_input> V1206 (lambda E shen.nextline)) (let It (shen.record-it V1206) (if (or (= Line shen.nextline) (empty? Line)) (shen.lineread-loop (read-byte V1207) (append V1206 (cons V1205 ())) V1207) Line)))) (true (shen.lineread-loop (read-byte V1207) (append V1206 (cons V1205 ())) V1207))))
+
+(defun shen.record-it (V1208) (let TrimLeft (shen.trim-whitespace V1208) (let TrimRight (shen.trim-whitespace (reverse TrimLeft)) (let Trimmed (reverse TrimRight) (shen.record-it-h Trimmed)))))
+
+(defun shen.trim-whitespace (V1209) (cond ((and (cons? V1209) (element? (hd V1209) (cons 9 (cons 10 (cons 13 (cons 32 ())))))) (shen.trim-whitespace (tl V1209))) (true V1209)))
+
+(defun shen.record-it-h (V1210) (do (set shen.*it* (shen.cn-all (map (lambda V1180 (n->string V1180)) V1210))) V1210))
+
+(defun shen.cn-all (V1211) (cond ((= () V1211) "") ((cons? V1211) (cn (hd V1211) (shen.cn-all (tl V1211)))) (true (shen.f_error shen.cn-all))))
+
+(defun read-file (V1212) (let Bytelist (read-file-as-bytelist V1212) (compile shen.<st_input> Bytelist shen.read-error)))
+
+(defun read-from-string (V1213) (let Ns (map (lambda V1181 (string->n V1181)) (explode V1213)) (compile shen.<st_input> Ns shen.read-error)))
+
+(defun shen.read-error (V1220) (cond ((and (cons? V1220) (and (cons? (hd V1220)) (and (cons? (tl V1220)) (= () (tl (tl V1220)))))) (simple-error (cn "read error here:
+
+ " (shen.app (shen.compress-50 50 (hd V1220)) "
+" shen.a)))) (true (simple-error "read error
+"))))
+
+(defun shen.compress-50 (V1225 V1226) (cond ((= () V1226) "") ((= 0 V1225) "") ((cons? V1226) (cn (n->string (hd V1226)) (shen.compress-50 (- V1225 1) (tl V1226)))) (true (shen.f_error shen.compress-50))))
+
+(defun shen.<st_input> (V1227) (let YaccParse (let Parse_shen.<lsb> (shen.<lsb> V1227) (if (not (= (fail) Parse_shen.<lsb>)) (let Parse_shen.<st_input1> (shen.<st_input1> Parse_shen.<lsb>) (if (not (= (fail) Parse_shen.<st_input1>)) (let Parse_shen.<rsb> (shen.<rsb> Parse_shen.<st_input1>) (if (not (= (fail) Parse_shen.<rsb>)) (let Parse_shen.<st_input2> (shen.<st_input2> Parse_shen.<rsb>) (if (not (= (fail) Parse_shen.<st_input2>)) (shen.pair (hd Parse_shen.<st_input2>) (cons (macroexpand (shen.cons_form (shen.hdtl Parse_shen.<st_input1>))) (shen.hdtl Parse_shen.<st_input2>))) (fail))) (fail))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen.<lrb> (shen.<lrb> V1227) (if (not (= (fail) Parse_shen.<lrb>)) (let Parse_shen.<st_input1> (shen.<st_input1> Parse_shen.<lrb>) (if (not (= (fail) Parse_shen.<st_input1>)) (let Parse_shen.<rrb> (shen.<rrb> Parse_shen.<st_input1>) (if (not (= (fail) Parse_shen.<rrb>)) (let Parse_shen.<st_input2> (shen.<st_input2> Parse_shen.<rrb>) (if (not (= (fail) Parse_shen.<st_input2>)) (shen.pair (hd Parse_shen.<st_input2>) (shen.package-macro (macroexpand (shen.hdtl Parse_shen.<st_input1>)) (shen.hdtl Parse_shen.<st_input2>))) (fail))) (fail))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen.<lcurly> (shen.<lcurly> V1227) (if (not (= (fail) Parse_shen.<lcurly>)) (let Parse_shen.<st_input> (shen.<st_input> Parse_shen.<lcurly>) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (cons { (shen.hdtl Parse_shen.<st_input>))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen.<rcurly> (shen.<rcurly> V1227) (if (not (= (fail) Parse_shen.<rcurly>)) (let Parse_shen.<st_input> (shen.<st_input> Parse_shen.<rcurly>) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (cons } (shen.hdtl Parse_shen.<st_input>))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen.<bar> (shen.<bar> V1227) (if (not (= (fail) Parse_shen.<bar>)) (let Parse_shen.<st_input> (shen.<st_input> Parse_shen.<bar>) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (cons bar! (shen.hdtl Parse_shen.<st_input>))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen.<semicolon> (shen.<semicolon> V1227) (if (not (= (fail) Parse_shen.<semicolon>)) (let Parse_shen.<st_input> (shen.<st_input> Parse_shen.<semicolon>) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (cons ; (shen.hdtl Parse_shen.<st_input>))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen.<colon> (shen.<colon> V1227) (if (not (= (fail) Parse_shen.<colon>)) (let Parse_shen.<equal> (shen.<equal> Parse_shen.<colon>) (if (not (= (fail) Parse_shen.<equal>)) (let Parse_shen.<st_input> (shen.<st_input> Parse_shen.<equal>) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (cons := (shen.hdtl Parse_shen.<st_input>))) (fail))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen.<colon> (shen.<colon> V1227) (if (not (= (fail) Parse_shen.<colon>)) (let Parse_shen.<minus> (shen.<minus> Parse_shen.<colon>) (if (not (= (fail) Parse_shen.<minus>)) (let Parse_shen.<st_input> (shen.<st_input> Parse_shen.<minus>) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (cons :- (shen.hdtl Parse_shen.<st_input>))) (fail))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen.<colon> (shen.<colon> V1227) (if (not (= (fail) Parse_shen.<colon>)) (let Parse_shen.<st_input> (shen.<st_input> Parse_shen.<colon>) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (cons : (shen.hdtl Parse_shen.<st_input>))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen.<comma> (shen.<comma> V1227) (if (not (= (fail) Parse_shen.<comma>)) (let Parse_shen.<st_input> (shen.<st_input> Parse_shen.<comma>) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (cons (intern ",") (shen.hdtl Parse_shen.<st_input>))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen.<comment> (shen.<comment> V1227) (if (not (= (fail) Parse_shen.<comment>)) (let Parse_shen.<st_input> (shen.<st_input> Parse_shen.<comment>) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (shen.hdtl Parse_shen.<st_input>)) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen.<atom> (shen.<atom> V1227) (if (not (= (fail) Parse_shen.<atom>)) (let Parse_shen.<st_input> (shen.<st_input> Parse_shen.<atom>) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (cons (macroexpand (shen.hdtl Parse_shen.<atom>)) (shen.hdtl Parse_shen.<st_input>))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen.<whitespaces> (shen.<whitespaces> V1227) (if (not (= (fail) Parse_shen.<whitespaces>)) (let Parse_shen.<st_input> (shen.<st_input> Parse_shen.<whitespaces>) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (shen.hdtl Parse_shen.<st_input>)) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_<e> (<e> V1227) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) ()) (fail))) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)))
+
+(defun shen.<lsb> (V1228) (if (and (cons? (hd V1228)) (= 91 (hd (hd V1228)))) (shen.pair (hd (shen.pair (tl (hd V1228)) (shen.hdtl V1228))) shen.skip) (fail)))
+
+(defun shen.<rsb> (V1229) (if (and (cons? (hd V1229)) (= 93 (hd (hd V1229)))) (shen.pair (hd (shen.pair (tl (hd V1229)) (shen.hdtl V1229))) shen.skip) (fail)))
+
+(defun shen.<lcurly> (V1230) (if (and (cons? (hd V1230)) (= 123 (hd (hd V1230)))) (shen.pair (hd (shen.pair (tl (hd V1230)) (shen.hdtl V1230))) shen.skip) (fail)))
+
+(defun shen.<rcurly> (V1231) (if (and (cons? (hd V1231)) (= 125 (hd (hd V1231)))) (shen.pair (hd (shen.pair (tl (hd V1231)) (shen.hdtl V1231))) shen.skip) (fail)))
+
+(defun shen.<bar> (V1232) (if (and (cons? (hd V1232)) (= 124 (hd (hd V1232)))) (shen.pair (hd (shen.pair (tl (hd V1232)) (shen.hdtl V1232))) shen.skip) (fail)))
+
+(defun shen.<semicolon> (V1233) (if (and (cons? (hd V1233)) (= 59 (hd (hd V1233)))) (shen.pair (hd (shen.pair (tl (hd V1233)) (shen.hdtl V1233))) shen.skip) (fail)))
+
+(defun shen.<colon> (V1234) (if (and (cons? (hd V1234)) (= 58 (hd (hd V1234)))) (shen.pair (hd (shen.pair (tl (hd V1234)) (shen.hdtl V1234))) shen.skip) (fail)))
+
+(defun shen.<comma> (V1235) (if (and (cons? (hd V1235)) (= 44 (hd (hd V1235)))) (shen.pair (hd (shen.pair (tl (hd V1235)) (shen.hdtl V1235))) shen.skip) (fail)))
+
+(defun shen.<equal> (V1236) (if (and (cons? (hd V1236)) (= 61 (hd (hd V1236)))) (shen.pair (hd (shen.pair (tl (hd V1236)) (shen.hdtl V1236))) shen.skip) (fail)))
+
+(defun shen.<minus> (V1237) (if (and (cons? (hd V1237)) (= 45 (hd (hd V1237)))) (shen.pair (hd (shen.pair (tl (hd V1237)) (shen.hdtl V1237))) shen.skip) (fail)))
+
+(defun shen.<lrb> (V1238) (if (and (cons? (hd V1238)) (= 40 (hd (hd V1238)))) (shen.pair (hd (shen.pair (tl (hd V1238)) (shen.hdtl V1238))) shen.skip) (fail)))
+
+(defun shen.<rrb> (V1239) (if (and (cons? (hd V1239)) (= 41 (hd (hd V1239)))) (shen.pair (hd (shen.pair (tl (hd V1239)) (shen.hdtl V1239))) shen.skip) (fail)))
+
+(defun shen.<atom> (V1240) (let YaccParse (let Parse_shen.<str> (shen.<str> V1240) (if (not (= (fail) Parse_shen.<str>)) (shen.pair (hd Parse_shen.<str>) (shen.control-chars (shen.hdtl Parse_shen.<str>))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen.<number> (shen.<number> V1240) (if (not (= (fail) Parse_shen.<number>)) (shen.pair (hd Parse_shen.<number>) (shen.hdtl Parse_shen.<number>)) (fail))) (if (= YaccParse (fail)) (let Parse_shen.<sym> (shen.<sym> V1240) (if (not (= (fail) Parse_shen.<sym>)) (shen.pair (hd Parse_shen.<sym>) (if (= (shen.hdtl Parse_shen.<sym>) "<>") (cons vector (cons 0 ())) (intern (shen.hdtl Parse_shen.<sym>)))) (fail))) YaccParse)) YaccParse)))
+
+(defun shen.control-chars (V1241) (cond ((= () V1241) "") ((and (cons? V1241) (and (= "c" (hd V1241)) (and (cons? (tl V1241)) (= "#" (hd (tl V1241)))))) (let CodePoint (shen.code-point (tl (tl V1241))) (let AfterCodePoint (shen.after-codepoint (tl (tl V1241))) (@s (n->string (shen.decimalise CodePoint)) (shen.control-chars AfterCodePoint))))) ((cons? V1241) (@s (hd V1241) (shen.control-chars (tl V1241)))) (true (shen.f_error shen.control-chars))))
+
+(defun shen.code-point (V1244) (cond ((and (cons? V1244) (= ";" (hd V1244))) "") ((and (cons? V1244) (element? (hd V1244) (cons "0" (cons "1" (cons "2" (cons "3" (cons "4" (cons "5" (cons "6" (cons "7" (cons "8" (cons "9" (cons "0" ()))))))))))))) (cons (hd V1244) (shen.code-point (tl V1244)))) (true (simple-error (cn "code point parse error " (shen.app V1244 "
+" shen.a))))))
+
+(defun shen.after-codepoint (V1249) (cond ((= () V1249) ()) ((and (cons? V1249) (= ";" (hd V1249))) (tl V1249)) ((cons? V1249) (shen.after-codepoint (tl V1249))) (true (shen.f_error shen.after-codepoint))))
+
+(defun shen.decimalise (V1250) (shen.pre (reverse (shen.digits->integers V1250)) 0))
+
+(defun shen.digits->integers (V1255) (cond ((and (cons? V1255) (= "0" (hd V1255))) (cons 0 (shen.digits->integers (tl V1255)))) ((and (cons? V1255) (= "1" (hd V1255))) (cons 1 (shen.digits->integers (tl V1255)))) ((and (cons? V1255) (= "2" (hd V1255))) (cons 2 (shen.digits->integers (tl V1255)))) ((and (cons? V1255) (= "3" (hd V1255))) (cons 3 (shen.digits->integers (tl V1255)))) ((and (cons? V1255) (= "4" (hd V1255))) (cons 4 (shen.digits->integers (tl V1255)))) ((and (cons? V1255) (= "5" (hd V1255))) (cons 5 (shen.digits->integers (tl V1255)))) ((and (cons? V1255) (= "6" (hd V1255))) (cons 6 (shen.digits->integers (tl V1255)))) ((and (cons? V1255) (= "7" (hd V1255))) (cons 7 (shen.digits->integers (tl V1255)))) ((and (cons? V1255) (= "8" (hd V1255))) (cons 8 (shen.digits->integers (tl V1255)))) ((and (cons? V1255) (= "9" (hd V1255))) (cons 9 (shen.digits->integers (tl V1255)))) (true ())))
+
+(defun shen.<sym> (V1256) (let Parse_shen.<alpha> (shen.<alpha> V1256) (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))))
+
+(defun shen.<alphanums> (V1257) (let YaccParse (let Parse_shen.<alphanum> (shen.<alphanum> V1257) (if (not (= (fail) Parse_shen.<alphanum>)) (let Parse_shen.<alphanums> (shen.<alphanums> Parse_shen.<alphanum>) (if (not (= (fail) Parse_shen.<alphanums>)) (shen.pair (hd Parse_shen.<alphanums>) (@s (shen.hdtl Parse_shen.<alphanum>) (shen.hdtl Parse_shen.<alphanums>))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_<e> (<e> V1257) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) "") (fail))) YaccParse)))
+
+(defun shen.<alphanum> (V1258) (let YaccParse (let Parse_shen.<alpha> (shen.<alpha> V1258) (if (not (= (fail) Parse_shen.<alpha>)) (shen.pair (hd Parse_shen.<alpha>) (shen.hdtl Parse_shen.<alpha>)) (fail))) (if (= YaccParse (fail)) (let Parse_shen.<num> (shen.<num> V1258) (if (not (= (fail) Parse_shen.<num>)) (shen.pair (hd Parse_shen.<num>) (shen.hdtl Parse_shen.<num>)) (fail))) YaccParse)))
+
+(defun shen.<num> (V1259) (if (cons? (hd V1259)) (let Parse_Byte (hd (hd V1259)) (if (shen.numbyte? Parse_Byte) (shen.pair (hd (shen.pair (tl (hd V1259)) (shen.hdtl V1259))) (n->string Parse_Byte)) (fail))) (fail)))
+
+(defun shen.numbyte? (V1264) (cond ((= 48 V1264) true) ((= 49 V1264) true) ((= 50 V1264) true) ((= 51 V1264) true) ((= 52 V1264) true) ((= 53 V1264) true) ((= 54 V1264) true) ((= 55 V1264) true) ((= 56 V1264) true) ((= 57 V1264) true) (true false)))
+
+(defun shen.<alpha> (V1265) (if (cons? (hd V1265)) (let Parse_Byte (hd (hd V1265)) (if (shen.symbol-code? Parse_Byte) (shen.pair (hd (shen.pair (tl (hd V1265)) (shen.hdtl V1265))) (n->string Parse_Byte)) (fail))) (fail)))
+
+(defun shen.symbol-code? (V1266) (or (= V1266 126) (or (and (> V1266 94) (< V1266 123)) (or (and (> V1266 59) (< V1266 91)) (or (and (> V1266 41) (and (< V1266 58) (not (= V1266 44)))) (or (and (> V1266 34) (< V1266 40)) (= V1266 33)))))))
+
+(defun shen.<str> (V1267) (let Parse_shen.<dbq> (shen.<dbq> V1267) (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))))
+
+(defun shen.<dbq> (V1268) (if (cons? (hd V1268)) (let Parse_Byte (hd (hd V1268)) (if (= Parse_Byte 34) (shen.pair (hd (shen.pair (tl (hd V1268)) (shen.hdtl V1268))) Parse_Byte) (fail))) (fail)))
+
+(defun shen.<strcontents> (V1269) (let YaccParse (let Parse_shen.<strc> (shen.<strc> V1269) (if (not (= (fail) Parse_shen.<strc>)) (let Parse_shen.<strcontents> (shen.<strcontents> Parse_shen.<strc>) (if (not (= (fail) Parse_shen.<strcontents>)) (shen.pair (hd Parse_shen.<strcontents>) (cons (shen.hdtl Parse_shen.<strc>) (shen.hdtl Parse_shen.<strcontents>))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_<e> (<e> V1269) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) ()) (fail))) YaccParse)))
+
+(defun shen.<byte> (V1270) (if (cons? (hd V1270)) (let Parse_Byte (hd (hd V1270)) (shen.pair (hd (shen.pair (tl (hd V1270)) (shen.hdtl V1270))) (n->string Parse_Byte))) (fail)))
+
+(defun shen.<strc> (V1271) (if (cons? (hd V1271)) (let Parse_Byte (hd (hd V1271)) (if (not (= Parse_Byte 34)) (shen.pair (hd (shen.pair (tl (hd V1271)) (shen.hdtl V1271))) (n->string Parse_Byte)) (fail))) (fail)))
+
+(defun shen.<number> (V1272) (let YaccParse (let Parse_shen.<minus> (shen.<minus> V1272) (if (not (= (fail) Parse_shen.<minus>)) (let Parse_shen.<number> (shen.<number> Parse_shen.<minus>) (if (not (= (fail) Parse_shen.<number>)) (shen.pair (hd Parse_shen.<number>) (- 0 (shen.hdtl Parse_shen.<number>))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen.<plus> (shen.<plus> V1272) (if (not (= (fail) Parse_shen.<plus>)) (let Parse_shen.<number> (shen.<number> Parse_shen.<plus>) (if (not (= (fail) Parse_shen.<number>)) (shen.pair (hd Parse_shen.<number>) (shen.hdtl Parse_shen.<number>)) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen.<predigits> (shen.<predigits> V1272) (if (not (= (fail) Parse_shen.<predigits>)) (let Parse_shen.<stop> (shen.<stop> Parse_shen.<predigits>) (if (not (= (fail) Parse_shen.<stop>)) (let Parse_shen.<postdigits> (shen.<postdigits> Parse_shen.<stop>) (if (not (= (fail) Parse_shen.<postdigits>)) (let Parse_shen.<E> (shen.<E> Parse_shen.<postdigits>) (if (not (= (fail) Parse_shen.<E>)) (let Parse_shen.<log10> (shen.<log10> Parse_shen.<E>) (if (not (= (fail) Parse_shen.<log10>)) (shen.pair (hd Parse_shen.<log10>) (* (shen.expt 10 (shen.hdtl Parse_shen.<log10>)) (+ (shen.pre (reverse (shen.hdtl Parse_shen.<predigits>)) 0) (shen.post (shen.hdtl Parse_shen.<postdigits>) 1)))) (fail))) (fail))) (fail))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen.<digits> (shen.<digits> V1272) (if (not (= (fail) Parse_shen.<digits>)) (let Parse_shen.<E> (shen.<E> Parse_shen.<digits>) (if (not (= (fail) Parse_shen.<E>)) (let Parse_shen.<log10> (shen.<log10> Parse_shen.<E>) (if (not (= (fail) Parse_shen.<log10>)) (shen.pair (hd Parse_shen.<log10>) (* (shen.expt 10 (shen.hdtl Parse_shen.<log10>)) (shen.pre (reverse (shen.hdtl Parse_shen.<digits>)) 0))) (fail))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen.<predigits> (shen.<predigits> V1272) (if (not (= (fail) Parse_shen.<predigits>)) (let Parse_shen.<stop> (shen.<stop> Parse_shen.<predigits>) (if (not (= (fail) Parse_shen.<stop>)) (let Parse_shen.<postdigits> (shen.<postdigits> Parse_shen.<stop>) (if (not (= (fail) Parse_shen.<postdigits>)) (shen.pair (hd Parse_shen.<postdigits>) (+ (shen.pre (reverse (shen.hdtl Parse_shen.<predigits>)) 0) (shen.post (shen.hdtl Parse_shen.<postdigits>) 1))) (fail))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_shen.<digits> (shen.<digits> V1272) (if (not (= (fail) Parse_shen.<digits>)) (shen.pair (hd Parse_shen.<digits>) (shen.pre (reverse (shen.hdtl Parse_shen.<digits>)) 0)) (fail))) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)))
+
+(defun shen.<E> (V1273) (if (and (cons? (hd V1273)) (= 101 (hd (hd V1273)))) (shen.pair (hd (shen.pair (tl (hd V1273)) (shen.hdtl V1273))) shen.skip) (fail)))
+
+(defun shen.<log10> (V1274) (let YaccParse (let Parse_shen.<minus> (shen.<minus> V1274) (if (not (= (fail) Parse_shen.<minus>)) (let Parse_shen.<digits> (shen.<digits> Parse_shen.<minus>) (if (not (= (fail) Parse_shen.<digits>)) (shen.pair (hd Parse_shen.<digits>) (- 0 (shen.pre (reverse (shen.hdtl Parse_shen.<digits>)) 0))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_shen.<digits> (shen.<digits> V1274) (if (not (= (fail) Parse_shen.<digits>)) (shen.pair (hd Parse_shen.<digits>) (shen.pre (reverse (shen.hdtl Parse_shen.<digits>)) 0)) (fail))) YaccParse)))
+
+(defun shen.<plus> (V1275) (if (cons? (hd V1275)) (let Parse_Byte (hd (hd V1275)) (if (= Parse_Byte 43) (shen.pair (hd (shen.pair (tl (hd V1275)) (shen.hdtl V1275))) Parse_Byte) (fail))) (fail)))
+
+(defun shen.<stop> (V1276) (if (cons? (hd V1276)) (let Parse_Byte (hd (hd V1276)) (if (= Parse_Byte 46) (shen.pair (hd (shen.pair (tl (hd V1276)) (shen.hdtl V1276))) Parse_Byte) (fail))) (fail)))
+
+(defun shen.<predigits> (V1277) (let YaccParse (let Parse_shen.<digits> (shen.<digits> V1277) (if (not (= (fail) Parse_shen.<digits>)) (shen.pair (hd Parse_shen.<digits>) (shen.hdtl Parse_shen.<digits>)) (fail))) (if (= YaccParse (fail)) (let Parse_<e> (<e> V1277) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) ()) (fail))) YaccParse)))
+
+(defun shen.<postdigits> (V1278) (let Parse_shen.<digits> (shen.<digits> V1278) (if (not (= (fail) Parse_shen.<digits>)) (shen.pair (hd Parse_shen.<digits>) (shen.hdtl Parse_shen.<digits>)) (fail))))
+
+(defun shen.<digits> (V1279) (let YaccParse (let Parse_shen.<digit> (shen.<digit> V1279) (if (not (= (fail) Parse_shen.<digit>)) (let Parse_shen.<digits> (shen.<digits> Parse_shen.<digit>) (if (not (= (fail) Parse_shen.<digits>)) (shen.pair (hd Parse_shen.<digits>) (cons (shen.hdtl Parse_shen.<digit>) (shen.hdtl Parse_shen.<digits>))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_shen.<digit> (shen.<digit> V1279) (if (not (= (fail) Parse_shen.<digit>)) (shen.pair (hd Parse_shen.<digit>) (cons (shen.hdtl Parse_shen.<digit>) ())) (fail))) YaccParse)))
+
+(defun shen.<digit> (V1280) (if (cons? (hd V1280)) (let Parse_X (hd (hd V1280)) (if (shen.numbyte? Parse_X) (shen.pair (hd (shen.pair (tl (hd V1280)) (shen.hdtl V1280))) (shen.byte->digit Parse_X)) (fail))) (fail)))
+
+(defun shen.byte->digit (V1281) (cond ((= 48 V1281) 0) ((= 49 V1281) 1) ((= 50 V1281) 2) ((= 51 V1281) 3) ((= 52 V1281) 4) ((= 53 V1281) 5) ((= 54 V1281) 6) ((= 55 V1281) 7) ((= 56 V1281) 8) ((= 57 V1281) 9) (true (shen.f_error shen.byte->digit))))
+
+(defun shen.pre (V1284 V1285) (cond ((= () V1284) 0) ((cons? V1284) (+ (* (shen.expt 10 V1285) (hd V1284)) (shen.pre (tl V1284) (+ V1285 1)))) (true (shen.f_error shen.pre))))
+
+(defun shen.post (V1288 V1289) (cond ((= () V1288) 0) ((cons? V1288) (+ (* (shen.expt 10 (- 0 V1289)) (hd V1288)) (shen.post (tl V1288) (+ V1289 1)))) (true (shen.f_error shen.post))))
+
+(defun shen.expt (V1292 V1293) (cond ((= 0 V1293) 1) ((> V1293 0) (* V1292 (shen.expt V1292 (- V1293 1)))) (true (* 1.0 (/ (shen.expt V1292 (+ V1293 1)) V1292)))))
+
+(defun shen.<st_input1> (V1294) (let Parse_shen.<st_input> (shen.<st_input> V1294) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (shen.hdtl Parse_shen.<st_input>)) (fail))))
+
+(defun shen.<st_input2> (V1295) (let Parse_shen.<st_input> (shen.<st_input> V1295) (if (not (= (fail) Parse_shen.<st_input>)) (shen.pair (hd Parse_shen.<st_input>) (shen.hdtl Parse_shen.<st_input>)) (fail))))
+
+(defun shen.<comment> (V1296) (let YaccParse (let Parse_shen.<singleline> (shen.<singleline> V1296) (if (not (= (fail) Parse_shen.<singleline>)) (shen.pair (hd Parse_shen.<singleline>) shen.skip) (fail))) (if (= YaccParse (fail)) (let Parse_shen.<multiline> (shen.<multiline> V1296) (if (not (= (fail) Parse_shen.<multiline>)) (shen.pair (hd Parse_shen.<multiline>) shen.skip) (fail))) YaccParse)))
+
+(defun shen.<singleline> (V1297) (let Parse_shen.<backslash> (shen.<backslash> V1297) (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))))
+
+(defun shen.<backslash> (V1298) (if (and (cons? (hd V1298)) (= 92 (hd (hd V1298)))) (shen.pair (hd (shen.pair (tl (hd V1298)) (shen.hdtl V1298))) shen.skip) (fail)))
+
+(defun shen.<anysingle> (V1299) (let YaccParse (let Parse_shen.<non-return> (shen.<non-return> V1299) (if (not (= (fail) Parse_shen.<non-return>)) (let Parse_shen.<anysingle> (shen.<anysingle> Parse_shen.<non-return>) (if (not (= (fail) Parse_shen.<anysingle>)) (shen.pair (hd Parse_shen.<anysingle>) shen.skip) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_<e> (<e> V1299) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) shen.skip) (fail))) YaccParse)))
+
+(defun shen.<non-return> (V1300) (if (cons? (hd V1300)) (let Parse_X (hd (hd V1300)) (if (not (element? Parse_X (cons 10 (cons 13 ())))) (shen.pair (hd (shen.pair (tl (hd V1300)) (shen.hdtl V1300))) shen.skip) (fail))) (fail)))
+
+(defun shen.<return> (V1301) (if (cons? (hd V1301)) (let Parse_X (hd (hd V1301)) (if (element? Parse_X (cons 10 (cons 13 ()))) (shen.pair (hd (shen.pair (tl (hd V1301)) (shen.hdtl V1301))) shen.skip) (fail))) (fail)))
+
+(defun shen.<multiline> (V1302) (let Parse_shen.<backslash> (shen.<backslash> V1302) (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))))
+
+(defun shen.<times> (V1303) (if (and (cons? (hd V1303)) (= 42 (hd (hd V1303)))) (shen.pair (hd (shen.pair (tl (hd V1303)) (shen.hdtl V1303))) shen.skip) (fail)))
+
+(defun shen.<anymulti> (V1304) (let YaccParse (let Parse_shen.<comment> (shen.<comment> V1304) (if (not (= (fail) Parse_shen.<comment>)) (let Parse_shen.<anymulti> (shen.<anymulti> Parse_shen.<comment>) (if (not (= (fail) Parse_shen.<anymulti>)) (shen.pair (hd Parse_shen.<anymulti>) shen.skip) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen.<times> (shen.<times> V1304) (if (not (= (fail) Parse_shen.<times>)) (let Parse_shen.<backslash> (shen.<backslash> Parse_shen.<times>) (if (not (= (fail) Parse_shen.<backslash>)) (shen.pair (hd Parse_shen.<backslash>) shen.skip) (fail))) (fail))) (if (= YaccParse (fail)) (if (cons? (hd V1304)) (let Parse_X (hd (hd V1304)) (let Parse_shen.<anymulti> (shen.<anymulti> (shen.pair (tl (hd V1304)) (shen.hdtl V1304))) (if (not (= (fail) Parse_shen.<anymulti>)) (shen.pair (hd Parse_shen.<anymulti>) shen.skip) (fail)))) (fail)) YaccParse)) YaccParse)))
+
+(defun shen.<whitespaces> (V1305) (let YaccParse (let Parse_shen.<whitespace> (shen.<whitespace> V1305) (if (not (= (fail) Parse_shen.<whitespace>)) (let Parse_shen.<whitespaces> (shen.<whitespaces> Parse_shen.<whitespace>) (if (not (= (fail) Parse_shen.<whitespaces>)) (shen.pair (hd Parse_shen.<whitespaces>) shen.skip) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_shen.<whitespace> (shen.<whitespace> V1305) (if (not (= (fail) Parse_shen.<whitespace>)) (shen.pair (hd Parse_shen.<whitespace>) shen.skip) (fail))) YaccParse)))
+
+(defun shen.<whitespace> (V1306) (if (cons? (hd V1306)) (let Parse_X (hd (hd V1306)) (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 V1306)) (shen.hdtl V1306))) shen.skip) (fail))) (fail)))
+
+(defun shen.cons_form (V1307) (cond ((= () V1307) ()) ((and (cons? V1307) (and (cons? (tl V1307)) (and (cons? (tl (tl V1307))) (and (= () (tl (tl (tl V1307)))) (= (hd (tl V1307)) bar!))))) (cons cons (cons (hd V1307) (tl (tl V1307))))) ((cons? V1307) (cons cons (cons (hd V1307) (cons (shen.cons_form (tl V1307)) ())))) (true (shen.f_error shen.cons_form))))
+
+(defun shen.package-macro (V1310 V1311) (cond ((and (cons? V1310) (and (= $ (hd V1310)) (and (cons? (tl V1310)) (= () (tl (tl V1310)))))) (append (explode (hd (tl V1310))) V1311)) ((and (cons? V1310) (and (= package (hd V1310)) (and (cons? (tl V1310)) (and (= null (hd (tl V1310))) (cons? (tl (tl V1310))))))) (append (tl (tl (tl V1310))) V1311)) ((and (cons? V1310) (and (= package (hd V1310)) (and (cons? (tl V1310)) (cons? (tl (tl V1310)))))) (let ListofExceptions (shen.eval-without-macros (hd (tl (tl V1310)))) (let Record (shen.record-exceptions ListofExceptions (hd (tl V1310))) (let PackageNameDot (intern (cn (str (hd (tl V1310))) ".")) (append (shen.packageh PackageNameDot ListofExceptions (tl (tl (tl V1310)))) V1311))))) (true (cons V1310 V1311))))
+
+(defun shen.record-exceptions (V1312 V1313) (let CurrExceptions (trap-error (get V1313 shen.external-symbols (value *property-vector*)) (lambda E ())) (let AllExceptions (union V1312 CurrExceptions) (put V1313 shen.external-symbols AllExceptions (value *property-vector*)))))
+
+(defun shen.packageh (V1322 V1323 V1324) (cond ((cons? V1324) (cons (shen.packageh V1322 V1323 (hd V1324)) (shen.packageh V1322 V1323 (tl V1324)))) ((or (shen.sysfunc? V1324) (or (variable? V1324) (or (element? V1324 V1323) (or (shen.doubleunderline? V1324) (shen.singleunderline? V1324))))) V1324) ((and (symbol? V1324) (not (shen.prefix? (cons "s" (cons "h" (cons "e" (cons "n" (cons "." ()))))) (explode V1324)))) (concat V1322 V1324)) (true V1324)))
+
+
+

data/shen/release/klambda/sequent.kl

@@ -0,0 +1,142 @@
+"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.datatype-error (V1329) (cond ((and (cons? V1329) (and (cons? (tl V1329)) (= () (tl (tl V1329))))) (simple-error (cn "datatype syntax error here:
+
+ " (shen.app (shen.next-50 50 (hd V1329)) "
+" shen.a)))) (true (shen.f_error shen.datatype-error))))
+
+(defun shen.<datatype-rules> (V1330) (let YaccParse (let Parse_shen.<datatype-rule> (shen.<datatype-rule> V1330) (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 (= YaccParse (fail)) (let Parse_<e> (<e> V1330) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) ()) (fail))) YaccParse)))
+
+(defun shen.<datatype-rule> (V1331) (let YaccParse (let Parse_shen.<side-conditions> (shen.<side-conditions> V1331) (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 (= YaccParse (fail)) (let Parse_shen.<side-conditions> (shen.<side-conditions> V1331) (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))) YaccParse)))
+
+(defun shen.<side-conditions> (V1332) (let YaccParse (let Parse_shen.<side-condition> (shen.<side-condition> V1332) (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 (= YaccParse (fail)) (let Parse_<e> (<e> V1332) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) ()) (fail))) YaccParse)))
+
+(defun shen.<side-condition> (V1333) (let YaccParse (if (and (cons? (hd V1333)) (= if (hd (hd V1333)))) (let Parse_shen.<expr> (shen.<expr> (shen.pair (tl (hd V1333)) (shen.hdtl V1333))) (if (not (= (fail) Parse_shen.<expr>)) (shen.pair (hd Parse_shen.<expr>) (cons if (cons (shen.hdtl Parse_shen.<expr>) ()))) (fail))) (fail)) (if (= YaccParse (fail)) (if (and (cons? (hd V1333)) (= let (hd (hd V1333)))) (let Parse_shen.<variable?> (shen.<variable?> (shen.pair (tl (hd V1333)) (shen.hdtl V1333))) (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)) YaccParse)))
+
+(defun shen.<variable?> (V1334) (if (cons? (hd V1334)) (let Parse_X (hd (hd V1334)) (if (variable? Parse_X) (shen.pair (hd (shen.pair (tl (hd V1334)) (shen.hdtl V1334))) Parse_X) (fail))) (fail)))
+
+(defun shen.<expr> (V1335) (if (cons? (hd V1335)) (let Parse_X (hd (hd V1335)) (if (not (or (element? Parse_X (cons >> (cons ; ()))) (or (shen.singleunderline? Parse_X) (shen.doubleunderline? Parse_X)))) (shen.pair (hd (shen.pair (tl (hd V1335)) (shen.hdtl V1335))) (shen.remove-bar Parse_X)) (fail))) (fail)))
+
+(defun shen.remove-bar (V1336) (cond ((and (cons? V1336) (and (cons? (tl V1336)) (and (cons? (tl (tl V1336))) (and (= () (tl (tl (tl V1336)))) (= (hd (tl V1336)) bar!))))) (cons (hd V1336) (hd (tl (tl V1336))))) ((cons? V1336) (cons (shen.remove-bar (hd V1336)) (shen.remove-bar (tl V1336)))) (true V1336)))
+
+(defun shen.<premises> (V1337) (let YaccParse (let Parse_shen.<premise> (shen.<premise> V1337) (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 (= YaccParse (fail)) (let Parse_<e> (<e> V1337) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) ()) (fail))) YaccParse)))
+
+(defun shen.<semicolon-symbol> (V1338) (if (cons? (hd V1338)) (let Parse_X (hd (hd V1338)) (if (= Parse_X ;) (shen.pair (hd (shen.pair (tl (hd V1338)) (shen.hdtl V1338))) shen.skip) (fail))) (fail)))
+
+(defun shen.<premise> (V1339) (let YaccParse (if (and (cons? (hd V1339)) (= ! (hd (hd V1339)))) (shen.pair (hd (shen.pair (tl (hd V1339)) (shen.hdtl V1339))) !) (fail)) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen.<formulae> (shen.<formulae> V1339) (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 (= YaccParse (fail)) (let Parse_shen.<formula> (shen.<formula> V1339) (if (not (= (fail) Parse_shen.<formula>)) (shen.pair (hd Parse_shen.<formula>) (shen.sequent () (shen.hdtl Parse_shen.<formula>))) (fail))) YaccParse)) YaccParse)))
+
+(defun shen.<conclusion> (V1340) (let YaccParse (let Parse_shen.<formulae> (shen.<formulae> V1340) (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 (= YaccParse (fail)) (let Parse_shen.<formula> (shen.<formula> V1340) (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))) YaccParse)))
+
+(defun shen.sequent (V1341 V1342) (@p V1341 V1342))
+
+(defun shen.<formulae> (V1343) (let YaccParse (let Parse_shen.<formula> (shen.<formula> V1343) (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 (= YaccParse (fail)) (let YaccParse (let Parse_shen.<formula> (shen.<formula> V1343) (if (not (= (fail) Parse_shen.<formula>)) (shen.pair (hd Parse_shen.<formula>) (cons (shen.hdtl Parse_shen.<formula>) ())) (fail))) (if (= YaccParse (fail)) (let Parse_<e> (<e> V1343) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) ()) (fail))) YaccParse)) YaccParse)))
+
+(defun shen.<comma-symbol> (V1344) (if (cons? (hd V1344)) (let Parse_X (hd (hd V1344)) (if (= Parse_X (intern ",")) (shen.pair (hd (shen.pair (tl (hd V1344)) (shen.hdtl V1344))) shen.skip) (fail))) (fail)))
+
+(defun shen.<formula> (V1345) (let YaccParse (let Parse_shen.<expr> (shen.<expr> V1345) (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 (= YaccParse (fail)) (let Parse_shen.<expr> (shen.<expr> V1345) (if (not (= (fail) Parse_shen.<expr>)) (shen.pair (hd Parse_shen.<expr>) (shen.hdtl Parse_shen.<expr>)) (fail))) YaccParse)))
+
+(defun shen.<type> (V1346) (let Parse_shen.<expr> (shen.<expr> V1346) (if (not (= (fail) Parse_shen.<expr>)) (shen.pair (hd Parse_shen.<expr>) (shen.curry-type (shen.hdtl Parse_shen.<expr>))) (fail))))
+
+(defun shen.<doubleunderline> (V1347) (if (cons? (hd V1347)) (let Parse_X (hd (hd V1347)) (if (shen.doubleunderline? Parse_X) (shen.pair (hd (shen.pair (tl (hd V1347)) (shen.hdtl V1347))) Parse_X) (fail))) (fail)))
+
+(defun shen.<singleunderline> (V1348) (if (cons? (hd V1348)) (let Parse_X (hd (hd V1348)) (if (shen.singleunderline? Parse_X) (shen.pair (hd (shen.pair (tl (hd V1348)) (shen.hdtl V1348))) Parse_X) (fail))) (fail)))
+
+(defun shen.singleunderline? (V1349) (and (symbol? V1349) (shen.sh? (str V1349))))
+
+(defun shen.sh? (V1350) (cond ((= "_" V1350) true) (true (and (= (pos V1350 0) "_") (shen.sh? (tlstr V1350))))))
+
+(defun shen.doubleunderline? (V1351) (and (symbol? V1351) (shen.dh? (str V1351))))
+
+(defun shen.dh? (V1352) (cond ((= "=" V1352) true) (true (and (= (pos V1352 0) "=") (shen.dh? (tlstr V1352))))))
+
+(defun shen.process-datatype (V1353 V1354) (shen.remember-datatype (shen.s-prolog (shen.rules->horn-clauses V1353 V1354))))
+
+(defun shen.remember-datatype (V1359) (cond ((cons? V1359) (do (set shen.*datatypes* (adjoin (hd V1359) (value shen.*datatypes*))) (do (set shen.*alldatatypes* (adjoin (hd V1359) (value shen.*alldatatypes*))) (hd V1359)))) (true (shen.f_error shen.remember-datatype))))
+
+(defun shen.rules->horn-clauses (V1362 V1363) (cond ((= () V1363) ()) ((and (cons? V1363) (and (tuple? (hd V1363)) (= shen.single (fst (hd V1363))))) (cons (shen.rule->horn-clause V1362 (snd (hd V1363))) (shen.rules->horn-clauses V1362 (tl V1363)))) ((and (cons? V1363) (and (tuple? (hd V1363)) (= shen.double (fst (hd V1363))))) (shen.rules->horn-clauses V1362 (append (shen.double->singles (snd (hd V1363))) (tl V1363)))) (true (shen.f_error shen.rules->horn-clauses))))
+
+(defun shen.double->singles (V1364) (cons (shen.right-rule V1364) (cons (shen.left-rule V1364) ())))
+
+(defun shen.right-rule (V1365) (@p shen.single V1365))
+
+(defun shen.left-rule (V1366) (cond ((and (cons? V1366) (and (cons? (tl V1366)) (and (cons? (tl (tl V1366))) (and (tuple? (hd (tl (tl V1366)))) (and (= () (fst (hd (tl (tl V1366))))) (= () (tl (tl (tl V1366))))))))) (let Q (gensym Qv) (let NewConclusion (@p (cons (snd (hd (tl (tl V1366)))) ()) Q) (let NewPremises (cons (@p (map shen.right->left (hd (tl V1366))) Q) ()) (@p shen.single (cons (hd V1366) (cons NewPremises (cons NewConclusion ())))))))) (true (shen.f_error shen.left-rule))))
+
+(defun shen.right->left (V1371) (cond ((and (tuple? V1371) (= () (fst V1371))) (snd V1371)) (true (simple-error "syntax error with ==========
+"))))
+
+(defun shen.rule->horn-clause (V1372 V1373) (cond ((and (cons? V1373) (and (cons? (tl V1373)) (and (cons? (tl (tl V1373))) (and (tuple? (hd (tl (tl V1373)))) (= () (tl (tl (tl V1373)))))))) (cons (shen.rule->horn-clause-head V1372 (snd (hd (tl (tl V1373))))) (cons :- (cons (shen.rule->horn-clause-body (hd V1373) (hd (tl V1373)) (fst (hd (tl (tl V1373))))) ())))) (true (shen.f_error shen.rule->horn-clause))))
+
+(defun shen.rule->horn-clause-head (V1374 V1375) (cons V1374 (cons (shen.mode-ify V1375) (cons Context_1957 ()))))
+
+(defun shen.mode-ify (V1376) (cond ((and (cons? V1376) (and (cons? (tl V1376)) (and (= : (hd (tl V1376))) (and (cons? (tl (tl V1376))) (= () (tl (tl (tl V1376)))))))) (cons mode (cons (cons (hd V1376) (cons : (cons (cons mode (cons (hd (tl (tl V1376))) (cons + ()))) ()))) (cons - ())))) (true V1376)))
+
+(defun shen.rule->horn-clause-body (V1377 V1378 V1379) (let Variables (map shen.extract_vars V1379) (let Predicates (map (lambda X (gensym shen.cl)) V1379) (let SearchLiterals (shen.construct-search-literals Predicates Variables Context_1957 Context1_1957) (let SearchClauses (shen.construct-search-clauses Predicates V1379 Variables) (let SideLiterals (shen.construct-side-literals V1377) (let PremissLiterals (map (lambda X (shen.construct-premiss-literal X (empty? V1379))) V1378) (append SearchLiterals (append SideLiterals PremissLiterals)))))))))
+
+(defun shen.construct-search-literals (V1384 V1385 V1386 V1387) (cond ((and (= () V1384) (= () V1385)) ()) (true (shen.csl-help V1384 V1385 V1386 V1387))))
+
+(defun shen.csl-help (V1390 V1391 V1392 V1393) (cond ((and (= () V1390) (= () V1391)) (cons (cons bind (cons ContextOut_1957 (cons V1392 ()))) ())) ((and (cons? V1390) (cons? V1391)) (cons (cons (hd V1390) (cons V1392 (cons V1393 (hd V1391)))) (shen.csl-help (tl V1390) (tl V1391) V1393 (gensym Context)))) (true (shen.f_error shen.csl-help))))
+
+(defun shen.construct-search-clauses (V1394 V1395 V1396) (cond ((and (= () V1394) (and (= () V1395) (= () V1396))) shen.skip) ((and (cons? V1394) (and (cons? V1395) (cons? V1396))) (do (shen.construct-search-clause (hd V1394) (hd V1395) (hd V1396)) (shen.construct-search-clauses (tl V1394) (tl V1395) (tl V1396)))) (true (shen.f_error shen.construct-search-clauses))))
+
+(defun shen.construct-search-clause (V1397 V1398 V1399) (shen.s-prolog (cons (shen.construct-base-search-clause V1397 V1398 V1399) (cons (shen.construct-recursive-search-clause V1397 V1398 V1399) ()))))
+
+(defun shen.construct-base-search-clause (V1400 V1401 V1402) (cons (cons V1400 (cons (cons (shen.mode-ify V1401) In_1957) (cons In_1957 V1402))) (cons :- (cons () ()))))
+
+(defun shen.construct-recursive-search-clause (V1403 V1404 V1405) (cons (cons V1403 (cons (cons Assumption_1957 Assumptions_1957) (cons (cons Assumption_1957 Out_1957) V1405))) (cons :- (cons (cons (cons V1403 (cons Assumptions_1957 (cons Out_1957 V1405))) ()) ()))))
+
+(defun shen.construct-side-literals (V1410) (cond ((= () V1410) ()) ((and (cons? V1410) (and (cons? (hd V1410)) (and (= if (hd (hd V1410))) (and (cons? (tl (hd V1410))) (= () (tl (tl (hd V1410)))))))) (cons (cons when (tl (hd V1410))) (shen.construct-side-literals (tl V1410)))) ((and (cons? V1410) (and (cons? (hd V1410)) (and (= let (hd (hd V1410))) (and (cons? (tl (hd V1410))) (and (cons? (tl (tl (hd V1410)))) (= () (tl (tl (tl (hd V1410)))))))))) (cons (cons is (tl (hd V1410))) (shen.construct-side-literals (tl V1410)))) ((cons? V1410) (shen.construct-side-literals (tl V1410))) (true (shen.f_error shen.construct-side-literals))))
+
+(defun shen.construct-premiss-literal (V1415 V1416) (cond ((tuple? V1415) (cons shen.t* (cons (shen.recursive_cons_form (snd V1415)) (cons (shen.construct-context V1416 (fst V1415)) ())))) ((= ! V1415) (cons cut (cons Throwcontrol ()))) (true (shen.f_error shen.construct-premiss-literal))))
+
+(defun shen.construct-context (V1417 V1418) (cond ((and (= true V1417) (= () V1418)) Context_1957) ((and (= false V1417) (= () V1418)) ContextOut_1957) ((cons? V1418) (cons cons (cons (shen.recursive_cons_form (hd V1418)) (cons (shen.construct-context V1417 (tl V1418)) ())))) (true (shen.f_error shen.construct-context))))
+
+(defun shen.recursive_cons_form (V1419) (cond ((cons? V1419) (cons cons (cons (shen.recursive_cons_form (hd V1419)) (cons (shen.recursive_cons_form (tl V1419)) ())))) (true V1419)))
+
+(defun preclude (V1420) (shen.preclude-h (map shen.intern-type V1420)))
+
+(defun shen.preclude-h (V1421) (let FilterDatatypes (set shen.*datatypes* (difference (value shen.*datatypes*) V1421)) (value shen.*datatypes*)))
+
+(defun include (V1422) (shen.include-h (map shen.intern-type V1422)))
+
+(defun shen.include-h (V1423) (let ValidTypes (intersection V1423 (value shen.*alldatatypes*)) (let NewDatatypes (set shen.*datatypes* (union ValidTypes (value shen.*datatypes*))) (value shen.*datatypes*))))
+
+(defun preclude-all-but (V1424) (shen.preclude-h (difference (value shen.*alldatatypes*) (map shen.intern-type V1424))))
+
+(defun include-all-but (V1425) (shen.include-h (difference (value shen.*alldatatypes*) (map shen.intern-type V1425))))
+
+(defun shen.synonyms-help (V1430) (cond ((= () V1430) (shen.demodulation-function (value shen.*tc*) (mapcan shen.demod-rule (value shen.*synonyms*)))) ((and (cons? V1430) (cons? (tl V1430))) (let Vs (difference (shen.extract_vars (hd (tl V1430))) (shen.extract_vars (hd V1430))) (if (empty? Vs) (do (shen.pushnew (cons (hd V1430) (cons (hd (tl V1430)) ())) shen.*synonyms*) (shen.synonyms-help (tl (tl V1430)))) (shen.free_variable_warnings (hd (tl V1430)) Vs)))) (true (simple-error "odd number of synonyms
+"))))
+
+(defun shen.pushnew (V1431 V1432) (if (element? V1431 (value V1432)) (value V1432) (set V1432 (cons V1431 (value V1432)))))
+
+(defun shen.demod-rule (V1433) (cond ((and (cons? V1433) (and (cons? (tl V1433)) (= () (tl (tl V1433))))) (cons (shen.rcons_form (hd V1433)) (cons -> (cons (shen.rcons_form (hd (tl V1433))) ())))) (true (shen.f_error shen.demod-rule))))
+
+(defun shen.demodulation-function (V1434 V1435) (do (tc -) (do (eval (cons define (cons shen.demod (append V1435 (shen.default-rule))))) (do (if V1434 (tc +) shen.skip) synonyms))))
+
+(defun shen.default-rule () (cons X (cons -> (cons X ()))))
+
+
+

data/shen/release/klambda/sys.kl

@@ -0,0 +1,253 @@
+"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 thaw (V1438) (V1438))
+
+(defun eval (V1439) (let Macroexpand (shen.walk (lambda V1436 (macroexpand V1436)) V1439) (if (shen.packaged? Macroexpand) (map shen.eval-without-macros (shen.package-contents Macroexpand)) (shen.eval-without-macros Macroexpand))))
+
+(defun shen.eval-without-macros (V1440) (eval-kl (shen.elim-def (shen.proc-input+ V1440))))
+
+(defun shen.proc-input+ (V1441) (cond ((and (cons? V1441) (and (= input+ (hd V1441)) (and (cons? (tl V1441)) (and (cons? (tl (tl V1441))) (= () (tl (tl (tl V1441)))))))) (cons input+ (cons (shen.rcons_form (hd (tl V1441))) (tl (tl V1441))))) ((and (cons? V1441) (and (= shen.read+ (hd V1441)) (and (cons? (tl V1441)) (and (cons? (tl (tl V1441))) (= () (tl (tl (tl V1441)))))))) (cons shen.read+ (cons (shen.rcons_form (hd (tl V1441))) (tl (tl V1441))))) ((cons? V1441) (map shen.proc-input+ V1441)) (true V1441)))
+
+(defun shen.elim-def (V1442) (cond ((and (cons? V1442) (and (= define (hd V1442)) (cons? (tl V1442)))) (shen.shen->kl (hd (tl V1442)) (tl (tl V1442)))) ((and (cons? V1442) (and (= defmacro (hd V1442)) (cons? (tl V1442)))) (let Default (cons X (cons -> (cons X ()))) (let Def (shen.elim-def (cons define (cons (hd (tl V1442)) (append (tl (tl V1442)) Default)))) (let MacroAdd (shen.add-macro (hd (tl V1442))) Def)))) ((and (cons? V1442) (and (= defcc (hd V1442)) (cons? (tl V1442)))) (shen.elim-def (shen.yacc V1442))) ((cons? V1442) (map shen.elim-def V1442)) (true V1442)))
+
+(defun shen.add-macro (V1443) (let MacroReg (value shen.*macroreg*) (let NewMacroReg (set shen.*macroreg* (adjoin V1443 (value shen.*macroreg*))) (if (= MacroReg NewMacroReg) shen.skip (set *macros* (cons (lambda X (V1443 X)) (value *macros*)))))))
+
+(defun shen.packaged? (V1450) (cond ((and (cons? V1450) (and (= package (hd V1450)) (and (cons? (tl V1450)) (cons? (tl (tl V1450)))))) true) (true false)))
+
+(defun external (V1451) (trap-error (get V1451 shen.external-symbols (value *property-vector*)) (lambda E (simple-error (cn "package " (shen.app V1451 " has not been used.
+" shen.a))))))
+
+(defun shen.package-contents (V1454) (cond ((and (cons? V1454) (and (= package (hd V1454)) (and (cons? (tl V1454)) (and (= null (hd (tl V1454))) (cons? (tl (tl V1454))))))) (tl (tl (tl V1454)))) ((and (cons? V1454) (and (= package (hd V1454)) (and (cons? (tl V1454)) (cons? (tl (tl V1454)))))) (shen.packageh (hd (tl V1454)) (hd (tl (tl V1454))) (tl (tl (tl V1454))))) (true (shen.f_error shen.package-contents))))
+
+(defun shen.walk (V1455 V1456) (cond ((cons? V1456) (V1455 (map (lambda Z (shen.walk V1455 Z)) V1456))) (true (V1455 V1456))))
+
+(defun compile (V1457 V1458 V1459) (let O (V1457 (cons V1458 (cons () ()))) (if (or (= (fail) O) (not (empty? (hd O)))) (V1459 O) (shen.hdtl O))))
+
+(defun fail-if (V1460 V1461) (if (V1460 V1461) (fail) V1461))
+
+(defun @s (V1462 V1463) (cn V1462 V1463))
+
+(defun tc? () (value shen.*tc*))
+
+(defun ps (V1464) (trap-error (get V1464 shen.source (value *property-vector*)) (lambda E (simple-error (shen.app V1464 " not found.
+" shen.a)))))
+
+(defun stinput () (value *stinput*))
+
+(defun shen.+vector? (V1465) (and (absvector? V1465) (> (<-address V1465 0) 0)))
+
+(defun vector (V1466) (let Vector (absvector (+ V1466 1)) (let ZeroStamp (address-> Vector 0 V1466) (let Standard (if (= V1466 0) ZeroStamp (shen.fillvector ZeroStamp 1 V1466 (fail))) Standard))))
+
+(defun shen.fillvector (V1468 V1469 V1470 V1471) (cond ((= V1470 V1469) (address-> V1468 V1470 V1471)) (true (shen.fillvector (address-> V1468 V1469 V1471) (+ 1 V1469) V1470 V1471))))
+
+(defun vector? (V1472) (and (absvector? V1472) (trap-error (>= (<-address V1472 0) 0) (lambda E false))))
+
+(defun vector-> (V1473 V1474 V1475) (if (= V1474 0) (simple-error "cannot access 0th element of a vector
+") (address-> V1473 V1474 V1475)))
+
+(defun <-vector (V1476 V1477) (if (= V1477 0) (simple-error "cannot access 0th element of a vector
+") (let VectorElement (<-address V1476 V1477) (if (= VectorElement (fail)) (simple-error "vector element not found
+") VectorElement))))
+
+(defun shen.posint? (V1478) (and (integer? V1478) (>= V1478 0)))
+
+(defun limit (V1479) (<-address V1479 0))
+
+(defun symbol? (V1480) (cond ((or (boolean? V1480) (or (number? V1480) (string? V1480))) false) (true (trap-error (let String (str V1480) (shen.analyse-symbol? String)) (lambda E false)))))
+
+(defun shen.analyse-symbol? (V1481) (cond ((shen.+string? V1481) (and (shen.alpha? (pos V1481 0)) (shen.alphanums? (tlstr V1481)))) (true (shen.f_error shen.analyse-symbol?))))
+
+(defun shen.alpha? (V1482) (element? V1482 (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 "." ())))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
+
+(defun shen.alphanums? (V1483) (cond ((= "" V1483) true) ((shen.+string? V1483) (and (shen.alphanum? (pos V1483 0)) (shen.alphanums? (tlstr V1483)))) (true (shen.f_error shen.alphanums?))))
+
+(defun shen.alphanum? (V1484) (or (shen.alpha? V1484) (shen.digit? V1484)))
+
+(defun shen.digit? (V1485) (element? V1485 (cons "1" (cons "2" (cons "3" (cons "4" (cons "5" (cons "6" (cons "7" (cons "8" (cons "9" (cons "0" ()))))))))))))
+
+(defun variable? (V1486) (cond ((or (boolean? V1486) (or (number? V1486) (string? V1486))) false) (true (trap-error (let String (str V1486) (shen.analyse-variable? String)) (lambda E false)))))
+
+(defun shen.analyse-variable? (V1487) (cond ((shen.+string? V1487) (and (shen.uppercase? (pos V1487 0)) (shen.alphanums? (tlstr V1487)))) (true (shen.f_error shen.analyse-variable?))))
+
+(defun shen.uppercase? (V1488) (element? V1488 (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" ()))))))))))))))))))))))))))))
+
+(defun gensym (V1489) (concat V1489 (set shen.*gensym* (+ 1 (value shen.*gensym*)))))
+
+(defun concat (V1490 V1491) (intern (cn (str V1490) (str V1491))))
+
+(defun @p (V1492 V1493) (let Vector (absvector 3) (let Tag (address-> Vector 0 shen.tuple) (let Fst (address-> Vector 1 V1492) (let Snd (address-> Vector 2 V1493) Vector)))))
+
+(defun fst (V1494) (<-address V1494 1))
+
+(defun snd (V1495) (<-address V1495 2))
+
+(defun tuple? (V1496) (trap-error (and (absvector? V1496) (= shen.tuple (<-address V1496 0))) (lambda E false)))
+
+(defun append (V1497 V1498) (cond ((= () V1497) V1498) ((cons? V1497) (cons (hd V1497) (append (tl V1497) V1498))) (true (shen.f_error append))))
+
+(defun @v (V1499 V1500) (let Limit (limit V1500) (let NewVector (vector (+ Limit 1)) (let X+NewVector (vector-> NewVector 1 V1499) (if (= Limit 0) X+NewVector (shen.@v-help V1500 1 Limit X+NewVector))))))
+
+(defun shen.@v-help (V1502 V1503 V1504 V1505) (cond ((= V1504 V1503) (shen.copyfromvector V1502 V1505 V1504 (+ V1504 1))) (true (shen.@v-help V1502 (+ V1503 1) V1504 (shen.copyfromvector V1502 V1505 V1503 (+ V1503 1))))))
+
+(defun shen.copyfromvector (V1506 V1507 V1508 V1509) (trap-error (vector-> V1507 V1509 (<-vector V1506 V1508)) (lambda E V1507)))
+
+(defun hdv (V1510) (trap-error (<-vector V1510 1) (lambda E (simple-error (cn "hdv needs a non-empty vector as an argument; not " (shen.app V1510 "
+" shen.s))))))
+
+(defun tlv (V1511) (let Limit (limit V1511) (if (= Limit 0) (simple-error "cannot take the tail of the empty vector
+") (if (= Limit 1) (vector 0) (let NewVector (vector (- Limit 1)) (shen.tlv-help V1511 2 Limit (vector (- Limit 1))))))))
+
+(defun shen.tlv-help (V1513 V1514 V1515 V1516) (cond ((= V1515 V1514) (shen.copyfromvector V1513 V1516 V1515 (- V1515 1))) (true (shen.tlv-help V1513 (+ V1514 1) V1515 (shen.copyfromvector V1513 V1516 V1514 (- V1514 1))))))
+
+(defun assoc (V1526 V1527) (cond ((= () V1527) ()) ((and (cons? V1527) (and (cons? (hd V1527)) (= (hd (hd V1527)) V1526))) (hd V1527)) ((cons? V1527) (assoc V1526 (tl V1527))) (true (shen.f_error assoc))))
+
+(defun boolean? (V1532) (cond ((= true V1532) true) ((= false V1532) true) (true false)))
+
+(defun nl (V1533) (cond ((= 0 V1533) 0) (true (do (shen.prhush "
+" (stoutput)) (nl (- V1533 1))))))
+
+(defun difference (V1536 V1537) (cond ((= () V1536) ()) ((cons? V1536) (if (element? (hd V1536) V1537) (difference (tl V1536) V1537) (cons (hd V1536) (difference (tl V1536) V1537)))) (true (shen.f_error difference))))
+
+(defun do (V1538 V1539) V1539)
+
+(defun element? (V1549 V1550) (cond ((= () V1550) false) ((and (cons? V1550) (= (hd V1550) V1549)) true) ((cons? V1550) (element? V1549 (tl V1550))) (true (shen.f_error element?))))
+
+(defun empty? (V1555) (cond ((= () V1555) true) (true false)))
+
+(defun fix (V1556 V1557) (shen.fix-help V1556 V1557 (V1556 V1557)))
+
+(defun shen.fix-help (V1565 V1566 V1567) (cond ((= V1567 V1566) V1567) (true (shen.fix-help V1565 V1567 (V1565 V1567)))))
+
+(defun put (V1568 V1569 V1570 V1571) (let N (hash V1568 (limit V1571)) (let Entry (trap-error (<-vector V1571 N) (lambda E ())) (let Change (vector-> V1571 N (shen.change-pointer-value V1568 V1569 V1570 Entry)) V1570))))
+
+(defun unput (V1572 V1573 V1574) (let N (hash V1572 (limit V1574)) (let Entry (trap-error (<-vector V1574 N) (lambda E ())) (let Change (vector-> V1574 N (shen.remove-pointer V1572 V1573 Entry)) V1572))))
+
+(defun shen.remove-pointer (V1579 V1580 V1581) (cond ((= () V1581) ()) ((and (cons? V1581) (and (cons? (hd V1581)) (and (cons? (hd (hd V1581))) (and (cons? (tl (hd (hd V1581)))) (and (= () (tl (tl (hd (hd V1581))))) (and (= (hd (tl (hd (hd V1581)))) V1580) (= (hd (hd (hd V1581))) V1579))))))) (tl V1581)) ((cons? V1581) (cons (hd V1581) (shen.remove-pointer V1579 V1580 (tl V1581)))) (true (shen.f_error shen.remove-pointer))))
+
+(defun shen.change-pointer-value (V1586 V1587 V1588 V1589) (cond ((= () V1589) (cons (cons (cons V1586 (cons V1587 ())) V1588) ())) ((and (cons? V1589) (and (cons? (hd V1589)) (and (cons? (hd (hd V1589))) (and (cons? (tl (hd (hd V1589)))) (and (= () (tl (tl (hd (hd V1589))))) (and (= (hd (tl (hd (hd V1589)))) V1587) (= (hd (hd (hd V1589))) V1586))))))) (cons (cons (hd (hd V1589)) V1588) (tl V1589))) ((cons? V1589) (cons (hd V1589) (shen.change-pointer-value V1586 V1587 V1588 (tl V1589)))) (true (shen.f_error shen.change-pointer-value))))
+
+(defun get (V1590 V1591 V1592) (let N (hash V1590 (limit V1592)) (let Entry (trap-error (<-vector V1592 N) (lambda E (simple-error "pointer not found
+"))) (let Result (assoc (cons V1590 (cons V1591 ())) Entry) (if (empty? Result) (simple-error "value not found
+") (tl Result))))))
+
+(defun hash (V1593 V1594) (let Hash (shen.mod (sum (map (lambda V1437 (string->n V1437)) (explode V1593))) V1594) (if (= 0 Hash) 1 Hash)))
+
+(defun shen.mod (V1595 V1596) (shen.modh V1595 (shen.multiples V1595 (cons V1596 ()))))
+
+(defun shen.multiples (V1597 V1598) (cond ((and (cons? V1598) (> (hd V1598) V1597)) (tl V1598)) ((cons? V1598) (shen.multiples V1597 (cons (* 2 (hd V1598)) V1598))) (true (shen.f_error shen.multiples))))
+
+(defun shen.modh (V1601 V1602) (cond ((= 0 V1601) 0) ((= () V1602) V1601) ((and (cons? V1602) (> (hd V1602) V1601)) (if (empty? (tl V1602)) V1601 (shen.modh V1601 (tl V1602)))) ((cons? V1602) (shen.modh (- V1601 (hd V1602)) V1602)) (true (shen.f_error shen.modh))))
+
+(defun sum (V1603) (cond ((= () V1603) 0) ((cons? V1603) (+ (hd V1603) (sum (tl V1603)))) (true (shen.f_error sum))))
+
+(defun head (V1610) (cond ((cons? V1610) (hd V1610)) (true (simple-error "head expects a non-empty list"))))
+
+(defun tail (V1617) (cond ((cons? V1617) (tl V1617)) (true (simple-error "tail expects a non-empty list"))))
+
+(defun hdstr (V1618) (pos V1618 0))
+
+(defun intersection (V1621 V1622) (cond ((= () V1621) ()) ((cons? V1621) (if (element? (hd V1621) V1622) (cons (hd V1621) (intersection (tl V1621) V1622)) (intersection (tl V1621) V1622))) (true (shen.f_error intersection))))
+
+(defun reverse (V1623) (shen.reverse_help V1623 ()))
+
+(defun shen.reverse_help (V1624 V1625) (cond ((= () V1624) V1625) ((cons? V1624) (shen.reverse_help (tl V1624) (cons (hd V1624) V1625))) (true (shen.f_error shen.reverse_help))))
+
+(defun union (V1626 V1627) (cond ((= () V1626) V1627) ((cons? V1626) (if (element? (hd V1626) V1627) (union (tl V1626) V1627) (cons (hd V1626) (union (tl V1626) V1627)))) (true (shen.f_error union))))
+
+(defun y-or-n? (V1628) (let Message (shen.prhush (shen.proc-nl V1628) (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
+" (stoutput)) (y-or-n? V1628))))))))
+
+(defun not (V1629) (if V1629 false true))
+
+(defun subst (V1639 V1640 V1641) (cond ((= V1641 V1640) V1639) ((cons? V1641) (map (lambda W (subst V1639 V1640 W)) V1641)) (true V1641)))
+
+(defun explode (V1642) (shen.explode-h (shen.app V1642 "" shen.a)))
+
+(defun shen.explode-h (V1643) (cond ((= "" V1643) ()) ((shen.+string? V1643) (cons (pos V1643 0) (shen.explode-h (tlstr V1643)))) (true (shen.f_error shen.explode-h))))
+
+(defun cd (V1644) (set *home-directory* (if (= V1644 "") "" (shen.app V1644 "/" shen.a))))
+
+(defun map (V1645 V1646) (shen.map-h V1645 V1646 ()))
+
+(defun shen.map-h (V1649 V1650 V1651) (cond ((= () V1650) (reverse V1651)) ((cons? V1650) (shen.map-h V1649 (tl V1650) (cons (V1649 (hd V1650)) V1651))) (true (shen.f_error shen.map-h))))
+
+(defun length (V1652) (shen.length-h V1652 0))
+
+(defun shen.length-h (V1653 V1654) (cond ((= () V1653) V1654) (true (shen.length-h (tl V1653) (+ V1654 1)))))
+
+(defun occurrences (V1664 V1665) (cond ((= V1665 V1664) 1) ((cons? V1665) (+ (occurrences V1664 (hd V1665)) (occurrences V1664 (tl V1665)))) (true 0)))
+
+(defun nth (V1672 V1673) (cond ((and (= 1 V1672) (cons? V1673)) (hd V1673)) ((cons? V1673) (nth (- V1672 1) (tl V1673))) (true (shen.f_error nth))))
+
+(defun integer? (V1674) (and (number? V1674) (let Abs (shen.abs V1674) (shen.integer-test? Abs (shen.magless Abs 1)))))
+
+(defun shen.abs (V1675) (if (> V1675 0) V1675 (- 0 V1675)))
+
+(defun shen.magless (V1676 V1677) (let Nx2 (* V1677 2) (if (> Nx2 V1676) V1677 (shen.magless V1676 Nx2))))
+
+(defun shen.integer-test? (V1681 V1682) (cond ((= 0 V1681) true) ((> 1 V1681) false) (true (let Abs-N (- V1681 V1682) (if (> 0 Abs-N) (integer? V1681) (shen.integer-test? Abs-N V1682))))))
+
+(defun mapcan (V1685 V1686) (cond ((= () V1686) ()) ((cons? V1686) (append (V1685 (hd V1686)) (mapcan V1685 (tl V1686)))) (true (shen.f_error mapcan))))
+
+(defun == (V1696 V1697) (cond ((= V1697 V1696) true) (true false)))
+
+(defun abort () (simple-error ""))
+
+(defun bound? (V1698) (and (symbol? V1698) (let Val (trap-error (value V1698) (lambda E shen.this-symbol-is-unbound)) (if (= Val shen.this-symbol-is-unbound) false true))))
+
+(defun shen.string->bytes (V1699) (cond ((= "" V1699) ()) (true (cons (string->n (pos V1699 0)) (shen.string->bytes (tlstr V1699))))))
+
+(defun maxinferences (V1700) (set shen.*maxinferences* V1700))
+
+(defun inferences () (value shen.*infs*))
+
+(defun protect (V1701) V1701)
+
+(defun stoutput () (value *stoutput*))
+
+(defun string->symbol (V1702) (let Symbol (intern V1702) (if (symbol? Symbol) Symbol (simple-error (cn "cannot intern " (shen.app V1702 " to a symbol" shen.s))))))
+
+(defun optimise (V1707) (cond ((= + V1707) (set shen.*optimise* true)) ((= - V1707) (set shen.*optimise* false)) (true (simple-error "optimise expects a + or a -.
+"))))
+
+(defun os () (value *os*))
+
+(defun language () (value *language*))
+
+(defun version () (value *version*))
+
+(defun port () (value *port*))
+
+(defun porters () (value *porters*))
+
+(defun implementation () (value *implementation*))
+
+(defun release () (value *release*))
+
+(defun package? (V1708) (trap-error (do (external V1708) true) (lambda E false)))
+
+
+