"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.yacc) 1) (define (kl:shen.yacc V4159) (cond ((and (pair? V4159) (and (eq? (quote defcc) (car V4159)) (pair? (cdr V4159)))) (kl:shen.yacc->shen (car (cdr V4159)) (cdr (cdr V4159)))) (#t (kl:shen.f_error (quote shen.yacc))))) (quote shen.yacc))
(begin (register-function-arity (quote shen.yacc->shen) 2) (define (kl:shen.yacc->shen V4162 V4163) (let ((CCRules (kl:shen.split_cc_rules #t V4163 (quote ())))) (let ((CCBody (kl:map (lambda (X) (kl:shen.cc_body X)) CCRules))) (let ((YaccCases (kl:shen.yacc_cases CCBody))) (cons (quote define) (cons V4162 (cons (quote Stream) (cons (quote ->) (cons (kl:shen.kill-code YaccCases) (quote ())))))))))) (quote shen.yacc->shen))
(begin (register-function-arity (quote shen.kill-code) 1) (define (kl:shen.kill-code V4165) (cond ((> (kl:occurrences (quote kill) V4165) 0) (cons (quote trap-error) (cons V4165 (cons (cons (quote lambda) (cons (quote E) (cons (cons (quote shen.analyse-kill) (cons (quote E) (quote ()))) (quote ())))) (quote ()))))) (#t V4165))) (quote shen.kill-code))
(begin (register-function-arity (quote kill) 0) (define (kl:kill) (simple-error "yacc kill")) (quote kill))
(begin (register-function-arity (quote shen.analyse-kill) 1) (define (kl:shen.analyse-kill V4167) (let ((String (kl:error-to-string V4167))) (if (equal? String "yacc kill") (quote shen.fail!) V4167))) (quote shen.analyse-kill))
(begin (register-function-arity (quote shen.split_cc_rules) 3) (define (kl:shen.split_cc_rules V4173 V4174 V4175) (cond ((and (null? V4174) (null? V4175)) (quote ())) ((null? V4174) (cons (kl:shen.split_cc_rule V4173 (kl:reverse V4175) (quote ())) (quote ()))) ((and (pair? V4174) (eq? (quote _scheme_sc_) (car V4174))) (cons (kl:shen.split_cc_rule V4173 (kl:reverse V4175) (quote ())) (kl:shen.split_cc_rules V4173 (cdr V4174) (quote ())))) ((pair? V4174) (kl:shen.split_cc_rules V4173 (cdr V4174) (cons (car V4174) V4175))) (#t (kl:shen.f_error (quote shen.split_cc_rules))))) (quote shen.split_cc_rules))
(begin (register-function-arity (quote shen.split_cc_rule) 3) (define (kl:shen.split_cc_rule V4183 V4184 V4185) (cond ((and (pair? V4184) (and (eq? (quote :=) (car V4184)) (and (pair? (cdr V4184)) (null? (cdr (cdr V4184)))))) (cons (kl:reverse V4185) (cdr V4184))) ((and (pair? V4184) (and (eq? (quote :=) (car V4184)) (and (pair? (cdr V4184)) (and (pair? (cdr (cdr V4184))) (and (eq? (quote where) (car (cdr (cdr V4184)))) (and (pair? (cdr (cdr (cdr V4184)))) (null? (cdr (cdr (cdr (cdr V4184))))))))))) (cons (kl:reverse V4185) (cons (cons (quote where) (cons (car (cdr (cdr (cdr V4184)))) (cons (car (cdr V4184)) (quote ())))) (quote ())))) ((null? V4184) (begin (kl:shen.semantic-completion-warning V4183 V4185) (kl:shen.split_cc_rule V4183 (cons (quote :=) (cons (kl:shen.default_semantics (kl:reverse V4185)) (quote ()))) V4185))) ((pair? V4184) (kl:shen.split_cc_rule V4183 (cdr V4184) (cons (car V4184) V4185))) (#t (kl:shen.f_error (quote shen.split_cc_rule))))) (quote shen.split_cc_rule))
(begin (register-function-arity (quote shen.semantic-completion-warning) 2) (define (kl:shen.semantic-completion-warning V4196 V4197) (cond ((kl:= #t V4196) (begin (kl:shen.prhush "warning: " (kl:stoutput)) (begin (kl:shen.for-each (lambda (X) (kl:shen.prhush (kl:shen.app X " " (quote shen.a)) (kl:stoutput))) (kl:reverse V4197)) (kl:shen.prhush "has no semantics.\n" (kl:stoutput))))) (#t (quote shen.skip)))) (quote shen.semantic-completion-warning))
(begin (register-function-arity (quote shen.default_semantics) 1) (define (kl:shen.default_semantics V4199) (cond ((null? V4199) (quote ())) ((and (pair? V4199) (and (null? (cdr V4199)) (assert-boolean (kl:shen.grammar_symbol? (car V4199))))) (car V4199)) ((and (pair? V4199) (assert-boolean (kl:shen.grammar_symbol? (car V4199)))) (cons (quote append) (cons (car V4199) (cons (kl:shen.default_semantics (cdr V4199)) (quote ()))))) ((pair? V4199) (cons (quote cons) (cons (car V4199) (cons (kl:shen.default_semantics (cdr V4199)) (quote ()))))) (#t (kl:shen.f_error (quote shen.default_semantics))))) (quote shen.default_semantics))
(begin (register-function-arity (quote shen.grammar_symbol?) 1) (define (kl:shen.grammar_symbol? V4201) (and (assert-boolean (symbol? V4201)) (assert-boolean (let ((Cs (kl:shen.strip-pathname (kl:explode V4201)))) (and (equal? (car Cs) "<") (equal? (car (kl:reverse Cs)) ">")))))) (quote shen.grammar_symbol?))
(begin (register-function-arity (quote shen.yacc_cases) 1) (define (kl:shen.yacc_cases V4203) (cond ((and (pair? V4203) (null? (cdr V4203))) (car V4203)) ((pair? V4203) (let ((P (quote YaccParse))) (cons (quote let) (cons P (cons (car V4203) (cons (cons (quote if) (cons (cons (quote =) (cons P (cons (cons (quote fail) (quote ())) (quote ())))) (cons (kl:shen.yacc_cases (cdr V4203)) (cons P (quote ()))))) (quote ()))))))) (#t (kl:shen.f_error (quote shen.yacc_cases))))) (quote shen.yacc_cases))
(begin (register-function-arity (quote shen.cc_body) 1) (define (kl:shen.cc_body V4205) (cond ((and (pair? V4205) (and (pair? (cdr V4205)) (null? (cdr (cdr V4205))))) (kl:shen.syntax (car V4205) (quote Stream) (car (cdr V4205)))) (#t (kl:shen.f_error (quote shen.cc_body))))) (quote shen.cc_body))
(begin (register-function-arity (quote shen.syntax) 3) (define (kl:shen.syntax V4209 V4210 V4211) (cond ((and (null? V4209) (and (pair? V4211) (and (eq? (quote where) (car V4211)) (and (pair? (cdr V4211)) (and (pair? (cdr (cdr V4211))) (null? (cdr (cdr (cdr V4211))))))))) (cons (quote if) (cons (kl:shen.semantics (car (cdr V4211))) (cons (cons (quote shen.pair) (cons (cons (quote hd) (cons V4210 (quote ()))) (cons (kl:shen.semantics (car (cdr (cdr V4211)))) (quote ())))) (cons (cons (quote fail) (quote ())) (quote ())))))) ((null? V4209) (cons (quote shen.pair) (cons (cons (quote hd) (cons V4210 (quote ()))) (cons (kl:shen.semantics V4211) (quote ()))))) ((pair? V4209) (if (assert-boolean (kl:shen.grammar_symbol? (car V4209))) (kl:shen.recursive_descent V4209 V4210 V4211) (if (kl:variable? (car V4209)) (kl:shen.variable-match V4209 V4210 V4211) (if (assert-boolean (kl:shen.jump_stream? (car V4209))) (kl:shen.jump_stream V4209 V4210 V4211) (if (assert-boolean (kl:shen.terminal? (car V4209))) (kl:shen.check_stream V4209 V4210 V4211) (if (pair? (car V4209)) (kl:shen.list-stream (kl:shen.decons (car V4209)) (cdr V4209) V4210 V4211) (simple-error (kl:shen.app (car V4209) " is not legal syntax\n" (quote shen.a))))))))) (#t (kl:shen.f_error (quote shen.syntax))))) (quote shen.syntax))
(begin (register-function-arity (quote shen.list-stream) 4) (define (kl:shen.list-stream V4216 V4217 V4218 V4219) (let ((Test (cons (quote and) (cons (cons (quote cons?) (cons (cons (quote hd) (cons V4218 (quote ()))) (quote ()))) (cons (cons (quote cons?) (cons (cons (quote shen.hdhd) (cons V4218 (quote ()))) (quote ()))) (quote ())))))) (let ((Placeholder (kl:gensym (quote shen.place)))) (let ((RunOn (kl:shen.syntax V4217 (cons (quote shen.pair) (cons (cons (quote shen.tlhd) (cons V4218 (quote ()))) (cons (cons (quote shen.hdtl) (cons V4218 (quote ()))) (quote ())))) V4219))) (let ((Action (kl:shen.insert-runon RunOn Placeholder (kl:shen.syntax V4216 (cons (quote shen.pair) (cons (cons (quote shen.hdhd) (cons V4218 (quote ()))) (cons (cons (quote shen.hdtl) (cons V4218 (quote ()))) (quote ())))) Placeholder)))) (cons (quote if) (cons Test (cons Action (cons (cons (quote fail) (quote ())) (quote ())))))))))) (quote shen.list-stream))
(begin (register-function-arity (quote shen.decons) 1) (define (kl:shen.decons V4221) (cond ((and (pair? V4221) (and (eq? (quote cons) (car V4221)) (and (pair? (cdr V4221)) (and (pair? (cdr (cdr V4221))) (and (null? (car (cdr (cdr V4221)))) (null? (cdr (cdr (cdr V4221))))))))) (cons (car (cdr V4221)) (quote ()))) ((and (pair? V4221) (and (eq? (quote cons) (car V4221)) (and (pair? (cdr V4221)) (and (pair? (cdr (cdr V4221))) (null? (cdr (cdr (cdr V4221)))))))) (cons (car (cdr V4221)) (kl:shen.decons (car (cdr (cdr V4221)))))) (#t V4221))) (quote shen.decons))
(begin (register-function-arity (quote shen.insert-runon) 3) (define (kl:shen.insert-runon V4236 V4237 V4238) (cond ((and (pair? V4238) (and (eq? (quote shen.pair) (car V4238)) (and (pair? (cdr V4238)) (and (pair? (cdr (cdr V4238))) (and (null? (cdr (cdr (cdr V4238)))) (kl:= (car (cdr (cdr V4238))) V4237)))))) V4236) ((pair? V4238) (kl:map (lambda (Z) (kl:shen.insert-runon V4236 V4237 Z)) V4238)) (#t V4238))) (quote shen.insert-runon))
(begin (register-function-arity (quote shen.strip-pathname) 1) (define (kl:shen.strip-pathname V4244) (cond ((kl:not (kl:element? "." V4244)) V4244) ((pair? V4244) (kl:shen.strip-pathname (cdr V4244))) (#t (kl:shen.f_error (quote shen.strip-pathname))))) (quote shen.strip-pathname))
(begin (register-function-arity (quote shen.recursive_descent) 3) (define (kl:shen.recursive_descent V4248 V4249 V4250) (cond ((pair? V4248) (let ((Test (cons (car V4248) (cons V4249 (quote ()))))) (let ((Action (kl:shen.syntax (cdr V4248) (kl:concat (quote Parse_) (car V4248)) V4250))) (let ((Else (cons (quote fail) (quote ())))) (cons (quote let) (cons (kl:concat (quote Parse_) (car V4248)) (cons Test (cons (cons (quote if) (cons (cons (quote not) (cons (cons (quote =) (cons (cons (quote fail) (quote ())) (cons (kl:concat (quote Parse_) (car V4248)) (quote ())))) (quote ()))) (cons Action (cons Else (quote ()))))) (quote ()))))))))) (#t (kl:shen.f_error (quote shen.recursive_descent))))) (quote shen.recursive_descent))
(begin (register-function-arity (quote shen.variable-match) 3) (define (kl:shen.variable-match V4254 V4255 V4256) (cond ((pair? V4254) (let ((Test (cons (quote cons?) (cons (cons (quote hd) (cons V4255 (quote ()))) (quote ()))))) (let ((Action (cons (quote let) (cons (kl:concat (quote Parse_) (car V4254)) (cons (cons (quote shen.hdhd) (cons V4255 (quote ()))) (cons (kl:shen.syntax (cdr V4254) (cons (quote shen.pair) (cons (cons (quote shen.tlhd) (cons V4255 (quote ()))) (cons (cons (quote shen.hdtl) (cons V4255 (quote ()))) (quote ())))) V4256) (quote ()))))))) (let ((Else (cons (quote fail) (quote ())))) (cons (quote if) (cons Test (cons Action (cons Else (quote ()))))))))) (#t (kl:shen.f_error (quote shen.variable-match))))) (quote shen.variable-match))
(begin (register-function-arity (quote shen.terminal?) 1) (define (kl:shen.terminal? V4266) (cond ((pair? V4266) #f) ((kl:variable? V4266) #f) (#t #t))) (quote shen.terminal?))
(begin (register-function-arity (quote shen.jump_stream?) 1) (define (kl:shen.jump_stream? V4272) (cond ((eq? V4272 (quote _)) #t) (#t #f))) (quote shen.jump_stream?))
(begin (register-function-arity (quote shen.check_stream) 3) (define (kl:shen.check_stream V4276 V4277 V4278) (cond ((pair? V4276) (let ((Test (cons (quote and) (cons (cons (quote cons?) (cons (cons (quote hd) (cons V4277 (quote ()))) (quote ()))) (cons (cons (quote =) (cons (car V4276) (cons (cons (quote shen.hdhd) (cons V4277 (quote ()))) (quote ())))) (quote ())))))) (let ((NewStr (kl:gensym (quote NewStream)))) (let ((Action (cons (quote let) (cons NewStr (cons (cons (quote shen.pair) (cons (cons (quote shen.tlhd) (cons V4277 (quote ()))) (cons (cons (quote shen.hdtl) (cons V4277 (quote ()))) (quote ())))) (cons (kl:shen.syntax (cdr V4276) NewStr V4278) (quote ()))))))) (let ((Else (cons (quote fail) (quote ())))) (cons (quote if) (cons Test (cons Action (cons Else (quote ())))))))))) (#t (kl:shen.f_error (quote shen.check_stream))))) (quote shen.check_stream))
(begin (register-function-arity (quote shen.jump_stream) 3) (define (kl:shen.jump_stream V4282 V4283 V4284) (cond ((pair? V4282) (let ((Test (cons (quote cons?) (cons (cons (quote hd) (cons V4283 (quote ()))) (quote ()))))) (let ((Action (kl:shen.syntax (cdr V4282) (cons (quote shen.pair) (cons (cons (quote shen.tlhd) (cons V4283 (quote ()))) (cons (cons (quote shen.hdtl) (cons V4283 (quote ()))) (quote ())))) V4284))) (let ((Else (cons (quote fail) (quote ())))) (cons (quote if) (cons Test (cons Action (cons Else (quote ()))))))))) (#t (kl:shen.f_error (quote shen.jump_stream))))) (quote shen.jump_stream))
(begin (register-function-arity (quote shen.semantics) 1) (define (kl:shen.semantics V4286) (cond ((null? V4286) (quote ())) ((assert-boolean (kl:shen.grammar_symbol? V4286)) (cons (quote shen.hdtl) (cons (kl:concat (quote Parse_) V4286) (quote ())))) ((kl:variable? V4286) (kl:concat (quote Parse_) V4286)) ((pair? V4286) (kl:map (lambda (Z) (kl:shen.semantics Z)) V4286)) (#t V4286))) (quote shen.semantics))
(begin (register-function-arity (quote shen.pair) 2) (define (kl:shen.pair V4289 V4290) (cons V4289 (cons V4290 (quote ())))) (quote shen.pair))
(begin (register-function-arity (quote shen.hdtl) 1) (define (kl:shen.hdtl V4292) (car (cdr V4292))) (quote shen.hdtl))
(begin (register-function-arity (quote shen.hdhd) 1) (define (kl:shen.hdhd V4294) (car (car V4294))) (quote shen.hdhd))
(begin (register-function-arity (quote shen.tlhd) 1) (define (kl:shen.tlhd V4296) (cdr (car V4296))) (quote shen.tlhd))
(begin (register-function-arity (quote shen.snd-or-fail) 1) (define (kl:shen.snd-or-fail V4304) (cond ((and (pair? V4304) (and (pair? (cdr V4304)) (null? (cdr (cdr V4304))))) (car (cdr V4304))) (#t (quote shen.fail!)))) (quote shen.snd-or-fail))
(begin (register-function-arity (quote fail) 0) (define (kl:fail) (quote shen.fail!)) (quote fail))
(begin (register-function-arity (quote <!>) 1) (define (kl:<!> V4312) (cond ((and (pair? V4312) (and (pair? (cdr V4312)) (null? (cdr (cdr V4312))))) (cons (quote ()) (cons (car V4312) (quote ())))) (#t (quote shen.fail!)))) (quote <!>))
(begin (register-function-arity (quote <e>) 1) (define (kl:<e> V4318) (cond ((and (pair? V4318) (and (pair? (cdr V4318)) (null? (cdr (cdr V4318))))) (cons (car V4318) (cons (quote ()) (quote ())))) (#t (kl:shen.f_error (quote <e>))))) (quote <e>))