"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 load) 1) (define (kl:load V1498) (let ((Load (let ((Start (kl:get-time (quote run)))) (let ((Result (kl:shen.load-help (kl:value (quote shen.*tc*)) (kl:read-file V1498)))) (let ((Finish (kl:get-time (quote run)))) (let ((Time (- Finish Start))) (let ((Message (kl:shen.prhush (string-append "\nrun time: " (string-append (kl:str Time) " secs\n")) (kl:stoutput)))) Result))))))) (let ((Infs (if (assert-boolean (kl:value (quote shen.*tc*))) (kl:shen.prhush (string-append "\ntypechecked in " (kl:shen.app (kl:inferences) " inferences\n" (quote shen.a))) (kl:stoutput)) (quote shen.skip)))) (quote loaded)))) (quote load))
(begin (register-function-arity (quote shen.load-help) 2) (define (kl:shen.load-help V1505 V1506) (cond ((kl:= #f V1505) (kl:shen.for-each (lambda (X) (kl:shen.prhush (kl:shen.app (kl:shen.eval-without-macros X) "\n" (quote shen.s)) (kl:stoutput))) V1506)) (#t (let ((RemoveSynonyms (kl:mapcan (lambda (X) (kl:shen.remove-synonyms X)) V1506))) (let ((Table (kl:mapcan (lambda (X) (kl:shen.typetable X)) RemoveSynonyms))) (let ((Assume (kl:shen.for-each (lambda (X) (kl:shen.assumetype X)) Table))) (guard (lambda (E) (kl:shen.unwind-types E Table)) (lambda () (kl:shen.for-each (lambda (X) (kl:shen.typecheck-and-load X)) RemoveSynonyms))))))))) (quote shen.load-help))
(begin (register-function-arity (quote shen.remove-synonyms) 1) (define (kl:shen.remove-synonyms V1508) (cond ((and (pair? V1508) (eq? (quote shen.synonyms-help) (car V1508))) (begin (kl:eval V1508) (quote ()))) (#t (cons V1508 (quote ()))))) (quote shen.remove-synonyms))
(begin (register-function-arity (quote shen.typecheck-and-load) 1) (define (kl:shen.typecheck-and-load V1510) (begin (kl:nl 1) (kl:shen.typecheck-and-evaluate V1510 (kl:gensym (quote A))))) (quote shen.typecheck-and-load))
(begin (register-function-arity (quote shen.typetable) 1) (define (kl:shen.typetable V1516) (cond ((and (pair? V1516) (and (eq? (quote define) (car V1516)) (pair? (cdr V1516)))) (let ((Sig (kl:compile (lambda (Y) (kl:shen.<sig+rest> Y)) (cdr (cdr V1516)) (lambda (E) (simple-error (kl:shen.app (car (cdr V1516)) " lacks a proper signature.\n" (quote shen.a))))))) (cons (cons (car (cdr V1516)) Sig) (quote ())))) (#t (quote ())))) (quote shen.typetable))
(begin (register-function-arity (quote shen.assumetype) 1) (define (kl:shen.assumetype V1518) (cond ((pair? V1518) (kl:declare (car V1518) (cdr V1518))) (#t (kl:shen.f_error (quote shen.assumetype))))) (quote shen.assumetype))
(begin (register-function-arity (quote shen.unwind-types) 2) (define (kl:shen.unwind-types V1525 V1526) (cond ((null? V1526) (simple-error (kl:error-to-string V1525))) ((and (pair? V1526) (pair? (car V1526))) (begin (kl:shen.remtype (car (car V1526))) (kl:shen.unwind-types V1525 (cdr V1526)))) (#t (kl:shen.f_error (quote shen.unwind-types))))) (quote shen.unwind-types))
(begin (register-function-arity (quote shen.remtype) 1) (define (kl:shen.remtype V1528) (kl:set (quote shen.*signedfuncs*) (kl:shen.removetype V1528 (kl:value (quote shen.*signedfuncs*))))) (quote shen.remtype))
(begin (register-function-arity (quote shen.removetype) 2) (define (kl:shen.removetype V1536 V1537) (cond ((null? V1537) (quote ())) ((and (pair? V1537) (and (pair? (car V1537)) (kl:= (car (car V1537)) V1536))) (kl:shen.removetype (car (car V1537)) (cdr V1537))) ((pair? V1537) (cons (car V1537) (kl:shen.removetype V1536 (cdr V1537)))) (#t (kl:shen.f_error (quote shen.removetype))))) (quote shen.removetype))
(begin (register-function-arity (quote shen.<sig+rest>) 1) (define (kl:shen.<sig+rest> V1539) (let ((Parse_shen.<signature> (kl:shen.<signature> V1539))) (if (kl:not (eq? (quote shen.fail!) Parse_shen.<signature>)) (let ((Parse_<!> (kl:<!> Parse_shen.<signature>))) (if (kl:not (eq? (quote shen.fail!) Parse_<!>)) (kl:shen.pair (car Parse_<!>) (kl:shen.hdtl Parse_shen.<signature>)) (quote shen.fail!))) (quote shen.fail!)))) (quote shen.<sig+rest>))
(begin (register-function-arity (quote write-to-file) 2) (define (kl:write-to-file V1542 V1543) (let ((Stream (kl:open V1542 (quote out)))) (let ((String (if (string? V1543) (kl:shen.app V1543 "\n\n" (quote shen.a)) (kl:shen.app V1543 "\n\n" (quote shen.s))))) (let ((Write (kl:pr String Stream))) (let ((Close (kl:close Stream))) V1543))))) (quote write-to-file))