"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) 0) (define (kl:shen.shen) (begin (kl:shen.credits) (kl:shen.loop))) (quote shen.shen))
(begin (register-function-arity (quote shen.loop) 0) (define (kl:shen.loop) (begin (kl:shen.initialise_environment) (begin (kl:shen.prompt) (begin (guard (lambda (E) (kl:shen.toplevel-display-exception E)) (lambda () (kl:shen.read-evaluate-print))) (kl:shen.loop))))) (quote shen.loop))
(begin (register-function-arity (quote shen.toplevel-display-exception) 1) (define (kl:shen.toplevel-display-exception V3819) (kl:pr (kl:error-to-string V3819) (kl:stoutput))) (quote shen.toplevel-display-exception))
(begin (register-function-arity (quote shen.credits) 0) (define (kl:shen.credits) (begin (kl:shen.prhush "\nShen, copyright (C) 2010-2015 Mark Tarver\n" (kl:stoutput)) (begin (kl:shen.prhush (string-append "www.shenlanguage.org, " (kl:shen.app (kl:value (quote *version*)) "\n" (quote shen.a))) (kl:stoutput)) (begin (kl:shen.prhush (string-append "running under " (kl:shen.app (kl:value (quote *language*)) (string-append ", implementation: " (kl:shen.app (kl:value (quote *implementation*)) "" (quote shen.a))) (quote shen.a))) (kl:stoutput)) (kl:shen.prhush (string-append "\nport " (kl:shen.app (kl:value (quote *port*)) (string-append " ported by " (kl:shen.app (kl:value (quote *porters*)) "\n" (quote shen.a))) (quote shen.a))) (kl:stoutput)))))) (quote shen.credits))
(begin (register-function-arity (quote shen.initialise_environment) 0) (define (kl:shen.initialise_environment) (kl:shen.multiple-set (cons (quote shen.*call*) (cons 0 (cons (quote shen.*infs*) (cons 0 (cons (quote shen.*process-counter*) (cons 0 (cons (quote shen.*catch*) (cons 0 (quote ()))))))))))) (quote shen.initialise_environment))
(begin (register-function-arity (quote shen.multiple-set) 1) (define (kl:shen.multiple-set V3821) (cond ((null? V3821) (quote ())) ((and (pair? V3821) (pair? (cdr V3821))) (begin (kl:set (car V3821) (car (cdr V3821))) (kl:shen.multiple-set (cdr (cdr V3821))))) (#t (kl:shen.f_error (quote shen.multiple-set))))) (quote shen.multiple-set))
(begin (register-function-arity (quote destroy) 1) (define (kl:destroy V3823) (kl:declare V3823 (quote symbol))) (quote destroy))
(kl:set (quote shen.*history*) (quote ()))
(begin (register-function-arity (quote shen.read-evaluate-print) 0) (define (kl:shen.read-evaluate-print) (let ((Lineread (kl:shen.toplineread))) (let ((History (kl:value (quote shen.*history*)))) (let ((NewLineread (kl:shen.retrieve-from-history-if-needed Lineread History))) (let ((NewHistory (kl:shen.update_history NewLineread History))) (let ((Parsed (kl:fst NewLineread))) (kl:shen.toplevel Parsed))))))) (quote shen.read-evaluate-print))
(begin (register-function-arity (quote shen.retrieve-from-history-if-needed) 2) (define (kl:shen.retrieve-from-history-if-needed V3835 V3836) (cond ((and (kl:tuple? V3835) (and (pair? (kl:snd V3835)) (kl:element? (car (kl:snd V3835)) (cons (kl:shen.space) (cons (kl:shen.newline) (quote ())))))) (kl:shen.retrieve-from-history-if-needed (kl:_scheme_at_p (kl:fst V3835) (cdr (kl:snd V3835))) V3836)) ((and (kl:tuple? V3835) (and (pair? (kl:snd V3835)) (and (pair? (cdr (kl:snd V3835))) (and (null? (cdr (cdr (kl:snd V3835)))) (and (pair? V3836) (and (kl:= (car (kl:snd V3835)) (kl:shen.exclamation)) (kl:= (car (cdr (kl:snd V3835))) (kl:shen.exclamation)))))))) (let ((PastPrint (kl:shen.prbytes (kl:snd (car V3836))))) (car V3836))) ((and (kl:tuple? V3835) (and (pair? (kl:snd V3835)) (kl:= (car (kl:snd V3835)) (kl:shen.exclamation)))) (let ((Key? (kl:shen.make-key (cdr (kl:snd V3835)) V3836))) (let ((Find (kl:head (kl:shen.find-past-inputs Key? V3836)))) (let ((PastPrint (kl:shen.prbytes (kl:snd Find)))) Find)))) ((and (kl:tuple? V3835) (and (pair? (kl:snd V3835)) (and (null? (cdr (kl:snd V3835))) (kl:= (car (kl:snd V3835)) (kl:shen.percent))))) (begin (kl:shen.print-past-inputs (lambda (X) #t) (kl:reverse V3836) 0) (kl:abort))) ((and (kl:tuple? V3835) (and (pair? (kl:snd V3835)) (kl:= (car (kl:snd V3835)) (kl:shen.percent)))) (let ((Key? (kl:shen.make-key (cdr (kl:snd V3835)) V3836))) (let ((Pastprint (kl:shen.print-past-inputs Key? (kl:reverse V3836) 0))) (kl:abort)))) (#t V3835))) (quote shen.retrieve-from-history-if-needed))
(begin (register-function-arity (quote shen.percent) 0) (define (kl:shen.percent) 37) (quote shen.percent))
(begin (register-function-arity (quote shen.exclamation) 0) (define (kl:shen.exclamation) 33) (quote shen.exclamation))
(begin (register-function-arity (quote shen.prbytes) 1) (define (kl:shen.prbytes V3838) (begin (kl:shen.for-each (lambda (Byte) (kl:pr (kl:n->string Byte) (kl:stoutput))) V3838) (kl:nl 1))) (quote shen.prbytes))
(begin (register-function-arity (quote shen.update_history) 2) (define (kl:shen.update_history V3841 V3842) (kl:set (quote shen.*history*) (cons V3841 V3842))) (quote shen.update_history))
(begin (register-function-arity (quote shen.toplineread) 0) (define (kl:shen.toplineread) (kl:shen.toplineread_loop (kl:shen.read-char-code (kl:stinput)) (quote ()))) (quote shen.toplineread))
(begin (register-function-arity (quote shen.toplineread_loop) 2) (define (kl:shen.toplineread_loop V3846 V3847) (cond ((kl:= V3846 (kl:shen.hat)) (simple-error "line read aborted")) ((kl:element? V3846 (cons (kl:shen.newline) (cons (kl:shen.carriage-return) (quote ())))) (let ((Line (kl:compile (lambda (X) (kl:shen.<st_input> X)) V3847 (lambda (E) (quote shen.nextline))))) (let ((It (kl:shen.record-it V3847))) (if (or (eq? Line (quote shen.nextline)) (kl:empty? Line)) (kl:shen.toplineread_loop (kl:shen.read-char-code (kl:stinput)) (kl:append V3847 (cons V3846 (quote ())))) (kl:_scheme_at_p Line V3847))))) (#t (kl:shen.toplineread_loop (kl:shen.read-char-code (kl:stinput)) (if (kl:= V3846 -1) V3847 (kl:append V3847 (cons V3846 (quote ())))))))) (quote shen.toplineread_loop))
(begin (register-function-arity (quote shen.hat) 0) (define (kl:shen.hat) 94) (quote shen.hat))
(begin (register-function-arity (quote shen.newline) 0) (define (kl:shen.newline) 10) (quote shen.newline))
(begin (register-function-arity (quote shen.carriage-return) 0) (define (kl:shen.carriage-return) 13) (quote shen.carriage-return))
(begin (register-function-arity (quote tc) 1) (define (kl:tc V3853) (cond ((eq? (quote +) V3853) (kl:set (quote shen.*tc*) #t)) ((eq? (quote -) V3853) (kl:set (quote shen.*tc*) #f)) (#t (simple-error "tc expects a + or -")))) (quote tc))
(begin (register-function-arity (quote shen.prompt) 0) (define (kl:shen.prompt) (if (assert-boolean (kl:value (quote shen.*tc*))) (kl:shen.prhush (string-append "\n\n(" (kl:shen.app (kl:length (kl:value (quote shen.*history*))) "+) " (quote shen.a))) (kl:stoutput)) (kl:shen.prhush (string-append "\n\n(" (kl:shen.app (kl:length (kl:value (quote shen.*history*))) "-) " (quote shen.a))) (kl:stoutput)))) (quote shen.prompt))
(begin (register-function-arity (quote shen.toplevel) 1) (define (kl:shen.toplevel V3855) (kl:shen.toplevel_evaluate V3855 (kl:value (quote shen.*tc*)))) (quote shen.toplevel))
(begin (register-function-arity (quote shen.find-past-inputs) 2) (define (kl:shen.find-past-inputs V3858 V3859) (let ((F (kl:shen.find V3858 V3859))) (if (kl:empty? F) (simple-error "input not found\n") F))) (quote shen.find-past-inputs))
(begin (register-function-arity (quote shen.make-key) 2) (define (kl:shen.make-key V3862 V3863) (let ((Atom (car (kl:compile (lambda (X) (kl:shen.<st_input> X)) V3862 (lambda (E) (if (pair? E) (simple-error (string-append "parse error here: " (kl:shen.app E "\n" (quote shen.s)))) (simple-error "parse error\n"))))))) (if (assert-boolean (kl:integer? Atom)) (lambda (X) (kl:= X (kl:nth (+ Atom 1) (kl:reverse V3863)))) (lambda (X) (kl:shen.prefix? V3862 (kl:shen.trim-gubbins (kl:snd X))))))) (quote shen.make-key))
(begin (register-function-arity (quote shen.trim-gubbins) 1) (define (kl:shen.trim-gubbins V3865) (cond ((and (pair? V3865) (kl:= (car V3865) (kl:shen.space))) (kl:shen.trim-gubbins (cdr V3865))) ((and (pair? V3865) (kl:= (car V3865) (kl:shen.newline))) (kl:shen.trim-gubbins (cdr V3865))) ((and (pair? V3865) (kl:= (car V3865) (kl:shen.carriage-return))) (kl:shen.trim-gubbins (cdr V3865))) ((and (pair? V3865) (kl:= (car V3865) (kl:shen.tab))) (kl:shen.trim-gubbins (cdr V3865))) ((and (pair? V3865) (kl:= (car V3865) (kl:shen.left-round))) (kl:shen.trim-gubbins (cdr V3865))) (#t V3865))) (quote shen.trim-gubbins))
(begin (register-function-arity (quote shen.space) 0) (define (kl:shen.space) 32) (quote shen.space))
(begin (register-function-arity (quote shen.tab) 0) (define (kl:shen.tab) 9) (quote shen.tab))
(begin (register-function-arity (quote shen.left-round) 0) (define (kl:shen.left-round) 40) (quote shen.left-round))
(begin (register-function-arity (quote shen.find) 2) (define (kl:shen.find V3874 V3875) (cond ((null? V3875) (quote ())) ((and (pair? V3875) (assert-boolean (V3874 (car V3875)))) (cons (car V3875) (kl:shen.find V3874 (cdr V3875)))) ((pair? V3875) (kl:shen.find V3874 (cdr V3875))) (#t (kl:shen.f_error (quote shen.find))))) (quote shen.find))
(begin (register-function-arity (quote shen.prefix?) 2) (define (kl:shen.prefix? V3889 V3890) (cond ((null? V3889) #t) ((and (pair? V3889) (and (pair? V3890) (kl:= (car V3890) (car V3889)))) (kl:shen.prefix? (cdr V3889) (cdr V3890))) (#t #f))) (quote shen.prefix?))
(begin (register-function-arity (quote shen.print-past-inputs) 3) (define (kl:shen.print-past-inputs V3902 V3903 V3904) (cond ((null? V3903) (quote _)) ((and (pair? V3903) (kl:not (V3902 (car V3903)))) (kl:shen.print-past-inputs V3902 (cdr V3903) (+ V3904 1))) ((and (pair? V3903) (kl:tuple? (car V3903))) (begin (kl:shen.prhush (kl:shen.app V3904 ". " (quote shen.a)) (kl:stoutput)) (begin (kl:shen.prbytes (kl:snd (car V3903))) (kl:shen.print-past-inputs V3902 (cdr V3903) (+ V3904 1))))) (#t (kl:shen.f_error (quote shen.print-past-inputs))))) (quote shen.print-past-inputs))
(begin (register-function-arity (quote shen.toplevel_evaluate) 2) (define (kl:shen.toplevel_evaluate V3907 V3908) (cond ((and (pair? V3907) (and (pair? (cdr V3907)) (and (eq? (quote :) (car (cdr V3907))) (and (pair? (cdr (cdr V3907))) (and (null? (cdr (cdr (cdr V3907)))) (kl:= #t V3908)))))) (kl:shen.typecheck-and-evaluate (car V3907) (car (cdr (cdr V3907))))) ((and (pair? V3907) (pair? (cdr V3907))) (begin (kl:shen.toplevel_evaluate (cons (car V3907) (quote ())) V3908) (begin (kl:nl 1) (kl:shen.toplevel_evaluate (cdr V3907) V3908)))) ((and (pair? V3907) (and (null? (cdr V3907)) (kl:= #t V3908))) (kl:shen.typecheck-and-evaluate (car V3907) (kl:gensym (quote A)))) ((and (pair? V3907) (and (null? (cdr V3907)) (kl:= #f V3908))) (let ((Eval (kl:shen.eval-without-macros (car V3907)))) (kl:print Eval))) (#t (kl:shen.f_error (quote shen.toplevel_evaluate))))) (quote shen.toplevel_evaluate))
(begin (register-function-arity (quote shen.typecheck-and-evaluate) 2) (define (kl:shen.typecheck-and-evaluate V3911 V3912) (let ((Typecheck (kl:shen.typecheck V3911 V3912))) (if (kl:= Typecheck #f) (simple-error "type error\n") (let ((Eval (kl:shen.eval-without-macros V3911))) (let ((Type (kl:shen.pretty-type Typecheck))) (kl:shen.prhush (kl:shen.app Eval (string-append " : " (kl:shen.app Type "" (quote shen.r))) (quote shen.s)) (kl:stoutput))))))) (quote shen.typecheck-and-evaluate))
(begin (register-function-arity (quote shen.pretty-type) 1) (define (kl:shen.pretty-type V3914) (kl:shen.mult_subst (kl:value (quote shen.*alphabet*)) (kl:shen.extract-pvars V3914) V3914)) (quote shen.pretty-type))
(begin (register-function-arity (quote shen.extract-pvars) 1) (define (kl:shen.extract-pvars V3920) (cond ((kl:shen.pvar? V3920) (cons V3920 (quote ()))) ((pair? V3920) (kl:union (kl:shen.extract-pvars (car V3920)) (kl:shen.extract-pvars (cdr V3920)))) (#t (quote ())))) (quote shen.extract-pvars))
(begin (register-function-arity (quote shen.mult_subst) 3) (define (kl:shen.mult_subst V3928 V3929 V3930) (cond ((null? V3928) V3930) ((null? V3929) V3930) ((and (pair? V3928) (pair? V3929)) (kl:shen.mult_subst (cdr V3928) (cdr V3929) (kl:subst (car V3928) (car V3929) V3930))) (#t (kl:shen.f_error (quote shen.mult_subst))))) (quote shen.mult_subst))