"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.f_error) 1) (define (kl:shen.f_error V3932) (begin (kl:shen.prhush (string-append "partial function " (kl:shen.app V3932 ";\n" (quote shen.a))) (kl:stoutput)) (begin (if (and (kl:not (kl:shen.tracked? V3932)) (assert-boolean (kl:y-or-n? (string-append "track " (kl:shen.app V3932 "? " (quote shen.a)))))) (kl:shen.track-function (kl:ps V3932)) (quote shen.ok)) (simple-error "aborted")))) (quote shen.f_error))
(begin (register-function-arity (quote shen.tracked?) 1) (define (kl:shen.tracked? V3934) (kl:element? V3934 (kl:value (quote shen.*tracking*)))) (quote shen.tracked?))
(begin (register-function-arity (quote track) 1) (define (kl:track V3936) (let ((Source (kl:ps V3936))) (kl:shen.track-function Source))) (quote track))
(begin (register-function-arity (quote shen.track-function) 1) (define (kl:shen.track-function V3938) (cond ((and (pair? V3938) (and (eq? (quote defun) (car V3938)) (and (pair? (cdr V3938)) (and (pair? (cdr (cdr V3938))) (and (pair? (cdr (cdr (cdr V3938)))) (null? (cdr (cdr (cdr (cdr V3938)))))))))) (let ((KL (cons (quote defun) (cons (car (cdr V3938)) (cons (car (cdr (cdr V3938))) (cons (kl:shen.insert-tracking-code (car (cdr V3938)) (car (cdr (cdr V3938))) (car (cdr (cdr (cdr V3938))))) (quote ()))))))) (let ((Ob (kl:eval-kl KL))) (let ((Tr (kl:set (quote shen.*tracking*) (cons Ob (kl:value (quote shen.*tracking*)))))) Ob)))) (#t (kl:shen.f_error (quote shen.track-function))))) (quote shen.track-function))
(begin (register-function-arity (quote shen.insert-tracking-code) 3) (define (kl:shen.insert-tracking-code V3942 V3943 V3944) (cons (quote do) (cons (cons (quote set) (cons (quote shen.*call*) (cons (cons (quote +) (cons (cons (quote value) (cons (quote shen.*call*) (quote ()))) (cons 1 (quote ())))) (quote ())))) (cons (cons (quote do) (cons (cons (quote shen.input-track) (cons (cons (quote value) (cons (quote shen.*call*) (quote ()))) (cons V3942 (cons (kl:shen.cons_form V3943) (quote ()))))) (cons (cons (quote do) (cons (cons (quote shen.terpri-or-read-char) (quote ())) (cons (cons (quote let) (cons (quote Result) (cons V3944 (cons (cons (quote do) (cons (cons (quote shen.output-track) (cons (cons (quote value) (cons (quote shen.*call*) (quote ()))) (cons V3942 (cons (quote Result) (quote ()))))) (cons (cons (quote do) (cons (cons (quote set) (cons (quote shen.*call*) (cons (cons (quote -) (cons (cons (quote value) (cons (quote shen.*call*) (quote ()))) (cons 1 (quote ())))) (quote ())))) (cons (cons (quote do) (cons (cons (quote shen.terpri-or-read-char) (quote ())) (cons (quote Result) (quote ())))) (quote ())))) (quote ())))) (quote ()))))) (quote ())))) (quote ())))) (quote ()))))) (quote shen.insert-tracking-code))
(kl:set (quote shen.*step*) #f)
(begin (register-function-arity (quote step) 1) (define (kl:step V3950) (cond ((eq? (quote +) V3950) (kl:set (quote shen.*step*) #t)) ((eq? (quote -) V3950) (kl:set (quote shen.*step*) #f)) (#t (simple-error "step expects a + or a -.\n")))) (quote step))
(begin (register-function-arity (quote spy) 1) (define (kl:spy V3956) (cond ((eq? (quote +) V3956) (kl:set (quote shen.*spy*) #t)) ((eq? (quote -) V3956) (kl:set (quote shen.*spy*) #f)) (#t (simple-error "spy expects a + or a -.\n")))) (quote spy))
(begin (register-function-arity (quote shen.terpri-or-read-char) 0) (define (kl:shen.terpri-or-read-char) (if (assert-boolean (kl:value (quote shen.*step*))) (kl:shen.check-byte (kl:read-byte (kl:value (quote *stinput*)))) (kl:nl 1))) (quote shen.terpri-or-read-char))
(begin (register-function-arity (quote shen.check-byte) 1) (define (kl:shen.check-byte V3962) (cond ((kl:= V3962 (kl:shen.hat)) (simple-error "aborted")) (#t #t))) (quote shen.check-byte))
(begin (register-function-arity (quote shen.input-track) 3) (define (kl:shen.input-track V3966 V3967 V3968) (begin (kl:shen.prhush (string-append "\n" (kl:shen.app (kl:shen.spaces V3966) (string-append "<" (kl:shen.app V3966 (string-append "> Inputs to " (kl:shen.app V3967 (string-append " \n" (kl:shen.app (kl:shen.spaces V3966) "" (quote shen.a))) (quote shen.a))) (quote shen.a))) (quote shen.a))) (kl:stoutput)) (kl:shen.recursively-print V3968))) (quote shen.input-track))
(begin (register-function-arity (quote shen.recursively-print) 1) (define (kl:shen.recursively-print V3970) (cond ((null? V3970) (kl:shen.prhush " ==>" (kl:stoutput))) ((pair? V3970) (begin (kl:print (car V3970)) (begin (kl:shen.prhush ", " (kl:stoutput)) (kl:shen.recursively-print (cdr V3970))))) (#t (kl:shen.f_error (quote shen.recursively-print))))) (quote shen.recursively-print))
(begin (register-function-arity (quote shen.spaces) 1) (define (kl:shen.spaces V3972) (cond ((kl:= 0 V3972) "") (#t (string-append " " (kl:shen.spaces (- V3972 1)))))) (quote shen.spaces))
(begin (register-function-arity (quote shen.output-track) 3) (define (kl:shen.output-track V3976 V3977 V3978) (kl:shen.prhush (string-append "\n" (kl:shen.app (kl:shen.spaces V3976) (string-append "<" (kl:shen.app V3976 (string-append "> Output from " (kl:shen.app V3977 (string-append " \n" (kl:shen.app (kl:shen.spaces V3976) (string-append "==> " (kl:shen.app V3978 "" (quote shen.s))) (quote shen.a))) (quote shen.a))) (quote shen.a))) (quote shen.a))) (kl:stoutput))) (quote shen.output-track))
(begin (register-function-arity (quote untrack) 1) (define (kl:untrack V3980) (let ((Tracking (kl:value (quote shen.*tracking*)))) (let ((Tracking (kl:set (quote shen.*tracking*) (kl:remove V3980 Tracking)))) (kl:eval (kl:ps V3980))))) (quote untrack))
(begin (register-function-arity (quote profile) 1) (define (kl:profile V3982) (kl:shen.profile-help (kl:ps V3982))) (quote profile))
(begin (register-function-arity (quote shen.profile-help) 1) (define (kl:shen.profile-help V3988) (cond ((and (pair? V3988) (and (eq? (quote defun) (car V3988)) (and (pair? (cdr V3988)) (and (pair? (cdr (cdr V3988))) (and (pair? (cdr (cdr (cdr V3988)))) (null? (cdr (cdr (cdr (cdr V3988)))))))))) (let ((G (kl:gensym (quote shen.f)))) (let ((Profile (cons (quote defun) (cons (car (cdr V3988)) (cons (car (cdr (cdr V3988))) (cons (kl:shen.profile-func (car (cdr V3988)) (car (cdr (cdr V3988))) (cons G (car (cdr (cdr V3988))))) (quote ()))))))) (let ((Def (cons (quote defun) (cons G (cons (car (cdr (cdr V3988))) (cons (kl:subst G (car (cdr V3988)) (car (cdr (cdr (cdr V3988))))) (quote ()))))))) (let ((CompileProfile (kl:shen.eval-without-macros Profile))) (let ((CompileG (kl:shen.eval-without-macros Def))) (car (cdr V3988)))))))) (#t (simple-error "Cannot profile.\n")))) (quote shen.profile-help))
(begin (register-function-arity (quote unprofile) 1) (define (kl:unprofile V3990) (kl:untrack V3990)) (quote unprofile))
(begin (register-function-arity (quote shen.profile-func) 3) (define (kl:shen.profile-func V3994 V3995 V3996) (cons (quote let) (cons (quote Start) (cons (cons (quote get-time) (cons (quote run) (quote ()))) (cons (cons (quote let) (cons (quote Result) (cons V3996 (cons (cons (quote let) (cons (quote Finish) (cons (cons (quote -) (cons (cons (quote get-time) (cons (quote run) (quote ()))) (cons (quote Start) (quote ())))) (cons (cons (quote let) (cons (quote Record) (cons (cons (quote shen.put-profile) (cons V3994 (cons (cons (quote +) (cons (cons (quote shen.get-profile) (cons V3994 (quote ()))) (cons (quote Finish) (quote ())))) (quote ())))) (cons (quote Result) (quote ()))))) (quote ()))))) (quote ()))))) (quote ())))))) (quote shen.profile-func))
(begin (register-function-arity (quote profile-results) 1) (define (kl:profile-results V3998) (let ((Results (kl:shen.get-profile V3998))) (let ((Initialise (kl:shen.put-profile V3998 0))) (kl:_scheme_at_p V3998 Results)))) (quote profile-results))
(begin (register-function-arity (quote shen.get-profile) 1) (define (kl:shen.get-profile V4000) (guard (lambda (E) 0) (lambda () (kl:get V4000 (quote profile) (kl:value (quote *property-vector*)))))) (quote shen.get-profile))
(begin (register-function-arity (quote shen.put-profile) 2) (define (kl:shen.put-profile V4003 V4004) (kl:put V4003 (quote profile) V4004 (kl:value (quote *property-vector*)))) (quote shen.put-profile))