"Copyright (c) 2015, Mark Tarver\n\nAll rights reserved.\n\nRedistribution and use in source and binary forms, with or without\nmodification, are permitted provided that the following conditions are met:\n1. Redistributions of source code must retain the above copyright\n   notice, this list of conditions and the following disclaimer.\n2. Redistributions in binary form must reproduce the above copyright\n   notice, this list of conditions and the following disclaimer in the\n   documentation and/or other materials provided with the distribution.\n3. The name of Mark Tarver may not be used to endorse or promote products\n   derived from this software without specific prior written permission.\n\nTHIS SOFTWARE IS PROVIDED BY Mark Tarver ''AS IS'' AND ANY\nEXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED\nWARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE\nDISCLAIMED. IN NO EVENT SHALL Mark Tarver BE LIABLE FOR ANY\nDIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES\n(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;\nLOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND\nON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT\n(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS\nSOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE."
(begin (register-function-arity (quote shen.shen->kl) 2) (define (kl:shen.shen->kl V1191 V1192) (kl:compile (lambda (X) (kl:shen.<define> X)) (cons V1191 V1192) (lambda (X) (kl:shen.shen-syntax-error V1191 X)))) (quote shen.shen->kl))
(begin (register-function-arity (quote shen.shen-syntax-error) 2) (define (kl:shen.shen-syntax-error V1199 V1200) (cond ((pair? V1200) (simple-error (string-append "syntax error in " (kl:shen.app V1199 (string-append " here:\n\n " (kl:shen.app (kl:shen.next-50 50 (car V1200)) "\n" (quote shen.a))) (quote shen.a))))) (#t (simple-error (string-append "syntax error in " (kl:shen.app V1199 "\n" (quote shen.a))))))) (quote shen.shen-syntax-error))
(begin (register-function-arity (quote shen.<define>) 1) (define (kl:shen.<define> V1202) (let ((YaccParse (let ((Parse_shen.<name> (kl:shen.<name> V1202))) (if (kl:not (eq? (quote shen.fail!) Parse_shen.<name>)) (let ((Parse_shen.<signature> (kl:shen.<signature> Parse_shen.<name>))) (if (kl:not (eq? (quote shen.fail!) Parse_shen.<signature>)) (let ((Parse_shen.<rules> (kl:shen.<rules> Parse_shen.<signature>))) (if (kl:not (eq? (quote shen.fail!) Parse_shen.<rules>)) (kl:shen.pair (car Parse_shen.<rules>) (kl:shen.compile_to_machine_code (kl:shen.hdtl Parse_shen.<name>) (kl:shen.hdtl Parse_shen.<rules>))) (quote shen.fail!))) (quote shen.fail!))) (quote shen.fail!))))) (if (eq? YaccParse (quote shen.fail!)) (let ((Parse_shen.<name> (kl:shen.<name> V1202))) (if (kl:not (eq? (quote shen.fail!) Parse_shen.<name>)) (let ((Parse_shen.<rules> (kl:shen.<rules> Parse_shen.<name>))) (if (kl:not (eq? (quote shen.fail!) Parse_shen.<rules>)) (kl:shen.pair (car Parse_shen.<rules>) (kl:shen.compile_to_machine_code (kl:shen.hdtl Parse_shen.<name>) (kl:shen.hdtl Parse_shen.<rules>))) (quote shen.fail!))) (quote shen.fail!))) YaccParse))) (quote shen.<define>))
(begin (register-function-arity (quote shen.<name>) 1) (define (kl:shen.<name> V1204) (if (pair? (car V1204)) (let ((Parse_X (kl:shen.hdhd V1204))) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V1204) (kl:shen.hdtl V1204))) (if (and (assert-boolean (symbol? Parse_X)) (kl:not (kl:shen.sysfunc? Parse_X))) Parse_X (simple-error (kl:shen.app Parse_X " is not a legitimate function name.\n" (quote shen.a)))))) (quote shen.fail!))) (quote shen.<name>))
(begin (register-function-arity (quote shen.sysfunc?) 1) (define (kl:shen.sysfunc? V1206) (kl:element? V1206 (kl:get (kl:intern "shen") (quote shen.external-symbols) (kl:value (quote *property-vector*))))) (quote shen.sysfunc?))
(begin (register-function-arity (quote shen.<signature>) 1) (define (kl:shen.<signature> V1210) (if (and (pair? (car V1210)) (eq? (quote |{|) (kl:shen.hdhd V1210))) (let ((NewStream1207 (kl:shen.pair (kl:shen.tlhd V1210) (kl:shen.hdtl V1210)))) (let ((Parse_shen.<signature-help> (kl:shen.<signature-help> NewStream1207))) (if (kl:not (eq? (quote shen.fail!) Parse_shen.<signature-help>)) (if (and (pair? (car Parse_shen.<signature-help>)) (eq? (quote |}|) (kl:shen.hdhd Parse_shen.<signature-help>))) (let ((NewStream1208 (kl:shen.pair (kl:shen.tlhd Parse_shen.<signature-help>) (kl:shen.hdtl Parse_shen.<signature-help>)))) (kl:shen.pair (car NewStream1208) (kl:shen.demodulate (kl:shen.curry-type (kl:shen.hdtl Parse_shen.<signature-help>))))) (quote shen.fail!)) (quote shen.fail!)))) (quote shen.fail!))) (quote shen.<signature>))
(begin (register-function-arity (quote shen.curry-type) 1) (define (kl:shen.curry-type V1212) (kl:shen.active-cons (kl:shen.curry-type-h V1212))) (quote shen.curry-type))
(begin (register-function-arity (quote shen.active-cons) 1) (define (kl:shen.active-cons V1214) (cond ((and (pair? V1214) (and (pair? (cdr V1214)) (and (pair? (cdr (cdr V1214))) (and (null? (cdr (cdr (cdr V1214)))) (eq? (car (cdr V1214)) (quote bar!)))))) (cons (kl:shen.active-cons (car V1214)) (kl:shen.active-cons (car (cdr (cdr V1214)))))) ((pair? V1214) (cons (kl:shen.active-cons (car V1214)) (kl:shen.active-cons (cdr V1214)))) (#t V1214))) (quote shen.active-cons))
(begin (register-function-arity (quote shen.curry-type-h) 1) (define (kl:shen.curry-type-h V1216) (cond ((and (pair? V1216) (and (pair? (cdr V1216)) (and (eq? (quote -->) (car (cdr V1216))) (and (pair? (cdr (cdr V1216))) (and (pair? (cdr (cdr (cdr V1216)))) (eq? (quote -->) (car (cdr (cdr (cdr V1216)))))))))) (kl:shen.curry-type-h (cons (car V1216) (cons (quote -->) (cons (cdr (cdr V1216)) (quote ())))))) ((and (pair? V1216) (and (pair? (cdr V1216)) (and (eq? (quote *) (car (cdr V1216))) (and (pair? (cdr (cdr V1216))) (and (pair? (cdr (cdr (cdr V1216)))) (eq? (quote *) (car (cdr (cdr (cdr V1216)))))))))) (kl:shen.curry-type-h (cons (car V1216) (cons (quote *) (cons (cdr (cdr V1216)) (quote ())))))) ((pair? V1216) (kl:map (lambda (Z) (kl:shen.curry-type-h Z)) V1216)) (#t V1216))) (quote shen.curry-type-h))
(begin (register-function-arity (quote shen.<signature-help>) 1) (define (kl:shen.<signature-help> V1218) (let ((YaccParse (if (pair? (car V1218)) (let ((Parse_X (kl:shen.hdhd V1218))) (let ((Parse_shen.<signature-help> (kl:shen.<signature-help> (kl:shen.pair (kl:shen.tlhd V1218) (kl:shen.hdtl V1218))))) (if (kl:not (eq? (quote shen.fail!) Parse_shen.<signature-help>)) (if (kl:not (kl:element? Parse_X (cons (quote |{|) (cons (quote |}|) (quote ()))))) (kl:shen.pair (car Parse_shen.<signature-help>) (cons Parse_X (kl:shen.hdtl Parse_shen.<signature-help>))) (quote shen.fail!)) (quote shen.fail!)))) (quote shen.fail!)))) (if (eq? YaccParse (quote shen.fail!)) (let ((Parse_<e> (kl:<e> V1218))) (if (kl:not (eq? (quote shen.fail!) Parse_<e>)) (kl:shen.pair (car Parse_<e>) (quote ())) (quote shen.fail!))) YaccParse))) (quote shen.<signature-help>))
(begin (register-function-arity (quote shen.<rules>) 1) (define (kl:shen.<rules> V1220) (let ((YaccParse (let ((Parse_shen.<rule> (kl:shen.<rule> V1220))) (if (kl:not (eq? (quote shen.fail!) Parse_shen.<rule>)) (let ((Parse_shen.<rules> (kl:shen.<rules> Parse_shen.<rule>))) (if (kl:not (eq? (quote shen.fail!) Parse_shen.<rules>)) (kl:shen.pair (car Parse_shen.<rules>) (cons (kl:shen.linearise (kl:shen.hdtl Parse_shen.<rule>)) (kl:shen.hdtl Parse_shen.<rules>))) (quote shen.fail!))) (quote shen.fail!))))) (if (eq? YaccParse (quote shen.fail!)) (let ((Parse_shen.<rule> (kl:shen.<rule> V1220))) (if (kl:not (eq? (quote shen.fail!) Parse_shen.<rule>)) (kl:shen.pair (car Parse_shen.<rule>) (cons (kl:shen.linearise (kl:shen.hdtl Parse_shen.<rule>)) (quote ()))) (quote shen.fail!))) YaccParse))) (quote shen.<rules>))
(begin (register-function-arity (quote shen.<rule>) 1) (define (kl:shen.<rule> V1228) (let ((YaccParse (let ((Parse_shen.<patterns> (kl:shen.<patterns> V1228))) (if (kl:not (eq? (quote shen.fail!) Parse_shen.<patterns>)) (if (and (pair? (car Parse_shen.<patterns>)) (eq? (quote ->) (kl:shen.hdhd Parse_shen.<patterns>))) (let ((NewStream1221 (kl:shen.pair (kl:shen.tlhd Parse_shen.<patterns>) (kl:shen.hdtl Parse_shen.<patterns>)))) (let ((Parse_shen.<action> (kl:shen.<action> NewStream1221))) (if (kl:not (eq? (quote shen.fail!) Parse_shen.<action>)) (if (and (pair? (car Parse_shen.<action>)) (eq? (quote where) (kl:shen.hdhd Parse_shen.<action>))) (let ((NewStream1222 (kl:shen.pair (kl:shen.tlhd Parse_shen.<action>) (kl:shen.hdtl Parse_shen.<action>)))) (let ((Parse_shen.<guard> (kl:shen.<guard> NewStream1222))) (if (kl:not (eq? (quote shen.fail!) Parse_shen.<guard>)) (kl:shen.pair (car Parse_shen.<guard>) (cons (kl:shen.hdtl Parse_shen.<patterns>) (cons (cons (quote where) (cons (kl:shen.hdtl Parse_shen.<guard>) (cons (kl:shen.hdtl Parse_shen.<action>) (quote ())))) (quote ())))) (quote shen.fail!)))) (quote shen.fail!)) (quote shen.fail!)))) (quote shen.fail!)) (quote shen.fail!))))) (if (eq? YaccParse (quote shen.fail!)) (let ((YaccParse (let ((Parse_shen.<patterns> (kl:shen.<patterns> V1228))) (if (kl:not (eq? (quote shen.fail!) Parse_shen.<patterns>)) (if (and (pair? (car Parse_shen.<patterns>)) (eq? (quote ->) (kl:shen.hdhd Parse_shen.<patterns>))) (let ((NewStream1223 (kl:shen.pair (kl:shen.tlhd Parse_shen.<patterns>) (kl:shen.hdtl Parse_shen.<patterns>)))) (let ((Parse_shen.<action> (kl:shen.<action> NewStream1223))) (if (kl:not (eq? (quote shen.fail!) Parse_shen.<action>)) (kl:shen.pair (car Parse_shen.<action>) (cons (kl:shen.hdtl Parse_shen.<patterns>) (cons (kl:shen.hdtl Parse_shen.<action>) (quote ())))) (quote shen.fail!)))) (quote shen.fail!)) (quote shen.fail!))))) (if (eq? YaccParse (quote shen.fail!)) (let ((YaccParse (let ((Parse_shen.<patterns> (kl:shen.<patterns> V1228))) (if (kl:not (eq? (quote shen.fail!) Parse_shen.<patterns>)) (if (and (pair? (car Parse_shen.<patterns>)) (eq? (quote <-) (kl:shen.hdhd Parse_shen.<patterns>))) (let ((NewStream1224 (kl:shen.pair (kl:shen.tlhd Parse_shen.<patterns>) (kl:shen.hdtl Parse_shen.<patterns>)))) (let ((Parse_shen.<action> (kl:shen.<action> NewStream1224))) (if (kl:not (eq? (quote shen.fail!) Parse_shen.<action>)) (if (and (pair? (car Parse_shen.<action>)) (eq? (quote where) (kl:shen.hdhd Parse_shen.<action>))) (let ((NewStream1225 (kl:shen.pair (kl:shen.tlhd Parse_shen.<action>) (kl:shen.hdtl Parse_shen.<action>)))) (let ((Parse_shen.<guard> (kl:shen.<guard> NewStream1225))) (if (kl:not (eq? (quote shen.fail!) Parse_shen.<guard>)) (kl:shen.pair (car Parse_shen.<guard>) (cons (kl:shen.hdtl Parse_shen.<patterns>) (cons (cons (quote where) (cons (kl:shen.hdtl Parse_shen.<guard>) (cons (cons (quote shen.choicepoint!) (cons (kl:shen.hdtl Parse_shen.<action>) (quote ()))) (quote ())))) (quote ())))) (quote shen.fail!)))) (quote shen.fail!)) (quote shen.fail!)))) (quote shen.fail!)) (quote shen.fail!))))) (if (eq? YaccParse (quote shen.fail!)) (let ((Parse_shen.<patterns> (kl:shen.<patterns> V1228))) (if (kl:not (eq? (quote shen.fail!) Parse_shen.<patterns>)) (if (and (pair? (car Parse_shen.<patterns>)) (eq? (quote <-) (kl:shen.hdhd Parse_shen.<patterns>))) (let ((NewStream1226 (kl:shen.pair (kl:shen.tlhd Parse_shen.<patterns>) (kl:shen.hdtl Parse_shen.<patterns>)))) (let ((Parse_shen.<action> (kl:shen.<action> NewStream1226))) (if (kl:not (eq? (quote shen.fail!) Parse_shen.<action>)) (kl:shen.pair (car Parse_shen.<action>) (cons (kl:shen.hdtl Parse_shen.<patterns>) (cons (cons (quote shen.choicepoint!) (cons (kl:shen.hdtl Parse_shen.<action>) (quote ()))) (quote ())))) (quote shen.fail!)))) (quote shen.fail!)) (quote shen.fail!))) YaccParse)) YaccParse)) YaccParse))) (quote shen.<rule>))
(begin (register-function-arity (quote shen.fail_if) 2) (define (kl:shen.fail_if V1231 V1232) (if (assert-boolean (V1231 V1232)) (quote shen.fail!) V1232)) (quote shen.fail_if))
(begin (register-function-arity (quote shen.succeeds?) 1) (define (kl:shen.succeeds? V1238) (cond ((eq? V1238 (quote shen.fail!)) #f) (#t #t))) (quote shen.succeeds?))
(begin (register-function-arity (quote shen.<patterns>) 1) (define (kl:shen.<patterns> V1240) (let ((YaccParse (let ((Parse_shen.<pattern> (kl:shen.<pattern> V1240))) (if (kl:not (eq? (quote shen.fail!) Parse_shen.<pattern>)) (let ((Parse_shen.<patterns> (kl:shen.<patterns> Parse_shen.<pattern>))) (if (kl:not (eq? (quote shen.fail!) Parse_shen.<patterns>)) (kl:shen.pair (car Parse_shen.<patterns>) (cons (kl:shen.hdtl Parse_shen.<pattern>) (kl:shen.hdtl Parse_shen.<patterns>))) (quote shen.fail!))) (quote shen.fail!))))) (if (eq? YaccParse (quote shen.fail!)) (let ((Parse_<e> (kl:<e> V1240))) (if (kl:not (eq? (quote shen.fail!) Parse_<e>)) (kl:shen.pair (car Parse_<e>) (quote ())) (quote shen.fail!))) YaccParse))) (quote shen.<patterns>))
(begin (register-function-arity (quote shen.<pattern>) 1) (define (kl:shen.<pattern> V1253) (let ((YaccParse (if (and (pair? (car V1253)) (pair? (kl:shen.hdhd V1253))) (if (and (pair? (car (kl:shen.pair (kl:shen.hdhd V1253) (kl:shen.hdtl V1253)))) (eq? (quote _scheme_at_p) (kl:shen.hdhd (kl:shen.pair (kl:shen.hdhd V1253) (kl:shen.hdtl V1253))))) (let ((NewStream1242 (kl:shen.pair (kl:shen.tlhd (kl:shen.pair (kl:shen.hdhd V1253) (kl:shen.hdtl V1253))) (kl:shen.hdtl (kl:shen.pair (kl:shen.hdhd V1253) (kl:shen.hdtl V1253)))))) (let ((Parse_shen.<pattern1> (kl:shen.<pattern1> NewStream1242))) (if (kl:not (eq? (quote shen.fail!) Parse_shen.<pattern1>)) (let ((Parse_shen.<pattern2> (kl:shen.<pattern2> Parse_shen.<pattern1>))) (if (kl:not (eq? (quote shen.fail!) Parse_shen.<pattern2>)) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V1253) (kl:shen.hdtl V1253))) (cons (quote _scheme_at_p) (cons (kl:shen.hdtl Parse_shen.<pattern1>) (cons (kl:shen.hdtl Parse_shen.<pattern2>) (quote ()))))) (quote shen.fail!))) (quote shen.fail!)))) (quote shen.fail!)) (quote shen.fail!)))) (if (eq? YaccParse (quote shen.fail!)) (let ((YaccParse (if (and (pair? (car V1253)) (pair? (kl:shen.hdhd V1253))) (if (and (pair? (car (kl:shen.pair (kl:shen.hdhd V1253) (kl:shen.hdtl V1253)))) (eq? (quote cons) (kl:shen.hdhd (kl:shen.pair (kl:shen.hdhd V1253) (kl:shen.hdtl V1253))))) (let ((NewStream1244 (kl:shen.pair (kl:shen.tlhd (kl:shen.pair (kl:shen.hdhd V1253) (kl:shen.hdtl V1253))) (kl:shen.hdtl (kl:shen.pair (kl:shen.hdhd V1253) (kl:shen.hdtl V1253)))))) (let ((Parse_shen.<pattern1> (kl:shen.<pattern1> NewStream1244))) (if (kl:not (eq? (quote shen.fail!) Parse_shen.<pattern1>)) (let ((Parse_shen.<pattern2> (kl:shen.<pattern2> Parse_shen.<pattern1>))) (if (kl:not (eq? (quote shen.fail!) Parse_shen.<pattern2>)) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V1253) (kl:shen.hdtl V1253))) (cons (quote cons) (cons (kl:shen.hdtl Parse_shen.<pattern1>) (cons (kl:shen.hdtl Parse_shen.<pattern2>) (quote ()))))) (quote shen.fail!))) (quote shen.fail!)))) (quote shen.fail!)) (quote shen.fail!)))) (if (eq? YaccParse (quote shen.fail!)) (let ((YaccParse (if (and (pair? (car V1253)) (pair? (kl:shen.hdhd V1253))) (if (and (pair? (car (kl:shen.pair (kl:shen.hdhd V1253) (kl:shen.hdtl V1253)))) (eq? (quote _scheme_at_v) (kl:shen.hdhd (kl:shen.pair (kl:shen.hdhd V1253) (kl:shen.hdtl V1253))))) (let ((NewStream1246 (kl:shen.pair (kl:shen.tlhd (kl:shen.pair (kl:shen.hdhd V1253) (kl:shen.hdtl V1253))) (kl:shen.hdtl (kl:shen.pair (kl:shen.hdhd V1253) (kl:shen.hdtl V1253)))))) (let ((Parse_shen.<pattern1> (kl:shen.<pattern1> NewStream1246))) (if (kl:not (eq? (quote shen.fail!) Parse_shen.<pattern1>)) (let ((Parse_shen.<pattern2> (kl:shen.<pattern2> Parse_shen.<pattern1>))) (if (kl:not (eq? (quote shen.fail!) Parse_shen.<pattern2>)) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V1253) (kl:shen.hdtl V1253))) (cons (quote _scheme_at_v) (cons (kl:shen.hdtl Parse_shen.<pattern1>) (cons (kl:shen.hdtl Parse_shen.<pattern2>) (quote ()))))) (quote shen.fail!))) (quote shen.fail!)))) (quote shen.fail!)) (quote shen.fail!)))) (if (eq? YaccParse (quote shen.fail!)) (let ((YaccParse (if (and (pair? (car V1253)) (pair? (kl:shen.hdhd V1253))) (if (and (pair? (car (kl:shen.pair (kl:shen.hdhd V1253) (kl:shen.hdtl V1253)))) (eq? (quote _scheme_at_s) (kl:shen.hdhd (kl:shen.pair (kl:shen.hdhd V1253) (kl:shen.hdtl V1253))))) (let ((NewStream1248 (kl:shen.pair (kl:shen.tlhd (kl:shen.pair (kl:shen.hdhd V1253) (kl:shen.hdtl V1253))) (kl:shen.hdtl (kl:shen.pair (kl:shen.hdhd V1253) (kl:shen.hdtl V1253)))))) (let ((Parse_shen.<pattern1> (kl:shen.<pattern1> NewStream1248))) (if (kl:not (eq? (quote shen.fail!) Parse_shen.<pattern1>)) (let ((Parse_shen.<pattern2> (kl:shen.<pattern2> Parse_shen.<pattern1>))) (if (kl:not (eq? (quote shen.fail!) Parse_shen.<pattern2>)) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V1253) (kl:shen.hdtl V1253))) (cons (quote _scheme_at_s) (cons (kl:shen.hdtl Parse_shen.<pattern1>) (cons (kl:shen.hdtl Parse_shen.<pattern2>) (quote ()))))) (quote shen.fail!))) (quote shen.fail!)))) (quote shen.fail!)) (quote shen.fail!)))) (if (eq? YaccParse (quote shen.fail!)) (let ((YaccParse (if (and (pair? (car V1253)) (pair? (kl:shen.hdhd V1253))) (if (and (pair? (car (kl:shen.pair (kl:shen.hdhd V1253) (kl:shen.hdtl V1253)))) (eq? (quote vector) (kl:shen.hdhd (kl:shen.pair (kl:shen.hdhd V1253) (kl:shen.hdtl V1253))))) (let ((NewStream1250 (kl:shen.pair (kl:shen.tlhd (kl:shen.pair (kl:shen.hdhd V1253) (kl:shen.hdtl V1253))) (kl:shen.hdtl (kl:shen.pair (kl:shen.hdhd V1253) (kl:shen.hdtl V1253)))))) (if (and (pair? (car NewStream1250)) (kl:= 0 (kl:shen.hdhd NewStream1250))) (let ((NewStream1251 (kl:shen.pair (kl:shen.tlhd NewStream1250) (kl:shen.hdtl NewStream1250)))) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V1253) (kl:shen.hdtl V1253))) (cons (quote vector) (cons 0 (quote ()))))) (quote shen.fail!))) (quote shen.fail!)) (quote shen.fail!)))) (if (eq? YaccParse (quote shen.fail!)) (let ((YaccParse (if (pair? (car V1253)) (let ((Parse_X (kl:shen.hdhd V1253))) (if (pair? Parse_X) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V1253) (kl:shen.hdtl V1253))) (kl:shen.constructor-error Parse_X)) (quote shen.fail!))) (quote shen.fail!)))) (if (eq? YaccParse (quote shen.fail!)) (let ((Parse_shen.<simple_pattern> (kl:shen.<simple_pattern> V1253))) (if (kl:not (eq? (quote shen.fail!) Parse_shen.<simple_pattern>)) (kl:shen.pair (car Parse_shen.<simple_pattern>) (kl:shen.hdtl Parse_shen.<simple_pattern>)) (quote shen.fail!))) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse))) (quote shen.<pattern>))
(begin (register-function-arity (quote shen.constructor-error) 1) (define (kl:shen.constructor-error V1255) (simple-error (kl:shen.app V1255 " is not a legitimate constructor\n" (quote shen.a)))) (quote shen.constructor-error))
(begin (register-function-arity (quote shen.<simple_pattern>) 1) (define (kl:shen.<simple_pattern> V1257) (let ((YaccParse (if (pair? (car V1257)) (let ((Parse_X (kl:shen.hdhd V1257))) (if (eq? Parse_X (quote _)) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V1257) (kl:shen.hdtl V1257))) (kl:gensym (quote Parse_Y))) (quote shen.fail!))) (quote shen.fail!)))) (if (eq? YaccParse (quote shen.fail!)) (if (pair? (car V1257)) (let ((Parse_X (kl:shen.hdhd V1257))) (if (kl:not (kl:element? Parse_X (cons (quote ->) (cons (quote <-) (quote ()))))) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V1257) (kl:shen.hdtl V1257))) Parse_X) (quote shen.fail!))) (quote shen.fail!)) YaccParse))) (quote shen.<simple_pattern>))
(begin (register-function-arity (quote shen.<pattern1>) 1) (define (kl:shen.<pattern1> V1259) (let ((Parse_shen.<pattern> (kl:shen.<pattern> V1259))) (if (kl:not (eq? (quote shen.fail!) Parse_shen.<pattern>)) (kl:shen.pair (car Parse_shen.<pattern>) (kl:shen.hdtl Parse_shen.<pattern>)) (quote shen.fail!)))) (quote shen.<pattern1>))
(begin (register-function-arity (quote shen.<pattern2>) 1) (define (kl:shen.<pattern2> V1261) (let ((Parse_shen.<pattern> (kl:shen.<pattern> V1261))) (if (kl:not (eq? (quote shen.fail!) Parse_shen.<pattern>)) (kl:shen.pair (car Parse_shen.<pattern>) (kl:shen.hdtl Parse_shen.<pattern>)) (quote shen.fail!)))) (quote shen.<pattern2>))
(begin (register-function-arity (quote shen.<action>) 1) (define (kl:shen.<action> V1263) (if (pair? (car V1263)) (let ((Parse_X (kl:shen.hdhd V1263))) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V1263) (kl:shen.hdtl V1263))) Parse_X)) (quote shen.fail!))) (quote shen.<action>))
(begin (register-function-arity (quote shen.<guard>) 1) (define (kl:shen.<guard> V1265) (if (pair? (car V1265)) (let ((Parse_X (kl:shen.hdhd V1265))) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V1265) (kl:shen.hdtl V1265))) Parse_X)) (quote shen.fail!))) (quote shen.<guard>))
(begin (register-function-arity (quote shen.compile_to_machine_code) 2) (define (kl:shen.compile_to_machine_code V1268 V1269) (let ((Lambda+ (kl:shen.compile_to_lambda+ V1268 V1269))) (let ((KL (kl:shen.compile_to_kl V1268 Lambda+))) (let ((Record (kl:shen.record-source V1268 KL))) KL)))) (quote shen.compile_to_machine_code))
(begin (register-function-arity (quote shen.record-source) 2) (define (kl:shen.record-source V1274 V1275) (cond ((assert-boolean (kl:value (quote shen.*installing-kl*))) (quote shen.skip)) (#t (kl:put V1274 (quote shen.source) V1275 (kl:value (quote *property-vector*)))))) (quote shen.record-source))
(begin (register-function-arity (quote shen.compile_to_lambda+) 2) (define (kl:shen.compile_to_lambda+ V1278 V1279) (let ((Arity (kl:shen.aritycheck V1278 V1279))) (let ((UpDateSymbolTable (kl:shen.update-symbol-table V1278 Arity))) (let ((Free (kl:shen.for-each (lambda (Rule) (kl:shen.free_variable_check V1278 Rule)) V1279))) (let ((Variables (kl:shen.parameters Arity))) (let ((Strip (kl:map (lambda (X) (kl:shen.strip-protect X)) V1279))) (let ((Abstractions (kl:map (lambda (X) (kl:shen.abstract_rule X)) Strip))) (let ((Applications (kl:map (lambda (X) (kl:shen.application_build Variables X)) Abstractions))) (cons Variables (cons Applications (quote ()))))))))))) (quote shen.compile_to_lambda+))
(begin (register-function-arity (quote shen.update-symbol-table) 2) (define (kl:shen.update-symbol-table V1282 V1283) (cond ((kl:= 0 V1283) (quote shen.skip)) (#t (kl:put V1282 (quote shen.lambda-form) (kl:eval-kl (kl:shen.lambda-form V1282 V1283)) (kl:value (quote *property-vector*)))))) (quote shen.update-symbol-table))
(begin (register-function-arity (quote shen.free_variable_check) 2) (define (kl:shen.free_variable_check V1286 V1287) (cond ((and (pair? V1287) (and (pair? (cdr V1287)) (null? (cdr (cdr V1287))))) (let ((Bound (kl:shen.extract_vars (car V1287)))) (let ((Free (kl:shen.extract_free_vars Bound (car (cdr V1287))))) (kl:shen.free_variable_warnings V1286 Free)))) (#t (kl:shen.f_error (quote shen.free_variable_check))))) (quote shen.free_variable_check))
(begin (register-function-arity (quote shen.extract_vars) 1) (define (kl:shen.extract_vars V1289) (cond ((kl:variable? V1289) (cons V1289 (quote ()))) ((pair? V1289) (kl:union (kl:shen.extract_vars (car V1289)) (kl:shen.extract_vars (cdr V1289)))) (#t (quote ())))) (quote shen.extract_vars))
(begin (register-function-arity (quote shen.extract_free_vars) 2) (define (kl:shen.extract_free_vars V1301 V1302) (cond ((and (pair? V1302) (and (pair? (cdr V1302)) (and (null? (cdr (cdr V1302))) (eq? (car V1302) (quote protect))))) (quote ())) ((and (kl:variable? V1302) (kl:not (kl:element? V1302 V1301))) (cons V1302 (quote ()))) ((and (pair? V1302) (and (eq? (quote lambda) (car V1302)) (and (pair? (cdr V1302)) (and (pair? (cdr (cdr V1302))) (null? (cdr (cdr (cdr V1302)))))))) (kl:shen.extract_free_vars (cons (car (cdr V1302)) V1301) (car (cdr (cdr V1302))))) ((and (pair? V1302) (and (eq? (quote let) (car V1302)) (and (pair? (cdr V1302)) (and (pair? (cdr (cdr V1302))) (and (pair? (cdr (cdr (cdr V1302)))) (null? (cdr (cdr (cdr (cdr V1302)))))))))) (kl:union (kl:shen.extract_free_vars V1301 (car (cdr (cdr V1302)))) (kl:shen.extract_free_vars (cons (car (cdr V1302)) V1301) (car (cdr (cdr (cdr V1302))))))) ((pair? V1302) (kl:union (kl:shen.extract_free_vars V1301 (car V1302)) (kl:shen.extract_free_vars V1301 (cdr V1302)))) (#t (quote ())))) (quote shen.extract_free_vars))
(begin (register-function-arity (quote shen.free_variable_warnings) 2) (define (kl:shen.free_variable_warnings V1307 V1308) (cond ((null? V1308) (quote _)) (#t (simple-error (string-append "error: the following variables are free in " (kl:shen.app V1307 (string-append ": " (kl:shen.app (kl:shen.list_variables V1308) "" (quote shen.a))) (quote shen.a))))))) (quote shen.free_variable_warnings))
(begin (register-function-arity (quote shen.list_variables) 1) (define (kl:shen.list_variables V1310) (cond ((and (pair? V1310) (null? (cdr V1310))) (string-append (kl:str (car V1310)) ".")) ((pair? V1310) (string-append (kl:str (car V1310)) (string-append ", " (kl:shen.list_variables (cdr V1310))))) (#t (kl:shen.f_error (quote shen.list_variables))))) (quote shen.list_variables))
(begin (register-function-arity (quote shen.strip-protect) 1) (define (kl:shen.strip-protect V1312) (cond ((and (pair? V1312) (and (pair? (cdr V1312)) (and (null? (cdr (cdr V1312))) (eq? (car V1312) (quote protect))))) (kl:shen.strip-protect (car (cdr V1312)))) ((pair? V1312) (kl:map (lambda (Z) (kl:shen.strip-protect Z)) V1312)) (#t V1312))) (quote shen.strip-protect))
(begin (register-function-arity (quote shen.linearise) 1) (define (kl:shen.linearise V1314) (cond ((and (pair? V1314) (and (pair? (cdr V1314)) (null? (cdr (cdr V1314))))) (kl:shen.linearise_help (kl:shen.flatten (car V1314)) (car V1314) (car (cdr V1314)))) (#t (kl:shen.f_error (quote shen.linearise))))) (quote shen.linearise))
(begin (register-function-arity (quote shen.flatten) 1) (define (kl:shen.flatten V1316) (cond ((null? V1316) (quote ())) ((pair? V1316) (kl:append (kl:shen.flatten (car V1316)) (kl:shen.flatten (cdr V1316)))) (#t (cons V1316 (quote ()))))) (quote shen.flatten))
(begin (register-function-arity (quote shen.linearise_help) 3) (define (kl:shen.linearise_help V1320 V1321 V1322) (cond ((null? V1320) (cons V1321 (cons V1322 (quote ())))) ((pair? V1320) (if (and (kl:variable? (car V1320)) (kl:element? (car V1320) (cdr V1320))) (let ((Var (kl:gensym (car V1320)))) (let ((NewAction (cons (quote where) (cons (cons (quote =) (cons (car V1320) (cons Var (quote ())))) (cons V1322 (quote ())))))) (let ((NewPatts (kl:shen.linearise_X (car V1320) Var V1321))) (kl:shen.linearise_help (cdr V1320) NewPatts NewAction)))) (kl:shen.linearise_help (cdr V1320) V1321 V1322))) (#t (kl:shen.f_error (quote shen.linearise_help))))) (quote shen.linearise_help))
(begin (register-function-arity (quote shen.linearise_X) 3) (define (kl:shen.linearise_X V1335 V1336 V1337) (cond ((kl:= V1337 V1335) V1336) ((pair? V1337) (let ((L (kl:shen.linearise_X V1335 V1336 (car V1337)))) (if (kl:= L (car V1337)) (cons (car V1337) (kl:shen.linearise_X V1335 V1336 (cdr V1337))) (cons L (cdr V1337))))) (#t V1337))) (quote shen.linearise_X))
(begin (register-function-arity (quote shen.aritycheck) 2) (define (kl:shen.aritycheck V1340 V1341) (cond ((and (pair? V1341) (and (pair? (car V1341)) (and (pair? (cdr (car V1341))) (and (null? (cdr (cdr (car V1341)))) (null? (cdr V1341)))))) (begin (kl:shen.aritycheck-action (car (cdr (car V1341)))) (kl:shen.aritycheck-name V1340 (kl:arity V1340) (kl:length (car (car V1341)))))) ((and (pair? V1341) (and (pair? (car V1341)) (and (pair? (cdr (car V1341))) (and (null? (cdr (cdr (car V1341)))) (and (pair? (cdr V1341)) (and (pair? (car (cdr V1341))) (and (pair? (cdr (car (cdr V1341)))) (null? (cdr (cdr (car (cdr V1341)))))))))))) (if (kl:= (kl:length (car (car V1341))) (kl:length (car (car (cdr V1341))))) (begin (kl:shen.aritycheck-action (car (cdr (car V1341)))) (kl:shen.aritycheck V1340 (cdr V1341))) (simple-error (string-append "arity error in " (kl:shen.app V1340 "\n" (quote shen.a)))))) (#t (kl:shen.f_error (quote shen.aritycheck))))) (quote shen.aritycheck))
(begin (register-function-arity (quote shen.aritycheck-name) 3) (define (kl:shen.aritycheck-name V1354 V1355 V1356) (cond ((kl:= -1 V1355) V1356) ((kl:= V1356 V1355) V1356) (#t (begin (kl:shen.prhush (string-append "\nwarning: changing the arity of " (kl:shen.app V1354 " can cause errors.\n" (quote shen.a))) (kl:stoutput)) V1356)))) (quote shen.aritycheck-name))
(begin (register-function-arity (quote shen.aritycheck-action) 1) (define (kl:shen.aritycheck-action V1362) (cond ((pair? V1362) (begin (kl:shen.aah (car V1362) (cdr V1362)) (kl:shen.for-each (lambda (Y) (kl:shen.aritycheck-action Y)) V1362))) (#t (quote shen.skip)))) (quote shen.aritycheck-action))
(begin (register-function-arity (quote shen.aah) 2) (define (kl:shen.aah V1365 V1366) (let ((Arity (kl:arity V1365))) (let ((Len (kl:length V1366))) (if (and (> Arity -1) (> Len Arity)) (kl:shen.prhush (string-append "warning: " (kl:shen.app V1365 (string-append " might not like " (kl:shen.app Len (string-append " argument" (kl:shen.app (if (> Len 1) "s" "") ".\n" (quote shen.a))) (quote shen.a))) (quote shen.a))) (kl:stoutput)) (quote shen.skip))))) (quote shen.aah))
(begin (register-function-arity (quote shen.abstract_rule) 1) (define (kl:shen.abstract_rule V1368) (cond ((and (pair? V1368) (and (pair? (cdr V1368)) (null? (cdr (cdr V1368))))) (kl:shen.abstraction_build (car V1368) (car (cdr V1368)))) (#t (kl:shen.f_error (quote shen.abstract_rule))))) (quote shen.abstract_rule))
(begin (register-function-arity (quote shen.abstraction_build) 2) (define (kl:shen.abstraction_build V1371 V1372) (cond ((null? V1371) V1372) ((pair? V1371) (cons (quote /.) (cons (car V1371) (cons (kl:shen.abstraction_build (cdr V1371) V1372) (quote ()))))) (#t (kl:shen.f_error (quote shen.abstraction_build))))) (quote shen.abstraction_build))
(begin (register-function-arity (quote shen.parameters) 1) (define (kl:shen.parameters V1374) (cond ((kl:= 0 V1374) (quote ())) (#t (cons (kl:gensym (quote V)) (kl:shen.parameters (- V1374 1)))))) (quote shen.parameters))
(begin (register-function-arity (quote shen.application_build) 2) (define (kl:shen.application_build V1377 V1378) (cond ((null? V1377) V1378) ((pair? V1377) (kl:shen.application_build (cdr V1377) (cons V1378 (cons (car V1377) (quote ()))))) (#t (kl:shen.f_error (quote shen.application_build))))) (quote shen.application_build))
(begin (register-function-arity (quote shen.compile_to_kl) 2) (define (kl:shen.compile_to_kl V1381 V1382) (cond ((and (pair? V1382) (and (pair? (cdr V1382)) (null? (cdr (cdr V1382))))) (let ((Arity (kl:shen.store-arity V1381 (kl:length (car V1382))))) (let ((Reduce (kl:map (lambda (X) (kl:shen.reduce X)) (car (cdr V1382))))) (let ((CondExpression (kl:shen.cond-expression V1381 (car V1382) Reduce))) (let ((TypeTable (if (assert-boolean (kl:value (quote shen.*optimise*))) (kl:shen.typextable (kl:shen.get-type V1381) (car V1382)) (quote shen.skip)))) (let ((TypedCondExpression (if (assert-boolean (kl:value (quote shen.*optimise*))) (kl:shen.assign-types (car V1382) TypeTable CondExpression) CondExpression))) (cons (quote defun) (cons V1381 (cons (car V1382) (cons TypedCondExpression (quote ()))))))))))) (#t (kl:shen.f_error (quote shen.compile_to_kl))))) (quote shen.compile_to_kl))
(begin (register-function-arity (quote shen.get-type) 1) (define (kl:shen.get-type V1388) (cond ((pair? V1388) (quote shen.skip)) (#t (let ((FType (kl:assoc V1388 (kl:value (quote shen.*signedfuncs*))))) (if (kl:empty? FType) (quote shen.skip) (cdr FType)))))) (quote shen.get-type))
(begin (register-function-arity (quote shen.typextable) 2) (define (kl:shen.typextable V1399 V1400) (cond ((and (pair? V1399) (and (pair? (cdr V1399)) (and (eq? (quote -->) (car (cdr V1399))) (and (pair? (cdr (cdr V1399))) (and (null? (cdr (cdr (cdr V1399)))) (pair? V1400)))))) (if (kl:variable? (car V1399)) (kl:shen.typextable (car (cdr (cdr V1399))) (cdr V1400)) (cons (cons (car V1400) (car V1399)) (kl:shen.typextable (car (cdr (cdr V1399))) (cdr V1400))))) (#t (quote ())))) (quote shen.typextable))
(begin (register-function-arity (quote shen.assign-types) 3) (define (kl:shen.assign-types V1404 V1405 V1406) (cond ((and (pair? V1406) (and (eq? (quote let) (car V1406)) (and (pair? (cdr V1406)) (and (pair? (cdr (cdr V1406))) (and (pair? (cdr (cdr (cdr V1406)))) (null? (cdr (cdr (cdr (cdr V1406)))))))))) (cons (quote let) (cons (car (cdr V1406)) (cons (kl:shen.assign-types V1404 V1405 (car (cdr (cdr V1406)))) (cons (kl:shen.assign-types (cons (car (cdr V1406)) V1404) V1405 (car (cdr (cdr (cdr V1406))))) (quote ())))))) ((and (pair? V1406) (and (eq? (quote lambda) (car V1406)) (and (pair? (cdr V1406)) (and (pair? (cdr (cdr V1406))) (null? (cdr (cdr (cdr V1406)))))))) (cons (quote lambda) (cons (car (cdr V1406)) (cons (kl:shen.assign-types (cons (car (cdr V1406)) V1404) V1405 (car (cdr (cdr V1406)))) (quote ()))))) ((and (pair? V1406) (eq? (quote cond) (car V1406))) (cons (quote cond) (kl:map (lambda (Y) (cons (kl:shen.assign-types V1404 V1405 (car Y)) (cons (kl:shen.assign-types V1404 V1405 (car (cdr Y))) (quote ())))) (cdr V1406)))) ((pair? V1406) (let ((NewTable (kl:shen.typextable (kl:shen.get-type (car V1406)) (cdr V1406)))) (cons (car V1406) (kl:map (lambda (Y) (kl:shen.assign-types V1404 (kl:append V1405 NewTable) Y)) (cdr V1406))))) (#t (let ((AtomType (kl:assoc V1406 V1405))) (if (pair? AtomType) (cons (quote type) (cons V1406 (cons (cdr AtomType) (quote ())))) (if (kl:element? V1406 V1404) V1406 (kl:shen.atom-type V1406))))))) (quote shen.assign-types))
(begin (register-function-arity (quote shen.atom-type) 1) (define (kl:shen.atom-type V1408) (if (string? V1408) (cons (quote type) (cons V1408 (cons (quote string) (quote ())))) (if (number? V1408) (cons (quote type) (cons V1408 (cons (quote number) (quote ())))) (if (kl:boolean? V1408) (cons (quote type) (cons V1408 (cons (quote boolean) (quote ())))) (if (assert-boolean (symbol? V1408)) (cons (quote type) (cons V1408 (cons (quote symbol) (quote ())))) V1408))))) (quote shen.atom-type))
(begin (register-function-arity (quote shen.store-arity) 2) (define (kl:shen.store-arity V1413 V1414) (cond ((assert-boolean (kl:value (quote shen.*installing-kl*))) (quote shen.skip)) (#t (kl:put V1413 (quote arity) V1414 (kl:value (quote *property-vector*)))))) (quote shen.store-arity))
(begin (register-function-arity (quote shen.reduce) 1) (define (kl:shen.reduce V1416) (begin (kl:set (quote shen.*teststack*) (quote ())) (let ((Result (kl:shen.reduce_help V1416))) (cons (cons (quote :) (cons (quote shen.tests) (kl:reverse (kl:value (quote shen.*teststack*))))) (cons Result (quote ())))))) (quote shen.reduce))
(begin (register-function-arity (quote shen.reduce_help) 1) (define (kl:shen.reduce_help V1418) (cond ((and (pair? V1418) (and (pair? (car V1418)) (and (eq? (quote /.) (car (car V1418))) (and (pair? (cdr (car V1418))) (and (pair? (car (cdr (car V1418)))) (and (eq? (quote cons) (car (car (cdr (car V1418))))) (and (pair? (cdr (car (cdr (car V1418))))) (and (pair? (cdr (cdr (car (cdr (car V1418)))))) (and (null? (cdr (cdr (cdr (car (cdr (car V1418))))))) (and (pair? (cdr (cdr (car V1418)))) (and (null? (cdr (cdr (cdr (car V1418))))) (and (pair? (cdr V1418)) (null? (cdr (cdr V1418))))))))))))))) (begin (kl:shen.add_test (cons (quote cons?) (cdr V1418))) (let ((Abstraction (cons (quote /.) (cons (car (cdr (car (cdr (car V1418))))) (cons (cons (quote /.) (cons (car (cdr (cdr (car (cdr (car V1418)))))) (cons (kl:shen.ebr (car (cdr V1418)) (car (cdr (car V1418))) (car (cdr (cdr (car V1418))))) (quote ())))) (quote ())))))) (let ((Application (cons (cons Abstraction (cons (cons (quote hd) (cdr V1418)) (quote ()))) (cons (cons (quote tl) (cdr V1418)) (quote ()))))) (kl:shen.reduce_help Application))))) ((and (pair? V1418) (and (pair? (car V1418)) (and (eq? (quote /.) (car (car V1418))) (and (pair? (cdr (car V1418))) (and (pair? (car (cdr (car V1418)))) (and (eq? (quote _scheme_at_p) (car (car (cdr (car V1418))))) (and (pair? (cdr (car (cdr (car V1418))))) (and (pair? (cdr (cdr (car (cdr (car V1418)))))) (and (null? (cdr (cdr (cdr (car (cdr (car V1418))))))) (and (pair? (cdr (cdr (car V1418)))) (and (null? (cdr (cdr (cdr (car V1418))))) (and (pair? (cdr V1418)) (null? (cdr (cdr V1418))))))))))))))) (begin (kl:shen.add_test (cons (quote tuple?) (cdr V1418))) (let ((Abstraction (cons (quote /.) (cons (car (cdr (car (cdr (car V1418))))) (cons (cons (quote /.) (cons (car (cdr (cdr (car (cdr (car V1418)))))) (cons (kl:shen.ebr (car (cdr V1418)) (car (cdr (car V1418))) (car (cdr (cdr (car V1418))))) (quote ())))) (quote ())))))) (let ((Application (cons (cons Abstraction (cons (cons (quote fst) (cdr V1418)) (quote ()))) (cons (cons (quote snd) (cdr V1418)) (quote ()))))) (kl:shen.reduce_help Application))))) ((and (pair? V1418) (and (pair? (car V1418)) (and (eq? (quote /.) (car (car V1418))) (and (pair? (cdr (car V1418))) (and (pair? (car (cdr (car V1418)))) (and (eq? (quote _scheme_at_v) (car (car (cdr (car V1418))))) (and (pair? (cdr (car (cdr (car V1418))))) (and (pair? (cdr (cdr (car (cdr (car V1418)))))) (and (null? (cdr (cdr (cdr (car (cdr (car V1418))))))) (and (pair? (cdr (cdr (car V1418)))) (and (null? (cdr (cdr (cdr (car V1418))))) (and (pair? (cdr V1418)) (null? (cdr (cdr V1418))))))))))))))) (begin (kl:shen.add_test (cons (quote shen.+vector?) (cdr V1418))) (let ((Abstraction (cons (quote /.) (cons (car (cdr (car (cdr (car V1418))))) (cons (cons (quote /.) (cons (car (cdr (cdr (car (cdr (car V1418)))))) (cons (kl:shen.ebr (car (cdr V1418)) (car (cdr (car V1418))) (car (cdr (cdr (car V1418))))) (quote ())))) (quote ())))))) (let ((Application (cons (cons Abstraction (cons (cons (quote hdv) (cdr V1418)) (quote ()))) (cons (cons (quote tlv) (cdr V1418)) (quote ()))))) (kl:shen.reduce_help Application))))) ((and (pair? V1418) (and (pair? (car V1418)) (and (eq? (quote /.) (car (car V1418))) (and (pair? (cdr (car V1418))) (and (pair? (car (cdr (car V1418)))) (and (eq? (quote _scheme_at_s) (car (car (cdr (car V1418))))) (and (pair? (cdr (car (cdr (car V1418))))) (and (pair? (cdr (cdr (car (cdr (car V1418)))))) (and (null? (cdr (cdr (cdr (car (cdr (car V1418))))))) (and (pair? (cdr (cdr (car V1418)))) (and (null? (cdr (cdr (cdr (car V1418))))) (and (pair? (cdr V1418)) (null? (cdr (cdr V1418))))))))))))))) (begin (kl:shen.add_test (cons (quote shen.+string?) (cdr V1418))) (let ((Abstraction (cons (quote /.) (cons (car (cdr (car (cdr (car V1418))))) (cons (cons (quote /.) (cons (car (cdr (cdr (car (cdr (car V1418)))))) (cons (kl:shen.ebr (car (cdr V1418)) (car (cdr (car V1418))) (car (cdr (cdr (car V1418))))) (quote ())))) (quote ())))))) (let ((Application (cons (cons Abstraction (cons (cons (quote pos) (cons (car (cdr V1418)) (cons 0 (quote ())))) (quote ()))) (cons (cons (quote tlstr) (cdr V1418)) (quote ()))))) (kl:shen.reduce_help Application))))) ((and (pair? V1418) (and (pair? (car V1418)) (and (eq? (quote /.) (car (car V1418))) (and (pair? (cdr (car V1418))) (and (pair? (cdr (cdr (car V1418)))) (and (null? (cdr (cdr (cdr (car V1418))))) (and (pair? (cdr V1418)) (and (null? (cdr (cdr V1418))) (kl:not (kl:variable? (car (cdr (car V1418))))))))))))) (begin (kl:shen.add_test (cons (quote =) (cons (car (cdr (car V1418))) (cdr V1418)))) (kl:shen.reduce_help (car (cdr (cdr (car V1418))))))) ((and (pair? V1418) (and (pair? (car V1418)) (and (eq? (quote /.) (car (car V1418))) (and (pair? (cdr (car V1418))) (and (pair? (cdr (cdr (car V1418)))) (and (null? (cdr (cdr (cdr (car V1418))))) (and (pair? (cdr V1418)) (null? (cdr (cdr V1418)))))))))) (kl:shen.reduce_help (kl:shen.ebr (car (cdr V1418)) (car (cdr (car V1418))) (car (cdr (cdr (car V1418))))))) ((and (pair? V1418) (and (eq? (quote where) (car V1418)) (and (pair? (cdr V1418)) (and (pair? (cdr (cdr V1418))) (null? (cdr (cdr (cdr V1418)))))))) (begin (kl:shen.add_test (car (cdr V1418))) (kl:shen.reduce_help (car (cdr (cdr V1418)))))) ((and (pair? V1418) (and (pair? (cdr V1418)) (null? (cdr (cdr V1418))))) (let ((Z (kl:shen.reduce_help (car V1418)))) (if (kl:= (car V1418) Z) V1418 (kl:shen.reduce_help (cons Z (cdr V1418)))))) (#t V1418))) (quote shen.reduce_help))
(begin (register-function-arity (quote shen.+string?) 1) (define (kl:shen.+string? V1420) (cond ((equal? "" V1420) #f) (#t (string? V1420)))) (quote shen.+string?))
(begin (register-function-arity (quote shen.+vector?) 1) (define (kl:shen.+vector? V1422) (and (vector? V1422) (> (vector-ref V1422 0) 0))) (quote shen.+vector?))
(begin (register-function-arity (quote shen.ebr) 3) (define (kl:shen.ebr V1436 V1437 V1438) (cond ((kl:= V1438 V1437) V1436) ((and (pair? V1438) (and (eq? (quote /.) (car V1438)) (and (pair? (cdr V1438)) (and (pair? (cdr (cdr V1438))) (and (null? (cdr (cdr (cdr V1438)))) (> (kl:occurrences V1437 (car (cdr V1438))) 0)))))) V1438) ((and (pair? V1438) (and (eq? (quote lambda) (car V1438)) (and (pair? (cdr V1438)) (and (pair? (cdr (cdr V1438))) (and (null? (cdr (cdr (cdr V1438)))) (> (kl:occurrences V1437 (car (cdr V1438))) 0)))))) V1438) ((and (pair? V1438) (and (eq? (quote let) (car V1438)) (and (pair? (cdr V1438)) (and (pair? (cdr (cdr V1438))) (and (pair? (cdr (cdr (cdr V1438)))) (and (null? (cdr (cdr (cdr (cdr V1438))))) (kl:= (car (cdr V1438)) V1437))))))) (cons (quote let) (cons (car (cdr V1438)) (cons (kl:shen.ebr V1436 (car (cdr V1438)) (car (cdr (cdr V1438)))) (cdr (cdr (cdr V1438))))))) ((pair? V1438) (cons (kl:shen.ebr V1436 V1437 (car V1438)) (kl:shen.ebr V1436 V1437 (cdr V1438)))) (#t V1438))) (quote shen.ebr))
(begin (register-function-arity (quote shen.add_test) 1) (define (kl:shen.add_test V1440) (kl:set (quote shen.*teststack*) (cons V1440 (kl:value (quote shen.*teststack*))))) (quote shen.add_test))
(begin (register-function-arity (quote shen.cond-expression) 3) (define (kl:shen.cond-expression V1444 V1445 V1446) (let ((Err (kl:shen.err-condition V1444))) (let ((Cases (kl:shen.case-form V1446 Err))) (let ((EncodeChoices (kl:shen.encode-choices Cases V1444))) (kl:shen.cond-form EncodeChoices))))) (quote shen.cond-expression))
(begin (register-function-arity (quote shen.cond-form) 1) (define (kl:shen.cond-form V1450) (cond ((and (pair? V1450) (and (pair? (car V1450)) (and (kl:= #t (car (car V1450))) (and (pair? (cdr (car V1450))) (null? (cdr (cdr (car V1450)))))))) (car (cdr (car V1450)))) (#t (cons (quote cond) V1450)))) (quote shen.cond-form))
(begin (register-function-arity (quote shen.encode-choices) 2) (define (kl:shen.encode-choices V1455 V1456) (cond ((null? V1455) (quote ())) ((and (pair? V1455) (and (pair? (car V1455)) (and (kl:= #t (car (car V1455))) (and (pair? (cdr (car V1455))) (and (pair? (car (cdr (car V1455)))) (and (eq? (quote shen.choicepoint!) (car (car (cdr (car V1455))))) (and (pair? (cdr (car (cdr (car V1455))))) (and (null? (cdr (cdr (car (cdr (car V1455)))))) (and (null? (cdr (cdr (car V1455)))) (null? (cdr V1455))))))))))) (cons (cons #t (cons (cons (quote let) (cons (quote Result) (cons (car (cdr (car (cdr (car V1455))))) (cons (cons (quote if) (cons (cons (quote =) (cons (quote Result) (cons (cons (quote fail) (quote ())) (quote ())))) (cons (if (assert-boolean (kl:value (quote shen.*installing-kl*))) (cons (quote shen.sys-error) (cons V1456 (quote ()))) (cons (quote shen.f_error) (cons V1456 (quote ())))) (cons (quote Result) (quote ()))))) (quote ()))))) (quote ()))) (quote ()))) ((and (pair? V1455) (and (pair? (car V1455)) (and (kl:= #t (car (car V1455))) (and (pair? (cdr (car V1455))) (and (pair? (car (cdr (car V1455)))) (and (eq? (quote shen.choicepoint!) (car (car (cdr (car V1455))))) (and (pair? (cdr (car (cdr (car V1455))))) (and (null? (cdr (cdr (car (cdr (car V1455)))))) (null? (cdr (cdr (car V1455)))))))))))) (cons (cons #t (cons (cons (quote let) (cons (quote Result) (cons (car (cdr (car (cdr (car V1455))))) (cons (cons (quote if) (cons (cons (quote =) (cons (quote Result) (cons (cons (quote fail) (quote ())) (quote ())))) (cons (kl:shen.cond-form (kl:shen.encode-choices (cdr V1455) V1456)) (cons (quote Result) (quote ()))))) (quote ()))))) (quote ()))) (quote ()))) ((and (pair? V1455) (and (pair? (car V1455)) (and (pair? (cdr (car V1455))) (and (pair? (car (cdr (car V1455)))) (and (eq? (quote shen.choicepoint!) (car (car (cdr (car V1455))))) (and (pair? (cdr (car (cdr (car V1455))))) (and (null? (cdr (cdr (car (cdr (car V1455)))))) (null? (cdr (cdr (car V1455))))))))))) (cons (cons #t (cons (cons (quote let) (cons (quote Freeze) (cons (cons (quote freeze) (cons (kl:shen.cond-form (kl:shen.encode-choices (cdr V1455) V1456)) (quote ()))) (cons (cons (quote if) (cons (car (car V1455)) (cons (cons (quote let) (cons (quote Result) (cons (car (cdr (car (cdr (car V1455))))) (cons (cons (quote if) (cons (cons (quote =) (cons (quote Result) (cons (cons (quote fail) (quote ())) (quote ())))) (cons (cons (quote thaw) (cons (quote Freeze) (quote ()))) (cons (quote Result) (quote ()))))) (quote ()))))) (cons (cons (quote thaw) (cons (quote Freeze) (quote ()))) (quote ()))))) (quote ()))))) (quote ()))) (quote ()))) ((and (pair? V1455) (and (pair? (car V1455)) (and (pair? (cdr (car V1455))) (null? (cdr (cdr (car V1455))))))) (cons (car V1455) (kl:shen.encode-choices (cdr V1455) V1456))) (#t (kl:shen.f_error (quote shen.encode-choices))))) (quote shen.encode-choices))
(begin (register-function-arity (quote shen.case-form) 2) (define (kl:shen.case-form V1463 V1464) (cond ((null? V1463) (cons V1464 (quote ()))) ((and (pair? V1463) (and (pair? (car V1463)) (and (pair? (car (car V1463))) (and (eq? (quote :) (car (car (car V1463)))) (and (pair? (cdr (car (car V1463)))) (and (eq? (quote shen.tests) (car (cdr (car (car V1463))))) (and (null? (cdr (cdr (car (car V1463))))) (and (pair? (cdr (car V1463))) (and (pair? (car (cdr (car V1463)))) (and (eq? (quote shen.choicepoint!) (car (car (cdr (car V1463))))) (and (pair? (cdr (car (cdr (car V1463))))) (and (null? (cdr (cdr (car (cdr (car V1463)))))) (null? (cdr (cdr (car V1463)))))))))))))))) (cons (cons #t (cdr (car V1463))) (kl:shen.case-form (cdr V1463) V1464))) ((and (pair? V1463) (and (pair? (car V1463)) (and (pair? (car (car V1463))) (and (eq? (quote :) (car (car (car V1463)))) (and (pair? (cdr (car (car V1463)))) (and (eq? (quote shen.tests) (car (cdr (car (car V1463))))) (and (null? (cdr (cdr (car (car V1463))))) (and (pair? (cdr (car V1463))) (null? (cdr (cdr (car V1463)))))))))))) (cons (cons #t (cdr (car V1463))) (quote ()))) ((and (pair? V1463) (and (pair? (car V1463)) (and (pair? (car (car V1463))) (and (eq? (quote :) (car (car (car V1463)))) (and (pair? (cdr (car (car V1463)))) (and (eq? (quote shen.tests) (car (cdr (car (car V1463))))) (and (pair? (cdr (car V1463))) (null? (cdr (cdr (car V1463))))))))))) (cons (cons (kl:shen.embed-and (cdr (cdr (car (car V1463))))) (cdr (car V1463))) (kl:shen.case-form (cdr V1463) V1464))) (#t (kl:shen.f_error (quote shen.case-form))))) (quote shen.case-form))
(begin (register-function-arity (quote shen.embed-and) 1) (define (kl:shen.embed-and V1466) (cond ((and (pair? V1466) (null? (cdr V1466))) (car V1466)) ((pair? V1466) (cons (quote and) (cons (car V1466) (cons (kl:shen.embed-and (cdr V1466)) (quote ()))))) (#t (kl:shen.f_error (quote shen.embed-and))))) (quote shen.embed-and))
(begin (register-function-arity (quote shen.err-condition) 1) (define (kl:shen.err-condition V1468) (cons #t (cons (cons (quote shen.f_error) (cons V1468 (quote ()))) (quote ())))) (quote shen.err-condition))
(begin (register-function-arity (quote shen.sys-error) 1) (define (kl:shen.sys-error V1470) (simple-error (string-append "system function " (kl:shen.app V1470 ": unexpected argument\n" (quote shen.a))))) (quote shen.sys-error))