diff --git a/CHANGELOG.md b/CHANGELOG.md index 5dac48a..1f7005f 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,10 @@ # Change Log +## unreleased + +- Add module declarations to Wasp Lisp files and a `shen-libs.ms` that + can be imported to load all the compiled Shen code from Lisp. + ## 0.10 - 2018-10-07 - Update to Shen OS Kernel 21.1. diff --git a/README.md b/README.md index 6d45041..9b54e24 100644 --- a/README.md +++ b/README.md @@ -123,11 +123,10 @@ Note that it takes a while to startup as it runs through the Shen and KLambda in ## Running from the Wasp REPL -Shen can be run and debugged from the Wasp REPL. To load the compiled code and run Shen: +Shen can be run and debugged from the Wasp REPL. To import the compiled code and run Shen: $ rlwrap wasp - >> (import "driver") - >> (load-all) + >> (import "shen-lib") >> (kl:shen.shen) Shen, copyright (C) 2010-2015 Mark Tarver www.shenlanguage.org, Shen 20.1 @@ -137,8 +136,9 @@ Shen can be run and debugged from the Wasp REPL. To load the compiled code and r (0-) -When developing on the compiler it's useful to use `eval-all` instead of `load-all`. This will load the KLambda files, compile them to Scheme and `eval` them: +When developing on the compiler it's useful to use `eval-all`. This will load the KLambda files, compile them to Scheme and `eval` them: + >> (import "driver") >> (eval-all) >> (kl:shen.shen) ... diff --git a/compiled/core.kl.ms b/compiled/core.kl.ms index 2277641..5d341db 100644 --- a/compiled/core.kl.ms +++ b/compiled/core.kl.ms @@ -1,64 +1,65 @@ +(module "compiled/core.kl") "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. 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.) 1) (define (kl:shen. V1202) (let ((YaccParse (let ((Parse_shen. (kl:shen. V1202))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.compile_to_machine_code (kl:shen.hdtl Parse_shen.) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_shen. (kl:shen. V1202))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.compile_to_machine_code (kl:shen.hdtl Parse_shen.) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))) YaccParse))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. 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 (kl: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)))))) (kl:fail))) (quote shen.)) -(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.) 1) (define (kl:shen. 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. (kl:shen. NewStream1207))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (if (and (pair? (car Parse_shen.)) (eq? (quote }) (kl:shen.hdhd Parse_shen.))) (let ((NewStream1208 (kl:shen.pair (kl:shen.tlhd Parse_shen.) (kl:shen.hdtl Parse_shen.)))) (kl:shen.pair (car NewStream1208) (kl:shen.demodulate (kl:shen.curry-type (kl:shen.hdtl Parse_shen.))))) (kl:fail)) (kl:fail)))) (kl:fail))) (quote shen.)) -(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.) 1) (define (kl:shen. V1218) (let ((YaccParse (if (pair? (car V1218)) (let ((Parse_X (kl:shen.hdhd V1218))) (let ((Parse_shen. (kl:shen. (kl:shen.pair (kl:shen.tlhd V1218) (kl:shen.hdtl V1218))))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (if (kl:not (kl:element? Parse_X (cons (quote {) (cons (quote }) (quote ()))))) (kl:shen.pair (car Parse_shen.) (cons Parse_X (kl:shen.hdtl Parse_shen.))) (kl:fail)) (kl:fail)))) (kl:fail)))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_ (kl: V1218))) (if (kl:not (kl:= (kl:fail) Parse_)) (kl:shen.pair (car Parse_) (quote ())) (kl:fail))) YaccParse))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1220) (let ((YaccParse (let ((Parse_shen. (kl:shen. V1220))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (kl:shen.linearise (kl:shen.hdtl Parse_shen.)) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_shen. (kl:shen. V1220))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (kl:shen.linearise (kl:shen.hdtl Parse_shen.)) (quote ()))) (kl:fail))) YaccParse))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1228) (let ((YaccParse (let ((Parse_shen. (kl:shen. V1228))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (if (and (pair? (car Parse_shen.)) (eq? (quote ->) (kl:shen.hdhd Parse_shen.))) (let ((NewStream1221 (kl:shen.pair (kl:shen.tlhd Parse_shen.) (kl:shen.hdtl Parse_shen.)))) (let ((Parse_shen. (kl:shen. NewStream1221))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (if (and (pair? (car Parse_shen.)) (eq? (quote where) (kl:shen.hdhd Parse_shen.))) (let ((NewStream1222 (kl:shen.pair (kl:shen.tlhd Parse_shen.) (kl:shen.hdtl Parse_shen.)))) (let ((Parse_shen. (kl:shen. NewStream1222))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (cons (cons (quote where) (cons (kl:shen.hdtl Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (quote ())))) (quote ())))) (kl:fail)))) (kl:fail)) (kl:fail)))) (kl:fail)) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((YaccParse (let ((Parse_shen. (kl:shen. V1228))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (if (and (pair? (car Parse_shen.)) (eq? (quote ->) (kl:shen.hdhd Parse_shen.))) (let ((NewStream1223 (kl:shen.pair (kl:shen.tlhd Parse_shen.) (kl:shen.hdtl Parse_shen.)))) (let ((Parse_shen. (kl:shen. NewStream1223))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (quote ())))) (kl:fail)))) (kl:fail)) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((YaccParse (let ((Parse_shen. (kl:shen. V1228))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (if (and (pair? (car Parse_shen.)) (eq? (quote <-) (kl:shen.hdhd Parse_shen.))) (let ((NewStream1224 (kl:shen.pair (kl:shen.tlhd Parse_shen.) (kl:shen.hdtl Parse_shen.)))) (let ((Parse_shen. (kl:shen. NewStream1224))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (if (and (pair? (car Parse_shen.)) (eq? (quote where) (kl:shen.hdhd Parse_shen.))) (let ((NewStream1225 (kl:shen.pair (kl:shen.tlhd Parse_shen.) (kl:shen.hdtl Parse_shen.)))) (let ((Parse_shen. (kl:shen. NewStream1225))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (cons (cons (quote where) (cons (kl:shen.hdtl Parse_shen.) (cons (cons (quote shen.choicepoint!) (cons (kl:shen.hdtl Parse_shen.) (quote ()))) (quote ())))) (quote ())))) (kl:fail)))) (kl:fail)) (kl:fail)))) (kl:fail)) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_shen. (kl:shen. V1228))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (if (and (pair? (car Parse_shen.)) (eq? (quote <-) (kl:shen.hdhd Parse_shen.))) (let ((NewStream1226 (kl:shen.pair (kl:shen.tlhd Parse_shen.) (kl:shen.hdtl Parse_shen.)))) (let ((Parse_shen. (kl:shen. NewStream1226))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (cons (cons (quote shen.choicepoint!) (cons (kl:shen.hdtl Parse_shen.) (quote ()))) (quote ())))) (kl:fail)))) (kl:fail)) (kl:fail))) YaccParse)) YaccParse)) YaccParse))) (quote shen.)) -(begin (register-function-arity (quote shen.fail_if) 2) (define (kl:shen.fail_if V1231 V1232) (if (assert-boolean (V1231 V1232)) (kl:fail) V1232)) (quote shen.fail_if)) -(begin (register-function-arity (quote shen.succeeds?) 1) (define (kl:shen.succeeds? V1238) (cond ((kl:= V1238 (kl:fail)) #f) (#t #t))) (quote shen.succeeds?)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1240) (let ((YaccParse (let ((Parse_shen. (kl:shen. V1240))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_ (kl: V1240))) (if (kl:not (kl:= (kl:fail) Parse_)) (kl:shen.pair (car Parse_) (quote ())) (kl:fail))) YaccParse))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. 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 _waspvm_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. (kl:shen. NewStream1242))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V1253) (kl:shen.hdtl V1253))) (cons (quote _waspvm_at_p) (cons (kl:shen.hdtl Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (quote ()))))) (kl:fail))) (kl:fail)))) (kl:fail)) (kl:fail)))) (if (kl:= YaccParse (kl: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. (kl:shen. NewStream1244))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V1253) (kl:shen.hdtl V1253))) (cons (quote cons) (cons (kl:shen.hdtl Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (quote ()))))) (kl:fail))) (kl:fail)))) (kl:fail)) (kl:fail)))) (if (kl:= YaccParse (kl: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 _waspvm_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. (kl:shen. NewStream1246))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V1253) (kl:shen.hdtl V1253))) (cons (quote _waspvm_at_v) (cons (kl:shen.hdtl Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (quote ()))))) (kl:fail))) (kl:fail)))) (kl:fail)) (kl:fail)))) (if (kl:= YaccParse (kl: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 _waspvm_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. (kl:shen. NewStream1248))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V1253) (kl:shen.hdtl V1253))) (cons (quote _waspvm_at_s) (cons (kl:shen.hdtl Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (quote ()))))) (kl:fail))) (kl:fail)))) (kl:fail)) (kl:fail)))) (if (kl:= YaccParse (kl: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 ()))))) (kl:fail))) (kl:fail)) (kl:fail)))) (if (kl:= YaccParse (kl: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)) (kl:fail))) (kl:fail)))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_shen. (kl:shen. V1253))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.hdtl Parse_shen.)) (kl:fail))) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse))) (quote shen.)) -(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.) 1) (define (kl:shen. 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))) (kl:fail))) (kl:fail)))) (if (kl:= YaccParse (kl: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) (kl:fail))) (kl:fail)) YaccParse))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1259) (let ((Parse_shen. (kl:shen. V1259))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.hdtl Parse_shen.)) (kl:fail)))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1261) (let ((Parse_shen. (kl:shen. V1261))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.hdtl Parse_shen.)) (kl:fail)))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. 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)) (kl:fail))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. 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)) (kl:fail))) (quote shen.)) -(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 (kl: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 _waspvm_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 _waspvm_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 _waspvm_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)) +(begin (register-function-arity (quote shen.shen->kl) 2) (define (kl:shen.shen->kl V1191 V1192) (kl:compile (lambda (X) (kl:shen. X)) (cons V1191 V1192) (lambda (X) (kl:shen.shen-syntax-error V1191 X)))) (export shen.shen->kl) (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))))))) (export shen.shen-syntax-error) (quote shen.shen-syntax-error)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1202) (let ((YaccParse (let ((Parse_shen. (kl:shen. V1202))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.compile_to_machine_code (kl:shen.hdtl Parse_shen.) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_shen. (kl:shen. V1202))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.compile_to_machine_code (kl:shen.hdtl Parse_shen.) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))) YaccParse))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. 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 (kl: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)))))) (kl:fail))) (export shen.) (quote shen.)) +(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*))))) (export shen.sysfunc?) (quote shen.sysfunc?)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. 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. (kl:shen. NewStream1207))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (if (and (pair? (car Parse_shen.)) (eq? (quote }) (kl:shen.hdhd Parse_shen.))) (let ((NewStream1208 (kl:shen.pair (kl:shen.tlhd Parse_shen.) (kl:shen.hdtl Parse_shen.)))) (kl:shen.pair (car NewStream1208) (kl:shen.demodulate (kl:shen.curry-type (kl:shen.hdtl Parse_shen.))))) (kl:fail)) (kl:fail)))) (kl:fail))) (export shen.) (quote shen.)) +(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))) (export shen.curry-type) (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))) (export shen.active-cons) (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))) (export shen.curry-type-h) (quote shen.curry-type-h)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1218) (let ((YaccParse (if (pair? (car V1218)) (let ((Parse_X (kl:shen.hdhd V1218))) (let ((Parse_shen. (kl:shen. (kl:shen.pair (kl:shen.tlhd V1218) (kl:shen.hdtl V1218))))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (if (kl:not (kl:element? Parse_X (cons (quote {) (cons (quote }) (quote ()))))) (kl:shen.pair (car Parse_shen.) (cons Parse_X (kl:shen.hdtl Parse_shen.))) (kl:fail)) (kl:fail)))) (kl:fail)))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_ (kl: V1218))) (if (kl:not (kl:= (kl:fail) Parse_)) (kl:shen.pair (car Parse_) (quote ())) (kl:fail))) YaccParse))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1220) (let ((YaccParse (let ((Parse_shen. (kl:shen. V1220))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (kl:shen.linearise (kl:shen.hdtl Parse_shen.)) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_shen. (kl:shen. V1220))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (kl:shen.linearise (kl:shen.hdtl Parse_shen.)) (quote ()))) (kl:fail))) YaccParse))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1228) (let ((YaccParse (let ((Parse_shen. (kl:shen. V1228))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (if (and (pair? (car Parse_shen.)) (eq? (quote ->) (kl:shen.hdhd Parse_shen.))) (let ((NewStream1221 (kl:shen.pair (kl:shen.tlhd Parse_shen.) (kl:shen.hdtl Parse_shen.)))) (let ((Parse_shen. (kl:shen. NewStream1221))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (if (and (pair? (car Parse_shen.)) (eq? (quote where) (kl:shen.hdhd Parse_shen.))) (let ((NewStream1222 (kl:shen.pair (kl:shen.tlhd Parse_shen.) (kl:shen.hdtl Parse_shen.)))) (let ((Parse_shen. (kl:shen. NewStream1222))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (cons (cons (quote where) (cons (kl:shen.hdtl Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (quote ())))) (quote ())))) (kl:fail)))) (kl:fail)) (kl:fail)))) (kl:fail)) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((YaccParse (let ((Parse_shen. (kl:shen. V1228))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (if (and (pair? (car Parse_shen.)) (eq? (quote ->) (kl:shen.hdhd Parse_shen.))) (let ((NewStream1223 (kl:shen.pair (kl:shen.tlhd Parse_shen.) (kl:shen.hdtl Parse_shen.)))) (let ((Parse_shen. (kl:shen. NewStream1223))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (quote ())))) (kl:fail)))) (kl:fail)) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((YaccParse (let ((Parse_shen. (kl:shen. V1228))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (if (and (pair? (car Parse_shen.)) (eq? (quote <-) (kl:shen.hdhd Parse_shen.))) (let ((NewStream1224 (kl:shen.pair (kl:shen.tlhd Parse_shen.) (kl:shen.hdtl Parse_shen.)))) (let ((Parse_shen. (kl:shen. NewStream1224))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (if (and (pair? (car Parse_shen.)) (eq? (quote where) (kl:shen.hdhd Parse_shen.))) (let ((NewStream1225 (kl:shen.pair (kl:shen.tlhd Parse_shen.) (kl:shen.hdtl Parse_shen.)))) (let ((Parse_shen. (kl:shen. NewStream1225))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (cons (cons (quote where) (cons (kl:shen.hdtl Parse_shen.) (cons (cons (quote shen.choicepoint!) (cons (kl:shen.hdtl Parse_shen.) (quote ()))) (quote ())))) (quote ())))) (kl:fail)))) (kl:fail)) (kl:fail)))) (kl:fail)) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_shen. (kl:shen. V1228))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (if (and (pair? (car Parse_shen.)) (eq? (quote <-) (kl:shen.hdhd Parse_shen.))) (let ((NewStream1226 (kl:shen.pair (kl:shen.tlhd Parse_shen.) (kl:shen.hdtl Parse_shen.)))) (let ((Parse_shen. (kl:shen. NewStream1226))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (cons (cons (quote shen.choicepoint!) (cons (kl:shen.hdtl Parse_shen.) (quote ()))) (quote ())))) (kl:fail)))) (kl:fail)) (kl:fail))) YaccParse)) YaccParse)) YaccParse))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.fail_if) 2) (define (kl:shen.fail_if V1231 V1232) (if (assert-boolean (V1231 V1232)) (kl:fail) V1232)) (export shen.fail_if) (quote shen.fail_if)) +(begin (register-function-arity (quote shen.succeeds?) 1) (define (kl:shen.succeeds? V1238) (cond ((kl:= V1238 (kl:fail)) #f) (#t #t))) (export shen.succeeds?) (quote shen.succeeds?)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1240) (let ((YaccParse (let ((Parse_shen. (kl:shen. V1240))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_ (kl: V1240))) (if (kl:not (kl:= (kl:fail) Parse_)) (kl:shen.pair (car Parse_) (quote ())) (kl:fail))) YaccParse))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. 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 _waspvm_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. (kl:shen. NewStream1242))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V1253) (kl:shen.hdtl V1253))) (cons (quote _waspvm_at_p) (cons (kl:shen.hdtl Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (quote ()))))) (kl:fail))) (kl:fail)))) (kl:fail)) (kl:fail)))) (if (kl:= YaccParse (kl: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. (kl:shen. NewStream1244))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V1253) (kl:shen.hdtl V1253))) (cons (quote cons) (cons (kl:shen.hdtl Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (quote ()))))) (kl:fail))) (kl:fail)))) (kl:fail)) (kl:fail)))) (if (kl:= YaccParse (kl: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 _waspvm_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. (kl:shen. NewStream1246))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V1253) (kl:shen.hdtl V1253))) (cons (quote _waspvm_at_v) (cons (kl:shen.hdtl Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (quote ()))))) (kl:fail))) (kl:fail)))) (kl:fail)) (kl:fail)))) (if (kl:= YaccParse (kl: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 _waspvm_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. (kl:shen. NewStream1248))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V1253) (kl:shen.hdtl V1253))) (cons (quote _waspvm_at_s) (cons (kl:shen.hdtl Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (quote ()))))) (kl:fail))) (kl:fail)))) (kl:fail)) (kl:fail)))) (if (kl:= YaccParse (kl: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 ()))))) (kl:fail))) (kl:fail)) (kl:fail)))) (if (kl:= YaccParse (kl: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)) (kl:fail))) (kl:fail)))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_shen. (kl:shen. V1253))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.hdtl Parse_shen.)) (kl:fail))) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse))) (export shen.) (quote shen.)) +(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)))) (export shen.constructor-error) (quote shen.constructor-error)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. 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))) (kl:fail))) (kl:fail)))) (if (kl:= YaccParse (kl: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) (kl:fail))) (kl:fail)) YaccParse))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1259) (let ((Parse_shen. (kl:shen. V1259))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.hdtl Parse_shen.)) (kl:fail)))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1261) (let ((Parse_shen. (kl:shen. V1261))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.hdtl Parse_shen.)) (kl:fail)))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. 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)) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. 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)) (kl:fail))) (export shen.) (quote shen.)) +(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)))) (export shen.compile_to_machine_code) (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*)))))) (export shen.record-source) (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 ()))))))))))) (export shen.compile_to_lambda+) (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*)))))) (export shen.update-symbol-table) (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))))) (export 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 ())))) (export shen.extract_vars) (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 ())))) (export shen.extract_free_vars) (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))))))) (export shen.free_variable_warnings) (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))))) (export 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))) (export shen.strip-protect) (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))))) (export 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 ()))))) (export shen.flatten) (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))))) (export 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))) (export shen.linearise_X) (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))))) (export 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)))) (export shen.aritycheck-name) (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)))) (export shen.aritycheck-action) (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))))) (export shen.aah) (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))))) (export 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))))) (export 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)))))) (export shen.parameters) (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))))) (export 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))))) (export 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)))))) (export shen.get-type) (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 ())))) (export shen.typextable) (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))))))) (export shen.assign-types) (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 (kl:symbol? V1408) (cons (quote type) (cons V1408 (cons (quote symbol) (quote ())))) V1408))))) (export shen.atom-type) (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*)))))) (export shen.store-arity) (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 ())))))) (export shen.reduce) (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 _waspvm_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 _waspvm_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 _waspvm_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))) (export shen.reduce_help) (quote shen.reduce_help)) +(begin (register-function-arity (quote shen.+string?) 1) (define (kl:shen.+string? V1420) (cond ((equal? "" V1420) #f) (#t (string? V1420)))) (export shen.+string?) (quote shen.+string?)) +(begin (register-function-arity (quote shen.+vector?) 1) (define (kl:shen.+vector? V1422) (and (vector? V1422) (> (vector-ref V1422 0) 0))) (export shen.+vector?) (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))) (export shen.ebr) (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*))))) (export shen.add_test) (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))))) (export shen.cond-expression) (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)))) (export shen.cond-form) (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))))) (export 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))))) (export 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))))) (export 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 ())))) (export shen.err-condition) (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))))) (export shen.sys-error) (quote shen.sys-error)) diff --git a/compiled/declarations.kl.ms b/compiled/declarations.kl.ms index 7eb70fe..62c5f70 100644 --- a/compiled/declarations.kl.ms +++ b/compiled/declarations.kl.ms @@ -1,3 +1,4 @@ +(module "compiled/declarations.kl") "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." (kl:set (quote shen.*installing-kl*) #f) (kl:set (quote shen.*history*) (quote ())) @@ -33,16 +34,16 @@ (kl:set (quote *version*) "Shen 21.1") (if (kl:not (kl:bound? (quote *home-directory*))) (kl:set (quote *home-directory*) "") (quote shen.skip)) (if (kl:not (kl:bound? (quote *sterror*))) (kl:set (quote *sterror*) (kl:value (quote *stoutput*))) (quote shen.skip)) -(begin (register-function-arity (quote shen.initialise_arity_table) 1) (define (kl:shen.initialise_arity_table V1472) (cond ((null? V1472) (quote ())) ((and (pair? V1472) (pair? (cdr V1472))) (let ((DecArity (kl:put (car V1472) (quote arity) (car (cdr V1472)) (kl:value (quote *property-vector*))))) (kl:shen.initialise_arity_table (cdr (cdr V1472))))) (#t (kl:shen.f_error (quote shen.initialise_arity_table))))) (quote shen.initialise_arity_table)) -(begin (register-function-arity (quote arity) 1) (define (kl:arity V1474) (guard (lambda (E) -1) (kl:get V1474 (quote arity) (kl:value (quote *property-vector*))))) (quote arity)) +(begin (register-function-arity (quote shen.initialise_arity_table) 1) (define (kl:shen.initialise_arity_table V1472) (cond ((null? V1472) (quote ())) ((and (pair? V1472) (pair? (cdr V1472))) (let ((DecArity (kl:put (car V1472) (quote arity) (car (cdr V1472)) (kl:value (quote *property-vector*))))) (kl:shen.initialise_arity_table (cdr (cdr V1472))))) (#t (kl:shen.f_error (quote shen.initialise_arity_table))))) (export shen.initialise_arity_table) (quote shen.initialise_arity_table)) +(begin (register-function-arity (quote arity) 1) (define (kl:arity V1474) (guard (lambda (E) -1) (kl:get V1474 (quote arity) (kl:value (quote *property-vector*))))) (export arity) (quote arity)) (kl:shen.initialise_arity_table (cons (quote abort) (cons 0 (cons (quote absvector?) (cons 1 (cons (quote absvector) (cons 1 (cons (quote adjoin) (cons 2 (cons (quote and) (cons 2 (cons (quote append) (cons 2 (cons (quote arity) (cons 1 (cons (quote assoc) (cons 2 (cons (quote boolean?) (cons 1 (cons (quote bound?) (cons 1 (cons (quote cd) (cons 1 (cons (quote close) (cons 1 (cons (quote compile) (cons 3 (cons (quote concat) (cons 2 (cons (quote cons) (cons 2 (cons (quote cons?) (cons 1 (cons (quote cn) (cons 2 (cons (quote declare) (cons 2 (cons (quote destroy) (cons 1 (cons (quote difference) (cons 2 (cons (quote do) (cons 2 (cons (quote element?) (cons 2 (cons (quote empty?) (cons 1 (cons (quote enable-type-theory) (cons 1 (cons (quote error-to-string) (cons 1 (cons (quote shen.interror) (cons 2 (cons (quote eval) (cons 1 (cons (quote eval-kl) (cons 1 (cons (quote explode) (cons 1 (cons (quote external) (cons 1 (cons (quote fail-if) (cons 2 (cons (quote fail) (cons 0 (cons (quote fix) (cons 2 (cons (quote findall) (cons 5 (cons (quote freeze) (cons 1 (cons (quote fst) (cons 1 (cons (quote gensym) (cons 1 (cons (quote get) (cons 3 (cons (quote get-time) (cons 1 (cons (quote address->) (cons 3 (cons (quote <-address) (cons 2 (cons (quote <-vector) (cons 2 (cons (quote >) (cons 2 (cons (quote >=) (cons 2 (cons (quote =) (cons 2 (cons (quote hash) (cons 2 (cons (quote hd) (cons 1 (cons (quote hdv) (cons 1 (cons (quote hdstr) (cons 1 (cons (quote head) (cons 1 (cons (quote if) (cons 3 (cons (quote integer?) (cons 1 (cons (quote intern) (cons 1 (cons (quote identical) (cons 4 (cons (quote inferences) (cons 0 (cons (quote input) (cons 1 (cons (quote input+) (cons 2 (cons (quote implementation) (cons 0 (cons (quote intersection) (cons 2 (cons (quote internal) (cons 1 (cons (quote it) (cons 0 (cons (quote kill) (cons 0 (cons (quote language) (cons 0 (cons (quote length) (cons 1 (cons (quote limit) (cons 1 (cons (quote lineread) (cons 1 (cons (quote load) (cons 1 (cons (quote <) (cons 2 (cons (quote <=) (cons 2 (cons (quote vector) (cons 1 (cons (quote macroexpand) (cons 1 (cons (quote map) (cons 2 (cons (quote mapcan) (cons 2 (cons (quote maxinferences) (cons 1 (cons (quote nl) (cons 1 (cons (quote not) (cons 1 (cons (quote nth) (cons 2 (cons (quote n->string) (cons 1 (cons (quote number?) (cons 1 (cons (quote occurs-check) (cons 1 (cons (quote occurrences) (cons 2 (cons (quote occurs-check) (cons 1 (cons (quote open) (cons 2 (cons (quote optimise) (cons 1 (cons (quote or) (cons 2 (cons (quote os) (cons 0 (cons (quote package) (cons 3 (cons (quote package?) (cons 1 (cons (quote port) (cons 0 (cons (quote porters) (cons 0 (cons (quote pos) (cons 2 (cons (quote print) (cons 1 (cons (quote profile) (cons 1 (cons (quote profile-results) (cons 1 (cons (quote pr) (cons 2 (cons (quote ps) (cons 1 (cons (quote preclude) (cons 1 (cons (quote preclude-all-but) (cons 1 (cons (quote protect) (cons 1 (cons (quote address->) (cons 3 (cons (quote put) (cons 4 (cons (quote shen.reassemble) (cons 2 (cons (quote read-file-as-string) (cons 1 (cons (quote read-file) (cons 1 (cons (quote read-file-as-bytelist) (cons 1 (cons (quote read) (cons 1 (cons (quote read-byte) (cons 1 (cons (quote read-from-string) (cons 1 (cons (quote receive) (cons 1 (cons (quote release) (cons 0 (cons (quote remove) (cons 2 (cons (quote shen.require) (cons 3 (cons (quote reverse) (cons 1 (cons (quote set) (cons 2 (cons (quote simple-error) (cons 1 (cons (quote snd) (cons 1 (cons (quote specialise) (cons 1 (cons (quote spy) (cons 1 (cons (quote step) (cons 1 (cons (quote stinput) (cons 0 (cons (quote stoutput) (cons 0 (cons (quote sterror) (cons 0 (cons (quote string->n) (cons 1 (cons (quote string->symbol) (cons 1 (cons (quote string?) (cons 1 (cons (quote str) (cons 1 (cons (quote subst) (cons 3 (cons (quote sum) (cons 1 (cons (quote symbol?) (cons 1 (cons (quote systemf) (cons 1 (cons (quote tail) (cons 1 (cons (quote tl) (cons 1 (cons (quote tc) (cons 1 (cons (quote tc?) (cons 0 (cons (quote thaw) (cons 1 (cons (quote tlstr) (cons 1 (cons (quote track) (cons 1 (cons (quote trap-error) (cons 2 (cons (quote tuple?) (cons 1 (cons (quote type) (cons 2 (cons (quote return) (cons 3 (cons (quote undefmacro) (cons 1 (cons (quote unput) (cons 3 (cons (quote unprofile) (cons 1 (cons (quote unify) (cons 4 (cons (quote unify!) (cons 4 (cons (quote union) (cons 2 (cons (quote untrack) (cons 1 (cons (quote unspecialise) (cons 1 (cons (quote undefmacro) (cons 1 (cons (quote vector) (cons 1 (cons (quote vector?) (cons 1 (cons (quote vector->) (cons 3 (cons (quote value) (cons 1 (cons (quote variable?) (cons 1 (cons (quote version) (cons 0 (cons (quote write-byte) (cons 2 (cons (quote write-to-file) (cons 2 (cons (quote y-or-n?) (cons 1 (cons (quote +) (cons 2 (cons (quote *) (cons 2 (cons (quote /) (cons 2 (cons (quote -) (cons 2 (cons (quote ==) (cons 2 (cons (quote ) (cons 1 (cons (quote ) (cons 1 (cons (quote _waspvm_at_p) (cons 2 (cons (quote _waspvm_at_v) (cons 2 (cons (quote _waspvm_at_s) (cons 2 (cons (quote preclude) (cons 1 (cons (quote include) (cons 1 (cons (quote preclude-all-but) (cons 1 (cons (quote include-all-but) (cons 1 (quote ())))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) -(begin (register-function-arity (quote systemf) 1) (define (kl:systemf V1476) (let ((Shen (kl:intern "shen"))) (let ((External (kl:get Shen (quote shen.external-symbols) (kl:value (quote *property-vector*))))) (let ((Place (kl:put Shen (quote shen.external-symbols) (kl:adjoin V1476 External) (kl:value (quote *property-vector*))))) V1476)))) (quote systemf)) -(begin (register-function-arity (quote adjoin) 2) (define (kl:adjoin V1479 V1480) (if (kl:element? V1479 V1480) V1480 (cons V1479 V1480))) (quote adjoin)) +(begin (register-function-arity (quote systemf) 1) (define (kl:systemf V1476) (let ((Shen (kl:intern "shen"))) (let ((External (kl:get Shen (quote shen.external-symbols) (kl:value (quote *property-vector*))))) (let ((Place (kl:put Shen (quote shen.external-symbols) (kl:adjoin V1476 External) (kl:value (quote *property-vector*))))) V1476)))) (export systemf) (quote systemf)) +(begin (register-function-arity (quote adjoin) 2) (define (kl:adjoin V1479 V1480) (if (kl:element? V1479 V1480) V1480 (cons V1479 V1480))) (export adjoin) (quote adjoin)) (kl:put (kl:intern "shen") (quote shen.external-symbols) (cons (quote !) (cons (quote }) (cons (quote {) (cons (quote -->) (cons (quote <--) (cons (quote &&) (cons (quote :) (cons (quote _waspvm_sc_) (cons (quote :-) (cons (quote :=) (cons (quote _) (cons (string->symbol ",") (cons (quote *language*) (cons (quote *implementation*) (cons (quote *stinput*) (cons (quote *stoutput*) (cons (quote *sterror*) (cons (quote *home-directory*) (cons (quote *version*) (cons (quote *maximum-print-sequence-size*) (cons (quote *macros*) (cons (quote *os*) (cons (quote *release*) (cons (quote *property-vector*) (cons (quote *port*) (cons (quote *porters*) (cons (quote *hush*) (cons (quote _waspvm_at_v) (cons (quote _waspvm_at_p) (cons (quote _waspvm_at_s) (cons (quote <-) (cons (quote ->) (cons (quote ) (cons (quote ) (cons (quote ==) (cons (quote =) (cons (quote >=) (cons (quote >) (cons (quote /.) (cons (quote =!) (cons (quote _waspvm_dl_) (cons (quote -) (cons (quote /) (cons (quote *) (cons (quote +) (cons (quote <=) (cons (quote <) (cons (quote >>) (cons (kl:vector 0) (cons (quote y-or-n?) (cons (quote write-to-file) (cons (quote write-byte) (cons (quote where) (cons (quote when) (cons (quote warn) (cons (quote version) (cons (quote verified) (cons (quote variable?) (cons (quote value) (cons (quote vector->) (cons (quote <-vector) (cons (quote vector) (cons (quote vector?) (cons (quote unspecialise) (cons (quote untrack) (cons (quote unit) (cons (quote shen.unix) (cons (quote union) (cons (quote unify) (cons (quote unify!) (cons (quote unput) (cons (quote unprofile) (cons (quote undefmacro) (cons (quote return) (cons (quote type) (cons (quote tuple?) (cons #t (cons (quote trap-error) (cons (quote track) (cons (quote time) (cons (quote thaw) (cons (quote tc?) (cons (quote tc) (cons (quote tl) (cons (quote tlstr) (cons (quote tlv) (cons (quote tail) (cons (quote systemf) (cons (quote synonyms) (cons (quote symbol) (cons (quote symbol?) (cons (quote string->symbol) (cons (quote sum) (cons (quote subst) (cons (quote string?) (cons (quote string->n) (cons (quote stream) (cons (quote string) (cons (quote stinput) (cons (quote sterror) (cons (quote stoutput) (cons (quote step) (cons (quote spy) (cons (quote specialise) (cons (quote snd) (cons (quote simple-error) (cons (quote set) (cons (quote save) (cons (quote str) (cons (quote run) (cons (quote reverse) (cons (quote remove) (cons (quote release) (cons (quote read) (cons (quote receive) (cons (quote read-file) (cons (quote read-file-as-bytelist) (cons (quote read-file-as-string) (cons (quote read-byte) (cons (quote read-from-string) (cons (quote package?) (cons (quote put) (cons (quote preclude) (cons (quote preclude-all-but) (cons (quote ps) (cons (quote prolog?) (cons (quote protect) (cons (quote profile-results) (cons (quote profile) (cons (quote print) (cons (quote pr) (cons (quote pos) (cons (quote porters) (cons (quote port) (cons (quote package) (cons (quote output) (cons (quote out) (cons (quote os) (cons (quote or) (cons (quote optimise) (cons (quote open) (cons (quote occurrences) (cons (quote occurs-check) (cons (quote n->string) (cons (quote number?) (cons (quote number) (cons (quote null) (cons (quote nth) (cons (quote not) (cons (quote nl) (cons (quote mode) (cons (quote macroexpand) (cons (quote maxinferences) (cons (quote mapcan) (cons (quote map) (cons (quote make-string) (cons (quote load) (cons (quote loaded) (cons (quote list) (cons (quote lineread) (cons (quote limit) (cons (quote length) (cons (quote let) (cons (quote lazy) (cons (quote lambda) (cons (quote language) (cons (quote kill) (cons (quote is) (cons (quote intersection) (cons (quote inferences) (cons (quote intern) (cons (quote integer?) (cons (quote input) (cons (quote input+) (cons (quote include) (cons (quote include-all-but) (cons (quote it) (cons (quote in) (cons (quote internal) (cons (quote implementation) (cons (quote if) (cons (quote identical) (cons (quote head) (cons (quote hd) (cons (quote hdv) (cons (quote hdstr) (cons (quote hash) (cons (quote get) (cons (quote get-time) (cons (quote gensym) (cons (quote function) (cons (quote fst) (cons (quote freeze) (cons (quote fix) (cons (quote file) (cons (quote fail) (cons (quote fail-if) (cons (quote fwhen) (cons (quote findall) (cons #f (cons (quote enable-type-theory) (cons (quote explode) (cons (quote external) (cons (quote exception) (cons (quote eval-kl) (cons (quote eval) (cons (quote error-to-string) (cons (quote error) (cons (quote empty?) (cons (quote element?) (cons (quote do) (cons (quote difference) (cons (quote destroy) (cons (quote defun) (cons (quote define) (cons (quote defmacro) (cons (quote defcc) (cons (quote defprolog) (cons (quote declare) (cons (quote datatype) (cons (quote cut) (cons (quote cn) (cons (quote cons?) (cons (quote cons) (cons (quote cond) (cons (quote concat) (cons (quote compile) (cons (quote cd) (cons (quote cases) (cons (quote call) (cons (quote close) (cons (quote bind) (cons (quote bound?) (cons (quote boolean?) (cons (quote boolean) (cons (quote bar!) (cons (quote assoc) (cons (quote arity) (cons (quote abort) (cons (quote append) (cons (quote and) (cons (quote adjoin) (cons (quote <-address) (cons (quote address->) (cons (quote absvector?) (cons (quote absvector) (quote ()))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) (kl:value (quote *property-vector*))) -(begin (register-function-arity (quote shen.lambda-form-entry) 1) (define (kl:shen.lambda-form-entry V1482) (cond ((eq? (quote package) V1482) (quote ())) ((eq? (quote receive) V1482) (quote ())) (#t (let ((ArityF (kl:arity V1482))) (if (kl:= ArityF -1) (quote ()) (if (kl:= ArityF 0) (quote ()) (cons (cons V1482 (kl:eval-kl (kl:shen.lambda-form V1482 ArityF))) (quote ())))))))) (quote shen.lambda-form-entry)) -(begin (register-function-arity (quote shen.lambda-form) 2) (define (kl:shen.lambda-form V1485 V1486) (cond ((kl:= 0 V1486) V1485) (#t (let ((X (kl:gensym (quote V)))) (cons (quote lambda) (cons X (cons (kl:shen.lambda-form (kl:shen.add-end V1485 X) (- V1486 1)) (quote ())))))))) (quote shen.lambda-form)) -(begin (register-function-arity (quote shen.add-end) 2) (define (kl:shen.add-end V1489 V1490) (cond ((pair? V1489) (kl:append V1489 (cons V1490 (quote ())))) (#t (cons V1489 (cons V1490 (quote ())))))) (quote shen.add-end)) -(begin (register-function-arity (quote shen.set-lambda-form-entry) 1) (define (kl:shen.set-lambda-form-entry V1492) (cond ((pair? V1492) (kl:put (car V1492) (quote shen.lambda-form) (cdr V1492) (kl:value (quote *property-vector*)))) (#t (kl:shen.f_error (quote shen.set-lambda-form-entry))))) (quote shen.set-lambda-form-entry)) +(begin (register-function-arity (quote shen.lambda-form-entry) 1) (define (kl:shen.lambda-form-entry V1482) (cond ((eq? (quote package) V1482) (quote ())) ((eq? (quote receive) V1482) (quote ())) (#t (let ((ArityF (kl:arity V1482))) (if (kl:= ArityF -1) (quote ()) (if (kl:= ArityF 0) (quote ()) (cons (cons V1482 (kl:eval-kl (kl:shen.lambda-form V1482 ArityF))) (quote ())))))))) (export shen.lambda-form-entry) (quote shen.lambda-form-entry)) +(begin (register-function-arity (quote shen.lambda-form) 2) (define (kl:shen.lambda-form V1485 V1486) (cond ((kl:= 0 V1486) V1485) (#t (let ((X (kl:gensym (quote V)))) (cons (quote lambda) (cons X (cons (kl:shen.lambda-form (kl:shen.add-end V1485 X) (- V1486 1)) (quote ())))))))) (export shen.lambda-form) (quote shen.lambda-form)) +(begin (register-function-arity (quote shen.add-end) 2) (define (kl:shen.add-end V1489 V1490) (cond ((pair? V1489) (kl:append V1489 (cons V1490 (quote ())))) (#t (cons V1489 (cons V1490 (quote ())))))) (export shen.add-end) (quote shen.add-end)) +(begin (register-function-arity (quote shen.set-lambda-form-entry) 1) (define (kl:shen.set-lambda-form-entry V1492) (cond ((pair? V1492) (kl:put (car V1492) (quote shen.lambda-form) (cdr V1492) (kl:value (quote *property-vector*)))) (#t (kl:shen.f_error (quote shen.set-lambda-form-entry))))) (export shen.set-lambda-form-entry) (quote shen.set-lambda-form-entry)) (kl:shen.for-each (lambda (Entry) (kl:shen.set-lambda-form-entry Entry)) (cons (cons (quote shen.datatype-error) (lambda (X) (kl:shen.datatype-error X))) (cons (cons (quote shen.tuple) (lambda (X) (kl:shen.tuple X))) (cons (cons (quote shen.pvar) (lambda (X) (kl:shen.pvar X))) (cons (cons (quote shen.dictionary) (lambda (X) (kl:shen.dictionary X))) (kl:mapcan (lambda (X) (kl:shen.lambda-form-entry X)) (kl:external (kl:intern "shen")))))))) -(begin (register-function-arity (quote specialise) 1) (define (kl:specialise V1494) (begin (kl:set (quote shen.*special*) (cons V1494 (kl:value (quote shen.*special*)))) V1494)) (quote specialise)) -(begin (register-function-arity (quote unspecialise) 1) (define (kl:unspecialise V1496) (begin (kl:set (quote shen.*special*) (kl:remove V1496 (kl:value (quote shen.*special*)))) V1496)) (quote unspecialise)) +(begin (register-function-arity (quote specialise) 1) (define (kl:specialise V1494) (begin (kl:set (quote shen.*special*) (cons V1494 (kl:value (quote shen.*special*)))) V1494)) (export specialise) (quote specialise)) +(begin (register-function-arity (quote unspecialise) 1) (define (kl:unspecialise V1496) (begin (kl:set (quote shen.*special*) (kl:remove V1496 (kl:value (quote shen.*special*)))) V1496)) (export unspecialise) (quote unspecialise)) diff --git a/compiled/dict.kl.ms b/compiled/dict.kl.ms index 836e742..7af4a29 100644 --- a/compiled/dict.kl.ms +++ b/compiled/dict.kl.ms @@ -1,17 +1,18 @@ +(module "compiled/dict.kl") "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.dict) 1) (define (kl:shen.dict V3139) (cond ((< V3139 1) (simple-error (string-append "invalid initial dict size: " (kl:shen.app V3139 "" (quote shen.s))))) (#t (let ((D (make-vector (+ 3 V3139) (quote (quote shen.fail!))))) (let ((Tag (let ((_tmp D)) (vector-set! _tmp 0 (quote shen.dictionary)) _tmp))) (let ((Capacity (let ((_tmp D)) (vector-set! _tmp 1 V3139) _tmp))) (let ((Count (let ((_tmp D)) (vector-set! _tmp 2 0) _tmp))) (let ((Fill (kl:shen.fillvector D 3 (+ 2 V3139) (quote ())))) D)))))))) (quote shen.dict)) -(begin (register-function-arity (quote shen.dict?) 1) (define (kl:shen.dict? V3141) (and (vector? V3141) (eq? (guard (lambda (E) (quote shen.not-dictionary)) (vector-ref V3141 0)) (quote shen.dictionary)))) (quote shen.dict?)) -(begin (register-function-arity (quote shen.dict-capacity) 1) (define (kl:shen.dict-capacity V3143) (vector-ref V3143 1)) (quote shen.dict-capacity)) -(begin (register-function-arity (quote shen.dict-count) 1) (define (kl:shen.dict-count V3145) (vector-ref V3145 2)) (quote shen.dict-count)) -(begin (register-function-arity (quote shen.dict-count->) 2) (define (kl:shen.dict-count-> V3148 V3149) (let ((_tmp V3148)) (vector-set! _tmp 2 V3149) _tmp)) (quote shen.dict-count->)) -(begin (register-function-arity (quote shen.<-dict-bucket) 2) (define (kl:shen.<-dict-bucket V3152 V3153) (vector-ref V3152 (+ 3 V3153))) (quote shen.<-dict-bucket)) -(begin (register-function-arity (quote shen.dict-bucket->) 3) (define (kl:shen.dict-bucket-> V3157 V3158 V3159) (let ((_tmp V3157)) (vector-set! _tmp (+ 3 V3158) V3159) _tmp)) (quote shen.dict-bucket->)) -(begin (register-function-arity (quote shen.dict-update-count) 3) (define (kl:shen.dict-update-count V3163 V3164 V3165) (let ((Diff (- (kl:length V3165) (kl:length V3164)))) (kl:shen.dict-count-> V3163 (+ Diff (kl:shen.dict-count V3163))))) (quote shen.dict-update-count)) -(begin (register-function-arity (quote shen.dict->) 3) (define (kl:shen.dict-> V3169 V3170 V3171) (let ((N (kl:hash V3170 (kl:shen.dict-capacity V3169)))) (let ((Bucket (kl:shen.<-dict-bucket V3169 N))) (let ((NewBucket (kl:shen.assoc-set V3170 V3171 Bucket))) (let ((Change (kl:shen.dict-bucket-> V3169 N NewBucket))) (let ((Count (kl:shen.dict-update-count V3169 Bucket NewBucket))) V3171)))))) (quote shen.dict->)) -(begin (register-function-arity (quote shen.<-dict) 2) (define (kl:shen.<-dict V3174 V3175) (let ((N (kl:hash V3175 (kl:shen.dict-capacity V3174)))) (let ((Bucket (kl:shen.<-dict-bucket V3174 N))) (let ((Result (kl:assoc V3175 Bucket))) (if (kl:empty? Result) (simple-error (string-append "value " (kl:shen.app V3175 " not found in dict\n" (quote shen.a)))) (cdr Result)))))) (quote shen.<-dict)) -(begin (register-function-arity (quote shen.dict-rm) 2) (define (kl:shen.dict-rm V3178 V3179) (let ((N (kl:hash V3179 (kl:shen.dict-capacity V3178)))) (let ((Bucket (kl:shen.<-dict-bucket V3178 N))) (let ((NewBucket (kl:shen.assoc-rm V3179 Bucket))) (let ((Change (kl:shen.dict-bucket-> V3178 N NewBucket))) (let ((Count (kl:shen.dict-update-count V3178 Bucket NewBucket))) V3179)))))) (quote shen.dict-rm)) -(begin (register-function-arity (quote shen.dict-fold) 3) (define (kl:shen.dict-fold V3183 V3184 V3185) (let ((Limit (kl:shen.dict-capacity V3184))) (kl:shen.dict-fold-h V3183 V3184 V3185 0 Limit))) (quote shen.dict-fold)) -(begin (register-function-arity (quote shen.dict-fold-h) 5) (define (kl:shen.dict-fold-h V3192 V3193 V3194 V3195 V3196) (cond ((kl:= V3196 V3195) V3194) (#t (let ((B (kl:shen.<-dict-bucket V3193 V3195))) (let ((Acc (kl:shen.bucket-fold V3192 B V3194))) (kl:shen.dict-fold-h V3192 V3193 Acc (+ 1 V3195) V3196)))))) (quote shen.dict-fold-h)) -(begin (register-function-arity (quote shen.bucket-fold) 3) (define (kl:shen.bucket-fold V3200 V3201 V3202) (cond ((null? V3201) V3202) ((and (pair? V3201) (pair? (car V3201))) (((V3200 (car (car V3201))) (cdr (car V3201))) (kl:shen.bucket-fold V3200 (cdr V3201) V3202))) (#t (kl:shen.f_error (quote shen.bucket-fold))))) (quote shen.bucket-fold)) -(begin (register-function-arity (quote shen.dict-keys) 1) (define (kl:shen.dict-keys V3204) (kl:shen.dict-fold (lambda (K) (lambda (_) (lambda (Acc) (cons K Acc)))) V3204 (quote ()))) (quote shen.dict-keys)) -(begin (register-function-arity (quote shen.dict-values) 1) (define (kl:shen.dict-values V3206) (kl:shen.dict-fold (lambda (_) (lambda (V) (lambda (Acc) (cons V Acc)))) V3206 (quote ()))) (quote shen.dict-values)) +(begin (register-function-arity (quote shen.dict) 1) (define (kl:shen.dict V3139) (cond ((< V3139 1) (simple-error (string-append "invalid initial dict size: " (kl:shen.app V3139 "" (quote shen.s))))) (#t (let ((D (make-vector (+ 3 V3139) (quote (quote shen.fail!))))) (let ((Tag (let ((_tmp D)) (vector-set! _tmp 0 (quote shen.dictionary)) _tmp))) (let ((Capacity (let ((_tmp D)) (vector-set! _tmp 1 V3139) _tmp))) (let ((Count (let ((_tmp D)) (vector-set! _tmp 2 0) _tmp))) (let ((Fill (kl:shen.fillvector D 3 (+ 2 V3139) (quote ())))) D)))))))) (export shen.dict) (quote shen.dict)) +(begin (register-function-arity (quote shen.dict?) 1) (define (kl:shen.dict? V3141) (and (vector? V3141) (eq? (guard (lambda (E) (quote shen.not-dictionary)) (vector-ref V3141 0)) (quote shen.dictionary)))) (export shen.dict?) (quote shen.dict?)) +(begin (register-function-arity (quote shen.dict-capacity) 1) (define (kl:shen.dict-capacity V3143) (vector-ref V3143 1)) (export shen.dict-capacity) (quote shen.dict-capacity)) +(begin (register-function-arity (quote shen.dict-count) 1) (define (kl:shen.dict-count V3145) (vector-ref V3145 2)) (export shen.dict-count) (quote shen.dict-count)) +(begin (register-function-arity (quote shen.dict-count->) 2) (define (kl:shen.dict-count-> V3148 V3149) (let ((_tmp V3148)) (vector-set! _tmp 2 V3149) _tmp)) (export shen.dict-count->) (quote shen.dict-count->)) +(begin (register-function-arity (quote shen.<-dict-bucket) 2) (define (kl:shen.<-dict-bucket V3152 V3153) (vector-ref V3152 (+ 3 V3153))) (export shen.<-dict-bucket) (quote shen.<-dict-bucket)) +(begin (register-function-arity (quote shen.dict-bucket->) 3) (define (kl:shen.dict-bucket-> V3157 V3158 V3159) (let ((_tmp V3157)) (vector-set! _tmp (+ 3 V3158) V3159) _tmp)) (export shen.dict-bucket->) (quote shen.dict-bucket->)) +(begin (register-function-arity (quote shen.dict-update-count) 3) (define (kl:shen.dict-update-count V3163 V3164 V3165) (let ((Diff (- (kl:length V3165) (kl:length V3164)))) (kl:shen.dict-count-> V3163 (+ Diff (kl:shen.dict-count V3163))))) (export shen.dict-update-count) (quote shen.dict-update-count)) +(begin (register-function-arity (quote shen.dict->) 3) (define (kl:shen.dict-> V3169 V3170 V3171) (let ((N (kl:hash V3170 (kl:shen.dict-capacity V3169)))) (let ((Bucket (kl:shen.<-dict-bucket V3169 N))) (let ((NewBucket (kl:shen.assoc-set V3170 V3171 Bucket))) (let ((Change (kl:shen.dict-bucket-> V3169 N NewBucket))) (let ((Count (kl:shen.dict-update-count V3169 Bucket NewBucket))) V3171)))))) (export shen.dict->) (quote shen.dict->)) +(begin (register-function-arity (quote shen.<-dict) 2) (define (kl:shen.<-dict V3174 V3175) (let ((N (kl:hash V3175 (kl:shen.dict-capacity V3174)))) (let ((Bucket (kl:shen.<-dict-bucket V3174 N))) (let ((Result (kl:assoc V3175 Bucket))) (if (kl:empty? Result) (simple-error (string-append "value " (kl:shen.app V3175 " not found in dict\n" (quote shen.a)))) (cdr Result)))))) (export shen.<-dict) (quote shen.<-dict)) +(begin (register-function-arity (quote shen.dict-rm) 2) (define (kl:shen.dict-rm V3178 V3179) (let ((N (kl:hash V3179 (kl:shen.dict-capacity V3178)))) (let ((Bucket (kl:shen.<-dict-bucket V3178 N))) (let ((NewBucket (kl:shen.assoc-rm V3179 Bucket))) (let ((Change (kl:shen.dict-bucket-> V3178 N NewBucket))) (let ((Count (kl:shen.dict-update-count V3178 Bucket NewBucket))) V3179)))))) (export shen.dict-rm) (quote shen.dict-rm)) +(begin (register-function-arity (quote shen.dict-fold) 3) (define (kl:shen.dict-fold V3183 V3184 V3185) (let ((Limit (kl:shen.dict-capacity V3184))) (kl:shen.dict-fold-h V3183 V3184 V3185 0 Limit))) (export shen.dict-fold) (quote shen.dict-fold)) +(begin (register-function-arity (quote shen.dict-fold-h) 5) (define (kl:shen.dict-fold-h V3192 V3193 V3194 V3195 V3196) (cond ((kl:= V3196 V3195) V3194) (#t (let ((B (kl:shen.<-dict-bucket V3193 V3195))) (let ((Acc (kl:shen.bucket-fold V3192 B V3194))) (kl:shen.dict-fold-h V3192 V3193 Acc (+ 1 V3195) V3196)))))) (export shen.dict-fold-h) (quote shen.dict-fold-h)) +(begin (register-function-arity (quote shen.bucket-fold) 3) (define (kl:shen.bucket-fold V3200 V3201 V3202) (cond ((null? V3201) V3202) ((and (pair? V3201) (pair? (car V3201))) (((V3200 (car (car V3201))) (cdr (car V3201))) (kl:shen.bucket-fold V3200 (cdr V3201) V3202))) (#t (kl:shen.f_error (quote shen.bucket-fold))))) (export shen.bucket-fold) (quote shen.bucket-fold)) +(begin (register-function-arity (quote shen.dict-keys) 1) (define (kl:shen.dict-keys V3204) (kl:shen.dict-fold (lambda (K) (lambda (_) (lambda (Acc) (cons K Acc)))) V3204 (quote ()))) (export shen.dict-keys) (quote shen.dict-keys)) +(begin (register-function-arity (quote shen.dict-values) 1) (define (kl:shen.dict-values V3206) (kl:shen.dict-fold (lambda (_) (lambda (V) (lambda (Acc) (cons V Acc)))) V3206 (quote ()))) (export shen.dict-values) (quote shen.dict-values)) diff --git a/compiled/load.kl.ms b/compiled/load.kl.ms index bd0befb..62ca918 100644 --- a/compiled/load.kl.ms +++ b/compiled/load.kl.ms @@ -1,12 +1,13 @@ +(module "compiled/load.kl") "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)) (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. 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.) 1) (define (kl:shen. V1539) (let ((Parse_shen. (kl:shen. V1539))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_ (kl: Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_)) (kl:shen.pair (car Parse_) (kl:shen.hdtl Parse_shen.)) (kl:fail))) (kl:fail)))) (quote shen.)) -(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)) +(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)))) (export load) (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)) (kl:shen.for-each (lambda (X) (kl:shen.typecheck-and-load X)) RemoveSynonyms)))))))) (export shen.load-help) (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 ()))))) (export shen.remove-synonyms) (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))))) (export shen.typecheck-and-load) (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. 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 ())))) (export shen.typetable) (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))))) (export 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))))) (export 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*))))) (export shen.remtype) (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))))) (export shen.removetype) (quote shen.removetype)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1539) (let ((Parse_shen. (kl:shen. V1539))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_ (kl: Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_)) (kl:shen.pair (car Parse_) (kl:shen.hdtl Parse_shen.)) (kl:fail))) (kl:fail)))) (export shen.) (quote shen.)) +(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))))) (export write-to-file) (quote write-to-file)) diff --git a/compiled/macros.kl.ms b/compiled/macros.kl.ms index be848d8..63415e9 100644 --- a/compiled/macros.kl.ms +++ b/compiled/macros.kl.ms @@ -1,32 +1,33 @@ +(module "compiled/macros.kl") "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 macroexpand) 1) (define (kl:macroexpand V1545) (let ((Y (kl:shen.compose (kl:value (quote *macros*)) V1545))) (if (kl:= V1545 Y) V1545 (kl:shen.walk (lambda (Z) (kl:macroexpand Z)) Y)))) (quote macroexpand)) -(begin (register-function-arity (quote shen.error-macro) 1) (define (kl:shen.error-macro V1547) (cond ((and (pair? V1547) (and (eq? (quote error) (car V1547)) (pair? (cdr V1547)))) (cons (quote simple-error) (cons (kl:shen.mkstr (car (cdr V1547)) (cdr (cdr V1547))) (quote ())))) (#t V1547))) (quote shen.error-macro)) -(begin (register-function-arity (quote shen.output-macro) 1) (define (kl:shen.output-macro V1549) (cond ((and (pair? V1549) (and (eq? (quote output) (car V1549)) (pair? (cdr V1549)))) (cons (quote shen.prhush) (cons (kl:shen.mkstr (car (cdr V1549)) (cdr (cdr V1549))) (cons (cons (quote stoutput) (quote ())) (quote ()))))) ((and (pair? V1549) (and (eq? (quote pr) (car V1549)) (and (pair? (cdr V1549)) (null? (cdr (cdr V1549)))))) (cons (quote pr) (cons (car (cdr V1549)) (cons (cons (quote stoutput) (quote ())) (quote ()))))) (#t V1549))) (quote shen.output-macro)) -(begin (register-function-arity (quote shen.make-string-macro) 1) (define (kl:shen.make-string-macro V1551) (cond ((and (pair? V1551) (and (eq? (quote make-string) (car V1551)) (pair? (cdr V1551)))) (kl:shen.mkstr (car (cdr V1551)) (cdr (cdr V1551)))) (#t V1551))) (quote shen.make-string-macro)) -(begin (register-function-arity (quote shen.input-macro) 1) (define (kl:shen.input-macro V1553) (cond ((and (pair? V1553) (and (eq? (quote lineread) (car V1553)) (null? (cdr V1553)))) (cons (quote lineread) (cons (cons (quote stinput) (quote ())) (quote ())))) ((and (pair? V1553) (and (eq? (quote input) (car V1553)) (null? (cdr V1553)))) (cons (quote input) (cons (cons (quote stinput) (quote ())) (quote ())))) ((and (pair? V1553) (and (eq? (quote read) (car V1553)) (null? (cdr V1553)))) (cons (quote read) (cons (cons (quote stinput) (quote ())) (quote ())))) ((and (pair? V1553) (and (eq? (quote input+) (car V1553)) (and (pair? (cdr V1553)) (null? (cdr (cdr V1553)))))) (cons (quote input+) (cons (car (cdr V1553)) (cons (cons (quote stinput) (quote ())) (quote ()))))) ((and (pair? V1553) (and (eq? (quote read-byte) (car V1553)) (null? (cdr V1553)))) (cons (quote read-byte) (cons (cons (quote stinput) (quote ())) (quote ())))) (#t V1553))) (quote shen.input-macro)) -(begin (register-function-arity (quote shen.compose) 2) (define (kl:shen.compose V1556 V1557) (cond ((null? V1556) V1557) ((pair? V1556) (kl:shen.compose (cdr V1556) ((car V1556) V1557))) (#t (kl:shen.f_error (quote shen.compose))))) (quote shen.compose)) -(begin (register-function-arity (quote shen.compile-macro) 1) (define (kl:shen.compile-macro V1559) (cond ((and (pair? V1559) (and (eq? (quote compile) (car V1559)) (and (pair? (cdr V1559)) (and (pair? (cdr (cdr V1559))) (null? (cdr (cdr (cdr V1559)))))))) (cons (quote compile) (cons (car (cdr V1559)) (cons (car (cdr (cdr V1559))) (cons (cons (quote lambda) (cons (quote E) (cons (cons (quote if) (cons (cons (quote cons?) (cons (quote E) (quote ()))) (cons (cons (quote error) (cons "parse error here: ~S~%" (cons (quote E) (quote ())))) (cons (cons (quote error) (cons "parse error~%" (quote ()))) (quote ()))))) (quote ())))) (quote ())))))) (#t V1559))) (quote shen.compile-macro)) -(begin (register-function-arity (quote shen.prolog-macro) 1) (define (kl:shen.prolog-macro V1561) (cond ((and (pair? V1561) (eq? (quote prolog?) (car V1561))) (cons (quote let) (cons (quote NPP) (cons (cons (quote shen.start-new-prolog-process) (quote ())) (cons (let ((Calls (kl:shen.bld-prolog-call (quote NPP) (cdr V1561)))) (let ((Vs (kl:shen.extract_vars (cdr V1561)))) (let ((External (kl:shen.externally-bound (cdr V1561)))) (let ((PrologVs (kl:difference Vs External))) (kl:shen.locally-bind-prolog-vs (quote NPP) PrologVs Calls))))) (quote ())))))) (#t V1561))) (quote shen.prolog-macro)) -(begin (register-function-arity (quote shen.externally-bound) 1) (define (kl:shen.externally-bound V1567) (cond ((and (pair? V1567) (and (eq? (quote receive) (car V1567)) (and (pair? (cdr V1567)) (null? (cdr (cdr V1567)))))) (cdr V1567)) ((pair? V1567) (kl:union (kl:shen.externally-bound (car V1567)) (kl:shen.externally-bound (cdr V1567)))) (#t (quote ())))) (quote shen.externally-bound)) -(begin (register-function-arity (quote shen.locally-bind-prolog-vs) 3) (define (kl:shen.locally-bind-prolog-vs V1585 V1586 V1587) (cond ((null? V1586) V1587) ((pair? V1586) (cons (quote let) (cons (car V1586) (cons (cons (quote shen.newpv) (cons V1585 (quote ()))) (cons (kl:shen.locally-bind-prolog-vs V1585 (cdr V1586) V1587) (quote ())))))) (#t (simple-error "implementation error inp locally-bind-prolog-vs")))) (quote shen.locally-bind-prolog-vs)) -(begin (register-function-arity (quote shen.bld-prolog-call) 2) (define (kl:shen.bld-prolog-call V1600 V1601) (cond ((null? V1601) #t) ((and (pair? V1601) (eq? (quote !) (car V1601))) (cons (quote cut) (cons #f (cons V1600 (cons (cons (quote freeze) (cons (kl:shen.bld-prolog-call V1600 (cdr V1601)) (quote ()))) (quote ())))))) ((and (pair? V1601) (and (pair? (car V1601)) (and (eq? (quote when) (car (car V1601))) (and (pair? (cdr (car V1601))) (null? (cdr (cdr (car V1601)))))))) (cons (quote fwhen) (cons (kl:shen.insert-deref (car (cdr (car V1601))) V1600) (cons V1600 (cons (cons (quote freeze) (cons (kl:shen.bld-prolog-call V1600 (cdr V1601)) (quote ()))) (quote ())))))) ((and (pair? V1601) (and (pair? (car V1601)) (and (eq? (quote is) (car (car V1601))) (and (pair? (cdr (car V1601))) (and (pair? (cdr (cdr (car V1601)))) (null? (cdr (cdr (cdr (car V1601)))))))))) (cons (quote bind) (cons (car (cdr (car V1601))) (cons (kl:shen.insert-deref (car (cdr (cdr (car V1601)))) V1600) (cons V1600 (cons (cons (quote freeze) (cons (kl:shen.bld-prolog-call V1600 (cdr V1601)) (quote ()))) (quote ()))))))) ((and (pair? V1601) (and (pair? (car V1601)) (and (eq? (quote receive) (car (car V1601))) (and (pair? (cdr (car V1601))) (null? (cdr (cdr (car V1601)))))))) (kl:shen.bld-prolog-call V1600 (cdr V1601))) ((and (pair? V1601) (and (pair? (car V1601)) (and (eq? (quote bind) (car (car V1601))) (and (pair? (cdr (car V1601))) (and (pair? (cdr (cdr (car V1601)))) (null? (cdr (cdr (cdr (car V1601)))))))))) (cons (quote bind) (cons (car (cdr (car V1601))) (cons (kl:shen.insert-lazyderef (car (cdr (cdr (car V1601)))) V1600) (cons V1600 (cons (cons (quote freeze) (cons (kl:shen.bld-prolog-call V1600 (cdr V1601)) (quote ()))) (quote ()))))))) ((and (pair? V1601) (and (pair? (car V1601)) (and (eq? (quote fwhen) (car (car V1601))) (and (pair? (cdr (car V1601))) (null? (cdr (cdr (car V1601)))))))) (cons (quote fwhen) (cons (kl:shen.insert-lazyderef (car (cdr (car V1601))) V1600) (cons V1600 (cons (cons (quote freeze) (cons (kl:shen.bld-prolog-call V1600 (cdr V1601)) (quote ()))) (quote ())))))) ((pair? V1601) (kl:append (car V1601) (cons V1600 (cons (cons (quote freeze) (cons (kl:shen.bld-prolog-call V1600 (cdr V1601)) (quote ()))) (quote ()))))) (#t (simple-error "implementation error in bld-prolog-call")))) (quote shen.bld-prolog-call)) -(begin (register-function-arity (quote shen.defprolog-macro) 1) (define (kl:shen.defprolog-macro V1603) (cond ((and (pair? V1603) (and (eq? (quote defprolog) (car V1603)) (pair? (cdr V1603)))) (kl:compile (lambda (Y) (kl:shen. Y)) (cdr V1603) (lambda (Y) (kl:shen.prolog-error (car (cdr V1603)) Y)))) (#t V1603))) (quote shen.defprolog-macro)) -(begin (register-function-arity (quote shen.datatype-macro) 1) (define (kl:shen.datatype-macro V1605) (cond ((and (pair? V1605) (and (eq? (quote datatype) (car V1605)) (pair? (cdr V1605)))) (cons (quote shen.process-datatype) (cons (kl:shen.intern-type (car (cdr V1605))) (cons (cons (quote compile) (cons (cons (quote lambda) (cons (quote X) (cons (cons (quote shen.) (cons (quote X) (quote ()))) (quote ())))) (cons (kl:shen.rcons_form (cdr (cdr V1605))) (cons (cons (quote function) (cons (quote shen.datatype-error) (quote ()))) (quote ()))))) (quote ()))))) (#t V1605))) (quote shen.datatype-macro)) -(begin (register-function-arity (quote shen.intern-type) 1) (define (kl:shen.intern-type V1607) (kl:intern (string-append "type#" (kl:str V1607)))) (quote shen.intern-type)) -(begin (register-function-arity (quote shen._waspvm_at_s-macro) 1) (define (kl:shen._waspvm_at_s-macro V1609) (cond ((and (pair? V1609) (and (eq? (quote _waspvm_at_s) (car V1609)) (and (pair? (cdr V1609)) (and (pair? (cdr (cdr V1609))) (pair? (cdr (cdr (cdr V1609)))))))) (cons (quote _waspvm_at_s) (cons (car (cdr V1609)) (cons (kl:shen._waspvm_at_s-macro (cons (quote _waspvm_at_s) (cdr (cdr V1609)))) (quote ()))))) ((and (pair? V1609) (and (eq? (quote _waspvm_at_s) (car V1609)) (and (pair? (cdr V1609)) (and (pair? (cdr (cdr V1609))) (and (null? (cdr (cdr (cdr V1609)))) (string? (car (cdr V1609)))))))) (let ((E (kl:explode (car (cdr V1609))))) (if (> (kl:length E) 1) (kl:shen._waspvm_at_s-macro (cons (quote _waspvm_at_s) (kl:append E (cdr (cdr V1609))))) V1609))) (#t V1609))) (quote shen._waspvm_at_s-macro)) -(begin (register-function-arity (quote shen.synonyms-macro) 1) (define (kl:shen.synonyms-macro V1611) (cond ((and (pair? V1611) (eq? (quote synonyms) (car V1611))) (cons (quote shen.synonyms-help) (cons (kl:shen.rcons_form (kl:shen.curry-synonyms (cdr V1611))) (quote ())))) (#t V1611))) (quote shen.synonyms-macro)) -(begin (register-function-arity (quote shen.curry-synonyms) 1) (define (kl:shen.curry-synonyms V1613) (kl:map (lambda (X) (kl:shen.curry-type X)) V1613)) (quote shen.curry-synonyms)) -(begin (register-function-arity (quote shen.nl-macro) 1) (define (kl:shen.nl-macro V1615) (cond ((and (pair? V1615) (and (eq? (quote nl) (car V1615)) (null? (cdr V1615)))) (cons (quote nl) (cons 1 (quote ())))) (#t V1615))) (quote shen.nl-macro)) -(begin (register-function-arity (quote shen.assoc-macro) 1) (define (kl:shen.assoc-macro V1617) (cond ((and (pair? V1617) (and (pair? (cdr V1617)) (and (pair? (cdr (cdr V1617))) (and (pair? (cdr (cdr (cdr V1617)))) (kl:element? (car V1617) (cons (quote _waspvm_at_p) (cons (quote _waspvm_at_v) (cons (quote append) (cons (quote and) (cons (quote or) (cons (quote +) (cons (quote *) (cons (quote do) (quote ())))))))))))))) (cons (car V1617) (cons (car (cdr V1617)) (cons (kl:shen.assoc-macro (cons (car V1617) (cdr (cdr V1617)))) (quote ()))))) (#t V1617))) (quote shen.assoc-macro)) -(begin (register-function-arity (quote shen.let-macro) 1) (define (kl:shen.let-macro V1619) (cond ((and (pair? V1619) (and (eq? (quote let) (car V1619)) (and (pair? (cdr V1619)) (and (pair? (cdr (cdr V1619))) (and (pair? (cdr (cdr (cdr V1619)))) (pair? (cdr (cdr (cdr (cdr V1619)))))))))) (cons (quote let) (cons (car (cdr V1619)) (cons (car (cdr (cdr V1619))) (cons (kl:shen.let-macro (cons (quote let) (cdr (cdr (cdr V1619))))) (quote ())))))) (#t V1619))) (quote shen.let-macro)) -(begin (register-function-arity (quote shen.abs-macro) 1) (define (kl:shen.abs-macro V1621) (cond ((and (pair? V1621) (and (eq? (quote /.) (car V1621)) (and (pair? (cdr V1621)) (and (pair? (cdr (cdr V1621))) (pair? (cdr (cdr (cdr V1621)))))))) (cons (quote lambda) (cons (car (cdr V1621)) (cons (kl:shen.abs-macro (cons (quote /.) (cdr (cdr V1621)))) (quote ()))))) ((and (pair? V1621) (and (eq? (quote /.) (car V1621)) (and (pair? (cdr V1621)) (and (pair? (cdr (cdr V1621))) (null? (cdr (cdr (cdr V1621)))))))) (cons (quote lambda) (cdr V1621))) (#t V1621))) (quote shen.abs-macro)) -(begin (register-function-arity (quote shen.cases-macro) 1) (define (kl:shen.cases-macro V1625) (cond ((and (pair? V1625) (and (eq? (quote cases) (car V1625)) (and (pair? (cdr V1625)) (and (kl:= #t (car (cdr V1625))) (pair? (cdr (cdr V1625))))))) (car (cdr (cdr V1625)))) ((and (pair? V1625) (and (eq? (quote cases) (car V1625)) (and (pair? (cdr V1625)) (and (pair? (cdr (cdr V1625))) (null? (cdr (cdr (cdr V1625)))))))) (cons (quote if) (cons (car (cdr V1625)) (cons (car (cdr (cdr V1625))) (cons (cons (quote simple-error) (cons "error: cases exhausted" (quote ()))) (quote ())))))) ((and (pair? V1625) (and (eq? (quote cases) (car V1625)) (and (pair? (cdr V1625)) (pair? (cdr (cdr V1625)))))) (cons (quote if) (cons (car (cdr V1625)) (cons (car (cdr (cdr V1625))) (cons (kl:shen.cases-macro (cons (quote cases) (cdr (cdr (cdr V1625))))) (quote ())))))) ((and (pair? V1625) (and (eq? (quote cases) (car V1625)) (and (pair? (cdr V1625)) (null? (cdr (cdr V1625)))))) (simple-error "error: odd number of case elements\n")) (#t V1625))) (quote shen.cases-macro)) -(begin (register-function-arity (quote shen.timer-macro) 1) (define (kl:shen.timer-macro V1627) (cond ((and (pair? V1627) (and (eq? (quote time) (car V1627)) (and (pair? (cdr V1627)) (null? (cdr (cdr V1627)))))) (kl:shen.let-macro (cons (quote let) (cons (quote Start) (cons (cons (quote get-time) (cons (quote run) (quote ()))) (cons (quote Result) (cons (car (cdr V1627)) (cons (quote Finish) (cons (cons (quote get-time) (cons (quote run) (quote ()))) (cons (quote Time) (cons (cons (quote -) (cons (quote Finish) (cons (quote Start) (quote ())))) (cons (quote Message) (cons (cons (quote shen.prhush) (cons (cons (quote cn) (cons "\nrun time: " (cons (cons (quote cn) (cons (cons (quote str) (cons (quote Time) (quote ()))) (cons " secs\n" (quote ())))) (quote ())))) (cons (cons (quote stoutput) (quote ())) (quote ())))) (cons (quote Result) (quote ()))))))))))))))) (#t V1627))) (quote shen.timer-macro)) -(begin (register-function-arity (quote shen.tuple-up) 1) (define (kl:shen.tuple-up V1629) (cond ((pair? V1629) (cons (quote _waspvm_at_p) (cons (car V1629) (cons (kl:shen.tuple-up (cdr V1629)) (quote ()))))) (#t V1629))) (quote shen.tuple-up)) -(begin (register-function-arity (quote shen.put/get-macro) 1) (define (kl:shen.put/get-macro V1631) (cond ((and (pair? V1631) (and (eq? (quote put) (car V1631)) (and (pair? (cdr V1631)) (and (pair? (cdr (cdr V1631))) (and (pair? (cdr (cdr (cdr V1631)))) (null? (cdr (cdr (cdr (cdr V1631)))))))))) (cons (quote put) (cons (car (cdr V1631)) (cons (car (cdr (cdr V1631))) (cons (car (cdr (cdr (cdr V1631)))) (cons (cons (quote value) (cons (quote *property-vector*) (quote ()))) (quote ()))))))) ((and (pair? V1631) (and (eq? (quote get) (car V1631)) (and (pair? (cdr V1631)) (and (pair? (cdr (cdr V1631))) (null? (cdr (cdr (cdr V1631)))))))) (cons (quote get) (cons (car (cdr V1631)) (cons (car (cdr (cdr V1631))) (cons (cons (quote value) (cons (quote *property-vector*) (quote ()))) (quote ())))))) ((and (pair? V1631) (and (eq? (quote unput) (car V1631)) (and (pair? (cdr V1631)) (and (pair? (cdr (cdr V1631))) (null? (cdr (cdr (cdr V1631)))))))) (cons (quote unput) (cons (car (cdr V1631)) (cons (car (cdr (cdr V1631))) (cons (cons (quote value) (cons (quote *property-vector*) (quote ()))) (quote ())))))) (#t V1631))) (quote shen.put/get-macro)) -(begin (register-function-arity (quote shen.function-macro) 1) (define (kl:shen.function-macro V1633) (cond ((and (pair? V1633) (and (eq? (quote function) (car V1633)) (and (pair? (cdr V1633)) (null? (cdr (cdr V1633)))))) (kl:shen.function-abstraction (car (cdr V1633)) (kl:arity (car (cdr V1633))))) (#t V1633))) (quote shen.function-macro)) -(begin (register-function-arity (quote shen.function-abstraction) 2) (define (kl:shen.function-abstraction V1636 V1637) (cond ((kl:= 0 V1637) (simple-error (kl:shen.app V1636 " has no lambda form\n" (quote shen.a)))) ((kl:= -1 V1637) (cons (quote function) (cons V1636 (quote ())))) (#t (kl:shen.function-abstraction-help V1636 V1637 (quote ()))))) (quote shen.function-abstraction)) -(begin (register-function-arity (quote shen.function-abstraction-help) 3) (define (kl:shen.function-abstraction-help V1641 V1642 V1643) (cond ((kl:= 0 V1642) (cons V1641 V1643)) (#t (let ((X (kl:gensym (quote V)))) (cons (quote /.) (cons X (cons (kl:shen.function-abstraction-help V1641 (- V1642 1) (kl:append V1643 (cons X (quote ())))) (quote ())))))))) (quote shen.function-abstraction-help)) -(begin (register-function-arity (quote undefmacro) 1) (define (kl:undefmacro V1645) (let ((MacroReg (kl:value (quote shen.*macroreg*)))) (let ((Pos (kl:shen.findpos V1645 MacroReg))) (let ((Remove1 (kl:set (quote shen.*macroreg*) (kl:remove V1645 MacroReg)))) (let ((Remove2 (kl:set (quote *macros*) (kl:shen.remove-nth Pos (kl:value (quote *macros*)))))) V1645))))) (quote undefmacro)) -(begin (register-function-arity (quote shen.findpos) 2) (define (kl:shen.findpos V1655 V1656) (cond ((null? V1656) (simple-error (kl:shen.app V1655 " is not a macro\n" (quote shen.a)))) ((and (pair? V1656) (kl:= (car V1656) V1655)) 1) ((pair? V1656) (+ 1 (kl:shen.findpos V1655 (cdr V1656)))) (#t (kl:shen.f_error (quote shen.findpos))))) (quote shen.findpos)) -(begin (register-function-arity (quote shen.remove-nth) 2) (define (kl:shen.remove-nth V1661 V1662) (cond ((and (kl:= 1 V1661) (pair? V1662)) (cdr V1662)) ((pair? V1662) (cons (car V1662) (kl:shen.remove-nth (- V1661 1) (cdr V1662)))) (#t (kl:shen.f_error (quote shen.remove-nth))))) (quote shen.remove-nth)) +(begin (register-function-arity (quote macroexpand) 1) (define (kl:macroexpand V1545) (let ((Y (kl:shen.compose (kl:value (quote *macros*)) V1545))) (if (kl:= V1545 Y) V1545 (kl:shen.walk (lambda (Z) (kl:macroexpand Z)) Y)))) (export macroexpand) (quote macroexpand)) +(begin (register-function-arity (quote shen.error-macro) 1) (define (kl:shen.error-macro V1547) (cond ((and (pair? V1547) (and (eq? (quote error) (car V1547)) (pair? (cdr V1547)))) (cons (quote simple-error) (cons (kl:shen.mkstr (car (cdr V1547)) (cdr (cdr V1547))) (quote ())))) (#t V1547))) (export shen.error-macro) (quote shen.error-macro)) +(begin (register-function-arity (quote shen.output-macro) 1) (define (kl:shen.output-macro V1549) (cond ((and (pair? V1549) (and (eq? (quote output) (car V1549)) (pair? (cdr V1549)))) (cons (quote shen.prhush) (cons (kl:shen.mkstr (car (cdr V1549)) (cdr (cdr V1549))) (cons (cons (quote stoutput) (quote ())) (quote ()))))) ((and (pair? V1549) (and (eq? (quote pr) (car V1549)) (and (pair? (cdr V1549)) (null? (cdr (cdr V1549)))))) (cons (quote pr) (cons (car (cdr V1549)) (cons (cons (quote stoutput) (quote ())) (quote ()))))) (#t V1549))) (export shen.output-macro) (quote shen.output-macro)) +(begin (register-function-arity (quote shen.make-string-macro) 1) (define (kl:shen.make-string-macro V1551) (cond ((and (pair? V1551) (and (eq? (quote make-string) (car V1551)) (pair? (cdr V1551)))) (kl:shen.mkstr (car (cdr V1551)) (cdr (cdr V1551)))) (#t V1551))) (export shen.make-string-macro) (quote shen.make-string-macro)) +(begin (register-function-arity (quote shen.input-macro) 1) (define (kl:shen.input-macro V1553) (cond ((and (pair? V1553) (and (eq? (quote lineread) (car V1553)) (null? (cdr V1553)))) (cons (quote lineread) (cons (cons (quote stinput) (quote ())) (quote ())))) ((and (pair? V1553) (and (eq? (quote input) (car V1553)) (null? (cdr V1553)))) (cons (quote input) (cons (cons (quote stinput) (quote ())) (quote ())))) ((and (pair? V1553) (and (eq? (quote read) (car V1553)) (null? (cdr V1553)))) (cons (quote read) (cons (cons (quote stinput) (quote ())) (quote ())))) ((and (pair? V1553) (and (eq? (quote input+) (car V1553)) (and (pair? (cdr V1553)) (null? (cdr (cdr V1553)))))) (cons (quote input+) (cons (car (cdr V1553)) (cons (cons (quote stinput) (quote ())) (quote ()))))) ((and (pair? V1553) (and (eq? (quote read-byte) (car V1553)) (null? (cdr V1553)))) (cons (quote read-byte) (cons (cons (quote stinput) (quote ())) (quote ())))) (#t V1553))) (export shen.input-macro) (quote shen.input-macro)) +(begin (register-function-arity (quote shen.compose) 2) (define (kl:shen.compose V1556 V1557) (cond ((null? V1556) V1557) ((pair? V1556) (kl:shen.compose (cdr V1556) ((car V1556) V1557))) (#t (kl:shen.f_error (quote shen.compose))))) (export shen.compose) (quote shen.compose)) +(begin (register-function-arity (quote shen.compile-macro) 1) (define (kl:shen.compile-macro V1559) (cond ((and (pair? V1559) (and (eq? (quote compile) (car V1559)) (and (pair? (cdr V1559)) (and (pair? (cdr (cdr V1559))) (null? (cdr (cdr (cdr V1559)))))))) (cons (quote compile) (cons (car (cdr V1559)) (cons (car (cdr (cdr V1559))) (cons (cons (quote lambda) (cons (quote E) (cons (cons (quote if) (cons (cons (quote cons?) (cons (quote E) (quote ()))) (cons (cons (quote error) (cons "parse error here: ~S~%" (cons (quote E) (quote ())))) (cons (cons (quote error) (cons "parse error~%" (quote ()))) (quote ()))))) (quote ())))) (quote ())))))) (#t V1559))) (export shen.compile-macro) (quote shen.compile-macro)) +(begin (register-function-arity (quote shen.prolog-macro) 1) (define (kl:shen.prolog-macro V1561) (cond ((and (pair? V1561) (eq? (quote prolog?) (car V1561))) (cons (quote let) (cons (quote NPP) (cons (cons (quote shen.start-new-prolog-process) (quote ())) (cons (let ((Calls (kl:shen.bld-prolog-call (quote NPP) (cdr V1561)))) (let ((Vs (kl:shen.extract_vars (cdr V1561)))) (let ((External (kl:shen.externally-bound (cdr V1561)))) (let ((PrologVs (kl:difference Vs External))) (kl:shen.locally-bind-prolog-vs (quote NPP) PrologVs Calls))))) (quote ())))))) (#t V1561))) (export shen.prolog-macro) (quote shen.prolog-macro)) +(begin (register-function-arity (quote shen.externally-bound) 1) (define (kl:shen.externally-bound V1567) (cond ((and (pair? V1567) (and (eq? (quote receive) (car V1567)) (and (pair? (cdr V1567)) (null? (cdr (cdr V1567)))))) (cdr V1567)) ((pair? V1567) (kl:union (kl:shen.externally-bound (car V1567)) (kl:shen.externally-bound (cdr V1567)))) (#t (quote ())))) (export shen.externally-bound) (quote shen.externally-bound)) +(begin (register-function-arity (quote shen.locally-bind-prolog-vs) 3) (define (kl:shen.locally-bind-prolog-vs V1585 V1586 V1587) (cond ((null? V1586) V1587) ((pair? V1586) (cons (quote let) (cons (car V1586) (cons (cons (quote shen.newpv) (cons V1585 (quote ()))) (cons (kl:shen.locally-bind-prolog-vs V1585 (cdr V1586) V1587) (quote ())))))) (#t (simple-error "implementation error inp locally-bind-prolog-vs")))) (export shen.locally-bind-prolog-vs) (quote shen.locally-bind-prolog-vs)) +(begin (register-function-arity (quote shen.bld-prolog-call) 2) (define (kl:shen.bld-prolog-call V1600 V1601) (cond ((null? V1601) #t) ((and (pair? V1601) (eq? (quote !) (car V1601))) (cons (quote cut) (cons #f (cons V1600 (cons (cons (quote freeze) (cons (kl:shen.bld-prolog-call V1600 (cdr V1601)) (quote ()))) (quote ())))))) ((and (pair? V1601) (and (pair? (car V1601)) (and (eq? (quote when) (car (car V1601))) (and (pair? (cdr (car V1601))) (null? (cdr (cdr (car V1601)))))))) (cons (quote fwhen) (cons (kl:shen.insert-deref (car (cdr (car V1601))) V1600) (cons V1600 (cons (cons (quote freeze) (cons (kl:shen.bld-prolog-call V1600 (cdr V1601)) (quote ()))) (quote ())))))) ((and (pair? V1601) (and (pair? (car V1601)) (and (eq? (quote is) (car (car V1601))) (and (pair? (cdr (car V1601))) (and (pair? (cdr (cdr (car V1601)))) (null? (cdr (cdr (cdr (car V1601)))))))))) (cons (quote bind) (cons (car (cdr (car V1601))) (cons (kl:shen.insert-deref (car (cdr (cdr (car V1601)))) V1600) (cons V1600 (cons (cons (quote freeze) (cons (kl:shen.bld-prolog-call V1600 (cdr V1601)) (quote ()))) (quote ()))))))) ((and (pair? V1601) (and (pair? (car V1601)) (and (eq? (quote receive) (car (car V1601))) (and (pair? (cdr (car V1601))) (null? (cdr (cdr (car V1601)))))))) (kl:shen.bld-prolog-call V1600 (cdr V1601))) ((and (pair? V1601) (and (pair? (car V1601)) (and (eq? (quote bind) (car (car V1601))) (and (pair? (cdr (car V1601))) (and (pair? (cdr (cdr (car V1601)))) (null? (cdr (cdr (cdr (car V1601)))))))))) (cons (quote bind) (cons (car (cdr (car V1601))) (cons (kl:shen.insert-lazyderef (car (cdr (cdr (car V1601)))) V1600) (cons V1600 (cons (cons (quote freeze) (cons (kl:shen.bld-prolog-call V1600 (cdr V1601)) (quote ()))) (quote ()))))))) ((and (pair? V1601) (and (pair? (car V1601)) (and (eq? (quote fwhen) (car (car V1601))) (and (pair? (cdr (car V1601))) (null? (cdr (cdr (car V1601)))))))) (cons (quote fwhen) (cons (kl:shen.insert-lazyderef (car (cdr (car V1601))) V1600) (cons V1600 (cons (cons (quote freeze) (cons (kl:shen.bld-prolog-call V1600 (cdr V1601)) (quote ()))) (quote ())))))) ((pair? V1601) (kl:append (car V1601) (cons V1600 (cons (cons (quote freeze) (cons (kl:shen.bld-prolog-call V1600 (cdr V1601)) (quote ()))) (quote ()))))) (#t (simple-error "implementation error in bld-prolog-call")))) (export shen.bld-prolog-call) (quote shen.bld-prolog-call)) +(begin (register-function-arity (quote shen.defprolog-macro) 1) (define (kl:shen.defprolog-macro V1603) (cond ((and (pair? V1603) (and (eq? (quote defprolog) (car V1603)) (pair? (cdr V1603)))) (kl:compile (lambda (Y) (kl:shen. Y)) (cdr V1603) (lambda (Y) (kl:shen.prolog-error (car (cdr V1603)) Y)))) (#t V1603))) (export shen.defprolog-macro) (quote shen.defprolog-macro)) +(begin (register-function-arity (quote shen.datatype-macro) 1) (define (kl:shen.datatype-macro V1605) (cond ((and (pair? V1605) (and (eq? (quote datatype) (car V1605)) (pair? (cdr V1605)))) (cons (quote shen.process-datatype) (cons (kl:shen.intern-type (car (cdr V1605))) (cons (cons (quote compile) (cons (cons (quote lambda) (cons (quote X) (cons (cons (quote shen.) (cons (quote X) (quote ()))) (quote ())))) (cons (kl:shen.rcons_form (cdr (cdr V1605))) (cons (cons (quote function) (cons (quote shen.datatype-error) (quote ()))) (quote ()))))) (quote ()))))) (#t V1605))) (export shen.datatype-macro) (quote shen.datatype-macro)) +(begin (register-function-arity (quote shen.intern-type) 1) (define (kl:shen.intern-type V1607) (kl:intern (string-append "type#" (kl:str V1607)))) (export shen.intern-type) (quote shen.intern-type)) +(begin (register-function-arity (quote shen._waspvm_at_s-macro) 1) (define (kl:shen._waspvm_at_s-macro V1609) (cond ((and (pair? V1609) (and (eq? (quote _waspvm_at_s) (car V1609)) (and (pair? (cdr V1609)) (and (pair? (cdr (cdr V1609))) (pair? (cdr (cdr (cdr V1609)))))))) (cons (quote _waspvm_at_s) (cons (car (cdr V1609)) (cons (kl:shen._waspvm_at_s-macro (cons (quote _waspvm_at_s) (cdr (cdr V1609)))) (quote ()))))) ((and (pair? V1609) (and (eq? (quote _waspvm_at_s) (car V1609)) (and (pair? (cdr V1609)) (and (pair? (cdr (cdr V1609))) (and (null? (cdr (cdr (cdr V1609)))) (string? (car (cdr V1609)))))))) (let ((E (kl:explode (car (cdr V1609))))) (if (> (kl:length E) 1) (kl:shen._waspvm_at_s-macro (cons (quote _waspvm_at_s) (kl:append E (cdr (cdr V1609))))) V1609))) (#t V1609))) (export shen._waspvm_at_s-macro) (quote shen._waspvm_at_s-macro)) +(begin (register-function-arity (quote shen.synonyms-macro) 1) (define (kl:shen.synonyms-macro V1611) (cond ((and (pair? V1611) (eq? (quote synonyms) (car V1611))) (cons (quote shen.synonyms-help) (cons (kl:shen.rcons_form (kl:shen.curry-synonyms (cdr V1611))) (quote ())))) (#t V1611))) (export shen.synonyms-macro) (quote shen.synonyms-macro)) +(begin (register-function-arity (quote shen.curry-synonyms) 1) (define (kl:shen.curry-synonyms V1613) (kl:map (lambda (X) (kl:shen.curry-type X)) V1613)) (export shen.curry-synonyms) (quote shen.curry-synonyms)) +(begin (register-function-arity (quote shen.nl-macro) 1) (define (kl:shen.nl-macro V1615) (cond ((and (pair? V1615) (and (eq? (quote nl) (car V1615)) (null? (cdr V1615)))) (cons (quote nl) (cons 1 (quote ())))) (#t V1615))) (export shen.nl-macro) (quote shen.nl-macro)) +(begin (register-function-arity (quote shen.assoc-macro) 1) (define (kl:shen.assoc-macro V1617) (cond ((and (pair? V1617) (and (pair? (cdr V1617)) (and (pair? (cdr (cdr V1617))) (and (pair? (cdr (cdr (cdr V1617)))) (kl:element? (car V1617) (cons (quote _waspvm_at_p) (cons (quote _waspvm_at_v) (cons (quote append) (cons (quote and) (cons (quote or) (cons (quote +) (cons (quote *) (cons (quote do) (quote ())))))))))))))) (cons (car V1617) (cons (car (cdr V1617)) (cons (kl:shen.assoc-macro (cons (car V1617) (cdr (cdr V1617)))) (quote ()))))) (#t V1617))) (export shen.assoc-macro) (quote shen.assoc-macro)) +(begin (register-function-arity (quote shen.let-macro) 1) (define (kl:shen.let-macro V1619) (cond ((and (pair? V1619) (and (eq? (quote let) (car V1619)) (and (pair? (cdr V1619)) (and (pair? (cdr (cdr V1619))) (and (pair? (cdr (cdr (cdr V1619)))) (pair? (cdr (cdr (cdr (cdr V1619)))))))))) (cons (quote let) (cons (car (cdr V1619)) (cons (car (cdr (cdr V1619))) (cons (kl:shen.let-macro (cons (quote let) (cdr (cdr (cdr V1619))))) (quote ())))))) (#t V1619))) (export shen.let-macro) (quote shen.let-macro)) +(begin (register-function-arity (quote shen.abs-macro) 1) (define (kl:shen.abs-macro V1621) (cond ((and (pair? V1621) (and (eq? (quote /.) (car V1621)) (and (pair? (cdr V1621)) (and (pair? (cdr (cdr V1621))) (pair? (cdr (cdr (cdr V1621)))))))) (cons (quote lambda) (cons (car (cdr V1621)) (cons (kl:shen.abs-macro (cons (quote /.) (cdr (cdr V1621)))) (quote ()))))) ((and (pair? V1621) (and (eq? (quote /.) (car V1621)) (and (pair? (cdr V1621)) (and (pair? (cdr (cdr V1621))) (null? (cdr (cdr (cdr V1621)))))))) (cons (quote lambda) (cdr V1621))) (#t V1621))) (export shen.abs-macro) (quote shen.abs-macro)) +(begin (register-function-arity (quote shen.cases-macro) 1) (define (kl:shen.cases-macro V1625) (cond ((and (pair? V1625) (and (eq? (quote cases) (car V1625)) (and (pair? (cdr V1625)) (and (kl:= #t (car (cdr V1625))) (pair? (cdr (cdr V1625))))))) (car (cdr (cdr V1625)))) ((and (pair? V1625) (and (eq? (quote cases) (car V1625)) (and (pair? (cdr V1625)) (and (pair? (cdr (cdr V1625))) (null? (cdr (cdr (cdr V1625)))))))) (cons (quote if) (cons (car (cdr V1625)) (cons (car (cdr (cdr V1625))) (cons (cons (quote simple-error) (cons "error: cases exhausted" (quote ()))) (quote ())))))) ((and (pair? V1625) (and (eq? (quote cases) (car V1625)) (and (pair? (cdr V1625)) (pair? (cdr (cdr V1625)))))) (cons (quote if) (cons (car (cdr V1625)) (cons (car (cdr (cdr V1625))) (cons (kl:shen.cases-macro (cons (quote cases) (cdr (cdr (cdr V1625))))) (quote ())))))) ((and (pair? V1625) (and (eq? (quote cases) (car V1625)) (and (pair? (cdr V1625)) (null? (cdr (cdr V1625)))))) (simple-error "error: odd number of case elements\n")) (#t V1625))) (export shen.cases-macro) (quote shen.cases-macro)) +(begin (register-function-arity (quote shen.timer-macro) 1) (define (kl:shen.timer-macro V1627) (cond ((and (pair? V1627) (and (eq? (quote time) (car V1627)) (and (pair? (cdr V1627)) (null? (cdr (cdr V1627)))))) (kl:shen.let-macro (cons (quote let) (cons (quote Start) (cons (cons (quote get-time) (cons (quote run) (quote ()))) (cons (quote Result) (cons (car (cdr V1627)) (cons (quote Finish) (cons (cons (quote get-time) (cons (quote run) (quote ()))) (cons (quote Time) (cons (cons (quote -) (cons (quote Finish) (cons (quote Start) (quote ())))) (cons (quote Message) (cons (cons (quote shen.prhush) (cons (cons (quote cn) (cons "\nrun time: " (cons (cons (quote cn) (cons (cons (quote str) (cons (quote Time) (quote ()))) (cons " secs\n" (quote ())))) (quote ())))) (cons (cons (quote stoutput) (quote ())) (quote ())))) (cons (quote Result) (quote ()))))))))))))))) (#t V1627))) (export shen.timer-macro) (quote shen.timer-macro)) +(begin (register-function-arity (quote shen.tuple-up) 1) (define (kl:shen.tuple-up V1629) (cond ((pair? V1629) (cons (quote _waspvm_at_p) (cons (car V1629) (cons (kl:shen.tuple-up (cdr V1629)) (quote ()))))) (#t V1629))) (export shen.tuple-up) (quote shen.tuple-up)) +(begin (register-function-arity (quote shen.put/get-macro) 1) (define (kl:shen.put/get-macro V1631) (cond ((and (pair? V1631) (and (eq? (quote put) (car V1631)) (and (pair? (cdr V1631)) (and (pair? (cdr (cdr V1631))) (and (pair? (cdr (cdr (cdr V1631)))) (null? (cdr (cdr (cdr (cdr V1631)))))))))) (cons (quote put) (cons (car (cdr V1631)) (cons (car (cdr (cdr V1631))) (cons (car (cdr (cdr (cdr V1631)))) (cons (cons (quote value) (cons (quote *property-vector*) (quote ()))) (quote ()))))))) ((and (pair? V1631) (and (eq? (quote get) (car V1631)) (and (pair? (cdr V1631)) (and (pair? (cdr (cdr V1631))) (null? (cdr (cdr (cdr V1631)))))))) (cons (quote get) (cons (car (cdr V1631)) (cons (car (cdr (cdr V1631))) (cons (cons (quote value) (cons (quote *property-vector*) (quote ()))) (quote ())))))) ((and (pair? V1631) (and (eq? (quote unput) (car V1631)) (and (pair? (cdr V1631)) (and (pair? (cdr (cdr V1631))) (null? (cdr (cdr (cdr V1631)))))))) (cons (quote unput) (cons (car (cdr V1631)) (cons (car (cdr (cdr V1631))) (cons (cons (quote value) (cons (quote *property-vector*) (quote ()))) (quote ())))))) (#t V1631))) (export shen.put/get-macro) (quote shen.put/get-macro)) +(begin (register-function-arity (quote shen.function-macro) 1) (define (kl:shen.function-macro V1633) (cond ((and (pair? V1633) (and (eq? (quote function) (car V1633)) (and (pair? (cdr V1633)) (null? (cdr (cdr V1633)))))) (kl:shen.function-abstraction (car (cdr V1633)) (kl:arity (car (cdr V1633))))) (#t V1633))) (export shen.function-macro) (quote shen.function-macro)) +(begin (register-function-arity (quote shen.function-abstraction) 2) (define (kl:shen.function-abstraction V1636 V1637) (cond ((kl:= 0 V1637) (simple-error (kl:shen.app V1636 " has no lambda form\n" (quote shen.a)))) ((kl:= -1 V1637) (cons (quote function) (cons V1636 (quote ())))) (#t (kl:shen.function-abstraction-help V1636 V1637 (quote ()))))) (export shen.function-abstraction) (quote shen.function-abstraction)) +(begin (register-function-arity (quote shen.function-abstraction-help) 3) (define (kl:shen.function-abstraction-help V1641 V1642 V1643) (cond ((kl:= 0 V1642) (cons V1641 V1643)) (#t (let ((X (kl:gensym (quote V)))) (cons (quote /.) (cons X (cons (kl:shen.function-abstraction-help V1641 (- V1642 1) (kl:append V1643 (cons X (quote ())))) (quote ())))))))) (export shen.function-abstraction-help) (quote shen.function-abstraction-help)) +(begin (register-function-arity (quote undefmacro) 1) (define (kl:undefmacro V1645) (let ((MacroReg (kl:value (quote shen.*macroreg*)))) (let ((Pos (kl:shen.findpos V1645 MacroReg))) (let ((Remove1 (kl:set (quote shen.*macroreg*) (kl:remove V1645 MacroReg)))) (let ((Remove2 (kl:set (quote *macros*) (kl:shen.remove-nth Pos (kl:value (quote *macros*)))))) V1645))))) (export undefmacro) (quote undefmacro)) +(begin (register-function-arity (quote shen.findpos) 2) (define (kl:shen.findpos V1655 V1656) (cond ((null? V1656) (simple-error (kl:shen.app V1655 " is not a macro\n" (quote shen.a)))) ((and (pair? V1656) (kl:= (car V1656) V1655)) 1) ((pair? V1656) (+ 1 (kl:shen.findpos V1655 (cdr V1656)))) (#t (kl:shen.f_error (quote shen.findpos))))) (export shen.findpos) (quote shen.findpos)) +(begin (register-function-arity (quote shen.remove-nth) 2) (define (kl:shen.remove-nth V1661 V1662) (cond ((and (kl:= 1 V1661) (pair? V1662)) (cdr V1662)) ((pair? V1662) (cons (car V1662) (kl:shen.remove-nth (- V1661 1) (cdr V1662)))) (#t (kl:shen.f_error (quote shen.remove-nth))))) (export shen.remove-nth) (quote shen.remove-nth)) diff --git a/compiled/prolog.kl.ms b/compiled/prolog.kl.ms index 57204e0..dcb9b2d 100644 --- a/compiled/prolog.kl.ms +++ b/compiled/prolog.kl.ms @@ -1,98 +1,99 @@ +(module "compiled/prolog.kl") "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.) 1) (define (kl:shen. V1664) (let ((Parse_shen. (kl:shen. V1664))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (car (kl:shen.prolog->shen (kl:map (lambda (Parse_X) (kl:shen.insert-predicate (kl:shen.hdtl Parse_shen.) Parse_X)) (kl:shen.hdtl Parse_shen.))))) (kl:fail))) (kl:fail)))) (quote shen.)) -(begin (register-function-arity (quote shen.prolog-error) 2) (define (kl:shen.prolog-error V1673 V1674) (cond ((and (pair? V1674) (and (pair? (cdr V1674)) (null? (cdr (cdr V1674))))) (simple-error (string-append "prolog syntax error in " (kl:shen.app V1673 (string-append " here:\n\n " (kl:shen.app (kl:shen.next-50 50 (car V1674)) "\n" (quote shen.a))) (quote shen.a))))) (#t (simple-error (string-append "prolog syntax error in " (kl:shen.app V1673 "\n" (quote shen.a))))))) (quote shen.prolog-error)) -(begin (register-function-arity (quote shen.next-50) 2) (define (kl:shen.next-50 V1681 V1682) (cond ((null? V1682) "") ((kl:= 0 V1681) "") ((pair? V1682) (string-append (kl:shen.decons-string (car V1682)) (kl:shen.next-50 (- V1681 1) (cdr V1682)))) (#t (kl:shen.f_error (quote shen.next-50))))) (quote shen.next-50)) -(begin (register-function-arity (quote shen.decons-string) 1) (define (kl:shen.decons-string V1684) (cond ((and (pair? V1684) (and (eq? (quote cons) (car V1684)) (and (pair? (cdr V1684)) (and (pair? (cdr (cdr V1684))) (null? (cdr (cdr (cdr V1684)))))))) (kl:shen.app (kl:shen.eval-cons V1684) " " (quote shen.s))) (#t (kl:shen.app V1684 " " (quote shen.r))))) (quote shen.decons-string)) -(begin (register-function-arity (quote shen.insert-predicate) 2) (define (kl:shen.insert-predicate V1687 V1688) (cond ((and (pair? V1688) (and (pair? (cdr V1688)) (null? (cdr (cdr V1688))))) (cons (cons V1687 (car V1688)) (cons (quote :-) (cdr V1688)))) (#t (kl:shen.f_error (quote shen.insert-predicate))))) (quote shen.insert-predicate)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1690) (if (pair? (car V1690)) (let ((Parse_X (kl:shen.hdhd V1690))) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V1690) (kl:shen.hdtl V1690))) Parse_X)) (kl:fail))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1692) (let ((YaccParse (let ((Parse_shen. (kl:shen. V1692))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_ (kl: V1692))) (if (kl:not (kl:= (kl:fail) Parse_)) (kl:shen.pair (car Parse_) (quote ())) (kl:fail))) YaccParse))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1695) (let ((Parse_shen. (kl:shen. V1695))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (if (and (pair? (car Parse_shen.)) (eq? (quote <--) (kl:shen.hdhd Parse_shen.))) (let ((NewStream1693 (kl:shen.pair (kl:shen.tlhd Parse_shen.) (kl:shen.hdtl Parse_shen.)))) (let ((Parse_shen. (kl:shen. NewStream1693))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (quote ())))) (kl:fail))) (kl:fail)))) (kl:fail)) (kl:fail)))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1697) (let ((YaccParse (let ((Parse_shen. (kl:shen. V1697))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_ (kl: V1697))) (if (kl:not (kl:= (kl:fail) Parse_)) (kl:shen.pair (car Parse_) (quote ())) (kl:fail))) YaccParse))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1699) (if (pair? (car V1699)) (let ((Parse_X (kl:shen.hdhd V1699))) (if (and (kl:not (eq? (quote <--) Parse_X)) (assert-boolean (kl:shen.legitimate-term? Parse_X))) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V1699) (kl:shen.hdtl V1699))) (kl:shen.eval-cons Parse_X)) (kl:fail))) (kl:fail))) (quote shen.)) -(begin (register-function-arity (quote shen.legitimate-term?) 1) (define (kl:shen.legitimate-term? V1705) (cond ((and (pair? V1705) (and (eq? (quote cons) (car V1705)) (and (pair? (cdr V1705)) (and (pair? (cdr (cdr V1705))) (null? (cdr (cdr (cdr V1705)))))))) (and (assert-boolean (kl:shen.legitimate-term? (car (cdr V1705)))) (assert-boolean (kl:shen.legitimate-term? (car (cdr (cdr V1705))))))) ((and (pair? V1705) (and (eq? (quote mode) (car V1705)) (and (pair? (cdr V1705)) (and (pair? (cdr (cdr V1705))) (and (eq? (quote +) (car (cdr (cdr V1705)))) (null? (cdr (cdr (cdr V1705))))))))) (kl:shen.legitimate-term? (car (cdr V1705)))) ((and (pair? V1705) (and (eq? (quote mode) (car V1705)) (and (pair? (cdr V1705)) (and (pair? (cdr (cdr V1705))) (and (eq? (quote -) (car (cdr (cdr V1705)))) (null? (cdr (cdr (cdr V1705))))))))) (kl:shen.legitimate-term? (car (cdr V1705)))) ((pair? V1705) #f) (#t #t))) (quote shen.legitimate-term?)) -(begin (register-function-arity (quote shen.eval-cons) 1) (define (kl:shen.eval-cons V1707) (cond ((and (pair? V1707) (and (eq? (quote cons) (car V1707)) (and (pair? (cdr V1707)) (and (pair? (cdr (cdr V1707))) (null? (cdr (cdr (cdr V1707)))))))) (cons (kl:shen.eval-cons (car (cdr V1707))) (kl:shen.eval-cons (car (cdr (cdr V1707)))))) ((and (pair? V1707) (and (eq? (quote mode) (car V1707)) (and (pair? (cdr V1707)) (and (pair? (cdr (cdr V1707))) (null? (cdr (cdr (cdr V1707)))))))) (cons (quote mode) (cons (kl:shen.eval-cons (car (cdr V1707))) (cdr (cdr V1707))))) (#t V1707))) (quote shen.eval-cons)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1709) (let ((YaccParse (let ((Parse_shen. (kl:shen. V1709))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_ (kl: V1709))) (if (kl:not (kl:= (kl:fail) Parse_)) (kl:shen.pair (car Parse_) (quote ())) (kl:fail))) YaccParse))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1712) (let ((YaccParse (if (and (pair? (car V1712)) (eq? (quote !) (kl:shen.hdhd V1712))) (let ((NewStream1710 (kl:shen.pair (kl:shen.tlhd V1712) (kl:shen.hdtl V1712)))) (kl:shen.pair (car NewStream1710) (cons (quote cut) (cons (kl:intern "Throwcontrol") (quote ()))))) (kl:fail)))) (if (kl:= YaccParse (kl:fail)) (if (pair? (car V1712)) (let ((Parse_X (kl:shen.hdhd V1712))) (if (pair? Parse_X) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V1712) (kl:shen.hdtl V1712))) Parse_X) (kl:fail))) (kl:fail)) YaccParse))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1714) (if (pair? (car V1714)) (let ((Parse_X (kl:shen.hdhd V1714))) (if (eq? Parse_X (quote _waspvm_sc_)) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V1714) (kl:shen.hdtl V1714))) Parse_X) (kl:fail))) (kl:fail))) (quote shen.)) -(begin (register-function-arity (quote cut) 3) (define (kl:cut V1718 V1719 V1720) (let ((Result (kl:thaw V1720))) (if (kl:= Result #f) V1718 Result))) (quote cut)) -(begin (register-function-arity (quote shen.insert_modes) 1) (define (kl:shen.insert_modes V1722) (cond ((and (pair? V1722) (and (eq? (quote mode) (car V1722)) (and (pair? (cdr V1722)) (and (pair? (cdr (cdr V1722))) (null? (cdr (cdr (cdr V1722)))))))) V1722) ((null? V1722) (quote ())) ((pair? V1722) (cons (cons (quote mode) (cons (car V1722) (cons (quote +) (quote ())))) (cons (quote mode) (cons (kl:shen.insert_modes (cdr V1722)) (cons (quote -) (quote ())))))) (#t V1722))) (quote shen.insert_modes)) -(begin (register-function-arity (quote shen.s-prolog) 1) (define (kl:shen.s-prolog V1724) (kl:map (lambda (X) (kl:eval X)) (kl:shen.prolog->shen V1724))) (quote shen.s-prolog)) -(begin (register-function-arity (quote shen.prolog->shen) 1) (define (kl:shen.prolog->shen V1726) (kl:map (lambda (X) (kl:shen.compile_prolog_procedure X)) (kl:shen.group_clauses (kl:map (lambda (X) (kl:shen.s-prolog_clause X)) (kl:mapcan (lambda (X) (kl:shen.head_abstraction X)) V1726))))) (quote shen.prolog->shen)) -(begin (register-function-arity (quote shen.s-prolog_clause) 1) (define (kl:shen.s-prolog_clause V1728) (cond ((and (pair? V1728) (and (pair? (cdr V1728)) (and (eq? (quote :-) (car (cdr V1728))) (and (pair? (cdr (cdr V1728))) (null? (cdr (cdr (cdr V1728)))))))) (cons (car V1728) (cons (quote :-) (cons (kl:map (lambda (X) (kl:shen.s-prolog_literal X)) (car (cdr (cdr V1728)))) (quote ()))))) (#t (kl:shen.f_error (quote shen.s-prolog_clause))))) (quote shen.s-prolog_clause)) -(begin (register-function-arity (quote shen.head_abstraction) 1) (define (kl:shen.head_abstraction V1730) (cond ((and (pair? V1730) (and (pair? (cdr V1730)) (and (eq? (quote :-) (car (cdr V1730))) (and (pair? (cdr (cdr V1730))) (and (null? (cdr (cdr (cdr V1730)))) (assert-boolean (guard (lambda (_) #f) (< (kl:shen.complexity_head (car V1730)) (kl:value (quote shen.*maxcomplexity*)))))))))) (cons V1730 (quote ()))) ((and (pair? V1730) (and (pair? (car V1730)) (and (pair? (cdr V1730)) (and (eq? (quote :-) (car (cdr V1730))) (and (pair? (cdr (cdr V1730))) (null? (cdr (cdr (cdr V1730))))))))) (let ((Terms (kl:map (lambda (Y) (kl:gensym (quote V))) (cdr (car V1730))))) (let ((XTerms (kl:shen.rcons_form (kl:shen.remove_modes (cdr (car V1730)))))) (let ((Literal (cons (quote unify) (cons (kl:shen.cons_form Terms) (cons XTerms (quote ())))))) (let ((Clause (cons (cons (car (car V1730)) Terms) (cons (quote :-) (cons (cons Literal (car (cdr (cdr V1730)))) (quote ())))))) (cons Clause (quote ()))))))) (#t (kl:shen.f_error (quote shen.head_abstraction))))) (quote shen.head_abstraction)) -(begin (register-function-arity (quote shen.complexity_head) 1) (define (kl:shen.complexity_head V1736) (cond ((pair? V1736) (kl:shen.safe-product (kl:map (lambda (X) (kl:shen.complexity X)) (cdr V1736)))) (#t (kl:shen.f_error (quote shen.complexity_head))))) (quote shen.complexity_head)) -(begin (register-function-arity (quote shen.safe-multiply) 2) (define (kl:shen.safe-multiply V1739 V1740) (* V1739 V1740)) (quote shen.safe-multiply)) -(begin (register-function-arity (quote shen.complexity) 1) (define (kl:shen.complexity V1749) (cond ((and (pair? V1749) (and (eq? (quote mode) (car V1749)) (and (pair? (cdr V1749)) (and (pair? (car (cdr V1749))) (and (eq? (quote mode) (car (car (cdr V1749)))) (and (pair? (cdr (car (cdr V1749)))) (and (pair? (cdr (cdr (car (cdr V1749))))) (and (null? (cdr (cdr (cdr (car (cdr V1749)))))) (and (pair? (cdr (cdr V1749))) (null? (cdr (cdr (cdr V1749))))))))))))) (kl:shen.complexity (car (cdr V1749)))) ((and (pair? V1749) (and (eq? (quote mode) (car V1749)) (and (pair? (cdr V1749)) (and (pair? (car (cdr V1749))) (and (pair? (cdr (cdr V1749))) (and (eq? (quote +) (car (cdr (cdr V1749)))) (null? (cdr (cdr (cdr V1749)))))))))) (kl:shen.safe-multiply 2 (kl:shen.safe-multiply (kl:shen.complexity (cons (quote mode) (cons (car (car (cdr V1749))) (cdr (cdr V1749))))) (kl:shen.complexity (cons (quote mode) (cons (cdr (car (cdr V1749))) (cdr (cdr V1749)))))))) ((and (pair? V1749) (and (eq? (quote mode) (car V1749)) (and (pair? (cdr V1749)) (and (pair? (car (cdr V1749))) (and (pair? (cdr (cdr V1749))) (and (eq? (quote -) (car (cdr (cdr V1749)))) (null? (cdr (cdr (cdr V1749)))))))))) (kl:shen.safe-multiply (kl:shen.complexity (cons (quote mode) (cons (car (car (cdr V1749))) (cdr (cdr V1749))))) (kl:shen.complexity (cons (quote mode) (cons (cdr (car (cdr V1749))) (cdr (cdr V1749))))))) ((and (pair? V1749) (and (eq? (quote mode) (car V1749)) (and (pair? (cdr V1749)) (and (pair? (cdr (cdr V1749))) (and (null? (cdr (cdr (cdr V1749)))) (kl:variable? (car (cdr V1749)))))))) 1) ((and (pair? V1749) (and (eq? (quote mode) (car V1749)) (and (pair? (cdr V1749)) (and (pair? (cdr (cdr V1749))) (and (eq? (quote +) (car (cdr (cdr V1749)))) (null? (cdr (cdr (cdr V1749))))))))) 2) ((and (pair? V1749) (and (eq? (quote mode) (car V1749)) (and (pair? (cdr V1749)) (and (pair? (cdr (cdr V1749))) (and (eq? (quote -) (car (cdr (cdr V1749)))) (null? (cdr (cdr (cdr V1749))))))))) 1) (#t (kl:shen.complexity (cons (quote mode) (cons V1749 (cons (quote +) (quote ())))))))) (quote shen.complexity)) -(begin (register-function-arity (quote shen.safe-product) 1) (define (kl:shen.safe-product V1751) (cond ((null? V1751) 1) ((pair? V1751) (kl:shen.safe-multiply (car V1751) (kl:shen.safe-product (cdr V1751)))) (#t (kl:shen.f_error (quote shen.safe-product))))) (quote shen.safe-product)) -(begin (register-function-arity (quote shen.s-prolog_literal) 1) (define (kl:shen.s-prolog_literal V1753) (cond ((and (pair? V1753) (and (eq? (quote is) (car V1753)) (and (pair? (cdr V1753)) (and (pair? (cdr (cdr V1753))) (null? (cdr (cdr (cdr V1753)))))))) (cons (quote bind) (cons (car (cdr V1753)) (cons (kl:shen.insert-deref (car (cdr (cdr V1753))) (quote ProcessN)) (quote ()))))) ((and (pair? V1753) (and (eq? (quote when) (car V1753)) (and (pair? (cdr V1753)) (null? (cdr (cdr V1753)))))) (cons (quote fwhen) (cons (kl:shen.insert-deref (car (cdr V1753)) (quote ProcessN)) (quote ())))) ((and (pair? V1753) (and (eq? (quote bind) (car V1753)) (and (pair? (cdr V1753)) (and (pair? (cdr (cdr V1753))) (null? (cdr (cdr (cdr V1753)))))))) (cons (quote bind) (cons (car (cdr V1753)) (cons (kl:shen.insert-lazyderef (car (cdr (cdr V1753))) (quote ProcessN)) (quote ()))))) ((and (pair? V1753) (and (eq? (quote fwhen) (car V1753)) (and (pair? (cdr V1753)) (null? (cdr (cdr V1753)))))) (cons (quote fwhen) (cons (kl:shen.insert-lazyderef (car (cdr V1753)) (quote ProcessN)) (quote ())))) ((pair? V1753) V1753) (#t (kl:shen.f_error (quote shen.s-prolog_literal))))) (quote shen.s-prolog_literal)) -(begin (register-function-arity (quote shen.insert-deref) 2) (define (kl:shen.insert-deref V1760 V1761) (cond ((kl:variable? V1760) (cons (quote shen.deref) (cons V1760 (cons V1761 (quote ()))))) ((and (pair? V1760) (and (eq? (quote lambda) (car V1760)) (and (pair? (cdr V1760)) (and (pair? (cdr (cdr V1760))) (null? (cdr (cdr (cdr V1760)))))))) (cons (quote lambda) (cons (car (cdr V1760)) (cons (kl:shen.insert-deref (car (cdr (cdr V1760))) V1761) (quote ()))))) ((and (pair? V1760) (and (eq? (quote let) (car V1760)) (and (pair? (cdr V1760)) (and (pair? (cdr (cdr V1760))) (and (pair? (cdr (cdr (cdr V1760)))) (null? (cdr (cdr (cdr (cdr V1760)))))))))) (cons (quote let) (cons (car (cdr V1760)) (cons (kl:shen.insert-deref (car (cdr (cdr V1760))) V1761) (cons (kl:shen.insert-deref (car (cdr (cdr (cdr V1760)))) V1761) (quote ())))))) ((pair? V1760) (cons (kl:shen.insert-deref (car V1760) V1761) (kl:shen.insert-deref (cdr V1760) V1761))) (#t V1760))) (quote shen.insert-deref)) -(begin (register-function-arity (quote shen.insert-lazyderef) 2) (define (kl:shen.insert-lazyderef V1768 V1769) (cond ((kl:variable? V1768) (cons (quote shen.lazyderef) (cons V1768 (cons V1769 (quote ()))))) ((and (pair? V1768) (and (eq? (quote lambda) (car V1768)) (and (pair? (cdr V1768)) (and (pair? (cdr (cdr V1768))) (null? (cdr (cdr (cdr V1768)))))))) (cons (quote lambda) (cons (car (cdr V1768)) (cons (kl:shen.insert-lazyderef (car (cdr (cdr V1768))) V1769) (quote ()))))) ((and (pair? V1768) (and (eq? (quote let) (car V1768)) (and (pair? (cdr V1768)) (and (pair? (cdr (cdr V1768))) (and (pair? (cdr (cdr (cdr V1768)))) (null? (cdr (cdr (cdr (cdr V1768)))))))))) (cons (quote let) (cons (car (cdr V1768)) (cons (kl:shen.insert-lazyderef (car (cdr (cdr V1768))) V1769) (cons (kl:shen.insert-lazyderef (car (cdr (cdr (cdr V1768)))) V1769) (quote ())))))) ((pair? V1768) (cons (kl:shen.insert-lazyderef (car V1768) V1769) (kl:shen.insert-lazyderef (cdr V1768) V1769))) (#t V1768))) (quote shen.insert-lazyderef)) -(begin (register-function-arity (quote shen.group_clauses) 1) (define (kl:shen.group_clauses V1771) (cond ((null? V1771) (quote ())) ((pair? V1771) (let ((Group (kl:shen.collect (lambda (X) (kl:shen.same_predicate? (car V1771) X)) V1771))) (let ((Rest (kl:difference V1771 Group))) (cons Group (kl:shen.group_clauses Rest))))) (#t (kl:shen.f_error (quote shen.group_clauses))))) (quote shen.group_clauses)) -(begin (register-function-arity (quote shen.collect) 2) (define (kl:shen.collect V1776 V1777) (cond ((null? V1777) (quote ())) ((pair? V1777) (if (assert-boolean (V1776 (car V1777))) (cons (car V1777) (kl:shen.collect V1776 (cdr V1777))) (kl:shen.collect V1776 (cdr V1777)))) (#t (kl:shen.f_error (quote shen.collect))))) (quote shen.collect)) -(begin (register-function-arity (quote shen.same_predicate?) 2) (define (kl:shen.same_predicate? V1796 V1797) (cond ((and (pair? V1796) (and (pair? (car V1796)) (and (pair? V1797) (pair? (car V1797))))) (kl:= (car (car V1796)) (car (car V1797)))) (#t (kl:shen.f_error (quote shen.same_predicate?))))) (quote shen.same_predicate?)) -(begin (register-function-arity (quote shen.compile_prolog_procedure) 1) (define (kl:shen.compile_prolog_procedure V1799) (let ((F (kl:shen.procedure_name V1799))) (let ((Shen (kl:shen.clauses-to-shen F V1799))) Shen))) (quote shen.compile_prolog_procedure)) -(begin (register-function-arity (quote shen.procedure_name) 1) (define (kl:shen.procedure_name V1813) (cond ((and (pair? V1813) (and (pair? (car V1813)) (pair? (car (car V1813))))) (car (car (car V1813)))) (#t (kl:shen.f_error (quote shen.procedure_name))))) (quote shen.procedure_name)) -(begin (register-function-arity (quote shen.clauses-to-shen) 2) (define (kl:shen.clauses-to-shen V1816 V1817) (let ((Linear (kl:map (lambda (X) (kl:shen.linearise-clause X)) V1817))) (let ((Arity (kl:shen.prolog-aritycheck V1816 (kl:map (lambda (X) (kl:head X)) V1817)))) (let ((Parameters (kl:shen.parameters Arity))) (let ((AUM_instructions (kl:map (lambda (X) (kl:shen.aum X Parameters)) Linear))) (let ((Code (kl:shen.catch-cut (kl:shen.nest-disjunct (kl:map (lambda (X) (kl:shen.aum_to_shen X)) AUM_instructions))))) (let ((ShenDef (cons (quote define) (cons V1816 (kl:append Parameters (kl:append (cons (quote ProcessN) (cons (quote Continuation) (quote ()))) (cons (quote ->) (cons Code (quote ()))))))))) ShenDef))))))) (quote shen.clauses-to-shen)) -(begin (register-function-arity (quote shen.catch-cut) 1) (define (kl:shen.catch-cut V1819) (cond ((kl:not (kl:shen.occurs? (quote cut) V1819)) V1819) (#t (cons (quote let) (cons (quote Throwcontrol) (cons (cons (quote shen.catchpoint) (quote ())) (cons (cons (quote shen.cutpoint) (cons (quote Throwcontrol) (cons V1819 (quote ())))) (quote ())))))))) (quote shen.catch-cut)) -(begin (register-function-arity (quote shen.catchpoint) 0) (define (kl:shen.catchpoint) (kl:set (quote shen.*catch*) (+ 1 (kl:value (quote shen.*catch*))))) (quote shen.catchpoint)) -(begin (register-function-arity (quote shen.cutpoint) 2) (define (kl:shen.cutpoint V1827 V1828) (cond ((kl:= V1828 V1827) #f) (#t V1828))) (quote shen.cutpoint)) -(begin (register-function-arity (quote shen.nest-disjunct) 1) (define (kl:shen.nest-disjunct V1830) (cond ((and (pair? V1830) (null? (cdr V1830))) (car V1830)) ((pair? V1830) (kl:shen.lisp-or (car V1830) (kl:shen.nest-disjunct (cdr V1830)))) (#t (kl:shen.f_error (quote shen.nest-disjunct))))) (quote shen.nest-disjunct)) -(begin (register-function-arity (quote shen.lisp-or) 2) (define (kl:shen.lisp-or V1833 V1834) (cons (quote let) (cons (quote Case) (cons V1833 (cons (cons (quote if) (cons (cons (quote =) (cons (quote Case) (cons #f (quote ())))) (cons V1834 (cons (quote Case) (quote ()))))) (quote ())))))) (quote shen.lisp-or)) -(begin (register-function-arity (quote shen.prolog-aritycheck) 2) (define (kl:shen.prolog-aritycheck V1839 V1840) (cond ((and (pair? V1840) (null? (cdr V1840))) (- (kl:length (car V1840)) 1)) ((and (pair? V1840) (pair? (cdr V1840))) (if (kl:= (kl:length (car V1840)) (kl:length (car (cdr V1840)))) (kl:shen.prolog-aritycheck V1839 (cdr V1840)) (simple-error (string-append "arity error in prolog procedure " (kl:shen.app (cons V1839 (quote ())) "\n" (quote shen.a)))))) (#t (kl:shen.f_error (quote shen.prolog-aritycheck))))) (quote shen.prolog-aritycheck)) -(begin (register-function-arity (quote shen.linearise-clause) 1) (define (kl:shen.linearise-clause V1842) (cond ((and (pair? V1842) (and (pair? (cdr V1842)) (and (eq? (quote :-) (car (cdr V1842))) (and (pair? (cdr (cdr V1842))) (null? (cdr (cdr (cdr V1842)))))))) (let ((Linear (kl:shen.linearise (cons (car V1842) (cdr (cdr V1842)))))) (kl:shen.clause_form Linear))) (#t (kl:shen.f_error (quote shen.linearise-clause))))) (quote shen.linearise-clause)) -(begin (register-function-arity (quote shen.clause_form) 1) (define (kl:shen.clause_form V1844) (cond ((and (pair? V1844) (and (pair? (cdr V1844)) (null? (cdr (cdr V1844))))) (cons (kl:shen.explicit_modes (car V1844)) (cons (quote :-) (cons (kl:shen.cf_help (car (cdr V1844))) (quote ()))))) (#t (kl:shen.f_error (quote shen.clause_form))))) (quote shen.clause_form)) -(begin (register-function-arity (quote shen.explicit_modes) 1) (define (kl:shen.explicit_modes V1846) (cond ((pair? V1846) (cons (car V1846) (kl:map (lambda (X) (kl:shen.em_help X)) (cdr V1846)))) (#t (kl:shen.f_error (quote shen.explicit_modes))))) (quote shen.explicit_modes)) -(begin (register-function-arity (quote shen.em_help) 1) (define (kl:shen.em_help V1848) (cond ((and (pair? V1848) (and (eq? (quote mode) (car V1848)) (and (pair? (cdr V1848)) (and (pair? (cdr (cdr V1848))) (null? (cdr (cdr (cdr V1848)))))))) V1848) (#t (cons (quote mode) (cons V1848 (cons (quote +) (quote ()))))))) (quote shen.em_help)) -(begin (register-function-arity (quote shen.cf_help) 1) (define (kl:shen.cf_help V1850) (cond ((and (pair? V1850) (and (eq? (quote where) (car V1850)) (and (pair? (cdr V1850)) (and (pair? (car (cdr V1850))) (and (eq? (quote =) (car (car (cdr V1850)))) (and (pair? (cdr (car (cdr V1850)))) (and (pair? (cdr (cdr (car (cdr V1850))))) (and (null? (cdr (cdr (cdr (car (cdr V1850)))))) (and (pair? (cdr (cdr V1850))) (null? (cdr (cdr (cdr V1850))))))))))))) (cons (cons (if (assert-boolean (kl:value (quote shen.*occurs*))) (quote unify!) (quote unify)) (cdr (car (cdr V1850)))) (kl:shen.cf_help (car (cdr (cdr V1850)))))) (#t V1850))) (quote shen.cf_help)) -(begin (register-function-arity (quote occurs-check) 1) (define (kl:occurs-check V1856) (cond ((eq? (quote +) V1856) (kl:set (quote shen.*occurs*) #t)) ((eq? (quote -) V1856) (kl:set (quote shen.*occurs*) #f)) (#t (simple-error "occurs-check expects + or -\n")))) (quote occurs-check)) -(begin (register-function-arity (quote shen.aum) 2) (define (kl:shen.aum V1859 V1860) (cond ((and (pair? V1859) (and (pair? (car V1859)) (and (pair? (cdr V1859)) (and (eq? (quote :-) (car (cdr V1859))) (and (pair? (cdr (cdr V1859))) (null? (cdr (cdr (cdr V1859))))))))) (let ((MuApplication (kl:shen.make_mu_application (cons (quote shen.mu) (cons (cdr (car V1859)) (cons (kl:shen.continuation_call (cdr (car V1859)) (car (cdr (cdr V1859)))) (quote ())))) V1860))) (kl:shen.mu_reduction MuApplication (quote +)))) (#t (kl:shen.f_error (quote shen.aum))))) (quote shen.aum)) -(begin (register-function-arity (quote shen.continuation_call) 2) (define (kl:shen.continuation_call V1863 V1864) (let ((VTerms (cons (quote ProcessN) (kl:shen.extract_vars V1863)))) (let ((VBody (kl:shen.extract_vars V1864))) (let ((Free (kl:remove (quote Throwcontrol) (kl:difference VBody VTerms)))) (kl:shen.cc_help Free V1864))))) (quote shen.continuation_call)) -(begin (register-function-arity (quote remove) 2) (define (kl:remove V1867 V1868) (kl:shen.remove-h V1867 V1868 (quote ()))) (quote remove)) -(begin (register-function-arity (quote shen.remove-h) 3) (define (kl:shen.remove-h V1875 V1876 V1877) (cond ((null? V1876) (kl:reverse V1877)) ((and (pair? V1876) (kl:= (car V1876) V1875)) (kl:shen.remove-h (car V1876) (cdr V1876) V1877)) ((pair? V1876) (kl:shen.remove-h V1875 (cdr V1876) (cons (car V1876) V1877))) (#t (kl:shen.f_error (quote shen.remove-h))))) (quote shen.remove-h)) -(begin (register-function-arity (quote shen.cc_help) 2) (define (kl:shen.cc_help V1880 V1881) (cond ((and (null? V1880) (null? V1881)) (cons (quote shen.pop) (cons (quote shen.the) (cons (quote shen.stack) (quote ()))))) ((null? V1881) (cons (quote shen.rename) (cons (quote shen.the) (cons (quote shen.variables) (cons (quote in) (cons V1880 (cons (quote and) (cons (quote shen.then) (cons (cons (quote shen.pop) (cons (quote shen.the) (cons (quote shen.stack) (quote ())))) (quote ())))))))))) ((null? V1880) (cons (quote call) (cons (quote shen.the) (cons (quote shen.continuation) (cons V1881 (quote ())))))) (#t (cons (quote shen.rename) (cons (quote shen.the) (cons (quote shen.variables) (cons (quote in) (cons V1880 (cons (quote and) (cons (quote shen.then) (cons (cons (quote call) (cons (quote shen.the) (cons (quote shen.continuation) (cons V1881 (quote ()))))) (quote ())))))))))))) (quote shen.cc_help)) -(begin (register-function-arity (quote shen.make_mu_application) 2) (define (kl:shen.make_mu_application V1884 V1885) (cond ((and (pair? V1884) (and (eq? (quote shen.mu) (car V1884)) (and (pair? (cdr V1884)) (and (null? (car (cdr V1884))) (and (pair? (cdr (cdr V1884))) (and (null? (cdr (cdr (cdr V1884)))) (null? V1885))))))) (car (cdr (cdr V1884)))) ((and (pair? V1884) (and (eq? (quote shen.mu) (car V1884)) (and (pair? (cdr V1884)) (and (pair? (car (cdr V1884))) (and (pair? (cdr (cdr V1884))) (and (null? (cdr (cdr (cdr V1884)))) (pair? V1885))))))) (cons (cons (quote shen.mu) (cons (car (car (cdr V1884))) (cons (kl:shen.make_mu_application (cons (quote shen.mu) (cons (cdr (car (cdr V1884))) (cdr (cdr V1884)))) (cdr V1885)) (quote ())))) (cons (car V1885) (quote ())))) (#t (kl:shen.f_error (quote shen.make_mu_application))))) (quote shen.make_mu_application)) -(begin (register-function-arity (quote shen.mu_reduction) 2) (define (kl:shen.mu_reduction V1894 V1895) (cond ((and (pair? V1894) (and (pair? (car V1894)) (and (eq? (quote shen.mu) (car (car V1894))) (and (pair? (cdr (car V1894))) (and (pair? (car (cdr (car V1894)))) (and (eq? (quote mode) (car (car (cdr (car V1894))))) (and (pair? (cdr (car (cdr (car V1894))))) (and (pair? (cdr (cdr (car (cdr (car V1894)))))) (and (null? (cdr (cdr (cdr (car (cdr (car V1894))))))) (and (pair? (cdr (cdr (car V1894)))) (and (null? (cdr (cdr (cdr (car V1894))))) (and (pair? (cdr V1894)) (null? (cdr (cdr V1894))))))))))))))) (kl:shen.mu_reduction (cons (cons (quote shen.mu) (cons (car (cdr (car (cdr (car V1894))))) (cdr (cdr (car V1894))))) (cdr V1894)) (car (cdr (cdr (car (cdr (car V1894)))))))) ((and (pair? V1894) (and (pair? (car V1894)) (and (eq? (quote shen.mu) (car (car V1894))) (and (pair? (cdr (car V1894))) (and (pair? (cdr (cdr (car V1894)))) (and (null? (cdr (cdr (cdr (car V1894))))) (and (pair? (cdr V1894)) (and (null? (cdr (cdr V1894))) (eq? (quote _) (car (cdr (car V1894)))))))))))) (kl:shen.mu_reduction (car (cdr (cdr (car V1894)))) V1895)) ((and (pair? V1894) (and (pair? (car V1894)) (and (eq? (quote shen.mu) (car (car V1894))) (and (pair? (cdr (car V1894))) (and (pair? (cdr (cdr (car V1894)))) (and (null? (cdr (cdr (cdr (car V1894))))) (and (pair? (cdr V1894)) (and (null? (cdr (cdr V1894))) (assert-boolean (kl:shen.ephemeral_variable? (car (cdr (car V1894))) (car (cdr V1894)))))))))))) (kl:subst (car (cdr V1894)) (car (cdr (car V1894))) (kl:shen.mu_reduction (car (cdr (cdr (car V1894)))) V1895))) ((and (pair? V1894) (and (pair? (car V1894)) (and (eq? (quote shen.mu) (car (car V1894))) (and (pair? (cdr (car V1894))) (and (pair? (cdr (cdr (car V1894)))) (and (null? (cdr (cdr (cdr (car V1894))))) (and (pair? (cdr V1894)) (and (null? (cdr (cdr V1894))) (kl:variable? (car (cdr (car V1894)))))))))))) (cons (quote let) (cons (car (cdr (car V1894))) (cons (quote shen.be) (cons (car (cdr V1894)) (cons (quote in) (cons (kl:shen.mu_reduction (car (cdr (cdr (car V1894)))) V1895) (quote ())))))))) ((and (pair? V1894) (and (pair? (car V1894)) (and (eq? (quote shen.mu) (car (car V1894))) (and (pair? (cdr (car V1894))) (and (pair? (cdr (cdr (car V1894)))) (and (null? (cdr (cdr (cdr (car V1894))))) (and (pair? (cdr V1894)) (and (null? (cdr (cdr V1894))) (and (eq? (quote -) V1895) (assert-boolean (kl:shen.prolog_constant? (car (cdr (car V1894)))))))))))))) (let ((Z (kl:gensym (quote V)))) (cons (quote let) (cons Z (cons (quote shen.be) (cons (cons (quote shen.the) (cons (quote shen.result) (cons (quote shen.of) (cons (quote shen.dereferencing) (cdr V1894))))) (cons (quote in) (cons (cons (quote if) (cons (cons Z (cons (quote is) (cons (quote identical) (cons (quote shen.to) (cons (car (cdr (car V1894))) (quote ())))))) (cons (quote shen.then) (cons (kl:shen.mu_reduction (car (cdr (cdr (car V1894)))) (quote -)) (cons (quote shen.else) (cons (quote shen.failed!) (quote ()))))))) (quote ()))))))))) ((and (pair? V1894) (and (pair? (car V1894)) (and (eq? (quote shen.mu) (car (car V1894))) (and (pair? (cdr (car V1894))) (and (pair? (cdr (cdr (car V1894)))) (and (null? (cdr (cdr (cdr (car V1894))))) (and (pair? (cdr V1894)) (and (null? (cdr (cdr V1894))) (and (eq? (quote +) V1895) (assert-boolean (kl:shen.prolog_constant? (car (cdr (car V1894)))))))))))))) (let ((Z (kl:gensym (quote V)))) (cons (quote let) (cons Z (cons (quote shen.be) (cons (cons (quote shen.the) (cons (quote shen.result) (cons (quote shen.of) (cons (quote shen.dereferencing) (cdr V1894))))) (cons (quote in) (cons (cons (quote if) (cons (cons Z (cons (quote is) (cons (quote identical) (cons (quote shen.to) (cons (car (cdr (car V1894))) (quote ())))))) (cons (quote shen.then) (cons (kl:shen.mu_reduction (car (cdr (cdr (car V1894)))) (quote +)) (cons (quote shen.else) (cons (cons (quote if) (cons (cons Z (cons (quote is) (cons (quote shen.a) (cons (quote shen.variable) (quote ()))))) (cons (quote shen.then) (cons (cons (quote bind) (cons Z (cons (quote shen.to) (cons (car (cdr (car V1894))) (cons (quote in) (cons (kl:shen.mu_reduction (car (cdr (cdr (car V1894)))) (quote +)) (quote ()))))))) (cons (quote shen.else) (cons (quote shen.failed!) (quote ()))))))) (quote ()))))))) (quote ()))))))))) ((and (pair? V1894) (and (pair? (car V1894)) (and (eq? (quote shen.mu) (car (car V1894))) (and (pair? (cdr (car V1894))) (and (pair? (car (cdr (car V1894)))) (and (pair? (cdr (cdr (car V1894)))) (and (null? (cdr (cdr (cdr (car V1894))))) (and (pair? (cdr V1894)) (and (null? (cdr (cdr V1894))) (eq? (quote -) V1895)))))))))) (let ((Z (kl:gensym (quote V)))) (cons (quote let) (cons Z (cons (quote shen.be) (cons (cons (quote shen.the) (cons (quote shen.result) (cons (quote shen.of) (cons (quote shen.dereferencing) (cdr V1894))))) (cons (quote in) (cons (cons (quote if) (cons (cons Z (cons (quote is) (cons (quote shen.a) (cons (quote shen.non-empty) (cons (quote list) (quote ())))))) (cons (quote shen.then) (cons (kl:shen.mu_reduction (cons (cons (quote shen.mu) (cons (car (car (cdr (car V1894)))) (cons (cons (cons (quote shen.mu) (cons (cdr (car (cdr (car V1894)))) (cdr (cdr (car V1894))))) (cons (cons (quote shen.the) (cons (quote tail) (cons (quote shen.of) (cons Z (quote ()))))) (quote ()))) (quote ())))) (cons (cons (quote shen.the) (cons (quote head) (cons (quote shen.of) (cons Z (quote ()))))) (quote ()))) (quote -)) (cons (quote shen.else) (cons (quote shen.failed!) (quote ()))))))) (quote ()))))))))) ((and (pair? V1894) (and (pair? (car V1894)) (and (eq? (quote shen.mu) (car (car V1894))) (and (pair? (cdr (car V1894))) (and (pair? (car (cdr (car V1894)))) (and (pair? (cdr (cdr (car V1894)))) (and (null? (cdr (cdr (cdr (car V1894))))) (and (pair? (cdr V1894)) (and (null? (cdr (cdr V1894))) (eq? (quote +) V1895)))))))))) (let ((Z (kl:gensym (quote V)))) (cons (quote let) (cons Z (cons (quote shen.be) (cons (cons (quote shen.the) (cons (quote shen.result) (cons (quote shen.of) (cons (quote shen.dereferencing) (cdr V1894))))) (cons (quote in) (cons (cons (quote if) (cons (cons Z (cons (quote is) (cons (quote shen.a) (cons (quote shen.non-empty) (cons (quote list) (quote ())))))) (cons (quote shen.then) (cons (kl:shen.mu_reduction (cons (cons (quote shen.mu) (cons (car (car (cdr (car V1894)))) (cons (cons (cons (quote shen.mu) (cons (cdr (car (cdr (car V1894)))) (cdr (cdr (car V1894))))) (cons (cons (quote shen.the) (cons (quote tail) (cons (quote shen.of) (cons Z (quote ()))))) (quote ()))) (quote ())))) (cons (cons (quote shen.the) (cons (quote head) (cons (quote shen.of) (cons Z (quote ()))))) (quote ()))) (quote +)) (cons (quote shen.else) (cons (cons (quote if) (cons (cons Z (cons (quote is) (cons (quote shen.a) (cons (quote shen.variable) (quote ()))))) (cons (quote shen.then) (cons (cons (quote shen.rename) (cons (quote shen.the) (cons (quote shen.variables) (cons (quote in) (cons (kl:shen.extract_vars (car (cdr (car V1894)))) (cons (quote and) (cons (quote shen.then) (cons (cons (quote bind) (cons Z (cons (quote shen.to) (cons (kl:shen.rcons_form (kl:shen.remove_modes (car (cdr (car V1894))))) (cons (quote in) (cons (kl:shen.mu_reduction (car (cdr (cdr (car V1894)))) (quote +)) (quote ()))))))) (quote ()))))))))) (cons (quote shen.else) (cons (quote shen.failed!) (quote ()))))))) (quote ()))))))) (quote ()))))))))) (#t V1894))) (quote shen.mu_reduction)) -(begin (register-function-arity (quote shen.rcons_form) 1) (define (kl:shen.rcons_form V1897) (cond ((pair? V1897) (cons (quote cons) (cons (kl:shen.rcons_form (car V1897)) (cons (kl:shen.rcons_form (cdr V1897)) (quote ()))))) (#t V1897))) (quote shen.rcons_form)) -(begin (register-function-arity (quote shen.remove_modes) 1) (define (kl:shen.remove_modes V1899) (cond ((and (pair? V1899) (and (eq? (quote mode) (car V1899)) (and (pair? (cdr V1899)) (and (pair? (cdr (cdr V1899))) (and (eq? (quote +) (car (cdr (cdr V1899)))) (null? (cdr (cdr (cdr V1899))))))))) (kl:shen.remove_modes (car (cdr V1899)))) ((and (pair? V1899) (and (eq? (quote mode) (car V1899)) (and (pair? (cdr V1899)) (and (pair? (cdr (cdr V1899))) (and (eq? (quote -) (car (cdr (cdr V1899)))) (null? (cdr (cdr (cdr V1899))))))))) (kl:shen.remove_modes (car (cdr V1899)))) ((pair? V1899) (cons (kl:shen.remove_modes (car V1899)) (kl:shen.remove_modes (cdr V1899)))) (#t V1899))) (quote shen.remove_modes)) -(begin (register-function-arity (quote shen.ephemeral_variable?) 2) (define (kl:shen.ephemeral_variable? V1902 V1903) (and (kl:variable? V1902) (kl:variable? V1903))) (quote shen.ephemeral_variable?)) -(begin (register-function-arity (quote shen.prolog_constant?) 1) (define (kl:shen.prolog_constant? V1913) (cond ((pair? V1913) #f) (#t #t))) (quote shen.prolog_constant?)) -(begin (register-function-arity (quote shen.aum_to_shen) 1) (define (kl:shen.aum_to_shen V1915) (cond ((and (pair? V1915) (and (eq? (quote let) (car V1915)) (and (pair? (cdr V1915)) (and (pair? (cdr (cdr V1915))) (and (eq? (quote shen.be) (car (cdr (cdr V1915)))) (and (pair? (cdr (cdr (cdr V1915)))) (and (pair? (cdr (cdr (cdr (cdr V1915))))) (and (eq? (quote in) (car (cdr (cdr (cdr (cdr V1915)))))) (and (pair? (cdr (cdr (cdr (cdr (cdr V1915)))))) (null? (cdr (cdr (cdr (cdr (cdr (cdr V1915)))))))))))))))) (cons (quote let) (cons (car (cdr V1915)) (cons (kl:shen.aum_to_shen (car (cdr (cdr (cdr V1915))))) (cons (kl:shen.aum_to_shen (car (cdr (cdr (cdr (cdr (cdr V1915))))))) (quote ())))))) ((and (pair? V1915) (and (eq? (quote shen.the) (car V1915)) (and (pair? (cdr V1915)) (and (eq? (quote shen.result) (car (cdr V1915))) (and (pair? (cdr (cdr V1915))) (and (eq? (quote shen.of) (car (cdr (cdr V1915)))) (and (pair? (cdr (cdr (cdr V1915)))) (and (eq? (quote shen.dereferencing) (car (cdr (cdr (cdr V1915))))) (and (pair? (cdr (cdr (cdr (cdr V1915))))) (null? (cdr (cdr (cdr (cdr (cdr V1915))))))))))))))) (cons (quote shen.lazyderef) (cons (kl:shen.aum_to_shen (car (cdr (cdr (cdr (cdr V1915)))))) (cons (quote ProcessN) (quote ()))))) ((and (pair? V1915) (and (eq? (quote if) (car V1915)) (and (pair? (cdr V1915)) (and (pair? (cdr (cdr V1915))) (and (eq? (quote shen.then) (car (cdr (cdr V1915)))) (and (pair? (cdr (cdr (cdr V1915)))) (and (pair? (cdr (cdr (cdr (cdr V1915))))) (and (eq? (quote shen.else) (car (cdr (cdr (cdr (cdr V1915)))))) (and (pair? (cdr (cdr (cdr (cdr (cdr V1915)))))) (null? (cdr (cdr (cdr (cdr (cdr (cdr V1915)))))))))))))))) (cons (quote if) (cons (kl:shen.aum_to_shen (car (cdr V1915))) (cons (kl:shen.aum_to_shen (car (cdr (cdr (cdr V1915))))) (cons (kl:shen.aum_to_shen (car (cdr (cdr (cdr (cdr (cdr V1915))))))) (quote ())))))) ((and (pair? V1915) (and (pair? (cdr V1915)) (and (eq? (quote is) (car (cdr V1915))) (and (pair? (cdr (cdr V1915))) (and (eq? (quote shen.a) (car (cdr (cdr V1915)))) (and (pair? (cdr (cdr (cdr V1915)))) (and (eq? (quote shen.variable) (car (cdr (cdr (cdr V1915))))) (null? (cdr (cdr (cdr (cdr V1915)))))))))))) (cons (quote shen.pvar?) (cons (car V1915) (quote ())))) ((and (pair? V1915) (and (pair? (cdr V1915)) (and (eq? (quote is) (car (cdr V1915))) (and (pair? (cdr (cdr V1915))) (and (eq? (quote shen.a) (car (cdr (cdr V1915)))) (and (pair? (cdr (cdr (cdr V1915)))) (and (eq? (quote shen.non-empty) (car (cdr (cdr (cdr V1915))))) (and (pair? (cdr (cdr (cdr (cdr V1915))))) (and (eq? (quote list) (car (cdr (cdr (cdr (cdr V1915)))))) (null? (cdr (cdr (cdr (cdr (cdr V1915))))))))))))))) (cons (quote cons?) (cons (car V1915) (quote ())))) ((and (pair? V1915) (and (eq? (quote shen.rename) (car V1915)) (and (pair? (cdr V1915)) (and (eq? (quote shen.the) (car (cdr V1915))) (and (pair? (cdr (cdr V1915))) (and (eq? (quote shen.variables) (car (cdr (cdr V1915)))) (and (pair? (cdr (cdr (cdr V1915)))) (and (eq? (quote in) (car (cdr (cdr (cdr V1915))))) (and (pair? (cdr (cdr (cdr (cdr V1915))))) (and (null? (car (cdr (cdr (cdr (cdr V1915)))))) (and (pair? (cdr (cdr (cdr (cdr (cdr V1915)))))) (and (eq? (quote and) (car (cdr (cdr (cdr (cdr (cdr V1915))))))) (and (pair? (cdr (cdr (cdr (cdr (cdr (cdr V1915))))))) (and (eq? (quote shen.then) (car (cdr (cdr (cdr (cdr (cdr (cdr V1915)))))))) (and (pair? (cdr (cdr (cdr (cdr (cdr (cdr (cdr V1915)))))))) (null? (cdr (cdr (cdr (cdr (cdr (cdr (cdr (cdr V1915)))))))))))))))))))))))) (kl:shen.aum_to_shen (car (cdr (cdr (cdr (cdr (cdr (cdr (cdr V1915)))))))))) ((and (pair? V1915) (and (eq? (quote shen.rename) (car V1915)) (and (pair? (cdr V1915)) (and (eq? (quote shen.the) (car (cdr V1915))) (and (pair? (cdr (cdr V1915))) (and (eq? (quote shen.variables) (car (cdr (cdr V1915)))) (and (pair? (cdr (cdr (cdr V1915)))) (and (eq? (quote in) (car (cdr (cdr (cdr V1915))))) (and (pair? (cdr (cdr (cdr (cdr V1915))))) (and (pair? (car (cdr (cdr (cdr (cdr V1915)))))) (and (pair? (cdr (cdr (cdr (cdr (cdr V1915)))))) (and (eq? (quote and) (car (cdr (cdr (cdr (cdr (cdr V1915))))))) (and (pair? (cdr (cdr (cdr (cdr (cdr (cdr V1915))))))) (and (eq? (quote shen.then) (car (cdr (cdr (cdr (cdr (cdr (cdr V1915)))))))) (and (pair? (cdr (cdr (cdr (cdr (cdr (cdr (cdr V1915)))))))) (null? (cdr (cdr (cdr (cdr (cdr (cdr (cdr (cdr V1915)))))))))))))))))))))))) (cons (quote let) (cons (car (car (cdr (cdr (cdr (cdr V1915)))))) (cons (cons (quote shen.newpv) (cons (quote ProcessN) (quote ()))) (cons (kl:shen.aum_to_shen (cons (quote shen.rename) (cons (quote shen.the) (cons (quote shen.variables) (cons (quote in) (cons (cdr (car (cdr (cdr (cdr (cdr V1915)))))) (cdr (cdr (cdr (cdr (cdr V1915))))))))))) (quote ())))))) ((and (pair? V1915) (and (eq? (quote bind) (car V1915)) (and (pair? (cdr V1915)) (and (pair? (cdr (cdr V1915))) (and (eq? (quote shen.to) (car (cdr (cdr V1915)))) (and (pair? (cdr (cdr (cdr V1915)))) (and (pair? (cdr (cdr (cdr (cdr V1915))))) (and (eq? (quote in) (car (cdr (cdr (cdr (cdr V1915)))))) (and (pair? (cdr (cdr (cdr (cdr (cdr V1915)))))) (null? (cdr (cdr (cdr (cdr (cdr (cdr V1915)))))))))))))))) (cons (quote do) (cons (cons (quote shen.bindv) (cons (car (cdr V1915)) (cons (kl:shen.chwild (car (cdr (cdr (cdr V1915))))) (cons (quote ProcessN) (quote ()))))) (cons (cons (quote let) (cons (quote Result) (cons (kl:shen.aum_to_shen (car (cdr (cdr (cdr (cdr (cdr V1915))))))) (cons (cons (quote do) (cons (cons (quote shen.unbindv) (cons (car (cdr V1915)) (cons (quote ProcessN) (quote ())))) (cons (quote Result) (quote ())))) (quote ()))))) (quote ()))))) ((and (pair? V1915) (and (pair? (cdr V1915)) (and (eq? (quote is) (car (cdr V1915))) (and (pair? (cdr (cdr V1915))) (and (eq? (quote identical) (car (cdr (cdr V1915)))) (and (pair? (cdr (cdr (cdr V1915)))) (and (eq? (quote shen.to) (car (cdr (cdr (cdr V1915))))) (and (pair? (cdr (cdr (cdr (cdr V1915))))) (null? (cdr (cdr (cdr (cdr (cdr V1915)))))))))))))) (cons (quote =) (cons (car (cdr (cdr (cdr (cdr V1915))))) (cons (car V1915) (quote ()))))) ((eq? (quote shen.failed!) V1915) #f) ((and (pair? V1915) (and (eq? (quote shen.the) (car V1915)) (and (pair? (cdr V1915)) (and (eq? (quote head) (car (cdr V1915))) (and (pair? (cdr (cdr V1915))) (and (eq? (quote shen.of) (car (cdr (cdr V1915)))) (and (pair? (cdr (cdr (cdr V1915)))) (null? (cdr (cdr (cdr (cdr V1915)))))))))))) (cons (quote hd) (cdr (cdr (cdr V1915))))) ((and (pair? V1915) (and (eq? (quote shen.the) (car V1915)) (and (pair? (cdr V1915)) (and (eq? (quote tail) (car (cdr V1915))) (and (pair? (cdr (cdr V1915))) (and (eq? (quote shen.of) (car (cdr (cdr V1915)))) (and (pair? (cdr (cdr (cdr V1915)))) (null? (cdr (cdr (cdr (cdr V1915)))))))))))) (cons (quote tl) (cdr (cdr (cdr V1915))))) ((and (pair? V1915) (and (eq? (quote shen.pop) (car V1915)) (and (pair? (cdr V1915)) (and (eq? (quote shen.the) (car (cdr V1915))) (and (pair? (cdr (cdr V1915))) (and (eq? (quote shen.stack) (car (cdr (cdr V1915)))) (null? (cdr (cdr (cdr V1915)))))))))) (cons (quote do) (cons (cons (quote shen.incinfs) (quote ())) (cons (cons (quote thaw) (cons (quote Continuation) (quote ()))) (quote ()))))) ((and (pair? V1915) (and (eq? (quote call) (car V1915)) (and (pair? (cdr V1915)) (and (eq? (quote shen.the) (car (cdr V1915))) (and (pair? (cdr (cdr V1915))) (and (eq? (quote shen.continuation) (car (cdr (cdr V1915)))) (and (pair? (cdr (cdr (cdr V1915)))) (null? (cdr (cdr (cdr (cdr V1915)))))))))))) (cons (quote do) (cons (cons (quote shen.incinfs) (quote ())) (cons (kl:shen.call_the_continuation (kl:shen.chwild (car (cdr (cdr (cdr V1915))))) (quote ProcessN) (quote Continuation)) (quote ()))))) (#t V1915))) (quote shen.aum_to_shen)) -(begin (register-function-arity (quote shen.chwild) 1) (define (kl:shen.chwild V1917) (cond ((eq? V1917 (quote _)) (cons (quote shen.newpv) (cons (quote ProcessN) (quote ())))) ((pair? V1917) (kl:map (lambda (Z) (kl:shen.chwild Z)) V1917)) (#t V1917))) (quote shen.chwild)) -(begin (register-function-arity (quote shen.newpv) 1) (define (kl:shen.newpv V1919) (let ((Count+1 (+ (vector-ref (kl:value (quote shen.*varcounter*)) V1919) 1))) (let ((IncVar (let ((_tmp (kl:value (quote shen.*varcounter*)))) (vector-set! _tmp V1919 Count+1) _tmp))) (let ((Vector (vector-ref (kl:value (quote shen.*prologvectors*)) V1919))) (let ((ResizeVectorIfNeeded (if (kl:= Count+1 (kl:limit Vector)) (kl:shen.resizeprocessvector V1919 Count+1) (quote shen.skip)))) (kl:shen.mk-pvar Count+1)))))) (quote shen.newpv)) -(begin (register-function-arity (quote shen.resizeprocessvector) 2) (define (kl:shen.resizeprocessvector V1922 V1923) (let ((Vector (vector-ref (kl:value (quote shen.*prologvectors*)) V1922))) (let ((BigVector (kl:shen.resize-vector Vector (+ V1923 V1923) (quote shen.-null-)))) (let ((_tmp (kl:value (quote shen.*prologvectors*)))) (vector-set! _tmp V1922 BigVector) _tmp)))) (quote shen.resizeprocessvector)) -(begin (register-function-arity (quote shen.resize-vector) 3) (define (kl:shen.resize-vector V1927 V1928 V1929) (let ((BigVector (let ((_tmp (make-vector (+ 1 V1928) (quote (quote shen.fail!))))) (vector-set! _tmp 0 V1928) _tmp))) (kl:shen.copy-vector V1927 BigVector (kl:limit V1927) V1928 V1929))) (quote shen.resize-vector)) -(begin (register-function-arity (quote shen.copy-vector) 5) (define (kl:shen.copy-vector V1935 V1936 V1937 V1938 V1939) (kl:shen.copy-vector-stage-2 (+ 1 V1937) (+ V1938 1) V1939 (kl:shen.copy-vector-stage-1 1 V1935 V1936 (+ 1 V1937)))) (quote shen.copy-vector)) -(begin (register-function-arity (quote shen.copy-vector-stage-1) 4) (define (kl:shen.copy-vector-stage-1 V1947 V1948 V1949 V1950) (cond ((kl:= V1950 V1947) V1949) (#t (kl:shen.copy-vector-stage-1 (+ 1 V1947) V1948 (let ((_tmp V1949)) (vector-set! _tmp V1947 (vector-ref V1948 V1947)) _tmp) V1950)))) (quote shen.copy-vector-stage-1)) -(begin (register-function-arity (quote shen.copy-vector-stage-2) 4) (define (kl:shen.copy-vector-stage-2 V1958 V1959 V1960 V1961) (cond ((kl:= V1959 V1958) V1961) (#t (kl:shen.copy-vector-stage-2 (+ V1958 1) V1959 V1960 (let ((_tmp V1961)) (vector-set! _tmp V1958 V1960) _tmp))))) (quote shen.copy-vector-stage-2)) -(begin (register-function-arity (quote shen.mk-pvar) 1) (define (kl:shen.mk-pvar V1963) (let ((_tmp (let ((_tmp (make-vector 2 (quote (quote shen.fail!))))) (vector-set! _tmp 0 (quote shen.pvar)) _tmp))) (vector-set! _tmp 1 V1963) _tmp)) (quote shen.mk-pvar)) -(begin (register-function-arity (quote shen.pvar?) 1) (define (kl:shen.pvar? V1965) (and (vector? V1965) (eq? (guard (lambda (E) (quote shen.not-pvar)) (vector-ref V1965 0)) (quote shen.pvar)))) (quote shen.pvar?)) -(begin (register-function-arity (quote shen.bindv) 3) (define (kl:shen.bindv V1969 V1970 V1971) (let ((Vector (vector-ref (kl:value (quote shen.*prologvectors*)) V1971))) (let ((_tmp Vector)) (vector-set! _tmp (vector-ref V1969 1) V1970) _tmp))) (quote shen.bindv)) -(begin (register-function-arity (quote shen.unbindv) 2) (define (kl:shen.unbindv V1974 V1975) (let ((Vector (vector-ref (kl:value (quote shen.*prologvectors*)) V1975))) (let ((_tmp Vector)) (vector-set! _tmp (vector-ref V1974 1) (quote shen.-null-)) _tmp))) (quote shen.unbindv)) -(begin (register-function-arity (quote shen.incinfs) 0) (define (kl:shen.incinfs) (kl:set (quote shen.*infs*) (+ 1 (kl:value (quote shen.*infs*))))) (quote shen.incinfs)) -(begin (register-function-arity (quote shen.call_the_continuation) 3) (define (kl:shen.call_the_continuation V1979 V1980 V1981) (cond ((and (pair? V1979) (and (pair? (car V1979)) (null? (cdr V1979)))) (cons (car (car V1979)) (kl:append (cdr (car V1979)) (cons V1980 (cons V1981 (quote ())))))) ((and (pair? V1979) (pair? (car V1979))) (let ((NewContinuation (kl:shen.newcontinuation (cdr V1979) V1980 V1981))) (cons (car (car V1979)) (kl:append (cdr (car V1979)) (cons V1980 (cons NewContinuation (quote ()))))))) (#t (kl:shen.f_error (quote shen.call_the_continuation))))) (quote shen.call_the_continuation)) -(begin (register-function-arity (quote shen.newcontinuation) 3) (define (kl:shen.newcontinuation V1985 V1986 V1987) (cond ((null? V1985) V1987) ((and (pair? V1985) (pair? (car V1985))) (cons (quote freeze) (cons (cons (car (car V1985)) (kl:append (cdr (car V1985)) (cons V1986 (cons (kl:shen.newcontinuation (cdr V1985) V1986 V1987) (quote ()))))) (quote ())))) (#t (kl:shen.f_error (quote shen.newcontinuation))))) (quote shen.newcontinuation)) -(begin (register-function-arity (quote return) 3) (define (kl:return V1995 V1996 V1997) (kl:shen.deref V1995 V1996)) (quote return)) -(begin (register-function-arity (quote shen.measure&return) 3) (define (kl:shen.measure&return V2005 V2006 V2007) (begin (kl:shen.prhush (kl:shen.app (kl:value (quote shen.*infs*)) " inferences\n" (quote shen.a)) (kl:stoutput)) (kl:shen.deref V2005 V2006))) (quote shen.measure&return)) -(begin (register-function-arity (quote unify) 4) (define (kl:unify V2012 V2013 V2014 V2015) (kl:shen.lzy= (kl:shen.lazyderef V2012 V2014) (kl:shen.lazyderef V2013 V2014) V2014 V2015)) (quote unify)) -(begin (register-function-arity (quote shen.lzy=) 4) (define (kl:shen.lzy= V2037 V2038 V2039 V2040) (cond ((kl:= V2038 V2037) (kl:thaw V2040)) ((kl:shen.pvar? V2037) (kl:bind V2037 V2038 V2039 V2040)) ((kl:shen.pvar? V2038) (kl:bind V2038 V2037 V2039 V2040)) ((and (pair? V2037) (pair? V2038)) (kl:shen.lzy= (kl:shen.lazyderef (car V2037) V2039) (kl:shen.lazyderef (car V2038) V2039) V2039 (lambda () (kl:shen.lzy= (kl:shen.lazyderef (cdr V2037) V2039) (kl:shen.lazyderef (cdr V2038) V2039) V2039 V2040)))) (#t #f))) (quote shen.lzy=)) -(begin (register-function-arity (quote shen.deref) 2) (define (kl:shen.deref V2043 V2044) (cond ((pair? V2043) (cons (kl:shen.deref (car V2043) V2044) (kl:shen.deref (cdr V2043) V2044))) (#t (if (kl:shen.pvar? V2043) (let ((Value (kl:shen.valvector V2043 V2044))) (if (eq? Value (quote shen.-null-)) V2043 (kl:shen.deref Value V2044))) V2043)))) (quote shen.deref)) -(begin (register-function-arity (quote shen.lazyderef) 2) (define (kl:shen.lazyderef V2047 V2048) (if (kl:shen.pvar? V2047) (let ((Value (kl:shen.valvector V2047 V2048))) (if (eq? Value (quote shen.-null-)) V2047 (kl:shen.lazyderef Value V2048))) V2047)) (quote shen.lazyderef)) -(begin (register-function-arity (quote shen.valvector) 2) (define (kl:shen.valvector V2051 V2052) (vector-ref (vector-ref (kl:value (quote shen.*prologvectors*)) V2052) (vector-ref V2051 1))) (quote shen.valvector)) -(begin (register-function-arity (quote unify!) 4) (define (kl:unify! V2057 V2058 V2059 V2060) (kl:shen.lzy=! (kl:shen.lazyderef V2057 V2059) (kl:shen.lazyderef V2058 V2059) V2059 V2060)) (quote unify!)) -(begin (register-function-arity (quote shen.lzy=!) 4) (define (kl:shen.lzy=! V2082 V2083 V2084 V2085) (cond ((kl:= V2083 V2082) (kl:thaw V2085)) ((and (kl:shen.pvar? V2082) (kl:not (kl:shen.occurs? V2082 (kl:shen.deref V2083 V2084)))) (kl:bind V2082 V2083 V2084 V2085)) ((and (kl:shen.pvar? V2083) (kl:not (kl:shen.occurs? V2083 (kl:shen.deref V2082 V2084)))) (kl:bind V2083 V2082 V2084 V2085)) ((and (pair? V2082) (pair? V2083)) (kl:shen.lzy=! (kl:shen.lazyderef (car V2082) V2084) (kl:shen.lazyderef (car V2083) V2084) V2084 (lambda () (kl:shen.lzy=! (kl:shen.lazyderef (cdr V2082) V2084) (kl:shen.lazyderef (cdr V2083) V2084) V2084 V2085)))) (#t #f))) (quote shen.lzy=!)) -(begin (register-function-arity (quote shen.occurs?) 2) (define (kl:shen.occurs? V2097 V2098) (cond ((kl:= V2098 V2097) #t) ((pair? V2098) (or (assert-boolean (kl:shen.occurs? V2097 (car V2098))) (assert-boolean (kl:shen.occurs? V2097 (cdr V2098))))) (#t #f))) (quote shen.occurs?)) -(begin (register-function-arity (quote identical) 4) (define (kl:identical V2103 V2104 V2105 V2106) (kl:shen.lzy== (kl:shen.lazyderef V2103 V2105) (kl:shen.lazyderef V2104 V2105) V2105 V2106)) (quote identical)) -(begin (register-function-arity (quote shen.lzy==) 4) (define (kl:shen.lzy== V2128 V2129 V2130 V2131) (cond ((kl:= V2129 V2128) (kl:thaw V2131)) ((and (pair? V2128) (pair? V2129)) (kl:shen.lzy== (kl:shen.lazyderef (car V2128) V2130) (kl:shen.lazyderef (car V2129) V2130) V2130 (lambda () (kl:shen.lzy== (cdr V2128) (cdr V2129) V2130 V2131)))) (#t #f))) (quote shen.lzy==)) -(begin (register-function-arity (quote shen.pvar) 1) (define (kl:shen.pvar V2133) (string-append "Var" (kl:shen.app (vector-ref V2133 1) "" (quote shen.a)))) (quote shen.pvar)) -(begin (register-function-arity (quote bind) 4) (define (kl:bind V2138 V2139 V2140 V2141) (begin (kl:shen.bindv V2138 V2139 V2140) (let ((Result (kl:thaw V2141))) (begin (kl:shen.unbindv V2138 V2140) Result)))) (quote bind)) -(begin (register-function-arity (quote fwhen) 3) (define (kl:fwhen V2159 V2160 V2161) (cond ((kl:= #t V2159) (kl:thaw V2161)) ((kl:= #f V2159) #f) (#t (simple-error (string-append "fwhen expects a boolean: not " (kl:shen.app V2159 "%" (quote shen.s))))))) (quote fwhen)) -(begin (register-function-arity (quote call) 3) (define (kl:call V2177 V2178 V2179) (cond ((pair? V2177) (kl:shen.call-help (kl:function (kl:shen.lazyderef (car V2177) V2178)) (cdr V2177) V2178 V2179)) ((kl:shen.pvar? V2177) (kl:call (kl:shen.lazyderef V2177 V2178) V2178 V2179)) (#t #f))) (quote call)) -(begin (register-function-arity (quote shen.call-help) 4) (define (kl:shen.call-help V2184 V2185 V2186 V2187) (cond ((null? V2185) ((V2184 V2186) V2187)) ((pair? V2185) (kl:shen.call-help (V2184 (car V2185)) (cdr V2185) V2186 V2187)) (#t (kl:shen.f_error (quote shen.call-help))))) (quote shen.call-help)) -(begin (register-function-arity (quote shen.intprolog) 1) (define (kl:shen.intprolog V2189) (cond ((and (pair? V2189) (pair? (car V2189))) (let ((ProcessN (kl:shen.start-new-prolog-process))) (kl:shen.intprolog-help (car (car V2189)) (kl:shen.insert-prolog-variables (cons (cdr (car V2189)) (cons (cdr V2189) (quote ()))) ProcessN) ProcessN))) (#t (kl:shen.f_error (quote shen.intprolog))))) (quote shen.intprolog)) -(begin (register-function-arity (quote shen.intprolog-help) 3) (define (kl:shen.intprolog-help V2193 V2194 V2195) (cond ((and (pair? V2194) (and (pair? (cdr V2194)) (null? (cdr (cdr V2194))))) (kl:shen.intprolog-help-help V2193 (car V2194) (car (cdr V2194)) V2195)) (#t (kl:shen.f_error (quote shen.intprolog-help))))) (quote shen.intprolog-help)) -(begin (register-function-arity (quote shen.intprolog-help-help) 4) (define (kl:shen.intprolog-help-help V2200 V2201 V2202 V2203) (cond ((null? V2201) ((V2200 V2203) (lambda () (kl:shen.call-rest V2202 V2203)))) ((pair? V2201) (kl:shen.intprolog-help-help (V2200 (car V2201)) (cdr V2201) V2202 V2203)) (#t (kl:shen.f_error (quote shen.intprolog-help-help))))) (quote shen.intprolog-help-help)) -(begin (register-function-arity (quote shen.call-rest) 2) (define (kl:shen.call-rest V2208 V2209) (cond ((null? V2208) #t) ((and (pair? V2208) (and (pair? (car V2208)) (pair? (cdr (car V2208))))) (kl:shen.call-rest (cons (cons ((car (car V2208)) (car (cdr (car V2208)))) (cdr (cdr (car V2208)))) (cdr V2208)) V2209)) ((and (pair? V2208) (and (pair? (car V2208)) (null? (cdr (car V2208))))) (((car (car V2208)) V2209) (lambda () (kl:shen.call-rest (cdr V2208) V2209)))) (#t (kl:shen.f_error (quote shen.call-rest))))) (quote shen.call-rest)) -(begin (register-function-arity (quote shen.start-new-prolog-process) 0) (define (kl:shen.start-new-prolog-process) (let ((IncrementProcessCounter (kl:set (quote shen.*process-counter*) (+ 1 (kl:value (quote shen.*process-counter*)))))) (kl:shen.initialise-prolog IncrementProcessCounter))) (quote shen.start-new-prolog-process)) -(begin (register-function-arity (quote shen.insert-prolog-variables) 2) (define (kl:shen.insert-prolog-variables V2212 V2213) (kl:shen.insert-prolog-variables-help V2212 (kl:shen.flatten V2212) V2213)) (quote shen.insert-prolog-variables)) -(begin (register-function-arity (quote shen.insert-prolog-variables-help) 3) (define (kl:shen.insert-prolog-variables-help V2221 V2222 V2223) (cond ((null? V2222) V2221) ((and (pair? V2222) (kl:variable? (car V2222))) (let ((V (kl:shen.newpv V2223))) (let ((XV/Y (kl:subst V (car V2222) V2221))) (let ((Z-Y (kl:remove (car V2222) (cdr V2222)))) (kl:shen.insert-prolog-variables-help XV/Y Z-Y V2223))))) ((pair? V2222) (kl:shen.insert-prolog-variables-help V2221 (cdr V2222) V2223)) (#t (kl:shen.f_error (quote shen.insert-prolog-variables-help))))) (quote shen.insert-prolog-variables-help)) -(begin (register-function-arity (quote shen.initialise-prolog) 1) (define (kl:shen.initialise-prolog V2225) (let ((Vector (let ((_tmp (kl:value (quote shen.*prologvectors*)))) (vector-set! _tmp V2225 (kl:shen.fillvector (kl:vector 10) 1 10 (quote shen.-null-))) _tmp))) (let ((Counter (let ((_tmp (kl:value (quote shen.*varcounter*)))) (vector-set! _tmp V2225 1) _tmp))) V2225))) (quote shen.initialise-prolog)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1664) (let ((Parse_shen. (kl:shen. V1664))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (car (kl:shen.prolog->shen (kl:map (lambda (Parse_X) (kl:shen.insert-predicate (kl:shen.hdtl Parse_shen.) Parse_X)) (kl:shen.hdtl Parse_shen.))))) (kl:fail))) (kl:fail)))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.prolog-error) 2) (define (kl:shen.prolog-error V1673 V1674) (cond ((and (pair? V1674) (and (pair? (cdr V1674)) (null? (cdr (cdr V1674))))) (simple-error (string-append "prolog syntax error in " (kl:shen.app V1673 (string-append " here:\n\n " (kl:shen.app (kl:shen.next-50 50 (car V1674)) "\n" (quote shen.a))) (quote shen.a))))) (#t (simple-error (string-append "prolog syntax error in " (kl:shen.app V1673 "\n" (quote shen.a))))))) (export shen.prolog-error) (quote shen.prolog-error)) +(begin (register-function-arity (quote shen.next-50) 2) (define (kl:shen.next-50 V1681 V1682) (cond ((null? V1682) "") ((kl:= 0 V1681) "") ((pair? V1682) (string-append (kl:shen.decons-string (car V1682)) (kl:shen.next-50 (- V1681 1) (cdr V1682)))) (#t (kl:shen.f_error (quote shen.next-50))))) (export shen.next-50) (quote shen.next-50)) +(begin (register-function-arity (quote shen.decons-string) 1) (define (kl:shen.decons-string V1684) (cond ((and (pair? V1684) (and (eq? (quote cons) (car V1684)) (and (pair? (cdr V1684)) (and (pair? (cdr (cdr V1684))) (null? (cdr (cdr (cdr V1684)))))))) (kl:shen.app (kl:shen.eval-cons V1684) " " (quote shen.s))) (#t (kl:shen.app V1684 " " (quote shen.r))))) (export shen.decons-string) (quote shen.decons-string)) +(begin (register-function-arity (quote shen.insert-predicate) 2) (define (kl:shen.insert-predicate V1687 V1688) (cond ((and (pair? V1688) (and (pair? (cdr V1688)) (null? (cdr (cdr V1688))))) (cons (cons V1687 (car V1688)) (cons (quote :-) (cdr V1688)))) (#t (kl:shen.f_error (quote shen.insert-predicate))))) (export shen.insert-predicate) (quote shen.insert-predicate)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1690) (if (pair? (car V1690)) (let ((Parse_X (kl:shen.hdhd V1690))) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V1690) (kl:shen.hdtl V1690))) Parse_X)) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1692) (let ((YaccParse (let ((Parse_shen. (kl:shen. V1692))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_ (kl: V1692))) (if (kl:not (kl:= (kl:fail) Parse_)) (kl:shen.pair (car Parse_) (quote ())) (kl:fail))) YaccParse))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1695) (let ((Parse_shen. (kl:shen. V1695))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (if (and (pair? (car Parse_shen.)) (eq? (quote <--) (kl:shen.hdhd Parse_shen.))) (let ((NewStream1693 (kl:shen.pair (kl:shen.tlhd Parse_shen.) (kl:shen.hdtl Parse_shen.)))) (let ((Parse_shen. (kl:shen. NewStream1693))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (quote ())))) (kl:fail))) (kl:fail)))) (kl:fail)) (kl:fail)))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1697) (let ((YaccParse (let ((Parse_shen. (kl:shen. V1697))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_ (kl: V1697))) (if (kl:not (kl:= (kl:fail) Parse_)) (kl:shen.pair (car Parse_) (quote ())) (kl:fail))) YaccParse))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1699) (if (pair? (car V1699)) (let ((Parse_X (kl:shen.hdhd V1699))) (if (and (kl:not (eq? (quote <--) Parse_X)) (assert-boolean (kl:shen.legitimate-term? Parse_X))) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V1699) (kl:shen.hdtl V1699))) (kl:shen.eval-cons Parse_X)) (kl:fail))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.legitimate-term?) 1) (define (kl:shen.legitimate-term? V1705) (cond ((and (pair? V1705) (and (eq? (quote cons) (car V1705)) (and (pair? (cdr V1705)) (and (pair? (cdr (cdr V1705))) (null? (cdr (cdr (cdr V1705)))))))) (and (assert-boolean (kl:shen.legitimate-term? (car (cdr V1705)))) (assert-boolean (kl:shen.legitimate-term? (car (cdr (cdr V1705))))))) ((and (pair? V1705) (and (eq? (quote mode) (car V1705)) (and (pair? (cdr V1705)) (and (pair? (cdr (cdr V1705))) (and (eq? (quote +) (car (cdr (cdr V1705)))) (null? (cdr (cdr (cdr V1705))))))))) (kl:shen.legitimate-term? (car (cdr V1705)))) ((and (pair? V1705) (and (eq? (quote mode) (car V1705)) (and (pair? (cdr V1705)) (and (pair? (cdr (cdr V1705))) (and (eq? (quote -) (car (cdr (cdr V1705)))) (null? (cdr (cdr (cdr V1705))))))))) (kl:shen.legitimate-term? (car (cdr V1705)))) ((pair? V1705) #f) (#t #t))) (export shen.legitimate-term?) (quote shen.legitimate-term?)) +(begin (register-function-arity (quote shen.eval-cons) 1) (define (kl:shen.eval-cons V1707) (cond ((and (pair? V1707) (and (eq? (quote cons) (car V1707)) (and (pair? (cdr V1707)) (and (pair? (cdr (cdr V1707))) (null? (cdr (cdr (cdr V1707)))))))) (cons (kl:shen.eval-cons (car (cdr V1707))) (kl:shen.eval-cons (car (cdr (cdr V1707)))))) ((and (pair? V1707) (and (eq? (quote mode) (car V1707)) (and (pair? (cdr V1707)) (and (pair? (cdr (cdr V1707))) (null? (cdr (cdr (cdr V1707)))))))) (cons (quote mode) (cons (kl:shen.eval-cons (car (cdr V1707))) (cdr (cdr V1707))))) (#t V1707))) (export shen.eval-cons) (quote shen.eval-cons)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1709) (let ((YaccParse (let ((Parse_shen. (kl:shen. V1709))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_ (kl: V1709))) (if (kl:not (kl:= (kl:fail) Parse_)) (kl:shen.pair (car Parse_) (quote ())) (kl:fail))) YaccParse))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1712) (let ((YaccParse (if (and (pair? (car V1712)) (eq? (quote !) (kl:shen.hdhd V1712))) (let ((NewStream1710 (kl:shen.pair (kl:shen.tlhd V1712) (kl:shen.hdtl V1712)))) (kl:shen.pair (car NewStream1710) (cons (quote cut) (cons (kl:intern "Throwcontrol") (quote ()))))) (kl:fail)))) (if (kl:= YaccParse (kl:fail)) (if (pair? (car V1712)) (let ((Parse_X (kl:shen.hdhd V1712))) (if (pair? Parse_X) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V1712) (kl:shen.hdtl V1712))) Parse_X) (kl:fail))) (kl:fail)) YaccParse))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1714) (if (pair? (car V1714)) (let ((Parse_X (kl:shen.hdhd V1714))) (if (eq? Parse_X (quote _waspvm_sc_)) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V1714) (kl:shen.hdtl V1714))) Parse_X) (kl:fail))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote cut) 3) (define (kl:cut V1718 V1719 V1720) (let ((Result (kl:thaw V1720))) (if (kl:= Result #f) V1718 Result))) (export cut) (quote cut)) +(begin (register-function-arity (quote shen.insert_modes) 1) (define (kl:shen.insert_modes V1722) (cond ((and (pair? V1722) (and (eq? (quote mode) (car V1722)) (and (pair? (cdr V1722)) (and (pair? (cdr (cdr V1722))) (null? (cdr (cdr (cdr V1722)))))))) V1722) ((null? V1722) (quote ())) ((pair? V1722) (cons (cons (quote mode) (cons (car V1722) (cons (quote +) (quote ())))) (cons (quote mode) (cons (kl:shen.insert_modes (cdr V1722)) (cons (quote -) (quote ())))))) (#t V1722))) (export shen.insert_modes) (quote shen.insert_modes)) +(begin (register-function-arity (quote shen.s-prolog) 1) (define (kl:shen.s-prolog V1724) (kl:map (lambda (X) (kl:eval X)) (kl:shen.prolog->shen V1724))) (export shen.s-prolog) (quote shen.s-prolog)) +(begin (register-function-arity (quote shen.prolog->shen) 1) (define (kl:shen.prolog->shen V1726) (kl:map (lambda (X) (kl:shen.compile_prolog_procedure X)) (kl:shen.group_clauses (kl:map (lambda (X) (kl:shen.s-prolog_clause X)) (kl:mapcan (lambda (X) (kl:shen.head_abstraction X)) V1726))))) (export shen.prolog->shen) (quote shen.prolog->shen)) +(begin (register-function-arity (quote shen.s-prolog_clause) 1) (define (kl:shen.s-prolog_clause V1728) (cond ((and (pair? V1728) (and (pair? (cdr V1728)) (and (eq? (quote :-) (car (cdr V1728))) (and (pair? (cdr (cdr V1728))) (null? (cdr (cdr (cdr V1728)))))))) (cons (car V1728) (cons (quote :-) (cons (kl:map (lambda (X) (kl:shen.s-prolog_literal X)) (car (cdr (cdr V1728)))) (quote ()))))) (#t (kl:shen.f_error (quote shen.s-prolog_clause))))) (export shen.s-prolog_clause) (quote shen.s-prolog_clause)) +(begin (register-function-arity (quote shen.head_abstraction) 1) (define (kl:shen.head_abstraction V1730) (cond ((and (pair? V1730) (and (pair? (cdr V1730)) (and (eq? (quote :-) (car (cdr V1730))) (and (pair? (cdr (cdr V1730))) (and (null? (cdr (cdr (cdr V1730)))) (assert-boolean (guard (lambda (_) #f) (< (kl:shen.complexity_head (car V1730)) (kl:value (quote shen.*maxcomplexity*)))))))))) (cons V1730 (quote ()))) ((and (pair? V1730) (and (pair? (car V1730)) (and (pair? (cdr V1730)) (and (eq? (quote :-) (car (cdr V1730))) (and (pair? (cdr (cdr V1730))) (null? (cdr (cdr (cdr V1730))))))))) (let ((Terms (kl:map (lambda (Y) (kl:gensym (quote V))) (cdr (car V1730))))) (let ((XTerms (kl:shen.rcons_form (kl:shen.remove_modes (cdr (car V1730)))))) (let ((Literal (cons (quote unify) (cons (kl:shen.cons_form Terms) (cons XTerms (quote ())))))) (let ((Clause (cons (cons (car (car V1730)) Terms) (cons (quote :-) (cons (cons Literal (car (cdr (cdr V1730)))) (quote ())))))) (cons Clause (quote ()))))))) (#t (kl:shen.f_error (quote shen.head_abstraction))))) (export shen.head_abstraction) (quote shen.head_abstraction)) +(begin (register-function-arity (quote shen.complexity_head) 1) (define (kl:shen.complexity_head V1736) (cond ((pair? V1736) (kl:shen.safe-product (kl:map (lambda (X) (kl:shen.complexity X)) (cdr V1736)))) (#t (kl:shen.f_error (quote shen.complexity_head))))) (export shen.complexity_head) (quote shen.complexity_head)) +(begin (register-function-arity (quote shen.safe-multiply) 2) (define (kl:shen.safe-multiply V1739 V1740) (* V1739 V1740)) (export shen.safe-multiply) (quote shen.safe-multiply)) +(begin (register-function-arity (quote shen.complexity) 1) (define (kl:shen.complexity V1749) (cond ((and (pair? V1749) (and (eq? (quote mode) (car V1749)) (and (pair? (cdr V1749)) (and (pair? (car (cdr V1749))) (and (eq? (quote mode) (car (car (cdr V1749)))) (and (pair? (cdr (car (cdr V1749)))) (and (pair? (cdr (cdr (car (cdr V1749))))) (and (null? (cdr (cdr (cdr (car (cdr V1749)))))) (and (pair? (cdr (cdr V1749))) (null? (cdr (cdr (cdr V1749))))))))))))) (kl:shen.complexity (car (cdr V1749)))) ((and (pair? V1749) (and (eq? (quote mode) (car V1749)) (and (pair? (cdr V1749)) (and (pair? (car (cdr V1749))) (and (pair? (cdr (cdr V1749))) (and (eq? (quote +) (car (cdr (cdr V1749)))) (null? (cdr (cdr (cdr V1749)))))))))) (kl:shen.safe-multiply 2 (kl:shen.safe-multiply (kl:shen.complexity (cons (quote mode) (cons (car (car (cdr V1749))) (cdr (cdr V1749))))) (kl:shen.complexity (cons (quote mode) (cons (cdr (car (cdr V1749))) (cdr (cdr V1749)))))))) ((and (pair? V1749) (and (eq? (quote mode) (car V1749)) (and (pair? (cdr V1749)) (and (pair? (car (cdr V1749))) (and (pair? (cdr (cdr V1749))) (and (eq? (quote -) (car (cdr (cdr V1749)))) (null? (cdr (cdr (cdr V1749)))))))))) (kl:shen.safe-multiply (kl:shen.complexity (cons (quote mode) (cons (car (car (cdr V1749))) (cdr (cdr V1749))))) (kl:shen.complexity (cons (quote mode) (cons (cdr (car (cdr V1749))) (cdr (cdr V1749))))))) ((and (pair? V1749) (and (eq? (quote mode) (car V1749)) (and (pair? (cdr V1749)) (and (pair? (cdr (cdr V1749))) (and (null? (cdr (cdr (cdr V1749)))) (kl:variable? (car (cdr V1749)))))))) 1) ((and (pair? V1749) (and (eq? (quote mode) (car V1749)) (and (pair? (cdr V1749)) (and (pair? (cdr (cdr V1749))) (and (eq? (quote +) (car (cdr (cdr V1749)))) (null? (cdr (cdr (cdr V1749))))))))) 2) ((and (pair? V1749) (and (eq? (quote mode) (car V1749)) (and (pair? (cdr V1749)) (and (pair? (cdr (cdr V1749))) (and (eq? (quote -) (car (cdr (cdr V1749)))) (null? (cdr (cdr (cdr V1749))))))))) 1) (#t (kl:shen.complexity (cons (quote mode) (cons V1749 (cons (quote +) (quote ())))))))) (export shen.complexity) (quote shen.complexity)) +(begin (register-function-arity (quote shen.safe-product) 1) (define (kl:shen.safe-product V1751) (cond ((null? V1751) 1) ((pair? V1751) (kl:shen.safe-multiply (car V1751) (kl:shen.safe-product (cdr V1751)))) (#t (kl:shen.f_error (quote shen.safe-product))))) (export shen.safe-product) (quote shen.safe-product)) +(begin (register-function-arity (quote shen.s-prolog_literal) 1) (define (kl:shen.s-prolog_literal V1753) (cond ((and (pair? V1753) (and (eq? (quote is) (car V1753)) (and (pair? (cdr V1753)) (and (pair? (cdr (cdr V1753))) (null? (cdr (cdr (cdr V1753)))))))) (cons (quote bind) (cons (car (cdr V1753)) (cons (kl:shen.insert-deref (car (cdr (cdr V1753))) (quote ProcessN)) (quote ()))))) ((and (pair? V1753) (and (eq? (quote when) (car V1753)) (and (pair? (cdr V1753)) (null? (cdr (cdr V1753)))))) (cons (quote fwhen) (cons (kl:shen.insert-deref (car (cdr V1753)) (quote ProcessN)) (quote ())))) ((and (pair? V1753) (and (eq? (quote bind) (car V1753)) (and (pair? (cdr V1753)) (and (pair? (cdr (cdr V1753))) (null? (cdr (cdr (cdr V1753)))))))) (cons (quote bind) (cons (car (cdr V1753)) (cons (kl:shen.insert-lazyderef (car (cdr (cdr V1753))) (quote ProcessN)) (quote ()))))) ((and (pair? V1753) (and (eq? (quote fwhen) (car V1753)) (and (pair? (cdr V1753)) (null? (cdr (cdr V1753)))))) (cons (quote fwhen) (cons (kl:shen.insert-lazyderef (car (cdr V1753)) (quote ProcessN)) (quote ())))) ((pair? V1753) V1753) (#t (kl:shen.f_error (quote shen.s-prolog_literal))))) (export shen.s-prolog_literal) (quote shen.s-prolog_literal)) +(begin (register-function-arity (quote shen.insert-deref) 2) (define (kl:shen.insert-deref V1760 V1761) (cond ((kl:variable? V1760) (cons (quote shen.deref) (cons V1760 (cons V1761 (quote ()))))) ((and (pair? V1760) (and (eq? (quote lambda) (car V1760)) (and (pair? (cdr V1760)) (and (pair? (cdr (cdr V1760))) (null? (cdr (cdr (cdr V1760)))))))) (cons (quote lambda) (cons (car (cdr V1760)) (cons (kl:shen.insert-deref (car (cdr (cdr V1760))) V1761) (quote ()))))) ((and (pair? V1760) (and (eq? (quote let) (car V1760)) (and (pair? (cdr V1760)) (and (pair? (cdr (cdr V1760))) (and (pair? (cdr (cdr (cdr V1760)))) (null? (cdr (cdr (cdr (cdr V1760)))))))))) (cons (quote let) (cons (car (cdr V1760)) (cons (kl:shen.insert-deref (car (cdr (cdr V1760))) V1761) (cons (kl:shen.insert-deref (car (cdr (cdr (cdr V1760)))) V1761) (quote ())))))) ((pair? V1760) (cons (kl:shen.insert-deref (car V1760) V1761) (kl:shen.insert-deref (cdr V1760) V1761))) (#t V1760))) (export shen.insert-deref) (quote shen.insert-deref)) +(begin (register-function-arity (quote shen.insert-lazyderef) 2) (define (kl:shen.insert-lazyderef V1768 V1769) (cond ((kl:variable? V1768) (cons (quote shen.lazyderef) (cons V1768 (cons V1769 (quote ()))))) ((and (pair? V1768) (and (eq? (quote lambda) (car V1768)) (and (pair? (cdr V1768)) (and (pair? (cdr (cdr V1768))) (null? (cdr (cdr (cdr V1768)))))))) (cons (quote lambda) (cons (car (cdr V1768)) (cons (kl:shen.insert-lazyderef (car (cdr (cdr V1768))) V1769) (quote ()))))) ((and (pair? V1768) (and (eq? (quote let) (car V1768)) (and (pair? (cdr V1768)) (and (pair? (cdr (cdr V1768))) (and (pair? (cdr (cdr (cdr V1768)))) (null? (cdr (cdr (cdr (cdr V1768)))))))))) (cons (quote let) (cons (car (cdr V1768)) (cons (kl:shen.insert-lazyderef (car (cdr (cdr V1768))) V1769) (cons (kl:shen.insert-lazyderef (car (cdr (cdr (cdr V1768)))) V1769) (quote ())))))) ((pair? V1768) (cons (kl:shen.insert-lazyderef (car V1768) V1769) (kl:shen.insert-lazyderef (cdr V1768) V1769))) (#t V1768))) (export shen.insert-lazyderef) (quote shen.insert-lazyderef)) +(begin (register-function-arity (quote shen.group_clauses) 1) (define (kl:shen.group_clauses V1771) (cond ((null? V1771) (quote ())) ((pair? V1771) (let ((Group (kl:shen.collect (lambda (X) (kl:shen.same_predicate? (car V1771) X)) V1771))) (let ((Rest (kl:difference V1771 Group))) (cons Group (kl:shen.group_clauses Rest))))) (#t (kl:shen.f_error (quote shen.group_clauses))))) (export shen.group_clauses) (quote shen.group_clauses)) +(begin (register-function-arity (quote shen.collect) 2) (define (kl:shen.collect V1776 V1777) (cond ((null? V1777) (quote ())) ((pair? V1777) (if (assert-boolean (V1776 (car V1777))) (cons (car V1777) (kl:shen.collect V1776 (cdr V1777))) (kl:shen.collect V1776 (cdr V1777)))) (#t (kl:shen.f_error (quote shen.collect))))) (export shen.collect) (quote shen.collect)) +(begin (register-function-arity (quote shen.same_predicate?) 2) (define (kl:shen.same_predicate? V1796 V1797) (cond ((and (pair? V1796) (and (pair? (car V1796)) (and (pair? V1797) (pair? (car V1797))))) (kl:= (car (car V1796)) (car (car V1797)))) (#t (kl:shen.f_error (quote shen.same_predicate?))))) (export shen.same_predicate?) (quote shen.same_predicate?)) +(begin (register-function-arity (quote shen.compile_prolog_procedure) 1) (define (kl:shen.compile_prolog_procedure V1799) (let ((F (kl:shen.procedure_name V1799))) (let ((Shen (kl:shen.clauses-to-shen F V1799))) Shen))) (export shen.compile_prolog_procedure) (quote shen.compile_prolog_procedure)) +(begin (register-function-arity (quote shen.procedure_name) 1) (define (kl:shen.procedure_name V1813) (cond ((and (pair? V1813) (and (pair? (car V1813)) (pair? (car (car V1813))))) (car (car (car V1813)))) (#t (kl:shen.f_error (quote shen.procedure_name))))) (export shen.procedure_name) (quote shen.procedure_name)) +(begin (register-function-arity (quote shen.clauses-to-shen) 2) (define (kl:shen.clauses-to-shen V1816 V1817) (let ((Linear (kl:map (lambda (X) (kl:shen.linearise-clause X)) V1817))) (let ((Arity (kl:shen.prolog-aritycheck V1816 (kl:map (lambda (X) (kl:head X)) V1817)))) (let ((Parameters (kl:shen.parameters Arity))) (let ((AUM_instructions (kl:map (lambda (X) (kl:shen.aum X Parameters)) Linear))) (let ((Code (kl:shen.catch-cut (kl:shen.nest-disjunct (kl:map (lambda (X) (kl:shen.aum_to_shen X)) AUM_instructions))))) (let ((ShenDef (cons (quote define) (cons V1816 (kl:append Parameters (kl:append (cons (quote ProcessN) (cons (quote Continuation) (quote ()))) (cons (quote ->) (cons Code (quote ()))))))))) ShenDef))))))) (export shen.clauses-to-shen) (quote shen.clauses-to-shen)) +(begin (register-function-arity (quote shen.catch-cut) 1) (define (kl:shen.catch-cut V1819) (cond ((kl:not (kl:shen.occurs? (quote cut) V1819)) V1819) (#t (cons (quote let) (cons (quote Throwcontrol) (cons (cons (quote shen.catchpoint) (quote ())) (cons (cons (quote shen.cutpoint) (cons (quote Throwcontrol) (cons V1819 (quote ())))) (quote ())))))))) (export shen.catch-cut) (quote shen.catch-cut)) +(begin (register-function-arity (quote shen.catchpoint) 0) (define (kl:shen.catchpoint) (kl:set (quote shen.*catch*) (+ 1 (kl:value (quote shen.*catch*))))) (export shen.catchpoint) (quote shen.catchpoint)) +(begin (register-function-arity (quote shen.cutpoint) 2) (define (kl:shen.cutpoint V1827 V1828) (cond ((kl:= V1828 V1827) #f) (#t V1828))) (export shen.cutpoint) (quote shen.cutpoint)) +(begin (register-function-arity (quote shen.nest-disjunct) 1) (define (kl:shen.nest-disjunct V1830) (cond ((and (pair? V1830) (null? (cdr V1830))) (car V1830)) ((pair? V1830) (kl:shen.lisp-or (car V1830) (kl:shen.nest-disjunct (cdr V1830)))) (#t (kl:shen.f_error (quote shen.nest-disjunct))))) (export shen.nest-disjunct) (quote shen.nest-disjunct)) +(begin (register-function-arity (quote shen.lisp-or) 2) (define (kl:shen.lisp-or V1833 V1834) (cons (quote let) (cons (quote Case) (cons V1833 (cons (cons (quote if) (cons (cons (quote =) (cons (quote Case) (cons #f (quote ())))) (cons V1834 (cons (quote Case) (quote ()))))) (quote ())))))) (export shen.lisp-or) (quote shen.lisp-or)) +(begin (register-function-arity (quote shen.prolog-aritycheck) 2) (define (kl:shen.prolog-aritycheck V1839 V1840) (cond ((and (pair? V1840) (null? (cdr V1840))) (- (kl:length (car V1840)) 1)) ((and (pair? V1840) (pair? (cdr V1840))) (if (kl:= (kl:length (car V1840)) (kl:length (car (cdr V1840)))) (kl:shen.prolog-aritycheck V1839 (cdr V1840)) (simple-error (string-append "arity error in prolog procedure " (kl:shen.app (cons V1839 (quote ())) "\n" (quote shen.a)))))) (#t (kl:shen.f_error (quote shen.prolog-aritycheck))))) (export shen.prolog-aritycheck) (quote shen.prolog-aritycheck)) +(begin (register-function-arity (quote shen.linearise-clause) 1) (define (kl:shen.linearise-clause V1842) (cond ((and (pair? V1842) (and (pair? (cdr V1842)) (and (eq? (quote :-) (car (cdr V1842))) (and (pair? (cdr (cdr V1842))) (null? (cdr (cdr (cdr V1842)))))))) (let ((Linear (kl:shen.linearise (cons (car V1842) (cdr (cdr V1842)))))) (kl:shen.clause_form Linear))) (#t (kl:shen.f_error (quote shen.linearise-clause))))) (export shen.linearise-clause) (quote shen.linearise-clause)) +(begin (register-function-arity (quote shen.clause_form) 1) (define (kl:shen.clause_form V1844) (cond ((and (pair? V1844) (and (pair? (cdr V1844)) (null? (cdr (cdr V1844))))) (cons (kl:shen.explicit_modes (car V1844)) (cons (quote :-) (cons (kl:shen.cf_help (car (cdr V1844))) (quote ()))))) (#t (kl:shen.f_error (quote shen.clause_form))))) (export shen.clause_form) (quote shen.clause_form)) +(begin (register-function-arity (quote shen.explicit_modes) 1) (define (kl:shen.explicit_modes V1846) (cond ((pair? V1846) (cons (car V1846) (kl:map (lambda (X) (kl:shen.em_help X)) (cdr V1846)))) (#t (kl:shen.f_error (quote shen.explicit_modes))))) (export shen.explicit_modes) (quote shen.explicit_modes)) +(begin (register-function-arity (quote shen.em_help) 1) (define (kl:shen.em_help V1848) (cond ((and (pair? V1848) (and (eq? (quote mode) (car V1848)) (and (pair? (cdr V1848)) (and (pair? (cdr (cdr V1848))) (null? (cdr (cdr (cdr V1848)))))))) V1848) (#t (cons (quote mode) (cons V1848 (cons (quote +) (quote ()))))))) (export shen.em_help) (quote shen.em_help)) +(begin (register-function-arity (quote shen.cf_help) 1) (define (kl:shen.cf_help V1850) (cond ((and (pair? V1850) (and (eq? (quote where) (car V1850)) (and (pair? (cdr V1850)) (and (pair? (car (cdr V1850))) (and (eq? (quote =) (car (car (cdr V1850)))) (and (pair? (cdr (car (cdr V1850)))) (and (pair? (cdr (cdr (car (cdr V1850))))) (and (null? (cdr (cdr (cdr (car (cdr V1850)))))) (and (pair? (cdr (cdr V1850))) (null? (cdr (cdr (cdr V1850))))))))))))) (cons (cons (if (assert-boolean (kl:value (quote shen.*occurs*))) (quote unify!) (quote unify)) (cdr (car (cdr V1850)))) (kl:shen.cf_help (car (cdr (cdr V1850)))))) (#t V1850))) (export shen.cf_help) (quote shen.cf_help)) +(begin (register-function-arity (quote occurs-check) 1) (define (kl:occurs-check V1856) (cond ((eq? (quote +) V1856) (kl:set (quote shen.*occurs*) #t)) ((eq? (quote -) V1856) (kl:set (quote shen.*occurs*) #f)) (#t (simple-error "occurs-check expects + or -\n")))) (export occurs-check) (quote occurs-check)) +(begin (register-function-arity (quote shen.aum) 2) (define (kl:shen.aum V1859 V1860) (cond ((and (pair? V1859) (and (pair? (car V1859)) (and (pair? (cdr V1859)) (and (eq? (quote :-) (car (cdr V1859))) (and (pair? (cdr (cdr V1859))) (null? (cdr (cdr (cdr V1859))))))))) (let ((MuApplication (kl:shen.make_mu_application (cons (quote shen.mu) (cons (cdr (car V1859)) (cons (kl:shen.continuation_call (cdr (car V1859)) (car (cdr (cdr V1859)))) (quote ())))) V1860))) (kl:shen.mu_reduction MuApplication (quote +)))) (#t (kl:shen.f_error (quote shen.aum))))) (export shen.aum) (quote shen.aum)) +(begin (register-function-arity (quote shen.continuation_call) 2) (define (kl:shen.continuation_call V1863 V1864) (let ((VTerms (cons (quote ProcessN) (kl:shen.extract_vars V1863)))) (let ((VBody (kl:shen.extract_vars V1864))) (let ((Free (kl:remove (quote Throwcontrol) (kl:difference VBody VTerms)))) (kl:shen.cc_help Free V1864))))) (export shen.continuation_call) (quote shen.continuation_call)) +(begin (register-function-arity (quote remove) 2) (define (kl:remove V1867 V1868) (kl:shen.remove-h V1867 V1868 (quote ()))) (export remove) (quote remove)) +(begin (register-function-arity (quote shen.remove-h) 3) (define (kl:shen.remove-h V1875 V1876 V1877) (cond ((null? V1876) (kl:reverse V1877)) ((and (pair? V1876) (kl:= (car V1876) V1875)) (kl:shen.remove-h (car V1876) (cdr V1876) V1877)) ((pair? V1876) (kl:shen.remove-h V1875 (cdr V1876) (cons (car V1876) V1877))) (#t (kl:shen.f_error (quote shen.remove-h))))) (export shen.remove-h) (quote shen.remove-h)) +(begin (register-function-arity (quote shen.cc_help) 2) (define (kl:shen.cc_help V1880 V1881) (cond ((and (null? V1880) (null? V1881)) (cons (quote shen.pop) (cons (quote shen.the) (cons (quote shen.stack) (quote ()))))) ((null? V1881) (cons (quote shen.rename) (cons (quote shen.the) (cons (quote shen.variables) (cons (quote in) (cons V1880 (cons (quote and) (cons (quote shen.then) (cons (cons (quote shen.pop) (cons (quote shen.the) (cons (quote shen.stack) (quote ())))) (quote ())))))))))) ((null? V1880) (cons (quote call) (cons (quote shen.the) (cons (quote shen.continuation) (cons V1881 (quote ())))))) (#t (cons (quote shen.rename) (cons (quote shen.the) (cons (quote shen.variables) (cons (quote in) (cons V1880 (cons (quote and) (cons (quote shen.then) (cons (cons (quote call) (cons (quote shen.the) (cons (quote shen.continuation) (cons V1881 (quote ()))))) (quote ())))))))))))) (export shen.cc_help) (quote shen.cc_help)) +(begin (register-function-arity (quote shen.make_mu_application) 2) (define (kl:shen.make_mu_application V1884 V1885) (cond ((and (pair? V1884) (and (eq? (quote shen.mu) (car V1884)) (and (pair? (cdr V1884)) (and (null? (car (cdr V1884))) (and (pair? (cdr (cdr V1884))) (and (null? (cdr (cdr (cdr V1884)))) (null? V1885))))))) (car (cdr (cdr V1884)))) ((and (pair? V1884) (and (eq? (quote shen.mu) (car V1884)) (and (pair? (cdr V1884)) (and (pair? (car (cdr V1884))) (and (pair? (cdr (cdr V1884))) (and (null? (cdr (cdr (cdr V1884)))) (pair? V1885))))))) (cons (cons (quote shen.mu) (cons (car (car (cdr V1884))) (cons (kl:shen.make_mu_application (cons (quote shen.mu) (cons (cdr (car (cdr V1884))) (cdr (cdr V1884)))) (cdr V1885)) (quote ())))) (cons (car V1885) (quote ())))) (#t (kl:shen.f_error (quote shen.make_mu_application))))) (export shen.make_mu_application) (quote shen.make_mu_application)) +(begin (register-function-arity (quote shen.mu_reduction) 2) (define (kl:shen.mu_reduction V1894 V1895) (cond ((and (pair? V1894) (and (pair? (car V1894)) (and (eq? (quote shen.mu) (car (car V1894))) (and (pair? (cdr (car V1894))) (and (pair? (car (cdr (car V1894)))) (and (eq? (quote mode) (car (car (cdr (car V1894))))) (and (pair? (cdr (car (cdr (car V1894))))) (and (pair? (cdr (cdr (car (cdr (car V1894)))))) (and (null? (cdr (cdr (cdr (car (cdr (car V1894))))))) (and (pair? (cdr (cdr (car V1894)))) (and (null? (cdr (cdr (cdr (car V1894))))) (and (pair? (cdr V1894)) (null? (cdr (cdr V1894))))))))))))))) (kl:shen.mu_reduction (cons (cons (quote shen.mu) (cons (car (cdr (car (cdr (car V1894))))) (cdr (cdr (car V1894))))) (cdr V1894)) (car (cdr (cdr (car (cdr (car V1894)))))))) ((and (pair? V1894) (and (pair? (car V1894)) (and (eq? (quote shen.mu) (car (car V1894))) (and (pair? (cdr (car V1894))) (and (pair? (cdr (cdr (car V1894)))) (and (null? (cdr (cdr (cdr (car V1894))))) (and (pair? (cdr V1894)) (and (null? (cdr (cdr V1894))) (eq? (quote _) (car (cdr (car V1894)))))))))))) (kl:shen.mu_reduction (car (cdr (cdr (car V1894)))) V1895)) ((and (pair? V1894) (and (pair? (car V1894)) (and (eq? (quote shen.mu) (car (car V1894))) (and (pair? (cdr (car V1894))) (and (pair? (cdr (cdr (car V1894)))) (and (null? (cdr (cdr (cdr (car V1894))))) (and (pair? (cdr V1894)) (and (null? (cdr (cdr V1894))) (assert-boolean (kl:shen.ephemeral_variable? (car (cdr (car V1894))) (car (cdr V1894)))))))))))) (kl:subst (car (cdr V1894)) (car (cdr (car V1894))) (kl:shen.mu_reduction (car (cdr (cdr (car V1894)))) V1895))) ((and (pair? V1894) (and (pair? (car V1894)) (and (eq? (quote shen.mu) (car (car V1894))) (and (pair? (cdr (car V1894))) (and (pair? (cdr (cdr (car V1894)))) (and (null? (cdr (cdr (cdr (car V1894))))) (and (pair? (cdr V1894)) (and (null? (cdr (cdr V1894))) (kl:variable? (car (cdr (car V1894)))))))))))) (cons (quote let) (cons (car (cdr (car V1894))) (cons (quote shen.be) (cons (car (cdr V1894)) (cons (quote in) (cons (kl:shen.mu_reduction (car (cdr (cdr (car V1894)))) V1895) (quote ())))))))) ((and (pair? V1894) (and (pair? (car V1894)) (and (eq? (quote shen.mu) (car (car V1894))) (and (pair? (cdr (car V1894))) (and (pair? (cdr (cdr (car V1894)))) (and (null? (cdr (cdr (cdr (car V1894))))) (and (pair? (cdr V1894)) (and (null? (cdr (cdr V1894))) (and (eq? (quote -) V1895) (assert-boolean (kl:shen.prolog_constant? (car (cdr (car V1894)))))))))))))) (let ((Z (kl:gensym (quote V)))) (cons (quote let) (cons Z (cons (quote shen.be) (cons (cons (quote shen.the) (cons (quote shen.result) (cons (quote shen.of) (cons (quote shen.dereferencing) (cdr V1894))))) (cons (quote in) (cons (cons (quote if) (cons (cons Z (cons (quote is) (cons (quote identical) (cons (quote shen.to) (cons (car (cdr (car V1894))) (quote ())))))) (cons (quote shen.then) (cons (kl:shen.mu_reduction (car (cdr (cdr (car V1894)))) (quote -)) (cons (quote shen.else) (cons (quote shen.failed!) (quote ()))))))) (quote ()))))))))) ((and (pair? V1894) (and (pair? (car V1894)) (and (eq? (quote shen.mu) (car (car V1894))) (and (pair? (cdr (car V1894))) (and (pair? (cdr (cdr (car V1894)))) (and (null? (cdr (cdr (cdr (car V1894))))) (and (pair? (cdr V1894)) (and (null? (cdr (cdr V1894))) (and (eq? (quote +) V1895) (assert-boolean (kl:shen.prolog_constant? (car (cdr (car V1894)))))))))))))) (let ((Z (kl:gensym (quote V)))) (cons (quote let) (cons Z (cons (quote shen.be) (cons (cons (quote shen.the) (cons (quote shen.result) (cons (quote shen.of) (cons (quote shen.dereferencing) (cdr V1894))))) (cons (quote in) (cons (cons (quote if) (cons (cons Z (cons (quote is) (cons (quote identical) (cons (quote shen.to) (cons (car (cdr (car V1894))) (quote ())))))) (cons (quote shen.then) (cons (kl:shen.mu_reduction (car (cdr (cdr (car V1894)))) (quote +)) (cons (quote shen.else) (cons (cons (quote if) (cons (cons Z (cons (quote is) (cons (quote shen.a) (cons (quote shen.variable) (quote ()))))) (cons (quote shen.then) (cons (cons (quote bind) (cons Z (cons (quote shen.to) (cons (car (cdr (car V1894))) (cons (quote in) (cons (kl:shen.mu_reduction (car (cdr (cdr (car V1894)))) (quote +)) (quote ()))))))) (cons (quote shen.else) (cons (quote shen.failed!) (quote ()))))))) (quote ()))))))) (quote ()))))))))) ((and (pair? V1894) (and (pair? (car V1894)) (and (eq? (quote shen.mu) (car (car V1894))) (and (pair? (cdr (car V1894))) (and (pair? (car (cdr (car V1894)))) (and (pair? (cdr (cdr (car V1894)))) (and (null? (cdr (cdr (cdr (car V1894))))) (and (pair? (cdr V1894)) (and (null? (cdr (cdr V1894))) (eq? (quote -) V1895)))))))))) (let ((Z (kl:gensym (quote V)))) (cons (quote let) (cons Z (cons (quote shen.be) (cons (cons (quote shen.the) (cons (quote shen.result) (cons (quote shen.of) (cons (quote shen.dereferencing) (cdr V1894))))) (cons (quote in) (cons (cons (quote if) (cons (cons Z (cons (quote is) (cons (quote shen.a) (cons (quote shen.non-empty) (cons (quote list) (quote ())))))) (cons (quote shen.then) (cons (kl:shen.mu_reduction (cons (cons (quote shen.mu) (cons (car (car (cdr (car V1894)))) (cons (cons (cons (quote shen.mu) (cons (cdr (car (cdr (car V1894)))) (cdr (cdr (car V1894))))) (cons (cons (quote shen.the) (cons (quote tail) (cons (quote shen.of) (cons Z (quote ()))))) (quote ()))) (quote ())))) (cons (cons (quote shen.the) (cons (quote head) (cons (quote shen.of) (cons Z (quote ()))))) (quote ()))) (quote -)) (cons (quote shen.else) (cons (quote shen.failed!) (quote ()))))))) (quote ()))))))))) ((and (pair? V1894) (and (pair? (car V1894)) (and (eq? (quote shen.mu) (car (car V1894))) (and (pair? (cdr (car V1894))) (and (pair? (car (cdr (car V1894)))) (and (pair? (cdr (cdr (car V1894)))) (and (null? (cdr (cdr (cdr (car V1894))))) (and (pair? (cdr V1894)) (and (null? (cdr (cdr V1894))) (eq? (quote +) V1895)))))))))) (let ((Z (kl:gensym (quote V)))) (cons (quote let) (cons Z (cons (quote shen.be) (cons (cons (quote shen.the) (cons (quote shen.result) (cons (quote shen.of) (cons (quote shen.dereferencing) (cdr V1894))))) (cons (quote in) (cons (cons (quote if) (cons (cons Z (cons (quote is) (cons (quote shen.a) (cons (quote shen.non-empty) (cons (quote list) (quote ())))))) (cons (quote shen.then) (cons (kl:shen.mu_reduction (cons (cons (quote shen.mu) (cons (car (car (cdr (car V1894)))) (cons (cons (cons (quote shen.mu) (cons (cdr (car (cdr (car V1894)))) (cdr (cdr (car V1894))))) (cons (cons (quote shen.the) (cons (quote tail) (cons (quote shen.of) (cons Z (quote ()))))) (quote ()))) (quote ())))) (cons (cons (quote shen.the) (cons (quote head) (cons (quote shen.of) (cons Z (quote ()))))) (quote ()))) (quote +)) (cons (quote shen.else) (cons (cons (quote if) (cons (cons Z (cons (quote is) (cons (quote shen.a) (cons (quote shen.variable) (quote ()))))) (cons (quote shen.then) (cons (cons (quote shen.rename) (cons (quote shen.the) (cons (quote shen.variables) (cons (quote in) (cons (kl:shen.extract_vars (car (cdr (car V1894)))) (cons (quote and) (cons (quote shen.then) (cons (cons (quote bind) (cons Z (cons (quote shen.to) (cons (kl:shen.rcons_form (kl:shen.remove_modes (car (cdr (car V1894))))) (cons (quote in) (cons (kl:shen.mu_reduction (car (cdr (cdr (car V1894)))) (quote +)) (quote ()))))))) (quote ()))))))))) (cons (quote shen.else) (cons (quote shen.failed!) (quote ()))))))) (quote ()))))))) (quote ()))))))))) (#t V1894))) (export shen.mu_reduction) (quote shen.mu_reduction)) +(begin (register-function-arity (quote shen.rcons_form) 1) (define (kl:shen.rcons_form V1897) (cond ((pair? V1897) (cons (quote cons) (cons (kl:shen.rcons_form (car V1897)) (cons (kl:shen.rcons_form (cdr V1897)) (quote ()))))) (#t V1897))) (export shen.rcons_form) (quote shen.rcons_form)) +(begin (register-function-arity (quote shen.remove_modes) 1) (define (kl:shen.remove_modes V1899) (cond ((and (pair? V1899) (and (eq? (quote mode) (car V1899)) (and (pair? (cdr V1899)) (and (pair? (cdr (cdr V1899))) (and (eq? (quote +) (car (cdr (cdr V1899)))) (null? (cdr (cdr (cdr V1899))))))))) (kl:shen.remove_modes (car (cdr V1899)))) ((and (pair? V1899) (and (eq? (quote mode) (car V1899)) (and (pair? (cdr V1899)) (and (pair? (cdr (cdr V1899))) (and (eq? (quote -) (car (cdr (cdr V1899)))) (null? (cdr (cdr (cdr V1899))))))))) (kl:shen.remove_modes (car (cdr V1899)))) ((pair? V1899) (cons (kl:shen.remove_modes (car V1899)) (kl:shen.remove_modes (cdr V1899)))) (#t V1899))) (export shen.remove_modes) (quote shen.remove_modes)) +(begin (register-function-arity (quote shen.ephemeral_variable?) 2) (define (kl:shen.ephemeral_variable? V1902 V1903) (and (kl:variable? V1902) (kl:variable? V1903))) (export shen.ephemeral_variable?) (quote shen.ephemeral_variable?)) +(begin (register-function-arity (quote shen.prolog_constant?) 1) (define (kl:shen.prolog_constant? V1913) (cond ((pair? V1913) #f) (#t #t))) (export shen.prolog_constant?) (quote shen.prolog_constant?)) +(begin (register-function-arity (quote shen.aum_to_shen) 1) (define (kl:shen.aum_to_shen V1915) (cond ((and (pair? V1915) (and (eq? (quote let) (car V1915)) (and (pair? (cdr V1915)) (and (pair? (cdr (cdr V1915))) (and (eq? (quote shen.be) (car (cdr (cdr V1915)))) (and (pair? (cdr (cdr (cdr V1915)))) (and (pair? (cdr (cdr (cdr (cdr V1915))))) (and (eq? (quote in) (car (cdr (cdr (cdr (cdr V1915)))))) (and (pair? (cdr (cdr (cdr (cdr (cdr V1915)))))) (null? (cdr (cdr (cdr (cdr (cdr (cdr V1915)))))))))))))))) (cons (quote let) (cons (car (cdr V1915)) (cons (kl:shen.aum_to_shen (car (cdr (cdr (cdr V1915))))) (cons (kl:shen.aum_to_shen (car (cdr (cdr (cdr (cdr (cdr V1915))))))) (quote ())))))) ((and (pair? V1915) (and (eq? (quote shen.the) (car V1915)) (and (pair? (cdr V1915)) (and (eq? (quote shen.result) (car (cdr V1915))) (and (pair? (cdr (cdr V1915))) (and (eq? (quote shen.of) (car (cdr (cdr V1915)))) (and (pair? (cdr (cdr (cdr V1915)))) (and (eq? (quote shen.dereferencing) (car (cdr (cdr (cdr V1915))))) (and (pair? (cdr (cdr (cdr (cdr V1915))))) (null? (cdr (cdr (cdr (cdr (cdr V1915))))))))))))))) (cons (quote shen.lazyderef) (cons (kl:shen.aum_to_shen (car (cdr (cdr (cdr (cdr V1915)))))) (cons (quote ProcessN) (quote ()))))) ((and (pair? V1915) (and (eq? (quote if) (car V1915)) (and (pair? (cdr V1915)) (and (pair? (cdr (cdr V1915))) (and (eq? (quote shen.then) (car (cdr (cdr V1915)))) (and (pair? (cdr (cdr (cdr V1915)))) (and (pair? (cdr (cdr (cdr (cdr V1915))))) (and (eq? (quote shen.else) (car (cdr (cdr (cdr (cdr V1915)))))) (and (pair? (cdr (cdr (cdr (cdr (cdr V1915)))))) (null? (cdr (cdr (cdr (cdr (cdr (cdr V1915)))))))))))))))) (cons (quote if) (cons (kl:shen.aum_to_shen (car (cdr V1915))) (cons (kl:shen.aum_to_shen (car (cdr (cdr (cdr V1915))))) (cons (kl:shen.aum_to_shen (car (cdr (cdr (cdr (cdr (cdr V1915))))))) (quote ())))))) ((and (pair? V1915) (and (pair? (cdr V1915)) (and (eq? (quote is) (car (cdr V1915))) (and (pair? (cdr (cdr V1915))) (and (eq? (quote shen.a) (car (cdr (cdr V1915)))) (and (pair? (cdr (cdr (cdr V1915)))) (and (eq? (quote shen.variable) (car (cdr (cdr (cdr V1915))))) (null? (cdr (cdr (cdr (cdr V1915)))))))))))) (cons (quote shen.pvar?) (cons (car V1915) (quote ())))) ((and (pair? V1915) (and (pair? (cdr V1915)) (and (eq? (quote is) (car (cdr V1915))) (and (pair? (cdr (cdr V1915))) (and (eq? (quote shen.a) (car (cdr (cdr V1915)))) (and (pair? (cdr (cdr (cdr V1915)))) (and (eq? (quote shen.non-empty) (car (cdr (cdr (cdr V1915))))) (and (pair? (cdr (cdr (cdr (cdr V1915))))) (and (eq? (quote list) (car (cdr (cdr (cdr (cdr V1915)))))) (null? (cdr (cdr (cdr (cdr (cdr V1915))))))))))))))) (cons (quote cons?) (cons (car V1915) (quote ())))) ((and (pair? V1915) (and (eq? (quote shen.rename) (car V1915)) (and (pair? (cdr V1915)) (and (eq? (quote shen.the) (car (cdr V1915))) (and (pair? (cdr (cdr V1915))) (and (eq? (quote shen.variables) (car (cdr (cdr V1915)))) (and (pair? (cdr (cdr (cdr V1915)))) (and (eq? (quote in) (car (cdr (cdr (cdr V1915))))) (and (pair? (cdr (cdr (cdr (cdr V1915))))) (and (null? (car (cdr (cdr (cdr (cdr V1915)))))) (and (pair? (cdr (cdr (cdr (cdr (cdr V1915)))))) (and (eq? (quote and) (car (cdr (cdr (cdr (cdr (cdr V1915))))))) (and (pair? (cdr (cdr (cdr (cdr (cdr (cdr V1915))))))) (and (eq? (quote shen.then) (car (cdr (cdr (cdr (cdr (cdr (cdr V1915)))))))) (and (pair? (cdr (cdr (cdr (cdr (cdr (cdr (cdr V1915)))))))) (null? (cdr (cdr (cdr (cdr (cdr (cdr (cdr (cdr V1915)))))))))))))))))))))))) (kl:shen.aum_to_shen (car (cdr (cdr (cdr (cdr (cdr (cdr (cdr V1915)))))))))) ((and (pair? V1915) (and (eq? (quote shen.rename) (car V1915)) (and (pair? (cdr V1915)) (and (eq? (quote shen.the) (car (cdr V1915))) (and (pair? (cdr (cdr V1915))) (and (eq? (quote shen.variables) (car (cdr (cdr V1915)))) (and (pair? (cdr (cdr (cdr V1915)))) (and (eq? (quote in) (car (cdr (cdr (cdr V1915))))) (and (pair? (cdr (cdr (cdr (cdr V1915))))) (and (pair? (car (cdr (cdr (cdr (cdr V1915)))))) (and (pair? (cdr (cdr (cdr (cdr (cdr V1915)))))) (and (eq? (quote and) (car (cdr (cdr (cdr (cdr (cdr V1915))))))) (and (pair? (cdr (cdr (cdr (cdr (cdr (cdr V1915))))))) (and (eq? (quote shen.then) (car (cdr (cdr (cdr (cdr (cdr (cdr V1915)))))))) (and (pair? (cdr (cdr (cdr (cdr (cdr (cdr (cdr V1915)))))))) (null? (cdr (cdr (cdr (cdr (cdr (cdr (cdr (cdr V1915)))))))))))))))))))))))) (cons (quote let) (cons (car (car (cdr (cdr (cdr (cdr V1915)))))) (cons (cons (quote shen.newpv) (cons (quote ProcessN) (quote ()))) (cons (kl:shen.aum_to_shen (cons (quote shen.rename) (cons (quote shen.the) (cons (quote shen.variables) (cons (quote in) (cons (cdr (car (cdr (cdr (cdr (cdr V1915)))))) (cdr (cdr (cdr (cdr (cdr V1915))))))))))) (quote ())))))) ((and (pair? V1915) (and (eq? (quote bind) (car V1915)) (and (pair? (cdr V1915)) (and (pair? (cdr (cdr V1915))) (and (eq? (quote shen.to) (car (cdr (cdr V1915)))) (and (pair? (cdr (cdr (cdr V1915)))) (and (pair? (cdr (cdr (cdr (cdr V1915))))) (and (eq? (quote in) (car (cdr (cdr (cdr (cdr V1915)))))) (and (pair? (cdr (cdr (cdr (cdr (cdr V1915)))))) (null? (cdr (cdr (cdr (cdr (cdr (cdr V1915)))))))))))))))) (cons (quote do) (cons (cons (quote shen.bindv) (cons (car (cdr V1915)) (cons (kl:shen.chwild (car (cdr (cdr (cdr V1915))))) (cons (quote ProcessN) (quote ()))))) (cons (cons (quote let) (cons (quote Result) (cons (kl:shen.aum_to_shen (car (cdr (cdr (cdr (cdr (cdr V1915))))))) (cons (cons (quote do) (cons (cons (quote shen.unbindv) (cons (car (cdr V1915)) (cons (quote ProcessN) (quote ())))) (cons (quote Result) (quote ())))) (quote ()))))) (quote ()))))) ((and (pair? V1915) (and (pair? (cdr V1915)) (and (eq? (quote is) (car (cdr V1915))) (and (pair? (cdr (cdr V1915))) (and (eq? (quote identical) (car (cdr (cdr V1915)))) (and (pair? (cdr (cdr (cdr V1915)))) (and (eq? (quote shen.to) (car (cdr (cdr (cdr V1915))))) (and (pair? (cdr (cdr (cdr (cdr V1915))))) (null? (cdr (cdr (cdr (cdr (cdr V1915)))))))))))))) (cons (quote =) (cons (car (cdr (cdr (cdr (cdr V1915))))) (cons (car V1915) (quote ()))))) ((eq? (quote shen.failed!) V1915) #f) ((and (pair? V1915) (and (eq? (quote shen.the) (car V1915)) (and (pair? (cdr V1915)) (and (eq? (quote head) (car (cdr V1915))) (and (pair? (cdr (cdr V1915))) (and (eq? (quote shen.of) (car (cdr (cdr V1915)))) (and (pair? (cdr (cdr (cdr V1915)))) (null? (cdr (cdr (cdr (cdr V1915)))))))))))) (cons (quote hd) (cdr (cdr (cdr V1915))))) ((and (pair? V1915) (and (eq? (quote shen.the) (car V1915)) (and (pair? (cdr V1915)) (and (eq? (quote tail) (car (cdr V1915))) (and (pair? (cdr (cdr V1915))) (and (eq? (quote shen.of) (car (cdr (cdr V1915)))) (and (pair? (cdr (cdr (cdr V1915)))) (null? (cdr (cdr (cdr (cdr V1915)))))))))))) (cons (quote tl) (cdr (cdr (cdr V1915))))) ((and (pair? V1915) (and (eq? (quote shen.pop) (car V1915)) (and (pair? (cdr V1915)) (and (eq? (quote shen.the) (car (cdr V1915))) (and (pair? (cdr (cdr V1915))) (and (eq? (quote shen.stack) (car (cdr (cdr V1915)))) (null? (cdr (cdr (cdr V1915)))))))))) (cons (quote do) (cons (cons (quote shen.incinfs) (quote ())) (cons (cons (quote thaw) (cons (quote Continuation) (quote ()))) (quote ()))))) ((and (pair? V1915) (and (eq? (quote call) (car V1915)) (and (pair? (cdr V1915)) (and (eq? (quote shen.the) (car (cdr V1915))) (and (pair? (cdr (cdr V1915))) (and (eq? (quote shen.continuation) (car (cdr (cdr V1915)))) (and (pair? (cdr (cdr (cdr V1915)))) (null? (cdr (cdr (cdr (cdr V1915)))))))))))) (cons (quote do) (cons (cons (quote shen.incinfs) (quote ())) (cons (kl:shen.call_the_continuation (kl:shen.chwild (car (cdr (cdr (cdr V1915))))) (quote ProcessN) (quote Continuation)) (quote ()))))) (#t V1915))) (export shen.aum_to_shen) (quote shen.aum_to_shen)) +(begin (register-function-arity (quote shen.chwild) 1) (define (kl:shen.chwild V1917) (cond ((eq? V1917 (quote _)) (cons (quote shen.newpv) (cons (quote ProcessN) (quote ())))) ((pair? V1917) (kl:map (lambda (Z) (kl:shen.chwild Z)) V1917)) (#t V1917))) (export shen.chwild) (quote shen.chwild)) +(begin (register-function-arity (quote shen.newpv) 1) (define (kl:shen.newpv V1919) (let ((Count+1 (+ (vector-ref (kl:value (quote shen.*varcounter*)) V1919) 1))) (let ((IncVar (let ((_tmp (kl:value (quote shen.*varcounter*)))) (vector-set! _tmp V1919 Count+1) _tmp))) (let ((Vector (vector-ref (kl:value (quote shen.*prologvectors*)) V1919))) (let ((ResizeVectorIfNeeded (if (kl:= Count+1 (kl:limit Vector)) (kl:shen.resizeprocessvector V1919 Count+1) (quote shen.skip)))) (kl:shen.mk-pvar Count+1)))))) (export shen.newpv) (quote shen.newpv)) +(begin (register-function-arity (quote shen.resizeprocessvector) 2) (define (kl:shen.resizeprocessvector V1922 V1923) (let ((Vector (vector-ref (kl:value (quote shen.*prologvectors*)) V1922))) (let ((BigVector (kl:shen.resize-vector Vector (+ V1923 V1923) (quote shen.-null-)))) (let ((_tmp (kl:value (quote shen.*prologvectors*)))) (vector-set! _tmp V1922 BigVector) _tmp)))) (export shen.resizeprocessvector) (quote shen.resizeprocessvector)) +(begin (register-function-arity (quote shen.resize-vector) 3) (define (kl:shen.resize-vector V1927 V1928 V1929) (let ((BigVector (let ((_tmp (make-vector (+ 1 V1928) (quote (quote shen.fail!))))) (vector-set! _tmp 0 V1928) _tmp))) (kl:shen.copy-vector V1927 BigVector (kl:limit V1927) V1928 V1929))) (export shen.resize-vector) (quote shen.resize-vector)) +(begin (register-function-arity (quote shen.copy-vector) 5) (define (kl:shen.copy-vector V1935 V1936 V1937 V1938 V1939) (kl:shen.copy-vector-stage-2 (+ 1 V1937) (+ V1938 1) V1939 (kl:shen.copy-vector-stage-1 1 V1935 V1936 (+ 1 V1937)))) (export shen.copy-vector) (quote shen.copy-vector)) +(begin (register-function-arity (quote shen.copy-vector-stage-1) 4) (define (kl:shen.copy-vector-stage-1 V1947 V1948 V1949 V1950) (cond ((kl:= V1950 V1947) V1949) (#t (kl:shen.copy-vector-stage-1 (+ 1 V1947) V1948 (let ((_tmp V1949)) (vector-set! _tmp V1947 (vector-ref V1948 V1947)) _tmp) V1950)))) (export shen.copy-vector-stage-1) (quote shen.copy-vector-stage-1)) +(begin (register-function-arity (quote shen.copy-vector-stage-2) 4) (define (kl:shen.copy-vector-stage-2 V1958 V1959 V1960 V1961) (cond ((kl:= V1959 V1958) V1961) (#t (kl:shen.copy-vector-stage-2 (+ V1958 1) V1959 V1960 (let ((_tmp V1961)) (vector-set! _tmp V1958 V1960) _tmp))))) (export shen.copy-vector-stage-2) (quote shen.copy-vector-stage-2)) +(begin (register-function-arity (quote shen.mk-pvar) 1) (define (kl:shen.mk-pvar V1963) (let ((_tmp (let ((_tmp (make-vector 2 (quote (quote shen.fail!))))) (vector-set! _tmp 0 (quote shen.pvar)) _tmp))) (vector-set! _tmp 1 V1963) _tmp)) (export shen.mk-pvar) (quote shen.mk-pvar)) +(begin (register-function-arity (quote shen.pvar?) 1) (define (kl:shen.pvar? V1965) (and (vector? V1965) (eq? (guard (lambda (E) (quote shen.not-pvar)) (vector-ref V1965 0)) (quote shen.pvar)))) (export shen.pvar?) (quote shen.pvar?)) +(begin (register-function-arity (quote shen.bindv) 3) (define (kl:shen.bindv V1969 V1970 V1971) (let ((Vector (vector-ref (kl:value (quote shen.*prologvectors*)) V1971))) (let ((_tmp Vector)) (vector-set! _tmp (vector-ref V1969 1) V1970) _tmp))) (export shen.bindv) (quote shen.bindv)) +(begin (register-function-arity (quote shen.unbindv) 2) (define (kl:shen.unbindv V1974 V1975) (let ((Vector (vector-ref (kl:value (quote shen.*prologvectors*)) V1975))) (let ((_tmp Vector)) (vector-set! _tmp (vector-ref V1974 1) (quote shen.-null-)) _tmp))) (export shen.unbindv) (quote shen.unbindv)) +(begin (register-function-arity (quote shen.incinfs) 0) (define (kl:shen.incinfs) (kl:set (quote shen.*infs*) (+ 1 (kl:value (quote shen.*infs*))))) (export shen.incinfs) (quote shen.incinfs)) +(begin (register-function-arity (quote shen.call_the_continuation) 3) (define (kl:shen.call_the_continuation V1979 V1980 V1981) (cond ((and (pair? V1979) (and (pair? (car V1979)) (null? (cdr V1979)))) (cons (car (car V1979)) (kl:append (cdr (car V1979)) (cons V1980 (cons V1981 (quote ())))))) ((and (pair? V1979) (pair? (car V1979))) (let ((NewContinuation (kl:shen.newcontinuation (cdr V1979) V1980 V1981))) (cons (car (car V1979)) (kl:append (cdr (car V1979)) (cons V1980 (cons NewContinuation (quote ()))))))) (#t (kl:shen.f_error (quote shen.call_the_continuation))))) (export shen.call_the_continuation) (quote shen.call_the_continuation)) +(begin (register-function-arity (quote shen.newcontinuation) 3) (define (kl:shen.newcontinuation V1985 V1986 V1987) (cond ((null? V1985) V1987) ((and (pair? V1985) (pair? (car V1985))) (cons (quote freeze) (cons (cons (car (car V1985)) (kl:append (cdr (car V1985)) (cons V1986 (cons (kl:shen.newcontinuation (cdr V1985) V1986 V1987) (quote ()))))) (quote ())))) (#t (kl:shen.f_error (quote shen.newcontinuation))))) (export shen.newcontinuation) (quote shen.newcontinuation)) +(begin (register-function-arity (quote return) 3) (define (kl:return V1995 V1996 V1997) (kl:shen.deref V1995 V1996)) (export return) (quote return)) +(begin (register-function-arity (quote shen.measure&return) 3) (define (kl:shen.measure&return V2005 V2006 V2007) (begin (kl:shen.prhush (kl:shen.app (kl:value (quote shen.*infs*)) " inferences\n" (quote shen.a)) (kl:stoutput)) (kl:shen.deref V2005 V2006))) (export shen.measure&return) (quote shen.measure&return)) +(begin (register-function-arity (quote unify) 4) (define (kl:unify V2012 V2013 V2014 V2015) (kl:shen.lzy= (kl:shen.lazyderef V2012 V2014) (kl:shen.lazyderef V2013 V2014) V2014 V2015)) (export unify) (quote unify)) +(begin (register-function-arity (quote shen.lzy=) 4) (define (kl:shen.lzy= V2037 V2038 V2039 V2040) (cond ((kl:= V2038 V2037) (kl:thaw V2040)) ((kl:shen.pvar? V2037) (kl:bind V2037 V2038 V2039 V2040)) ((kl:shen.pvar? V2038) (kl:bind V2038 V2037 V2039 V2040)) ((and (pair? V2037) (pair? V2038)) (kl:shen.lzy= (kl:shen.lazyderef (car V2037) V2039) (kl:shen.lazyderef (car V2038) V2039) V2039 (lambda () (kl:shen.lzy= (kl:shen.lazyderef (cdr V2037) V2039) (kl:shen.lazyderef (cdr V2038) V2039) V2039 V2040)))) (#t #f))) (export shen.lzy=) (quote shen.lzy=)) +(begin (register-function-arity (quote shen.deref) 2) (define (kl:shen.deref V2043 V2044) (cond ((pair? V2043) (cons (kl:shen.deref (car V2043) V2044) (kl:shen.deref (cdr V2043) V2044))) (#t (if (kl:shen.pvar? V2043) (let ((Value (kl:shen.valvector V2043 V2044))) (if (eq? Value (quote shen.-null-)) V2043 (kl:shen.deref Value V2044))) V2043)))) (export shen.deref) (quote shen.deref)) +(begin (register-function-arity (quote shen.lazyderef) 2) (define (kl:shen.lazyderef V2047 V2048) (if (kl:shen.pvar? V2047) (let ((Value (kl:shen.valvector V2047 V2048))) (if (eq? Value (quote shen.-null-)) V2047 (kl:shen.lazyderef Value V2048))) V2047)) (export shen.lazyderef) (quote shen.lazyderef)) +(begin (register-function-arity (quote shen.valvector) 2) (define (kl:shen.valvector V2051 V2052) (vector-ref (vector-ref (kl:value (quote shen.*prologvectors*)) V2052) (vector-ref V2051 1))) (export shen.valvector) (quote shen.valvector)) +(begin (register-function-arity (quote unify!) 4) (define (kl:unify! V2057 V2058 V2059 V2060) (kl:shen.lzy=! (kl:shen.lazyderef V2057 V2059) (kl:shen.lazyderef V2058 V2059) V2059 V2060)) (export unify!) (quote unify!)) +(begin (register-function-arity (quote shen.lzy=!) 4) (define (kl:shen.lzy=! V2082 V2083 V2084 V2085) (cond ((kl:= V2083 V2082) (kl:thaw V2085)) ((and (kl:shen.pvar? V2082) (kl:not (kl:shen.occurs? V2082 (kl:shen.deref V2083 V2084)))) (kl:bind V2082 V2083 V2084 V2085)) ((and (kl:shen.pvar? V2083) (kl:not (kl:shen.occurs? V2083 (kl:shen.deref V2082 V2084)))) (kl:bind V2083 V2082 V2084 V2085)) ((and (pair? V2082) (pair? V2083)) (kl:shen.lzy=! (kl:shen.lazyderef (car V2082) V2084) (kl:shen.lazyderef (car V2083) V2084) V2084 (lambda () (kl:shen.lzy=! (kl:shen.lazyderef (cdr V2082) V2084) (kl:shen.lazyderef (cdr V2083) V2084) V2084 V2085)))) (#t #f))) (export shen.lzy=!) (quote shen.lzy=!)) +(begin (register-function-arity (quote shen.occurs?) 2) (define (kl:shen.occurs? V2097 V2098) (cond ((kl:= V2098 V2097) #t) ((pair? V2098) (or (assert-boolean (kl:shen.occurs? V2097 (car V2098))) (assert-boolean (kl:shen.occurs? V2097 (cdr V2098))))) (#t #f))) (export shen.occurs?) (quote shen.occurs?)) +(begin (register-function-arity (quote identical) 4) (define (kl:identical V2103 V2104 V2105 V2106) (kl:shen.lzy== (kl:shen.lazyderef V2103 V2105) (kl:shen.lazyderef V2104 V2105) V2105 V2106)) (export identical) (quote identical)) +(begin (register-function-arity (quote shen.lzy==) 4) (define (kl:shen.lzy== V2128 V2129 V2130 V2131) (cond ((kl:= V2129 V2128) (kl:thaw V2131)) ((and (pair? V2128) (pair? V2129)) (kl:shen.lzy== (kl:shen.lazyderef (car V2128) V2130) (kl:shen.lazyderef (car V2129) V2130) V2130 (lambda () (kl:shen.lzy== (cdr V2128) (cdr V2129) V2130 V2131)))) (#t #f))) (export shen.lzy==) (quote shen.lzy==)) +(begin (register-function-arity (quote shen.pvar) 1) (define (kl:shen.pvar V2133) (string-append "Var" (kl:shen.app (vector-ref V2133 1) "" (quote shen.a)))) (export shen.pvar) (quote shen.pvar)) +(begin (register-function-arity (quote bind) 4) (define (kl:bind V2138 V2139 V2140 V2141) (begin (kl:shen.bindv V2138 V2139 V2140) (let ((Result (kl:thaw V2141))) (begin (kl:shen.unbindv V2138 V2140) Result)))) (export bind) (quote bind)) +(begin (register-function-arity (quote fwhen) 3) (define (kl:fwhen V2159 V2160 V2161) (cond ((kl:= #t V2159) (kl:thaw V2161)) ((kl:= #f V2159) #f) (#t (simple-error (string-append "fwhen expects a boolean: not " (kl:shen.app V2159 "%" (quote shen.s))))))) (export fwhen) (quote fwhen)) +(begin (register-function-arity (quote call) 3) (define (kl:call V2177 V2178 V2179) (cond ((pair? V2177) (kl:shen.call-help (kl:function (kl:shen.lazyderef (car V2177) V2178)) (cdr V2177) V2178 V2179)) ((kl:shen.pvar? V2177) (kl:call (kl:shen.lazyderef V2177 V2178) V2178 V2179)) (#t #f))) (export call) (quote call)) +(begin (register-function-arity (quote shen.call-help) 4) (define (kl:shen.call-help V2184 V2185 V2186 V2187) (cond ((null? V2185) ((V2184 V2186) V2187)) ((pair? V2185) (kl:shen.call-help (V2184 (car V2185)) (cdr V2185) V2186 V2187)) (#t (kl:shen.f_error (quote shen.call-help))))) (export shen.call-help) (quote shen.call-help)) +(begin (register-function-arity (quote shen.intprolog) 1) (define (kl:shen.intprolog V2189) (cond ((and (pair? V2189) (pair? (car V2189))) (let ((ProcessN (kl:shen.start-new-prolog-process))) (kl:shen.intprolog-help (car (car V2189)) (kl:shen.insert-prolog-variables (cons (cdr (car V2189)) (cons (cdr V2189) (quote ()))) ProcessN) ProcessN))) (#t (kl:shen.f_error (quote shen.intprolog))))) (export shen.intprolog) (quote shen.intprolog)) +(begin (register-function-arity (quote shen.intprolog-help) 3) (define (kl:shen.intprolog-help V2193 V2194 V2195) (cond ((and (pair? V2194) (and (pair? (cdr V2194)) (null? (cdr (cdr V2194))))) (kl:shen.intprolog-help-help V2193 (car V2194) (car (cdr V2194)) V2195)) (#t (kl:shen.f_error (quote shen.intprolog-help))))) (export shen.intprolog-help) (quote shen.intprolog-help)) +(begin (register-function-arity (quote shen.intprolog-help-help) 4) (define (kl:shen.intprolog-help-help V2200 V2201 V2202 V2203) (cond ((null? V2201) ((V2200 V2203) (lambda () (kl:shen.call-rest V2202 V2203)))) ((pair? V2201) (kl:shen.intprolog-help-help (V2200 (car V2201)) (cdr V2201) V2202 V2203)) (#t (kl:shen.f_error (quote shen.intprolog-help-help))))) (export shen.intprolog-help-help) (quote shen.intprolog-help-help)) +(begin (register-function-arity (quote shen.call-rest) 2) (define (kl:shen.call-rest V2208 V2209) (cond ((null? V2208) #t) ((and (pair? V2208) (and (pair? (car V2208)) (pair? (cdr (car V2208))))) (kl:shen.call-rest (cons (cons ((car (car V2208)) (car (cdr (car V2208)))) (cdr (cdr (car V2208)))) (cdr V2208)) V2209)) ((and (pair? V2208) (and (pair? (car V2208)) (null? (cdr (car V2208))))) (((car (car V2208)) V2209) (lambda () (kl:shen.call-rest (cdr V2208) V2209)))) (#t (kl:shen.f_error (quote shen.call-rest))))) (export shen.call-rest) (quote shen.call-rest)) +(begin (register-function-arity (quote shen.start-new-prolog-process) 0) (define (kl:shen.start-new-prolog-process) (let ((IncrementProcessCounter (kl:set (quote shen.*process-counter*) (+ 1 (kl:value (quote shen.*process-counter*)))))) (kl:shen.initialise-prolog IncrementProcessCounter))) (export shen.start-new-prolog-process) (quote shen.start-new-prolog-process)) +(begin (register-function-arity (quote shen.insert-prolog-variables) 2) (define (kl:shen.insert-prolog-variables V2212 V2213) (kl:shen.insert-prolog-variables-help V2212 (kl:shen.flatten V2212) V2213)) (export shen.insert-prolog-variables) (quote shen.insert-prolog-variables)) +(begin (register-function-arity (quote shen.insert-prolog-variables-help) 3) (define (kl:shen.insert-prolog-variables-help V2221 V2222 V2223) (cond ((null? V2222) V2221) ((and (pair? V2222) (kl:variable? (car V2222))) (let ((V (kl:shen.newpv V2223))) (let ((XV/Y (kl:subst V (car V2222) V2221))) (let ((Z-Y (kl:remove (car V2222) (cdr V2222)))) (kl:shen.insert-prolog-variables-help XV/Y Z-Y V2223))))) ((pair? V2222) (kl:shen.insert-prolog-variables-help V2221 (cdr V2222) V2223)) (#t (kl:shen.f_error (quote shen.insert-prolog-variables-help))))) (export shen.insert-prolog-variables-help) (quote shen.insert-prolog-variables-help)) +(begin (register-function-arity (quote shen.initialise-prolog) 1) (define (kl:shen.initialise-prolog V2225) (let ((Vector (let ((_tmp (kl:value (quote shen.*prologvectors*)))) (vector-set! _tmp V2225 (kl:shen.fillvector (kl:vector 10) 1 10 (quote shen.-null-))) _tmp))) (let ((Counter (let ((_tmp (kl:value (quote shen.*varcounter*)))) (vector-set! _tmp V2225 1) _tmp))) V2225))) (export shen.initialise-prolog) (quote shen.initialise-prolog)) diff --git a/compiled/reader.kl.ms b/compiled/reader.kl.ms index d343b89..c5414e5 100644 --- a/compiled/reader.kl.ms +++ b/compiled/reader.kl.ms @@ -1,88 +1,89 @@ +(module "compiled/reader.kl") "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.read-char-code) 1) (define (kl:shen.read-char-code V2227) (read-u8 V2227)) (quote shen.read-char-code)) -(begin (register-function-arity (quote read-file-as-bytelist) 1) (define (kl:read-file-as-bytelist V2229) (kl:shen.read-file-as-Xlist V2229 (lambda (S) (read-u8 S)))) (quote read-file-as-bytelist)) -(begin (register-function-arity (quote shen.read-file-as-charlist) 1) (define (kl:shen.read-file-as-charlist V2231) (kl:shen.read-file-as-Xlist V2231 (lambda (S) (kl:shen.read-char-code S)))) (quote shen.read-file-as-charlist)) -(begin (register-function-arity (quote shen.read-file-as-Xlist) 2) (define (kl:shen.read-file-as-Xlist V2234 V2235) (let ((Stream (kl:open V2234 (quote in)))) (let ((X (V2235 Stream))) (let ((Xs (kl:shen.read-file-as-Xlist-help Stream V2235 X (quote ())))) (let ((Close (kl:close Stream))) (kl:reverse Xs)))))) (quote shen.read-file-as-Xlist)) -(begin (register-function-arity (quote shen.read-file-as-Xlist-help) 4) (define (kl:shen.read-file-as-Xlist-help V2240 V2241 V2242 V2243) (cond ((kl:= -1 V2242) V2243) (#t (kl:shen.read-file-as-Xlist-help V2240 V2241 (V2241 V2240) (cons V2242 V2243))))) (quote shen.read-file-as-Xlist-help)) -(begin (register-function-arity (quote read-file-as-string) 1) (define (kl:read-file-as-string V2245) (let ((Stream (kl:open V2245 (quote in)))) (kl:shen.rfas-h Stream (kl:shen.read-char-code Stream) ""))) (quote read-file-as-string)) -(begin (register-function-arity (quote shen.rfas-h) 3) (define (kl:shen.rfas-h V2249 V2250 V2251) (cond ((kl:= -1 V2250) (begin (kl:close V2249) V2251)) (#t (kl:shen.rfas-h V2249 (kl:shen.read-char-code V2249) (string-append V2251 (make-string 1 V2250)))))) (quote shen.rfas-h)) -(begin (register-function-arity (quote input) 1) (define (kl:input V2253) (kl:eval-kl (kl:read V2253))) (quote input)) -(begin (register-function-arity (quote input+) 2) (define (kl:input+ V2256 V2257) (let ((Mono? (kl:shen.monotype V2256))) (let ((Input (kl:read V2257))) (if (kl:= #f (kl:shen.typecheck Input (kl:shen.demodulate V2256))) (simple-error (string-append "type error: " (kl:shen.app Input (string-append " is not of type " (kl:shen.app V2256 "\n" (quote shen.r))) (quote shen.r)))) (kl:eval-kl Input))))) (quote input+)) -(begin (register-function-arity (quote shen.monotype) 1) (define (kl:shen.monotype V2259) (cond ((pair? V2259) (kl:map (lambda (Z) (kl:shen.monotype Z)) V2259)) (#t (if (kl:variable? V2259) (simple-error (string-append "input+ expects a monotype: not " (kl:shen.app V2259 "\n" (quote shen.a)))) V2259)))) (quote shen.monotype)) -(begin (register-function-arity (quote read) 1) (define (kl:read V2261) (car (kl:shen.read-loop V2261 (kl:shen.read-char-code V2261) (quote ())))) (quote read)) -(begin (register-function-arity (quote it) 0) (define (kl:it) (kl:value (quote shen.*it*))) (quote it)) -(begin (register-function-arity (quote shen.read-loop) 3) (define (kl:shen.read-loop V2269 V2270 V2271) (cond ((kl:= 94 V2270) (simple-error "read aborted")) ((kl:= -1 V2270) (if (kl:empty? V2271) (simple-error "error: empty stream") (kl:compile (lambda (X) (kl:shen. X)) V2271 (lambda (E) E)))) ((assert-boolean (kl:shen.terminator? V2270)) (let ((AllChars (kl:append V2271 (cons V2270 (quote ()))))) (let ((It (kl:shen.record-it AllChars))) (let ((Read (kl:compile (lambda (X) (kl:shen. X)) AllChars (lambda (E) (quote shen.nextbyte))))) (if (or (eq? Read (quote shen.nextbyte)) (kl:empty? Read)) (kl:shen.read-loop V2269 (kl:shen.read-char-code V2269) AllChars) Read))))) (#t (kl:shen.read-loop V2269 (kl:shen.read-char-code V2269) (kl:append V2271 (cons V2270 (quote ()))))))) (quote shen.read-loop)) -(begin (register-function-arity (quote shen.terminator?) 1) (define (kl:shen.terminator? V2273) (kl:element? V2273 (cons 9 (cons 10 (cons 13 (cons 32 (cons 34 (cons 41 (cons 93 (quote ())))))))))) (quote shen.terminator?)) -(begin (register-function-arity (quote lineread) 1) (define (kl:lineread V2275) (kl:shen.lineread-loop (kl:shen.read-char-code V2275) (quote ()) V2275)) (quote lineread)) -(begin (register-function-arity (quote shen.lineread-loop) 3) (define (kl:shen.lineread-loop V2280 V2281 V2282) (cond ((kl:= -1 V2280) (if (kl:empty? V2281) (simple-error "empty stream") (kl:compile (lambda (X) (kl:shen. X)) V2281 (lambda (E) E)))) ((kl:= V2280 (kl:shen.hat)) (simple-error "line read aborted")) ((kl:element? V2280 (cons (kl:shen.newline) (cons (kl:shen.carriage-return) (quote ())))) (let ((Line (kl:compile (lambda (X) (kl:shen. X)) V2281 (lambda (E) (quote shen.nextline))))) (let ((It (kl:shen.record-it V2281))) (if (or (eq? Line (quote shen.nextline)) (kl:empty? Line)) (kl:shen.lineread-loop (kl:shen.read-char-code V2282) (kl:append V2281 (cons V2280 (quote ()))) V2282) Line)))) (#t (kl:shen.lineread-loop (kl:shen.read-char-code V2282) (kl:append V2281 (cons V2280 (quote ()))) V2282)))) (quote shen.lineread-loop)) -(begin (register-function-arity (quote shen.record-it) 1) (define (kl:shen.record-it V2284) (let ((TrimLeft (kl:shen.trim-whitespace V2284))) (let ((TrimRight (kl:shen.trim-whitespace (kl:reverse TrimLeft)))) (let ((Trimmed (kl:reverse TrimRight))) (kl:shen.record-it-h Trimmed))))) (quote shen.record-it)) -(begin (register-function-arity (quote shen.trim-whitespace) 1) (define (kl:shen.trim-whitespace V2286) (cond ((and (pair? V2286) (kl:element? (car V2286) (cons 9 (cons 10 (cons 13 (cons 32 (quote ()))))))) (kl:shen.trim-whitespace (cdr V2286))) (#t V2286))) (quote shen.trim-whitespace)) -(begin (register-function-arity (quote shen.record-it-h) 1) (define (kl:shen.record-it-h V2288) (begin (kl:set (quote shen.*it*) (kl:shen.cn-all (kl:map (lambda (X) (make-string 1 X)) V2288))) V2288)) (quote shen.record-it-h)) -(begin (register-function-arity (quote shen.cn-all) 1) (define (kl:shen.cn-all V2290) (cond ((null? V2290) "") ((pair? V2290) (string-append (car V2290) (kl:shen.cn-all (cdr V2290)))) (#t (kl:shen.f_error (quote shen.cn-all))))) (quote shen.cn-all)) -(begin (register-function-arity (quote read-file) 1) (define (kl:read-file V2292) (let ((Charlist (kl:shen.read-file-as-charlist V2292))) (kl:compile (lambda (X) (kl:shen. X)) Charlist (lambda (X) (kl:shen.read-error X))))) (quote read-file)) -(begin (register-function-arity (quote read-from-string) 1) (define (kl:read-from-string V2294) (let ((Ns (kl:map (lambda (X) (string-ref X 0)) (kl:explode V2294)))) (kl:compile (lambda (X) (kl:shen. X)) Ns (lambda (X) (kl:shen.read-error X))))) (quote read-from-string)) -(begin (register-function-arity (quote shen.read-error) 1) (define (kl:shen.read-error V2302) (cond ((and (pair? V2302) (and (pair? (car V2302)) (and (pair? (cdr V2302)) (null? (cdr (cdr V2302)))))) (simple-error (string-append "read error here:\n\n " (kl:shen.app (kl:shen.compress-50 50 (car V2302)) "\n" (quote shen.a))))) (#t (simple-error "read error\n")))) (quote shen.read-error)) -(begin (register-function-arity (quote shen.compress-50) 2) (define (kl:shen.compress-50 V2309 V2310) (cond ((null? V2310) "") ((kl:= 0 V2309) "") ((pair? V2310) (string-append (make-string 1 (car V2310)) (kl:shen.compress-50 (- V2309 1) (cdr V2310)))) (#t (kl:shen.f_error (quote shen.compress-50))))) (quote shen.compress-50)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2312) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2312))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (kl:macroexpand (kl:shen.cons_form (kl:shen.hdtl Parse_shen.))) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2312))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.package-macro (kl:macroexpand (kl:shen.hdtl Parse_shen.)) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2312))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (quote {) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2312))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (quote }) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2312))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (quote bar!) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2312))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (quote _waspvm_sc_) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2312))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (quote :=) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2312))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (quote :-) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2312))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (quote :) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2312))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (kl:intern ",") (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2312))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.hdtl Parse_shen.)) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2312))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (kl:macroexpand (kl:shen.hdtl Parse_shen.)) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2312))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.hdtl Parse_shen.)) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_ (kl: V2312))) (if (kl:not (kl:= (kl:fail) Parse_)) (kl:shen.pair (car Parse_) (quote ())) (kl:fail))) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2315) (if (and (pair? (car V2315)) (kl:= 91 (kl:shen.hdhd V2315))) (let ((NewStream2313 (kl:shen.pair (kl:shen.tlhd V2315) (kl:shen.hdtl V2315)))) (kl:shen.pair (car NewStream2313) (quote shen.skip))) (kl:fail))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2318) (if (and (pair? (car V2318)) (kl:= 93 (kl:shen.hdhd V2318))) (let ((NewStream2316 (kl:shen.pair (kl:shen.tlhd V2318) (kl:shen.hdtl V2318)))) (kl:shen.pair (car NewStream2316) (quote shen.skip))) (kl:fail))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2321) (if (and (pair? (car V2321)) (kl:= 123 (kl:shen.hdhd V2321))) (let ((NewStream2319 (kl:shen.pair (kl:shen.tlhd V2321) (kl:shen.hdtl V2321)))) (kl:shen.pair (car NewStream2319) (quote shen.skip))) (kl:fail))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2324) (if (and (pair? (car V2324)) (kl:= 125 (kl:shen.hdhd V2324))) (let ((NewStream2322 (kl:shen.pair (kl:shen.tlhd V2324) (kl:shen.hdtl V2324)))) (kl:shen.pair (car NewStream2322) (quote shen.skip))) (kl:fail))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2327) (if (and (pair? (car V2327)) (kl:= 124 (kl:shen.hdhd V2327))) (let ((NewStream2325 (kl:shen.pair (kl:shen.tlhd V2327) (kl:shen.hdtl V2327)))) (kl:shen.pair (car NewStream2325) (quote shen.skip))) (kl:fail))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2330) (if (and (pair? (car V2330)) (kl:= 59 (kl:shen.hdhd V2330))) (let ((NewStream2328 (kl:shen.pair (kl:shen.tlhd V2330) (kl:shen.hdtl V2330)))) (kl:shen.pair (car NewStream2328) (quote shen.skip))) (kl:fail))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2333) (if (and (pair? (car V2333)) (kl:= 58 (kl:shen.hdhd V2333))) (let ((NewStream2331 (kl:shen.pair (kl:shen.tlhd V2333) (kl:shen.hdtl V2333)))) (kl:shen.pair (car NewStream2331) (quote shen.skip))) (kl:fail))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2336) (if (and (pair? (car V2336)) (kl:= 44 (kl:shen.hdhd V2336))) (let ((NewStream2334 (kl:shen.pair (kl:shen.tlhd V2336) (kl:shen.hdtl V2336)))) (kl:shen.pair (car NewStream2334) (quote shen.skip))) (kl:fail))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2339) (if (and (pair? (car V2339)) (kl:= 61 (kl:shen.hdhd V2339))) (let ((NewStream2337 (kl:shen.pair (kl:shen.tlhd V2339) (kl:shen.hdtl V2339)))) (kl:shen.pair (car NewStream2337) (quote shen.skip))) (kl:fail))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2342) (if (and (pair? (car V2342)) (kl:= 45 (kl:shen.hdhd V2342))) (let ((NewStream2340 (kl:shen.pair (kl:shen.tlhd V2342) (kl:shen.hdtl V2342)))) (kl:shen.pair (car NewStream2340) (quote shen.skip))) (kl:fail))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2345) (if (and (pair? (car V2345)) (kl:= 40 (kl:shen.hdhd V2345))) (let ((NewStream2343 (kl:shen.pair (kl:shen.tlhd V2345) (kl:shen.hdtl V2345)))) (kl:shen.pair (car NewStream2343) (quote shen.skip))) (kl:fail))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2348) (if (and (pair? (car V2348)) (kl:= 41 (kl:shen.hdhd V2348))) (let ((NewStream2346 (kl:shen.pair (kl:shen.tlhd V2348) (kl:shen.hdtl V2348)))) (kl:shen.pair (car NewStream2346) (quote shen.skip))) (kl:fail))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2350) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2350))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.control-chars (kl:shen.hdtl Parse_shen.))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2350))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.hdtl Parse_shen.)) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_shen. (kl:shen. V2350))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (if (equal? (kl:shen.hdtl Parse_shen.) "<>") (cons (quote vector) (cons 0 (quote ()))) (kl:intern (kl:shen.hdtl Parse_shen.)))) (kl:fail))) YaccParse)) YaccParse))) (quote shen.)) -(begin (register-function-arity (quote shen.control-chars) 1) (define (kl:shen.control-chars V2352) (cond ((null? V2352) "") ((and (pair? V2352) (and (equal? "c" (car V2352)) (and (pair? (cdr V2352)) (equal? "#" (car (cdr V2352)))))) (let ((CodePoint (kl:shen.code-point (cdr (cdr V2352))))) (let ((AfterCodePoint (kl:shen.after-codepoint (cdr (cdr V2352))))) (kl:_waspvm_at_s (make-string 1 (kl:shen.decimalise CodePoint)) (kl:shen.control-chars AfterCodePoint))))) ((pair? V2352) (kl:_waspvm_at_s (car V2352) (kl:shen.control-chars (cdr V2352)))) (#t (kl:shen.f_error (quote shen.control-chars))))) (quote shen.control-chars)) -(begin (register-function-arity (quote shen.code-point) 1) (define (kl:shen.code-point V2356) (cond ((and (pair? V2356) (equal? ";" (car V2356))) "") ((and (pair? V2356) (kl:element? (car V2356) (cons "0" (cons "1" (cons "2" (cons "3" (cons "4" (cons "5" (cons "6" (cons "7" (cons "8" (cons "9" (cons "0" (quote ())))))))))))))) (cons (car V2356) (kl:shen.code-point (cdr V2356)))) (#t (simple-error (string-append "code point parse error " (kl:shen.app V2356 "\n" (quote shen.a))))))) (quote shen.code-point)) -(begin (register-function-arity (quote shen.after-codepoint) 1) (define (kl:shen.after-codepoint V2362) (cond ((null? V2362) (quote ())) ((and (pair? V2362) (equal? ";" (car V2362))) (cdr V2362)) ((pair? V2362) (kl:shen.after-codepoint (cdr V2362))) (#t (kl:shen.f_error (quote shen.after-codepoint))))) (quote shen.after-codepoint)) -(begin (register-function-arity (quote shen.decimalise) 1) (define (kl:shen.decimalise V2364) (kl:shen.pre (kl:reverse (kl:shen.digits->integers V2364)) 0)) (quote shen.decimalise)) -(begin (register-function-arity (quote shen.digits->integers) 1) (define (kl:shen.digits->integers V2370) (cond ((and (pair? V2370) (equal? "0" (car V2370))) (cons 0 (kl:shen.digits->integers (cdr V2370)))) ((and (pair? V2370) (equal? "1" (car V2370))) (cons 1 (kl:shen.digits->integers (cdr V2370)))) ((and (pair? V2370) (equal? "2" (car V2370))) (cons 2 (kl:shen.digits->integers (cdr V2370)))) ((and (pair? V2370) (equal? "3" (car V2370))) (cons 3 (kl:shen.digits->integers (cdr V2370)))) ((and (pair? V2370) (equal? "4" (car V2370))) (cons 4 (kl:shen.digits->integers (cdr V2370)))) ((and (pair? V2370) (equal? "5" (car V2370))) (cons 5 (kl:shen.digits->integers (cdr V2370)))) ((and (pair? V2370) (equal? "6" (car V2370))) (cons 6 (kl:shen.digits->integers (cdr V2370)))) ((and (pair? V2370) (equal? "7" (car V2370))) (cons 7 (kl:shen.digits->integers (cdr V2370)))) ((and (pair? V2370) (equal? "8" (car V2370))) (cons 8 (kl:shen.digits->integers (cdr V2370)))) ((and (pair? V2370) (equal? "9" (car V2370))) (cons 9 (kl:shen.digits->integers (cdr V2370)))) (#t (quote ())))) (quote shen.digits->integers)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2372) (let ((Parse_shen. (kl:shen. V2372))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:_waspvm_at_s (kl:shen.hdtl Parse_shen.) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail)))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2374) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2374))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:_waspvm_at_s (kl:shen.hdtl Parse_shen.) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_ (kl: V2374))) (if (kl:not (kl:= (kl:fail) Parse_)) (kl:shen.pair (car Parse_) "") (kl:fail))) YaccParse))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2376) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2376))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.hdtl Parse_shen.)) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_shen. (kl:shen. V2376))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.hdtl Parse_shen.)) (kl:fail))) YaccParse))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2378) (if (pair? (car V2378)) (let ((Parse_Char (kl:shen.hdhd V2378))) (if (assert-boolean (kl:shen.numbyte? Parse_Char)) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V2378) (kl:shen.hdtl V2378))) (make-string 1 Parse_Char)) (kl:fail))) (kl:fail))) (quote shen.)) -(begin (register-function-arity (quote shen.numbyte?) 1) (define (kl:shen.numbyte? V2384) (cond ((kl:= 48 V2384) #t) ((kl:= 49 V2384) #t) ((kl:= 50 V2384) #t) ((kl:= 51 V2384) #t) ((kl:= 52 V2384) #t) ((kl:= 53 V2384) #t) ((kl:= 54 V2384) #t) ((kl:= 55 V2384) #t) ((kl:= 56 V2384) #t) ((kl:= 57 V2384) #t) (#t #f))) (quote shen.numbyte?)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2386) (if (pair? (car V2386)) (let ((Parse_Char (kl:shen.hdhd V2386))) (if (assert-boolean (kl:shen.symbol-code? Parse_Char)) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V2386) (kl:shen.hdtl V2386))) (make-string 1 Parse_Char)) (kl:fail))) (kl:fail))) (quote shen.)) -(begin (register-function-arity (quote shen.symbol-code?) 1) (define (kl:shen.symbol-code? V2388) (or (kl:= V2388 126) (or (and (> V2388 94) (< V2388 123)) (or (and (> V2388 59) (< V2388 91)) (or (and (> V2388 41) (and (< V2388 58) (kl:not (kl:= V2388 44)))) (or (and (> V2388 34) (< V2388 40)) (kl:= V2388 33))))))) (quote shen.symbol-code?)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2390) (let ((Parse_shen. (kl:shen. V2390))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.hdtl Parse_shen.)) (kl:fail))) (kl:fail))) (kl:fail)))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2392) (if (pair? (car V2392)) (let ((Parse_Char (kl:shen.hdhd V2392))) (if (kl:= Parse_Char 34) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V2392) (kl:shen.hdtl V2392))) Parse_Char) (kl:fail))) (kl:fail))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2394) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2394))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_ (kl: V2394))) (if (kl:not (kl:= (kl:fail) Parse_)) (kl:shen.pair (car Parse_) (quote ())) (kl:fail))) YaccParse))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2396) (if (pair? (car V2396)) (let ((Parse_Char (kl:shen.hdhd V2396))) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V2396) (kl:shen.hdtl V2396))) (make-string 1 Parse_Char))) (kl:fail))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2398) (if (pair? (car V2398)) (let ((Parse_Char (kl:shen.hdhd V2398))) (if (kl:not (kl:= Parse_Char 34)) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V2398) (kl:shen.hdtl V2398))) (make-string 1 Parse_Char)) (kl:fail))) (kl:fail))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2400) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2400))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (- 0 (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2400))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.hdtl Parse_shen.)) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2400))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (* (kl:shen.expt 10 (kl:shen.hdtl Parse_shen.)) (+ (kl:shen.pre (kl:reverse (kl:shen.hdtl Parse_shen.)) 0) (kl:shen.post (kl:shen.hdtl Parse_shen.) 1)))) (kl:fail))) (kl:fail))) (kl:fail))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2400))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (* (kl:shen.expt 10 (kl:shen.hdtl Parse_shen.)) (kl:shen.pre (kl:reverse (kl:shen.hdtl Parse_shen.)) 0))) (kl:fail))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2400))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (+ (kl:shen.pre (kl:reverse (kl:shen.hdtl Parse_shen.)) 0) (kl:shen.post (kl:shen.hdtl Parse_shen.) 1))) (kl:fail))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_shen. (kl:shen. V2400))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.pre (kl:reverse (kl:shen.hdtl Parse_shen.)) 0)) (kl:fail))) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2403) (if (and (pair? (car V2403)) (kl:= 101 (kl:shen.hdhd V2403))) (let ((NewStream2401 (kl:shen.pair (kl:shen.tlhd V2403) (kl:shen.hdtl V2403)))) (kl:shen.pair (car NewStream2401) (quote shen.skip))) (kl:fail))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2405) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2405))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (- 0 (kl:shen.pre (kl:reverse (kl:shen.hdtl Parse_shen.)) 0))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_shen. (kl:shen. V2405))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.pre (kl:reverse (kl:shen.hdtl Parse_shen.)) 0)) (kl:fail))) YaccParse))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2407) (if (pair? (car V2407)) (let ((Parse_Char (kl:shen.hdhd V2407))) (if (kl:= Parse_Char 43) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V2407) (kl:shen.hdtl V2407))) Parse_Char) (kl:fail))) (kl:fail))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2409) (if (pair? (car V2409)) (let ((Parse_Char (kl:shen.hdhd V2409))) (if (kl:= Parse_Char 46) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V2409) (kl:shen.hdtl V2409))) Parse_Char) (kl:fail))) (kl:fail))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2411) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2411))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.hdtl Parse_shen.)) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_ (kl: V2411))) (if (kl:not (kl:= (kl:fail) Parse_)) (kl:shen.pair (car Parse_) (quote ())) (kl:fail))) YaccParse))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2413) (let ((Parse_shen. (kl:shen. V2413))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.hdtl Parse_shen.)) (kl:fail)))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2415) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2415))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_shen. (kl:shen. V2415))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (quote ()))) (kl:fail))) YaccParse))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2417) (if (pair? (car V2417)) (let ((Parse_X (kl:shen.hdhd V2417))) (if (assert-boolean (kl:shen.numbyte? Parse_X)) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V2417) (kl:shen.hdtl V2417))) (kl:shen.byte->digit Parse_X)) (kl:fail))) (kl:fail))) (quote shen.)) -(begin (register-function-arity (quote shen.byte->digit) 1) (define (kl:shen.byte->digit V2419) (cond ((kl:= 48 V2419) 0) ((kl:= 49 V2419) 1) ((kl:= 50 V2419) 2) ((kl:= 51 V2419) 3) ((kl:= 52 V2419) 4) ((kl:= 53 V2419) 5) ((kl:= 54 V2419) 6) ((kl:= 55 V2419) 7) ((kl:= 56 V2419) 8) ((kl:= 57 V2419) 9) (#t (kl:shen.f_error (quote shen.byte->digit))))) (quote shen.byte->digit)) -(begin (register-function-arity (quote shen.pre) 2) (define (kl:shen.pre V2424 V2425) (cond ((null? V2424) 0) ((pair? V2424) (+ (* (kl:shen.expt 10 V2425) (car V2424)) (kl:shen.pre (cdr V2424) (+ V2425 1)))) (#t (kl:shen.f_error (quote shen.pre))))) (quote shen.pre)) -(begin (register-function-arity (quote shen.post) 2) (define (kl:shen.post V2430 V2431) (cond ((null? V2430) 0) ((pair? V2430) (+ (* (kl:shen.expt 10 (- 0 V2431)) (car V2430)) (kl:shen.post (cdr V2430) (+ V2431 1)))) (#t (kl:shen.f_error (quote shen.post))))) (quote shen.post)) -(begin (register-function-arity (quote shen.expt) 2) (define (kl:shen.expt V2436 V2437) (cond ((kl:= 0 V2437) 1) ((> V2437 0) (* V2436 (kl:shen.expt V2436 (- V2437 1)))) (#t (* 1.000000000000000 (/ (kl:shen.expt V2436 (+ V2437 1)) V2436))))) (quote shen.expt)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2439) (let ((Parse_shen. (kl:shen. V2439))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.hdtl Parse_shen.)) (kl:fail)))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2441) (let ((Parse_shen. (kl:shen. V2441))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.hdtl Parse_shen.)) (kl:fail)))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2443) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2443))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (quote shen.skip)) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_shen. (kl:shen. V2443))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (quote shen.skip)) (kl:fail))) YaccParse))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2445) (let ((Parse_shen. (kl:shen. V2445))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (quote shen.skip)) (kl:fail))) (kl:fail))) (kl:fail))) (kl:fail)))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2448) (if (and (pair? (car V2448)) (kl:= 92 (kl:shen.hdhd V2448))) (let ((NewStream2446 (kl:shen.pair (kl:shen.tlhd V2448) (kl:shen.hdtl V2448)))) (kl:shen.pair (car NewStream2446) (quote shen.skip))) (kl:fail))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2450) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2450))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (quote shen.skip)) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_ (kl: V2450))) (if (kl:not (kl:= (kl:fail) Parse_)) (kl:shen.pair (car Parse_) (quote shen.skip)) (kl:fail))) YaccParse))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2452) (if (pair? (car V2452)) (let ((Parse_X (kl:shen.hdhd V2452))) (if (kl:not (kl:element? Parse_X (cons 10 (cons 13 (quote ()))))) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V2452) (kl:shen.hdtl V2452))) (quote shen.skip)) (kl:fail))) (kl:fail))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2454) (if (pair? (car V2454)) (let ((Parse_X (kl:shen.hdhd V2454))) (if (kl:element? Parse_X (cons 10 (cons 13 (quote ())))) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V2454) (kl:shen.hdtl V2454))) (quote shen.skip)) (kl:fail))) (kl:fail))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2456) (let ((Parse_shen. (kl:shen. V2456))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (quote shen.skip)) (kl:fail))) (kl:fail))) (kl:fail)))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2459) (if (and (pair? (car V2459)) (kl:= 42 (kl:shen.hdhd V2459))) (let ((NewStream2457 (kl:shen.pair (kl:shen.tlhd V2459) (kl:shen.hdtl V2459)))) (kl:shen.pair (car NewStream2457) (quote shen.skip))) (kl:fail))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2461) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2461))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (quote shen.skip)) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2461))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (quote shen.skip)) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (if (pair? (car V2461)) (let ((Parse_X (kl:shen.hdhd V2461))) (let ((Parse_shen. (kl:shen. (kl:shen.pair (kl:shen.tlhd V2461) (kl:shen.hdtl V2461))))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (quote shen.skip)) (kl:fail)))) (kl:fail)) YaccParse)) YaccParse))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2463) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2463))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (quote shen.skip)) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_shen. (kl:shen. V2463))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (quote shen.skip)) (kl:fail))) YaccParse))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2465) (if (pair? (car V2465)) (let ((Parse_X (kl:shen.hdhd V2465))) (if (assert-boolean (let ((Parse_Case Parse_X)) (or (kl:= Parse_Case 32) (or (kl:= Parse_Case 13) (or (kl:= Parse_Case 10) (kl:= Parse_Case 9)))))) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V2465) (kl:shen.hdtl V2465))) (quote shen.skip)) (kl:fail))) (kl:fail))) (quote shen.)) -(begin (register-function-arity (quote shen.cons_form) 1) (define (kl:shen.cons_form V2467) (cond ((null? V2467) (quote ())) ((and (pair? V2467) (and (pair? (cdr V2467)) (and (pair? (cdr (cdr V2467))) (and (null? (cdr (cdr (cdr V2467)))) (eq? (car (cdr V2467)) (quote bar!)))))) (cons (quote cons) (cons (car V2467) (cdr (cdr V2467))))) ((pair? V2467) (cons (quote cons) (cons (car V2467) (cons (kl:shen.cons_form (cdr V2467)) (quote ()))))) (#t (kl:shen.f_error (quote shen.cons_form))))) (quote shen.cons_form)) -(begin (register-function-arity (quote shen.package-macro) 2) (define (kl:shen.package-macro V2472 V2473) (cond ((and (pair? V2472) (and (eq? (quote _waspvm_dl_) (car V2472)) (and (pair? (cdr V2472)) (null? (cdr (cdr V2472)))))) (kl:append (kl:explode (car (cdr V2472))) V2473)) ((and (pair? V2472) (and (eq? (quote package) (car V2472)) (and (pair? (cdr V2472)) (and (eq? (quote null) (car (cdr V2472))) (pair? (cdr (cdr V2472))))))) (kl:append (cdr (cdr (cdr V2472))) V2473)) ((and (pair? V2472) (and (eq? (quote package) (car V2472)) (and (pair? (cdr V2472)) (pair? (cdr (cdr V2472)))))) (let ((ListofExceptions (kl:shen.eval-without-macros (car (cdr (cdr V2472)))))) (let ((External (kl:shen.record-exceptions ListofExceptions (car (cdr V2472))))) (let ((PackageNameDot (kl:intern (string-append (kl:str (car (cdr V2472))) ".")))) (let ((ExpPackageNameDot (kl:explode PackageNameDot))) (let ((Packaged (kl:shen.packageh PackageNameDot ListofExceptions (cdr (cdr (cdr V2472))) ExpPackageNameDot))) (let ((Internal (kl:shen.record-internal (car (cdr V2472)) (kl:shen.internal-symbols ExpPackageNameDot Packaged)))) (kl:append Packaged V2473)))))))) (#t (cons V2472 V2473)))) (quote shen.package-macro)) -(begin (register-function-arity (quote shen.record-exceptions) 2) (define (kl:shen.record-exceptions V2476 V2477) (let ((CurrExceptions (guard (lambda (E) (quote ())) (kl:get V2477 (quote shen.external-symbols) (kl:value (quote *property-vector*)))))) (let ((AllExceptions (kl:union V2476 CurrExceptions))) (kl:put V2477 (quote shen.external-symbols) AllExceptions (kl:value (quote *property-vector*)))))) (quote shen.record-exceptions)) -(begin (register-function-arity (quote shen.record-internal) 2) (define (kl:shen.record-internal V2480 V2481) (kl:put V2480 (quote shen.internal-symbols) (kl:union V2481 (guard (lambda (E) (quote ())) (kl:get V2480 (quote shen.internal-symbols) (kl:value (quote *property-vector*))))) (kl:value (quote *property-vector*)))) (quote shen.record-internal)) -(begin (register-function-arity (quote shen.internal-symbols) 2) (define (kl:shen.internal-symbols V2492 V2493) (cond ((and (kl:symbol? V2493) (assert-boolean (kl:shen.prefix? V2492 (kl:explode V2493)))) (cons V2493 (quote ()))) ((pair? V2493) (kl:union (kl:shen.internal-symbols V2492 (car V2493)) (kl:shen.internal-symbols V2492 (cdr V2493)))) (#t (quote ())))) (quote shen.internal-symbols)) -(begin (register-function-arity (quote shen.packageh) 4) (define (kl:shen.packageh V2510 V2511 V2512 V2513) (cond ((pair? V2512) (cons (kl:shen.packageh V2510 V2511 (car V2512) V2513) (kl:shen.packageh V2510 V2511 (cdr V2512) V2513))) ((or (assert-boolean (kl:shen.sysfunc? V2512)) (or (kl:variable? V2512) (or (kl:element? V2512 V2511) (or (assert-boolean (kl:shen.doubleunderline? V2512)) (assert-boolean (kl:shen.singleunderline? V2512)))))) V2512) ((and (kl:symbol? V2512) (assert-boolean (let ((ExplodeX (kl:explode V2512))) (and (kl:not (kl:shen.prefix? (cons "s" (cons "h" (cons "e" (cons "n" (cons "." (quote ())))))) ExplodeX)) (kl:not (kl:shen.prefix? V2513 ExplodeX)))))) (kl:concat V2510 V2512)) (#t V2512))) (quote shen.packageh)) +(begin (register-function-arity (quote shen.read-char-code) 1) (define (kl:shen.read-char-code V2227) (read-u8 V2227)) (export shen.read-char-code) (quote shen.read-char-code)) +(begin (register-function-arity (quote read-file-as-bytelist) 1) (define (kl:read-file-as-bytelist V2229) (kl:shen.read-file-as-Xlist V2229 (lambda (S) (read-u8 S)))) (export read-file-as-bytelist) (quote read-file-as-bytelist)) +(begin (register-function-arity (quote shen.read-file-as-charlist) 1) (define (kl:shen.read-file-as-charlist V2231) (kl:shen.read-file-as-Xlist V2231 (lambda (S) (kl:shen.read-char-code S)))) (export shen.read-file-as-charlist) (quote shen.read-file-as-charlist)) +(begin (register-function-arity (quote shen.read-file-as-Xlist) 2) (define (kl:shen.read-file-as-Xlist V2234 V2235) (let ((Stream (kl:open V2234 (quote in)))) (let ((X (V2235 Stream))) (let ((Xs (kl:shen.read-file-as-Xlist-help Stream V2235 X (quote ())))) (let ((Close (kl:close Stream))) (kl:reverse Xs)))))) (export shen.read-file-as-Xlist) (quote shen.read-file-as-Xlist)) +(begin (register-function-arity (quote shen.read-file-as-Xlist-help) 4) (define (kl:shen.read-file-as-Xlist-help V2240 V2241 V2242 V2243) (cond ((kl:= -1 V2242) V2243) (#t (kl:shen.read-file-as-Xlist-help V2240 V2241 (V2241 V2240) (cons V2242 V2243))))) (export shen.read-file-as-Xlist-help) (quote shen.read-file-as-Xlist-help)) +(begin (register-function-arity (quote read-file-as-string) 1) (define (kl:read-file-as-string V2245) (let ((Stream (kl:open V2245 (quote in)))) (kl:shen.rfas-h Stream (kl:shen.read-char-code Stream) ""))) (export read-file-as-string) (quote read-file-as-string)) +(begin (register-function-arity (quote shen.rfas-h) 3) (define (kl:shen.rfas-h V2249 V2250 V2251) (cond ((kl:= -1 V2250) (begin (kl:close V2249) V2251)) (#t (kl:shen.rfas-h V2249 (kl:shen.read-char-code V2249) (string-append V2251 (make-string 1 V2250)))))) (export shen.rfas-h) (quote shen.rfas-h)) +(begin (register-function-arity (quote input) 1) (define (kl:input V2253) (kl:eval-kl (kl:read V2253))) (export input) (quote input)) +(begin (register-function-arity (quote input+) 2) (define (kl:input+ V2256 V2257) (let ((Mono? (kl:shen.monotype V2256))) (let ((Input (kl:read V2257))) (if (kl:= #f (kl:shen.typecheck Input (kl:shen.demodulate V2256))) (simple-error (string-append "type error: " (kl:shen.app Input (string-append " is not of type " (kl:shen.app V2256 "\n" (quote shen.r))) (quote shen.r)))) (kl:eval-kl Input))))) (export input+) (quote input+)) +(begin (register-function-arity (quote shen.monotype) 1) (define (kl:shen.monotype V2259) (cond ((pair? V2259) (kl:map (lambda (Z) (kl:shen.monotype Z)) V2259)) (#t (if (kl:variable? V2259) (simple-error (string-append "input+ expects a monotype: not " (kl:shen.app V2259 "\n" (quote shen.a)))) V2259)))) (export shen.monotype) (quote shen.monotype)) +(begin (register-function-arity (quote read) 1) (define (kl:read V2261) (car (kl:shen.read-loop V2261 (kl:shen.read-char-code V2261) (quote ())))) (export read) (quote read)) +(begin (register-function-arity (quote it) 0) (define (kl:it) (kl:value (quote shen.*it*))) (export it) (quote it)) +(begin (register-function-arity (quote shen.read-loop) 3) (define (kl:shen.read-loop V2269 V2270 V2271) (cond ((kl:= 94 V2270) (simple-error "read aborted")) ((kl:= -1 V2270) (if (kl:empty? V2271) (simple-error "error: empty stream") (kl:compile (lambda (X) (kl:shen. X)) V2271 (lambda (E) E)))) ((assert-boolean (kl:shen.terminator? V2270)) (let ((AllChars (kl:append V2271 (cons V2270 (quote ()))))) (let ((It (kl:shen.record-it AllChars))) (let ((Read (kl:compile (lambda (X) (kl:shen. X)) AllChars (lambda (E) (quote shen.nextbyte))))) (if (or (eq? Read (quote shen.nextbyte)) (kl:empty? Read)) (kl:shen.read-loop V2269 (kl:shen.read-char-code V2269) AllChars) Read))))) (#t (kl:shen.read-loop V2269 (kl:shen.read-char-code V2269) (kl:append V2271 (cons V2270 (quote ()))))))) (export shen.read-loop) (quote shen.read-loop)) +(begin (register-function-arity (quote shen.terminator?) 1) (define (kl:shen.terminator? V2273) (kl:element? V2273 (cons 9 (cons 10 (cons 13 (cons 32 (cons 34 (cons 41 (cons 93 (quote ())))))))))) (export shen.terminator?) (quote shen.terminator?)) +(begin (register-function-arity (quote lineread) 1) (define (kl:lineread V2275) (kl:shen.lineread-loop (kl:shen.read-char-code V2275) (quote ()) V2275)) (export lineread) (quote lineread)) +(begin (register-function-arity (quote shen.lineread-loop) 3) (define (kl:shen.lineread-loop V2280 V2281 V2282) (cond ((kl:= -1 V2280) (if (kl:empty? V2281) (simple-error "empty stream") (kl:compile (lambda (X) (kl:shen. X)) V2281 (lambda (E) E)))) ((kl:= V2280 (kl:shen.hat)) (simple-error "line read aborted")) ((kl:element? V2280 (cons (kl:shen.newline) (cons (kl:shen.carriage-return) (quote ())))) (let ((Line (kl:compile (lambda (X) (kl:shen. X)) V2281 (lambda (E) (quote shen.nextline))))) (let ((It (kl:shen.record-it V2281))) (if (or (eq? Line (quote shen.nextline)) (kl:empty? Line)) (kl:shen.lineread-loop (kl:shen.read-char-code V2282) (kl:append V2281 (cons V2280 (quote ()))) V2282) Line)))) (#t (kl:shen.lineread-loop (kl:shen.read-char-code V2282) (kl:append V2281 (cons V2280 (quote ()))) V2282)))) (export shen.lineread-loop) (quote shen.lineread-loop)) +(begin (register-function-arity (quote shen.record-it) 1) (define (kl:shen.record-it V2284) (let ((TrimLeft (kl:shen.trim-whitespace V2284))) (let ((TrimRight (kl:shen.trim-whitespace (kl:reverse TrimLeft)))) (let ((Trimmed (kl:reverse TrimRight))) (kl:shen.record-it-h Trimmed))))) (export shen.record-it) (quote shen.record-it)) +(begin (register-function-arity (quote shen.trim-whitespace) 1) (define (kl:shen.trim-whitespace V2286) (cond ((and (pair? V2286) (kl:element? (car V2286) (cons 9 (cons 10 (cons 13 (cons 32 (quote ()))))))) (kl:shen.trim-whitespace (cdr V2286))) (#t V2286))) (export shen.trim-whitespace) (quote shen.trim-whitespace)) +(begin (register-function-arity (quote shen.record-it-h) 1) (define (kl:shen.record-it-h V2288) (begin (kl:set (quote shen.*it*) (kl:shen.cn-all (kl:map (lambda (X) (make-string 1 X)) V2288))) V2288)) (export shen.record-it-h) (quote shen.record-it-h)) +(begin (register-function-arity (quote shen.cn-all) 1) (define (kl:shen.cn-all V2290) (cond ((null? V2290) "") ((pair? V2290) (string-append (car V2290) (kl:shen.cn-all (cdr V2290)))) (#t (kl:shen.f_error (quote shen.cn-all))))) (export shen.cn-all) (quote shen.cn-all)) +(begin (register-function-arity (quote read-file) 1) (define (kl:read-file V2292) (let ((Charlist (kl:shen.read-file-as-charlist V2292))) (kl:compile (lambda (X) (kl:shen. X)) Charlist (lambda (X) (kl:shen.read-error X))))) (export read-file) (quote read-file)) +(begin (register-function-arity (quote read-from-string) 1) (define (kl:read-from-string V2294) (let ((Ns (kl:map (lambda (X) (string-ref X 0)) (kl:explode V2294)))) (kl:compile (lambda (X) (kl:shen. X)) Ns (lambda (X) (kl:shen.read-error X))))) (export read-from-string) (quote read-from-string)) +(begin (register-function-arity (quote shen.read-error) 1) (define (kl:shen.read-error V2302) (cond ((and (pair? V2302) (and (pair? (car V2302)) (and (pair? (cdr V2302)) (null? (cdr (cdr V2302)))))) (simple-error (string-append "read error here:\n\n " (kl:shen.app (kl:shen.compress-50 50 (car V2302)) "\n" (quote shen.a))))) (#t (simple-error "read error\n")))) (export shen.read-error) (quote shen.read-error)) +(begin (register-function-arity (quote shen.compress-50) 2) (define (kl:shen.compress-50 V2309 V2310) (cond ((null? V2310) "") ((kl:= 0 V2309) "") ((pair? V2310) (string-append (make-string 1 (car V2310)) (kl:shen.compress-50 (- V2309 1) (cdr V2310)))) (#t (kl:shen.f_error (quote shen.compress-50))))) (export shen.compress-50) (quote shen.compress-50)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2312) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2312))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (kl:macroexpand (kl:shen.cons_form (kl:shen.hdtl Parse_shen.))) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2312))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.package-macro (kl:macroexpand (kl:shen.hdtl Parse_shen.)) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2312))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (quote {) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2312))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (quote }) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2312))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (quote bar!) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2312))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (quote _waspvm_sc_) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2312))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (quote :=) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2312))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (quote :-) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2312))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (quote :) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2312))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (kl:intern ",") (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2312))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.hdtl Parse_shen.)) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2312))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (kl:macroexpand (kl:shen.hdtl Parse_shen.)) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2312))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.hdtl Parse_shen.)) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_ (kl: V2312))) (if (kl:not (kl:= (kl:fail) Parse_)) (kl:shen.pair (car Parse_) (quote ())) (kl:fail))) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2315) (if (and (pair? (car V2315)) (kl:= 91 (kl:shen.hdhd V2315))) (let ((NewStream2313 (kl:shen.pair (kl:shen.tlhd V2315) (kl:shen.hdtl V2315)))) (kl:shen.pair (car NewStream2313) (quote shen.skip))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2318) (if (and (pair? (car V2318)) (kl:= 93 (kl:shen.hdhd V2318))) (let ((NewStream2316 (kl:shen.pair (kl:shen.tlhd V2318) (kl:shen.hdtl V2318)))) (kl:shen.pair (car NewStream2316) (quote shen.skip))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2321) (if (and (pair? (car V2321)) (kl:= 123 (kl:shen.hdhd V2321))) (let ((NewStream2319 (kl:shen.pair (kl:shen.tlhd V2321) (kl:shen.hdtl V2321)))) (kl:shen.pair (car NewStream2319) (quote shen.skip))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2324) (if (and (pair? (car V2324)) (kl:= 125 (kl:shen.hdhd V2324))) (let ((NewStream2322 (kl:shen.pair (kl:shen.tlhd V2324) (kl:shen.hdtl V2324)))) (kl:shen.pair (car NewStream2322) (quote shen.skip))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2327) (if (and (pair? (car V2327)) (kl:= 124 (kl:shen.hdhd V2327))) (let ((NewStream2325 (kl:shen.pair (kl:shen.tlhd V2327) (kl:shen.hdtl V2327)))) (kl:shen.pair (car NewStream2325) (quote shen.skip))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2330) (if (and (pair? (car V2330)) (kl:= 59 (kl:shen.hdhd V2330))) (let ((NewStream2328 (kl:shen.pair (kl:shen.tlhd V2330) (kl:shen.hdtl V2330)))) (kl:shen.pair (car NewStream2328) (quote shen.skip))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2333) (if (and (pair? (car V2333)) (kl:= 58 (kl:shen.hdhd V2333))) (let ((NewStream2331 (kl:shen.pair (kl:shen.tlhd V2333) (kl:shen.hdtl V2333)))) (kl:shen.pair (car NewStream2331) (quote shen.skip))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2336) (if (and (pair? (car V2336)) (kl:= 44 (kl:shen.hdhd V2336))) (let ((NewStream2334 (kl:shen.pair (kl:shen.tlhd V2336) (kl:shen.hdtl V2336)))) (kl:shen.pair (car NewStream2334) (quote shen.skip))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2339) (if (and (pair? (car V2339)) (kl:= 61 (kl:shen.hdhd V2339))) (let ((NewStream2337 (kl:shen.pair (kl:shen.tlhd V2339) (kl:shen.hdtl V2339)))) (kl:shen.pair (car NewStream2337) (quote shen.skip))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2342) (if (and (pair? (car V2342)) (kl:= 45 (kl:shen.hdhd V2342))) (let ((NewStream2340 (kl:shen.pair (kl:shen.tlhd V2342) (kl:shen.hdtl V2342)))) (kl:shen.pair (car NewStream2340) (quote shen.skip))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2345) (if (and (pair? (car V2345)) (kl:= 40 (kl:shen.hdhd V2345))) (let ((NewStream2343 (kl:shen.pair (kl:shen.tlhd V2345) (kl:shen.hdtl V2345)))) (kl:shen.pair (car NewStream2343) (quote shen.skip))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2348) (if (and (pair? (car V2348)) (kl:= 41 (kl:shen.hdhd V2348))) (let ((NewStream2346 (kl:shen.pair (kl:shen.tlhd V2348) (kl:shen.hdtl V2348)))) (kl:shen.pair (car NewStream2346) (quote shen.skip))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2350) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2350))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.control-chars (kl:shen.hdtl Parse_shen.))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2350))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.hdtl Parse_shen.)) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_shen. (kl:shen. V2350))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (if (equal? (kl:shen.hdtl Parse_shen.) "<>") (cons (quote vector) (cons 0 (quote ()))) (kl:intern (kl:shen.hdtl Parse_shen.)))) (kl:fail))) YaccParse)) YaccParse))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.control-chars) 1) (define (kl:shen.control-chars V2352) (cond ((null? V2352) "") ((and (pair? V2352) (and (equal? "c" (car V2352)) (and (pair? (cdr V2352)) (equal? "#" (car (cdr V2352)))))) (let ((CodePoint (kl:shen.code-point (cdr (cdr V2352))))) (let ((AfterCodePoint (kl:shen.after-codepoint (cdr (cdr V2352))))) (kl:_waspvm_at_s (make-string 1 (kl:shen.decimalise CodePoint)) (kl:shen.control-chars AfterCodePoint))))) ((pair? V2352) (kl:_waspvm_at_s (car V2352) (kl:shen.control-chars (cdr V2352)))) (#t (kl:shen.f_error (quote shen.control-chars))))) (export shen.control-chars) (quote shen.control-chars)) +(begin (register-function-arity (quote shen.code-point) 1) (define (kl:shen.code-point V2356) (cond ((and (pair? V2356) (equal? ";" (car V2356))) "") ((and (pair? V2356) (kl:element? (car V2356) (cons "0" (cons "1" (cons "2" (cons "3" (cons "4" (cons "5" (cons "6" (cons "7" (cons "8" (cons "9" (cons "0" (quote ())))))))))))))) (cons (car V2356) (kl:shen.code-point (cdr V2356)))) (#t (simple-error (string-append "code point parse error " (kl:shen.app V2356 "\n" (quote shen.a))))))) (export shen.code-point) (quote shen.code-point)) +(begin (register-function-arity (quote shen.after-codepoint) 1) (define (kl:shen.after-codepoint V2362) (cond ((null? V2362) (quote ())) ((and (pair? V2362) (equal? ";" (car V2362))) (cdr V2362)) ((pair? V2362) (kl:shen.after-codepoint (cdr V2362))) (#t (kl:shen.f_error (quote shen.after-codepoint))))) (export shen.after-codepoint) (quote shen.after-codepoint)) +(begin (register-function-arity (quote shen.decimalise) 1) (define (kl:shen.decimalise V2364) (kl:shen.pre (kl:reverse (kl:shen.digits->integers V2364)) 0)) (export shen.decimalise) (quote shen.decimalise)) +(begin (register-function-arity (quote shen.digits->integers) 1) (define (kl:shen.digits->integers V2370) (cond ((and (pair? V2370) (equal? "0" (car V2370))) (cons 0 (kl:shen.digits->integers (cdr V2370)))) ((and (pair? V2370) (equal? "1" (car V2370))) (cons 1 (kl:shen.digits->integers (cdr V2370)))) ((and (pair? V2370) (equal? "2" (car V2370))) (cons 2 (kl:shen.digits->integers (cdr V2370)))) ((and (pair? V2370) (equal? "3" (car V2370))) (cons 3 (kl:shen.digits->integers (cdr V2370)))) ((and (pair? V2370) (equal? "4" (car V2370))) (cons 4 (kl:shen.digits->integers (cdr V2370)))) ((and (pair? V2370) (equal? "5" (car V2370))) (cons 5 (kl:shen.digits->integers (cdr V2370)))) ((and (pair? V2370) (equal? "6" (car V2370))) (cons 6 (kl:shen.digits->integers (cdr V2370)))) ((and (pair? V2370) (equal? "7" (car V2370))) (cons 7 (kl:shen.digits->integers (cdr V2370)))) ((and (pair? V2370) (equal? "8" (car V2370))) (cons 8 (kl:shen.digits->integers (cdr V2370)))) ((and (pair? V2370) (equal? "9" (car V2370))) (cons 9 (kl:shen.digits->integers (cdr V2370)))) (#t (quote ())))) (export shen.digits->integers) (quote shen.digits->integers)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2372) (let ((Parse_shen. (kl:shen. V2372))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:_waspvm_at_s (kl:shen.hdtl Parse_shen.) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail)))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2374) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2374))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:_waspvm_at_s (kl:shen.hdtl Parse_shen.) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_ (kl: V2374))) (if (kl:not (kl:= (kl:fail) Parse_)) (kl:shen.pair (car Parse_) "") (kl:fail))) YaccParse))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2376) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2376))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.hdtl Parse_shen.)) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_shen. (kl:shen. V2376))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.hdtl Parse_shen.)) (kl:fail))) YaccParse))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2378) (if (pair? (car V2378)) (let ((Parse_Char (kl:shen.hdhd V2378))) (if (assert-boolean (kl:shen.numbyte? Parse_Char)) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V2378) (kl:shen.hdtl V2378))) (make-string 1 Parse_Char)) (kl:fail))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.numbyte?) 1) (define (kl:shen.numbyte? V2384) (cond ((kl:= 48 V2384) #t) ((kl:= 49 V2384) #t) ((kl:= 50 V2384) #t) ((kl:= 51 V2384) #t) ((kl:= 52 V2384) #t) ((kl:= 53 V2384) #t) ((kl:= 54 V2384) #t) ((kl:= 55 V2384) #t) ((kl:= 56 V2384) #t) ((kl:= 57 V2384) #t) (#t #f))) (export shen.numbyte?) (quote shen.numbyte?)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2386) (if (pair? (car V2386)) (let ((Parse_Char (kl:shen.hdhd V2386))) (if (assert-boolean (kl:shen.symbol-code? Parse_Char)) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V2386) (kl:shen.hdtl V2386))) (make-string 1 Parse_Char)) (kl:fail))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.symbol-code?) 1) (define (kl:shen.symbol-code? V2388) (or (kl:= V2388 126) (or (and (> V2388 94) (< V2388 123)) (or (and (> V2388 59) (< V2388 91)) (or (and (> V2388 41) (and (< V2388 58) (kl:not (kl:= V2388 44)))) (or (and (> V2388 34) (< V2388 40)) (kl:= V2388 33))))))) (export shen.symbol-code?) (quote shen.symbol-code?)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2390) (let ((Parse_shen. (kl:shen. V2390))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.hdtl Parse_shen.)) (kl:fail))) (kl:fail))) (kl:fail)))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2392) (if (pair? (car V2392)) (let ((Parse_Char (kl:shen.hdhd V2392))) (if (kl:= Parse_Char 34) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V2392) (kl:shen.hdtl V2392))) Parse_Char) (kl:fail))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2394) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2394))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_ (kl: V2394))) (if (kl:not (kl:= (kl:fail) Parse_)) (kl:shen.pair (car Parse_) (quote ())) (kl:fail))) YaccParse))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2396) (if (pair? (car V2396)) (let ((Parse_Char (kl:shen.hdhd V2396))) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V2396) (kl:shen.hdtl V2396))) (make-string 1 Parse_Char))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2398) (if (pair? (car V2398)) (let ((Parse_Char (kl:shen.hdhd V2398))) (if (kl:not (kl:= Parse_Char 34)) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V2398) (kl:shen.hdtl V2398))) (make-string 1 Parse_Char)) (kl:fail))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2400) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2400))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (- 0 (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2400))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.hdtl Parse_shen.)) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2400))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (* (kl:shen.expt 10 (kl:shen.hdtl Parse_shen.)) (+ (kl:shen.pre (kl:reverse (kl:shen.hdtl Parse_shen.)) 0) (kl:shen.post (kl:shen.hdtl Parse_shen.) 1)))) (kl:fail))) (kl:fail))) (kl:fail))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2400))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (* (kl:shen.expt 10 (kl:shen.hdtl Parse_shen.)) (kl:shen.pre (kl:reverse (kl:shen.hdtl Parse_shen.)) 0))) (kl:fail))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2400))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (+ (kl:shen.pre (kl:reverse (kl:shen.hdtl Parse_shen.)) 0) (kl:shen.post (kl:shen.hdtl Parse_shen.) 1))) (kl:fail))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_shen. (kl:shen. V2400))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.pre (kl:reverse (kl:shen.hdtl Parse_shen.)) 0)) (kl:fail))) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2403) (if (and (pair? (car V2403)) (kl:= 101 (kl:shen.hdhd V2403))) (let ((NewStream2401 (kl:shen.pair (kl:shen.tlhd V2403) (kl:shen.hdtl V2403)))) (kl:shen.pair (car NewStream2401) (quote shen.skip))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2405) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2405))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (- 0 (kl:shen.pre (kl:reverse (kl:shen.hdtl Parse_shen.)) 0))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_shen. (kl:shen. V2405))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.pre (kl:reverse (kl:shen.hdtl Parse_shen.)) 0)) (kl:fail))) YaccParse))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2407) (if (pair? (car V2407)) (let ((Parse_Char (kl:shen.hdhd V2407))) (if (kl:= Parse_Char 43) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V2407) (kl:shen.hdtl V2407))) Parse_Char) (kl:fail))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2409) (if (pair? (car V2409)) (let ((Parse_Char (kl:shen.hdhd V2409))) (if (kl:= Parse_Char 46) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V2409) (kl:shen.hdtl V2409))) Parse_Char) (kl:fail))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2411) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2411))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.hdtl Parse_shen.)) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_ (kl: V2411))) (if (kl:not (kl:= (kl:fail) Parse_)) (kl:shen.pair (car Parse_) (quote ())) (kl:fail))) YaccParse))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2413) (let ((Parse_shen. (kl:shen. V2413))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.hdtl Parse_shen.)) (kl:fail)))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2415) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2415))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_shen. (kl:shen. V2415))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (quote ()))) (kl:fail))) YaccParse))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2417) (if (pair? (car V2417)) (let ((Parse_X (kl:shen.hdhd V2417))) (if (assert-boolean (kl:shen.numbyte? Parse_X)) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V2417) (kl:shen.hdtl V2417))) (kl:shen.byte->digit Parse_X)) (kl:fail))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.byte->digit) 1) (define (kl:shen.byte->digit V2419) (cond ((kl:= 48 V2419) 0) ((kl:= 49 V2419) 1) ((kl:= 50 V2419) 2) ((kl:= 51 V2419) 3) ((kl:= 52 V2419) 4) ((kl:= 53 V2419) 5) ((kl:= 54 V2419) 6) ((kl:= 55 V2419) 7) ((kl:= 56 V2419) 8) ((kl:= 57 V2419) 9) (#t (kl:shen.f_error (quote shen.byte->digit))))) (export shen.byte->digit) (quote shen.byte->digit)) +(begin (register-function-arity (quote shen.pre) 2) (define (kl:shen.pre V2424 V2425) (cond ((null? V2424) 0) ((pair? V2424) (+ (* (kl:shen.expt 10 V2425) (car V2424)) (kl:shen.pre (cdr V2424) (+ V2425 1)))) (#t (kl:shen.f_error (quote shen.pre))))) (export shen.pre) (quote shen.pre)) +(begin (register-function-arity (quote shen.post) 2) (define (kl:shen.post V2430 V2431) (cond ((null? V2430) 0) ((pair? V2430) (+ (* (kl:shen.expt 10 (- 0 V2431)) (car V2430)) (kl:shen.post (cdr V2430) (+ V2431 1)))) (#t (kl:shen.f_error (quote shen.post))))) (export shen.post) (quote shen.post)) +(begin (register-function-arity (quote shen.expt) 2) (define (kl:shen.expt V2436 V2437) (cond ((kl:= 0 V2437) 1) ((> V2437 0) (* V2436 (kl:shen.expt V2436 (- V2437 1)))) (#t (* 1.000000000000000 (/ (kl:shen.expt V2436 (+ V2437 1)) V2436))))) (export shen.expt) (quote shen.expt)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2439) (let ((Parse_shen. (kl:shen. V2439))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.hdtl Parse_shen.)) (kl:fail)))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2441) (let ((Parse_shen. (kl:shen. V2441))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.hdtl Parse_shen.)) (kl:fail)))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2443) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2443))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (quote shen.skip)) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_shen. (kl:shen. V2443))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (quote shen.skip)) (kl:fail))) YaccParse))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2445) (let ((Parse_shen. (kl:shen. V2445))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (quote shen.skip)) (kl:fail))) (kl:fail))) (kl:fail))) (kl:fail)))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2448) (if (and (pair? (car V2448)) (kl:= 92 (kl:shen.hdhd V2448))) (let ((NewStream2446 (kl:shen.pair (kl:shen.tlhd V2448) (kl:shen.hdtl V2448)))) (kl:shen.pair (car NewStream2446) (quote shen.skip))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2450) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2450))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (quote shen.skip)) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_ (kl: V2450))) (if (kl:not (kl:= (kl:fail) Parse_)) (kl:shen.pair (car Parse_) (quote shen.skip)) (kl:fail))) YaccParse))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2452) (if (pair? (car V2452)) (let ((Parse_X (kl:shen.hdhd V2452))) (if (kl:not (kl:element? Parse_X (cons 10 (cons 13 (quote ()))))) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V2452) (kl:shen.hdtl V2452))) (quote shen.skip)) (kl:fail))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2454) (if (pair? (car V2454)) (let ((Parse_X (kl:shen.hdhd V2454))) (if (kl:element? Parse_X (cons 10 (cons 13 (quote ())))) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V2454) (kl:shen.hdtl V2454))) (quote shen.skip)) (kl:fail))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2456) (let ((Parse_shen. (kl:shen. V2456))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (quote shen.skip)) (kl:fail))) (kl:fail))) (kl:fail)))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2459) (if (and (pair? (car V2459)) (kl:= 42 (kl:shen.hdhd V2459))) (let ((NewStream2457 (kl:shen.pair (kl:shen.tlhd V2459) (kl:shen.hdtl V2459)))) (kl:shen.pair (car NewStream2457) (quote shen.skip))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2461) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2461))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (quote shen.skip)) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2461))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (quote shen.skip)) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (if (pair? (car V2461)) (let ((Parse_X (kl:shen.hdhd V2461))) (let ((Parse_shen. (kl:shen. (kl:shen.pair (kl:shen.tlhd V2461) (kl:shen.hdtl V2461))))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (quote shen.skip)) (kl:fail)))) (kl:fail)) YaccParse)) YaccParse))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2463) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2463))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (quote shen.skip)) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_shen. (kl:shen. V2463))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (quote shen.skip)) (kl:fail))) YaccParse))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2465) (if (pair? (car V2465)) (let ((Parse_X (kl:shen.hdhd V2465))) (if (assert-boolean (let ((Parse_Case Parse_X)) (or (kl:= Parse_Case 32) (or (kl:= Parse_Case 13) (or (kl:= Parse_Case 10) (kl:= Parse_Case 9)))))) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V2465) (kl:shen.hdtl V2465))) (quote shen.skip)) (kl:fail))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.cons_form) 1) (define (kl:shen.cons_form V2467) (cond ((null? V2467) (quote ())) ((and (pair? V2467) (and (pair? (cdr V2467)) (and (pair? (cdr (cdr V2467))) (and (null? (cdr (cdr (cdr V2467)))) (eq? (car (cdr V2467)) (quote bar!)))))) (cons (quote cons) (cons (car V2467) (cdr (cdr V2467))))) ((pair? V2467) (cons (quote cons) (cons (car V2467) (cons (kl:shen.cons_form (cdr V2467)) (quote ()))))) (#t (kl:shen.f_error (quote shen.cons_form))))) (export shen.cons_form) (quote shen.cons_form)) +(begin (register-function-arity (quote shen.package-macro) 2) (define (kl:shen.package-macro V2472 V2473) (cond ((and (pair? V2472) (and (eq? (quote _waspvm_dl_) (car V2472)) (and (pair? (cdr V2472)) (null? (cdr (cdr V2472)))))) (kl:append (kl:explode (car (cdr V2472))) V2473)) ((and (pair? V2472) (and (eq? (quote package) (car V2472)) (and (pair? (cdr V2472)) (and (eq? (quote null) (car (cdr V2472))) (pair? (cdr (cdr V2472))))))) (kl:append (cdr (cdr (cdr V2472))) V2473)) ((and (pair? V2472) (and (eq? (quote package) (car V2472)) (and (pair? (cdr V2472)) (pair? (cdr (cdr V2472)))))) (let ((ListofExceptions (kl:shen.eval-without-macros (car (cdr (cdr V2472)))))) (let ((External (kl:shen.record-exceptions ListofExceptions (car (cdr V2472))))) (let ((PackageNameDot (kl:intern (string-append (kl:str (car (cdr V2472))) ".")))) (let ((ExpPackageNameDot (kl:explode PackageNameDot))) (let ((Packaged (kl:shen.packageh PackageNameDot ListofExceptions (cdr (cdr (cdr V2472))) ExpPackageNameDot))) (let ((Internal (kl:shen.record-internal (car (cdr V2472)) (kl:shen.internal-symbols ExpPackageNameDot Packaged)))) (kl:append Packaged V2473)))))))) (#t (cons V2472 V2473)))) (export shen.package-macro) (quote shen.package-macro)) +(begin (register-function-arity (quote shen.record-exceptions) 2) (define (kl:shen.record-exceptions V2476 V2477) (let ((CurrExceptions (guard (lambda (E) (quote ())) (kl:get V2477 (quote shen.external-symbols) (kl:value (quote *property-vector*)))))) (let ((AllExceptions (kl:union V2476 CurrExceptions))) (kl:put V2477 (quote shen.external-symbols) AllExceptions (kl:value (quote *property-vector*)))))) (export shen.record-exceptions) (quote shen.record-exceptions)) +(begin (register-function-arity (quote shen.record-internal) 2) (define (kl:shen.record-internal V2480 V2481) (kl:put V2480 (quote shen.internal-symbols) (kl:union V2481 (guard (lambda (E) (quote ())) (kl:get V2480 (quote shen.internal-symbols) (kl:value (quote *property-vector*))))) (kl:value (quote *property-vector*)))) (export shen.record-internal) (quote shen.record-internal)) +(begin (register-function-arity (quote shen.internal-symbols) 2) (define (kl:shen.internal-symbols V2492 V2493) (cond ((and (kl:symbol? V2493) (assert-boolean (kl:shen.prefix? V2492 (kl:explode V2493)))) (cons V2493 (quote ()))) ((pair? V2493) (kl:union (kl:shen.internal-symbols V2492 (car V2493)) (kl:shen.internal-symbols V2492 (cdr V2493)))) (#t (quote ())))) (export shen.internal-symbols) (quote shen.internal-symbols)) +(begin (register-function-arity (quote shen.packageh) 4) (define (kl:shen.packageh V2510 V2511 V2512 V2513) (cond ((pair? V2512) (cons (kl:shen.packageh V2510 V2511 (car V2512) V2513) (kl:shen.packageh V2510 V2511 (cdr V2512) V2513))) ((or (assert-boolean (kl:shen.sysfunc? V2512)) (or (kl:variable? V2512) (or (kl:element? V2512 V2511) (or (assert-boolean (kl:shen.doubleunderline? V2512)) (assert-boolean (kl:shen.singleunderline? V2512)))))) V2512) ((and (kl:symbol? V2512) (assert-boolean (let ((ExplodeX (kl:explode V2512))) (and (kl:not (kl:shen.prefix? (cons "s" (cons "h" (cons "e" (cons "n" (cons "." (quote ())))))) ExplodeX)) (kl:not (kl:shen.prefix? V2513 ExplodeX)))))) (kl:concat V2510 V2512)) (#t V2512))) (export shen.packageh) (quote shen.packageh)) diff --git a/compiled/sequent.kl.ms b/compiled/sequent.kl.ms index 2c311be..9b78b37 100644 --- a/compiled/sequent.kl.ms +++ b/compiled/sequent.kl.ms @@ -1,57 +1,58 @@ +(module "compiled/sequent.kl") "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.datatype-error) 1) (define (kl:shen.datatype-error V2519) (cond ((and (pair? V2519) (and (pair? (cdr V2519)) (null? (cdr (cdr V2519))))) (simple-error (string-append "datatype syntax error here:\n\n " (kl:shen.app (kl:shen.next-50 50 (car V2519)) "\n" (quote shen.a))))) (#t (kl:shen.f_error (quote shen.datatype-error))))) (quote shen.datatype-error)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2521) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2521))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_ (kl: V2521))) (if (kl:not (kl:= (kl:fail) Parse_)) (kl:shen.pair (car Parse_) (quote ())) (kl:fail))) YaccParse))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2523) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2523))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.sequent (quote shen.single) (cons (kl:shen.hdtl Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (quote ())))))) (kl:fail))) (kl:fail))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_shen. (kl:shen. V2523))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.sequent (quote shen.double) (cons (kl:shen.hdtl Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (quote ())))))) (kl:fail))) (kl:fail))) (kl:fail))) (kl:fail))) YaccParse))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2525) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2525))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_ (kl: V2525))) (if (kl:not (kl:= (kl:fail) Parse_)) (kl:shen.pair (car Parse_) (quote ())) (kl:fail))) YaccParse))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2529) (let ((YaccParse (if (and (pair? (car V2529)) (eq? (quote if) (kl:shen.hdhd V2529))) (let ((NewStream2526 (kl:shen.pair (kl:shen.tlhd V2529) (kl:shen.hdtl V2529)))) (let ((Parse_shen. (kl:shen. NewStream2526))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (quote if) (cons (kl:shen.hdtl Parse_shen.) (quote ())))) (kl:fail)))) (kl:fail)))) (if (kl:= YaccParse (kl:fail)) (if (and (pair? (car V2529)) (eq? (quote let) (kl:shen.hdhd V2529))) (let ((NewStream2527 (kl:shen.pair (kl:shen.tlhd V2529) (kl:shen.hdtl V2529)))) (let ((Parse_shen. (kl:shen. NewStream2527))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (quote let) (cons (kl:shen.hdtl Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (quote ()))))) (kl:fail))) (kl:fail)))) (kl:fail)) YaccParse))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2531) (if (pair? (car V2531)) (let ((Parse_X (kl:shen.hdhd V2531))) (if (kl:variable? Parse_X) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V2531) (kl:shen.hdtl V2531))) Parse_X) (kl:fail))) (kl:fail))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2533) (if (pair? (car V2533)) (let ((Parse_X (kl:shen.hdhd V2533))) (if (kl:not (or (kl:element? Parse_X (cons (quote >>) (cons (quote _waspvm_sc_) (quote ())))) (or (assert-boolean (kl:shen.singleunderline? Parse_X)) (assert-boolean (kl:shen.doubleunderline? Parse_X))))) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V2533) (kl:shen.hdtl V2533))) (kl:shen.remove-bar Parse_X)) (kl:fail))) (kl:fail))) (quote shen.)) -(begin (register-function-arity (quote shen.remove-bar) 1) (define (kl:shen.remove-bar V2535) (cond ((and (pair? V2535) (and (pair? (cdr V2535)) (and (pair? (cdr (cdr V2535))) (and (null? (cdr (cdr (cdr V2535)))) (eq? (car (cdr V2535)) (quote bar!)))))) (cons (car V2535) (car (cdr (cdr V2535))))) ((pair? V2535) (cons (kl:shen.remove-bar (car V2535)) (kl:shen.remove-bar (cdr V2535)))) (#t V2535))) (quote shen.remove-bar)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2537) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2537))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_ (kl: V2537))) (if (kl:not (kl:= (kl:fail) Parse_)) (kl:shen.pair (car Parse_) (quote ())) (kl:fail))) YaccParse))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2539) (if (pair? (car V2539)) (let ((Parse_X (kl:shen.hdhd V2539))) (if (eq? Parse_X (quote _waspvm_sc_)) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V2539) (kl:shen.hdtl V2539))) (quote shen.skip)) (kl:fail))) (kl:fail))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2543) (let ((YaccParse (if (and (pair? (car V2543)) (eq? (quote !) (kl:shen.hdhd V2543))) (let ((NewStream2540 (kl:shen.pair (kl:shen.tlhd V2543) (kl:shen.hdtl V2543)))) (kl:shen.pair (car NewStream2540) (quote !))) (kl:fail)))) (if (kl:= YaccParse (kl:fail)) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2543))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (if (and (pair? (car Parse_shen.)) (eq? (quote >>) (kl:shen.hdhd Parse_shen.))) (let ((NewStream2541 (kl:shen.pair (kl:shen.tlhd Parse_shen.) (kl:shen.hdtl Parse_shen.)))) (let ((Parse_shen. (kl:shen. NewStream2541))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.sequent (kl:shen.hdtl Parse_shen.) (kl:shen.hdtl Parse_shen.))) (kl:fail)))) (kl:fail)) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_shen. (kl:shen. V2543))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.sequent (quote ()) (kl:shen.hdtl Parse_shen.))) (kl:fail))) YaccParse)) YaccParse))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2546) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2546))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (if (and (pair? (car Parse_shen.)) (eq? (quote >>) (kl:shen.hdhd Parse_shen.))) (let ((NewStream2544 (kl:shen.pair (kl:shen.tlhd Parse_shen.) (kl:shen.hdtl Parse_shen.)))) (let ((Parse_shen. (kl:shen. NewStream2544))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.sequent (kl:shen.hdtl Parse_shen.) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail)))) (kl:fail)) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_shen. (kl:shen. V2546))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.sequent (quote ()) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))) YaccParse))) (quote shen.)) -(begin (register-function-arity (quote shen.sequent) 2) (define (kl:shen.sequent V2549 V2550) (kl:_waspvm_at_p V2549 V2550)) (quote shen.sequent)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2552) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2552))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2552))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (quote ()))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_ (kl: V2552))) (if (kl:not (kl:= (kl:fail) Parse_)) (kl:shen.pair (car Parse_) (quote ())) (kl:fail))) YaccParse)) YaccParse))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2554) (if (pair? (car V2554)) (let ((Parse_X (kl:shen.hdhd V2554))) (if (kl:= Parse_X (kl:intern ",")) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V2554) (kl:shen.hdtl V2554))) (quote shen.skip)) (kl:fail))) (kl:fail))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2557) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2557))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (if (and (pair? (car Parse_shen.)) (eq? (quote :) (kl:shen.hdhd Parse_shen.))) (let ((NewStream2555 (kl:shen.pair (kl:shen.tlhd Parse_shen.) (kl:shen.hdtl Parse_shen.)))) (let ((Parse_shen. (kl:shen. NewStream2555))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (kl:shen.curry (kl:shen.hdtl Parse_shen.)) (cons (quote :) (cons (kl:shen.demodulate (kl:shen.hdtl Parse_shen.)) (quote ()))))) (kl:fail)))) (kl:fail)) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_shen. (kl:shen. V2557))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.hdtl Parse_shen.)) (kl:fail))) YaccParse))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2559) (let ((Parse_shen. (kl:shen. V2559))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.curry-type (kl:shen.hdtl Parse_shen.))) (kl:fail)))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2561) (if (pair? (car V2561)) (let ((Parse_X (kl:shen.hdhd V2561))) (if (assert-boolean (kl:shen.doubleunderline? Parse_X)) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V2561) (kl:shen.hdtl V2561))) Parse_X) (kl:fail))) (kl:fail))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2563) (if (pair? (car V2563)) (let ((Parse_X (kl:shen.hdhd V2563))) (if (assert-boolean (kl:shen.singleunderline? Parse_X)) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V2563) (kl:shen.hdtl V2563))) Parse_X) (kl:fail))) (kl:fail))) (quote shen.)) -(begin (register-function-arity (quote shen.singleunderline?) 1) (define (kl:shen.singleunderline? V2565) (and (kl:symbol? V2565) (assert-boolean (kl:shen.sh? (kl:str V2565))))) (quote shen.singleunderline?)) -(begin (register-function-arity (quote shen.sh?) 1) (define (kl:shen.sh? V2567) (cond ((equal? "_" V2567) #t) (#t (and (equal? (make-string 1 (string-ref V2567 0)) "_") (assert-boolean (kl:shen.sh? (string-tail V2567 1))))))) (quote shen.sh?)) -(begin (register-function-arity (quote shen.doubleunderline?) 1) (define (kl:shen.doubleunderline? V2569) (and (kl:symbol? V2569) (assert-boolean (kl:shen.dh? (kl:str V2569))))) (quote shen.doubleunderline?)) -(begin (register-function-arity (quote shen.dh?) 1) (define (kl:shen.dh? V2571) (cond ((equal? "=" V2571) #t) (#t (and (equal? (make-string 1 (string-ref V2571 0)) "=") (assert-boolean (kl:shen.dh? (string-tail V2571 1))))))) (quote shen.dh?)) -(begin (register-function-arity (quote shen.process-datatype) 2) (define (kl:shen.process-datatype V2574 V2575) (kl:shen.remember-datatype (kl:shen.s-prolog (kl:shen.rules->horn-clauses V2574 V2575)))) (quote shen.process-datatype)) -(begin (register-function-arity (quote shen.remember-datatype) 1) (define (kl:shen.remember-datatype V2581) (cond ((pair? V2581) (begin (kl:set (quote shen.*datatypes*) (kl:adjoin (car V2581) (kl:value (quote shen.*datatypes*)))) (begin (kl:set (quote shen.*alldatatypes*) (kl:adjoin (car V2581) (kl:value (quote shen.*alldatatypes*)))) (car V2581)))) (#t (kl:shen.f_error (quote shen.remember-datatype))))) (quote shen.remember-datatype)) -(begin (register-function-arity (quote shen.rules->horn-clauses) 2) (define (kl:shen.rules->horn-clauses V2586 V2587) (cond ((null? V2587) (quote ())) ((and (pair? V2587) (and (kl:tuple? (car V2587)) (eq? (quote shen.single) (kl:fst (car V2587))))) (cons (kl:shen.rule->horn-clause V2586 (kl:snd (car V2587))) (kl:shen.rules->horn-clauses V2586 (cdr V2587)))) ((and (pair? V2587) (and (kl:tuple? (car V2587)) (eq? (quote shen.double) (kl:fst (car V2587))))) (kl:shen.rules->horn-clauses V2586 (kl:append (kl:shen.double->singles (kl:snd (car V2587))) (cdr V2587)))) (#t (kl:shen.f_error (quote shen.rules->horn-clauses))))) (quote shen.rules->horn-clauses)) -(begin (register-function-arity (quote shen.double->singles) 1) (define (kl:shen.double->singles V2589) (cons (kl:shen.right-rule V2589) (cons (kl:shen.left-rule V2589) (quote ())))) (quote shen.double->singles)) -(begin (register-function-arity (quote shen.right-rule) 1) (define (kl:shen.right-rule V2591) (kl:_waspvm_at_p (quote shen.single) V2591)) (quote shen.right-rule)) -(begin (register-function-arity (quote shen.left-rule) 1) (define (kl:shen.left-rule V2593) (cond ((and (pair? V2593) (and (pair? (cdr V2593)) (and (pair? (cdr (cdr V2593))) (and (kl:tuple? (car (cdr (cdr V2593)))) (and (null? (kl:fst (car (cdr (cdr V2593))))) (null? (cdr (cdr (cdr V2593))))))))) (let ((Q (kl:gensym (quote Qv)))) (let ((NewConclusion (kl:_waspvm_at_p (cons (kl:snd (car (cdr (cdr V2593)))) (quote ())) Q))) (let ((NewPremises (cons (kl:_waspvm_at_p (kl:map (lambda (X) (kl:shen.right->left X)) (car (cdr V2593))) Q) (quote ())))) (kl:_waspvm_at_p (quote shen.single) (cons (car V2593) (cons NewPremises (cons NewConclusion (quote ()))))))))) (#t (kl:shen.f_error (quote shen.left-rule))))) (quote shen.left-rule)) -(begin (register-function-arity (quote shen.right->left) 1) (define (kl:shen.right->left V2599) (cond ((and (kl:tuple? V2599) (null? (kl:fst V2599))) (kl:snd V2599)) (#t (simple-error "syntax error with ==========\n")))) (quote shen.right->left)) -(begin (register-function-arity (quote shen.rule->horn-clause) 2) (define (kl:shen.rule->horn-clause V2602 V2603) (cond ((and (pair? V2603) (and (pair? (cdr V2603)) (and (pair? (cdr (cdr V2603))) (and (kl:tuple? (car (cdr (cdr V2603)))) (null? (cdr (cdr (cdr V2603)))))))) (cons (kl:shen.rule->horn-clause-head V2602 (kl:snd (car (cdr (cdr V2603))))) (cons (quote :-) (cons (kl:shen.rule->horn-clause-body (car V2603) (car (cdr V2603)) (kl:fst (car (cdr (cdr V2603))))) (quote ()))))) (#t (kl:shen.f_error (quote shen.rule->horn-clause))))) (quote shen.rule->horn-clause)) -(begin (register-function-arity (quote shen.rule->horn-clause-head) 2) (define (kl:shen.rule->horn-clause-head V2606 V2607) (cons V2606 (cons (kl:shen.mode-ify V2607) (cons (quote Context_1957) (quote ()))))) (quote shen.rule->horn-clause-head)) -(begin (register-function-arity (quote shen.mode-ify) 1) (define (kl:shen.mode-ify V2609) (cond ((and (pair? V2609) (and (pair? (cdr V2609)) (and (eq? (quote :) (car (cdr V2609))) (and (pair? (cdr (cdr V2609))) (null? (cdr (cdr (cdr V2609)))))))) (cons (quote mode) (cons (cons (car V2609) (cons (quote :) (cons (cons (quote mode) (cons (car (cdr (cdr V2609))) (cons (quote +) (quote ())))) (quote ())))) (cons (quote -) (quote ()))))) (#t V2609))) (quote shen.mode-ify)) -(begin (register-function-arity (quote shen.rule->horn-clause-body) 3) (define (kl:shen.rule->horn-clause-body V2613 V2614 V2615) (let ((Variables (kl:map (lambda (X) (kl:shen.extract_vars X)) V2615))) (let ((Predicates (kl:map (lambda (X) (kl:gensym (quote shen.cl))) V2615))) (let ((SearchLiterals (kl:shen.construct-search-literals Predicates Variables (quote Context_1957) (quote Context1_1957)))) (let ((SearchClauses (kl:shen.construct-search-clauses Predicates V2615 Variables))) (let ((SideLiterals (kl:shen.construct-side-literals V2613))) (let ((PremissLiterals (kl:map (lambda (X) (kl:shen.construct-premiss-literal X (kl:empty? V2615))) V2614))) (kl:append SearchLiterals (kl:append SideLiterals PremissLiterals))))))))) (quote shen.rule->horn-clause-body)) -(begin (register-function-arity (quote shen.construct-search-literals) 4) (define (kl:shen.construct-search-literals V2624 V2625 V2626 V2627) (cond ((and (null? V2624) (null? V2625)) (quote ())) (#t (kl:shen.csl-help V2624 V2625 V2626 V2627)))) (quote shen.construct-search-literals)) -(begin (register-function-arity (quote shen.csl-help) 4) (define (kl:shen.csl-help V2634 V2635 V2636 V2637) (cond ((and (null? V2634) (null? V2635)) (cons (cons (quote bind) (cons (quote ContextOut_1957) (cons V2636 (quote ())))) (quote ()))) ((and (pair? V2634) (pair? V2635)) (cons (cons (car V2634) (cons V2636 (cons V2637 (car V2635)))) (kl:shen.csl-help (cdr V2634) (cdr V2635) V2637 (kl:gensym (quote Context))))) (#t (kl:shen.f_error (quote shen.csl-help))))) (quote shen.csl-help)) -(begin (register-function-arity (quote shen.construct-search-clauses) 3) (define (kl:shen.construct-search-clauses V2641 V2642 V2643) (cond ((and (null? V2641) (and (null? V2642) (null? V2643))) (quote shen.skip)) ((and (pair? V2641) (and (pair? V2642) (pair? V2643))) (begin (kl:shen.construct-search-clause (car V2641) (car V2642) (car V2643)) (kl:shen.construct-search-clauses (cdr V2641) (cdr V2642) (cdr V2643)))) (#t (kl:shen.f_error (quote shen.construct-search-clauses))))) (quote shen.construct-search-clauses)) -(begin (register-function-arity (quote shen.construct-search-clause) 3) (define (kl:shen.construct-search-clause V2647 V2648 V2649) (kl:shen.s-prolog (cons (kl:shen.construct-base-search-clause V2647 V2648 V2649) (cons (kl:shen.construct-recursive-search-clause V2647 V2648 V2649) (quote ()))))) (quote shen.construct-search-clause)) -(begin (register-function-arity (quote shen.construct-base-search-clause) 3) (define (kl:shen.construct-base-search-clause V2653 V2654 V2655) (cons (cons V2653 (cons (cons (kl:shen.mode-ify V2654) (quote In_1957)) (cons (quote In_1957) V2655))) (cons (quote :-) (cons (quote ()) (quote ()))))) (quote shen.construct-base-search-clause)) -(begin (register-function-arity (quote shen.construct-recursive-search-clause) 3) (define (kl:shen.construct-recursive-search-clause V2659 V2660 V2661) (cons (cons V2659 (cons (cons (quote Assumption_1957) (quote Assumptions_1957)) (cons (cons (quote Assumption_1957) (quote Out_1957)) V2661))) (cons (quote :-) (cons (cons (cons V2659 (cons (quote Assumptions_1957) (cons (quote Out_1957) V2661))) (quote ())) (quote ()))))) (quote shen.construct-recursive-search-clause)) -(begin (register-function-arity (quote shen.construct-side-literals) 1) (define (kl:shen.construct-side-literals V2667) (cond ((null? V2667) (quote ())) ((and (pair? V2667) (and (pair? (car V2667)) (and (eq? (quote if) (car (car V2667))) (and (pair? (cdr (car V2667))) (null? (cdr (cdr (car V2667)))))))) (cons (cons (quote when) (cdr (car V2667))) (kl:shen.construct-side-literals (cdr V2667)))) ((and (pair? V2667) (and (pair? (car V2667)) (and (eq? (quote let) (car (car V2667))) (and (pair? (cdr (car V2667))) (and (pair? (cdr (cdr (car V2667)))) (null? (cdr (cdr (cdr (car V2667)))))))))) (cons (cons (quote is) (cdr (car V2667))) (kl:shen.construct-side-literals (cdr V2667)))) ((pair? V2667) (kl:shen.construct-side-literals (cdr V2667))) (#t (kl:shen.f_error (quote shen.construct-side-literals))))) (quote shen.construct-side-literals)) -(begin (register-function-arity (quote shen.construct-premiss-literal) 2) (define (kl:shen.construct-premiss-literal V2674 V2675) (cond ((kl:tuple? V2674) (cons (quote shen.t*) (cons (kl:shen.recursive_cons_form (kl:snd V2674)) (cons (kl:shen.construct-context V2675 (kl:fst V2674)) (quote ()))))) ((eq? (quote !) V2674) (cons (quote cut) (cons (quote Throwcontrol) (quote ())))) (#t (kl:shen.f_error (quote shen.construct-premiss-literal))))) (quote shen.construct-premiss-literal)) -(begin (register-function-arity (quote shen.construct-context) 2) (define (kl:shen.construct-context V2678 V2679) (cond ((and (kl:= #t V2678) (null? V2679)) (quote Context_1957)) ((and (kl:= #f V2678) (null? V2679)) (quote ContextOut_1957)) ((pair? V2679) (cons (quote cons) (cons (kl:shen.recursive_cons_form (car V2679)) (cons (kl:shen.construct-context V2678 (cdr V2679)) (quote ()))))) (#t (kl:shen.f_error (quote shen.construct-context))))) (quote shen.construct-context)) -(begin (register-function-arity (quote shen.recursive_cons_form) 1) (define (kl:shen.recursive_cons_form V2681) (cond ((pair? V2681) (cons (quote cons) (cons (kl:shen.recursive_cons_form (car V2681)) (cons (kl:shen.recursive_cons_form (cdr V2681)) (quote ()))))) (#t V2681))) (quote shen.recursive_cons_form)) -(begin (register-function-arity (quote preclude) 1) (define (kl:preclude V2683) (kl:shen.preclude-h (kl:map (lambda (X) (kl:shen.intern-type X)) V2683))) (quote preclude)) -(begin (register-function-arity (quote shen.preclude-h) 1) (define (kl:shen.preclude-h V2685) (let ((FilterDatatypes (kl:set (quote shen.*datatypes*) (kl:difference (kl:value (quote shen.*datatypes*)) V2685)))) (kl:value (quote shen.*datatypes*)))) (quote shen.preclude-h)) -(begin (register-function-arity (quote include) 1) (define (kl:include V2687) (kl:shen.include-h (kl:map (lambda (X) (kl:shen.intern-type X)) V2687))) (quote include)) -(begin (register-function-arity (quote shen.include-h) 1) (define (kl:shen.include-h V2689) (let ((ValidTypes (kl:intersection V2689 (kl:value (quote shen.*alldatatypes*))))) (let ((NewDatatypes (kl:set (quote shen.*datatypes*) (kl:union ValidTypes (kl:value (quote shen.*datatypes*)))))) (kl:value (quote shen.*datatypes*))))) (quote shen.include-h)) -(begin (register-function-arity (quote preclude-all-but) 1) (define (kl:preclude-all-but V2691) (kl:shen.preclude-h (kl:difference (kl:value (quote shen.*alldatatypes*)) (kl:map (lambda (X) (kl:shen.intern-type X)) V2691)))) (quote preclude-all-but)) -(begin (register-function-arity (quote include-all-but) 1) (define (kl:include-all-but V2693) (kl:shen.include-h (kl:difference (kl:value (quote shen.*alldatatypes*)) (kl:map (lambda (X) (kl:shen.intern-type X)) V2693)))) (quote include-all-but)) -(begin (register-function-arity (quote shen.synonyms-help) 1) (define (kl:shen.synonyms-help V2699) (cond ((null? V2699) (kl:shen.update-demodulation-function (kl:value (quote shen.*tc*)) (kl:mapcan (lambda (X) (kl:shen.demod-rule X)) (kl:value (quote shen.*synonyms*))))) ((and (pair? V2699) (pair? (cdr V2699))) (let ((Vs (kl:difference (kl:shen.extract_vars (car (cdr V2699))) (kl:shen.extract_vars (car V2699))))) (if (kl:empty? Vs) (begin (kl:shen.pushnew (cons (car V2699) (cons (car (cdr V2699)) (quote ()))) (quote shen.*synonyms*)) (kl:shen.synonyms-help (cdr (cdr V2699)))) (kl:shen.free_variable_warnings (car (cdr V2699)) Vs)))) (#t (simple-error "odd number of synonyms\n")))) (quote shen.synonyms-help)) -(begin (register-function-arity (quote shen.pushnew) 2) (define (kl:shen.pushnew V2702 V2703) (if (kl:element? V2702 (kl:value V2703)) (kl:value V2703) (kl:set V2703 (cons V2702 (kl:value V2703))))) (quote shen.pushnew)) -(begin (register-function-arity (quote shen.demod-rule) 1) (define (kl:shen.demod-rule V2705) (cond ((and (pair? V2705) (and (pair? (cdr V2705)) (null? (cdr (cdr V2705))))) (cons (kl:shen.rcons_form (car V2705)) (cons (quote ->) (cons (kl:shen.rcons_form (car (cdr V2705))) (quote ()))))) (#t (kl:shen.f_error (quote shen.demod-rule))))) (quote shen.demod-rule)) -(begin (register-function-arity (quote shen.lambda-of-defun) 1) (define (kl:shen.lambda-of-defun V2711) (cond ((and (pair? V2711) (and (eq? (quote defun) (car V2711)) (and (pair? (cdr V2711)) (and (pair? (cdr (cdr V2711))) (and (pair? (car (cdr (cdr V2711)))) (and (null? (cdr (car (cdr (cdr V2711))))) (and (pair? (cdr (cdr (cdr V2711)))) (null? (cdr (cdr (cdr (cdr V2711)))))))))))) (kl:eval (cons (quote /.) (cons (car (car (cdr (cdr V2711)))) (cdr (cdr (cdr V2711))))))) (#t (kl:shen.f_error (quote shen.lambda-of-defun))))) (quote shen.lambda-of-defun)) -(begin (register-function-arity (quote shen.update-demodulation-function) 2) (define (kl:shen.update-demodulation-function V2714 V2715) (begin (kl:tc (quote -)) (begin (kl:set (quote shen.*demodulation-function*) (kl:shen.lambda-of-defun (kl:shen.elim-def (cons (quote define) (cons (quote shen.demod) (kl:append V2715 (kl:shen.default-rule))))))) (begin (if (assert-boolean V2714) (kl:tc (quote +)) (quote shen.skip)) (quote synonyms))))) (quote shen.update-demodulation-function)) -(begin (register-function-arity (quote shen.default-rule) 0) (define (kl:shen.default-rule) (cons (quote X) (cons (quote ->) (cons (quote X) (quote ()))))) (quote shen.default-rule)) +(begin (register-function-arity (quote shen.datatype-error) 1) (define (kl:shen.datatype-error V2519) (cond ((and (pair? V2519) (and (pair? (cdr V2519)) (null? (cdr (cdr V2519))))) (simple-error (string-append "datatype syntax error here:\n\n " (kl:shen.app (kl:shen.next-50 50 (car V2519)) "\n" (quote shen.a))))) (#t (kl:shen.f_error (quote shen.datatype-error))))) (export shen.datatype-error) (quote shen.datatype-error)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2521) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2521))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_ (kl: V2521))) (if (kl:not (kl:= (kl:fail) Parse_)) (kl:shen.pair (car Parse_) (quote ())) (kl:fail))) YaccParse))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2523) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2523))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.sequent (quote shen.single) (cons (kl:shen.hdtl Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (quote ())))))) (kl:fail))) (kl:fail))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_shen. (kl:shen. V2523))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.sequent (quote shen.double) (cons (kl:shen.hdtl Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (quote ())))))) (kl:fail))) (kl:fail))) (kl:fail))) (kl:fail))) YaccParse))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2525) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2525))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_ (kl: V2525))) (if (kl:not (kl:= (kl:fail) Parse_)) (kl:shen.pair (car Parse_) (quote ())) (kl:fail))) YaccParse))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2529) (let ((YaccParse (if (and (pair? (car V2529)) (eq? (quote if) (kl:shen.hdhd V2529))) (let ((NewStream2526 (kl:shen.pair (kl:shen.tlhd V2529) (kl:shen.hdtl V2529)))) (let ((Parse_shen. (kl:shen. NewStream2526))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (quote if) (cons (kl:shen.hdtl Parse_shen.) (quote ())))) (kl:fail)))) (kl:fail)))) (if (kl:= YaccParse (kl:fail)) (if (and (pair? (car V2529)) (eq? (quote let) (kl:shen.hdhd V2529))) (let ((NewStream2527 (kl:shen.pair (kl:shen.tlhd V2529) (kl:shen.hdtl V2529)))) (let ((Parse_shen. (kl:shen. NewStream2527))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (quote let) (cons (kl:shen.hdtl Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (quote ()))))) (kl:fail))) (kl:fail)))) (kl:fail)) YaccParse))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2531) (if (pair? (car V2531)) (let ((Parse_X (kl:shen.hdhd V2531))) (if (kl:variable? Parse_X) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V2531) (kl:shen.hdtl V2531))) Parse_X) (kl:fail))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2533) (if (pair? (car V2533)) (let ((Parse_X (kl:shen.hdhd V2533))) (if (kl:not (or (kl:element? Parse_X (cons (quote >>) (cons (quote _waspvm_sc_) (quote ())))) (or (assert-boolean (kl:shen.singleunderline? Parse_X)) (assert-boolean (kl:shen.doubleunderline? Parse_X))))) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V2533) (kl:shen.hdtl V2533))) (kl:shen.remove-bar Parse_X)) (kl:fail))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.remove-bar) 1) (define (kl:shen.remove-bar V2535) (cond ((and (pair? V2535) (and (pair? (cdr V2535)) (and (pair? (cdr (cdr V2535))) (and (null? (cdr (cdr (cdr V2535)))) (eq? (car (cdr V2535)) (quote bar!)))))) (cons (car V2535) (car (cdr (cdr V2535))))) ((pair? V2535) (cons (kl:shen.remove-bar (car V2535)) (kl:shen.remove-bar (cdr V2535)))) (#t V2535))) (export shen.remove-bar) (quote shen.remove-bar)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2537) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2537))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_ (kl: V2537))) (if (kl:not (kl:= (kl:fail) Parse_)) (kl:shen.pair (car Parse_) (quote ())) (kl:fail))) YaccParse))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2539) (if (pair? (car V2539)) (let ((Parse_X (kl:shen.hdhd V2539))) (if (eq? Parse_X (quote _waspvm_sc_)) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V2539) (kl:shen.hdtl V2539))) (quote shen.skip)) (kl:fail))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2543) (let ((YaccParse (if (and (pair? (car V2543)) (eq? (quote !) (kl:shen.hdhd V2543))) (let ((NewStream2540 (kl:shen.pair (kl:shen.tlhd V2543) (kl:shen.hdtl V2543)))) (kl:shen.pair (car NewStream2540) (quote !))) (kl:fail)))) (if (kl:= YaccParse (kl:fail)) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2543))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (if (and (pair? (car Parse_shen.)) (eq? (quote >>) (kl:shen.hdhd Parse_shen.))) (let ((NewStream2541 (kl:shen.pair (kl:shen.tlhd Parse_shen.) (kl:shen.hdtl Parse_shen.)))) (let ((Parse_shen. (kl:shen. NewStream2541))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.sequent (kl:shen.hdtl Parse_shen.) (kl:shen.hdtl Parse_shen.))) (kl:fail)))) (kl:fail)) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_shen. (kl:shen. V2543))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.sequent (quote ()) (kl:shen.hdtl Parse_shen.))) (kl:fail))) YaccParse)) YaccParse))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2546) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2546))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (if (and (pair? (car Parse_shen.)) (eq? (quote >>) (kl:shen.hdhd Parse_shen.))) (let ((NewStream2544 (kl:shen.pair (kl:shen.tlhd Parse_shen.) (kl:shen.hdtl Parse_shen.)))) (let ((Parse_shen. (kl:shen. NewStream2544))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.sequent (kl:shen.hdtl Parse_shen.) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail)))) (kl:fail)) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_shen. (kl:shen. V2546))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.sequent (quote ()) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))) YaccParse))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.sequent) 2) (define (kl:shen.sequent V2549 V2550) (kl:_waspvm_at_p V2549 V2550)) (export shen.sequent) (quote shen.sequent)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2552) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2552))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2552))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (quote ()))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_ (kl: V2552))) (if (kl:not (kl:= (kl:fail) Parse_)) (kl:shen.pair (car Parse_) (quote ())) (kl:fail))) YaccParse)) YaccParse))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2554) (if (pair? (car V2554)) (let ((Parse_X (kl:shen.hdhd V2554))) (if (kl:= Parse_X (kl:intern ",")) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V2554) (kl:shen.hdtl V2554))) (quote shen.skip)) (kl:fail))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2557) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2557))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (if (and (pair? (car Parse_shen.)) (eq? (quote :) (kl:shen.hdhd Parse_shen.))) (let ((NewStream2555 (kl:shen.pair (kl:shen.tlhd Parse_shen.) (kl:shen.hdtl Parse_shen.)))) (let ((Parse_shen. (kl:shen. NewStream2555))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (kl:shen.curry (kl:shen.hdtl Parse_shen.)) (cons (quote :) (cons (kl:shen.demodulate (kl:shen.hdtl Parse_shen.)) (quote ()))))) (kl:fail)))) (kl:fail)) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_shen. (kl:shen. V2557))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.hdtl Parse_shen.)) (kl:fail))) YaccParse))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2559) (let ((Parse_shen. (kl:shen. V2559))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (kl:shen.curry-type (kl:shen.hdtl Parse_shen.))) (kl:fail)))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2561) (if (pair? (car V2561)) (let ((Parse_X (kl:shen.hdhd V2561))) (if (assert-boolean (kl:shen.doubleunderline? Parse_X)) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V2561) (kl:shen.hdtl V2561))) Parse_X) (kl:fail))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2563) (if (pair? (car V2563)) (let ((Parse_X (kl:shen.hdhd V2563))) (if (assert-boolean (kl:shen.singleunderline? Parse_X)) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V2563) (kl:shen.hdtl V2563))) Parse_X) (kl:fail))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.singleunderline?) 1) (define (kl:shen.singleunderline? V2565) (and (kl:symbol? V2565) (assert-boolean (kl:shen.sh? (kl:str V2565))))) (export shen.singleunderline?) (quote shen.singleunderline?)) +(begin (register-function-arity (quote shen.sh?) 1) (define (kl:shen.sh? V2567) (cond ((equal? "_" V2567) #t) (#t (and (equal? (make-string 1 (string-ref V2567 0)) "_") (assert-boolean (kl:shen.sh? (string-tail V2567 1))))))) (export shen.sh?) (quote shen.sh?)) +(begin (register-function-arity (quote shen.doubleunderline?) 1) (define (kl:shen.doubleunderline? V2569) (and (kl:symbol? V2569) (assert-boolean (kl:shen.dh? (kl:str V2569))))) (export shen.doubleunderline?) (quote shen.doubleunderline?)) +(begin (register-function-arity (quote shen.dh?) 1) (define (kl:shen.dh? V2571) (cond ((equal? "=" V2571) #t) (#t (and (equal? (make-string 1 (string-ref V2571 0)) "=") (assert-boolean (kl:shen.dh? (string-tail V2571 1))))))) (export shen.dh?) (quote shen.dh?)) +(begin (register-function-arity (quote shen.process-datatype) 2) (define (kl:shen.process-datatype V2574 V2575) (kl:shen.remember-datatype (kl:shen.s-prolog (kl:shen.rules->horn-clauses V2574 V2575)))) (export shen.process-datatype) (quote shen.process-datatype)) +(begin (register-function-arity (quote shen.remember-datatype) 1) (define (kl:shen.remember-datatype V2581) (cond ((pair? V2581) (begin (kl:set (quote shen.*datatypes*) (kl:adjoin (car V2581) (kl:value (quote shen.*datatypes*)))) (begin (kl:set (quote shen.*alldatatypes*) (kl:adjoin (car V2581) (kl:value (quote shen.*alldatatypes*)))) (car V2581)))) (#t (kl:shen.f_error (quote shen.remember-datatype))))) (export shen.remember-datatype) (quote shen.remember-datatype)) +(begin (register-function-arity (quote shen.rules->horn-clauses) 2) (define (kl:shen.rules->horn-clauses V2586 V2587) (cond ((null? V2587) (quote ())) ((and (pair? V2587) (and (kl:tuple? (car V2587)) (eq? (quote shen.single) (kl:fst (car V2587))))) (cons (kl:shen.rule->horn-clause V2586 (kl:snd (car V2587))) (kl:shen.rules->horn-clauses V2586 (cdr V2587)))) ((and (pair? V2587) (and (kl:tuple? (car V2587)) (eq? (quote shen.double) (kl:fst (car V2587))))) (kl:shen.rules->horn-clauses V2586 (kl:append (kl:shen.double->singles (kl:snd (car V2587))) (cdr V2587)))) (#t (kl:shen.f_error (quote shen.rules->horn-clauses))))) (export shen.rules->horn-clauses) (quote shen.rules->horn-clauses)) +(begin (register-function-arity (quote shen.double->singles) 1) (define (kl:shen.double->singles V2589) (cons (kl:shen.right-rule V2589) (cons (kl:shen.left-rule V2589) (quote ())))) (export shen.double->singles) (quote shen.double->singles)) +(begin (register-function-arity (quote shen.right-rule) 1) (define (kl:shen.right-rule V2591) (kl:_waspvm_at_p (quote shen.single) V2591)) (export shen.right-rule) (quote shen.right-rule)) +(begin (register-function-arity (quote shen.left-rule) 1) (define (kl:shen.left-rule V2593) (cond ((and (pair? V2593) (and (pair? (cdr V2593)) (and (pair? (cdr (cdr V2593))) (and (kl:tuple? (car (cdr (cdr V2593)))) (and (null? (kl:fst (car (cdr (cdr V2593))))) (null? (cdr (cdr (cdr V2593))))))))) (let ((Q (kl:gensym (quote Qv)))) (let ((NewConclusion (kl:_waspvm_at_p (cons (kl:snd (car (cdr (cdr V2593)))) (quote ())) Q))) (let ((NewPremises (cons (kl:_waspvm_at_p (kl:map (lambda (X) (kl:shen.right->left X)) (car (cdr V2593))) Q) (quote ())))) (kl:_waspvm_at_p (quote shen.single) (cons (car V2593) (cons NewPremises (cons NewConclusion (quote ()))))))))) (#t (kl:shen.f_error (quote shen.left-rule))))) (export shen.left-rule) (quote shen.left-rule)) +(begin (register-function-arity (quote shen.right->left) 1) (define (kl:shen.right->left V2599) (cond ((and (kl:tuple? V2599) (null? (kl:fst V2599))) (kl:snd V2599)) (#t (simple-error "syntax error with ==========\n")))) (export shen.right->left) (quote shen.right->left)) +(begin (register-function-arity (quote shen.rule->horn-clause) 2) (define (kl:shen.rule->horn-clause V2602 V2603) (cond ((and (pair? V2603) (and (pair? (cdr V2603)) (and (pair? (cdr (cdr V2603))) (and (kl:tuple? (car (cdr (cdr V2603)))) (null? (cdr (cdr (cdr V2603)))))))) (cons (kl:shen.rule->horn-clause-head V2602 (kl:snd (car (cdr (cdr V2603))))) (cons (quote :-) (cons (kl:shen.rule->horn-clause-body (car V2603) (car (cdr V2603)) (kl:fst (car (cdr (cdr V2603))))) (quote ()))))) (#t (kl:shen.f_error (quote shen.rule->horn-clause))))) (export shen.rule->horn-clause) (quote shen.rule->horn-clause)) +(begin (register-function-arity (quote shen.rule->horn-clause-head) 2) (define (kl:shen.rule->horn-clause-head V2606 V2607) (cons V2606 (cons (kl:shen.mode-ify V2607) (cons (quote Context_1957) (quote ()))))) (export shen.rule->horn-clause-head) (quote shen.rule->horn-clause-head)) +(begin (register-function-arity (quote shen.mode-ify) 1) (define (kl:shen.mode-ify V2609) (cond ((and (pair? V2609) (and (pair? (cdr V2609)) (and (eq? (quote :) (car (cdr V2609))) (and (pair? (cdr (cdr V2609))) (null? (cdr (cdr (cdr V2609)))))))) (cons (quote mode) (cons (cons (car V2609) (cons (quote :) (cons (cons (quote mode) (cons (car (cdr (cdr V2609))) (cons (quote +) (quote ())))) (quote ())))) (cons (quote -) (quote ()))))) (#t V2609))) (export shen.mode-ify) (quote shen.mode-ify)) +(begin (register-function-arity (quote shen.rule->horn-clause-body) 3) (define (kl:shen.rule->horn-clause-body V2613 V2614 V2615) (let ((Variables (kl:map (lambda (X) (kl:shen.extract_vars X)) V2615))) (let ((Predicates (kl:map (lambda (X) (kl:gensym (quote shen.cl))) V2615))) (let ((SearchLiterals (kl:shen.construct-search-literals Predicates Variables (quote Context_1957) (quote Context1_1957)))) (let ((SearchClauses (kl:shen.construct-search-clauses Predicates V2615 Variables))) (let ((SideLiterals (kl:shen.construct-side-literals V2613))) (let ((PremissLiterals (kl:map (lambda (X) (kl:shen.construct-premiss-literal X (kl:empty? V2615))) V2614))) (kl:append SearchLiterals (kl:append SideLiterals PremissLiterals))))))))) (export shen.rule->horn-clause-body) (quote shen.rule->horn-clause-body)) +(begin (register-function-arity (quote shen.construct-search-literals) 4) (define (kl:shen.construct-search-literals V2624 V2625 V2626 V2627) (cond ((and (null? V2624) (null? V2625)) (quote ())) (#t (kl:shen.csl-help V2624 V2625 V2626 V2627)))) (export shen.construct-search-literals) (quote shen.construct-search-literals)) +(begin (register-function-arity (quote shen.csl-help) 4) (define (kl:shen.csl-help V2634 V2635 V2636 V2637) (cond ((and (null? V2634) (null? V2635)) (cons (cons (quote bind) (cons (quote ContextOut_1957) (cons V2636 (quote ())))) (quote ()))) ((and (pair? V2634) (pair? V2635)) (cons (cons (car V2634) (cons V2636 (cons V2637 (car V2635)))) (kl:shen.csl-help (cdr V2634) (cdr V2635) V2637 (kl:gensym (quote Context))))) (#t (kl:shen.f_error (quote shen.csl-help))))) (export shen.csl-help) (quote shen.csl-help)) +(begin (register-function-arity (quote shen.construct-search-clauses) 3) (define (kl:shen.construct-search-clauses V2641 V2642 V2643) (cond ((and (null? V2641) (and (null? V2642) (null? V2643))) (quote shen.skip)) ((and (pair? V2641) (and (pair? V2642) (pair? V2643))) (begin (kl:shen.construct-search-clause (car V2641) (car V2642) (car V2643)) (kl:shen.construct-search-clauses (cdr V2641) (cdr V2642) (cdr V2643)))) (#t (kl:shen.f_error (quote shen.construct-search-clauses))))) (export shen.construct-search-clauses) (quote shen.construct-search-clauses)) +(begin (register-function-arity (quote shen.construct-search-clause) 3) (define (kl:shen.construct-search-clause V2647 V2648 V2649) (kl:shen.s-prolog (cons (kl:shen.construct-base-search-clause V2647 V2648 V2649) (cons (kl:shen.construct-recursive-search-clause V2647 V2648 V2649) (quote ()))))) (export shen.construct-search-clause) (quote shen.construct-search-clause)) +(begin (register-function-arity (quote shen.construct-base-search-clause) 3) (define (kl:shen.construct-base-search-clause V2653 V2654 V2655) (cons (cons V2653 (cons (cons (kl:shen.mode-ify V2654) (quote In_1957)) (cons (quote In_1957) V2655))) (cons (quote :-) (cons (quote ()) (quote ()))))) (export shen.construct-base-search-clause) (quote shen.construct-base-search-clause)) +(begin (register-function-arity (quote shen.construct-recursive-search-clause) 3) (define (kl:shen.construct-recursive-search-clause V2659 V2660 V2661) (cons (cons V2659 (cons (cons (quote Assumption_1957) (quote Assumptions_1957)) (cons (cons (quote Assumption_1957) (quote Out_1957)) V2661))) (cons (quote :-) (cons (cons (cons V2659 (cons (quote Assumptions_1957) (cons (quote Out_1957) V2661))) (quote ())) (quote ()))))) (export shen.construct-recursive-search-clause) (quote shen.construct-recursive-search-clause)) +(begin (register-function-arity (quote shen.construct-side-literals) 1) (define (kl:shen.construct-side-literals V2667) (cond ((null? V2667) (quote ())) ((and (pair? V2667) (and (pair? (car V2667)) (and (eq? (quote if) (car (car V2667))) (and (pair? (cdr (car V2667))) (null? (cdr (cdr (car V2667)))))))) (cons (cons (quote when) (cdr (car V2667))) (kl:shen.construct-side-literals (cdr V2667)))) ((and (pair? V2667) (and (pair? (car V2667)) (and (eq? (quote let) (car (car V2667))) (and (pair? (cdr (car V2667))) (and (pair? (cdr (cdr (car V2667)))) (null? (cdr (cdr (cdr (car V2667)))))))))) (cons (cons (quote is) (cdr (car V2667))) (kl:shen.construct-side-literals (cdr V2667)))) ((pair? V2667) (kl:shen.construct-side-literals (cdr V2667))) (#t (kl:shen.f_error (quote shen.construct-side-literals))))) (export shen.construct-side-literals) (quote shen.construct-side-literals)) +(begin (register-function-arity (quote shen.construct-premiss-literal) 2) (define (kl:shen.construct-premiss-literal V2674 V2675) (cond ((kl:tuple? V2674) (cons (quote shen.t*) (cons (kl:shen.recursive_cons_form (kl:snd V2674)) (cons (kl:shen.construct-context V2675 (kl:fst V2674)) (quote ()))))) ((eq? (quote !) V2674) (cons (quote cut) (cons (quote Throwcontrol) (quote ())))) (#t (kl:shen.f_error (quote shen.construct-premiss-literal))))) (export shen.construct-premiss-literal) (quote shen.construct-premiss-literal)) +(begin (register-function-arity (quote shen.construct-context) 2) (define (kl:shen.construct-context V2678 V2679) (cond ((and (kl:= #t V2678) (null? V2679)) (quote Context_1957)) ((and (kl:= #f V2678) (null? V2679)) (quote ContextOut_1957)) ((pair? V2679) (cons (quote cons) (cons (kl:shen.recursive_cons_form (car V2679)) (cons (kl:shen.construct-context V2678 (cdr V2679)) (quote ()))))) (#t (kl:shen.f_error (quote shen.construct-context))))) (export shen.construct-context) (quote shen.construct-context)) +(begin (register-function-arity (quote shen.recursive_cons_form) 1) (define (kl:shen.recursive_cons_form V2681) (cond ((pair? V2681) (cons (quote cons) (cons (kl:shen.recursive_cons_form (car V2681)) (cons (kl:shen.recursive_cons_form (cdr V2681)) (quote ()))))) (#t V2681))) (export shen.recursive_cons_form) (quote shen.recursive_cons_form)) +(begin (register-function-arity (quote preclude) 1) (define (kl:preclude V2683) (kl:shen.preclude-h (kl:map (lambda (X) (kl:shen.intern-type X)) V2683))) (export preclude) (quote preclude)) +(begin (register-function-arity (quote shen.preclude-h) 1) (define (kl:shen.preclude-h V2685) (let ((FilterDatatypes (kl:set (quote shen.*datatypes*) (kl:difference (kl:value (quote shen.*datatypes*)) V2685)))) (kl:value (quote shen.*datatypes*)))) (export shen.preclude-h) (quote shen.preclude-h)) +(begin (register-function-arity (quote include) 1) (define (kl:include V2687) (kl:shen.include-h (kl:map (lambda (X) (kl:shen.intern-type X)) V2687))) (export include) (quote include)) +(begin (register-function-arity (quote shen.include-h) 1) (define (kl:shen.include-h V2689) (let ((ValidTypes (kl:intersection V2689 (kl:value (quote shen.*alldatatypes*))))) (let ((NewDatatypes (kl:set (quote shen.*datatypes*) (kl:union ValidTypes (kl:value (quote shen.*datatypes*)))))) (kl:value (quote shen.*datatypes*))))) (export shen.include-h) (quote shen.include-h)) +(begin (register-function-arity (quote preclude-all-but) 1) (define (kl:preclude-all-but V2691) (kl:shen.preclude-h (kl:difference (kl:value (quote shen.*alldatatypes*)) (kl:map (lambda (X) (kl:shen.intern-type X)) V2691)))) (export preclude-all-but) (quote preclude-all-but)) +(begin (register-function-arity (quote include-all-but) 1) (define (kl:include-all-but V2693) (kl:shen.include-h (kl:difference (kl:value (quote shen.*alldatatypes*)) (kl:map (lambda (X) (kl:shen.intern-type X)) V2693)))) (export include-all-but) (quote include-all-but)) +(begin (register-function-arity (quote shen.synonyms-help) 1) (define (kl:shen.synonyms-help V2699) (cond ((null? V2699) (kl:shen.update-demodulation-function (kl:value (quote shen.*tc*)) (kl:mapcan (lambda (X) (kl:shen.demod-rule X)) (kl:value (quote shen.*synonyms*))))) ((and (pair? V2699) (pair? (cdr V2699))) (let ((Vs (kl:difference (kl:shen.extract_vars (car (cdr V2699))) (kl:shen.extract_vars (car V2699))))) (if (kl:empty? Vs) (begin (kl:shen.pushnew (cons (car V2699) (cons (car (cdr V2699)) (quote ()))) (quote shen.*synonyms*)) (kl:shen.synonyms-help (cdr (cdr V2699)))) (kl:shen.free_variable_warnings (car (cdr V2699)) Vs)))) (#t (simple-error "odd number of synonyms\n")))) (export shen.synonyms-help) (quote shen.synonyms-help)) +(begin (register-function-arity (quote shen.pushnew) 2) (define (kl:shen.pushnew V2702 V2703) (if (kl:element? V2702 (kl:value V2703)) (kl:value V2703) (kl:set V2703 (cons V2702 (kl:value V2703))))) (export shen.pushnew) (quote shen.pushnew)) +(begin (register-function-arity (quote shen.demod-rule) 1) (define (kl:shen.demod-rule V2705) (cond ((and (pair? V2705) (and (pair? (cdr V2705)) (null? (cdr (cdr V2705))))) (cons (kl:shen.rcons_form (car V2705)) (cons (quote ->) (cons (kl:shen.rcons_form (car (cdr V2705))) (quote ()))))) (#t (kl:shen.f_error (quote shen.demod-rule))))) (export shen.demod-rule) (quote shen.demod-rule)) +(begin (register-function-arity (quote shen.lambda-of-defun) 1) (define (kl:shen.lambda-of-defun V2711) (cond ((and (pair? V2711) (and (eq? (quote defun) (car V2711)) (and (pair? (cdr V2711)) (and (pair? (cdr (cdr V2711))) (and (pair? (car (cdr (cdr V2711)))) (and (null? (cdr (car (cdr (cdr V2711))))) (and (pair? (cdr (cdr (cdr V2711)))) (null? (cdr (cdr (cdr (cdr V2711)))))))))))) (kl:eval (cons (quote /.) (cons (car (car (cdr (cdr V2711)))) (cdr (cdr (cdr V2711))))))) (#t (kl:shen.f_error (quote shen.lambda-of-defun))))) (export shen.lambda-of-defun) (quote shen.lambda-of-defun)) +(begin (register-function-arity (quote shen.update-demodulation-function) 2) (define (kl:shen.update-demodulation-function V2714 V2715) (begin (kl:tc (quote -)) (begin (kl:set (quote shen.*demodulation-function*) (kl:shen.lambda-of-defun (kl:shen.elim-def (cons (quote define) (cons (quote shen.demod) (kl:append V2715 (kl:shen.default-rule))))))) (begin (if (assert-boolean V2714) (kl:tc (quote +)) (quote shen.skip)) (quote synonyms))))) (export shen.update-demodulation-function) (quote shen.update-demodulation-function)) +(begin (register-function-arity (quote shen.default-rule) 0) (define (kl:shen.default-rule) (cons (quote X) (cons (quote ->) (cons (quote X) (quote ()))))) (export shen.default-rule) (quote shen.default-rule)) diff --git a/compiled/sys.kl.ms b/compiled/sys.kl.ms index 9bc693f..a690971 100644 --- a/compiled/sys.kl.ms +++ b/compiled/sys.kl.ms @@ -1,111 +1,112 @@ +(module "compiled/sys.kl") "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 thaw) 1) (define (kl:thaw V2717) (V2717)) (quote thaw)) -(begin (register-function-arity (quote eval) 1) (define (kl:eval V2719) (let ((Macroexpand (kl:shen.walk (lambda (Y) (kl:macroexpand Y)) V2719))) (if (assert-boolean (kl:shen.packaged? Macroexpand)) (kl:map (lambda (Z) (kl:shen.eval-without-macros Z)) (kl:shen.package-contents Macroexpand)) (kl:shen.eval-without-macros Macroexpand)))) (quote eval)) -(begin (register-function-arity (quote shen.eval-without-macros) 1) (define (kl:shen.eval-without-macros V2721) (kl:eval-kl (kl:shen.elim-def (kl:shen.proc-input+ V2721)))) (quote shen.eval-without-macros)) -(begin (register-function-arity (quote shen.proc-input+) 1) (define (kl:shen.proc-input+ V2723) (cond ((and (pair? V2723) (and (eq? (quote input+) (car V2723)) (and (pair? (cdr V2723)) (and (pair? (cdr (cdr V2723))) (null? (cdr (cdr (cdr V2723)))))))) (cons (quote input+) (cons (kl:shen.rcons_form (car (cdr V2723))) (cdr (cdr V2723))))) ((and (pair? V2723) (and (eq? (quote shen.read+) (car V2723)) (and (pair? (cdr V2723)) (and (pair? (cdr (cdr V2723))) (null? (cdr (cdr (cdr V2723)))))))) (cons (quote shen.read+) (cons (kl:shen.rcons_form (car (cdr V2723))) (cdr (cdr V2723))))) ((pair? V2723) (kl:map (lambda (Z) (kl:shen.proc-input+ Z)) V2723)) (#t V2723))) (quote shen.proc-input+)) -(begin (register-function-arity (quote shen.elim-def) 1) (define (kl:shen.elim-def V2725) (cond ((and (pair? V2725) (and (eq? (quote define) (car V2725)) (pair? (cdr V2725)))) (kl:shen.shen->kl (car (cdr V2725)) (cdr (cdr V2725)))) ((and (pair? V2725) (and (eq? (quote defmacro) (car V2725)) (pair? (cdr V2725)))) (let ((Default (cons (quote X) (cons (quote ->) (cons (quote X) (quote ())))))) (let ((Def (kl:shen.elim-def (cons (quote define) (cons (car (cdr V2725)) (kl:append (cdr (cdr V2725)) Default)))))) (let ((MacroAdd (kl:shen.add-macro (car (cdr V2725))))) Def)))) ((and (pair? V2725) (and (eq? (quote defcc) (car V2725)) (pair? (cdr V2725)))) (kl:shen.elim-def (kl:shen.yacc V2725))) ((pair? V2725) (kl:map (lambda (Z) (kl:shen.elim-def Z)) V2725)) (#t V2725))) (quote shen.elim-def)) -(begin (register-function-arity (quote shen.add-macro) 1) (define (kl:shen.add-macro V2727) (let ((MacroReg (kl:value (quote shen.*macroreg*)))) (let ((NewMacroReg (kl:set (quote shen.*macroreg*) (kl:adjoin V2727 (kl:value (quote shen.*macroreg*)))))) (if (kl:= MacroReg NewMacroReg) (quote shen.skip) (kl:set (quote *macros*) (cons (kl:function V2727) (kl:value (quote *macros*)))))))) (quote shen.add-macro)) -(begin (register-function-arity (quote shen.packaged?) 1) (define (kl:shen.packaged? V2735) (cond ((and (pair? V2735) (and (eq? (quote package) (car V2735)) (and (pair? (cdr V2735)) (pair? (cdr (cdr V2735)))))) #t) (#t #f))) (quote shen.packaged?)) -(begin (register-function-arity (quote external) 1) (define (kl:external V2737) (guard (lambda (E) (simple-error (string-append "package " (kl:shen.app V2737 " has not been used.\n" (quote shen.a))))) (kl:get V2737 (quote shen.external-symbols) (kl:value (quote *property-vector*))))) (quote external)) -(begin (register-function-arity (quote internal) 1) (define (kl:internal V2739) (guard (lambda (E) (simple-error (string-append "package " (kl:shen.app V2739 " has not been used.\n" (quote shen.a))))) (kl:get V2739 (quote shen.internal-symbols) (kl:value (quote *property-vector*))))) (quote internal)) -(begin (register-function-arity (quote shen.package-contents) 1) (define (kl:shen.package-contents V2743) (cond ((and (pair? V2743) (and (eq? (quote package) (car V2743)) (and (pair? (cdr V2743)) (and (eq? (quote null) (car (cdr V2743))) (pair? (cdr (cdr V2743))))))) (cdr (cdr (cdr V2743)))) ((and (pair? V2743) (and (eq? (quote package) (car V2743)) (and (pair? (cdr V2743)) (pair? (cdr (cdr V2743)))))) (let ((PackageNameDot (kl:intern (string-append (kl:str (car (cdr V2743))) ".")))) (let ((ExpPackageNameDot (kl:explode PackageNameDot))) (kl:shen.packageh (car (cdr V2743)) (car (cdr (cdr V2743))) (cdr (cdr (cdr V2743))) ExpPackageNameDot)))) (#t (kl:shen.f_error (quote shen.package-contents))))) (quote shen.package-contents)) -(begin (register-function-arity (quote shen.walk) 2) (define (kl:shen.walk V2746 V2747) (cond ((pair? V2747) (V2746 (kl:map (lambda (Z) (kl:shen.walk V2746 Z)) V2747))) (#t (V2746 V2747)))) (quote shen.walk)) -(begin (register-function-arity (quote compile) 3) (define (kl:compile V2751 V2752 V2753) (let ((O (V2751 (cons V2752 (cons (quote ()) (quote ())))))) (if (or (kl:= (kl:fail) O) (kl:not (kl:empty? (car O)))) (V2753 O) (kl:shen.hdtl O)))) (quote compile)) -(begin (register-function-arity (quote fail-if) 2) (define (kl:fail-if V2756 V2757) (if (assert-boolean (V2756 V2757)) (kl:fail) V2757)) (quote fail-if)) -(begin (register-function-arity (quote _waspvm_at_s) 2) (define (kl:_waspvm_at_s V2760 V2761) (string-append V2760 V2761)) (quote _waspvm_at_s)) -(begin (register-function-arity (quote tc?) 0) (define (kl:tc?) (kl:value (quote shen.*tc*))) (quote tc?)) -(begin (register-function-arity (quote ps) 1) (define (kl:ps V2763) (guard (lambda (E) (simple-error (kl:shen.app V2763 " not found.\n" (quote shen.a)))) (kl:get V2763 (quote shen.source) (kl:value (quote *property-vector*))))) (quote ps)) -(begin (register-function-arity (quote stinput) 0) (define (kl:stinput) (kl:value (quote *stinput*))) (quote stinput)) -(begin (register-function-arity (quote vector) 1) (define (kl:vector V2765) (let ((Vector (make-vector (+ V2765 1) (quote (quote shen.fail!))))) (let ((ZeroStamp (let ((_tmp Vector)) (vector-set! _tmp 0 V2765) _tmp))) (let ((Standard (if (kl:= V2765 0) ZeroStamp (kl:shen.fillvector ZeroStamp 1 V2765 (kl:fail))))) Standard)))) (quote vector)) -(begin (register-function-arity (quote shen.fillvector) 4) (define (kl:shen.fillvector V2771 V2772 V2773 V2774) (cond ((kl:= V2773 V2772) (let ((_tmp V2771)) (vector-set! _tmp V2773 V2774) _tmp)) (#t (kl:shen.fillvector (let ((_tmp V2771)) (vector-set! _tmp V2772 V2774) _tmp) (+ 1 V2772) V2773 V2774)))) (quote shen.fillvector)) -(begin (register-function-arity (quote vector?) 1) (define (kl:vector? V2776) (and (vector? V2776) (assert-boolean (let ((X (guard (lambda (E) -1) (vector-ref V2776 0)))) (and (number? X) (>= X 0)))))) (quote vector?)) -(begin (register-function-arity (quote vector->) 3) (define (kl:vector-> V2780 V2781 V2782) (if (kl:= V2781 0) (simple-error "cannot access 0th element of a vector\n") (let ((_tmp V2780)) (vector-set! _tmp V2781 V2782) _tmp))) (quote vector->)) -(begin (register-function-arity (quote <-vector) 2) (define (kl:<-vector V2785 V2786) (if (kl:= V2786 0) (simple-error "cannot access 0th element of a vector\n") (let ((VectorElement (vector-ref V2785 V2786))) (if (kl:= VectorElement (kl:fail)) (simple-error "vector element not found\n") VectorElement)))) (quote <-vector)) -(begin (register-function-arity (quote shen.posint?) 1) (define (kl:shen.posint? V2788) (and (assert-boolean (kl:integer? V2788)) (>= V2788 0))) (quote shen.posint?)) -(begin (register-function-arity (quote limit) 1) (define (kl:limit V2790) (vector-ref V2790 0)) (quote limit)) -(begin (register-function-arity (quote symbol?) 1) (define (kl:symbol? V2792) (cond ((or (kl:boolean? V2792) (or (number? V2792) (string? V2792))) #f) (#t (guard (lambda (E) #f) (let ((String (kl:str V2792))) (kl:shen.analyse-symbol? String)))))) (quote symbol?)) -(begin (register-function-arity (quote shen.analyse-symbol?) 1) (define (kl:shen.analyse-symbol? V2794) (cond ((equal? "" V2794) #f) ((assert-boolean (kl:shen.+string? V2794)) (and (assert-boolean (kl:shen.alpha? (make-string 1 (string-ref V2794 0)))) (assert-boolean (kl:shen.alphanums? (string-tail V2794 1))))) (#t (kl:shen.f_error (quote shen.analyse-symbol?))))) (quote shen.analyse-symbol?)) -(begin (register-function-arity (quote shen.alpha?) 1) (define (kl:shen.alpha? V2796) (kl:element? V2796 (cons "A" (cons "B" (cons "C" (cons "D" (cons "E" (cons "F" (cons "G" (cons "H" (cons "I" (cons "J" (cons "K" (cons "L" (cons "M" (cons "N" (cons "O" (cons "P" (cons "Q" (cons "R" (cons "S" (cons "T" (cons "U" (cons "V" (cons "W" (cons "X" (cons "Y" (cons "Z" (cons "a" (cons "b" (cons "c" (cons "d" (cons "e" (cons "f" (cons "g" (cons "h" (cons "i" (cons "j" (cons "k" (cons "l" (cons "m" (cons "n" (cons "o" (cons "p" (cons "q" (cons "r" (cons "s" (cons "t" (cons "u" (cons "v" (cons "w" (cons "x" (cons "y" (cons "z" (cons "=" (cons "*" (cons "/" (cons "+" (cons "-" (cons "_" (cons "?" (cons "$" (cons "!" (cons "@" (cons "~" (cons ">" (cons "<" (cons "&" (cons "%" (cons "{" (cons "}" (cons ":" (cons ";" (cons "`" (cons "#" (cons "'" (cons "." (quote ())))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) (quote shen.alpha?)) -(begin (register-function-arity (quote shen.alphanums?) 1) (define (kl:shen.alphanums? V2798) (cond ((equal? "" V2798) #t) ((assert-boolean (kl:shen.+string? V2798)) (and (assert-boolean (kl:shen.alphanum? (make-string 1 (string-ref V2798 0)))) (assert-boolean (kl:shen.alphanums? (string-tail V2798 1))))) (#t (kl:shen.f_error (quote shen.alphanums?))))) (quote shen.alphanums?)) -(begin (register-function-arity (quote shen.alphanum?) 1) (define (kl:shen.alphanum? V2800) (or (assert-boolean (kl:shen.alpha? V2800)) (assert-boolean (kl:shen.digit? V2800)))) (quote shen.alphanum?)) -(begin (register-function-arity (quote shen.digit?) 1) (define (kl:shen.digit? V2802) (kl:element? V2802 (cons "1" (cons "2" (cons "3" (cons "4" (cons "5" (cons "6" (cons "7" (cons "8" (cons "9" (cons "0" (quote ()))))))))))))) (quote shen.digit?)) -(begin (register-function-arity (quote variable?) 1) (define (kl:variable? V2804) (cond ((or (kl:boolean? V2804) (or (number? V2804) (string? V2804))) #f) (#t (guard (lambda (E) #f) (let ((String (kl:str V2804))) (kl:shen.analyse-variable? String)))))) (quote variable?)) -(begin (register-function-arity (quote shen.analyse-variable?) 1) (define (kl:shen.analyse-variable? V2806) (cond ((assert-boolean (kl:shen.+string? V2806)) (and (assert-boolean (kl:shen.uppercase? (make-string 1 (string-ref V2806 0)))) (assert-boolean (kl:shen.alphanums? (string-tail V2806 1))))) (#t (kl:shen.f_error (quote shen.analyse-variable?))))) (quote shen.analyse-variable?)) -(begin (register-function-arity (quote shen.uppercase?) 1) (define (kl:shen.uppercase? V2808) (kl:element? V2808 (cons "A" (cons "B" (cons "C" (cons "D" (cons "E" (cons "F" (cons "G" (cons "H" (cons "I" (cons "J" (cons "K" (cons "L" (cons "M" (cons "N" (cons "O" (cons "P" (cons "Q" (cons "R" (cons "S" (cons "T" (cons "U" (cons "V" (cons "W" (cons "X" (cons "Y" (cons "Z" (quote ()))))))))))))))))))))))))))))) (quote shen.uppercase?)) -(begin (register-function-arity (quote gensym) 1) (define (kl:gensym V2810) (kl:concat V2810 (kl:set (quote shen.*gensym*) (+ 1 (kl:value (quote shen.*gensym*)))))) (quote gensym)) -(begin (register-function-arity (quote concat) 2) (define (kl:concat V2813 V2814) (kl:intern (string-append (kl:str V2813) (kl:str V2814)))) (quote concat)) -(begin (register-function-arity (quote _waspvm_at_p) 2) (define (kl:_waspvm_at_p V2817 V2818) (let ((Vector (make-vector 3 (quote (quote shen.fail!))))) (let ((Tag (let ((_tmp Vector)) (vector-set! _tmp 0 (quote shen.tuple)) _tmp))) (let ((Fst (let ((_tmp Vector)) (vector-set! _tmp 1 V2817) _tmp))) (let ((Snd (let ((_tmp Vector)) (vector-set! _tmp 2 V2818) _tmp))) Vector))))) (quote _waspvm_at_p)) -(begin (register-function-arity (quote fst) 1) (define (kl:fst V2820) (vector-ref V2820 1)) (quote fst)) -(begin (register-function-arity (quote snd) 1) (define (kl:snd V2822) (vector-ref V2822 2)) (quote snd)) -(begin (register-function-arity (quote tuple?) 1) (define (kl:tuple? V2824) (and (vector? V2824) (eq? (quote shen.tuple) (guard (lambda (E) (quote shen.not-tuple)) (vector-ref V2824 0))))) (quote tuple?)) -(begin (register-function-arity (quote append) 2) (define (kl:append V2827 V2828) (cond ((null? V2827) V2828) ((pair? V2827) (cons (car V2827) (kl:append (cdr V2827) V2828))) (#t (kl:shen.f_error (quote append))))) (quote append)) -(begin (register-function-arity (quote _waspvm_at_v) 2) (define (kl:_waspvm_at_v V2831 V2832) (let ((Limit (kl:limit V2832))) (let ((NewVector (kl:vector (+ Limit 1)))) (let ((X+NewVector (kl:vector-> NewVector 1 V2831))) (if (kl:= Limit 0) X+NewVector (kl:shen._waspvm_at_v-help V2832 1 Limit X+NewVector)))))) (quote _waspvm_at_v)) -(begin (register-function-arity (quote shen._waspvm_at_v-help) 4) (define (kl:shen._waspvm_at_v-help V2838 V2839 V2840 V2841) (cond ((kl:= V2840 V2839) (kl:shen.copyfromvector V2838 V2841 V2840 (+ V2840 1))) (#t (kl:shen._waspvm_at_v-help V2838 (+ V2839 1) V2840 (kl:shen.copyfromvector V2838 V2841 V2839 (+ V2839 1)))))) (quote shen._waspvm_at_v-help)) -(begin (register-function-arity (quote shen.copyfromvector) 4) (define (kl:shen.copyfromvector V2846 V2847 V2848 V2849) (guard (lambda (E) V2847) (kl:vector-> V2847 V2849 (kl:<-vector V2846 V2848)))) (quote shen.copyfromvector)) -(begin (register-function-arity (quote hdv) 1) (define (kl:hdv V2851) (guard (lambda (E) (simple-error (string-append "hdv needs a non-empty vector as an argument; not " (kl:shen.app V2851 "\n" (quote shen.s))))) (kl:<-vector V2851 1))) (quote hdv)) -(begin (register-function-arity (quote tlv) 1) (define (kl:tlv V2853) (let ((Limit (kl:limit V2853))) (if (kl:= Limit 0) (simple-error "cannot take the tail of the empty vector\n") (if (kl:= Limit 1) (kl:vector 0) (let ((NewVector (kl:vector (- Limit 1)))) (kl:shen.tlv-help V2853 2 Limit (kl:vector (- Limit 1)))))))) (quote tlv)) -(begin (register-function-arity (quote shen.tlv-help) 4) (define (kl:shen.tlv-help V2859 V2860 V2861 V2862) (cond ((kl:= V2861 V2860) (kl:shen.copyfromvector V2859 V2862 V2861 (- V2861 1))) (#t (kl:shen.tlv-help V2859 (+ V2860 1) V2861 (kl:shen.copyfromvector V2859 V2862 V2860 (- V2860 1)))))) (quote shen.tlv-help)) -(begin (register-function-arity (quote assoc) 2) (define (kl:assoc V2874 V2875) (cond ((null? V2875) (quote ())) ((and (pair? V2875) (and (pair? (car V2875)) (kl:= (car (car V2875)) V2874))) (car V2875)) ((pair? V2875) (kl:assoc V2874 (cdr V2875))) (#t (kl:shen.f_error (quote assoc))))) (quote assoc)) -(begin (register-function-arity (quote shen.assoc-set) 3) (define (kl:shen.assoc-set V2882 V2883 V2884) (cond ((null? V2884) (cons (cons V2882 V2883) (quote ()))) ((and (pair? V2884) (and (pair? (car V2884)) (kl:= (car (car V2884)) V2882))) (cons (cons (car (car V2884)) V2883) (cdr V2884))) ((pair? V2884) (cons (car V2884) (kl:shen.assoc-set V2882 V2883 (cdr V2884)))) (#t (kl:shen.f_error (quote shen.assoc-set))))) (quote shen.assoc-set)) -(begin (register-function-arity (quote shen.assoc-rm) 2) (define (kl:shen.assoc-rm V2890 V2891) (cond ((null? V2891) (quote ())) ((and (pair? V2891) (and (pair? (car V2891)) (kl:= (car (car V2891)) V2890))) (cdr V2891)) ((pair? V2891) (cons (car V2891) (kl:shen.assoc-rm V2890 (cdr V2891)))) (#t (kl:shen.f_error (quote shen.assoc-rm))))) (quote shen.assoc-rm)) -(begin (register-function-arity (quote boolean?) 1) (define (kl:boolean? V2897) (cond ((kl:= #t V2897) #t) ((kl:= #f V2897) #t) (#t #f))) (quote boolean?)) -(begin (register-function-arity (quote nl) 1) (define (kl:nl V2899) (cond ((kl:= 0 V2899) 0) (#t (begin (kl:shen.prhush "\n" (kl:stoutput)) (kl:nl (- V2899 1)))))) (quote nl)) -(begin (register-function-arity (quote difference) 2) (define (kl:difference V2904 V2905) (cond ((null? V2904) (quote ())) ((pair? V2904) (if (kl:element? (car V2904) V2905) (kl:difference (cdr V2904) V2905) (cons (car V2904) (kl:difference (cdr V2904) V2905)))) (#t (kl:shen.f_error (quote difference))))) (quote difference)) -(begin (register-function-arity (quote do) 2) (define (kl:do V2908 V2909) V2909) (quote do)) -(begin (register-function-arity (quote element?) 2) (define (kl:element? V2921 V2922) (cond ((null? V2922) #f) ((and (pair? V2922) (kl:= (car V2922) V2921)) #t) ((pair? V2922) (kl:element? V2921 (cdr V2922))) (#t (kl:shen.f_error (quote element?))))) (quote element?)) -(begin (register-function-arity (quote empty?) 1) (define (kl:empty? V2928) (cond ((null? V2928) #t) (#t #f))) (quote empty?)) -(begin (register-function-arity (quote fix) 2) (define (kl:fix V2931 V2932) (kl:shen.fix-help V2931 V2932 (V2931 V2932))) (quote fix)) -(begin (register-function-arity (quote shen.fix-help) 3) (define (kl:shen.fix-help V2943 V2944 V2945) (cond ((kl:= V2945 V2944) V2945) (#t (kl:shen.fix-help V2943 V2945 (V2943 V2945))))) (quote shen.fix-help)) -(begin (register-function-arity (quote put) 4) (define (kl:put V2950 V2951 V2952 V2953) (let ((Curr (guard (lambda (E) (quote ())) (kl:shen.<-dict V2953 V2950)))) (let ((Added (kl:shen.assoc-set V2951 V2952 Curr))) (let ((Update (kl:shen.dict-> V2953 V2950 Added))) V2952)))) (quote put)) -(begin (register-function-arity (quote unput) 3) (define (kl:unput V2957 V2958 V2959) (let ((Curr (guard (lambda (E) (quote ())) (kl:shen.<-dict V2959 V2957)))) (let ((Removed (kl:shen.assoc-rm V2958 Curr))) (let ((Update (kl:shen.dict-> V2959 V2957 Removed))) V2957)))) (quote unput)) -(begin (register-function-arity (quote get) 3) (define (kl:get V2963 V2964 V2965) (let ((Entry (guard (lambda (E) (quote ())) (kl:shen.<-dict V2965 V2963)))) (let ((Result (kl:assoc V2964 Entry))) (if (kl:empty? Result) (simple-error "value not found\n") (cdr Result))))) (quote get)) -(begin (register-function-arity (quote hash) 2) (define (kl:hash V2968 V2969) (kl:shen.mod (kl:sum (kl:map (lambda (X) (string-ref X 0)) (kl:explode V2968))) V2969)) (quote hash)) -(begin (register-function-arity (quote shen.mod) 2) (define (kl:shen.mod V2972 V2973) (kl:shen.modh V2972 (kl:shen.multiples V2972 (cons V2973 (quote ()))))) (quote shen.mod)) -(begin (register-function-arity (quote shen.multiples) 2) (define (kl:shen.multiples V2976 V2977) (cond ((and (pair? V2977) (> (car V2977) V2976)) (cdr V2977)) ((pair? V2977) (kl:shen.multiples V2976 (cons (* 2 (car V2977)) V2977))) (#t (kl:shen.f_error (quote shen.multiples))))) (quote shen.multiples)) -(begin (register-function-arity (quote shen.modh) 2) (define (kl:shen.modh V2982 V2983) (cond ((kl:= 0 V2982) 0) ((null? V2983) V2982) ((and (pair? V2983) (> (car V2983) V2982)) (if (kl:empty? (cdr V2983)) V2982 (kl:shen.modh V2982 (cdr V2983)))) ((pair? V2983) (kl:shen.modh (- V2982 (car V2983)) V2983)) (#t (kl:shen.f_error (quote shen.modh))))) (quote shen.modh)) -(begin (register-function-arity (quote sum) 1) (define (kl:sum V2985) (cond ((null? V2985) 0) ((pair? V2985) (+ (car V2985) (kl:sum (cdr V2985)))) (#t (kl:shen.f_error (quote sum))))) (quote sum)) -(begin (register-function-arity (quote head) 1) (define (kl:head V2993) (cond ((pair? V2993) (car V2993)) (#t (simple-error "head expects a non-empty list")))) (quote head)) -(begin (register-function-arity (quote tail) 1) (define (kl:tail V3001) (cond ((pair? V3001) (cdr V3001)) (#t (simple-error "tail expects a non-empty list")))) (quote tail)) -(begin (register-function-arity (quote hdstr) 1) (define (kl:hdstr V3003) (make-string 1 (string-ref V3003 0))) (quote hdstr)) -(begin (register-function-arity (quote intersection) 2) (define (kl:intersection V3008 V3009) (cond ((null? V3008) (quote ())) ((pair? V3008) (if (kl:element? (car V3008) V3009) (cons (car V3008) (kl:intersection (cdr V3008) V3009)) (kl:intersection (cdr V3008) V3009))) (#t (kl:shen.f_error (quote intersection))))) (quote intersection)) -(begin (register-function-arity (quote reverse) 1) (define (kl:reverse V3011) (kl:shen.reverse_help V3011 (quote ()))) (quote reverse)) -(begin (register-function-arity (quote shen.reverse_help) 2) (define (kl:shen.reverse_help V3014 V3015) (cond ((null? V3014) V3015) ((pair? V3014) (kl:shen.reverse_help (cdr V3014) (cons (car V3014) V3015))) (#t (kl:shen.f_error (quote shen.reverse_help))))) (quote shen.reverse_help)) -(begin (register-function-arity (quote union) 2) (define (kl:union V3018 V3019) (cond ((null? V3018) V3019) ((pair? V3018) (if (kl:element? (car V3018) V3019) (kl:union (cdr V3018) V3019) (cons (car V3018) (kl:union (cdr V3018) V3019)))) (#t (kl:shen.f_error (quote union))))) (quote union)) -(begin (register-function-arity (quote y-or-n?) 1) (define (kl:y-or-n? V3021) (let ((Message (kl:shen.prhush (kl:shen.proc-nl V3021) (kl:stoutput)))) (let ((Y-or-N (kl:shen.prhush " (y/n) " (kl:stoutput)))) (let ((Input (kl:shen.app (kl:read (kl:stinput)) "" (quote shen.s)))) (if (equal? "y" Input) #t (if (equal? "n" Input) #f (begin (kl:shen.prhush "please answer y or n\n" (kl:stoutput)) (kl:y-or-n? V3021)))))))) (quote y-or-n?)) -(begin (register-function-arity (quote not) 1) (define (kl:not V3023) (if (assert-boolean V3023) #f #t)) (quote not)) -(begin (register-function-arity (quote subst) 3) (define (kl:subst V3036 V3037 V3038) (cond ((kl:= V3038 V3037) V3036) ((pair? V3038) (kl:map (lambda (W) (kl:subst V3036 V3037 W)) V3038)) (#t V3038))) (quote subst)) -(begin (register-function-arity (quote explode) 1) (define (kl:explode V3040) (kl:shen.explode-h (kl:shen.app V3040 "" (quote shen.a)))) (quote explode)) -(begin (register-function-arity (quote shen.explode-h) 1) (define (kl:shen.explode-h V3042) (cond ((equal? "" V3042) (quote ())) ((assert-boolean (kl:shen.+string? V3042)) (cons (make-string 1 (string-ref V3042 0)) (kl:shen.explode-h (string-tail V3042 1)))) (#t (kl:shen.f_error (quote shen.explode-h))))) (quote shen.explode-h)) -(begin (register-function-arity (quote cd) 1) (define (kl:cd V3044) (kl:set (quote *home-directory*) (if (equal? V3044 "") "" (kl:shen.app V3044 "/" (quote shen.a))))) (quote cd)) -(begin (register-function-arity (quote shen.for-each) 2) (define (kl:shen.for-each V3047 V3048) (cond ((null? V3048) #t) ((pair? V3048) (let ((_ (V3047 (car V3048)))) (kl:shen.for-each V3047 (cdr V3048)))) (#t (kl:shen.f_error (quote shen.for-each))))) (quote shen.for-each)) -(begin (register-function-arity (quote map) 2) (define (kl:map V3053 V3054) (cond ((null? V3054) (quote ())) ((pair? V3054) (cons (V3053 (car V3054)) (kl:map V3053 (cdr V3054)))) (#t (V3053 V3054)))) (quote map)) -(begin (register-function-arity (quote length) 1) (define (kl:length V3056) (kl:shen.length-h V3056 0)) (quote length)) -(begin (register-function-arity (quote shen.length-h) 2) (define (kl:shen.length-h V3059 V3060) (cond ((null? V3059) V3060) (#t (kl:shen.length-h (cdr V3059) (+ V3060 1))))) (quote shen.length-h)) -(begin (register-function-arity (quote occurrences) 2) (define (kl:occurrences V3072 V3073) (cond ((kl:= V3073 V3072) 1) ((pair? V3073) (+ (kl:occurrences V3072 (car V3073)) (kl:occurrences V3072 (cdr V3073)))) (#t 0))) (quote occurrences)) -(begin (register-function-arity (quote nth) 2) (define (kl:nth V3080 V3081) (cond ((and (kl:= 1 V3080) (pair? V3081)) (car V3081)) ((pair? V3081) (kl:nth (- V3080 1) (cdr V3081))) (#t (simple-error (string-append "nth applied to " (kl:shen.app V3080 (string-append ", " (kl:shen.app V3081 "\n" (quote shen.a))) (quote shen.a))))))) (quote nth)) -(begin (register-function-arity (quote integer?) 1) (define (kl:integer? V3083) (and (number? V3083) (assert-boolean (let ((Abs (kl:shen.abs V3083))) (kl:shen.integer-test? Abs (kl:shen.magless Abs 1)))))) (quote integer?)) -(begin (register-function-arity (quote shen.abs) 1) (define (kl:shen.abs V3085) (if (> V3085 0) V3085 (- 0 V3085))) (quote shen.abs)) -(begin (register-function-arity (quote shen.magless) 2) (define (kl:shen.magless V3088 V3089) (let ((Nx2 (* V3089 2))) (if (> Nx2 V3088) V3089 (kl:shen.magless V3088 Nx2)))) (quote shen.magless)) -(begin (register-function-arity (quote shen.integer-test?) 2) (define (kl:shen.integer-test? V3095 V3096) (cond ((kl:= 0 V3095) #t) ((> 1 V3095) #f) (#t (let ((Abs-N (- V3095 V3096))) (if (> 0 Abs-N) (kl:integer? V3095) (kl:shen.integer-test? Abs-N V3096)))))) (quote shen.integer-test?)) -(begin (register-function-arity (quote mapcan) 2) (define (kl:mapcan V3101 V3102) (cond ((null? V3102) (quote ())) ((pair? V3102) (kl:append (V3101 (car V3102)) (kl:mapcan V3101 (cdr V3102)))) (#t (kl:shen.f_error (quote mapcan))))) (quote mapcan)) -(begin (register-function-arity (quote ==) 2) (define (kl:== V3114 V3115) (cond ((kl:= V3115 V3114) #t) (#t #f))) (quote ==)) -(begin (register-function-arity (quote abort) 0) (define (kl:abort) (simple-error "")) (quote abort)) -(begin (register-function-arity (quote bound?) 1) (define (kl:bound? V3117) (and (kl:symbol? V3117) (assert-boolean (let ((Val (guard (lambda (E) (quote shen.this-symbol-is-unbound)) (kl:value V3117)))) (if (eq? Val (quote shen.this-symbol-is-unbound)) #f #t))))) (quote bound?)) -(begin (register-function-arity (quote shen.string->bytes) 1) (define (kl:shen.string->bytes V3119) (cond ((equal? "" V3119) (quote ())) (#t (cons (string-ref (make-string 1 (string-ref V3119 0)) 0) (kl:shen.string->bytes (string-tail V3119 1)))))) (quote shen.string->bytes)) -(begin (register-function-arity (quote maxinferences) 1) (define (kl:maxinferences V3121) (kl:set (quote shen.*maxinferences*) V3121)) (quote maxinferences)) -(begin (register-function-arity (quote inferences) 0) (define (kl:inferences) (kl:value (quote shen.*infs*))) (quote inferences)) -(begin (register-function-arity (quote protect) 1) (define (kl:protect V3123) V3123) (quote protect)) -(begin (register-function-arity (quote stoutput) 0) (define (kl:stoutput) (kl:value (quote *stoutput*))) (quote stoutput)) -(begin (register-function-arity (quote sterror) 0) (define (kl:sterror) (kl:value (quote *sterror*))) (quote sterror)) -(begin (register-function-arity (quote string->symbol) 1) (define (kl:string->symbol V3125) (let ((Symbol (kl:intern V3125))) (if (kl:symbol? Symbol) Symbol (simple-error (string-append "cannot intern " (kl:shen.app V3125 " to a symbol" (quote shen.s))))))) (quote string->symbol)) -(begin (register-function-arity (quote optimise) 1) (define (kl:optimise V3131) (cond ((eq? (quote +) V3131) (kl:set (quote shen.*optimise*) #t)) ((eq? (quote -) V3131) (kl:set (quote shen.*optimise*) #f)) (#t (simple-error "optimise expects a + or a -.\n")))) (quote optimise)) -(begin (register-function-arity (quote os) 0) (define (kl:os) (kl:value (quote *os*))) (quote os)) -(begin (register-function-arity (quote language) 0) (define (kl:language) (kl:value (quote *language*))) (quote language)) -(begin (register-function-arity (quote version) 0) (define (kl:version) (kl:value (quote *version*))) (quote version)) -(begin (register-function-arity (quote port) 0) (define (kl:port) (kl:value (quote *port*))) (quote port)) -(begin (register-function-arity (quote porters) 0) (define (kl:porters) (kl:value (quote *porters*))) (quote porters)) -(begin (register-function-arity (quote implementation) 0) (define (kl:implementation) (kl:value (quote *implementation*))) (quote implementation)) -(begin (register-function-arity (quote release) 0) (define (kl:release) (kl:value (quote *release*))) (quote release)) -(begin (register-function-arity (quote package?) 1) (define (kl:package? V3133) (guard (lambda (E) #f) (begin (kl:external V3133) #t))) (quote package?)) -(begin (register-function-arity (quote function) 1) (define (kl:function V3135) (kl:shen.lookup-func V3135)) (quote function)) -(begin (register-function-arity (quote shen.lookup-func) 1) (define (kl:shen.lookup-func V3137) (guard (lambda (E) (simple-error (kl:shen.app V3137 " has no lambda expansion\n" (quote shen.a)))) (kl:get V3137 (quote shen.lambda-form) (kl:value (quote *property-vector*))))) (quote shen.lookup-func)) +(begin (register-function-arity (quote thaw) 1) (define (kl:thaw V2717) (V2717)) (export thaw) (quote thaw)) +(begin (register-function-arity (quote eval) 1) (define (kl:eval V2719) (let ((Macroexpand (kl:shen.walk (lambda (Y) (kl:macroexpand Y)) V2719))) (if (assert-boolean (kl:shen.packaged? Macroexpand)) (kl:map (lambda (Z) (kl:shen.eval-without-macros Z)) (kl:shen.package-contents Macroexpand)) (kl:shen.eval-without-macros Macroexpand)))) (export eval) (quote eval)) +(begin (register-function-arity (quote shen.eval-without-macros) 1) (define (kl:shen.eval-without-macros V2721) (kl:eval-kl (kl:shen.elim-def (kl:shen.proc-input+ V2721)))) (export shen.eval-without-macros) (quote shen.eval-without-macros)) +(begin (register-function-arity (quote shen.proc-input+) 1) (define (kl:shen.proc-input+ V2723) (cond ((and (pair? V2723) (and (eq? (quote input+) (car V2723)) (and (pair? (cdr V2723)) (and (pair? (cdr (cdr V2723))) (null? (cdr (cdr (cdr V2723)))))))) (cons (quote input+) (cons (kl:shen.rcons_form (car (cdr V2723))) (cdr (cdr V2723))))) ((and (pair? V2723) (and (eq? (quote shen.read+) (car V2723)) (and (pair? (cdr V2723)) (and (pair? (cdr (cdr V2723))) (null? (cdr (cdr (cdr V2723)))))))) (cons (quote shen.read+) (cons (kl:shen.rcons_form (car (cdr V2723))) (cdr (cdr V2723))))) ((pair? V2723) (kl:map (lambda (Z) (kl:shen.proc-input+ Z)) V2723)) (#t V2723))) (export shen.proc-input+) (quote shen.proc-input+)) +(begin (register-function-arity (quote shen.elim-def) 1) (define (kl:shen.elim-def V2725) (cond ((and (pair? V2725) (and (eq? (quote define) (car V2725)) (pair? (cdr V2725)))) (kl:shen.shen->kl (car (cdr V2725)) (cdr (cdr V2725)))) ((and (pair? V2725) (and (eq? (quote defmacro) (car V2725)) (pair? (cdr V2725)))) (let ((Default (cons (quote X) (cons (quote ->) (cons (quote X) (quote ())))))) (let ((Def (kl:shen.elim-def (cons (quote define) (cons (car (cdr V2725)) (kl:append (cdr (cdr V2725)) Default)))))) (let ((MacroAdd (kl:shen.add-macro (car (cdr V2725))))) Def)))) ((and (pair? V2725) (and (eq? (quote defcc) (car V2725)) (pair? (cdr V2725)))) (kl:shen.elim-def (kl:shen.yacc V2725))) ((pair? V2725) (kl:map (lambda (Z) (kl:shen.elim-def Z)) V2725)) (#t V2725))) (export shen.elim-def) (quote shen.elim-def)) +(begin (register-function-arity (quote shen.add-macro) 1) (define (kl:shen.add-macro V2727) (let ((MacroReg (kl:value (quote shen.*macroreg*)))) (let ((NewMacroReg (kl:set (quote shen.*macroreg*) (kl:adjoin V2727 (kl:value (quote shen.*macroreg*)))))) (if (kl:= MacroReg NewMacroReg) (quote shen.skip) (kl:set (quote *macros*) (cons (kl:function V2727) (kl:value (quote *macros*)))))))) (export shen.add-macro) (quote shen.add-macro)) +(begin (register-function-arity (quote shen.packaged?) 1) (define (kl:shen.packaged? V2735) (cond ((and (pair? V2735) (and (eq? (quote package) (car V2735)) (and (pair? (cdr V2735)) (pair? (cdr (cdr V2735)))))) #t) (#t #f))) (export shen.packaged?) (quote shen.packaged?)) +(begin (register-function-arity (quote external) 1) (define (kl:external V2737) (guard (lambda (E) (simple-error (string-append "package " (kl:shen.app V2737 " has not been used.\n" (quote shen.a))))) (kl:get V2737 (quote shen.external-symbols) (kl:value (quote *property-vector*))))) (export external) (quote external)) +(begin (register-function-arity (quote internal) 1) (define (kl:internal V2739) (guard (lambda (E) (simple-error (string-append "package " (kl:shen.app V2739 " has not been used.\n" (quote shen.a))))) (kl:get V2739 (quote shen.internal-symbols) (kl:value (quote *property-vector*))))) (export internal) (quote internal)) +(begin (register-function-arity (quote shen.package-contents) 1) (define (kl:shen.package-contents V2743) (cond ((and (pair? V2743) (and (eq? (quote package) (car V2743)) (and (pair? (cdr V2743)) (and (eq? (quote null) (car (cdr V2743))) (pair? (cdr (cdr V2743))))))) (cdr (cdr (cdr V2743)))) ((and (pair? V2743) (and (eq? (quote package) (car V2743)) (and (pair? (cdr V2743)) (pair? (cdr (cdr V2743)))))) (let ((PackageNameDot (kl:intern (string-append (kl:str (car (cdr V2743))) ".")))) (let ((ExpPackageNameDot (kl:explode PackageNameDot))) (kl:shen.packageh (car (cdr V2743)) (car (cdr (cdr V2743))) (cdr (cdr (cdr V2743))) ExpPackageNameDot)))) (#t (kl:shen.f_error (quote shen.package-contents))))) (export shen.package-contents) (quote shen.package-contents)) +(begin (register-function-arity (quote shen.walk) 2) (define (kl:shen.walk V2746 V2747) (cond ((pair? V2747) (V2746 (kl:map (lambda (Z) (kl:shen.walk V2746 Z)) V2747))) (#t (V2746 V2747)))) (export shen.walk) (quote shen.walk)) +(begin (register-function-arity (quote compile) 3) (define (kl:compile V2751 V2752 V2753) (let ((O (V2751 (cons V2752 (cons (quote ()) (quote ())))))) (if (or (kl:= (kl:fail) O) (kl:not (kl:empty? (car O)))) (V2753 O) (kl:shen.hdtl O)))) (export compile) (quote compile)) +(begin (register-function-arity (quote fail-if) 2) (define (kl:fail-if V2756 V2757) (if (assert-boolean (V2756 V2757)) (kl:fail) V2757)) (export fail-if) (quote fail-if)) +(begin (register-function-arity (quote _waspvm_at_s) 2) (define (kl:_waspvm_at_s V2760 V2761) (string-append V2760 V2761)) (export _waspvm_at_s) (quote _waspvm_at_s)) +(begin (register-function-arity (quote tc?) 0) (define (kl:tc?) (kl:value (quote shen.*tc*))) (export tc?) (quote tc?)) +(begin (register-function-arity (quote ps) 1) (define (kl:ps V2763) (guard (lambda (E) (simple-error (kl:shen.app V2763 " not found.\n" (quote shen.a)))) (kl:get V2763 (quote shen.source) (kl:value (quote *property-vector*))))) (export ps) (quote ps)) +(begin (register-function-arity (quote stinput) 0) (define (kl:stinput) (kl:value (quote *stinput*))) (export stinput) (quote stinput)) +(begin (register-function-arity (quote vector) 1) (define (kl:vector V2765) (let ((Vector (make-vector (+ V2765 1) (quote (quote shen.fail!))))) (let ((ZeroStamp (let ((_tmp Vector)) (vector-set! _tmp 0 V2765) _tmp))) (let ((Standard (if (kl:= V2765 0) ZeroStamp (kl:shen.fillvector ZeroStamp 1 V2765 (kl:fail))))) Standard)))) (export vector) (quote vector)) +(begin (register-function-arity (quote shen.fillvector) 4) (define (kl:shen.fillvector V2771 V2772 V2773 V2774) (cond ((kl:= V2773 V2772) (let ((_tmp V2771)) (vector-set! _tmp V2773 V2774) _tmp)) (#t (kl:shen.fillvector (let ((_tmp V2771)) (vector-set! _tmp V2772 V2774) _tmp) (+ 1 V2772) V2773 V2774)))) (export shen.fillvector) (quote shen.fillvector)) +(begin (register-function-arity (quote vector?) 1) (define (kl:vector? V2776) (and (vector? V2776) (assert-boolean (let ((X (guard (lambda (E) -1) (vector-ref V2776 0)))) (and (number? X) (>= X 0)))))) (export vector?) (quote vector?)) +(begin (register-function-arity (quote vector->) 3) (define (kl:vector-> V2780 V2781 V2782) (if (kl:= V2781 0) (simple-error "cannot access 0th element of a vector\n") (let ((_tmp V2780)) (vector-set! _tmp V2781 V2782) _tmp))) (export vector->) (quote vector->)) +(begin (register-function-arity (quote <-vector) 2) (define (kl:<-vector V2785 V2786) (if (kl:= V2786 0) (simple-error "cannot access 0th element of a vector\n") (let ((VectorElement (vector-ref V2785 V2786))) (if (kl:= VectorElement (kl:fail)) (simple-error "vector element not found\n") VectorElement)))) (export <-vector) (quote <-vector)) +(begin (register-function-arity (quote shen.posint?) 1) (define (kl:shen.posint? V2788) (and (assert-boolean (kl:integer? V2788)) (>= V2788 0))) (export shen.posint?) (quote shen.posint?)) +(begin (register-function-arity (quote limit) 1) (define (kl:limit V2790) (vector-ref V2790 0)) (export limit) (quote limit)) +(begin (register-function-arity (quote symbol?) 1) (define (kl:symbol? V2792) (cond ((or (kl:boolean? V2792) (or (number? V2792) (string? V2792))) #f) (#t (guard (lambda (E) #f) (let ((String (kl:str V2792))) (kl:shen.analyse-symbol? String)))))) (export symbol?) (quote symbol?)) +(begin (register-function-arity (quote shen.analyse-symbol?) 1) (define (kl:shen.analyse-symbol? V2794) (cond ((equal? "" V2794) #f) ((assert-boolean (kl:shen.+string? V2794)) (and (assert-boolean (kl:shen.alpha? (make-string 1 (string-ref V2794 0)))) (assert-boolean (kl:shen.alphanums? (string-tail V2794 1))))) (#t (kl:shen.f_error (quote shen.analyse-symbol?))))) (export shen.analyse-symbol?) (quote shen.analyse-symbol?)) +(begin (register-function-arity (quote shen.alpha?) 1) (define (kl:shen.alpha? V2796) (kl:element? V2796 (cons "A" (cons "B" (cons "C" (cons "D" (cons "E" (cons "F" (cons "G" (cons "H" (cons "I" (cons "J" (cons "K" (cons "L" (cons "M" (cons "N" (cons "O" (cons "P" (cons "Q" (cons "R" (cons "S" (cons "T" (cons "U" (cons "V" (cons "W" (cons "X" (cons "Y" (cons "Z" (cons "a" (cons "b" (cons "c" (cons "d" (cons "e" (cons "f" (cons "g" (cons "h" (cons "i" (cons "j" (cons "k" (cons "l" (cons "m" (cons "n" (cons "o" (cons "p" (cons "q" (cons "r" (cons "s" (cons "t" (cons "u" (cons "v" (cons "w" (cons "x" (cons "y" (cons "z" (cons "=" (cons "*" (cons "/" (cons "+" (cons "-" (cons "_" (cons "?" (cons "$" (cons "!" (cons "@" (cons "~" (cons ">" (cons "<" (cons "&" (cons "%" (cons "{" (cons "}" (cons ":" (cons ";" (cons "`" (cons "#" (cons "'" (cons "." (quote ())))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) (export shen.alpha?) (quote shen.alpha?)) +(begin (register-function-arity (quote shen.alphanums?) 1) (define (kl:shen.alphanums? V2798) (cond ((equal? "" V2798) #t) ((assert-boolean (kl:shen.+string? V2798)) (and (assert-boolean (kl:shen.alphanum? (make-string 1 (string-ref V2798 0)))) (assert-boolean (kl:shen.alphanums? (string-tail V2798 1))))) (#t (kl:shen.f_error (quote shen.alphanums?))))) (export shen.alphanums?) (quote shen.alphanums?)) +(begin (register-function-arity (quote shen.alphanum?) 1) (define (kl:shen.alphanum? V2800) (or (assert-boolean (kl:shen.alpha? V2800)) (assert-boolean (kl:shen.digit? V2800)))) (export shen.alphanum?) (quote shen.alphanum?)) +(begin (register-function-arity (quote shen.digit?) 1) (define (kl:shen.digit? V2802) (kl:element? V2802 (cons "1" (cons "2" (cons "3" (cons "4" (cons "5" (cons "6" (cons "7" (cons "8" (cons "9" (cons "0" (quote ()))))))))))))) (export shen.digit?) (quote shen.digit?)) +(begin (register-function-arity (quote variable?) 1) (define (kl:variable? V2804) (cond ((or (kl:boolean? V2804) (or (number? V2804) (string? V2804))) #f) (#t (guard (lambda (E) #f) (let ((String (kl:str V2804))) (kl:shen.analyse-variable? String)))))) (export variable?) (quote variable?)) +(begin (register-function-arity (quote shen.analyse-variable?) 1) (define (kl:shen.analyse-variable? V2806) (cond ((assert-boolean (kl:shen.+string? V2806)) (and (assert-boolean (kl:shen.uppercase? (make-string 1 (string-ref V2806 0)))) (assert-boolean (kl:shen.alphanums? (string-tail V2806 1))))) (#t (kl:shen.f_error (quote shen.analyse-variable?))))) (export shen.analyse-variable?) (quote shen.analyse-variable?)) +(begin (register-function-arity (quote shen.uppercase?) 1) (define (kl:shen.uppercase? V2808) (kl:element? V2808 (cons "A" (cons "B" (cons "C" (cons "D" (cons "E" (cons "F" (cons "G" (cons "H" (cons "I" (cons "J" (cons "K" (cons "L" (cons "M" (cons "N" (cons "O" (cons "P" (cons "Q" (cons "R" (cons "S" (cons "T" (cons "U" (cons "V" (cons "W" (cons "X" (cons "Y" (cons "Z" (quote ()))))))))))))))))))))))))))))) (export shen.uppercase?) (quote shen.uppercase?)) +(begin (register-function-arity (quote gensym) 1) (define (kl:gensym V2810) (kl:concat V2810 (kl:set (quote shen.*gensym*) (+ 1 (kl:value (quote shen.*gensym*)))))) (export gensym) (quote gensym)) +(begin (register-function-arity (quote concat) 2) (define (kl:concat V2813 V2814) (kl:intern (string-append (kl:str V2813) (kl:str V2814)))) (export concat) (quote concat)) +(begin (register-function-arity (quote _waspvm_at_p) 2) (define (kl:_waspvm_at_p V2817 V2818) (let ((Vector (make-vector 3 (quote (quote shen.fail!))))) (let ((Tag (let ((_tmp Vector)) (vector-set! _tmp 0 (quote shen.tuple)) _tmp))) (let ((Fst (let ((_tmp Vector)) (vector-set! _tmp 1 V2817) _tmp))) (let ((Snd (let ((_tmp Vector)) (vector-set! _tmp 2 V2818) _tmp))) Vector))))) (export _waspvm_at_p) (quote _waspvm_at_p)) +(begin (register-function-arity (quote fst) 1) (define (kl:fst V2820) (vector-ref V2820 1)) (export fst) (quote fst)) +(begin (register-function-arity (quote snd) 1) (define (kl:snd V2822) (vector-ref V2822 2)) (export snd) (quote snd)) +(begin (register-function-arity (quote tuple?) 1) (define (kl:tuple? V2824) (and (vector? V2824) (eq? (quote shen.tuple) (guard (lambda (E) (quote shen.not-tuple)) (vector-ref V2824 0))))) (export tuple?) (quote tuple?)) +(begin (register-function-arity (quote append) 2) (define (kl:append V2827 V2828) (cond ((null? V2827) V2828) ((pair? V2827) (cons (car V2827) (kl:append (cdr V2827) V2828))) (#t (kl:shen.f_error (quote append))))) (export append) (quote append)) +(begin (register-function-arity (quote _waspvm_at_v) 2) (define (kl:_waspvm_at_v V2831 V2832) (let ((Limit (kl:limit V2832))) (let ((NewVector (kl:vector (+ Limit 1)))) (let ((X+NewVector (kl:vector-> NewVector 1 V2831))) (if (kl:= Limit 0) X+NewVector (kl:shen._waspvm_at_v-help V2832 1 Limit X+NewVector)))))) (export _waspvm_at_v) (quote _waspvm_at_v)) +(begin (register-function-arity (quote shen._waspvm_at_v-help) 4) (define (kl:shen._waspvm_at_v-help V2838 V2839 V2840 V2841) (cond ((kl:= V2840 V2839) (kl:shen.copyfromvector V2838 V2841 V2840 (+ V2840 1))) (#t (kl:shen._waspvm_at_v-help V2838 (+ V2839 1) V2840 (kl:shen.copyfromvector V2838 V2841 V2839 (+ V2839 1)))))) (export shen._waspvm_at_v-help) (quote shen._waspvm_at_v-help)) +(begin (register-function-arity (quote shen.copyfromvector) 4) (define (kl:shen.copyfromvector V2846 V2847 V2848 V2849) (guard (lambda (E) V2847) (kl:vector-> V2847 V2849 (kl:<-vector V2846 V2848)))) (export shen.copyfromvector) (quote shen.copyfromvector)) +(begin (register-function-arity (quote hdv) 1) (define (kl:hdv V2851) (guard (lambda (E) (simple-error (string-append "hdv needs a non-empty vector as an argument; not " (kl:shen.app V2851 "\n" (quote shen.s))))) (kl:<-vector V2851 1))) (export hdv) (quote hdv)) +(begin (register-function-arity (quote tlv) 1) (define (kl:tlv V2853) (let ((Limit (kl:limit V2853))) (if (kl:= Limit 0) (simple-error "cannot take the tail of the empty vector\n") (if (kl:= Limit 1) (kl:vector 0) (let ((NewVector (kl:vector (- Limit 1)))) (kl:shen.tlv-help V2853 2 Limit (kl:vector (- Limit 1)))))))) (export tlv) (quote tlv)) +(begin (register-function-arity (quote shen.tlv-help) 4) (define (kl:shen.tlv-help V2859 V2860 V2861 V2862) (cond ((kl:= V2861 V2860) (kl:shen.copyfromvector V2859 V2862 V2861 (- V2861 1))) (#t (kl:shen.tlv-help V2859 (+ V2860 1) V2861 (kl:shen.copyfromvector V2859 V2862 V2860 (- V2860 1)))))) (export shen.tlv-help) (quote shen.tlv-help)) +(begin (register-function-arity (quote assoc) 2) (define (kl:assoc V2874 V2875) (cond ((null? V2875) (quote ())) ((and (pair? V2875) (and (pair? (car V2875)) (kl:= (car (car V2875)) V2874))) (car V2875)) ((pair? V2875) (kl:assoc V2874 (cdr V2875))) (#t (kl:shen.f_error (quote assoc))))) (export assoc) (quote assoc)) +(begin (register-function-arity (quote shen.assoc-set) 3) (define (kl:shen.assoc-set V2882 V2883 V2884) (cond ((null? V2884) (cons (cons V2882 V2883) (quote ()))) ((and (pair? V2884) (and (pair? (car V2884)) (kl:= (car (car V2884)) V2882))) (cons (cons (car (car V2884)) V2883) (cdr V2884))) ((pair? V2884) (cons (car V2884) (kl:shen.assoc-set V2882 V2883 (cdr V2884)))) (#t (kl:shen.f_error (quote shen.assoc-set))))) (export shen.assoc-set) (quote shen.assoc-set)) +(begin (register-function-arity (quote shen.assoc-rm) 2) (define (kl:shen.assoc-rm V2890 V2891) (cond ((null? V2891) (quote ())) ((and (pair? V2891) (and (pair? (car V2891)) (kl:= (car (car V2891)) V2890))) (cdr V2891)) ((pair? V2891) (cons (car V2891) (kl:shen.assoc-rm V2890 (cdr V2891)))) (#t (kl:shen.f_error (quote shen.assoc-rm))))) (export shen.assoc-rm) (quote shen.assoc-rm)) +(begin (register-function-arity (quote boolean?) 1) (define (kl:boolean? V2897) (cond ((kl:= #t V2897) #t) ((kl:= #f V2897) #t) (#t #f))) (export boolean?) (quote boolean?)) +(begin (register-function-arity (quote nl) 1) (define (kl:nl V2899) (cond ((kl:= 0 V2899) 0) (#t (begin (kl:shen.prhush "\n" (kl:stoutput)) (kl:nl (- V2899 1)))))) (export nl) (quote nl)) +(begin (register-function-arity (quote difference) 2) (define (kl:difference V2904 V2905) (cond ((null? V2904) (quote ())) ((pair? V2904) (if (kl:element? (car V2904) V2905) (kl:difference (cdr V2904) V2905) (cons (car V2904) (kl:difference (cdr V2904) V2905)))) (#t (kl:shen.f_error (quote difference))))) (export difference) (quote difference)) +(begin (register-function-arity (quote do) 2) (define (kl:do V2908 V2909) V2909) (export do) (quote do)) +(begin (register-function-arity (quote element?) 2) (define (kl:element? V2921 V2922) (cond ((null? V2922) #f) ((and (pair? V2922) (kl:= (car V2922) V2921)) #t) ((pair? V2922) (kl:element? V2921 (cdr V2922))) (#t (kl:shen.f_error (quote element?))))) (export element?) (quote element?)) +(begin (register-function-arity (quote empty?) 1) (define (kl:empty? V2928) (cond ((null? V2928) #t) (#t #f))) (export empty?) (quote empty?)) +(begin (register-function-arity (quote fix) 2) (define (kl:fix V2931 V2932) (kl:shen.fix-help V2931 V2932 (V2931 V2932))) (export fix) (quote fix)) +(begin (register-function-arity (quote shen.fix-help) 3) (define (kl:shen.fix-help V2943 V2944 V2945) (cond ((kl:= V2945 V2944) V2945) (#t (kl:shen.fix-help V2943 V2945 (V2943 V2945))))) (export shen.fix-help) (quote shen.fix-help)) +(begin (register-function-arity (quote put) 4) (define (kl:put V2950 V2951 V2952 V2953) (let ((Curr (guard (lambda (E) (quote ())) (kl:shen.<-dict V2953 V2950)))) (let ((Added (kl:shen.assoc-set V2951 V2952 Curr))) (let ((Update (kl:shen.dict-> V2953 V2950 Added))) V2952)))) (export put) (quote put)) +(begin (register-function-arity (quote unput) 3) (define (kl:unput V2957 V2958 V2959) (let ((Curr (guard (lambda (E) (quote ())) (kl:shen.<-dict V2959 V2957)))) (let ((Removed (kl:shen.assoc-rm V2958 Curr))) (let ((Update (kl:shen.dict-> V2959 V2957 Removed))) V2957)))) (export unput) (quote unput)) +(begin (register-function-arity (quote get) 3) (define (kl:get V2963 V2964 V2965) (let ((Entry (guard (lambda (E) (quote ())) (kl:shen.<-dict V2965 V2963)))) (let ((Result (kl:assoc V2964 Entry))) (if (kl:empty? Result) (simple-error "value not found\n") (cdr Result))))) (export get) (quote get)) +(begin (register-function-arity (quote hash) 2) (define (kl:hash V2968 V2969) (kl:shen.mod (kl:sum (kl:map (lambda (X) (string-ref X 0)) (kl:explode V2968))) V2969)) (export hash) (quote hash)) +(begin (register-function-arity (quote shen.mod) 2) (define (kl:shen.mod V2972 V2973) (kl:shen.modh V2972 (kl:shen.multiples V2972 (cons V2973 (quote ()))))) (export shen.mod) (quote shen.mod)) +(begin (register-function-arity (quote shen.multiples) 2) (define (kl:shen.multiples V2976 V2977) (cond ((and (pair? V2977) (> (car V2977) V2976)) (cdr V2977)) ((pair? V2977) (kl:shen.multiples V2976 (cons (* 2 (car V2977)) V2977))) (#t (kl:shen.f_error (quote shen.multiples))))) (export shen.multiples) (quote shen.multiples)) +(begin (register-function-arity (quote shen.modh) 2) (define (kl:shen.modh V2982 V2983) (cond ((kl:= 0 V2982) 0) ((null? V2983) V2982) ((and (pair? V2983) (> (car V2983) V2982)) (if (kl:empty? (cdr V2983)) V2982 (kl:shen.modh V2982 (cdr V2983)))) ((pair? V2983) (kl:shen.modh (- V2982 (car V2983)) V2983)) (#t (kl:shen.f_error (quote shen.modh))))) (export shen.modh) (quote shen.modh)) +(begin (register-function-arity (quote sum) 1) (define (kl:sum V2985) (cond ((null? V2985) 0) ((pair? V2985) (+ (car V2985) (kl:sum (cdr V2985)))) (#t (kl:shen.f_error (quote sum))))) (export sum) (quote sum)) +(begin (register-function-arity (quote head) 1) (define (kl:head V2993) (cond ((pair? V2993) (car V2993)) (#t (simple-error "head expects a non-empty list")))) (export head) (quote head)) +(begin (register-function-arity (quote tail) 1) (define (kl:tail V3001) (cond ((pair? V3001) (cdr V3001)) (#t (simple-error "tail expects a non-empty list")))) (export tail) (quote tail)) +(begin (register-function-arity (quote hdstr) 1) (define (kl:hdstr V3003) (make-string 1 (string-ref V3003 0))) (export hdstr) (quote hdstr)) +(begin (register-function-arity (quote intersection) 2) (define (kl:intersection V3008 V3009) (cond ((null? V3008) (quote ())) ((pair? V3008) (if (kl:element? (car V3008) V3009) (cons (car V3008) (kl:intersection (cdr V3008) V3009)) (kl:intersection (cdr V3008) V3009))) (#t (kl:shen.f_error (quote intersection))))) (export intersection) (quote intersection)) +(begin (register-function-arity (quote reverse) 1) (define (kl:reverse V3011) (kl:shen.reverse_help V3011 (quote ()))) (export reverse) (quote reverse)) +(begin (register-function-arity (quote shen.reverse_help) 2) (define (kl:shen.reverse_help V3014 V3015) (cond ((null? V3014) V3015) ((pair? V3014) (kl:shen.reverse_help (cdr V3014) (cons (car V3014) V3015))) (#t (kl:shen.f_error (quote shen.reverse_help))))) (export shen.reverse_help) (quote shen.reverse_help)) +(begin (register-function-arity (quote union) 2) (define (kl:union V3018 V3019) (cond ((null? V3018) V3019) ((pair? V3018) (if (kl:element? (car V3018) V3019) (kl:union (cdr V3018) V3019) (cons (car V3018) (kl:union (cdr V3018) V3019)))) (#t (kl:shen.f_error (quote union))))) (export union) (quote union)) +(begin (register-function-arity (quote y-or-n?) 1) (define (kl:y-or-n? V3021) (let ((Message (kl:shen.prhush (kl:shen.proc-nl V3021) (kl:stoutput)))) (let ((Y-or-N (kl:shen.prhush " (y/n) " (kl:stoutput)))) (let ((Input (kl:shen.app (kl:read (kl:stinput)) "" (quote shen.s)))) (if (equal? "y" Input) #t (if (equal? "n" Input) #f (begin (kl:shen.prhush "please answer y or n\n" (kl:stoutput)) (kl:y-or-n? V3021)))))))) (export y-or-n?) (quote y-or-n?)) +(begin (register-function-arity (quote not) 1) (define (kl:not V3023) (if (assert-boolean V3023) #f #t)) (export not) (quote not)) +(begin (register-function-arity (quote subst) 3) (define (kl:subst V3036 V3037 V3038) (cond ((kl:= V3038 V3037) V3036) ((pair? V3038) (kl:map (lambda (W) (kl:subst V3036 V3037 W)) V3038)) (#t V3038))) (export subst) (quote subst)) +(begin (register-function-arity (quote explode) 1) (define (kl:explode V3040) (kl:shen.explode-h (kl:shen.app V3040 "" (quote shen.a)))) (export explode) (quote explode)) +(begin (register-function-arity (quote shen.explode-h) 1) (define (kl:shen.explode-h V3042) (cond ((equal? "" V3042) (quote ())) ((assert-boolean (kl:shen.+string? V3042)) (cons (make-string 1 (string-ref V3042 0)) (kl:shen.explode-h (string-tail V3042 1)))) (#t (kl:shen.f_error (quote shen.explode-h))))) (export shen.explode-h) (quote shen.explode-h)) +(begin (register-function-arity (quote cd) 1) (define (kl:cd V3044) (kl:set (quote *home-directory*) (if (equal? V3044 "") "" (kl:shen.app V3044 "/" (quote shen.a))))) (export cd) (quote cd)) +(begin (register-function-arity (quote shen.for-each) 2) (define (kl:shen.for-each V3047 V3048) (cond ((null? V3048) #t) ((pair? V3048) (let ((_ (V3047 (car V3048)))) (kl:shen.for-each V3047 (cdr V3048)))) (#t (kl:shen.f_error (quote shen.for-each))))) (export shen.for-each) (quote shen.for-each)) +(begin (register-function-arity (quote map) 2) (define (kl:map V3053 V3054) (cond ((null? V3054) (quote ())) ((pair? V3054) (cons (V3053 (car V3054)) (kl:map V3053 (cdr V3054)))) (#t (V3053 V3054)))) (export map) (quote map)) +(begin (register-function-arity (quote length) 1) (define (kl:length V3056) (kl:shen.length-h V3056 0)) (export length) (quote length)) +(begin (register-function-arity (quote shen.length-h) 2) (define (kl:shen.length-h V3059 V3060) (cond ((null? V3059) V3060) (#t (kl:shen.length-h (cdr V3059) (+ V3060 1))))) (export shen.length-h) (quote shen.length-h)) +(begin (register-function-arity (quote occurrences) 2) (define (kl:occurrences V3072 V3073) (cond ((kl:= V3073 V3072) 1) ((pair? V3073) (+ (kl:occurrences V3072 (car V3073)) (kl:occurrences V3072 (cdr V3073)))) (#t 0))) (export occurrences) (quote occurrences)) +(begin (register-function-arity (quote nth) 2) (define (kl:nth V3080 V3081) (cond ((and (kl:= 1 V3080) (pair? V3081)) (car V3081)) ((pair? V3081) (kl:nth (- V3080 1) (cdr V3081))) (#t (simple-error (string-append "nth applied to " (kl:shen.app V3080 (string-append ", " (kl:shen.app V3081 "\n" (quote shen.a))) (quote shen.a))))))) (export nth) (quote nth)) +(begin (register-function-arity (quote integer?) 1) (define (kl:integer? V3083) (and (number? V3083) (assert-boolean (let ((Abs (kl:shen.abs V3083))) (kl:shen.integer-test? Abs (kl:shen.magless Abs 1)))))) (export integer?) (quote integer?)) +(begin (register-function-arity (quote shen.abs) 1) (define (kl:shen.abs V3085) (if (> V3085 0) V3085 (- 0 V3085))) (export shen.abs) (quote shen.abs)) +(begin (register-function-arity (quote shen.magless) 2) (define (kl:shen.magless V3088 V3089) (let ((Nx2 (* V3089 2))) (if (> Nx2 V3088) V3089 (kl:shen.magless V3088 Nx2)))) (export shen.magless) (quote shen.magless)) +(begin (register-function-arity (quote shen.integer-test?) 2) (define (kl:shen.integer-test? V3095 V3096) (cond ((kl:= 0 V3095) #t) ((> 1 V3095) #f) (#t (let ((Abs-N (- V3095 V3096))) (if (> 0 Abs-N) (kl:integer? V3095) (kl:shen.integer-test? Abs-N V3096)))))) (export shen.integer-test?) (quote shen.integer-test?)) +(begin (register-function-arity (quote mapcan) 2) (define (kl:mapcan V3101 V3102) (cond ((null? V3102) (quote ())) ((pair? V3102) (kl:append (V3101 (car V3102)) (kl:mapcan V3101 (cdr V3102)))) (#t (kl:shen.f_error (quote mapcan))))) (export mapcan) (quote mapcan)) +(begin (register-function-arity (quote ==) 2) (define (kl:== V3114 V3115) (cond ((kl:= V3115 V3114) #t) (#t #f))) (export ==) (quote ==)) +(begin (register-function-arity (quote abort) 0) (define (kl:abort) (simple-error "")) (export abort) (quote abort)) +(begin (register-function-arity (quote bound?) 1) (define (kl:bound? V3117) (and (kl:symbol? V3117) (assert-boolean (let ((Val (guard (lambda (E) (quote shen.this-symbol-is-unbound)) (kl:value V3117)))) (if (eq? Val (quote shen.this-symbol-is-unbound)) #f #t))))) (export bound?) (quote bound?)) +(begin (register-function-arity (quote shen.string->bytes) 1) (define (kl:shen.string->bytes V3119) (cond ((equal? "" V3119) (quote ())) (#t (cons (string-ref (make-string 1 (string-ref V3119 0)) 0) (kl:shen.string->bytes (string-tail V3119 1)))))) (export shen.string->bytes) (quote shen.string->bytes)) +(begin (register-function-arity (quote maxinferences) 1) (define (kl:maxinferences V3121) (kl:set (quote shen.*maxinferences*) V3121)) (export maxinferences) (quote maxinferences)) +(begin (register-function-arity (quote inferences) 0) (define (kl:inferences) (kl:value (quote shen.*infs*))) (export inferences) (quote inferences)) +(begin (register-function-arity (quote protect) 1) (define (kl:protect V3123) V3123) (export protect) (quote protect)) +(begin (register-function-arity (quote stoutput) 0) (define (kl:stoutput) (kl:value (quote *stoutput*))) (export stoutput) (quote stoutput)) +(begin (register-function-arity (quote sterror) 0) (define (kl:sterror) (kl:value (quote *sterror*))) (export sterror) (quote sterror)) +(begin (register-function-arity (quote string->symbol) 1) (define (kl:string->symbol V3125) (let ((Symbol (kl:intern V3125))) (if (kl:symbol? Symbol) Symbol (simple-error (string-append "cannot intern " (kl:shen.app V3125 " to a symbol" (quote shen.s))))))) (export string->symbol) (quote string->symbol)) +(begin (register-function-arity (quote optimise) 1) (define (kl:optimise V3131) (cond ((eq? (quote +) V3131) (kl:set (quote shen.*optimise*) #t)) ((eq? (quote -) V3131) (kl:set (quote shen.*optimise*) #f)) (#t (simple-error "optimise expects a + or a -.\n")))) (export optimise) (quote optimise)) +(begin (register-function-arity (quote os) 0) (define (kl:os) (kl:value (quote *os*))) (export os) (quote os)) +(begin (register-function-arity (quote language) 0) (define (kl:language) (kl:value (quote *language*))) (export language) (quote language)) +(begin (register-function-arity (quote version) 0) (define (kl:version) (kl:value (quote *version*))) (export version) (quote version)) +(begin (register-function-arity (quote port) 0) (define (kl:port) (kl:value (quote *port*))) (export port) (quote port)) +(begin (register-function-arity (quote porters) 0) (define (kl:porters) (kl:value (quote *porters*))) (export porters) (quote porters)) +(begin (register-function-arity (quote implementation) 0) (define (kl:implementation) (kl:value (quote *implementation*))) (export implementation) (quote implementation)) +(begin (register-function-arity (quote release) 0) (define (kl:release) (kl:value (quote *release*))) (export release) (quote release)) +(begin (register-function-arity (quote package?) 1) (define (kl:package? V3133) (guard (lambda (E) #f) (begin (kl:external V3133) #t))) (export package?) (quote package?)) +(begin (register-function-arity (quote function) 1) (define (kl:function V3135) (kl:shen.lookup-func V3135)) (export function) (quote function)) +(begin (register-function-arity (quote shen.lookup-func) 1) (define (kl:shen.lookup-func V3137) (guard (lambda (E) (simple-error (kl:shen.app V3137 " has no lambda expansion\n" (quote shen.a)))) (kl:get V3137 (quote shen.lambda-form) (kl:value (quote *property-vector*))))) (export shen.lookup-func) (quote shen.lookup-func)) diff --git a/compiled/t-star.kl.ms b/compiled/t-star.kl.ms index 917693b..ae54387 100644 --- a/compiled/t-star.kl.ms +++ b/compiled/t-star.kl.ms @@ -1,46 +1,47 @@ +(module "compiled/t-star.kl") "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.typecheck) 2) (define (kl:shen.typecheck V3528 V3529) (let ((Curry (kl:shen.curry V3528))) (let ((ProcessN (kl:shen.start-new-prolog-process))) (let ((Type (kl:shen.insert-prolog-variables (kl:shen.demodulate (kl:shen.curry-type V3529)) ProcessN))) (let ((Continuation (lambda () (kl:return Type ProcessN (quote shen.void))))) (kl:shen.t* (cons Curry (cons (quote :) (cons Type (quote ())))) (quote ()) ProcessN Continuation)))))) (quote shen.typecheck)) -(begin (register-function-arity (quote shen.curry) 1) (define (kl:shen.curry V3531) (cond ((and (pair? V3531) (assert-boolean (kl:shen.special? (car V3531)))) (cons (car V3531) (kl:map (lambda (Y) (kl:shen.curry Y)) (cdr V3531)))) ((and (pair? V3531) (and (pair? (cdr V3531)) (assert-boolean (kl:shen.extraspecial? (car V3531))))) V3531) ((and (pair? V3531) (and (eq? (quote type) (car V3531)) (and (pair? (cdr V3531)) (and (pair? (cdr (cdr V3531))) (null? (cdr (cdr (cdr V3531)))))))) (cons (quote type) (cons (kl:shen.curry (car (cdr V3531))) (cdr (cdr V3531))))) ((and (pair? V3531) (and (pair? (cdr V3531)) (pair? (cdr (cdr V3531))))) (kl:shen.curry (cons (cons (car V3531) (cons (car (cdr V3531)) (quote ()))) (cdr (cdr V3531))))) ((and (pair? V3531) (and (pair? (cdr V3531)) (null? (cdr (cdr V3531))))) (cons (kl:shen.curry (car V3531)) (cons (kl:shen.curry (car (cdr V3531))) (quote ())))) (#t V3531))) (quote shen.curry)) -(begin (register-function-arity (quote shen.special?) 1) (define (kl:shen.special? V3533) (kl:element? V3533 (kl:value (quote shen.*special*)))) (quote shen.special?)) -(begin (register-function-arity (quote shen.extraspecial?) 1) (define (kl:shen.extraspecial? V3535) (kl:element? V3535 (kl:value (quote shen.*extraspecial*)))) (quote shen.extraspecial?)) -(begin (register-function-arity (quote shen.t*) 4) (define (kl:shen.t* V3540 V3541 V3542 V3543) (let ((Throwcontrol (kl:shen.catchpoint))) (kl:shen.cutpoint Throwcontrol (let ((Case (let ((Error (kl:shen.newpv V3542))) (begin (kl:shen.incinfs) (kl:fwhen (kl:shen.maxinfexceeded?) V3542 (lambda () (kl:bind Error (kl:shen.errormaxinfs) V3542 V3543))))))) (if (kl:= Case #f) (let ((Case (let ((V3520 (kl:shen.lazyderef V3540 V3542))) (if (eq? (quote fail) V3520) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V3542 (lambda () (kl:shen.prolog-failure V3542 V3543)))) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3521 (kl:shen.lazyderef V3540 V3542))) (if (pair? V3521) (let ((X (car V3521))) (let ((V3522 (kl:shen.lazyderef (cdr V3521) V3542))) (if (pair? V3522) (let ((V3523 (kl:shen.lazyderef (car V3522) V3542))) (if (eq? (quote :) V3523) (let ((V3524 (kl:shen.lazyderef (cdr V3522) V3542))) (if (pair? V3524) (let ((A (car V3524))) (let ((V3525 (kl:shen.lazyderef (cdr V3524) V3542))) (if (null? V3525) (begin (kl:shen.incinfs) (kl:fwhen (kl:shen.type-theory-enabled?) V3542 (lambda () (kl:cut Throwcontrol V3542 (lambda () (kl:shen.th* X A V3541 V3542 V3543)))))) #f))) #f)) #f)) #f))) #f)))) (if (kl:= Case #f) (let ((Datatypes (kl:shen.newpv V3542))) (begin (kl:shen.incinfs) (kl:shen.show V3540 V3541 V3542 (lambda () (kl:bind Datatypes (kl:value (quote shen.*datatypes*)) V3542 (lambda () (kl:shen.udefs* V3540 V3541 Datatypes V3542 V3543))))))) Case)) Case)) Case))))) (quote shen.t*)) -(begin (register-function-arity (quote shen.type-theory-enabled?) 0) (define (kl:shen.type-theory-enabled?) (kl:value (quote shen.*shen-type-theory-enabled?*))) (quote shen.type-theory-enabled?)) -(begin (register-function-arity (quote enable-type-theory) 1) (define (kl:enable-type-theory V3549) (cond ((eq? (quote +) V3549) (kl:set (quote shen.*shen-type-theory-enabled?*) #t)) ((eq? (quote -) V3549) (kl:set (quote shen.*shen-type-theory-enabled?*) #f)) (#t (simple-error "enable-type-theory expects a + or a -\n")))) (quote enable-type-theory)) -(begin (register-function-arity (quote shen.prolog-failure) 2) (define (kl:shen.prolog-failure V3560 V3561) #f) (quote shen.prolog-failure)) -(begin (register-function-arity (quote shen.maxinfexceeded?) 0) (define (kl:shen.maxinfexceeded?) (> (kl:inferences) (kl:value (quote shen.*maxinferences*)))) (quote shen.maxinfexceeded?)) -(begin (register-function-arity (quote shen.errormaxinfs) 0) (define (kl:shen.errormaxinfs) (simple-error "maximum inferences exceeded~%")) (quote shen.errormaxinfs)) -(begin (register-function-arity (quote shen.udefs*) 5) (define (kl:shen.udefs* V3567 V3568 V3569 V3570 V3571) (let ((Case (let ((V3516 (kl:shen.lazyderef V3569 V3570))) (if (pair? V3516) (let ((D (car V3516))) (begin (kl:shen.incinfs) (kl:call (cons D (cons V3567 (cons V3568 (quote ())))) V3570 V3571))) #f)))) (if (kl:= Case #f) (let ((V3517 (kl:shen.lazyderef V3569 V3570))) (if (pair? V3517) (let ((Ds (cdr V3517))) (begin (kl:shen.incinfs) (kl:shen.udefs* V3567 V3568 Ds V3570 V3571))) #f)) Case))) (quote shen.udefs*)) -(begin (register-function-arity (quote shen.th*) 5) (define (kl:shen.th* V3577 V3578 V3579 V3580 V3581) (let ((Throwcontrol (kl:shen.catchpoint))) (kl:shen.cutpoint Throwcontrol (let ((Case (begin (kl:shen.incinfs) (kl:shen.show (cons V3577 (cons (quote :) (cons V3578 (quote ())))) V3579 V3580 (lambda () (kl:fwhen #f V3580 V3581)))))) (if (kl:= Case #f) (let ((Case (let ((F (kl:shen.newpv V3580))) (begin (kl:shen.incinfs) (kl:fwhen (kl:shen.typedf? (kl:shen.lazyderef V3577 V3580)) V3580 (lambda () (kl:bind F (kl:shen.sigf (kl:shen.lazyderef V3577 V3580)) V3580 (lambda () (kl:call (cons F (cons V3578 (quote ()))) V3580 V3581))))))))) (if (kl:= Case #f) (let ((Case (begin (kl:shen.incinfs) (kl:shen.base V3577 V3578 V3580 V3581)))) (if (kl:= Case #f) (let ((Case (begin (kl:shen.incinfs) (kl:shen.by_hypothesis V3577 V3578 V3579 V3580 V3581)))) (if (kl:= Case #f) (let ((Case (let ((V3412 (kl:shen.lazyderef V3577 V3580))) (if (pair? V3412) (let ((F (car V3412))) (let ((V3413 (kl:shen.lazyderef (cdr V3412) V3580))) (if (null? V3413) (begin (kl:shen.incinfs) (kl:shen.th* F (cons (quote -->) (cons V3578 (quote ()))) V3579 V3580 V3581)) #f))) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3414 (kl:shen.lazyderef V3577 V3580))) (if (pair? V3414) (let ((F (car V3414))) (let ((V3415 (kl:shen.lazyderef (cdr V3414) V3580))) (if (pair? V3415) (let ((X (car V3415))) (let ((V3416 (kl:shen.lazyderef (cdr V3415) V3580))) (if (null? V3416) (let ((B (kl:shen.newpv V3580))) (begin (kl:shen.incinfs) (kl:shen.th* F (cons B (cons (quote -->) (cons V3578 (quote ())))) V3579 V3580 (lambda () (kl:shen.th* X B V3579 V3580 V3581))))) #f))) #f))) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3417 (kl:shen.lazyderef V3577 V3580))) (if (pair? V3417) (let ((V3418 (kl:shen.lazyderef (car V3417) V3580))) (if (eq? (quote cons) V3418) (let ((V3419 (kl:shen.lazyderef (cdr V3417) V3580))) (if (pair? V3419) (let ((X (car V3419))) (let ((V3420 (kl:shen.lazyderef (cdr V3419) V3580))) (if (pair? V3420) (let ((Y (car V3420))) (let ((V3421 (kl:shen.lazyderef (cdr V3420) V3580))) (if (null? V3421) (let ((V3422 (kl:shen.lazyderef V3578 V3580))) (if (pair? V3422) (let ((V3423 (kl:shen.lazyderef (car V3422) V3580))) (if (eq? (quote list) V3423) (let ((V3424 (kl:shen.lazyderef (cdr V3422) V3580))) (if (pair? V3424) (let ((A (car V3424))) (let ((V3425 (kl:shen.lazyderef (cdr V3424) V3580))) (if (null? V3425) (begin (kl:shen.incinfs) (kl:shen.th* X A V3579 V3580 (lambda () (kl:shen.th* Y (cons (quote list) (cons A (quote ()))) V3579 V3580 V3581)))) (if (kl:shen.pvar? V3425) (begin (kl:shen.bindv V3425 (quote ()) V3580) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V3579 V3580 (lambda () (kl:shen.th* Y (cons (quote list) (cons A (quote ()))) V3579 V3580 V3581)))))) (begin (kl:shen.unbindv V3425 V3580) Result))) #f)))) (if (kl:shen.pvar? V3424) (let ((A (kl:shen.newpv V3580))) (begin (kl:shen.bindv V3424 (cons A (quote ())) V3580) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V3579 V3580 (lambda () (kl:shen.th* Y (cons (quote list) (cons A (quote ()))) V3579 V3580 V3581)))))) (begin (kl:shen.unbindv V3424 V3580) Result)))) #f))) (if (kl:shen.pvar? V3423) (begin (kl:shen.bindv V3423 (quote list) V3580) (let ((Result (let ((V3426 (kl:shen.lazyderef (cdr V3422) V3580))) (if (pair? V3426) (let ((A (car V3426))) (let ((V3427 (kl:shen.lazyderef (cdr V3426) V3580))) (if (null? V3427) (begin (kl:shen.incinfs) (kl:shen.th* X A V3579 V3580 (lambda () (kl:shen.th* Y (cons (quote list) (cons A (quote ()))) V3579 V3580 V3581)))) (if (kl:shen.pvar? V3427) (begin (kl:shen.bindv V3427 (quote ()) V3580) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V3579 V3580 (lambda () (kl:shen.th* Y (cons (quote list) (cons A (quote ()))) V3579 V3580 V3581)))))) (begin (kl:shen.unbindv V3427 V3580) Result))) #f)))) (if (kl:shen.pvar? V3426) (let ((A (kl:shen.newpv V3580))) (begin (kl:shen.bindv V3426 (cons A (quote ())) V3580) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V3579 V3580 (lambda () (kl:shen.th* Y (cons (quote list) (cons A (quote ()))) V3579 V3580 V3581)))))) (begin (kl:shen.unbindv V3426 V3580) Result)))) #f))))) (begin (kl:shen.unbindv V3423 V3580) Result))) #f))) (if (kl:shen.pvar? V3422) (let ((A (kl:shen.newpv V3580))) (begin (kl:shen.bindv V3422 (cons (quote list) (cons A (quote ()))) V3580) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V3579 V3580 (lambda () (kl:shen.th* Y (cons (quote list) (cons A (quote ()))) V3579 V3580 V3581)))))) (begin (kl:shen.unbindv V3422 V3580) Result)))) #f))) #f))) #f))) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3428 (kl:shen.lazyderef V3577 V3580))) (if (pair? V3428) (let ((V3429 (kl:shen.lazyderef (car V3428) V3580))) (if (eq? (quote _waspvm_at_p) V3429) (let ((V3430 (kl:shen.lazyderef (cdr V3428) V3580))) (if (pair? V3430) (let ((X (car V3430))) (let ((V3431 (kl:shen.lazyderef (cdr V3430) V3580))) (if (pair? V3431) (let ((Y (car V3431))) (let ((V3432 (kl:shen.lazyderef (cdr V3431) V3580))) (if (null? V3432) (let ((V3433 (kl:shen.lazyderef V3578 V3580))) (if (pair? V3433) (let ((A (car V3433))) (let ((V3434 (kl:shen.lazyderef (cdr V3433) V3580))) (if (pair? V3434) (let ((V3435 (kl:shen.lazyderef (car V3434) V3580))) (if (eq? (quote *) V3435) (let ((V3436 (kl:shen.lazyderef (cdr V3434) V3580))) (if (pair? V3436) (let ((B (car V3436))) (let ((V3437 (kl:shen.lazyderef (cdr V3436) V3580))) (if (null? V3437) (begin (kl:shen.incinfs) (kl:shen.th* X A V3579 V3580 (lambda () (kl:shen.th* Y B V3579 V3580 V3581)))) (if (kl:shen.pvar? V3437) (begin (kl:shen.bindv V3437 (quote ()) V3580) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V3579 V3580 (lambda () (kl:shen.th* Y B V3579 V3580 V3581)))))) (begin (kl:shen.unbindv V3437 V3580) Result))) #f)))) (if (kl:shen.pvar? V3436) (let ((B (kl:shen.newpv V3580))) (begin (kl:shen.bindv V3436 (cons B (quote ())) V3580) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V3579 V3580 (lambda () (kl:shen.th* Y B V3579 V3580 V3581)))))) (begin (kl:shen.unbindv V3436 V3580) Result)))) #f))) (if (kl:shen.pvar? V3435) (begin (kl:shen.bindv V3435 (quote *) V3580) (let ((Result (let ((V3438 (kl:shen.lazyderef (cdr V3434) V3580))) (if (pair? V3438) (let ((B (car V3438))) (let ((V3439 (kl:shen.lazyderef (cdr V3438) V3580))) (if (null? V3439) (begin (kl:shen.incinfs) (kl:shen.th* X A V3579 V3580 (lambda () (kl:shen.th* Y B V3579 V3580 V3581)))) (if (kl:shen.pvar? V3439) (begin (kl:shen.bindv V3439 (quote ()) V3580) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V3579 V3580 (lambda () (kl:shen.th* Y B V3579 V3580 V3581)))))) (begin (kl:shen.unbindv V3439 V3580) Result))) #f)))) (if (kl:shen.pvar? V3438) (let ((B (kl:shen.newpv V3580))) (begin (kl:shen.bindv V3438 (cons B (quote ())) V3580) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V3579 V3580 (lambda () (kl:shen.th* Y B V3579 V3580 V3581)))))) (begin (kl:shen.unbindv V3438 V3580) Result)))) #f))))) (begin (kl:shen.unbindv V3435 V3580) Result))) #f))) (if (kl:shen.pvar? V3434) (let ((B (kl:shen.newpv V3580))) (begin (kl:shen.bindv V3434 (cons (quote *) (cons B (quote ()))) V3580) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V3579 V3580 (lambda () (kl:shen.th* Y B V3579 V3580 V3581)))))) (begin (kl:shen.unbindv V3434 V3580) Result)))) #f)))) (if (kl:shen.pvar? V3433) (let ((A (kl:shen.newpv V3580))) (let ((B (kl:shen.newpv V3580))) (begin (kl:shen.bindv V3433 (cons A (cons (quote *) (cons B (quote ())))) V3580) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V3579 V3580 (lambda () (kl:shen.th* Y B V3579 V3580 V3581)))))) (begin (kl:shen.unbindv V3433 V3580) Result))))) #f))) #f))) #f))) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3440 (kl:shen.lazyderef V3577 V3580))) (if (pair? V3440) (let ((V3441 (kl:shen.lazyderef (car V3440) V3580))) (if (eq? (quote _waspvm_at_v) V3441) (let ((V3442 (kl:shen.lazyderef (cdr V3440) V3580))) (if (pair? V3442) (let ((X (car V3442))) (let ((V3443 (kl:shen.lazyderef (cdr V3442) V3580))) (if (pair? V3443) (let ((Y (car V3443))) (let ((V3444 (kl:shen.lazyderef (cdr V3443) V3580))) (if (null? V3444) (let ((V3445 (kl:shen.lazyderef V3578 V3580))) (if (pair? V3445) (let ((V3446 (kl:shen.lazyderef (car V3445) V3580))) (if (eq? (quote vector) V3446) (let ((V3447 (kl:shen.lazyderef (cdr V3445) V3580))) (if (pair? V3447) (let ((A (car V3447))) (let ((V3448 (kl:shen.lazyderef (cdr V3447) V3580))) (if (null? V3448) (begin (kl:shen.incinfs) (kl:shen.th* X A V3579 V3580 (lambda () (kl:shen.th* Y (cons (quote vector) (cons A (quote ()))) V3579 V3580 V3581)))) (if (kl:shen.pvar? V3448) (begin (kl:shen.bindv V3448 (quote ()) V3580) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V3579 V3580 (lambda () (kl:shen.th* Y (cons (quote vector) (cons A (quote ()))) V3579 V3580 V3581)))))) (begin (kl:shen.unbindv V3448 V3580) Result))) #f)))) (if (kl:shen.pvar? V3447) (let ((A (kl:shen.newpv V3580))) (begin (kl:shen.bindv V3447 (cons A (quote ())) V3580) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V3579 V3580 (lambda () (kl:shen.th* Y (cons (quote vector) (cons A (quote ()))) V3579 V3580 V3581)))))) (begin (kl:shen.unbindv V3447 V3580) Result)))) #f))) (if (kl:shen.pvar? V3446) (begin (kl:shen.bindv V3446 (quote vector) V3580) (let ((Result (let ((V3449 (kl:shen.lazyderef (cdr V3445) V3580))) (if (pair? V3449) (let ((A (car V3449))) (let ((V3450 (kl:shen.lazyderef (cdr V3449) V3580))) (if (null? V3450) (begin (kl:shen.incinfs) (kl:shen.th* X A V3579 V3580 (lambda () (kl:shen.th* Y (cons (quote vector) (cons A (quote ()))) V3579 V3580 V3581)))) (if (kl:shen.pvar? V3450) (begin (kl:shen.bindv V3450 (quote ()) V3580) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V3579 V3580 (lambda () (kl:shen.th* Y (cons (quote vector) (cons A (quote ()))) V3579 V3580 V3581)))))) (begin (kl:shen.unbindv V3450 V3580) Result))) #f)))) (if (kl:shen.pvar? V3449) (let ((A (kl:shen.newpv V3580))) (begin (kl:shen.bindv V3449 (cons A (quote ())) V3580) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V3579 V3580 (lambda () (kl:shen.th* Y (cons (quote vector) (cons A (quote ()))) V3579 V3580 V3581)))))) (begin (kl:shen.unbindv V3449 V3580) Result)))) #f))))) (begin (kl:shen.unbindv V3446 V3580) Result))) #f))) (if (kl:shen.pvar? V3445) (let ((A (kl:shen.newpv V3580))) (begin (kl:shen.bindv V3445 (cons (quote vector) (cons A (quote ()))) V3580) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V3579 V3580 (lambda () (kl:shen.th* Y (cons (quote vector) (cons A (quote ()))) V3579 V3580 V3581)))))) (begin (kl:shen.unbindv V3445 V3580) Result)))) #f))) #f))) #f))) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3451 (kl:shen.lazyderef V3577 V3580))) (if (pair? V3451) (let ((V3452 (kl:shen.lazyderef (car V3451) V3580))) (if (eq? (quote _waspvm_at_s) V3452) (let ((V3453 (kl:shen.lazyderef (cdr V3451) V3580))) (if (pair? V3453) (let ((X (car V3453))) (let ((V3454 (kl:shen.lazyderef (cdr V3453) V3580))) (if (pair? V3454) (let ((Y (car V3454))) (let ((V3455 (kl:shen.lazyderef (cdr V3454) V3580))) (if (null? V3455) (let ((V3456 (kl:shen.lazyderef V3578 V3580))) (if (eq? (quote string) V3456) (begin (kl:shen.incinfs) (kl:shen.th* X (quote string) V3579 V3580 (lambda () (kl:shen.th* Y (quote string) V3579 V3580 V3581)))) (if (kl:shen.pvar? V3456) (begin (kl:shen.bindv V3456 (quote string) V3580) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X (quote string) V3579 V3580 (lambda () (kl:shen.th* Y (quote string) V3579 V3580 V3581)))))) (begin (kl:shen.unbindv V3456 V3580) Result))) #f))) #f))) #f))) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3457 (kl:shen.lazyderef V3577 V3580))) (if (pair? V3457) (let ((V3458 (kl:shen.lazyderef (car V3457) V3580))) (if (eq? (quote lambda) V3458) (let ((V3459 (kl:shen.lazyderef (cdr V3457) V3580))) (if (pair? V3459) (let ((X (car V3459))) (let ((V3460 (kl:shen.lazyderef (cdr V3459) V3580))) (if (pair? V3460) (let ((Y (car V3460))) (let ((V3461 (kl:shen.lazyderef (cdr V3460) V3580))) (if (null? V3461) (let ((V3462 (kl:shen.lazyderef V3578 V3580))) (if (pair? V3462) (let ((A (car V3462))) (let ((V3463 (kl:shen.lazyderef (cdr V3462) V3580))) (if (pair? V3463) (let ((V3464 (kl:shen.lazyderef (car V3463) V3580))) (if (eq? (quote -->) V3464) (let ((V3465 (kl:shen.lazyderef (cdr V3463) V3580))) (if (pair? V3465) (let ((B (car V3465))) (let ((V3466 (kl:shen.lazyderef (cdr V3465) V3580))) (if (null? V3466) (let ((Z (kl:shen.newpv V3580))) (let ((X&& (kl:shen.newpv V3580))) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V3580 (lambda () (kl:bind X&& (kl:shen.placeholder) V3580 (lambda () (kl:bind Z (kl:shen.ebr (kl:shen.lazyderef X&& V3580) (kl:shen.lazyderef X V3580) (kl:shen.lazyderef Y V3580)) V3580 (lambda () (kl:shen.th* Z B (cons (cons X&& (cons (quote :) (cons A (quote ())))) V3579) V3580 V3581)))))))))) (if (kl:shen.pvar? V3466) (begin (kl:shen.bindv V3466 (quote ()) V3580) (let ((Result (let ((Z (kl:shen.newpv V3580))) (let ((X&& (kl:shen.newpv V3580))) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V3580 (lambda () (kl:bind X&& (kl:shen.placeholder) V3580 (lambda () (kl:bind Z (kl:shen.ebr (kl:shen.lazyderef X&& V3580) (kl:shen.lazyderef X V3580) (kl:shen.lazyderef Y V3580)) V3580 (lambda () (kl:shen.th* Z B (cons (cons X&& (cons (quote :) (cons A (quote ())))) V3579) V3580 V3581)))))))))))) (begin (kl:shen.unbindv V3466 V3580) Result))) #f)))) (if (kl:shen.pvar? V3465) (let ((B (kl:shen.newpv V3580))) (begin (kl:shen.bindv V3465 (cons B (quote ())) V3580) (let ((Result (let ((Z (kl:shen.newpv V3580))) (let ((X&& (kl:shen.newpv V3580))) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V3580 (lambda () (kl:bind X&& (kl:shen.placeholder) V3580 (lambda () (kl:bind Z (kl:shen.ebr (kl:shen.lazyderef X&& V3580) (kl:shen.lazyderef X V3580) (kl:shen.lazyderef Y V3580)) V3580 (lambda () (kl:shen.th* Z B (cons (cons X&& (cons (quote :) (cons A (quote ())))) V3579) V3580 V3581)))))))))))) (begin (kl:shen.unbindv V3465 V3580) Result)))) #f))) (if (kl:shen.pvar? V3464) (begin (kl:shen.bindv V3464 (quote -->) V3580) (let ((Result (let ((V3467 (kl:shen.lazyderef (cdr V3463) V3580))) (if (pair? V3467) (let ((B (car V3467))) (let ((V3468 (kl:shen.lazyderef (cdr V3467) V3580))) (if (null? V3468) (let ((Z (kl:shen.newpv V3580))) (let ((X&& (kl:shen.newpv V3580))) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V3580 (lambda () (kl:bind X&& (kl:shen.placeholder) V3580 (lambda () (kl:bind Z (kl:shen.ebr (kl:shen.lazyderef X&& V3580) (kl:shen.lazyderef X V3580) (kl:shen.lazyderef Y V3580)) V3580 (lambda () (kl:shen.th* Z B (cons (cons X&& (cons (quote :) (cons A (quote ())))) V3579) V3580 V3581)))))))))) (if (kl:shen.pvar? V3468) (begin (kl:shen.bindv V3468 (quote ()) V3580) (let ((Result (let ((Z (kl:shen.newpv V3580))) (let ((X&& (kl:shen.newpv V3580))) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V3580 (lambda () (kl:bind X&& (kl:shen.placeholder) V3580 (lambda () (kl:bind Z (kl:shen.ebr (kl:shen.lazyderef X&& V3580) (kl:shen.lazyderef X V3580) (kl:shen.lazyderef Y V3580)) V3580 (lambda () (kl:shen.th* Z B (cons (cons X&& (cons (quote :) (cons A (quote ())))) V3579) V3580 V3581)))))))))))) (begin (kl:shen.unbindv V3468 V3580) Result))) #f)))) (if (kl:shen.pvar? V3467) (let ((B (kl:shen.newpv V3580))) (begin (kl:shen.bindv V3467 (cons B (quote ())) V3580) (let ((Result (let ((Z (kl:shen.newpv V3580))) (let ((X&& (kl:shen.newpv V3580))) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V3580 (lambda () (kl:bind X&& (kl:shen.placeholder) V3580 (lambda () (kl:bind Z (kl:shen.ebr (kl:shen.lazyderef X&& V3580) (kl:shen.lazyderef X V3580) (kl:shen.lazyderef Y V3580)) V3580 (lambda () (kl:shen.th* Z B (cons (cons X&& (cons (quote :) (cons A (quote ())))) V3579) V3580 V3581)))))))))))) (begin (kl:shen.unbindv V3467 V3580) Result)))) #f))))) (begin (kl:shen.unbindv V3464 V3580) Result))) #f))) (if (kl:shen.pvar? V3463) (let ((B (kl:shen.newpv V3580))) (begin (kl:shen.bindv V3463 (cons (quote -->) (cons B (quote ()))) V3580) (let ((Result (let ((Z (kl:shen.newpv V3580))) (let ((X&& (kl:shen.newpv V3580))) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V3580 (lambda () (kl:bind X&& (kl:shen.placeholder) V3580 (lambda () (kl:bind Z (kl:shen.ebr (kl:shen.lazyderef X&& V3580) (kl:shen.lazyderef X V3580) (kl:shen.lazyderef Y V3580)) V3580 (lambda () (kl:shen.th* Z B (cons (cons X&& (cons (quote :) (cons A (quote ())))) V3579) V3580 V3581)))))))))))) (begin (kl:shen.unbindv V3463 V3580) Result)))) #f)))) (if (kl:shen.pvar? V3462) (let ((A (kl:shen.newpv V3580))) (let ((B (kl:shen.newpv V3580))) (begin (kl:shen.bindv V3462 (cons A (cons (quote -->) (cons B (quote ())))) V3580) (let ((Result (let ((Z (kl:shen.newpv V3580))) (let ((X&& (kl:shen.newpv V3580))) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V3580 (lambda () (kl:bind X&& (kl:shen.placeholder) V3580 (lambda () (kl:bind Z (kl:shen.ebr (kl:shen.lazyderef X&& V3580) (kl:shen.lazyderef X V3580) (kl:shen.lazyderef Y V3580)) V3580 (lambda () (kl:shen.th* Z B (cons (cons X&& (cons (quote :) (cons A (quote ())))) V3579) V3580 V3581)))))))))))) (begin (kl:shen.unbindv V3462 V3580) Result))))) #f))) #f))) #f))) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3469 (kl:shen.lazyderef V3577 V3580))) (if (pair? V3469) (let ((V3470 (kl:shen.lazyderef (car V3469) V3580))) (if (eq? (quote let) V3470) (let ((V3471 (kl:shen.lazyderef (cdr V3469) V3580))) (if (pair? V3471) (let ((X (car V3471))) (let ((V3472 (kl:shen.lazyderef (cdr V3471) V3580))) (if (pair? V3472) (let ((Y (car V3472))) (let ((V3473 (kl:shen.lazyderef (cdr V3472) V3580))) (if (pair? V3473) (let ((Z (car V3473))) (let ((V3474 (kl:shen.lazyderef (cdr V3473) V3580))) (if (null? V3474) (let ((W (kl:shen.newpv V3580))) (let ((X&& (kl:shen.newpv V3580))) (let ((B (kl:shen.newpv V3580))) (begin (kl:shen.incinfs) (kl:shen.th* Y B V3579 V3580 (lambda () (kl:bind X&& (kl:shen.placeholder) V3580 (lambda () (kl:bind W (kl:shen.ebr (kl:shen.lazyderef X&& V3580) (kl:shen.lazyderef X V3580) (kl:shen.lazyderef Z V3580)) V3580 (lambda () (kl:shen.th* W V3578 (cons (cons X&& (cons (quote :) (cons B (quote ())))) V3579) V3580 V3581))))))))))) #f))) #f))) #f))) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3475 (kl:shen.lazyderef V3577 V3580))) (if (pair? V3475) (let ((V3476 (kl:shen.lazyderef (car V3475) V3580))) (if (eq? (quote open) V3476) (let ((V3477 (kl:shen.lazyderef (cdr V3475) V3580))) (if (pair? V3477) (let ((FileName (car V3477))) (let ((V3478 (kl:shen.lazyderef (cdr V3477) V3580))) (if (pair? V3478) (let ((Direction3408 (car V3478))) (let ((V3479 (kl:shen.lazyderef (cdr V3478) V3580))) (if (null? V3479) (let ((V3480 (kl:shen.lazyderef V3578 V3580))) (if (pair? V3480) (let ((V3481 (kl:shen.lazyderef (car V3480) V3580))) (if (eq? (quote stream) V3481) (let ((V3482 (kl:shen.lazyderef (cdr V3480) V3580))) (if (pair? V3482) (let ((Direction (car V3482))) (let ((V3483 (kl:shen.lazyderef (cdr V3482) V3580))) (if (null? V3483) (begin (kl:shen.incinfs) (kl:unify! Direction Direction3408 V3580 (lambda () (kl:cut Throwcontrol V3580 (lambda () (kl:fwhen (kl:element? (kl:shen.lazyderef Direction V3580) (cons (quote in) (cons (quote out) (quote ())))) V3580 (lambda () (kl:shen.th* FileName (quote string) V3579 V3580 V3581)))))))) (if (kl:shen.pvar? V3483) (begin (kl:shen.bindv V3483 (quote ()) V3580) (let ((Result (begin (kl:shen.incinfs) (kl:unify! Direction Direction3408 V3580 (lambda () (kl:cut Throwcontrol V3580 (lambda () (kl:fwhen (kl:element? (kl:shen.lazyderef Direction V3580) (cons (quote in) (cons (quote out) (quote ())))) V3580 (lambda () (kl:shen.th* FileName (quote string) V3579 V3580 V3581)))))))))) (begin (kl:shen.unbindv V3483 V3580) Result))) #f)))) (if (kl:shen.pvar? V3482) (let ((Direction (kl:shen.newpv V3580))) (begin (kl:shen.bindv V3482 (cons Direction (quote ())) V3580) (let ((Result (begin (kl:shen.incinfs) (kl:unify! Direction Direction3408 V3580 (lambda () (kl:cut Throwcontrol V3580 (lambda () (kl:fwhen (kl:element? (kl:shen.lazyderef Direction V3580) (cons (quote in) (cons (quote out) (quote ())))) V3580 (lambda () (kl:shen.th* FileName (quote string) V3579 V3580 V3581)))))))))) (begin (kl:shen.unbindv V3482 V3580) Result)))) #f))) (if (kl:shen.pvar? V3481) (begin (kl:shen.bindv V3481 (quote stream) V3580) (let ((Result (let ((V3484 (kl:shen.lazyderef (cdr V3480) V3580))) (if (pair? V3484) (let ((Direction (car V3484))) (let ((V3485 (kl:shen.lazyderef (cdr V3484) V3580))) (if (null? V3485) (begin (kl:shen.incinfs) (kl:unify! Direction Direction3408 V3580 (lambda () (kl:cut Throwcontrol V3580 (lambda () (kl:fwhen (kl:element? (kl:shen.lazyderef Direction V3580) (cons (quote in) (cons (quote out) (quote ())))) V3580 (lambda () (kl:shen.th* FileName (quote string) V3579 V3580 V3581)))))))) (if (kl:shen.pvar? V3485) (begin (kl:shen.bindv V3485 (quote ()) V3580) (let ((Result (begin (kl:shen.incinfs) (kl:unify! Direction Direction3408 V3580 (lambda () (kl:cut Throwcontrol V3580 (lambda () (kl:fwhen (kl:element? (kl:shen.lazyderef Direction V3580) (cons (quote in) (cons (quote out) (quote ())))) V3580 (lambda () (kl:shen.th* FileName (quote string) V3579 V3580 V3581)))))))))) (begin (kl:shen.unbindv V3485 V3580) Result))) #f)))) (if (kl:shen.pvar? V3484) (let ((Direction (kl:shen.newpv V3580))) (begin (kl:shen.bindv V3484 (cons Direction (quote ())) V3580) (let ((Result (begin (kl:shen.incinfs) (kl:unify! Direction Direction3408 V3580 (lambda () (kl:cut Throwcontrol V3580 (lambda () (kl:fwhen (kl:element? (kl:shen.lazyderef Direction V3580) (cons (quote in) (cons (quote out) (quote ())))) V3580 (lambda () (kl:shen.th* FileName (quote string) V3579 V3580 V3581)))))))))) (begin (kl:shen.unbindv V3484 V3580) Result)))) #f))))) (begin (kl:shen.unbindv V3481 V3580) Result))) #f))) (if (kl:shen.pvar? V3480) (let ((Direction (kl:shen.newpv V3580))) (begin (kl:shen.bindv V3480 (cons (quote stream) (cons Direction (quote ()))) V3580) (let ((Result (begin (kl:shen.incinfs) (kl:unify! Direction Direction3408 V3580 (lambda () (kl:cut Throwcontrol V3580 (lambda () (kl:fwhen (kl:element? (kl:shen.lazyderef Direction V3580) (cons (quote in) (cons (quote out) (quote ())))) V3580 (lambda () (kl:shen.th* FileName (quote string) V3579 V3580 V3581)))))))))) (begin (kl:shen.unbindv V3480 V3580) Result)))) #f))) #f))) #f))) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3486 (kl:shen.lazyderef V3577 V3580))) (if (pair? V3486) (let ((V3487 (kl:shen.lazyderef (car V3486) V3580))) (if (eq? (quote type) V3487) (let ((V3488 (kl:shen.lazyderef (cdr V3486) V3580))) (if (pair? V3488) (let ((X (car V3488))) (let ((V3489 (kl:shen.lazyderef (cdr V3488) V3580))) (if (pair? V3489) (let ((A (car V3489))) (let ((V3490 (kl:shen.lazyderef (cdr V3489) V3580))) (if (null? V3490) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V3580 (lambda () (kl:unify A V3578 V3580 (lambda () (kl:shen.th* X A V3579 V3580 V3581)))))) #f))) #f))) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3491 (kl:shen.lazyderef V3577 V3580))) (if (pair? V3491) (let ((V3492 (kl:shen.lazyderef (car V3491) V3580))) (if (eq? (quote input+) V3492) (let ((V3493 (kl:shen.lazyderef (cdr V3491) V3580))) (if (pair? V3493) (let ((A (car V3493))) (let ((V3494 (kl:shen.lazyderef (cdr V3493) V3580))) (if (pair? V3494) (let ((Stream (car V3494))) (let ((V3495 (kl:shen.lazyderef (cdr V3494) V3580))) (if (null? V3495) (let ((C (kl:shen.newpv V3580))) (begin (kl:shen.incinfs) (kl:bind C (kl:shen.demodulate (kl:shen.lazyderef A V3580)) V3580 (lambda () (kl:unify V3578 C V3580 (lambda () (kl:shen.th* Stream (cons (quote stream) (cons (quote in) (quote ()))) V3579 V3580 V3581))))))) #f))) #f))) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3496 (kl:shen.lazyderef V3577 V3580))) (if (pair? V3496) (let ((V3497 (kl:shen.lazyderef (car V3496) V3580))) (if (eq? (quote set) V3497) (let ((V3498 (kl:shen.lazyderef (cdr V3496) V3580))) (if (pair? V3498) (let ((Var (car V3498))) (let ((V3499 (kl:shen.lazyderef (cdr V3498) V3580))) (if (pair? V3499) (let ((Val (car V3499))) (let ((V3500 (kl:shen.lazyderef (cdr V3499) V3580))) (if (null? V3500) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V3580 (lambda () (kl:shen.th* Var (quote symbol) V3579 V3580 (lambda () (kl:cut Throwcontrol V3580 (lambda () (kl:shen.th* (cons (quote value) (cons Var (quote ()))) V3578 V3579 V3580 (lambda () (kl:shen.th* Val V3578 V3579 V3580 V3581)))))))))) #f))) #f))) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((NewHyp (kl:shen.newpv V3580))) (begin (kl:shen.incinfs) (kl:shen.t*-hyps V3579 NewHyp V3580 (lambda () (kl:shen.th* V3577 V3578 NewHyp V3580 V3581))))))) (if (kl:= Case #f) (let ((Case (let ((V3501 (kl:shen.lazyderef V3577 V3580))) (if (pair? V3501) (let ((V3502 (kl:shen.lazyderef (car V3501) V3580))) (if (eq? (quote define) V3502) (let ((V3503 (kl:shen.lazyderef (cdr V3501) V3580))) (if (pair? V3503) (let ((F (car V3503))) (let ((X (cdr V3503))) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V3580 (lambda () (kl:shen.t*-def (cons (quote define) (cons F X)) V3578 V3579 V3580 V3581)))))) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3504 (kl:shen.lazyderef V3577 V3580))) (if (pair? V3504) (let ((V3505 (kl:shen.lazyderef (car V3504) V3580))) (if (eq? (quote defmacro) V3505) (let ((V3506 (kl:shen.lazyderef V3578 V3580))) (if (eq? (quote unit) V3506) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V3580 V3581)) (if (kl:shen.pvar? V3506) (begin (kl:shen.bindv V3506 (quote unit) V3580) (let ((Result (begin (kl:shen.incinfs) (kl:cut Throwcontrol V3580 V3581)))) (begin (kl:shen.unbindv V3506 V3580) Result))) #f))) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3507 (kl:shen.lazyderef V3577 V3580))) (if (pair? V3507) (let ((V3508 (kl:shen.lazyderef (car V3507) V3580))) (if (eq? (quote shen.process-datatype) V3508) (let ((V3509 (kl:shen.lazyderef V3578 V3580))) (if (eq? (quote symbol) V3509) (begin (kl:shen.incinfs) (kl:thaw V3581)) (if (kl:shen.pvar? V3509) (begin (kl:shen.bindv V3509 (quote symbol) V3580) (let ((Result (begin (kl:shen.incinfs) (kl:thaw V3581)))) (begin (kl:shen.unbindv V3509 V3580) Result))) #f))) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3510 (kl:shen.lazyderef V3577 V3580))) (if (pair? V3510) (let ((V3511 (kl:shen.lazyderef (car V3510) V3580))) (if (eq? (quote shen.synonyms-help) V3511) (let ((V3512 (kl:shen.lazyderef V3578 V3580))) (if (eq? (quote symbol) V3512) (begin (kl:shen.incinfs) (kl:thaw V3581)) (if (kl:shen.pvar? V3512) (begin (kl:shen.bindv V3512 (quote symbol) V3580) (let ((Result (begin (kl:shen.incinfs) (kl:thaw V3581)))) (begin (kl:shen.unbindv V3512 V3580) Result))) #f))) #f)) #f)))) (if (kl:= Case #f) (let ((Datatypes (kl:shen.newpv V3580))) (begin (kl:shen.incinfs) (kl:bind Datatypes (kl:value (quote shen.*datatypes*)) V3580 (lambda () (kl:shen.udefs* (cons V3577 (cons (quote :) (cons V3578 (quote ())))) V3579 Datatypes V3580 V3581))))) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case))))) (quote shen.th*)) -(begin (register-function-arity (quote shen.t*-hyps) 4) (define (kl:shen.t*-hyps V3586 V3587 V3588 V3589) (let ((Case (let ((V3323 (kl:shen.lazyderef V3586 V3588))) (if (pair? V3323) (let ((V3324 (kl:shen.lazyderef (car V3323) V3588))) (if (pair? V3324) (let ((V3325 (kl:shen.lazyderef (car V3324) V3588))) (if (pair? V3325) (let ((V3326 (kl:shen.lazyderef (car V3325) V3588))) (if (eq? (quote cons) V3326) (let ((V3327 (kl:shen.lazyderef (cdr V3325) V3588))) (if (pair? V3327) (let ((X (car V3327))) (let ((V3328 (kl:shen.lazyderef (cdr V3327) V3588))) (if (pair? V3328) (let ((Y (car V3328))) (let ((V3329 (kl:shen.lazyderef (cdr V3328) V3588))) (if (null? V3329) (let ((V3330 (kl:shen.lazyderef (cdr V3324) V3588))) (if (pair? V3330) (let ((V3331 (kl:shen.lazyderef (car V3330) V3588))) (if (eq? (quote :) V3331) (let ((V3332 (kl:shen.lazyderef (cdr V3330) V3588))) (if (pair? V3332) (let ((V3333 (kl:shen.lazyderef (car V3332) V3588))) (if (pair? V3333) (let ((V3334 (kl:shen.lazyderef (car V3333) V3588))) (if (eq? (quote list) V3334) (let ((V3335 (kl:shen.lazyderef (cdr V3333) V3588))) (if (pair? V3335) (let ((A (car V3335))) (let ((V3336 (kl:shen.lazyderef (cdr V3335) V3588))) (if (null? V3336) (let ((V3337 (kl:shen.lazyderef (cdr V3332) V3588))) (if (null? V3337) (let ((Hyp (cdr V3323))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))) (if (kl:shen.pvar? V3337) (begin (kl:shen.bindv V3337 (quote ()) V3588) (let ((Result (let ((Hyp (cdr V3323))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))))) (begin (kl:shen.unbindv V3337 V3588) Result))) #f))) (if (kl:shen.pvar? V3336) (begin (kl:shen.bindv V3336 (quote ()) V3588) (let ((Result (let ((V3338 (kl:shen.lazyderef (cdr V3332) V3588))) (if (null? V3338) (let ((Hyp (cdr V3323))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))) (if (kl:shen.pvar? V3338) (begin (kl:shen.bindv V3338 (quote ()) V3588) (let ((Result (let ((Hyp (cdr V3323))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))))) (begin (kl:shen.unbindv V3338 V3588) Result))) #f))))) (begin (kl:shen.unbindv V3336 V3588) Result))) #f)))) (if (kl:shen.pvar? V3335) (let ((A (kl:shen.newpv V3588))) (begin (kl:shen.bindv V3335 (cons A (quote ())) V3588) (let ((Result (let ((V3339 (kl:shen.lazyderef (cdr V3332) V3588))) (if (null? V3339) (let ((Hyp (cdr V3323))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))) (if (kl:shen.pvar? V3339) (begin (kl:shen.bindv V3339 (quote ()) V3588) (let ((Result (let ((Hyp (cdr V3323))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))))) (begin (kl:shen.unbindv V3339 V3588) Result))) #f))))) (begin (kl:shen.unbindv V3335 V3588) Result)))) #f))) (if (kl:shen.pvar? V3334) (begin (kl:shen.bindv V3334 (quote list) V3588) (let ((Result (let ((V3340 (kl:shen.lazyderef (cdr V3333) V3588))) (if (pair? V3340) (let ((A (car V3340))) (let ((V3341 (kl:shen.lazyderef (cdr V3340) V3588))) (if (null? V3341) (let ((V3342 (kl:shen.lazyderef (cdr V3332) V3588))) (if (null? V3342) (let ((Hyp (cdr V3323))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))) (if (kl:shen.pvar? V3342) (begin (kl:shen.bindv V3342 (quote ()) V3588) (let ((Result (let ((Hyp (cdr V3323))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))))) (begin (kl:shen.unbindv V3342 V3588) Result))) #f))) (if (kl:shen.pvar? V3341) (begin (kl:shen.bindv V3341 (quote ()) V3588) (let ((Result (let ((V3343 (kl:shen.lazyderef (cdr V3332) V3588))) (if (null? V3343) (let ((Hyp (cdr V3323))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))) (if (kl:shen.pvar? V3343) (begin (kl:shen.bindv V3343 (quote ()) V3588) (let ((Result (let ((Hyp (cdr V3323))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))))) (begin (kl:shen.unbindv V3343 V3588) Result))) #f))))) (begin (kl:shen.unbindv V3341 V3588) Result))) #f)))) (if (kl:shen.pvar? V3340) (let ((A (kl:shen.newpv V3588))) (begin (kl:shen.bindv V3340 (cons A (quote ())) V3588) (let ((Result (let ((V3344 (kl:shen.lazyderef (cdr V3332) V3588))) (if (null? V3344) (let ((Hyp (cdr V3323))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))) (if (kl:shen.pvar? V3344) (begin (kl:shen.bindv V3344 (quote ()) V3588) (let ((Result (let ((Hyp (cdr V3323))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))))) (begin (kl:shen.unbindv V3344 V3588) Result))) #f))))) (begin (kl:shen.unbindv V3340 V3588) Result)))) #f))))) (begin (kl:shen.unbindv V3334 V3588) Result))) #f))) (if (kl:shen.pvar? V3333) (let ((A (kl:shen.newpv V3588))) (begin (kl:shen.bindv V3333 (cons (quote list) (cons A (quote ()))) V3588) (let ((Result (let ((V3345 (kl:shen.lazyderef (cdr V3332) V3588))) (if (null? V3345) (let ((Hyp (cdr V3323))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))) (if (kl:shen.pvar? V3345) (begin (kl:shen.bindv V3345 (quote ()) V3588) (let ((Result (let ((Hyp (cdr V3323))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))))) (begin (kl:shen.unbindv V3345 V3588) Result))) #f))))) (begin (kl:shen.unbindv V3333 V3588) Result)))) #f))) #f)) #f)) #f)) #f))) #f))) #f)) #f)) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3346 (kl:shen.lazyderef V3586 V3588))) (if (pair? V3346) (let ((V3347 (kl:shen.lazyderef (car V3346) V3588))) (if (pair? V3347) (let ((V3348 (kl:shen.lazyderef (car V3347) V3588))) (if (pair? V3348) (let ((V3349 (kl:shen.lazyderef (car V3348) V3588))) (if (eq? (quote _waspvm_at_p) V3349) (let ((V3350 (kl:shen.lazyderef (cdr V3348) V3588))) (if (pair? V3350) (let ((X (car V3350))) (let ((V3351 (kl:shen.lazyderef (cdr V3350) V3588))) (if (pair? V3351) (let ((Y (car V3351))) (let ((V3352 (kl:shen.lazyderef (cdr V3351) V3588))) (if (null? V3352) (let ((V3353 (kl:shen.lazyderef (cdr V3347) V3588))) (if (pair? V3353) (let ((V3354 (kl:shen.lazyderef (car V3353) V3588))) (if (eq? (quote :) V3354) (let ((V3355 (kl:shen.lazyderef (cdr V3353) V3588))) (if (pair? V3355) (let ((V3356 (kl:shen.lazyderef (car V3355) V3588))) (if (pair? V3356) (let ((A (car V3356))) (let ((V3357 (kl:shen.lazyderef (cdr V3356) V3588))) (if (pair? V3357) (let ((V3358 (kl:shen.lazyderef (car V3357) V3588))) (if (eq? (quote *) V3358) (let ((V3359 (kl:shen.lazyderef (cdr V3357) V3588))) (if (pair? V3359) (let ((B (car V3359))) (let ((V3360 (kl:shen.lazyderef (cdr V3359) V3588))) (if (null? V3360) (let ((V3361 (kl:shen.lazyderef (cdr V3355) V3588))) (if (null? V3361) (let ((Hyp (cdr V3346))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (kl:shen.lazyderef B V3588) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))) (if (kl:shen.pvar? V3361) (begin (kl:shen.bindv V3361 (quote ()) V3588) (let ((Result (let ((Hyp (cdr V3346))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (kl:shen.lazyderef B V3588) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))))) (begin (kl:shen.unbindv V3361 V3588) Result))) #f))) (if (kl:shen.pvar? V3360) (begin (kl:shen.bindv V3360 (quote ()) V3588) (let ((Result (let ((V3362 (kl:shen.lazyderef (cdr V3355) V3588))) (if (null? V3362) (let ((Hyp (cdr V3346))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (kl:shen.lazyderef B V3588) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))) (if (kl:shen.pvar? V3362) (begin (kl:shen.bindv V3362 (quote ()) V3588) (let ((Result (let ((Hyp (cdr V3346))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (kl:shen.lazyderef B V3588) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))))) (begin (kl:shen.unbindv V3362 V3588) Result))) #f))))) (begin (kl:shen.unbindv V3360 V3588) Result))) #f)))) (if (kl:shen.pvar? V3359) (let ((B (kl:shen.newpv V3588))) (begin (kl:shen.bindv V3359 (cons B (quote ())) V3588) (let ((Result (let ((V3363 (kl:shen.lazyderef (cdr V3355) V3588))) (if (null? V3363) (let ((Hyp (cdr V3346))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (kl:shen.lazyderef B V3588) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))) (if (kl:shen.pvar? V3363) (begin (kl:shen.bindv V3363 (quote ()) V3588) (let ((Result (let ((Hyp (cdr V3346))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (kl:shen.lazyderef B V3588) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))))) (begin (kl:shen.unbindv V3363 V3588) Result))) #f))))) (begin (kl:shen.unbindv V3359 V3588) Result)))) #f))) (if (kl:shen.pvar? V3358) (begin (kl:shen.bindv V3358 (quote *) V3588) (let ((Result (let ((V3364 (kl:shen.lazyderef (cdr V3357) V3588))) (if (pair? V3364) (let ((B (car V3364))) (let ((V3365 (kl:shen.lazyderef (cdr V3364) V3588))) (if (null? V3365) (let ((V3366 (kl:shen.lazyderef (cdr V3355) V3588))) (if (null? V3366) (let ((Hyp (cdr V3346))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (kl:shen.lazyderef B V3588) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))) (if (kl:shen.pvar? V3366) (begin (kl:shen.bindv V3366 (quote ()) V3588) (let ((Result (let ((Hyp (cdr V3346))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (kl:shen.lazyderef B V3588) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))))) (begin (kl:shen.unbindv V3366 V3588) Result))) #f))) (if (kl:shen.pvar? V3365) (begin (kl:shen.bindv V3365 (quote ()) V3588) (let ((Result (let ((V3367 (kl:shen.lazyderef (cdr V3355) V3588))) (if (null? V3367) (let ((Hyp (cdr V3346))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (kl:shen.lazyderef B V3588) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))) (if (kl:shen.pvar? V3367) (begin (kl:shen.bindv V3367 (quote ()) V3588) (let ((Result (let ((Hyp (cdr V3346))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (kl:shen.lazyderef B V3588) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))))) (begin (kl:shen.unbindv V3367 V3588) Result))) #f))))) (begin (kl:shen.unbindv V3365 V3588) Result))) #f)))) (if (kl:shen.pvar? V3364) (let ((B (kl:shen.newpv V3588))) (begin (kl:shen.bindv V3364 (cons B (quote ())) V3588) (let ((Result (let ((V3368 (kl:shen.lazyderef (cdr V3355) V3588))) (if (null? V3368) (let ((Hyp (cdr V3346))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (kl:shen.lazyderef B V3588) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))) (if (kl:shen.pvar? V3368) (begin (kl:shen.bindv V3368 (quote ()) V3588) (let ((Result (let ((Hyp (cdr V3346))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (kl:shen.lazyderef B V3588) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))))) (begin (kl:shen.unbindv V3368 V3588) Result))) #f))))) (begin (kl:shen.unbindv V3364 V3588) Result)))) #f))))) (begin (kl:shen.unbindv V3358 V3588) Result))) #f))) (if (kl:shen.pvar? V3357) (let ((B (kl:shen.newpv V3588))) (begin (kl:shen.bindv V3357 (cons (quote *) (cons B (quote ()))) V3588) (let ((Result (let ((V3369 (kl:shen.lazyderef (cdr V3355) V3588))) (if (null? V3369) (let ((Hyp (cdr V3346))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (kl:shen.lazyderef B V3588) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))) (if (kl:shen.pvar? V3369) (begin (kl:shen.bindv V3369 (quote ()) V3588) (let ((Result (let ((Hyp (cdr V3346))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (kl:shen.lazyderef B V3588) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))))) (begin (kl:shen.unbindv V3369 V3588) Result))) #f))))) (begin (kl:shen.unbindv V3357 V3588) Result)))) #f)))) (if (kl:shen.pvar? V3356) (let ((A (kl:shen.newpv V3588))) (let ((B (kl:shen.newpv V3588))) (begin (kl:shen.bindv V3356 (cons A (cons (quote *) (cons B (quote ())))) V3588) (let ((Result (let ((V3370 (kl:shen.lazyderef (cdr V3355) V3588))) (if (null? V3370) (let ((Hyp (cdr V3346))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (kl:shen.lazyderef B V3588) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))) (if (kl:shen.pvar? V3370) (begin (kl:shen.bindv V3370 (quote ()) V3588) (let ((Result (let ((Hyp (cdr V3346))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (kl:shen.lazyderef B V3588) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))))) (begin (kl:shen.unbindv V3370 V3588) Result))) #f))))) (begin (kl:shen.unbindv V3356 V3588) Result))))) #f))) #f)) #f)) #f)) #f))) #f))) #f)) #f)) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3371 (kl:shen.lazyderef V3586 V3588))) (if (pair? V3371) (let ((V3372 (kl:shen.lazyderef (car V3371) V3588))) (if (pair? V3372) (let ((V3373 (kl:shen.lazyderef (car V3372) V3588))) (if (pair? V3373) (let ((V3374 (kl:shen.lazyderef (car V3373) V3588))) (if (eq? (quote _waspvm_at_v) V3374) (let ((V3375 (kl:shen.lazyderef (cdr V3373) V3588))) (if (pair? V3375) (let ((X (car V3375))) (let ((V3376 (kl:shen.lazyderef (cdr V3375) V3588))) (if (pair? V3376) (let ((Y (car V3376))) (let ((V3377 (kl:shen.lazyderef (cdr V3376) V3588))) (if (null? V3377) (let ((V3378 (kl:shen.lazyderef (cdr V3372) V3588))) (if (pair? V3378) (let ((V3379 (kl:shen.lazyderef (car V3378) V3588))) (if (eq? (quote :) V3379) (let ((V3380 (kl:shen.lazyderef (cdr V3378) V3588))) (if (pair? V3380) (let ((V3381 (kl:shen.lazyderef (car V3380) V3588))) (if (pair? V3381) (let ((V3382 (kl:shen.lazyderef (car V3381) V3588))) (if (eq? (quote vector) V3382) (let ((V3383 (kl:shen.lazyderef (cdr V3381) V3588))) (if (pair? V3383) (let ((A (car V3383))) (let ((V3384 (kl:shen.lazyderef (cdr V3383) V3588))) (if (null? V3384) (let ((V3385 (kl:shen.lazyderef (cdr V3380) V3588))) (if (null? V3385) (let ((Hyp (cdr V3371))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))) (if (kl:shen.pvar? V3385) (begin (kl:shen.bindv V3385 (quote ()) V3588) (let ((Result (let ((Hyp (cdr V3371))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))))) (begin (kl:shen.unbindv V3385 V3588) Result))) #f))) (if (kl:shen.pvar? V3384) (begin (kl:shen.bindv V3384 (quote ()) V3588) (let ((Result (let ((V3386 (kl:shen.lazyderef (cdr V3380) V3588))) (if (null? V3386) (let ((Hyp (cdr V3371))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))) (if (kl:shen.pvar? V3386) (begin (kl:shen.bindv V3386 (quote ()) V3588) (let ((Result (let ((Hyp (cdr V3371))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))))) (begin (kl:shen.unbindv V3386 V3588) Result))) #f))))) (begin (kl:shen.unbindv V3384 V3588) Result))) #f)))) (if (kl:shen.pvar? V3383) (let ((A (kl:shen.newpv V3588))) (begin (kl:shen.bindv V3383 (cons A (quote ())) V3588) (let ((Result (let ((V3387 (kl:shen.lazyderef (cdr V3380) V3588))) (if (null? V3387) (let ((Hyp (cdr V3371))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))) (if (kl:shen.pvar? V3387) (begin (kl:shen.bindv V3387 (quote ()) V3588) (let ((Result (let ((Hyp (cdr V3371))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))))) (begin (kl:shen.unbindv V3387 V3588) Result))) #f))))) (begin (kl:shen.unbindv V3383 V3588) Result)))) #f))) (if (kl:shen.pvar? V3382) (begin (kl:shen.bindv V3382 (quote vector) V3588) (let ((Result (let ((V3388 (kl:shen.lazyderef (cdr V3381) V3588))) (if (pair? V3388) (let ((A (car V3388))) (let ((V3389 (kl:shen.lazyderef (cdr V3388) V3588))) (if (null? V3389) (let ((V3390 (kl:shen.lazyderef (cdr V3380) V3588))) (if (null? V3390) (let ((Hyp (cdr V3371))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))) (if (kl:shen.pvar? V3390) (begin (kl:shen.bindv V3390 (quote ()) V3588) (let ((Result (let ((Hyp (cdr V3371))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))))) (begin (kl:shen.unbindv V3390 V3588) Result))) #f))) (if (kl:shen.pvar? V3389) (begin (kl:shen.bindv V3389 (quote ()) V3588) (let ((Result (let ((V3391 (kl:shen.lazyderef (cdr V3380) V3588))) (if (null? V3391) (let ((Hyp (cdr V3371))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))) (if (kl:shen.pvar? V3391) (begin (kl:shen.bindv V3391 (quote ()) V3588) (let ((Result (let ((Hyp (cdr V3371))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))))) (begin (kl:shen.unbindv V3391 V3588) Result))) #f))))) (begin (kl:shen.unbindv V3389 V3588) Result))) #f)))) (if (kl:shen.pvar? V3388) (let ((A (kl:shen.newpv V3588))) (begin (kl:shen.bindv V3388 (cons A (quote ())) V3588) (let ((Result (let ((V3392 (kl:shen.lazyderef (cdr V3380) V3588))) (if (null? V3392) (let ((Hyp (cdr V3371))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))) (if (kl:shen.pvar? V3392) (begin (kl:shen.bindv V3392 (quote ()) V3588) (let ((Result (let ((Hyp (cdr V3371))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))))) (begin (kl:shen.unbindv V3392 V3588) Result))) #f))))) (begin (kl:shen.unbindv V3388 V3588) Result)))) #f))))) (begin (kl:shen.unbindv V3382 V3588) Result))) #f))) (if (kl:shen.pvar? V3381) (let ((A (kl:shen.newpv V3588))) (begin (kl:shen.bindv V3381 (cons (quote vector) (cons A (quote ()))) V3588) (let ((Result (let ((V3393 (kl:shen.lazyderef (cdr V3380) V3588))) (if (null? V3393) (let ((Hyp (cdr V3371))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))) (if (kl:shen.pvar? V3393) (begin (kl:shen.bindv V3393 (quote ()) V3588) (let ((Result (let ((Hyp (cdr V3371))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))))) (begin (kl:shen.unbindv V3393 V3588) Result))) #f))))) (begin (kl:shen.unbindv V3381 V3588) Result)))) #f))) #f)) #f)) #f)) #f))) #f))) #f)) #f)) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3394 (kl:shen.lazyderef V3586 V3588))) (if (pair? V3394) (let ((V3395 (kl:shen.lazyderef (car V3394) V3588))) (if (pair? V3395) (let ((V3396 (kl:shen.lazyderef (car V3395) V3588))) (if (pair? V3396) (let ((V3397 (kl:shen.lazyderef (car V3396) V3588))) (if (eq? (quote _waspvm_at_s) V3397) (let ((V3398 (kl:shen.lazyderef (cdr V3396) V3588))) (if (pair? V3398) (let ((X (car V3398))) (let ((V3399 (kl:shen.lazyderef (cdr V3398) V3588))) (if (pair? V3399) (let ((Y (car V3399))) (let ((V3400 (kl:shen.lazyderef (cdr V3399) V3588))) (if (null? V3400) (let ((V3401 (kl:shen.lazyderef (cdr V3395) V3588))) (if (pair? V3401) (let ((V3402 (kl:shen.lazyderef (car V3401) V3588))) (if (eq? (quote :) V3402) (let ((V3403 (kl:shen.lazyderef (cdr V3401) V3588))) (if (pair? V3403) (let ((V3404 (kl:shen.lazyderef (car V3403) V3588))) (if (eq? (quote string) V3404) (let ((V3405 (kl:shen.lazyderef (cdr V3403) V3588))) (if (null? V3405) (let ((Hyp (cdr V3394))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (quote string) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (quote string) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))) (if (kl:shen.pvar? V3405) (begin (kl:shen.bindv V3405 (quote ()) V3588) (let ((Result (let ((Hyp (cdr V3394))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (quote string) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (quote string) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))))) (begin (kl:shen.unbindv V3405 V3588) Result))) #f))) (if (kl:shen.pvar? V3404) (begin (kl:shen.bindv V3404 (quote string) V3588) (let ((Result (let ((V3406 (kl:shen.lazyderef (cdr V3403) V3588))) (if (null? V3406) (let ((Hyp (cdr V3394))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (quote string) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (quote string) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))) (if (kl:shen.pvar? V3406) (begin (kl:shen.bindv V3406 (quote ()) V3588) (let ((Result (let ((Hyp (cdr V3394))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (quote string) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (quote string) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))))) (begin (kl:shen.unbindv V3406 V3588) Result))) #f))))) (begin (kl:shen.unbindv V3404 V3588) Result))) #f))) #f)) #f)) #f)) #f))) #f))) #f)) #f)) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((V3407 (kl:shen.lazyderef V3586 V3588))) (if (pair? V3407) (let ((X (car V3407))) (let ((Hyp (cdr V3407))) (let ((NewHyps (kl:shen.newpv V3588))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (kl:shen.lazyderef X V3588) (kl:shen.lazyderef NewHyps V3588)) V3588 (lambda () (kl:shen.t*-hyps Hyp NewHyps V3588 V3589))))))) #f)) Case)) Case)) Case)) Case))) (quote shen.t*-hyps)) -(begin (register-function-arity (quote shen.show) 4) (define (kl:shen.show V3606 V3607 V3608 V3609) (cond ((assert-boolean (kl:value (quote shen.*spy*))) (begin (kl:shen.line) (begin (kl:shen.show-p (kl:shen.deref V3606 V3608)) (begin (kl:nl 1) (begin (kl:nl 1) (begin (kl:shen.show-assumptions (kl:shen.deref V3607 V3608) 1) (begin (kl:shen.prhush "\n> " (kl:stoutput)) (begin (kl:shen.pause-for-user) (kl:thaw V3609))))))))) (#t (kl:thaw V3609)))) (quote shen.show)) -(begin (register-function-arity (quote shen.line) 0) (define (kl:shen.line) (let ((Infs (kl:inferences))) (kl:shen.prhush (string-append "____________________________________________________________ " (kl:shen.app Infs (string-append " inference" (kl:shen.app (if (kl:= 1 Infs) "" "s") " \n?- " (quote shen.a))) (quote shen.a))) (kl:stoutput)))) (quote shen.line)) -(begin (register-function-arity (quote shen.show-p) 1) (define (kl:shen.show-p V3611) (cond ((and (pair? V3611) (and (pair? (cdr V3611)) (and (eq? (quote :) (car (cdr V3611))) (and (pair? (cdr (cdr V3611))) (null? (cdr (cdr (cdr V3611)))))))) (kl:shen.prhush (kl:shen.app (car V3611) (string-append " : " (kl:shen.app (car (cdr (cdr V3611))) "" (quote shen.r))) (quote shen.r)) (kl:stoutput))) (#t (kl:shen.prhush (kl:shen.app V3611 "" (quote shen.r)) (kl:stoutput))))) (quote shen.show-p)) -(begin (register-function-arity (quote shen.show-assumptions) 2) (define (kl:shen.show-assumptions V3616 V3617) (cond ((null? V3616) (quote shen.skip)) ((pair? V3616) (begin (kl:shen.prhush (kl:shen.app V3617 ". " (quote shen.a)) (kl:stoutput)) (begin (kl:shen.show-p (car V3616)) (begin (kl:nl 1) (kl:shen.show-assumptions (cdr V3616) (+ V3617 1)))))) (#t (kl:shen.f_error (quote shen.show-assumptions))))) (quote shen.show-assumptions)) -(begin (register-function-arity (quote shen.pause-for-user) 0) (define (kl:shen.pause-for-user) (let ((Byte (read-u8 (kl:stinput)))) (if (kl:= Byte 94) (simple-error "input aborted\n") (kl:nl 1)))) (quote shen.pause-for-user)) -(begin (register-function-arity (quote shen.typedf?) 1) (define (kl:shen.typedf? V3619) (pair? (kl:assoc V3619 (kl:value (quote shen.*signedfuncs*))))) (quote shen.typedf?)) -(begin (register-function-arity (quote shen.sigf) 1) (define (kl:shen.sigf V3621) (kl:concat (quote shen.type-signature-of-) V3621)) (quote shen.sigf)) -(begin (register-function-arity (quote shen.placeholder) 0) (define (kl:shen.placeholder) (kl:gensym (quote &&))) (quote shen.placeholder)) -(begin (register-function-arity (quote shen.base) 4) (define (kl:shen.base V3626 V3627 V3628 V3629) (let ((Case (let ((V3310 (kl:shen.lazyderef V3627 V3628))) (if (eq? (quote number) V3310) (begin (kl:shen.incinfs) (kl:fwhen (number? (kl:shen.lazyderef V3626 V3628)) V3628 V3629)) (if (kl:shen.pvar? V3310) (begin (kl:shen.bindv V3310 (quote number) V3628) (let ((Result (begin (kl:shen.incinfs) (kl:fwhen (number? (kl:shen.lazyderef V3626 V3628)) V3628 V3629)))) (begin (kl:shen.unbindv V3310 V3628) Result))) #f))))) (if (kl:= Case #f) (let ((Case (let ((V3311 (kl:shen.lazyderef V3627 V3628))) (if (eq? (quote boolean) V3311) (begin (kl:shen.incinfs) (kl:fwhen (kl:boolean? (kl:shen.lazyderef V3626 V3628)) V3628 V3629)) (if (kl:shen.pvar? V3311) (begin (kl:shen.bindv V3311 (quote boolean) V3628) (let ((Result (begin (kl:shen.incinfs) (kl:fwhen (kl:boolean? (kl:shen.lazyderef V3626 V3628)) V3628 V3629)))) (begin (kl:shen.unbindv V3311 V3628) Result))) #f))))) (if (kl:= Case #f) (let ((Case (let ((V3312 (kl:shen.lazyderef V3627 V3628))) (if (eq? (quote string) V3312) (begin (kl:shen.incinfs) (kl:fwhen (string? (kl:shen.lazyderef V3626 V3628)) V3628 V3629)) (if (kl:shen.pvar? V3312) (begin (kl:shen.bindv V3312 (quote string) V3628) (let ((Result (begin (kl:shen.incinfs) (kl:fwhen (string? (kl:shen.lazyderef V3626 V3628)) V3628 V3629)))) (begin (kl:shen.unbindv V3312 V3628) Result))) #f))))) (if (kl:= Case #f) (let ((Case (let ((V3313 (kl:shen.lazyderef V3627 V3628))) (if (eq? (quote symbol) V3313) (begin (kl:shen.incinfs) (kl:fwhen (kl:symbol? (kl:shen.lazyderef V3626 V3628)) V3628 (lambda () (kl:fwhen (kl:not (kl:shen.ue? (kl:shen.lazyderef V3626 V3628))) V3628 V3629)))) (if (kl:shen.pvar? V3313) (begin (kl:shen.bindv V3313 (quote symbol) V3628) (let ((Result (begin (kl:shen.incinfs) (kl:fwhen (kl:symbol? (kl:shen.lazyderef V3626 V3628)) V3628 (lambda () (kl:fwhen (kl:not (kl:shen.ue? (kl:shen.lazyderef V3626 V3628))) V3628 V3629)))))) (begin (kl:shen.unbindv V3313 V3628) Result))) #f))))) (if (kl:= Case #f) (let ((V3314 (kl:shen.lazyderef V3626 V3628))) (if (null? V3314) (let ((V3315 (kl:shen.lazyderef V3627 V3628))) (if (pair? V3315) (let ((V3316 (kl:shen.lazyderef (car V3315) V3628))) (if (eq? (quote list) V3316) (let ((V3317 (kl:shen.lazyderef (cdr V3315) V3628))) (if (pair? V3317) (let ((A (car V3317))) (let ((V3318 (kl:shen.lazyderef (cdr V3317) V3628))) (if (null? V3318) (begin (kl:shen.incinfs) (kl:thaw V3629)) (if (kl:shen.pvar? V3318) (begin (kl:shen.bindv V3318 (quote ()) V3628) (let ((Result (begin (kl:shen.incinfs) (kl:thaw V3629)))) (begin (kl:shen.unbindv V3318 V3628) Result))) #f)))) (if (kl:shen.pvar? V3317) (let ((A (kl:shen.newpv V3628))) (begin (kl:shen.bindv V3317 (cons A (quote ())) V3628) (let ((Result (begin (kl:shen.incinfs) (kl:thaw V3629)))) (begin (kl:shen.unbindv V3317 V3628) Result)))) #f))) (if (kl:shen.pvar? V3316) (begin (kl:shen.bindv V3316 (quote list) V3628) (let ((Result (let ((V3319 (kl:shen.lazyderef (cdr V3315) V3628))) (if (pair? V3319) (let ((A (car V3319))) (let ((V3320 (kl:shen.lazyderef (cdr V3319) V3628))) (if (null? V3320) (begin (kl:shen.incinfs) (kl:thaw V3629)) (if (kl:shen.pvar? V3320) (begin (kl:shen.bindv V3320 (quote ()) V3628) (let ((Result (begin (kl:shen.incinfs) (kl:thaw V3629)))) (begin (kl:shen.unbindv V3320 V3628) Result))) #f)))) (if (kl:shen.pvar? V3319) (let ((A (kl:shen.newpv V3628))) (begin (kl:shen.bindv V3319 (cons A (quote ())) V3628) (let ((Result (begin (kl:shen.incinfs) (kl:thaw V3629)))) (begin (kl:shen.unbindv V3319 V3628) Result)))) #f))))) (begin (kl:shen.unbindv V3316 V3628) Result))) #f))) (if (kl:shen.pvar? V3315) (let ((A (kl:shen.newpv V3628))) (begin (kl:shen.bindv V3315 (cons (quote list) (cons A (quote ()))) V3628) (let ((Result (begin (kl:shen.incinfs) (kl:thaw V3629)))) (begin (kl:shen.unbindv V3315 V3628) Result)))) #f))) #f)) Case)) Case)) Case)) Case))) (quote shen.base)) -(begin (register-function-arity (quote shen.by_hypothesis) 5) (define (kl:shen.by_hypothesis V3635 V3636 V3637 V3638 V3639) (let ((Case (let ((V3301 (kl:shen.lazyderef V3637 V3638))) (if (pair? V3301) (let ((V3302 (kl:shen.lazyderef (car V3301) V3638))) (if (pair? V3302) (let ((Y (car V3302))) (let ((V3303 (kl:shen.lazyderef (cdr V3302) V3638))) (if (pair? V3303) (let ((V3304 (kl:shen.lazyderef (car V3303) V3638))) (if (eq? (quote :) V3304) (let ((V3305 (kl:shen.lazyderef (cdr V3303) V3638))) (if (pair? V3305) (let ((B (car V3305))) (let ((V3306 (kl:shen.lazyderef (cdr V3305) V3638))) (if (null? V3306) (begin (kl:shen.incinfs) (kl:identical V3635 Y V3638 (lambda () (kl:unify! V3636 B V3638 V3639)))) #f))) #f)) #f)) #f))) #f)) #f)))) (if (kl:= Case #f) (let ((V3307 (kl:shen.lazyderef V3637 V3638))) (if (pair? V3307) (let ((Hyp (cdr V3307))) (begin (kl:shen.incinfs) (kl:shen.by_hypothesis V3635 V3636 Hyp V3638 V3639))) #f)) Case))) (quote shen.by_hypothesis)) -(begin (register-function-arity (quote shen.t*-def) 5) (define (kl:shen.t*-def V3645 V3646 V3647 V3648 V3649) (let ((V3295 (kl:shen.lazyderef V3645 V3648))) (if (pair? V3295) (let ((V3296 (kl:shen.lazyderef (car V3295) V3648))) (if (eq? (quote define) V3296) (let ((V3297 (kl:shen.lazyderef (cdr V3295) V3648))) (if (pair? V3297) (let ((F (car V3297))) (let ((X (cdr V3297))) (let ((Y (kl:shen.newpv V3648))) (let ((E (kl:shen.newpv V3648))) (begin (kl:shen.incinfs) (kl:shen.t*-defh (kl:compile (lambda (Y) (kl:shen. Y)) X (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")))) F V3646 V3647 V3648 V3649)))))) #f)) #f)) #f))) (quote shen.t*-def)) -(begin (register-function-arity (quote shen.t*-defh) 6) (define (kl:shen.t*-defh V3656 V3657 V3658 V3659 V3660 V3661) (let ((V3291 (kl:shen.lazyderef V3656 V3660))) (if (pair? V3291) (let ((Sig (car V3291))) (let ((Rules (cdr V3291))) (begin (kl:shen.incinfs) (kl:shen.t*-defhh Sig (kl:shen.ue-sig Sig) V3657 V3658 V3659 Rules V3660 V3661)))) #f))) (quote shen.t*-defh)) -(begin (register-function-arity (quote shen.t*-defhh) 8) (define (kl:shen.t*-defhh V3670 V3671 V3672 V3673 V3674 V3675 V3676 V3677) (begin (kl:shen.incinfs) (kl:shen.t*-rules V3675 V3671 1 V3672 (cons (cons V3672 (cons (quote :) (cons V3671 (quote ())))) V3674) V3676 (lambda () (kl:shen.memo V3672 V3670 V3673 V3676 V3677))))) (quote shen.t*-defhh)) -(begin (register-function-arity (quote shen.memo) 5) (define (kl:shen.memo V3683 V3684 V3685 V3686 V3687) (let ((Jnk (kl:shen.newpv V3686))) (begin (kl:shen.incinfs) (kl:unify! V3685 V3684 V3686 (lambda () (kl:bind Jnk (kl:declare (kl:shen.lazyderef V3683 V3686) (kl:shen.lazyderef V3685 V3686)) V3686 V3687)))))) (quote shen.memo)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V3689) (let ((Parse_shen. (kl:shen. V3689))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail)))) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V3691) (let ((YaccParse (let ((Parse_shen. (kl:shen. V3691))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_shen. (kl:shen. V3691))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (quote ()))) (kl:fail))) YaccParse))) (quote shen.)) -(begin (register-function-arity (quote shen.ue) 1) (define (kl:shen.ue V3693) (cond ((and (pair? V3693) (and (pair? (cdr V3693)) (and (null? (cdr (cdr V3693))) (eq? (car V3693) (quote protect))))) V3693) ((pair? V3693) (kl:map (lambda (Z) (kl:shen.ue Z)) V3693)) ((kl:variable? V3693) (kl:concat (quote &&) V3693)) (#t V3693))) (quote shen.ue)) -(begin (register-function-arity (quote shen.ue-sig) 1) (define (kl:shen.ue-sig V3695) (cond ((pair? V3695) (kl:map (lambda (Z) (kl:shen.ue-sig Z)) V3695)) ((kl:variable? V3695) (kl:concat (quote &&&) V3695)) (#t V3695))) (quote shen.ue-sig)) -(begin (register-function-arity (quote shen.ues) 1) (define (kl:shen.ues V3701) (cond ((assert-boolean (kl:shen.ue? V3701)) (cons V3701 (quote ()))) ((pair? V3701) (kl:union (kl:shen.ues (car V3701)) (kl:shen.ues (cdr V3701)))) (#t (quote ())))) (quote shen.ues)) -(begin (register-function-arity (quote shen.ue?) 1) (define (kl:shen.ue? V3703) (and (kl:symbol? V3703) (assert-boolean (kl:shen.ue-h? (kl:str V3703))))) (quote shen.ue?)) -(begin (register-function-arity (quote shen.ue-h?) 1) (define (kl:shen.ue-h? V3711) (cond ((and (assert-boolean (kl:shen.+string? V3711)) (and (equal? "&" (make-string 1 (string-ref V3711 0))) (and (assert-boolean (kl:shen.+string? (string-tail V3711 1))) (equal? "&" (make-string 1 (string-ref (string-tail V3711 1) 0)))))) #t) (#t #f))) (quote shen.ue-h?)) -(begin (register-function-arity (quote shen.t*-rules) 7) (define (kl:shen.t*-rules V3719 V3720 V3721 V3722 V3723 V3724 V3725) (let ((Throwcontrol (kl:shen.catchpoint))) (kl:shen.cutpoint Throwcontrol (let ((Case (let ((V3275 (kl:shen.lazyderef V3719 V3724))) (if (null? V3275) (begin (kl:shen.incinfs) (kl:thaw V3725)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3276 (kl:shen.lazyderef V3719 V3724))) (if (pair? V3276) (let ((Rule (car V3276))) (let ((Rules (cdr V3276))) (begin (kl:shen.incinfs) (kl:shen.t*-rule (kl:shen.ue Rule) V3720 V3723 V3724 (lambda () (kl:cut Throwcontrol V3724 (lambda () (kl:shen.t*-rules Rules V3720 (+ V3721 1) V3722 V3723 V3724 V3725)))))))) #f)))) (if (kl:= Case #f) (let ((Err (kl:shen.newpv V3724))) (begin (kl:shen.incinfs) (kl:bind Err (simple-error (string-append "type error in rule " (kl:shen.app (kl:shen.lazyderef V3721 V3724) (string-append " of " (kl:shen.app (kl:shen.lazyderef V3722 V3724) "" (quote shen.a))) (quote shen.a)))) V3724 V3725))) Case)) Case))))) (quote shen.t*-rules)) -(begin (register-function-arity (quote shen.t*-rule) 5) (define (kl:shen.t*-rule V3731 V3732 V3733 V3734 V3735) (let ((Throwcontrol (kl:shen.catchpoint))) (kl:shen.cutpoint Throwcontrol (let ((V3267 (kl:shen.lazyderef V3731 V3734))) (if (pair? V3267) (let ((Patterns (car V3267))) (let ((V3268 (kl:shen.lazyderef (cdr V3267) V3734))) (if (pair? V3268) (let ((Action (car V3268))) (let ((V3269 (kl:shen.lazyderef (cdr V3268) V3734))) (if (null? V3269) (let ((NewHyps (kl:shen.newpv V3734))) (begin (kl:shen.incinfs) (kl:shen.newhyps (kl:shen.placeholders Patterns) V3733 NewHyps V3734 (lambda () (kl:shen.t*-patterns Patterns V3732 NewHyps V3734 (lambda () (kl:cut Throwcontrol V3734 (lambda () (kl:shen.t*-action (kl:shen.curry (kl:shen.ue Action)) (kl:shen.result-type Patterns V3732) (kl:shen.patthyps Patterns V3732 V3733) V3734 V3735))))))))) #f))) #f))) #f))))) (quote shen.t*-rule)) -(begin (register-function-arity (quote shen.placeholders) 1) (define (kl:shen.placeholders V3741) (cond ((assert-boolean (kl:shen.ue? V3741)) (cons V3741 (quote ()))) ((pair? V3741) (kl:union (kl:shen.placeholders (car V3741)) (kl:shen.placeholders (cdr V3741)))) (#t (quote ())))) (quote shen.placeholders)) -(begin (register-function-arity (quote shen.newhyps) 5) (define (kl:shen.newhyps V3747 V3748 V3749 V3750 V3751) (let ((Case (let ((V3254 (kl:shen.lazyderef V3747 V3750))) (if (null? V3254) (begin (kl:shen.incinfs) (kl:unify! V3749 V3748 V3750 V3751)) #f)))) (if (kl:= Case #f) (let ((V3255 (kl:shen.lazyderef V3747 V3750))) (if (pair? V3255) (let ((V3250 (car V3255))) (let ((Vs (cdr V3255))) (let ((V3256 (kl:shen.lazyderef V3749 V3750))) (if (pair? V3256) (let ((V3257 (kl:shen.lazyderef (car V3256) V3750))) (if (pair? V3257) (let ((V (car V3257))) (let ((V3258 (kl:shen.lazyderef (cdr V3257) V3750))) (if (pair? V3258) (let ((V3259 (kl:shen.lazyderef (car V3258) V3750))) (if (eq? (quote :) V3259) (let ((V3260 (kl:shen.lazyderef (cdr V3258) V3750))) (if (pair? V3260) (let ((A (car V3260))) (let ((V3261 (kl:shen.lazyderef (cdr V3260) V3750))) (if (null? V3261) (let ((NewHyp (cdr V3256))) (begin (kl:shen.incinfs) (kl:unify! V V3250 V3750 (lambda () (kl:shen.newhyps Vs V3748 NewHyp V3750 V3751))))) (if (kl:shen.pvar? V3261) (begin (kl:shen.bindv V3261 (quote ()) V3750) (let ((Result (let ((NewHyp (cdr V3256))) (begin (kl:shen.incinfs) (kl:unify! V V3250 V3750 (lambda () (kl:shen.newhyps Vs V3748 NewHyp V3750 V3751))))))) (begin (kl:shen.unbindv V3261 V3750) Result))) #f)))) (if (kl:shen.pvar? V3260) (let ((A (kl:shen.newpv V3750))) (begin (kl:shen.bindv V3260 (cons A (quote ())) V3750) (let ((Result (let ((NewHyp (cdr V3256))) (begin (kl:shen.incinfs) (kl:unify! V V3250 V3750 (lambda () (kl:shen.newhyps Vs V3748 NewHyp V3750 V3751))))))) (begin (kl:shen.unbindv V3260 V3750) Result)))) #f))) (if (kl:shen.pvar? V3259) (begin (kl:shen.bindv V3259 (quote :) V3750) (let ((Result (let ((V3262 (kl:shen.lazyderef (cdr V3258) V3750))) (if (pair? V3262) (let ((A (car V3262))) (let ((V3263 (kl:shen.lazyderef (cdr V3262) V3750))) (if (null? V3263) (let ((NewHyp (cdr V3256))) (begin (kl:shen.incinfs) (kl:unify! V V3250 V3750 (lambda () (kl:shen.newhyps Vs V3748 NewHyp V3750 V3751))))) (if (kl:shen.pvar? V3263) (begin (kl:shen.bindv V3263 (quote ()) V3750) (let ((Result (let ((NewHyp (cdr V3256))) (begin (kl:shen.incinfs) (kl:unify! V V3250 V3750 (lambda () (kl:shen.newhyps Vs V3748 NewHyp V3750 V3751))))))) (begin (kl:shen.unbindv V3263 V3750) Result))) #f)))) (if (kl:shen.pvar? V3262) (let ((A (kl:shen.newpv V3750))) (begin (kl:shen.bindv V3262 (cons A (quote ())) V3750) (let ((Result (let ((NewHyp (cdr V3256))) (begin (kl:shen.incinfs) (kl:unify! V V3250 V3750 (lambda () (kl:shen.newhyps Vs V3748 NewHyp V3750 V3751))))))) (begin (kl:shen.unbindv V3262 V3750) Result)))) #f))))) (begin (kl:shen.unbindv V3259 V3750) Result))) #f))) (if (kl:shen.pvar? V3258) (let ((A (kl:shen.newpv V3750))) (begin (kl:shen.bindv V3258 (cons (quote :) (cons A (quote ()))) V3750) (let ((Result (let ((NewHyp (cdr V3256))) (begin (kl:shen.incinfs) (kl:unify! V V3250 V3750 (lambda () (kl:shen.newhyps Vs V3748 NewHyp V3750 V3751))))))) (begin (kl:shen.unbindv V3258 V3750) Result)))) #f)))) (if (kl:shen.pvar? V3257) (let ((V (kl:shen.newpv V3750))) (let ((A (kl:shen.newpv V3750))) (begin (kl:shen.bindv V3257 (cons V (cons (quote :) (cons A (quote ())))) V3750) (let ((Result (let ((NewHyp (cdr V3256))) (begin (kl:shen.incinfs) (kl:unify! V V3250 V3750 (lambda () (kl:shen.newhyps Vs V3748 NewHyp V3750 V3751))))))) (begin (kl:shen.unbindv V3257 V3750) Result))))) #f))) (if (kl:shen.pvar? V3256) (let ((V (kl:shen.newpv V3750))) (let ((A (kl:shen.newpv V3750))) (let ((NewHyp (kl:shen.newpv V3750))) (begin (kl:shen.bindv V3256 (cons (cons V (cons (quote :) (cons A (quote ())))) NewHyp) V3750) (let ((Result (begin (kl:shen.incinfs) (kl:unify! V V3250 V3750 (lambda () (kl:shen.newhyps Vs V3748 NewHyp V3750 V3751)))))) (begin (kl:shen.unbindv V3256 V3750) Result)))))) #f))))) #f)) Case))) (quote shen.newhyps)) -(begin (register-function-arity (quote shen.patthyps) 3) (define (kl:shen.patthyps V3757 V3758 V3759) (cond ((null? V3757) V3759) ((and (pair? V3757) (and (pair? V3758) (and (pair? (cdr V3758)) (and (eq? (quote -->) (car (cdr V3758))) (and (pair? (cdr (cdr V3758))) (null? (cdr (cdr (cdr V3758))))))))) (kl:adjoin (cons (car V3757) (cons (quote :) (cons (car V3758) (quote ())))) (kl:shen.patthyps (cdr V3757) (car (cdr (cdr V3758))) V3759))) (#t (kl:shen.f_error (quote shen.patthyps))))) (quote shen.patthyps)) -(begin (register-function-arity (quote shen.result-type) 2) (define (kl:shen.result-type V3766 V3767) (cond ((and (null? V3766) (and (pair? V3767) (and (eq? (quote -->) (car V3767)) (and (pair? (cdr V3767)) (null? (cdr (cdr V3767))))))) (car (cdr V3767))) ((null? V3766) V3767) ((and (pair? V3766) (and (pair? V3767) (and (pair? (cdr V3767)) (and (eq? (quote -->) (car (cdr V3767))) (and (pair? (cdr (cdr V3767))) (null? (cdr (cdr (cdr V3767))))))))) (kl:shen.result-type (cdr V3766) (car (cdr (cdr V3767))))) (#t (kl:shen.f_error (quote shen.result-type))))) (quote shen.result-type)) -(begin (register-function-arity (quote shen.t*-patterns) 5) (define (kl:shen.t*-patterns V3773 V3774 V3775 V3776 V3777) (let ((Case (let ((V3242 (kl:shen.lazyderef V3773 V3776))) (if (null? V3242) (begin (kl:shen.incinfs) (kl:thaw V3777)) #f)))) (if (kl:= Case #f) (let ((V3243 (kl:shen.lazyderef V3773 V3776))) (if (pair? V3243) (let ((Pattern (car V3243))) (let ((Patterns (cdr V3243))) (let ((V3244 (kl:shen.lazyderef V3774 V3776))) (if (pair? V3244) (let ((A (car V3244))) (let ((V3245 (kl:shen.lazyderef (cdr V3244) V3776))) (if (pair? V3245) (let ((V3246 (kl:shen.lazyderef (car V3245) V3776))) (if (eq? (quote -->) V3246) (let ((V3247 (kl:shen.lazyderef (cdr V3245) V3776))) (if (pair? V3247) (let ((B (car V3247))) (let ((V3248 (kl:shen.lazyderef (cdr V3247) V3776))) (if (null? V3248) (begin (kl:shen.incinfs) (kl:shen.t* (cons Pattern (cons (quote :) (cons A (quote ())))) V3775 V3776 (lambda () (kl:shen.t*-patterns Patterns B V3775 V3776 V3777)))) #f))) #f)) #f)) #f))) #f)))) #f)) Case))) (quote shen.t*-patterns)) -(begin (register-function-arity (quote shen.t*-action) 5) (define (kl:shen.t*-action V3783 V3784 V3785 V3786 V3787) (let ((Throwcontrol (kl:shen.catchpoint))) (kl:shen.cutpoint Throwcontrol (let ((Case (let ((V3219 (kl:shen.lazyderef V3783 V3786))) (if (pair? V3219) (let ((V3220 (kl:shen.lazyderef (car V3219) V3786))) (if (eq? (quote where) V3220) (let ((V3221 (kl:shen.lazyderef (cdr V3219) V3786))) (if (pair? V3221) (let ((P (car V3221))) (let ((V3222 (kl:shen.lazyderef (cdr V3221) V3786))) (if (pair? V3222) (let ((Action (car V3222))) (let ((V3223 (kl:shen.lazyderef (cdr V3222) V3786))) (if (null? V3223) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V3786 (lambda () (kl:shen.t* (cons P (cons (quote :) (cons (quote boolean) (quote ())))) V3785 V3786 (lambda () (kl:cut Throwcontrol V3786 (lambda () (kl:shen.t*-action Action V3784 (cons (cons P (cons (quote :) (cons (quote verified) (quote ())))) V3785) V3786 V3787)))))))) #f))) #f))) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3224 (kl:shen.lazyderef V3783 V3786))) (if (pair? V3224) (let ((V3225 (kl:shen.lazyderef (car V3224) V3786))) (if (eq? (quote shen.choicepoint!) V3225) (let ((V3226 (kl:shen.lazyderef (cdr V3224) V3786))) (if (pair? V3226) (let ((V3227 (kl:shen.lazyderef (car V3226) V3786))) (if (pair? V3227) (let ((V3228 (kl:shen.lazyderef (car V3227) V3786))) (if (pair? V3228) (let ((V3229 (kl:shen.lazyderef (car V3228) V3786))) (if (eq? (quote fail-if) V3229) (let ((V3230 (kl:shen.lazyderef (cdr V3228) V3786))) (if (pair? V3230) (let ((F (car V3230))) (let ((V3231 (kl:shen.lazyderef (cdr V3230) V3786))) (if (null? V3231) (let ((V3232 (kl:shen.lazyderef (cdr V3227) V3786))) (if (pair? V3232) (let ((Action (car V3232))) (let ((V3233 (kl:shen.lazyderef (cdr V3232) V3786))) (if (null? V3233) (let ((V3234 (kl:shen.lazyderef (cdr V3226) V3786))) (if (null? V3234) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V3786 (lambda () (kl:shen.t*-action (cons (quote where) (cons (cons (quote not) (cons (cons F (cons Action (quote ()))) (quote ()))) (cons Action (quote ())))) V3784 V3785 V3786 V3787)))) #f)) #f))) #f)) #f))) #f)) #f)) #f)) #f)) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3235 (kl:shen.lazyderef V3783 V3786))) (if (pair? V3235) (let ((V3236 (kl:shen.lazyderef (car V3235) V3786))) (if (eq? (quote shen.choicepoint!) V3236) (let ((V3237 (kl:shen.lazyderef (cdr V3235) V3786))) (if (pair? V3237) (let ((Action (car V3237))) (let ((V3238 (kl:shen.lazyderef (cdr V3237) V3786))) (if (null? V3238) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V3786 (lambda () (kl:shen.t*-action (cons (quote where) (cons (cons (quote not) (cons (cons (cons (quote =) (cons Action (quote ()))) (cons (cons (quote fail) (quote ())) (quote ()))) (quote ()))) (cons Action (quote ())))) V3784 V3785 V3786 V3787)))) #f))) #f)) #f)) #f)))) (if (kl:= Case #f) (begin (kl:shen.incinfs) (kl:shen.t* (cons V3783 (cons (quote :) (cons V3784 (quote ())))) V3785 V3786 V3787)) Case)) Case)) Case))))) (quote shen.t*-action)) -(begin (register-function-arity (quote findall) 5) (define (kl:findall V3793 V3794 V3795 V3796 V3797) (let ((B (kl:shen.newpv V3796))) (let ((A (kl:shen.newpv V3796))) (begin (kl:shen.incinfs) (kl:bind A (kl:gensym (quote shen.a)) V3796 (lambda () (kl:bind B (kl:set (kl:shen.lazyderef A V3796) (quote ())) V3796 (lambda () (kl:shen.findallhelp V3793 V3794 V3795 A V3796 V3797))))))))) (quote findall)) -(begin (register-function-arity (quote shen.findallhelp) 6) (define (kl:shen.findallhelp V3804 V3805 V3806 V3807 V3808 V3809) (let ((Case (begin (kl:shen.incinfs) (kl:call V3805 V3808 (lambda () (kl:shen.remember V3807 V3804 V3808 (lambda () (kl:fwhen #f V3808 V3809)))))))) (if (kl:= Case #f) (begin (kl:shen.incinfs) (kl:bind V3806 (kl:value (kl:shen.lazyderef V3807 V3808)) V3808 V3809)) Case))) (quote shen.findallhelp)) -(begin (register-function-arity (quote shen.remember) 4) (define (kl:shen.remember V3814 V3815 V3816 V3817) (let ((B (kl:shen.newpv V3816))) (begin (kl:shen.incinfs) (kl:bind B (kl:set (kl:shen.deref V3814 V3816) (cons (kl:shen.deref V3815 V3816) (kl:value (kl:shen.deref V3814 V3816)))) V3816 V3817)))) (quote shen.remember)) +(begin (register-function-arity (quote shen.typecheck) 2) (define (kl:shen.typecheck V3528 V3529) (let ((Curry (kl:shen.curry V3528))) (let ((ProcessN (kl:shen.start-new-prolog-process))) (let ((Type (kl:shen.insert-prolog-variables (kl:shen.demodulate (kl:shen.curry-type V3529)) ProcessN))) (let ((Continuation (lambda () (kl:return Type ProcessN (quote shen.void))))) (kl:shen.t* (cons Curry (cons (quote :) (cons Type (quote ())))) (quote ()) ProcessN Continuation)))))) (export shen.typecheck) (quote shen.typecheck)) +(begin (register-function-arity (quote shen.curry) 1) (define (kl:shen.curry V3531) (cond ((and (pair? V3531) (assert-boolean (kl:shen.special? (car V3531)))) (cons (car V3531) (kl:map (lambda (Y) (kl:shen.curry Y)) (cdr V3531)))) ((and (pair? V3531) (and (pair? (cdr V3531)) (assert-boolean (kl:shen.extraspecial? (car V3531))))) V3531) ((and (pair? V3531) (and (eq? (quote type) (car V3531)) (and (pair? (cdr V3531)) (and (pair? (cdr (cdr V3531))) (null? (cdr (cdr (cdr V3531)))))))) (cons (quote type) (cons (kl:shen.curry (car (cdr V3531))) (cdr (cdr V3531))))) ((and (pair? V3531) (and (pair? (cdr V3531)) (pair? (cdr (cdr V3531))))) (kl:shen.curry (cons (cons (car V3531) (cons (car (cdr V3531)) (quote ()))) (cdr (cdr V3531))))) ((and (pair? V3531) (and (pair? (cdr V3531)) (null? (cdr (cdr V3531))))) (cons (kl:shen.curry (car V3531)) (cons (kl:shen.curry (car (cdr V3531))) (quote ())))) (#t V3531))) (export shen.curry) (quote shen.curry)) +(begin (register-function-arity (quote shen.special?) 1) (define (kl:shen.special? V3533) (kl:element? V3533 (kl:value (quote shen.*special*)))) (export shen.special?) (quote shen.special?)) +(begin (register-function-arity (quote shen.extraspecial?) 1) (define (kl:shen.extraspecial? V3535) (kl:element? V3535 (kl:value (quote shen.*extraspecial*)))) (export shen.extraspecial?) (quote shen.extraspecial?)) +(begin (register-function-arity (quote shen.t*) 4) (define (kl:shen.t* V3540 V3541 V3542 V3543) (let ((Throwcontrol (kl:shen.catchpoint))) (kl:shen.cutpoint Throwcontrol (let ((Case (let ((Error (kl:shen.newpv V3542))) (begin (kl:shen.incinfs) (kl:fwhen (kl:shen.maxinfexceeded?) V3542 (lambda () (kl:bind Error (kl:shen.errormaxinfs) V3542 V3543))))))) (if (kl:= Case #f) (let ((Case (let ((V3520 (kl:shen.lazyderef V3540 V3542))) (if (eq? (quote fail) V3520) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V3542 (lambda () (kl:shen.prolog-failure V3542 V3543)))) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3521 (kl:shen.lazyderef V3540 V3542))) (if (pair? V3521) (let ((X (car V3521))) (let ((V3522 (kl:shen.lazyderef (cdr V3521) V3542))) (if (pair? V3522) (let ((V3523 (kl:shen.lazyderef (car V3522) V3542))) (if (eq? (quote :) V3523) (let ((V3524 (kl:shen.lazyderef (cdr V3522) V3542))) (if (pair? V3524) (let ((A (car V3524))) (let ((V3525 (kl:shen.lazyderef (cdr V3524) V3542))) (if (null? V3525) (begin (kl:shen.incinfs) (kl:fwhen (kl:shen.type-theory-enabled?) V3542 (lambda () (kl:cut Throwcontrol V3542 (lambda () (kl:shen.th* X A V3541 V3542 V3543)))))) #f))) #f)) #f)) #f))) #f)))) (if (kl:= Case #f) (let ((Datatypes (kl:shen.newpv V3542))) (begin (kl:shen.incinfs) (kl:shen.show V3540 V3541 V3542 (lambda () (kl:bind Datatypes (kl:value (quote shen.*datatypes*)) V3542 (lambda () (kl:shen.udefs* V3540 V3541 Datatypes V3542 V3543))))))) Case)) Case)) Case))))) (export shen.t*) (quote shen.t*)) +(begin (register-function-arity (quote shen.type-theory-enabled?) 0) (define (kl:shen.type-theory-enabled?) (kl:value (quote shen.*shen-type-theory-enabled?*))) (export shen.type-theory-enabled?) (quote shen.type-theory-enabled?)) +(begin (register-function-arity (quote enable-type-theory) 1) (define (kl:enable-type-theory V3549) (cond ((eq? (quote +) V3549) (kl:set (quote shen.*shen-type-theory-enabled?*) #t)) ((eq? (quote -) V3549) (kl:set (quote shen.*shen-type-theory-enabled?*) #f)) (#t (simple-error "enable-type-theory expects a + or a -\n")))) (export enable-type-theory) (quote enable-type-theory)) +(begin (register-function-arity (quote shen.prolog-failure) 2) (define (kl:shen.prolog-failure V3560 V3561) #f) (export shen.prolog-failure) (quote shen.prolog-failure)) +(begin (register-function-arity (quote shen.maxinfexceeded?) 0) (define (kl:shen.maxinfexceeded?) (> (kl:inferences) (kl:value (quote shen.*maxinferences*)))) (export shen.maxinfexceeded?) (quote shen.maxinfexceeded?)) +(begin (register-function-arity (quote shen.errormaxinfs) 0) (define (kl:shen.errormaxinfs) (simple-error "maximum inferences exceeded~%")) (export shen.errormaxinfs) (quote shen.errormaxinfs)) +(begin (register-function-arity (quote shen.udefs*) 5) (define (kl:shen.udefs* V3567 V3568 V3569 V3570 V3571) (let ((Case (let ((V3516 (kl:shen.lazyderef V3569 V3570))) (if (pair? V3516) (let ((D (car V3516))) (begin (kl:shen.incinfs) (kl:call (cons D (cons V3567 (cons V3568 (quote ())))) V3570 V3571))) #f)))) (if (kl:= Case #f) (let ((V3517 (kl:shen.lazyderef V3569 V3570))) (if (pair? V3517) (let ((Ds (cdr V3517))) (begin (kl:shen.incinfs) (kl:shen.udefs* V3567 V3568 Ds V3570 V3571))) #f)) Case))) (export shen.udefs*) (quote shen.udefs*)) +(begin (register-function-arity (quote shen.th*) 5) (define (kl:shen.th* V3577 V3578 V3579 V3580 V3581) (let ((Throwcontrol (kl:shen.catchpoint))) (kl:shen.cutpoint Throwcontrol (let ((Case (begin (kl:shen.incinfs) (kl:shen.show (cons V3577 (cons (quote :) (cons V3578 (quote ())))) V3579 V3580 (lambda () (kl:fwhen #f V3580 V3581)))))) (if (kl:= Case #f) (let ((Case (let ((F (kl:shen.newpv V3580))) (begin (kl:shen.incinfs) (kl:fwhen (kl:shen.typedf? (kl:shen.lazyderef V3577 V3580)) V3580 (lambda () (kl:bind F (kl:shen.sigf (kl:shen.lazyderef V3577 V3580)) V3580 (lambda () (kl:call (cons F (cons V3578 (quote ()))) V3580 V3581))))))))) (if (kl:= Case #f) (let ((Case (begin (kl:shen.incinfs) (kl:shen.base V3577 V3578 V3580 V3581)))) (if (kl:= Case #f) (let ((Case (begin (kl:shen.incinfs) (kl:shen.by_hypothesis V3577 V3578 V3579 V3580 V3581)))) (if (kl:= Case #f) (let ((Case (let ((V3412 (kl:shen.lazyderef V3577 V3580))) (if (pair? V3412) (let ((F (car V3412))) (let ((V3413 (kl:shen.lazyderef (cdr V3412) V3580))) (if (null? V3413) (begin (kl:shen.incinfs) (kl:shen.th* F (cons (quote -->) (cons V3578 (quote ()))) V3579 V3580 V3581)) #f))) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3414 (kl:shen.lazyderef V3577 V3580))) (if (pair? V3414) (let ((F (car V3414))) (let ((V3415 (kl:shen.lazyderef (cdr V3414) V3580))) (if (pair? V3415) (let ((X (car V3415))) (let ((V3416 (kl:shen.lazyderef (cdr V3415) V3580))) (if (null? V3416) (let ((B (kl:shen.newpv V3580))) (begin (kl:shen.incinfs) (kl:shen.th* F (cons B (cons (quote -->) (cons V3578 (quote ())))) V3579 V3580 (lambda () (kl:shen.th* X B V3579 V3580 V3581))))) #f))) #f))) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3417 (kl:shen.lazyderef V3577 V3580))) (if (pair? V3417) (let ((V3418 (kl:shen.lazyderef (car V3417) V3580))) (if (eq? (quote cons) V3418) (let ((V3419 (kl:shen.lazyderef (cdr V3417) V3580))) (if (pair? V3419) (let ((X (car V3419))) (let ((V3420 (kl:shen.lazyderef (cdr V3419) V3580))) (if (pair? V3420) (let ((Y (car V3420))) (let ((V3421 (kl:shen.lazyderef (cdr V3420) V3580))) (if (null? V3421) (let ((V3422 (kl:shen.lazyderef V3578 V3580))) (if (pair? V3422) (let ((V3423 (kl:shen.lazyderef (car V3422) V3580))) (if (eq? (quote list) V3423) (let ((V3424 (kl:shen.lazyderef (cdr V3422) V3580))) (if (pair? V3424) (let ((A (car V3424))) (let ((V3425 (kl:shen.lazyderef (cdr V3424) V3580))) (if (null? V3425) (begin (kl:shen.incinfs) (kl:shen.th* X A V3579 V3580 (lambda () (kl:shen.th* Y (cons (quote list) (cons A (quote ()))) V3579 V3580 V3581)))) (if (kl:shen.pvar? V3425) (begin (kl:shen.bindv V3425 (quote ()) V3580) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V3579 V3580 (lambda () (kl:shen.th* Y (cons (quote list) (cons A (quote ()))) V3579 V3580 V3581)))))) (begin (kl:shen.unbindv V3425 V3580) Result))) #f)))) (if (kl:shen.pvar? V3424) (let ((A (kl:shen.newpv V3580))) (begin (kl:shen.bindv V3424 (cons A (quote ())) V3580) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V3579 V3580 (lambda () (kl:shen.th* Y (cons (quote list) (cons A (quote ()))) V3579 V3580 V3581)))))) (begin (kl:shen.unbindv V3424 V3580) Result)))) #f))) (if (kl:shen.pvar? V3423) (begin (kl:shen.bindv V3423 (quote list) V3580) (let ((Result (let ((V3426 (kl:shen.lazyderef (cdr V3422) V3580))) (if (pair? V3426) (let ((A (car V3426))) (let ((V3427 (kl:shen.lazyderef (cdr V3426) V3580))) (if (null? V3427) (begin (kl:shen.incinfs) (kl:shen.th* X A V3579 V3580 (lambda () (kl:shen.th* Y (cons (quote list) (cons A (quote ()))) V3579 V3580 V3581)))) (if (kl:shen.pvar? V3427) (begin (kl:shen.bindv V3427 (quote ()) V3580) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V3579 V3580 (lambda () (kl:shen.th* Y (cons (quote list) (cons A (quote ()))) V3579 V3580 V3581)))))) (begin (kl:shen.unbindv V3427 V3580) Result))) #f)))) (if (kl:shen.pvar? V3426) (let ((A (kl:shen.newpv V3580))) (begin (kl:shen.bindv V3426 (cons A (quote ())) V3580) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V3579 V3580 (lambda () (kl:shen.th* Y (cons (quote list) (cons A (quote ()))) V3579 V3580 V3581)))))) (begin (kl:shen.unbindv V3426 V3580) Result)))) #f))))) (begin (kl:shen.unbindv V3423 V3580) Result))) #f))) (if (kl:shen.pvar? V3422) (let ((A (kl:shen.newpv V3580))) (begin (kl:shen.bindv V3422 (cons (quote list) (cons A (quote ()))) V3580) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V3579 V3580 (lambda () (kl:shen.th* Y (cons (quote list) (cons A (quote ()))) V3579 V3580 V3581)))))) (begin (kl:shen.unbindv V3422 V3580) Result)))) #f))) #f))) #f))) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3428 (kl:shen.lazyderef V3577 V3580))) (if (pair? V3428) (let ((V3429 (kl:shen.lazyderef (car V3428) V3580))) (if (eq? (quote _waspvm_at_p) V3429) (let ((V3430 (kl:shen.lazyderef (cdr V3428) V3580))) (if (pair? V3430) (let ((X (car V3430))) (let ((V3431 (kl:shen.lazyderef (cdr V3430) V3580))) (if (pair? V3431) (let ((Y (car V3431))) (let ((V3432 (kl:shen.lazyderef (cdr V3431) V3580))) (if (null? V3432) (let ((V3433 (kl:shen.lazyderef V3578 V3580))) (if (pair? V3433) (let ((A (car V3433))) (let ((V3434 (kl:shen.lazyderef (cdr V3433) V3580))) (if (pair? V3434) (let ((V3435 (kl:shen.lazyderef (car V3434) V3580))) (if (eq? (quote *) V3435) (let ((V3436 (kl:shen.lazyderef (cdr V3434) V3580))) (if (pair? V3436) (let ((B (car V3436))) (let ((V3437 (kl:shen.lazyderef (cdr V3436) V3580))) (if (null? V3437) (begin (kl:shen.incinfs) (kl:shen.th* X A V3579 V3580 (lambda () (kl:shen.th* Y B V3579 V3580 V3581)))) (if (kl:shen.pvar? V3437) (begin (kl:shen.bindv V3437 (quote ()) V3580) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V3579 V3580 (lambda () (kl:shen.th* Y B V3579 V3580 V3581)))))) (begin (kl:shen.unbindv V3437 V3580) Result))) #f)))) (if (kl:shen.pvar? V3436) (let ((B (kl:shen.newpv V3580))) (begin (kl:shen.bindv V3436 (cons B (quote ())) V3580) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V3579 V3580 (lambda () (kl:shen.th* Y B V3579 V3580 V3581)))))) (begin (kl:shen.unbindv V3436 V3580) Result)))) #f))) (if (kl:shen.pvar? V3435) (begin (kl:shen.bindv V3435 (quote *) V3580) (let ((Result (let ((V3438 (kl:shen.lazyderef (cdr V3434) V3580))) (if (pair? V3438) (let ((B (car V3438))) (let ((V3439 (kl:shen.lazyderef (cdr V3438) V3580))) (if (null? V3439) (begin (kl:shen.incinfs) (kl:shen.th* X A V3579 V3580 (lambda () (kl:shen.th* Y B V3579 V3580 V3581)))) (if (kl:shen.pvar? V3439) (begin (kl:shen.bindv V3439 (quote ()) V3580) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V3579 V3580 (lambda () (kl:shen.th* Y B V3579 V3580 V3581)))))) (begin (kl:shen.unbindv V3439 V3580) Result))) #f)))) (if (kl:shen.pvar? V3438) (let ((B (kl:shen.newpv V3580))) (begin (kl:shen.bindv V3438 (cons B (quote ())) V3580) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V3579 V3580 (lambda () (kl:shen.th* Y B V3579 V3580 V3581)))))) (begin (kl:shen.unbindv V3438 V3580) Result)))) #f))))) (begin (kl:shen.unbindv V3435 V3580) Result))) #f))) (if (kl:shen.pvar? V3434) (let ((B (kl:shen.newpv V3580))) (begin (kl:shen.bindv V3434 (cons (quote *) (cons B (quote ()))) V3580) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V3579 V3580 (lambda () (kl:shen.th* Y B V3579 V3580 V3581)))))) (begin (kl:shen.unbindv V3434 V3580) Result)))) #f)))) (if (kl:shen.pvar? V3433) (let ((A (kl:shen.newpv V3580))) (let ((B (kl:shen.newpv V3580))) (begin (kl:shen.bindv V3433 (cons A (cons (quote *) (cons B (quote ())))) V3580) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V3579 V3580 (lambda () (kl:shen.th* Y B V3579 V3580 V3581)))))) (begin (kl:shen.unbindv V3433 V3580) Result))))) #f))) #f))) #f))) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3440 (kl:shen.lazyderef V3577 V3580))) (if (pair? V3440) (let ((V3441 (kl:shen.lazyderef (car V3440) V3580))) (if (eq? (quote _waspvm_at_v) V3441) (let ((V3442 (kl:shen.lazyderef (cdr V3440) V3580))) (if (pair? V3442) (let ((X (car V3442))) (let ((V3443 (kl:shen.lazyderef (cdr V3442) V3580))) (if (pair? V3443) (let ((Y (car V3443))) (let ((V3444 (kl:shen.lazyderef (cdr V3443) V3580))) (if (null? V3444) (let ((V3445 (kl:shen.lazyderef V3578 V3580))) (if (pair? V3445) (let ((V3446 (kl:shen.lazyderef (car V3445) V3580))) (if (eq? (quote vector) V3446) (let ((V3447 (kl:shen.lazyderef (cdr V3445) V3580))) (if (pair? V3447) (let ((A (car V3447))) (let ((V3448 (kl:shen.lazyderef (cdr V3447) V3580))) (if (null? V3448) (begin (kl:shen.incinfs) (kl:shen.th* X A V3579 V3580 (lambda () (kl:shen.th* Y (cons (quote vector) (cons A (quote ()))) V3579 V3580 V3581)))) (if (kl:shen.pvar? V3448) (begin (kl:shen.bindv V3448 (quote ()) V3580) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V3579 V3580 (lambda () (kl:shen.th* Y (cons (quote vector) (cons A (quote ()))) V3579 V3580 V3581)))))) (begin (kl:shen.unbindv V3448 V3580) Result))) #f)))) (if (kl:shen.pvar? V3447) (let ((A (kl:shen.newpv V3580))) (begin (kl:shen.bindv V3447 (cons A (quote ())) V3580) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V3579 V3580 (lambda () (kl:shen.th* Y (cons (quote vector) (cons A (quote ()))) V3579 V3580 V3581)))))) (begin (kl:shen.unbindv V3447 V3580) Result)))) #f))) (if (kl:shen.pvar? V3446) (begin (kl:shen.bindv V3446 (quote vector) V3580) (let ((Result (let ((V3449 (kl:shen.lazyderef (cdr V3445) V3580))) (if (pair? V3449) (let ((A (car V3449))) (let ((V3450 (kl:shen.lazyderef (cdr V3449) V3580))) (if (null? V3450) (begin (kl:shen.incinfs) (kl:shen.th* X A V3579 V3580 (lambda () (kl:shen.th* Y (cons (quote vector) (cons A (quote ()))) V3579 V3580 V3581)))) (if (kl:shen.pvar? V3450) (begin (kl:shen.bindv V3450 (quote ()) V3580) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V3579 V3580 (lambda () (kl:shen.th* Y (cons (quote vector) (cons A (quote ()))) V3579 V3580 V3581)))))) (begin (kl:shen.unbindv V3450 V3580) Result))) #f)))) (if (kl:shen.pvar? V3449) (let ((A (kl:shen.newpv V3580))) (begin (kl:shen.bindv V3449 (cons A (quote ())) V3580) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V3579 V3580 (lambda () (kl:shen.th* Y (cons (quote vector) (cons A (quote ()))) V3579 V3580 V3581)))))) (begin (kl:shen.unbindv V3449 V3580) Result)))) #f))))) (begin (kl:shen.unbindv V3446 V3580) Result))) #f))) (if (kl:shen.pvar? V3445) (let ((A (kl:shen.newpv V3580))) (begin (kl:shen.bindv V3445 (cons (quote vector) (cons A (quote ()))) V3580) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V3579 V3580 (lambda () (kl:shen.th* Y (cons (quote vector) (cons A (quote ()))) V3579 V3580 V3581)))))) (begin (kl:shen.unbindv V3445 V3580) Result)))) #f))) #f))) #f))) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3451 (kl:shen.lazyderef V3577 V3580))) (if (pair? V3451) (let ((V3452 (kl:shen.lazyderef (car V3451) V3580))) (if (eq? (quote _waspvm_at_s) V3452) (let ((V3453 (kl:shen.lazyderef (cdr V3451) V3580))) (if (pair? V3453) (let ((X (car V3453))) (let ((V3454 (kl:shen.lazyderef (cdr V3453) V3580))) (if (pair? V3454) (let ((Y (car V3454))) (let ((V3455 (kl:shen.lazyderef (cdr V3454) V3580))) (if (null? V3455) (let ((V3456 (kl:shen.lazyderef V3578 V3580))) (if (eq? (quote string) V3456) (begin (kl:shen.incinfs) (kl:shen.th* X (quote string) V3579 V3580 (lambda () (kl:shen.th* Y (quote string) V3579 V3580 V3581)))) (if (kl:shen.pvar? V3456) (begin (kl:shen.bindv V3456 (quote string) V3580) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X (quote string) V3579 V3580 (lambda () (kl:shen.th* Y (quote string) V3579 V3580 V3581)))))) (begin (kl:shen.unbindv V3456 V3580) Result))) #f))) #f))) #f))) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3457 (kl:shen.lazyderef V3577 V3580))) (if (pair? V3457) (let ((V3458 (kl:shen.lazyderef (car V3457) V3580))) (if (eq? (quote lambda) V3458) (let ((V3459 (kl:shen.lazyderef (cdr V3457) V3580))) (if (pair? V3459) (let ((X (car V3459))) (let ((V3460 (kl:shen.lazyderef (cdr V3459) V3580))) (if (pair? V3460) (let ((Y (car V3460))) (let ((V3461 (kl:shen.lazyderef (cdr V3460) V3580))) (if (null? V3461) (let ((V3462 (kl:shen.lazyderef V3578 V3580))) (if (pair? V3462) (let ((A (car V3462))) (let ((V3463 (kl:shen.lazyderef (cdr V3462) V3580))) (if (pair? V3463) (let ((V3464 (kl:shen.lazyderef (car V3463) V3580))) (if (eq? (quote -->) V3464) (let ((V3465 (kl:shen.lazyderef (cdr V3463) V3580))) (if (pair? V3465) (let ((B (car V3465))) (let ((V3466 (kl:shen.lazyderef (cdr V3465) V3580))) (if (null? V3466) (let ((Z (kl:shen.newpv V3580))) (let ((X&& (kl:shen.newpv V3580))) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V3580 (lambda () (kl:bind X&& (kl:shen.placeholder) V3580 (lambda () (kl:bind Z (kl:shen.ebr (kl:shen.lazyderef X&& V3580) (kl:shen.lazyderef X V3580) (kl:shen.lazyderef Y V3580)) V3580 (lambda () (kl:shen.th* Z B (cons (cons X&& (cons (quote :) (cons A (quote ())))) V3579) V3580 V3581)))))))))) (if (kl:shen.pvar? V3466) (begin (kl:shen.bindv V3466 (quote ()) V3580) (let ((Result (let ((Z (kl:shen.newpv V3580))) (let ((X&& (kl:shen.newpv V3580))) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V3580 (lambda () (kl:bind X&& (kl:shen.placeholder) V3580 (lambda () (kl:bind Z (kl:shen.ebr (kl:shen.lazyderef X&& V3580) (kl:shen.lazyderef X V3580) (kl:shen.lazyderef Y V3580)) V3580 (lambda () (kl:shen.th* Z B (cons (cons X&& (cons (quote :) (cons A (quote ())))) V3579) V3580 V3581)))))))))))) (begin (kl:shen.unbindv V3466 V3580) Result))) #f)))) (if (kl:shen.pvar? V3465) (let ((B (kl:shen.newpv V3580))) (begin (kl:shen.bindv V3465 (cons B (quote ())) V3580) (let ((Result (let ((Z (kl:shen.newpv V3580))) (let ((X&& (kl:shen.newpv V3580))) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V3580 (lambda () (kl:bind X&& (kl:shen.placeholder) V3580 (lambda () (kl:bind Z (kl:shen.ebr (kl:shen.lazyderef X&& V3580) (kl:shen.lazyderef X V3580) (kl:shen.lazyderef Y V3580)) V3580 (lambda () (kl:shen.th* Z B (cons (cons X&& (cons (quote :) (cons A (quote ())))) V3579) V3580 V3581)))))))))))) (begin (kl:shen.unbindv V3465 V3580) Result)))) #f))) (if (kl:shen.pvar? V3464) (begin (kl:shen.bindv V3464 (quote -->) V3580) (let ((Result (let ((V3467 (kl:shen.lazyderef (cdr V3463) V3580))) (if (pair? V3467) (let ((B (car V3467))) (let ((V3468 (kl:shen.lazyderef (cdr V3467) V3580))) (if (null? V3468) (let ((Z (kl:shen.newpv V3580))) (let ((X&& (kl:shen.newpv V3580))) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V3580 (lambda () (kl:bind X&& (kl:shen.placeholder) V3580 (lambda () (kl:bind Z (kl:shen.ebr (kl:shen.lazyderef X&& V3580) (kl:shen.lazyderef X V3580) (kl:shen.lazyderef Y V3580)) V3580 (lambda () (kl:shen.th* Z B (cons (cons X&& (cons (quote :) (cons A (quote ())))) V3579) V3580 V3581)))))))))) (if (kl:shen.pvar? V3468) (begin (kl:shen.bindv V3468 (quote ()) V3580) (let ((Result (let ((Z (kl:shen.newpv V3580))) (let ((X&& (kl:shen.newpv V3580))) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V3580 (lambda () (kl:bind X&& (kl:shen.placeholder) V3580 (lambda () (kl:bind Z (kl:shen.ebr (kl:shen.lazyderef X&& V3580) (kl:shen.lazyderef X V3580) (kl:shen.lazyderef Y V3580)) V3580 (lambda () (kl:shen.th* Z B (cons (cons X&& (cons (quote :) (cons A (quote ())))) V3579) V3580 V3581)))))))))))) (begin (kl:shen.unbindv V3468 V3580) Result))) #f)))) (if (kl:shen.pvar? V3467) (let ((B (kl:shen.newpv V3580))) (begin (kl:shen.bindv V3467 (cons B (quote ())) V3580) (let ((Result (let ((Z (kl:shen.newpv V3580))) (let ((X&& (kl:shen.newpv V3580))) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V3580 (lambda () (kl:bind X&& (kl:shen.placeholder) V3580 (lambda () (kl:bind Z (kl:shen.ebr (kl:shen.lazyderef X&& V3580) (kl:shen.lazyderef X V3580) (kl:shen.lazyderef Y V3580)) V3580 (lambda () (kl:shen.th* Z B (cons (cons X&& (cons (quote :) (cons A (quote ())))) V3579) V3580 V3581)))))))))))) (begin (kl:shen.unbindv V3467 V3580) Result)))) #f))))) (begin (kl:shen.unbindv V3464 V3580) Result))) #f))) (if (kl:shen.pvar? V3463) (let ((B (kl:shen.newpv V3580))) (begin (kl:shen.bindv V3463 (cons (quote -->) (cons B (quote ()))) V3580) (let ((Result (let ((Z (kl:shen.newpv V3580))) (let ((X&& (kl:shen.newpv V3580))) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V3580 (lambda () (kl:bind X&& (kl:shen.placeholder) V3580 (lambda () (kl:bind Z (kl:shen.ebr (kl:shen.lazyderef X&& V3580) (kl:shen.lazyderef X V3580) (kl:shen.lazyderef Y V3580)) V3580 (lambda () (kl:shen.th* Z B (cons (cons X&& (cons (quote :) (cons A (quote ())))) V3579) V3580 V3581)))))))))))) (begin (kl:shen.unbindv V3463 V3580) Result)))) #f)))) (if (kl:shen.pvar? V3462) (let ((A (kl:shen.newpv V3580))) (let ((B (kl:shen.newpv V3580))) (begin (kl:shen.bindv V3462 (cons A (cons (quote -->) (cons B (quote ())))) V3580) (let ((Result (let ((Z (kl:shen.newpv V3580))) (let ((X&& (kl:shen.newpv V3580))) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V3580 (lambda () (kl:bind X&& (kl:shen.placeholder) V3580 (lambda () (kl:bind Z (kl:shen.ebr (kl:shen.lazyderef X&& V3580) (kl:shen.lazyderef X V3580) (kl:shen.lazyderef Y V3580)) V3580 (lambda () (kl:shen.th* Z B (cons (cons X&& (cons (quote :) (cons A (quote ())))) V3579) V3580 V3581)))))))))))) (begin (kl:shen.unbindv V3462 V3580) Result))))) #f))) #f))) #f))) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3469 (kl:shen.lazyderef V3577 V3580))) (if (pair? V3469) (let ((V3470 (kl:shen.lazyderef (car V3469) V3580))) (if (eq? (quote let) V3470) (let ((V3471 (kl:shen.lazyderef (cdr V3469) V3580))) (if (pair? V3471) (let ((X (car V3471))) (let ((V3472 (kl:shen.lazyderef (cdr V3471) V3580))) (if (pair? V3472) (let ((Y (car V3472))) (let ((V3473 (kl:shen.lazyderef (cdr V3472) V3580))) (if (pair? V3473) (let ((Z (car V3473))) (let ((V3474 (kl:shen.lazyderef (cdr V3473) V3580))) (if (null? V3474) (let ((W (kl:shen.newpv V3580))) (let ((X&& (kl:shen.newpv V3580))) (let ((B (kl:shen.newpv V3580))) (begin (kl:shen.incinfs) (kl:shen.th* Y B V3579 V3580 (lambda () (kl:bind X&& (kl:shen.placeholder) V3580 (lambda () (kl:bind W (kl:shen.ebr (kl:shen.lazyderef X&& V3580) (kl:shen.lazyderef X V3580) (kl:shen.lazyderef Z V3580)) V3580 (lambda () (kl:shen.th* W V3578 (cons (cons X&& (cons (quote :) (cons B (quote ())))) V3579) V3580 V3581))))))))))) #f))) #f))) #f))) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3475 (kl:shen.lazyderef V3577 V3580))) (if (pair? V3475) (let ((V3476 (kl:shen.lazyderef (car V3475) V3580))) (if (eq? (quote open) V3476) (let ((V3477 (kl:shen.lazyderef (cdr V3475) V3580))) (if (pair? V3477) (let ((FileName (car V3477))) (let ((V3478 (kl:shen.lazyderef (cdr V3477) V3580))) (if (pair? V3478) (let ((Direction3408 (car V3478))) (let ((V3479 (kl:shen.lazyderef (cdr V3478) V3580))) (if (null? V3479) (let ((V3480 (kl:shen.lazyderef V3578 V3580))) (if (pair? V3480) (let ((V3481 (kl:shen.lazyderef (car V3480) V3580))) (if (eq? (quote stream) V3481) (let ((V3482 (kl:shen.lazyderef (cdr V3480) V3580))) (if (pair? V3482) (let ((Direction (car V3482))) (let ((V3483 (kl:shen.lazyderef (cdr V3482) V3580))) (if (null? V3483) (begin (kl:shen.incinfs) (kl:unify! Direction Direction3408 V3580 (lambda () (kl:cut Throwcontrol V3580 (lambda () (kl:fwhen (kl:element? (kl:shen.lazyderef Direction V3580) (cons (quote in) (cons (quote out) (quote ())))) V3580 (lambda () (kl:shen.th* FileName (quote string) V3579 V3580 V3581)))))))) (if (kl:shen.pvar? V3483) (begin (kl:shen.bindv V3483 (quote ()) V3580) (let ((Result (begin (kl:shen.incinfs) (kl:unify! Direction Direction3408 V3580 (lambda () (kl:cut Throwcontrol V3580 (lambda () (kl:fwhen (kl:element? (kl:shen.lazyderef Direction V3580) (cons (quote in) (cons (quote out) (quote ())))) V3580 (lambda () (kl:shen.th* FileName (quote string) V3579 V3580 V3581)))))))))) (begin (kl:shen.unbindv V3483 V3580) Result))) #f)))) (if (kl:shen.pvar? V3482) (let ((Direction (kl:shen.newpv V3580))) (begin (kl:shen.bindv V3482 (cons Direction (quote ())) V3580) (let ((Result (begin (kl:shen.incinfs) (kl:unify! Direction Direction3408 V3580 (lambda () (kl:cut Throwcontrol V3580 (lambda () (kl:fwhen (kl:element? (kl:shen.lazyderef Direction V3580) (cons (quote in) (cons (quote out) (quote ())))) V3580 (lambda () (kl:shen.th* FileName (quote string) V3579 V3580 V3581)))))))))) (begin (kl:shen.unbindv V3482 V3580) Result)))) #f))) (if (kl:shen.pvar? V3481) (begin (kl:shen.bindv V3481 (quote stream) V3580) (let ((Result (let ((V3484 (kl:shen.lazyderef (cdr V3480) V3580))) (if (pair? V3484) (let ((Direction (car V3484))) (let ((V3485 (kl:shen.lazyderef (cdr V3484) V3580))) (if (null? V3485) (begin (kl:shen.incinfs) (kl:unify! Direction Direction3408 V3580 (lambda () (kl:cut Throwcontrol V3580 (lambda () (kl:fwhen (kl:element? (kl:shen.lazyderef Direction V3580) (cons (quote in) (cons (quote out) (quote ())))) V3580 (lambda () (kl:shen.th* FileName (quote string) V3579 V3580 V3581)))))))) (if (kl:shen.pvar? V3485) (begin (kl:shen.bindv V3485 (quote ()) V3580) (let ((Result (begin (kl:shen.incinfs) (kl:unify! Direction Direction3408 V3580 (lambda () (kl:cut Throwcontrol V3580 (lambda () (kl:fwhen (kl:element? (kl:shen.lazyderef Direction V3580) (cons (quote in) (cons (quote out) (quote ())))) V3580 (lambda () (kl:shen.th* FileName (quote string) V3579 V3580 V3581)))))))))) (begin (kl:shen.unbindv V3485 V3580) Result))) #f)))) (if (kl:shen.pvar? V3484) (let ((Direction (kl:shen.newpv V3580))) (begin (kl:shen.bindv V3484 (cons Direction (quote ())) V3580) (let ((Result (begin (kl:shen.incinfs) (kl:unify! Direction Direction3408 V3580 (lambda () (kl:cut Throwcontrol V3580 (lambda () (kl:fwhen (kl:element? (kl:shen.lazyderef Direction V3580) (cons (quote in) (cons (quote out) (quote ())))) V3580 (lambda () (kl:shen.th* FileName (quote string) V3579 V3580 V3581)))))))))) (begin (kl:shen.unbindv V3484 V3580) Result)))) #f))))) (begin (kl:shen.unbindv V3481 V3580) Result))) #f))) (if (kl:shen.pvar? V3480) (let ((Direction (kl:shen.newpv V3580))) (begin (kl:shen.bindv V3480 (cons (quote stream) (cons Direction (quote ()))) V3580) (let ((Result (begin (kl:shen.incinfs) (kl:unify! Direction Direction3408 V3580 (lambda () (kl:cut Throwcontrol V3580 (lambda () (kl:fwhen (kl:element? (kl:shen.lazyderef Direction V3580) (cons (quote in) (cons (quote out) (quote ())))) V3580 (lambda () (kl:shen.th* FileName (quote string) V3579 V3580 V3581)))))))))) (begin (kl:shen.unbindv V3480 V3580) Result)))) #f))) #f))) #f))) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3486 (kl:shen.lazyderef V3577 V3580))) (if (pair? V3486) (let ((V3487 (kl:shen.lazyderef (car V3486) V3580))) (if (eq? (quote type) V3487) (let ((V3488 (kl:shen.lazyderef (cdr V3486) V3580))) (if (pair? V3488) (let ((X (car V3488))) (let ((V3489 (kl:shen.lazyderef (cdr V3488) V3580))) (if (pair? V3489) (let ((A (car V3489))) (let ((V3490 (kl:shen.lazyderef (cdr V3489) V3580))) (if (null? V3490) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V3580 (lambda () (kl:unify A V3578 V3580 (lambda () (kl:shen.th* X A V3579 V3580 V3581)))))) #f))) #f))) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3491 (kl:shen.lazyderef V3577 V3580))) (if (pair? V3491) (let ((V3492 (kl:shen.lazyderef (car V3491) V3580))) (if (eq? (quote input+) V3492) (let ((V3493 (kl:shen.lazyderef (cdr V3491) V3580))) (if (pair? V3493) (let ((A (car V3493))) (let ((V3494 (kl:shen.lazyderef (cdr V3493) V3580))) (if (pair? V3494) (let ((Stream (car V3494))) (let ((V3495 (kl:shen.lazyderef (cdr V3494) V3580))) (if (null? V3495) (let ((C (kl:shen.newpv V3580))) (begin (kl:shen.incinfs) (kl:bind C (kl:shen.demodulate (kl:shen.lazyderef A V3580)) V3580 (lambda () (kl:unify V3578 C V3580 (lambda () (kl:shen.th* Stream (cons (quote stream) (cons (quote in) (quote ()))) V3579 V3580 V3581))))))) #f))) #f))) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3496 (kl:shen.lazyderef V3577 V3580))) (if (pair? V3496) (let ((V3497 (kl:shen.lazyderef (car V3496) V3580))) (if (eq? (quote set) V3497) (let ((V3498 (kl:shen.lazyderef (cdr V3496) V3580))) (if (pair? V3498) (let ((Var (car V3498))) (let ((V3499 (kl:shen.lazyderef (cdr V3498) V3580))) (if (pair? V3499) (let ((Val (car V3499))) (let ((V3500 (kl:shen.lazyderef (cdr V3499) V3580))) (if (null? V3500) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V3580 (lambda () (kl:shen.th* Var (quote symbol) V3579 V3580 (lambda () (kl:cut Throwcontrol V3580 (lambda () (kl:shen.th* (cons (quote value) (cons Var (quote ()))) V3578 V3579 V3580 (lambda () (kl:shen.th* Val V3578 V3579 V3580 V3581)))))))))) #f))) #f))) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((NewHyp (kl:shen.newpv V3580))) (begin (kl:shen.incinfs) (kl:shen.t*-hyps V3579 NewHyp V3580 (lambda () (kl:shen.th* V3577 V3578 NewHyp V3580 V3581))))))) (if (kl:= Case #f) (let ((Case (let ((V3501 (kl:shen.lazyderef V3577 V3580))) (if (pair? V3501) (let ((V3502 (kl:shen.lazyderef (car V3501) V3580))) (if (eq? (quote define) V3502) (let ((V3503 (kl:shen.lazyderef (cdr V3501) V3580))) (if (pair? V3503) (let ((F (car V3503))) (let ((X (cdr V3503))) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V3580 (lambda () (kl:shen.t*-def (cons (quote define) (cons F X)) V3578 V3579 V3580 V3581)))))) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3504 (kl:shen.lazyderef V3577 V3580))) (if (pair? V3504) (let ((V3505 (kl:shen.lazyderef (car V3504) V3580))) (if (eq? (quote defmacro) V3505) (let ((V3506 (kl:shen.lazyderef V3578 V3580))) (if (eq? (quote unit) V3506) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V3580 V3581)) (if (kl:shen.pvar? V3506) (begin (kl:shen.bindv V3506 (quote unit) V3580) (let ((Result (begin (kl:shen.incinfs) (kl:cut Throwcontrol V3580 V3581)))) (begin (kl:shen.unbindv V3506 V3580) Result))) #f))) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3507 (kl:shen.lazyderef V3577 V3580))) (if (pair? V3507) (let ((V3508 (kl:shen.lazyderef (car V3507) V3580))) (if (eq? (quote shen.process-datatype) V3508) (let ((V3509 (kl:shen.lazyderef V3578 V3580))) (if (eq? (quote symbol) V3509) (begin (kl:shen.incinfs) (kl:thaw V3581)) (if (kl:shen.pvar? V3509) (begin (kl:shen.bindv V3509 (quote symbol) V3580) (let ((Result (begin (kl:shen.incinfs) (kl:thaw V3581)))) (begin (kl:shen.unbindv V3509 V3580) Result))) #f))) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3510 (kl:shen.lazyderef V3577 V3580))) (if (pair? V3510) (let ((V3511 (kl:shen.lazyderef (car V3510) V3580))) (if (eq? (quote shen.synonyms-help) V3511) (let ((V3512 (kl:shen.lazyderef V3578 V3580))) (if (eq? (quote symbol) V3512) (begin (kl:shen.incinfs) (kl:thaw V3581)) (if (kl:shen.pvar? V3512) (begin (kl:shen.bindv V3512 (quote symbol) V3580) (let ((Result (begin (kl:shen.incinfs) (kl:thaw V3581)))) (begin (kl:shen.unbindv V3512 V3580) Result))) #f))) #f)) #f)))) (if (kl:= Case #f) (let ((Datatypes (kl:shen.newpv V3580))) (begin (kl:shen.incinfs) (kl:bind Datatypes (kl:value (quote shen.*datatypes*)) V3580 (lambda () (kl:shen.udefs* (cons V3577 (cons (quote :) (cons V3578 (quote ())))) V3579 Datatypes V3580 V3581))))) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case))))) (export shen.th*) (quote shen.th*)) +(begin (register-function-arity (quote shen.t*-hyps) 4) (define (kl:shen.t*-hyps V3586 V3587 V3588 V3589) (let ((Case (let ((V3323 (kl:shen.lazyderef V3586 V3588))) (if (pair? V3323) (let ((V3324 (kl:shen.lazyderef (car V3323) V3588))) (if (pair? V3324) (let ((V3325 (kl:shen.lazyderef (car V3324) V3588))) (if (pair? V3325) (let ((V3326 (kl:shen.lazyderef (car V3325) V3588))) (if (eq? (quote cons) V3326) (let ((V3327 (kl:shen.lazyderef (cdr V3325) V3588))) (if (pair? V3327) (let ((X (car V3327))) (let ((V3328 (kl:shen.lazyderef (cdr V3327) V3588))) (if (pair? V3328) (let ((Y (car V3328))) (let ((V3329 (kl:shen.lazyderef (cdr V3328) V3588))) (if (null? V3329) (let ((V3330 (kl:shen.lazyderef (cdr V3324) V3588))) (if (pair? V3330) (let ((V3331 (kl:shen.lazyderef (car V3330) V3588))) (if (eq? (quote :) V3331) (let ((V3332 (kl:shen.lazyderef (cdr V3330) V3588))) (if (pair? V3332) (let ((V3333 (kl:shen.lazyderef (car V3332) V3588))) (if (pair? V3333) (let ((V3334 (kl:shen.lazyderef (car V3333) V3588))) (if (eq? (quote list) V3334) (let ((V3335 (kl:shen.lazyderef (cdr V3333) V3588))) (if (pair? V3335) (let ((A (car V3335))) (let ((V3336 (kl:shen.lazyderef (cdr V3335) V3588))) (if (null? V3336) (let ((V3337 (kl:shen.lazyderef (cdr V3332) V3588))) (if (null? V3337) (let ((Hyp (cdr V3323))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))) (if (kl:shen.pvar? V3337) (begin (kl:shen.bindv V3337 (quote ()) V3588) (let ((Result (let ((Hyp (cdr V3323))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))))) (begin (kl:shen.unbindv V3337 V3588) Result))) #f))) (if (kl:shen.pvar? V3336) (begin (kl:shen.bindv V3336 (quote ()) V3588) (let ((Result (let ((V3338 (kl:shen.lazyderef (cdr V3332) V3588))) (if (null? V3338) (let ((Hyp (cdr V3323))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))) (if (kl:shen.pvar? V3338) (begin (kl:shen.bindv V3338 (quote ()) V3588) (let ((Result (let ((Hyp (cdr V3323))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))))) (begin (kl:shen.unbindv V3338 V3588) Result))) #f))))) (begin (kl:shen.unbindv V3336 V3588) Result))) #f)))) (if (kl:shen.pvar? V3335) (let ((A (kl:shen.newpv V3588))) (begin (kl:shen.bindv V3335 (cons A (quote ())) V3588) (let ((Result (let ((V3339 (kl:shen.lazyderef (cdr V3332) V3588))) (if (null? V3339) (let ((Hyp (cdr V3323))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))) (if (kl:shen.pvar? V3339) (begin (kl:shen.bindv V3339 (quote ()) V3588) (let ((Result (let ((Hyp (cdr V3323))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))))) (begin (kl:shen.unbindv V3339 V3588) Result))) #f))))) (begin (kl:shen.unbindv V3335 V3588) Result)))) #f))) (if (kl:shen.pvar? V3334) (begin (kl:shen.bindv V3334 (quote list) V3588) (let ((Result (let ((V3340 (kl:shen.lazyderef (cdr V3333) V3588))) (if (pair? V3340) (let ((A (car V3340))) (let ((V3341 (kl:shen.lazyderef (cdr V3340) V3588))) (if (null? V3341) (let ((V3342 (kl:shen.lazyderef (cdr V3332) V3588))) (if (null? V3342) (let ((Hyp (cdr V3323))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))) (if (kl:shen.pvar? V3342) (begin (kl:shen.bindv V3342 (quote ()) V3588) (let ((Result (let ((Hyp (cdr V3323))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))))) (begin (kl:shen.unbindv V3342 V3588) Result))) #f))) (if (kl:shen.pvar? V3341) (begin (kl:shen.bindv V3341 (quote ()) V3588) (let ((Result (let ((V3343 (kl:shen.lazyderef (cdr V3332) V3588))) (if (null? V3343) (let ((Hyp (cdr V3323))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))) (if (kl:shen.pvar? V3343) (begin (kl:shen.bindv V3343 (quote ()) V3588) (let ((Result (let ((Hyp (cdr V3323))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))))) (begin (kl:shen.unbindv V3343 V3588) Result))) #f))))) (begin (kl:shen.unbindv V3341 V3588) Result))) #f)))) (if (kl:shen.pvar? V3340) (let ((A (kl:shen.newpv V3588))) (begin (kl:shen.bindv V3340 (cons A (quote ())) V3588) (let ((Result (let ((V3344 (kl:shen.lazyderef (cdr V3332) V3588))) (if (null? V3344) (let ((Hyp (cdr V3323))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))) (if (kl:shen.pvar? V3344) (begin (kl:shen.bindv V3344 (quote ()) V3588) (let ((Result (let ((Hyp (cdr V3323))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))))) (begin (kl:shen.unbindv V3344 V3588) Result))) #f))))) (begin (kl:shen.unbindv V3340 V3588) Result)))) #f))))) (begin (kl:shen.unbindv V3334 V3588) Result))) #f))) (if (kl:shen.pvar? V3333) (let ((A (kl:shen.newpv V3588))) (begin (kl:shen.bindv V3333 (cons (quote list) (cons A (quote ()))) V3588) (let ((Result (let ((V3345 (kl:shen.lazyderef (cdr V3332) V3588))) (if (null? V3345) (let ((Hyp (cdr V3323))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))) (if (kl:shen.pvar? V3345) (begin (kl:shen.bindv V3345 (quote ()) V3588) (let ((Result (let ((Hyp (cdr V3323))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))))) (begin (kl:shen.unbindv V3345 V3588) Result))) #f))))) (begin (kl:shen.unbindv V3333 V3588) Result)))) #f))) #f)) #f)) #f)) #f))) #f))) #f)) #f)) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3346 (kl:shen.lazyderef V3586 V3588))) (if (pair? V3346) (let ((V3347 (kl:shen.lazyderef (car V3346) V3588))) (if (pair? V3347) (let ((V3348 (kl:shen.lazyderef (car V3347) V3588))) (if (pair? V3348) (let ((V3349 (kl:shen.lazyderef (car V3348) V3588))) (if (eq? (quote _waspvm_at_p) V3349) (let ((V3350 (kl:shen.lazyderef (cdr V3348) V3588))) (if (pair? V3350) (let ((X (car V3350))) (let ((V3351 (kl:shen.lazyderef (cdr V3350) V3588))) (if (pair? V3351) (let ((Y (car V3351))) (let ((V3352 (kl:shen.lazyderef (cdr V3351) V3588))) (if (null? V3352) (let ((V3353 (kl:shen.lazyderef (cdr V3347) V3588))) (if (pair? V3353) (let ((V3354 (kl:shen.lazyderef (car V3353) V3588))) (if (eq? (quote :) V3354) (let ((V3355 (kl:shen.lazyderef (cdr V3353) V3588))) (if (pair? V3355) (let ((V3356 (kl:shen.lazyderef (car V3355) V3588))) (if (pair? V3356) (let ((A (car V3356))) (let ((V3357 (kl:shen.lazyderef (cdr V3356) V3588))) (if (pair? V3357) (let ((V3358 (kl:shen.lazyderef (car V3357) V3588))) (if (eq? (quote *) V3358) (let ((V3359 (kl:shen.lazyderef (cdr V3357) V3588))) (if (pair? V3359) (let ((B (car V3359))) (let ((V3360 (kl:shen.lazyderef (cdr V3359) V3588))) (if (null? V3360) (let ((V3361 (kl:shen.lazyderef (cdr V3355) V3588))) (if (null? V3361) (let ((Hyp (cdr V3346))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (kl:shen.lazyderef B V3588) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))) (if (kl:shen.pvar? V3361) (begin (kl:shen.bindv V3361 (quote ()) V3588) (let ((Result (let ((Hyp (cdr V3346))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (kl:shen.lazyderef B V3588) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))))) (begin (kl:shen.unbindv V3361 V3588) Result))) #f))) (if (kl:shen.pvar? V3360) (begin (kl:shen.bindv V3360 (quote ()) V3588) (let ((Result (let ((V3362 (kl:shen.lazyderef (cdr V3355) V3588))) (if (null? V3362) (let ((Hyp (cdr V3346))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (kl:shen.lazyderef B V3588) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))) (if (kl:shen.pvar? V3362) (begin (kl:shen.bindv V3362 (quote ()) V3588) (let ((Result (let ((Hyp (cdr V3346))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (kl:shen.lazyderef B V3588) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))))) (begin (kl:shen.unbindv V3362 V3588) Result))) #f))))) (begin (kl:shen.unbindv V3360 V3588) Result))) #f)))) (if (kl:shen.pvar? V3359) (let ((B (kl:shen.newpv V3588))) (begin (kl:shen.bindv V3359 (cons B (quote ())) V3588) (let ((Result (let ((V3363 (kl:shen.lazyderef (cdr V3355) V3588))) (if (null? V3363) (let ((Hyp (cdr V3346))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (kl:shen.lazyderef B V3588) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))) (if (kl:shen.pvar? V3363) (begin (kl:shen.bindv V3363 (quote ()) V3588) (let ((Result (let ((Hyp (cdr V3346))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (kl:shen.lazyderef B V3588) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))))) (begin (kl:shen.unbindv V3363 V3588) Result))) #f))))) (begin (kl:shen.unbindv V3359 V3588) Result)))) #f))) (if (kl:shen.pvar? V3358) (begin (kl:shen.bindv V3358 (quote *) V3588) (let ((Result (let ((V3364 (kl:shen.lazyderef (cdr V3357) V3588))) (if (pair? V3364) (let ((B (car V3364))) (let ((V3365 (kl:shen.lazyderef (cdr V3364) V3588))) (if (null? V3365) (let ((V3366 (kl:shen.lazyderef (cdr V3355) V3588))) (if (null? V3366) (let ((Hyp (cdr V3346))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (kl:shen.lazyderef B V3588) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))) (if (kl:shen.pvar? V3366) (begin (kl:shen.bindv V3366 (quote ()) V3588) (let ((Result (let ((Hyp (cdr V3346))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (kl:shen.lazyderef B V3588) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))))) (begin (kl:shen.unbindv V3366 V3588) Result))) #f))) (if (kl:shen.pvar? V3365) (begin (kl:shen.bindv V3365 (quote ()) V3588) (let ((Result (let ((V3367 (kl:shen.lazyderef (cdr V3355) V3588))) (if (null? V3367) (let ((Hyp (cdr V3346))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (kl:shen.lazyderef B V3588) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))) (if (kl:shen.pvar? V3367) (begin (kl:shen.bindv V3367 (quote ()) V3588) (let ((Result (let ((Hyp (cdr V3346))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (kl:shen.lazyderef B V3588) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))))) (begin (kl:shen.unbindv V3367 V3588) Result))) #f))))) (begin (kl:shen.unbindv V3365 V3588) Result))) #f)))) (if (kl:shen.pvar? V3364) (let ((B (kl:shen.newpv V3588))) (begin (kl:shen.bindv V3364 (cons B (quote ())) V3588) (let ((Result (let ((V3368 (kl:shen.lazyderef (cdr V3355) V3588))) (if (null? V3368) (let ((Hyp (cdr V3346))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (kl:shen.lazyderef B V3588) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))) (if (kl:shen.pvar? V3368) (begin (kl:shen.bindv V3368 (quote ()) V3588) (let ((Result (let ((Hyp (cdr V3346))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (kl:shen.lazyderef B V3588) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))))) (begin (kl:shen.unbindv V3368 V3588) Result))) #f))))) (begin (kl:shen.unbindv V3364 V3588) Result)))) #f))))) (begin (kl:shen.unbindv V3358 V3588) Result))) #f))) (if (kl:shen.pvar? V3357) (let ((B (kl:shen.newpv V3588))) (begin (kl:shen.bindv V3357 (cons (quote *) (cons B (quote ()))) V3588) (let ((Result (let ((V3369 (kl:shen.lazyderef (cdr V3355) V3588))) (if (null? V3369) (let ((Hyp (cdr V3346))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (kl:shen.lazyderef B V3588) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))) (if (kl:shen.pvar? V3369) (begin (kl:shen.bindv V3369 (quote ()) V3588) (let ((Result (let ((Hyp (cdr V3346))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (kl:shen.lazyderef B V3588) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))))) (begin (kl:shen.unbindv V3369 V3588) Result))) #f))))) (begin (kl:shen.unbindv V3357 V3588) Result)))) #f)))) (if (kl:shen.pvar? V3356) (let ((A (kl:shen.newpv V3588))) (let ((B (kl:shen.newpv V3588))) (begin (kl:shen.bindv V3356 (cons A (cons (quote *) (cons B (quote ())))) V3588) (let ((Result (let ((V3370 (kl:shen.lazyderef (cdr V3355) V3588))) (if (null? V3370) (let ((Hyp (cdr V3346))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (kl:shen.lazyderef B V3588) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))) (if (kl:shen.pvar? V3370) (begin (kl:shen.bindv V3370 (quote ()) V3588) (let ((Result (let ((Hyp (cdr V3346))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (kl:shen.lazyderef B V3588) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))))) (begin (kl:shen.unbindv V3370 V3588) Result))) #f))))) (begin (kl:shen.unbindv V3356 V3588) Result))))) #f))) #f)) #f)) #f)) #f))) #f))) #f)) #f)) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3371 (kl:shen.lazyderef V3586 V3588))) (if (pair? V3371) (let ((V3372 (kl:shen.lazyderef (car V3371) V3588))) (if (pair? V3372) (let ((V3373 (kl:shen.lazyderef (car V3372) V3588))) (if (pair? V3373) (let ((V3374 (kl:shen.lazyderef (car V3373) V3588))) (if (eq? (quote _waspvm_at_v) V3374) (let ((V3375 (kl:shen.lazyderef (cdr V3373) V3588))) (if (pair? V3375) (let ((X (car V3375))) (let ((V3376 (kl:shen.lazyderef (cdr V3375) V3588))) (if (pair? V3376) (let ((Y (car V3376))) (let ((V3377 (kl:shen.lazyderef (cdr V3376) V3588))) (if (null? V3377) (let ((V3378 (kl:shen.lazyderef (cdr V3372) V3588))) (if (pair? V3378) (let ((V3379 (kl:shen.lazyderef (car V3378) V3588))) (if (eq? (quote :) V3379) (let ((V3380 (kl:shen.lazyderef (cdr V3378) V3588))) (if (pair? V3380) (let ((V3381 (kl:shen.lazyderef (car V3380) V3588))) (if (pair? V3381) (let ((V3382 (kl:shen.lazyderef (car V3381) V3588))) (if (eq? (quote vector) V3382) (let ((V3383 (kl:shen.lazyderef (cdr V3381) V3588))) (if (pair? V3383) (let ((A (car V3383))) (let ((V3384 (kl:shen.lazyderef (cdr V3383) V3588))) (if (null? V3384) (let ((V3385 (kl:shen.lazyderef (cdr V3380) V3588))) (if (null? V3385) (let ((Hyp (cdr V3371))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))) (if (kl:shen.pvar? V3385) (begin (kl:shen.bindv V3385 (quote ()) V3588) (let ((Result (let ((Hyp (cdr V3371))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))))) (begin (kl:shen.unbindv V3385 V3588) Result))) #f))) (if (kl:shen.pvar? V3384) (begin (kl:shen.bindv V3384 (quote ()) V3588) (let ((Result (let ((V3386 (kl:shen.lazyderef (cdr V3380) V3588))) (if (null? V3386) (let ((Hyp (cdr V3371))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))) (if (kl:shen.pvar? V3386) (begin (kl:shen.bindv V3386 (quote ()) V3588) (let ((Result (let ((Hyp (cdr V3371))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))))) (begin (kl:shen.unbindv V3386 V3588) Result))) #f))))) (begin (kl:shen.unbindv V3384 V3588) Result))) #f)))) (if (kl:shen.pvar? V3383) (let ((A (kl:shen.newpv V3588))) (begin (kl:shen.bindv V3383 (cons A (quote ())) V3588) (let ((Result (let ((V3387 (kl:shen.lazyderef (cdr V3380) V3588))) (if (null? V3387) (let ((Hyp (cdr V3371))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))) (if (kl:shen.pvar? V3387) (begin (kl:shen.bindv V3387 (quote ()) V3588) (let ((Result (let ((Hyp (cdr V3371))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))))) (begin (kl:shen.unbindv V3387 V3588) Result))) #f))))) (begin (kl:shen.unbindv V3383 V3588) Result)))) #f))) (if (kl:shen.pvar? V3382) (begin (kl:shen.bindv V3382 (quote vector) V3588) (let ((Result (let ((V3388 (kl:shen.lazyderef (cdr V3381) V3588))) (if (pair? V3388) (let ((A (car V3388))) (let ((V3389 (kl:shen.lazyderef (cdr V3388) V3588))) (if (null? V3389) (let ((V3390 (kl:shen.lazyderef (cdr V3380) V3588))) (if (null? V3390) (let ((Hyp (cdr V3371))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))) (if (kl:shen.pvar? V3390) (begin (kl:shen.bindv V3390 (quote ()) V3588) (let ((Result (let ((Hyp (cdr V3371))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))))) (begin (kl:shen.unbindv V3390 V3588) Result))) #f))) (if (kl:shen.pvar? V3389) (begin (kl:shen.bindv V3389 (quote ()) V3588) (let ((Result (let ((V3391 (kl:shen.lazyderef (cdr V3380) V3588))) (if (null? V3391) (let ((Hyp (cdr V3371))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))) (if (kl:shen.pvar? V3391) (begin (kl:shen.bindv V3391 (quote ()) V3588) (let ((Result (let ((Hyp (cdr V3371))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))))) (begin (kl:shen.unbindv V3391 V3588) Result))) #f))))) (begin (kl:shen.unbindv V3389 V3588) Result))) #f)))) (if (kl:shen.pvar? V3388) (let ((A (kl:shen.newpv V3588))) (begin (kl:shen.bindv V3388 (cons A (quote ())) V3588) (let ((Result (let ((V3392 (kl:shen.lazyderef (cdr V3380) V3588))) (if (null? V3392) (let ((Hyp (cdr V3371))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))) (if (kl:shen.pvar? V3392) (begin (kl:shen.bindv V3392 (quote ()) V3588) (let ((Result (let ((Hyp (cdr V3371))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))))) (begin (kl:shen.unbindv V3392 V3588) Result))) #f))))) (begin (kl:shen.unbindv V3388 V3588) Result)))) #f))))) (begin (kl:shen.unbindv V3382 V3588) Result))) #f))) (if (kl:shen.pvar? V3381) (let ((A (kl:shen.newpv V3588))) (begin (kl:shen.bindv V3381 (cons (quote vector) (cons A (quote ()))) V3588) (let ((Result (let ((V3393 (kl:shen.lazyderef (cdr V3380) V3588))) (if (null? V3393) (let ((Hyp (cdr V3371))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))) (if (kl:shen.pvar? V3393) (begin (kl:shen.bindv V3393 (quote ()) V3588) (let ((Result (let ((Hyp (cdr V3371))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (kl:shen.lazyderef A V3588) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V3588) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))))) (begin (kl:shen.unbindv V3393 V3588) Result))) #f))))) (begin (kl:shen.unbindv V3381 V3588) Result)))) #f))) #f)) #f)) #f)) #f))) #f))) #f)) #f)) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3394 (kl:shen.lazyderef V3586 V3588))) (if (pair? V3394) (let ((V3395 (kl:shen.lazyderef (car V3394) V3588))) (if (pair? V3395) (let ((V3396 (kl:shen.lazyderef (car V3395) V3588))) (if (pair? V3396) (let ((V3397 (kl:shen.lazyderef (car V3396) V3588))) (if (eq? (quote _waspvm_at_s) V3397) (let ((V3398 (kl:shen.lazyderef (cdr V3396) V3588))) (if (pair? V3398) (let ((X (car V3398))) (let ((V3399 (kl:shen.lazyderef (cdr V3398) V3588))) (if (pair? V3399) (let ((Y (car V3399))) (let ((V3400 (kl:shen.lazyderef (cdr V3399) V3588))) (if (null? V3400) (let ((V3401 (kl:shen.lazyderef (cdr V3395) V3588))) (if (pair? V3401) (let ((V3402 (kl:shen.lazyderef (car V3401) V3588))) (if (eq? (quote :) V3402) (let ((V3403 (kl:shen.lazyderef (cdr V3401) V3588))) (if (pair? V3403) (let ((V3404 (kl:shen.lazyderef (car V3403) V3588))) (if (eq? (quote string) V3404) (let ((V3405 (kl:shen.lazyderef (cdr V3403) V3588))) (if (null? V3405) (let ((Hyp (cdr V3394))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (quote string) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (quote string) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))) (if (kl:shen.pvar? V3405) (begin (kl:shen.bindv V3405 (quote ()) V3588) (let ((Result (let ((Hyp (cdr V3394))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (quote string) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (quote string) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))))) (begin (kl:shen.unbindv V3405 V3588) Result))) #f))) (if (kl:shen.pvar? V3404) (begin (kl:shen.bindv V3404 (quote string) V3588) (let ((Result (let ((V3406 (kl:shen.lazyderef (cdr V3403) V3588))) (if (null? V3406) (let ((Hyp (cdr V3394))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (quote string) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (quote string) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))) (if (kl:shen.pvar? V3406) (begin (kl:shen.bindv V3406 (quote ()) V3588) (let ((Result (let ((Hyp (cdr V3394))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (cons (kl:shen.lazyderef X V3588) (cons (quote :) (cons (quote string) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3588) (cons (quote :) (cons (quote string) (quote ())))) (kl:shen.lazyderef Hyp V3588))) V3588 V3589))))) (begin (kl:shen.unbindv V3406 V3588) Result))) #f))))) (begin (kl:shen.unbindv V3404 V3588) Result))) #f))) #f)) #f)) #f)) #f))) #f))) #f)) #f)) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((V3407 (kl:shen.lazyderef V3586 V3588))) (if (pair? V3407) (let ((X (car V3407))) (let ((Hyp (cdr V3407))) (let ((NewHyps (kl:shen.newpv V3588))) (begin (kl:shen.incinfs) (kl:bind V3587 (cons (kl:shen.lazyderef X V3588) (kl:shen.lazyderef NewHyps V3588)) V3588 (lambda () (kl:shen.t*-hyps Hyp NewHyps V3588 V3589))))))) #f)) Case)) Case)) Case)) Case))) (export shen.t*-hyps) (quote shen.t*-hyps)) +(begin (register-function-arity (quote shen.show) 4) (define (kl:shen.show V3606 V3607 V3608 V3609) (cond ((assert-boolean (kl:value (quote shen.*spy*))) (begin (kl:shen.line) (begin (kl:shen.show-p (kl:shen.deref V3606 V3608)) (begin (kl:nl 1) (begin (kl:nl 1) (begin (kl:shen.show-assumptions (kl:shen.deref V3607 V3608) 1) (begin (kl:shen.prhush "\n> " (kl:stoutput)) (begin (kl:shen.pause-for-user) (kl:thaw V3609))))))))) (#t (kl:thaw V3609)))) (export shen.show) (quote shen.show)) +(begin (register-function-arity (quote shen.line) 0) (define (kl:shen.line) (let ((Infs (kl:inferences))) (kl:shen.prhush (string-append "____________________________________________________________ " (kl:shen.app Infs (string-append " inference" (kl:shen.app (if (kl:= 1 Infs) "" "s") " \n?- " (quote shen.a))) (quote shen.a))) (kl:stoutput)))) (export shen.line) (quote shen.line)) +(begin (register-function-arity (quote shen.show-p) 1) (define (kl:shen.show-p V3611) (cond ((and (pair? V3611) (and (pair? (cdr V3611)) (and (eq? (quote :) (car (cdr V3611))) (and (pair? (cdr (cdr V3611))) (null? (cdr (cdr (cdr V3611)))))))) (kl:shen.prhush (kl:shen.app (car V3611) (string-append " : " (kl:shen.app (car (cdr (cdr V3611))) "" (quote shen.r))) (quote shen.r)) (kl:stoutput))) (#t (kl:shen.prhush (kl:shen.app V3611 "" (quote shen.r)) (kl:stoutput))))) (export shen.show-p) (quote shen.show-p)) +(begin (register-function-arity (quote shen.show-assumptions) 2) (define (kl:shen.show-assumptions V3616 V3617) (cond ((null? V3616) (quote shen.skip)) ((pair? V3616) (begin (kl:shen.prhush (kl:shen.app V3617 ". " (quote shen.a)) (kl:stoutput)) (begin (kl:shen.show-p (car V3616)) (begin (kl:nl 1) (kl:shen.show-assumptions (cdr V3616) (+ V3617 1)))))) (#t (kl:shen.f_error (quote shen.show-assumptions))))) (export shen.show-assumptions) (quote shen.show-assumptions)) +(begin (register-function-arity (quote shen.pause-for-user) 0) (define (kl:shen.pause-for-user) (let ((Byte (read-u8 (kl:stinput)))) (if (kl:= Byte 94) (simple-error "input aborted\n") (kl:nl 1)))) (export shen.pause-for-user) (quote shen.pause-for-user)) +(begin (register-function-arity (quote shen.typedf?) 1) (define (kl:shen.typedf? V3619) (pair? (kl:assoc V3619 (kl:value (quote shen.*signedfuncs*))))) (export shen.typedf?) (quote shen.typedf?)) +(begin (register-function-arity (quote shen.sigf) 1) (define (kl:shen.sigf V3621) (kl:concat (quote shen.type-signature-of-) V3621)) (export shen.sigf) (quote shen.sigf)) +(begin (register-function-arity (quote shen.placeholder) 0) (define (kl:shen.placeholder) (kl:gensym (quote &&))) (export shen.placeholder) (quote shen.placeholder)) +(begin (register-function-arity (quote shen.base) 4) (define (kl:shen.base V3626 V3627 V3628 V3629) (let ((Case (let ((V3310 (kl:shen.lazyderef V3627 V3628))) (if (eq? (quote number) V3310) (begin (kl:shen.incinfs) (kl:fwhen (number? (kl:shen.lazyderef V3626 V3628)) V3628 V3629)) (if (kl:shen.pvar? V3310) (begin (kl:shen.bindv V3310 (quote number) V3628) (let ((Result (begin (kl:shen.incinfs) (kl:fwhen (number? (kl:shen.lazyderef V3626 V3628)) V3628 V3629)))) (begin (kl:shen.unbindv V3310 V3628) Result))) #f))))) (if (kl:= Case #f) (let ((Case (let ((V3311 (kl:shen.lazyderef V3627 V3628))) (if (eq? (quote boolean) V3311) (begin (kl:shen.incinfs) (kl:fwhen (kl:boolean? (kl:shen.lazyderef V3626 V3628)) V3628 V3629)) (if (kl:shen.pvar? V3311) (begin (kl:shen.bindv V3311 (quote boolean) V3628) (let ((Result (begin (kl:shen.incinfs) (kl:fwhen (kl:boolean? (kl:shen.lazyderef V3626 V3628)) V3628 V3629)))) (begin (kl:shen.unbindv V3311 V3628) Result))) #f))))) (if (kl:= Case #f) (let ((Case (let ((V3312 (kl:shen.lazyderef V3627 V3628))) (if (eq? (quote string) V3312) (begin (kl:shen.incinfs) (kl:fwhen (string? (kl:shen.lazyderef V3626 V3628)) V3628 V3629)) (if (kl:shen.pvar? V3312) (begin (kl:shen.bindv V3312 (quote string) V3628) (let ((Result (begin (kl:shen.incinfs) (kl:fwhen (string? (kl:shen.lazyderef V3626 V3628)) V3628 V3629)))) (begin (kl:shen.unbindv V3312 V3628) Result))) #f))))) (if (kl:= Case #f) (let ((Case (let ((V3313 (kl:shen.lazyderef V3627 V3628))) (if (eq? (quote symbol) V3313) (begin (kl:shen.incinfs) (kl:fwhen (kl:symbol? (kl:shen.lazyderef V3626 V3628)) V3628 (lambda () (kl:fwhen (kl:not (kl:shen.ue? (kl:shen.lazyderef V3626 V3628))) V3628 V3629)))) (if (kl:shen.pvar? V3313) (begin (kl:shen.bindv V3313 (quote symbol) V3628) (let ((Result (begin (kl:shen.incinfs) (kl:fwhen (kl:symbol? (kl:shen.lazyderef V3626 V3628)) V3628 (lambda () (kl:fwhen (kl:not (kl:shen.ue? (kl:shen.lazyderef V3626 V3628))) V3628 V3629)))))) (begin (kl:shen.unbindv V3313 V3628) Result))) #f))))) (if (kl:= Case #f) (let ((V3314 (kl:shen.lazyderef V3626 V3628))) (if (null? V3314) (let ((V3315 (kl:shen.lazyderef V3627 V3628))) (if (pair? V3315) (let ((V3316 (kl:shen.lazyderef (car V3315) V3628))) (if (eq? (quote list) V3316) (let ((V3317 (kl:shen.lazyderef (cdr V3315) V3628))) (if (pair? V3317) (let ((A (car V3317))) (let ((V3318 (kl:shen.lazyderef (cdr V3317) V3628))) (if (null? V3318) (begin (kl:shen.incinfs) (kl:thaw V3629)) (if (kl:shen.pvar? V3318) (begin (kl:shen.bindv V3318 (quote ()) V3628) (let ((Result (begin (kl:shen.incinfs) (kl:thaw V3629)))) (begin (kl:shen.unbindv V3318 V3628) Result))) #f)))) (if (kl:shen.pvar? V3317) (let ((A (kl:shen.newpv V3628))) (begin (kl:shen.bindv V3317 (cons A (quote ())) V3628) (let ((Result (begin (kl:shen.incinfs) (kl:thaw V3629)))) (begin (kl:shen.unbindv V3317 V3628) Result)))) #f))) (if (kl:shen.pvar? V3316) (begin (kl:shen.bindv V3316 (quote list) V3628) (let ((Result (let ((V3319 (kl:shen.lazyderef (cdr V3315) V3628))) (if (pair? V3319) (let ((A (car V3319))) (let ((V3320 (kl:shen.lazyderef (cdr V3319) V3628))) (if (null? V3320) (begin (kl:shen.incinfs) (kl:thaw V3629)) (if (kl:shen.pvar? V3320) (begin (kl:shen.bindv V3320 (quote ()) V3628) (let ((Result (begin (kl:shen.incinfs) (kl:thaw V3629)))) (begin (kl:shen.unbindv V3320 V3628) Result))) #f)))) (if (kl:shen.pvar? V3319) (let ((A (kl:shen.newpv V3628))) (begin (kl:shen.bindv V3319 (cons A (quote ())) V3628) (let ((Result (begin (kl:shen.incinfs) (kl:thaw V3629)))) (begin (kl:shen.unbindv V3319 V3628) Result)))) #f))))) (begin (kl:shen.unbindv V3316 V3628) Result))) #f))) (if (kl:shen.pvar? V3315) (let ((A (kl:shen.newpv V3628))) (begin (kl:shen.bindv V3315 (cons (quote list) (cons A (quote ()))) V3628) (let ((Result (begin (kl:shen.incinfs) (kl:thaw V3629)))) (begin (kl:shen.unbindv V3315 V3628) Result)))) #f))) #f)) Case)) Case)) Case)) Case))) (export shen.base) (quote shen.base)) +(begin (register-function-arity (quote shen.by_hypothesis) 5) (define (kl:shen.by_hypothesis V3635 V3636 V3637 V3638 V3639) (let ((Case (let ((V3301 (kl:shen.lazyderef V3637 V3638))) (if (pair? V3301) (let ((V3302 (kl:shen.lazyderef (car V3301) V3638))) (if (pair? V3302) (let ((Y (car V3302))) (let ((V3303 (kl:shen.lazyderef (cdr V3302) V3638))) (if (pair? V3303) (let ((V3304 (kl:shen.lazyderef (car V3303) V3638))) (if (eq? (quote :) V3304) (let ((V3305 (kl:shen.lazyderef (cdr V3303) V3638))) (if (pair? V3305) (let ((B (car V3305))) (let ((V3306 (kl:shen.lazyderef (cdr V3305) V3638))) (if (null? V3306) (begin (kl:shen.incinfs) (kl:identical V3635 Y V3638 (lambda () (kl:unify! V3636 B V3638 V3639)))) #f))) #f)) #f)) #f))) #f)) #f)))) (if (kl:= Case #f) (let ((V3307 (kl:shen.lazyderef V3637 V3638))) (if (pair? V3307) (let ((Hyp (cdr V3307))) (begin (kl:shen.incinfs) (kl:shen.by_hypothesis V3635 V3636 Hyp V3638 V3639))) #f)) Case))) (export shen.by_hypothesis) (quote shen.by_hypothesis)) +(begin (register-function-arity (quote shen.t*-def) 5) (define (kl:shen.t*-def V3645 V3646 V3647 V3648 V3649) (let ((V3295 (kl:shen.lazyderef V3645 V3648))) (if (pair? V3295) (let ((V3296 (kl:shen.lazyderef (car V3295) V3648))) (if (eq? (quote define) V3296) (let ((V3297 (kl:shen.lazyderef (cdr V3295) V3648))) (if (pair? V3297) (let ((F (car V3297))) (let ((X (cdr V3297))) (let ((Y (kl:shen.newpv V3648))) (let ((E (kl:shen.newpv V3648))) (begin (kl:shen.incinfs) (kl:shen.t*-defh (kl:compile (lambda (Y) (kl:shen. Y)) X (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")))) F V3646 V3647 V3648 V3649)))))) #f)) #f)) #f))) (export shen.t*-def) (quote shen.t*-def)) +(begin (register-function-arity (quote shen.t*-defh) 6) (define (kl:shen.t*-defh V3656 V3657 V3658 V3659 V3660 V3661) (let ((V3291 (kl:shen.lazyderef V3656 V3660))) (if (pair? V3291) (let ((Sig (car V3291))) (let ((Rules (cdr V3291))) (begin (kl:shen.incinfs) (kl:shen.t*-defhh Sig (kl:shen.ue-sig Sig) V3657 V3658 V3659 Rules V3660 V3661)))) #f))) (export shen.t*-defh) (quote shen.t*-defh)) +(begin (register-function-arity (quote shen.t*-defhh) 8) (define (kl:shen.t*-defhh V3670 V3671 V3672 V3673 V3674 V3675 V3676 V3677) (begin (kl:shen.incinfs) (kl:shen.t*-rules V3675 V3671 1 V3672 (cons (cons V3672 (cons (quote :) (cons V3671 (quote ())))) V3674) V3676 (lambda () (kl:shen.memo V3672 V3670 V3673 V3676 V3677))))) (export shen.t*-defhh) (quote shen.t*-defhh)) +(begin (register-function-arity (quote shen.memo) 5) (define (kl:shen.memo V3683 V3684 V3685 V3686 V3687) (let ((Jnk (kl:shen.newpv V3686))) (begin (kl:shen.incinfs) (kl:unify! V3685 V3684 V3686 (lambda () (kl:bind Jnk (kl:declare (kl:shen.lazyderef V3683 V3686) (kl:shen.lazyderef V3685 V3686)) V3686 V3687)))))) (export shen.memo) (quote shen.memo)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V3689) (let ((Parse_shen. (kl:shen. V3689))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail)))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V3691) (let ((YaccParse (let ((Parse_shen. (kl:shen. V3691))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (let ((Parse_shen. (kl:shen. Parse_shen.))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (kl:shen.hdtl Parse_shen.))) (kl:fail))) (kl:fail))))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_shen. (kl:shen. V3691))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (kl:shen.pair (car Parse_shen.) (cons (kl:shen.hdtl Parse_shen.) (quote ()))) (kl:fail))) YaccParse))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.ue) 1) (define (kl:shen.ue V3693) (cond ((and (pair? V3693) (and (pair? (cdr V3693)) (and (null? (cdr (cdr V3693))) (eq? (car V3693) (quote protect))))) V3693) ((pair? V3693) (kl:map (lambda (Z) (kl:shen.ue Z)) V3693)) ((kl:variable? V3693) (kl:concat (quote &&) V3693)) (#t V3693))) (export shen.ue) (quote shen.ue)) +(begin (register-function-arity (quote shen.ue-sig) 1) (define (kl:shen.ue-sig V3695) (cond ((pair? V3695) (kl:map (lambda (Z) (kl:shen.ue-sig Z)) V3695)) ((kl:variable? V3695) (kl:concat (quote &&&) V3695)) (#t V3695))) (export shen.ue-sig) (quote shen.ue-sig)) +(begin (register-function-arity (quote shen.ues) 1) (define (kl:shen.ues V3701) (cond ((assert-boolean (kl:shen.ue? V3701)) (cons V3701 (quote ()))) ((pair? V3701) (kl:union (kl:shen.ues (car V3701)) (kl:shen.ues (cdr V3701)))) (#t (quote ())))) (export shen.ues) (quote shen.ues)) +(begin (register-function-arity (quote shen.ue?) 1) (define (kl:shen.ue? V3703) (and (kl:symbol? V3703) (assert-boolean (kl:shen.ue-h? (kl:str V3703))))) (export shen.ue?) (quote shen.ue?)) +(begin (register-function-arity (quote shen.ue-h?) 1) (define (kl:shen.ue-h? V3711) (cond ((and (assert-boolean (kl:shen.+string? V3711)) (and (equal? "&" (make-string 1 (string-ref V3711 0))) (and (assert-boolean (kl:shen.+string? (string-tail V3711 1))) (equal? "&" (make-string 1 (string-ref (string-tail V3711 1) 0)))))) #t) (#t #f))) (export shen.ue-h?) (quote shen.ue-h?)) +(begin (register-function-arity (quote shen.t*-rules) 7) (define (kl:shen.t*-rules V3719 V3720 V3721 V3722 V3723 V3724 V3725) (let ((Throwcontrol (kl:shen.catchpoint))) (kl:shen.cutpoint Throwcontrol (let ((Case (let ((V3275 (kl:shen.lazyderef V3719 V3724))) (if (null? V3275) (begin (kl:shen.incinfs) (kl:thaw V3725)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3276 (kl:shen.lazyderef V3719 V3724))) (if (pair? V3276) (let ((Rule (car V3276))) (let ((Rules (cdr V3276))) (begin (kl:shen.incinfs) (kl:shen.t*-rule (kl:shen.ue Rule) V3720 V3723 V3724 (lambda () (kl:cut Throwcontrol V3724 (lambda () (kl:shen.t*-rules Rules V3720 (+ V3721 1) V3722 V3723 V3724 V3725)))))))) #f)))) (if (kl:= Case #f) (let ((Err (kl:shen.newpv V3724))) (begin (kl:shen.incinfs) (kl:bind Err (simple-error (string-append "type error in rule " (kl:shen.app (kl:shen.lazyderef V3721 V3724) (string-append " of " (kl:shen.app (kl:shen.lazyderef V3722 V3724) "" (quote shen.a))) (quote shen.a)))) V3724 V3725))) Case)) Case))))) (export shen.t*-rules) (quote shen.t*-rules)) +(begin (register-function-arity (quote shen.t*-rule) 5) (define (kl:shen.t*-rule V3731 V3732 V3733 V3734 V3735) (let ((Throwcontrol (kl:shen.catchpoint))) (kl:shen.cutpoint Throwcontrol (let ((V3267 (kl:shen.lazyderef V3731 V3734))) (if (pair? V3267) (let ((Patterns (car V3267))) (let ((V3268 (kl:shen.lazyderef (cdr V3267) V3734))) (if (pair? V3268) (let ((Action (car V3268))) (let ((V3269 (kl:shen.lazyderef (cdr V3268) V3734))) (if (null? V3269) (let ((NewHyps (kl:shen.newpv V3734))) (begin (kl:shen.incinfs) (kl:shen.newhyps (kl:shen.placeholders Patterns) V3733 NewHyps V3734 (lambda () (kl:shen.t*-patterns Patterns V3732 NewHyps V3734 (lambda () (kl:cut Throwcontrol V3734 (lambda () (kl:shen.t*-action (kl:shen.curry (kl:shen.ue Action)) (kl:shen.result-type Patterns V3732) (kl:shen.patthyps Patterns V3732 V3733) V3734 V3735))))))))) #f))) #f))) #f))))) (export shen.t*-rule) (quote shen.t*-rule)) +(begin (register-function-arity (quote shen.placeholders) 1) (define (kl:shen.placeholders V3741) (cond ((assert-boolean (kl:shen.ue? V3741)) (cons V3741 (quote ()))) ((pair? V3741) (kl:union (kl:shen.placeholders (car V3741)) (kl:shen.placeholders (cdr V3741)))) (#t (quote ())))) (export shen.placeholders) (quote shen.placeholders)) +(begin (register-function-arity (quote shen.newhyps) 5) (define (kl:shen.newhyps V3747 V3748 V3749 V3750 V3751) (let ((Case (let ((V3254 (kl:shen.lazyderef V3747 V3750))) (if (null? V3254) (begin (kl:shen.incinfs) (kl:unify! V3749 V3748 V3750 V3751)) #f)))) (if (kl:= Case #f) (let ((V3255 (kl:shen.lazyderef V3747 V3750))) (if (pair? V3255) (let ((V3250 (car V3255))) (let ((Vs (cdr V3255))) (let ((V3256 (kl:shen.lazyderef V3749 V3750))) (if (pair? V3256) (let ((V3257 (kl:shen.lazyderef (car V3256) V3750))) (if (pair? V3257) (let ((V (car V3257))) (let ((V3258 (kl:shen.lazyderef (cdr V3257) V3750))) (if (pair? V3258) (let ((V3259 (kl:shen.lazyderef (car V3258) V3750))) (if (eq? (quote :) V3259) (let ((V3260 (kl:shen.lazyderef (cdr V3258) V3750))) (if (pair? V3260) (let ((A (car V3260))) (let ((V3261 (kl:shen.lazyderef (cdr V3260) V3750))) (if (null? V3261) (let ((NewHyp (cdr V3256))) (begin (kl:shen.incinfs) (kl:unify! V V3250 V3750 (lambda () (kl:shen.newhyps Vs V3748 NewHyp V3750 V3751))))) (if (kl:shen.pvar? V3261) (begin (kl:shen.bindv V3261 (quote ()) V3750) (let ((Result (let ((NewHyp (cdr V3256))) (begin (kl:shen.incinfs) (kl:unify! V V3250 V3750 (lambda () (kl:shen.newhyps Vs V3748 NewHyp V3750 V3751))))))) (begin (kl:shen.unbindv V3261 V3750) Result))) #f)))) (if (kl:shen.pvar? V3260) (let ((A (kl:shen.newpv V3750))) (begin (kl:shen.bindv V3260 (cons A (quote ())) V3750) (let ((Result (let ((NewHyp (cdr V3256))) (begin (kl:shen.incinfs) (kl:unify! V V3250 V3750 (lambda () (kl:shen.newhyps Vs V3748 NewHyp V3750 V3751))))))) (begin (kl:shen.unbindv V3260 V3750) Result)))) #f))) (if (kl:shen.pvar? V3259) (begin (kl:shen.bindv V3259 (quote :) V3750) (let ((Result (let ((V3262 (kl:shen.lazyderef (cdr V3258) V3750))) (if (pair? V3262) (let ((A (car V3262))) (let ((V3263 (kl:shen.lazyderef (cdr V3262) V3750))) (if (null? V3263) (let ((NewHyp (cdr V3256))) (begin (kl:shen.incinfs) (kl:unify! V V3250 V3750 (lambda () (kl:shen.newhyps Vs V3748 NewHyp V3750 V3751))))) (if (kl:shen.pvar? V3263) (begin (kl:shen.bindv V3263 (quote ()) V3750) (let ((Result (let ((NewHyp (cdr V3256))) (begin (kl:shen.incinfs) (kl:unify! V V3250 V3750 (lambda () (kl:shen.newhyps Vs V3748 NewHyp V3750 V3751))))))) (begin (kl:shen.unbindv V3263 V3750) Result))) #f)))) (if (kl:shen.pvar? V3262) (let ((A (kl:shen.newpv V3750))) (begin (kl:shen.bindv V3262 (cons A (quote ())) V3750) (let ((Result (let ((NewHyp (cdr V3256))) (begin (kl:shen.incinfs) (kl:unify! V V3250 V3750 (lambda () (kl:shen.newhyps Vs V3748 NewHyp V3750 V3751))))))) (begin (kl:shen.unbindv V3262 V3750) Result)))) #f))))) (begin (kl:shen.unbindv V3259 V3750) Result))) #f))) (if (kl:shen.pvar? V3258) (let ((A (kl:shen.newpv V3750))) (begin (kl:shen.bindv V3258 (cons (quote :) (cons A (quote ()))) V3750) (let ((Result (let ((NewHyp (cdr V3256))) (begin (kl:shen.incinfs) (kl:unify! V V3250 V3750 (lambda () (kl:shen.newhyps Vs V3748 NewHyp V3750 V3751))))))) (begin (kl:shen.unbindv V3258 V3750) Result)))) #f)))) (if (kl:shen.pvar? V3257) (let ((V (kl:shen.newpv V3750))) (let ((A (kl:shen.newpv V3750))) (begin (kl:shen.bindv V3257 (cons V (cons (quote :) (cons A (quote ())))) V3750) (let ((Result (let ((NewHyp (cdr V3256))) (begin (kl:shen.incinfs) (kl:unify! V V3250 V3750 (lambda () (kl:shen.newhyps Vs V3748 NewHyp V3750 V3751))))))) (begin (kl:shen.unbindv V3257 V3750) Result))))) #f))) (if (kl:shen.pvar? V3256) (let ((V (kl:shen.newpv V3750))) (let ((A (kl:shen.newpv V3750))) (let ((NewHyp (kl:shen.newpv V3750))) (begin (kl:shen.bindv V3256 (cons (cons V (cons (quote :) (cons A (quote ())))) NewHyp) V3750) (let ((Result (begin (kl:shen.incinfs) (kl:unify! V V3250 V3750 (lambda () (kl:shen.newhyps Vs V3748 NewHyp V3750 V3751)))))) (begin (kl:shen.unbindv V3256 V3750) Result)))))) #f))))) #f)) Case))) (export shen.newhyps) (quote shen.newhyps)) +(begin (register-function-arity (quote shen.patthyps) 3) (define (kl:shen.patthyps V3757 V3758 V3759) (cond ((null? V3757) V3759) ((and (pair? V3757) (and (pair? V3758) (and (pair? (cdr V3758)) (and (eq? (quote -->) (car (cdr V3758))) (and (pair? (cdr (cdr V3758))) (null? (cdr (cdr (cdr V3758))))))))) (kl:adjoin (cons (car V3757) (cons (quote :) (cons (car V3758) (quote ())))) (kl:shen.patthyps (cdr V3757) (car (cdr (cdr V3758))) V3759))) (#t (kl:shen.f_error (quote shen.patthyps))))) (export shen.patthyps) (quote shen.patthyps)) +(begin (register-function-arity (quote shen.result-type) 2) (define (kl:shen.result-type V3766 V3767) (cond ((and (null? V3766) (and (pair? V3767) (and (eq? (quote -->) (car V3767)) (and (pair? (cdr V3767)) (null? (cdr (cdr V3767))))))) (car (cdr V3767))) ((null? V3766) V3767) ((and (pair? V3766) (and (pair? V3767) (and (pair? (cdr V3767)) (and (eq? (quote -->) (car (cdr V3767))) (and (pair? (cdr (cdr V3767))) (null? (cdr (cdr (cdr V3767))))))))) (kl:shen.result-type (cdr V3766) (car (cdr (cdr V3767))))) (#t (kl:shen.f_error (quote shen.result-type))))) (export shen.result-type) (quote shen.result-type)) +(begin (register-function-arity (quote shen.t*-patterns) 5) (define (kl:shen.t*-patterns V3773 V3774 V3775 V3776 V3777) (let ((Case (let ((V3242 (kl:shen.lazyderef V3773 V3776))) (if (null? V3242) (begin (kl:shen.incinfs) (kl:thaw V3777)) #f)))) (if (kl:= Case #f) (let ((V3243 (kl:shen.lazyderef V3773 V3776))) (if (pair? V3243) (let ((Pattern (car V3243))) (let ((Patterns (cdr V3243))) (let ((V3244 (kl:shen.lazyderef V3774 V3776))) (if (pair? V3244) (let ((A (car V3244))) (let ((V3245 (kl:shen.lazyderef (cdr V3244) V3776))) (if (pair? V3245) (let ((V3246 (kl:shen.lazyderef (car V3245) V3776))) (if (eq? (quote -->) V3246) (let ((V3247 (kl:shen.lazyderef (cdr V3245) V3776))) (if (pair? V3247) (let ((B (car V3247))) (let ((V3248 (kl:shen.lazyderef (cdr V3247) V3776))) (if (null? V3248) (begin (kl:shen.incinfs) (kl:shen.t* (cons Pattern (cons (quote :) (cons A (quote ())))) V3775 V3776 (lambda () (kl:shen.t*-patterns Patterns B V3775 V3776 V3777)))) #f))) #f)) #f)) #f))) #f)))) #f)) Case))) (export shen.t*-patterns) (quote shen.t*-patterns)) +(begin (register-function-arity (quote shen.t*-action) 5) (define (kl:shen.t*-action V3783 V3784 V3785 V3786 V3787) (let ((Throwcontrol (kl:shen.catchpoint))) (kl:shen.cutpoint Throwcontrol (let ((Case (let ((V3219 (kl:shen.lazyderef V3783 V3786))) (if (pair? V3219) (let ((V3220 (kl:shen.lazyderef (car V3219) V3786))) (if (eq? (quote where) V3220) (let ((V3221 (kl:shen.lazyderef (cdr V3219) V3786))) (if (pair? V3221) (let ((P (car V3221))) (let ((V3222 (kl:shen.lazyderef (cdr V3221) V3786))) (if (pair? V3222) (let ((Action (car V3222))) (let ((V3223 (kl:shen.lazyderef (cdr V3222) V3786))) (if (null? V3223) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V3786 (lambda () (kl:shen.t* (cons P (cons (quote :) (cons (quote boolean) (quote ())))) V3785 V3786 (lambda () (kl:cut Throwcontrol V3786 (lambda () (kl:shen.t*-action Action V3784 (cons (cons P (cons (quote :) (cons (quote verified) (quote ())))) V3785) V3786 V3787)))))))) #f))) #f))) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3224 (kl:shen.lazyderef V3783 V3786))) (if (pair? V3224) (let ((V3225 (kl:shen.lazyderef (car V3224) V3786))) (if (eq? (quote shen.choicepoint!) V3225) (let ((V3226 (kl:shen.lazyderef (cdr V3224) V3786))) (if (pair? V3226) (let ((V3227 (kl:shen.lazyderef (car V3226) V3786))) (if (pair? V3227) (let ((V3228 (kl:shen.lazyderef (car V3227) V3786))) (if (pair? V3228) (let ((V3229 (kl:shen.lazyderef (car V3228) V3786))) (if (eq? (quote fail-if) V3229) (let ((V3230 (kl:shen.lazyderef (cdr V3228) V3786))) (if (pair? V3230) (let ((F (car V3230))) (let ((V3231 (kl:shen.lazyderef (cdr V3230) V3786))) (if (null? V3231) (let ((V3232 (kl:shen.lazyderef (cdr V3227) V3786))) (if (pair? V3232) (let ((Action (car V3232))) (let ((V3233 (kl:shen.lazyderef (cdr V3232) V3786))) (if (null? V3233) (let ((V3234 (kl:shen.lazyderef (cdr V3226) V3786))) (if (null? V3234) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V3786 (lambda () (kl:shen.t*-action (cons (quote where) (cons (cons (quote not) (cons (cons F (cons Action (quote ()))) (quote ()))) (cons Action (quote ())))) V3784 V3785 V3786 V3787)))) #f)) #f))) #f)) #f))) #f)) #f)) #f)) #f)) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3235 (kl:shen.lazyderef V3783 V3786))) (if (pair? V3235) (let ((V3236 (kl:shen.lazyderef (car V3235) V3786))) (if (eq? (quote shen.choicepoint!) V3236) (let ((V3237 (kl:shen.lazyderef (cdr V3235) V3786))) (if (pair? V3237) (let ((Action (car V3237))) (let ((V3238 (kl:shen.lazyderef (cdr V3237) V3786))) (if (null? V3238) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V3786 (lambda () (kl:shen.t*-action (cons (quote where) (cons (cons (quote not) (cons (cons (cons (quote =) (cons Action (quote ()))) (cons (cons (quote fail) (quote ())) (quote ()))) (quote ()))) (cons Action (quote ())))) V3784 V3785 V3786 V3787)))) #f))) #f)) #f)) #f)))) (if (kl:= Case #f) (begin (kl:shen.incinfs) (kl:shen.t* (cons V3783 (cons (quote :) (cons V3784 (quote ())))) V3785 V3786 V3787)) Case)) Case)) Case))))) (export shen.t*-action) (quote shen.t*-action)) +(begin (register-function-arity (quote findall) 5) (define (kl:findall V3793 V3794 V3795 V3796 V3797) (let ((B (kl:shen.newpv V3796))) (let ((A (kl:shen.newpv V3796))) (begin (kl:shen.incinfs) (kl:bind A (kl:gensym (quote shen.a)) V3796 (lambda () (kl:bind B (kl:set (kl:shen.lazyderef A V3796) (quote ())) V3796 (lambda () (kl:shen.findallhelp V3793 V3794 V3795 A V3796 V3797))))))))) (export findall) (quote findall)) +(begin (register-function-arity (quote shen.findallhelp) 6) (define (kl:shen.findallhelp V3804 V3805 V3806 V3807 V3808 V3809) (let ((Case (begin (kl:shen.incinfs) (kl:call V3805 V3808 (lambda () (kl:shen.remember V3807 V3804 V3808 (lambda () (kl:fwhen #f V3808 V3809)))))))) (if (kl:= Case #f) (begin (kl:shen.incinfs) (kl:bind V3806 (kl:value (kl:shen.lazyderef V3807 V3808)) V3808 V3809)) Case))) (export shen.findallhelp) (quote shen.findallhelp)) +(begin (register-function-arity (quote shen.remember) 4) (define (kl:shen.remember V3814 V3815 V3816 V3817) (let ((B (kl:shen.newpv V3816))) (begin (kl:shen.incinfs) (kl:bind B (kl:set (kl:shen.deref V3814 V3816) (cons (kl:shen.deref V3815 V3816) (kl:value (kl:shen.deref V3814 V3816)))) V3816 V3817)))) (export shen.remember) (quote shen.remember)) diff --git a/compiled/toplevel.kl.ms b/compiled/toplevel.kl.ms index 449574e..b2544c6 100644 --- a/compiled/toplevel.kl.ms +++ b/compiled/toplevel.kl.ms @@ -1,37 +1,38 @@ +(module "compiled/toplevel.kl") "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)) (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)) +(begin (register-function-arity (quote shen.shen) 0) (define (kl:shen.shen) (begin (kl:shen.credits) (kl:shen.loop))) (export shen.shen) (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)) (kl:shen.read-evaluate-print)) (kl:shen.loop))))) (export 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))) (export shen.toplevel-display-exception) (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)))))) (export shen.credits) (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 ()))))))))))) (export shen.initialise_environment) (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))))) (export shen.multiple-set) (quote shen.multiple-set)) +(begin (register-function-arity (quote destroy) 1) (define (kl:destroy V3823) (kl:declare V3823 (quote symbol))) (export destroy) (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:_waspvm_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 (make-string 1 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. 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:_waspvm_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. 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)) +(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))))))) (export shen.read-evaluate-print) (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:_waspvm_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))) (export shen.retrieve-from-history-if-needed) (quote shen.retrieve-from-history-if-needed)) +(begin (register-function-arity (quote shen.percent) 0) (define (kl:shen.percent) 37) (export shen.percent) (quote shen.percent)) +(begin (register-function-arity (quote shen.exclamation) 0) (define (kl:shen.exclamation) 33) (export shen.exclamation) (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 (make-string 1 Byte) (kl:stoutput))) V3838) (kl:nl 1))) (export shen.prbytes) (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))) (export shen.update_history) (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 ()))) (export shen.toplineread) (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. 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:_waspvm_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 ())))))))) (export shen.toplineread_loop) (quote shen.toplineread_loop)) +(begin (register-function-arity (quote shen.hat) 0) (define (kl:shen.hat) 94) (export shen.hat) (quote shen.hat)) +(begin (register-function-arity (quote shen.newline) 0) (define (kl:shen.newline) 10) (export shen.newline) (quote shen.newline)) +(begin (register-function-arity (quote shen.carriage-return) 0) (define (kl:shen.carriage-return) 13) (export shen.carriage-return) (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 -")))) (export tc) (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)))) (export shen.prompt) (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*)))) (export shen.toplevel) (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))) (export shen.find-past-inputs) (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. 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))))))) (export shen.make-key) (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))) (export shen.trim-gubbins) (quote shen.trim-gubbins)) +(begin (register-function-arity (quote shen.space) 0) (define (kl:shen.space) 32) (export shen.space) (quote shen.space)) +(begin (register-function-arity (quote shen.tab) 0) (define (kl:shen.tab) 9) (export shen.tab) (quote shen.tab)) +(begin (register-function-arity (quote shen.left-round) 0) (define (kl:shen.left-round) 40) (export shen.left-round) (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))))) (export 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))) (export shen.prefix?) (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))))) (export 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))))) (export 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))))))) (export shen.typecheck-and-evaluate) (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)) (export shen.pretty-type) (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 ())))) (export shen.extract-pvars) (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))))) (export shen.mult_subst) (quote shen.mult_subst)) diff --git a/compiled/track.kl.ms b/compiled/track.kl.ms index 8198a72..c70c43f 100644 --- a/compiled/track.kl.ms +++ b/compiled/track.kl.ms @@ -1,23 +1,24 @@ +(module "compiled/track.kl") "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)) +(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")))) (export shen.f_error) (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*)))) (export shen.tracked?) (quote shen.tracked?)) +(begin (register-function-arity (quote track) 1) (define (kl:track V3936) (let ((Source (kl:ps V3936))) (kl:shen.track-function Source))) (export track) (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))))) (export 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 ()))))) (export shen.insert-tracking-code) (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 (read-u8 (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:_waspvm_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) (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)) +(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")))) (export step) (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")))) (export spy) (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 (read-u8 (kl:value (quote *stinput*)))) (kl:nl 1))) (export shen.terpri-or-read-char) (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))) (export shen.check-byte) (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))) (export shen.input-track) (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))))) (export 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)))))) (export shen.spaces) (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))) (export shen.output-track) (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))))) (export untrack) (quote untrack)) +(begin (register-function-arity (quote profile) 1) (define (kl:profile V3982) (kl:shen.profile-help (kl:ps V3982))) (export profile) (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")))) (export shen.profile-help) (quote shen.profile-help)) +(begin (register-function-arity (quote unprofile) 1) (define (kl:unprofile V3990) (kl:untrack V3990)) (export unprofile) (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 ())))))) (export shen.profile-func) (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:_waspvm_at_p V3998 Results)))) (export profile-results) (quote profile-results)) +(begin (register-function-arity (quote shen.get-profile) 1) (define (kl:shen.get-profile V4000) (guard (lambda (E) 0) (kl:get V4000 (quote profile) (kl:value (quote *property-vector*))))) (export shen.get-profile) (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*)))) (export shen.put-profile) (quote shen.put-profile)) diff --git a/compiled/types.kl.ms b/compiled/types.kl.ms index a815662..3ae8346 100644 --- a/compiled/types.kl.ms +++ b/compiled/types.kl.ms @@ -1,8 +1,9 @@ +(module "compiled/types.kl") "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 declare) 2) (define (kl:declare V4007 V4008) (let ((Record (kl:set (quote shen.*signedfuncs*) (cons (cons V4007 V4008) (kl:value (quote shen.*signedfuncs*)))))) (let ((Variancy (guard (lambda (E) (quote shen.skip)) (kl:shen.variancy-test V4007 V4008)))) (let ((Type (kl:shen.rcons_form (kl:shen.demodulate V4008)))) (let ((F* (kl:concat (quote shen.type-signature-of-) V4007))) (let ((Parameters (kl:shen.parameters 1))) (let ((Clause (cons (cons F* (cons (quote X) (quote ()))) (cons (quote :-) (cons (cons (cons (quote unify!) (cons (quote X) (cons Type (quote ())))) (quote ())) (quote ())))))) (let ((AUM_instruction (kl:shen.aum Clause Parameters))) (let ((Code (kl:shen.aum_to_shen AUM_instruction))) (let ((ShenDef (cons (quote define) (cons F* (kl:append Parameters (kl:append (cons (quote ProcessN) (cons (quote Continuation) (quote ()))) (cons (quote ->) (cons Code (quote ()))))))))) (let ((Eval (kl:shen.eval-without-macros ShenDef))) V4007))))))))))) (quote declare)) -(begin (register-function-arity (quote shen.demodulate) 1) (define (kl:shen.demodulate V4010) (let ((Demod (kl:shen.walk (kl:value (quote shen.*demodulation-function*)) V4010))) (if (kl:= Demod V4010) V4010 (kl:shen.demodulate Demod)))) (quote shen.demodulate)) -(begin (register-function-arity (quote shen.variancy-test) 2) (define (kl:shen.variancy-test V4013 V4014) (let ((TypeF (kl:shen.typecheck V4013 (quote B)))) (let ((Check (if (eq? (quote symbol) TypeF) (quote shen.skip) (if (assert-boolean (kl:shen.variant? TypeF V4014)) (quote shen.skip) (kl:shen.prhush (string-append "warning: changing the type of " (kl:shen.app V4013 " may create errors\n" (quote shen.a))) (kl:stoutput)))))) (quote shen.skip)))) (quote shen.variancy-test)) -(begin (register-function-arity (quote shen.variant?) 2) (define (kl:shen.variant? V4027 V4028) (cond ((kl:= V4028 V4027) #t) ((and (pair? V4027) (and (pair? V4028) (kl:= (car V4028) (car V4027)))) (kl:shen.variant? (cdr V4027) (cdr V4028))) ((and (pair? V4027) (and (pair? V4028) (and (kl:shen.pvar? (car V4027)) (kl:variable? (car V4028))))) (kl:shen.variant? (kl:subst (quote shen.a) (car V4027) (cdr V4027)) (kl:subst (quote shen.a) (car V4028) (cdr V4028)))) ((and (pair? V4027) (and (pair? (car V4027)) (and (pair? V4028) (pair? (car V4028))))) (kl:shen.variant? (kl:append (car V4027) (cdr V4027)) (kl:append (car V4028) (cdr V4028)))) (#t #f))) (quote shen.variant?)) +(begin (register-function-arity (quote declare) 2) (define (kl:declare V4007 V4008) (let ((Record (kl:set (quote shen.*signedfuncs*) (cons (cons V4007 V4008) (kl:value (quote shen.*signedfuncs*)))))) (let ((Variancy (guard (lambda (E) (quote shen.skip)) (kl:shen.variancy-test V4007 V4008)))) (let ((Type (kl:shen.rcons_form (kl:shen.demodulate V4008)))) (let ((F* (kl:concat (quote shen.type-signature-of-) V4007))) (let ((Parameters (kl:shen.parameters 1))) (let ((Clause (cons (cons F* (cons (quote X) (quote ()))) (cons (quote :-) (cons (cons (cons (quote unify!) (cons (quote X) (cons Type (quote ())))) (quote ())) (quote ())))))) (let ((AUM_instruction (kl:shen.aum Clause Parameters))) (let ((Code (kl:shen.aum_to_shen AUM_instruction))) (let ((ShenDef (cons (quote define) (cons F* (kl:append Parameters (kl:append (cons (quote ProcessN) (cons (quote Continuation) (quote ()))) (cons (quote ->) (cons Code (quote ()))))))))) (let ((Eval (kl:shen.eval-without-macros ShenDef))) V4007))))))))))) (export declare) (quote declare)) +(begin (register-function-arity (quote shen.demodulate) 1) (define (kl:shen.demodulate V4010) (let ((Demod (kl:shen.walk (kl:value (quote shen.*demodulation-function*)) V4010))) (if (kl:= Demod V4010) V4010 (kl:shen.demodulate Demod)))) (export shen.demodulate) (quote shen.demodulate)) +(begin (register-function-arity (quote shen.variancy-test) 2) (define (kl:shen.variancy-test V4013 V4014) (let ((TypeF (kl:shen.typecheck V4013 (quote B)))) (let ((Check (if (eq? (quote symbol) TypeF) (quote shen.skip) (if (assert-boolean (kl:shen.variant? TypeF V4014)) (quote shen.skip) (kl:shen.prhush (string-append "warning: changing the type of " (kl:shen.app V4013 " may create errors\n" (quote shen.a))) (kl:stoutput)))))) (quote shen.skip)))) (export shen.variancy-test) (quote shen.variancy-test)) +(begin (register-function-arity (quote shen.variant?) 2) (define (kl:shen.variant? V4027 V4028) (cond ((kl:= V4028 V4027) #t) ((and (pair? V4027) (and (pair? V4028) (kl:= (car V4028) (car V4027)))) (kl:shen.variant? (cdr V4027) (cdr V4028))) ((and (pair? V4027) (and (pair? V4028) (and (kl:shen.pvar? (car V4027)) (kl:variable? (car V4028))))) (kl:shen.variant? (kl:subst (quote shen.a) (car V4027) (cdr V4027)) (kl:subst (quote shen.a) (car V4028) (cdr V4028)))) ((and (pair? V4027) (and (pair? (car V4027)) (and (pair? V4028) (pair? (car V4028))))) (kl:shen.variant? (kl:append (car V4027) (cdr V4027)) (kl:append (car V4028) (cdr V4028)))) (#t #f))) (export shen.variant?) (quote shen.variant?)) (kl:declare (quote absvector?) (cons (quote A) (cons (quote -->) (cons (quote boolean) (quote ()))))) (kl:declare (quote adjoin) (cons (quote A) (cons (quote -->) (cons (cons (cons (quote list) (cons (quote A) (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons (quote A) (quote ()))) (quote ())))) (quote ()))))) (kl:declare (quote and) (cons (quote boolean) (cons (quote -->) (cons (cons (quote boolean) (cons (quote -->) (cons (quote boolean) (quote ())))) (quote ()))))) diff --git a/compiled/writer.kl.ms b/compiled/writer.kl.ms index 0bce2f2..a9b1694 100644 --- a/compiled/writer.kl.ms +++ b/compiled/writer.kl.ms @@ -1,29 +1,30 @@ +(module "compiled/writer.kl") "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 pr) 2) (define (kl:pr V4031 V4032) (guard (lambda (E) V4031) (kl:shen.prh V4031 V4032 0))) (quote pr)) -(begin (register-function-arity (quote shen.prh) 3) (define (kl:shen.prh V4036 V4037 V4038) (kl:shen.prh V4036 V4037 (kl:shen.write-char-and-inc V4036 V4037 V4038))) (quote shen.prh)) -(begin (register-function-arity (quote shen.write-char-and-inc) 3) (define (kl:shen.write-char-and-inc V4042 V4043 V4044) (begin (write-u8 (string-ref (make-string 1 (string-ref V4042 V4044)) 0) V4043) (+ V4044 1))) (quote shen.write-char-and-inc)) -(begin (register-function-arity (quote print) 1) (define (kl:print V4046) (let ((String (kl:shen.insert V4046 "~S"))) (let ((Print (kl:shen.prhush String (kl:stoutput)))) V4046))) (quote print)) -(begin (register-function-arity (quote shen.prhush) 2) (define (kl:shen.prhush V4049 V4050) (if (assert-boolean (kl:value (quote *hush*))) V4049 (kl:pr V4049 V4050))) (quote shen.prhush)) -(begin (register-function-arity (quote shen.mkstr) 2) (define (kl:shen.mkstr V4053 V4054) (cond ((string? V4053) (kl:shen.mkstr-l (kl:shen.proc-nl V4053) V4054)) (#t (kl:shen.mkstr-r (cons (quote shen.proc-nl) (cons V4053 (quote ()))) V4054)))) (quote shen.mkstr)) -(begin (register-function-arity (quote shen.mkstr-l) 2) (define (kl:shen.mkstr-l V4057 V4058) (cond ((null? V4058) V4057) ((pair? V4058) (kl:shen.mkstr-l (kl:shen.insert-l (car V4058) V4057) (cdr V4058))) (#t (kl:shen.f_error (quote shen.mkstr-l))))) (quote shen.mkstr-l)) -(begin (register-function-arity (quote shen.insert-l) 2) (define (kl:shen.insert-l V4063 V4064) (cond ((equal? "" V4064) "") ((and (assert-boolean (kl:shen.+string? V4064)) (and (equal? "~" (make-string 1 (string-ref V4064 0))) (and (assert-boolean (kl:shen.+string? (string-tail V4064 1))) (equal? "A" (make-string 1 (string-ref (string-tail V4064 1) 0)))))) (cons (quote shen.app) (cons V4063 (cons (string-tail (string-tail V4064 1) 1) (cons (quote shen.a) (quote ())))))) ((and (assert-boolean (kl:shen.+string? V4064)) (and (equal? "~" (make-string 1 (string-ref V4064 0))) (and (assert-boolean (kl:shen.+string? (string-tail V4064 1))) (equal? "R" (make-string 1 (string-ref (string-tail V4064 1) 0)))))) (cons (quote shen.app) (cons V4063 (cons (string-tail (string-tail V4064 1) 1) (cons (quote shen.r) (quote ())))))) ((and (assert-boolean (kl:shen.+string? V4064)) (and (equal? "~" (make-string 1 (string-ref V4064 0))) (and (assert-boolean (kl:shen.+string? (string-tail V4064 1))) (equal? "S" (make-string 1 (string-ref (string-tail V4064 1) 0)))))) (cons (quote shen.app) (cons V4063 (cons (string-tail (string-tail V4064 1) 1) (cons (quote shen.s) (quote ())))))) ((assert-boolean (kl:shen.+string? V4064)) (kl:shen.factor-cn (cons (quote cn) (cons (make-string 1 (string-ref V4064 0)) (cons (kl:shen.insert-l V4063 (string-tail V4064 1)) (quote ())))))) ((and (pair? V4064) (and (eq? (quote cn) (car V4064)) (and (pair? (cdr V4064)) (and (pair? (cdr (cdr V4064))) (null? (cdr (cdr (cdr V4064)))))))) (cons (quote cn) (cons (car (cdr V4064)) (cons (kl:shen.insert-l V4063 (car (cdr (cdr V4064)))) (quote ()))))) ((and (pair? V4064) (and (eq? (quote shen.app) (car V4064)) (and (pair? (cdr V4064)) (and (pair? (cdr (cdr V4064))) (and (pair? (cdr (cdr (cdr V4064)))) (null? (cdr (cdr (cdr (cdr V4064)))))))))) (cons (quote shen.app) (cons (car (cdr V4064)) (cons (kl:shen.insert-l V4063 (car (cdr (cdr V4064)))) (cdr (cdr (cdr V4064))))))) (#t (kl:shen.f_error (quote shen.insert-l))))) (quote shen.insert-l)) -(begin (register-function-arity (quote shen.factor-cn) 1) (define (kl:shen.factor-cn V4066) (cond ((and (pair? V4066) (and (eq? (quote cn) (car V4066)) (and (pair? (cdr V4066)) (and (pair? (cdr (cdr V4066))) (and (pair? (car (cdr (cdr V4066)))) (and (eq? (quote cn) (car (car (cdr (cdr V4066))))) (and (pair? (cdr (car (cdr (cdr V4066))))) (and (pair? (cdr (cdr (car (cdr (cdr V4066)))))) (and (null? (cdr (cdr (cdr (car (cdr (cdr V4066))))))) (and (null? (cdr (cdr (cdr V4066)))) (and (string? (car (cdr V4066))) (string? (car (cdr (car (cdr (cdr V4066))))))))))))))))) (cons (quote cn) (cons (string-append (car (cdr V4066)) (car (cdr (car (cdr (cdr V4066)))))) (cdr (cdr (car (cdr (cdr V4066)))))))) (#t V4066))) (quote shen.factor-cn)) -(begin (register-function-arity (quote shen.proc-nl) 1) (define (kl:shen.proc-nl V4068) (cond ((equal? "" V4068) "") ((and (assert-boolean (kl:shen.+string? V4068)) (and (equal? "~" (make-string 1 (string-ref V4068 0))) (and (assert-boolean (kl:shen.+string? (string-tail V4068 1))) (equal? "%" (make-string 1 (string-ref (string-tail V4068 1) 0)))))) (string-append (make-string 1 10) (kl:shen.proc-nl (string-tail (string-tail V4068 1) 1)))) ((assert-boolean (kl:shen.+string? V4068)) (string-append (make-string 1 (string-ref V4068 0)) (kl:shen.proc-nl (string-tail V4068 1)))) (#t (kl:shen.f_error (quote shen.proc-nl))))) (quote shen.proc-nl)) -(begin (register-function-arity (quote shen.mkstr-r) 2) (define (kl:shen.mkstr-r V4071 V4072) (cond ((null? V4072) V4071) ((pair? V4072) (kl:shen.mkstr-r (cons (quote shen.insert) (cons (car V4072) (cons V4071 (quote ())))) (cdr V4072))) (#t (kl:shen.f_error (quote shen.mkstr-r))))) (quote shen.mkstr-r)) -(begin (register-function-arity (quote shen.insert) 2) (define (kl:shen.insert V4075 V4076) (kl:shen.insert-h V4075 V4076 "")) (quote shen.insert)) -(begin (register-function-arity (quote shen.insert-h) 3) (define (kl:shen.insert-h V4082 V4083 V4084) (cond ((equal? "" V4083) V4084) ((and (assert-boolean (kl:shen.+string? V4083)) (and (equal? "~" (make-string 1 (string-ref V4083 0))) (and (assert-boolean (kl:shen.+string? (string-tail V4083 1))) (equal? "A" (make-string 1 (string-ref (string-tail V4083 1) 0)))))) (string-append V4084 (kl:shen.app V4082 (string-tail (string-tail V4083 1) 1) (quote shen.a)))) ((and (assert-boolean (kl:shen.+string? V4083)) (and (equal? "~" (make-string 1 (string-ref V4083 0))) (and (assert-boolean (kl:shen.+string? (string-tail V4083 1))) (equal? "R" (make-string 1 (string-ref (string-tail V4083 1) 0)))))) (string-append V4084 (kl:shen.app V4082 (string-tail (string-tail V4083 1) 1) (quote shen.r)))) ((and (assert-boolean (kl:shen.+string? V4083)) (and (equal? "~" (make-string 1 (string-ref V4083 0))) (and (assert-boolean (kl:shen.+string? (string-tail V4083 1))) (equal? "S" (make-string 1 (string-ref (string-tail V4083 1) 0)))))) (string-append V4084 (kl:shen.app V4082 (string-tail (string-tail V4083 1) 1) (quote shen.s)))) ((assert-boolean (kl:shen.+string? V4083)) (kl:shen.insert-h V4082 (string-tail V4083 1) (string-append V4084 (make-string 1 (string-ref V4083 0))))) (#t (kl:shen.f_error (quote shen.insert-h))))) (quote shen.insert-h)) -(begin (register-function-arity (quote shen.app) 3) (define (kl:shen.app V4088 V4089 V4090) (string-append (kl:shen.arg->str V4088 V4090) V4089)) (quote shen.app)) -(begin (register-function-arity (quote shen.arg->str) 2) (define (kl:shen.arg->str V4098 V4099) (cond ((kl:= V4098 (kl:fail)) "...") ((assert-boolean (kl:shen.list? V4098)) (kl:shen.list->str V4098 V4099)) ((string? V4098) (kl:shen.str->str V4098 V4099)) ((vector? V4098) (kl:shen.vector->str V4098 V4099)) (#t (kl:shen.atom->str V4098)))) (quote shen.arg->str)) -(begin (register-function-arity (quote shen.list->str) 2) (define (kl:shen.list->str V4102 V4103) (cond ((eq? (quote shen.r) V4103) (kl:_waspvm_at_s "(" (kl:_waspvm_at_s (kl:shen.iter-list V4102 (quote shen.r) (kl:shen.maxseq)) ")"))) (#t (kl:_waspvm_at_s "[" (kl:_waspvm_at_s (kl:shen.iter-list V4102 V4103 (kl:shen.maxseq)) "]"))))) (quote shen.list->str)) -(begin (register-function-arity (quote shen.maxseq) 0) (define (kl:shen.maxseq) (kl:value (quote *maximum-print-sequence-size*))) (quote shen.maxseq)) -(begin (register-function-arity (quote shen.iter-list) 3) (define (kl:shen.iter-list V4117 V4118 V4119) (cond ((null? V4117) "") ((kl:= 0 V4119) "... etc") ((and (pair? V4117) (null? (cdr V4117))) (kl:shen.arg->str (car V4117) V4118)) ((pair? V4117) (kl:_waspvm_at_s (kl:shen.arg->str (car V4117) V4118) (kl:_waspvm_at_s " " (kl:shen.iter-list (cdr V4117) V4118 (- V4119 1))))) (#t (kl:_waspvm_at_s "|" (kl:_waspvm_at_s " " (kl:shen.arg->str V4117 V4118)))))) (quote shen.iter-list)) -(begin (register-function-arity (quote shen.str->str) 2) (define (kl:shen.str->str V4126 V4127) (cond ((eq? (quote shen.a) V4127) V4126) (#t (kl:_waspvm_at_s (make-string 1 34) (kl:_waspvm_at_s V4126 (make-string 1 34)))))) (quote shen.str->str)) -(begin (register-function-arity (quote shen.vector->str) 2) (define (kl:shen.vector->str V4130 V4131) (if (assert-boolean (kl:shen.print-vector? V4130)) ((kl:function (vector-ref V4130 0)) V4130) (if (assert-boolean (kl:vector? V4130)) (kl:_waspvm_at_s "<" (kl:_waspvm_at_s (kl:shen.iter-vector V4130 1 V4131 (kl:shen.maxseq)) ">")) (kl:_waspvm_at_s "<" (kl:_waspvm_at_s "<" (kl:_waspvm_at_s (kl:shen.iter-vector V4130 0 V4131 (kl:shen.maxseq)) ">>")))))) (quote shen.vector->str)) -(begin (register-function-arity (quote shen.print-vector?) 1) (define (kl:shen.print-vector? V4133) (let ((Zero (vector-ref V4133 0))) (if (eq? Zero (quote shen.tuple)) #t (if (eq? Zero (quote shen.pvar)) #t (if (eq? Zero (quote shen.dictionary)) #t (if (kl:not (number? Zero)) (kl:shen.fbound? Zero) #f)))))) (quote shen.print-vector?)) -(begin (register-function-arity (quote shen.fbound?) 1) (define (kl:shen.fbound? V4135) (guard (lambda (E) #f) (begin (kl:shen.lookup-func V4135) #t))) (quote shen.fbound?)) -(begin (register-function-arity (quote shen.tuple) 1) (define (kl:shen.tuple V4137) (string-append "(@p " (kl:shen.app (vector-ref V4137 1) (string-append " " (kl:shen.app (vector-ref V4137 2) ")" (quote shen.s))) (quote shen.s)))) (quote shen.tuple)) -(begin (register-function-arity (quote shen.dictionary) 1) (define (kl:shen.dictionary V4139) "(dict ...)") (quote shen.dictionary)) -(begin (register-function-arity (quote shen.iter-vector) 4) (define (kl:shen.iter-vector V4150 V4151 V4152 V4153) (cond ((kl:= 0 V4153) "... etc") (#t (let ((Item (guard (lambda (E) (quote shen.out-of-bounds)) (vector-ref V4150 V4151)))) (let ((Next (guard (lambda (E) (quote shen.out-of-bounds)) (vector-ref V4150 (+ V4151 1))))) (if (eq? Item (quote shen.out-of-bounds)) "" (if (eq? Next (quote shen.out-of-bounds)) (kl:shen.arg->str Item V4152) (kl:_waspvm_at_s (kl:shen.arg->str Item V4152) (kl:_waspvm_at_s " " (kl:shen.iter-vector V4150 (+ V4151 1) V4152 (- V4153 1))))))))))) (quote shen.iter-vector)) -(begin (register-function-arity (quote shen.atom->str) 1) (define (kl:shen.atom->str V4155) (guard (lambda (E) (kl:shen.funexstring)) (kl:str V4155))) (quote shen.atom->str)) -(begin (register-function-arity (quote shen.funexstring) 0) (define (kl:shen.funexstring) (kl:_waspvm_at_s "\016" (kl:_waspvm_at_s "f" (kl:_waspvm_at_s "u" (kl:_waspvm_at_s "n" (kl:_waspvm_at_s "e" (kl:_waspvm_at_s (kl:shen.arg->str (kl:gensym (kl:intern "x")) (quote shen.a)) "\017"))))))) (quote shen.funexstring)) -(begin (register-function-arity (quote shen.list?) 1) (define (kl:shen.list? V4157) (or (kl:empty? V4157) (pair? V4157))) (quote shen.list?)) +(begin (register-function-arity (quote pr) 2) (define (kl:pr V4031 V4032) (guard (lambda (E) V4031) (kl:shen.prh V4031 V4032 0))) (export pr) (quote pr)) +(begin (register-function-arity (quote shen.prh) 3) (define (kl:shen.prh V4036 V4037 V4038) (kl:shen.prh V4036 V4037 (kl:shen.write-char-and-inc V4036 V4037 V4038))) (export shen.prh) (quote shen.prh)) +(begin (register-function-arity (quote shen.write-char-and-inc) 3) (define (kl:shen.write-char-and-inc V4042 V4043 V4044) (begin (write-u8 (string-ref (make-string 1 (string-ref V4042 V4044)) 0) V4043) (+ V4044 1))) (export shen.write-char-and-inc) (quote shen.write-char-and-inc)) +(begin (register-function-arity (quote print) 1) (define (kl:print V4046) (let ((String (kl:shen.insert V4046 "~S"))) (let ((Print (kl:shen.prhush String (kl:stoutput)))) V4046))) (export print) (quote print)) +(begin (register-function-arity (quote shen.prhush) 2) (define (kl:shen.prhush V4049 V4050) (if (assert-boolean (kl:value (quote *hush*))) V4049 (kl:pr V4049 V4050))) (export shen.prhush) (quote shen.prhush)) +(begin (register-function-arity (quote shen.mkstr) 2) (define (kl:shen.mkstr V4053 V4054) (cond ((string? V4053) (kl:shen.mkstr-l (kl:shen.proc-nl V4053) V4054)) (#t (kl:shen.mkstr-r (cons (quote shen.proc-nl) (cons V4053 (quote ()))) V4054)))) (export shen.mkstr) (quote shen.mkstr)) +(begin (register-function-arity (quote shen.mkstr-l) 2) (define (kl:shen.mkstr-l V4057 V4058) (cond ((null? V4058) V4057) ((pair? V4058) (kl:shen.mkstr-l (kl:shen.insert-l (car V4058) V4057) (cdr V4058))) (#t (kl:shen.f_error (quote shen.mkstr-l))))) (export shen.mkstr-l) (quote shen.mkstr-l)) +(begin (register-function-arity (quote shen.insert-l) 2) (define (kl:shen.insert-l V4063 V4064) (cond ((equal? "" V4064) "") ((and (assert-boolean (kl:shen.+string? V4064)) (and (equal? "~" (make-string 1 (string-ref V4064 0))) (and (assert-boolean (kl:shen.+string? (string-tail V4064 1))) (equal? "A" (make-string 1 (string-ref (string-tail V4064 1) 0)))))) (cons (quote shen.app) (cons V4063 (cons (string-tail (string-tail V4064 1) 1) (cons (quote shen.a) (quote ())))))) ((and (assert-boolean (kl:shen.+string? V4064)) (and (equal? "~" (make-string 1 (string-ref V4064 0))) (and (assert-boolean (kl:shen.+string? (string-tail V4064 1))) (equal? "R" (make-string 1 (string-ref (string-tail V4064 1) 0)))))) (cons (quote shen.app) (cons V4063 (cons (string-tail (string-tail V4064 1) 1) (cons (quote shen.r) (quote ())))))) ((and (assert-boolean (kl:shen.+string? V4064)) (and (equal? "~" (make-string 1 (string-ref V4064 0))) (and (assert-boolean (kl:shen.+string? (string-tail V4064 1))) (equal? "S" (make-string 1 (string-ref (string-tail V4064 1) 0)))))) (cons (quote shen.app) (cons V4063 (cons (string-tail (string-tail V4064 1) 1) (cons (quote shen.s) (quote ())))))) ((assert-boolean (kl:shen.+string? V4064)) (kl:shen.factor-cn (cons (quote cn) (cons (make-string 1 (string-ref V4064 0)) (cons (kl:shen.insert-l V4063 (string-tail V4064 1)) (quote ())))))) ((and (pair? V4064) (and (eq? (quote cn) (car V4064)) (and (pair? (cdr V4064)) (and (pair? (cdr (cdr V4064))) (null? (cdr (cdr (cdr V4064)))))))) (cons (quote cn) (cons (car (cdr V4064)) (cons (kl:shen.insert-l V4063 (car (cdr (cdr V4064)))) (quote ()))))) ((and (pair? V4064) (and (eq? (quote shen.app) (car V4064)) (and (pair? (cdr V4064)) (and (pair? (cdr (cdr V4064))) (and (pair? (cdr (cdr (cdr V4064)))) (null? (cdr (cdr (cdr (cdr V4064)))))))))) (cons (quote shen.app) (cons (car (cdr V4064)) (cons (kl:shen.insert-l V4063 (car (cdr (cdr V4064)))) (cdr (cdr (cdr V4064))))))) (#t (kl:shen.f_error (quote shen.insert-l))))) (export shen.insert-l) (quote shen.insert-l)) +(begin (register-function-arity (quote shen.factor-cn) 1) (define (kl:shen.factor-cn V4066) (cond ((and (pair? V4066) (and (eq? (quote cn) (car V4066)) (and (pair? (cdr V4066)) (and (pair? (cdr (cdr V4066))) (and (pair? (car (cdr (cdr V4066)))) (and (eq? (quote cn) (car (car (cdr (cdr V4066))))) (and (pair? (cdr (car (cdr (cdr V4066))))) (and (pair? (cdr (cdr (car (cdr (cdr V4066)))))) (and (null? (cdr (cdr (cdr (car (cdr (cdr V4066))))))) (and (null? (cdr (cdr (cdr V4066)))) (and (string? (car (cdr V4066))) (string? (car (cdr (car (cdr (cdr V4066))))))))))))))))) (cons (quote cn) (cons (string-append (car (cdr V4066)) (car (cdr (car (cdr (cdr V4066)))))) (cdr (cdr (car (cdr (cdr V4066)))))))) (#t V4066))) (export shen.factor-cn) (quote shen.factor-cn)) +(begin (register-function-arity (quote shen.proc-nl) 1) (define (kl:shen.proc-nl V4068) (cond ((equal? "" V4068) "") ((and (assert-boolean (kl:shen.+string? V4068)) (and (equal? "~" (make-string 1 (string-ref V4068 0))) (and (assert-boolean (kl:shen.+string? (string-tail V4068 1))) (equal? "%" (make-string 1 (string-ref (string-tail V4068 1) 0)))))) (string-append (make-string 1 10) (kl:shen.proc-nl (string-tail (string-tail V4068 1) 1)))) ((assert-boolean (kl:shen.+string? V4068)) (string-append (make-string 1 (string-ref V4068 0)) (kl:shen.proc-nl (string-tail V4068 1)))) (#t (kl:shen.f_error (quote shen.proc-nl))))) (export shen.proc-nl) (quote shen.proc-nl)) +(begin (register-function-arity (quote shen.mkstr-r) 2) (define (kl:shen.mkstr-r V4071 V4072) (cond ((null? V4072) V4071) ((pair? V4072) (kl:shen.mkstr-r (cons (quote shen.insert) (cons (car V4072) (cons V4071 (quote ())))) (cdr V4072))) (#t (kl:shen.f_error (quote shen.mkstr-r))))) (export shen.mkstr-r) (quote shen.mkstr-r)) +(begin (register-function-arity (quote shen.insert) 2) (define (kl:shen.insert V4075 V4076) (kl:shen.insert-h V4075 V4076 "")) (export shen.insert) (quote shen.insert)) +(begin (register-function-arity (quote shen.insert-h) 3) (define (kl:shen.insert-h V4082 V4083 V4084) (cond ((equal? "" V4083) V4084) ((and (assert-boolean (kl:shen.+string? V4083)) (and (equal? "~" (make-string 1 (string-ref V4083 0))) (and (assert-boolean (kl:shen.+string? (string-tail V4083 1))) (equal? "A" (make-string 1 (string-ref (string-tail V4083 1) 0)))))) (string-append V4084 (kl:shen.app V4082 (string-tail (string-tail V4083 1) 1) (quote shen.a)))) ((and (assert-boolean (kl:shen.+string? V4083)) (and (equal? "~" (make-string 1 (string-ref V4083 0))) (and (assert-boolean (kl:shen.+string? (string-tail V4083 1))) (equal? "R" (make-string 1 (string-ref (string-tail V4083 1) 0)))))) (string-append V4084 (kl:shen.app V4082 (string-tail (string-tail V4083 1) 1) (quote shen.r)))) ((and (assert-boolean (kl:shen.+string? V4083)) (and (equal? "~" (make-string 1 (string-ref V4083 0))) (and (assert-boolean (kl:shen.+string? (string-tail V4083 1))) (equal? "S" (make-string 1 (string-ref (string-tail V4083 1) 0)))))) (string-append V4084 (kl:shen.app V4082 (string-tail (string-tail V4083 1) 1) (quote shen.s)))) ((assert-boolean (kl:shen.+string? V4083)) (kl:shen.insert-h V4082 (string-tail V4083 1) (string-append V4084 (make-string 1 (string-ref V4083 0))))) (#t (kl:shen.f_error (quote shen.insert-h))))) (export shen.insert-h) (quote shen.insert-h)) +(begin (register-function-arity (quote shen.app) 3) (define (kl:shen.app V4088 V4089 V4090) (string-append (kl:shen.arg->str V4088 V4090) V4089)) (export shen.app) (quote shen.app)) +(begin (register-function-arity (quote shen.arg->str) 2) (define (kl:shen.arg->str V4098 V4099) (cond ((kl:= V4098 (kl:fail)) "...") ((assert-boolean (kl:shen.list? V4098)) (kl:shen.list->str V4098 V4099)) ((string? V4098) (kl:shen.str->str V4098 V4099)) ((vector? V4098) (kl:shen.vector->str V4098 V4099)) (#t (kl:shen.atom->str V4098)))) (export shen.arg->str) (quote shen.arg->str)) +(begin (register-function-arity (quote shen.list->str) 2) (define (kl:shen.list->str V4102 V4103) (cond ((eq? (quote shen.r) V4103) (kl:_waspvm_at_s "(" (kl:_waspvm_at_s (kl:shen.iter-list V4102 (quote shen.r) (kl:shen.maxseq)) ")"))) (#t (kl:_waspvm_at_s "[" (kl:_waspvm_at_s (kl:shen.iter-list V4102 V4103 (kl:shen.maxseq)) "]"))))) (export shen.list->str) (quote shen.list->str)) +(begin (register-function-arity (quote shen.maxseq) 0) (define (kl:shen.maxseq) (kl:value (quote *maximum-print-sequence-size*))) (export shen.maxseq) (quote shen.maxseq)) +(begin (register-function-arity (quote shen.iter-list) 3) (define (kl:shen.iter-list V4117 V4118 V4119) (cond ((null? V4117) "") ((kl:= 0 V4119) "... etc") ((and (pair? V4117) (null? (cdr V4117))) (kl:shen.arg->str (car V4117) V4118)) ((pair? V4117) (kl:_waspvm_at_s (kl:shen.arg->str (car V4117) V4118) (kl:_waspvm_at_s " " (kl:shen.iter-list (cdr V4117) V4118 (- V4119 1))))) (#t (kl:_waspvm_at_s "|" (kl:_waspvm_at_s " " (kl:shen.arg->str V4117 V4118)))))) (export shen.iter-list) (quote shen.iter-list)) +(begin (register-function-arity (quote shen.str->str) 2) (define (kl:shen.str->str V4126 V4127) (cond ((eq? (quote shen.a) V4127) V4126) (#t (kl:_waspvm_at_s (make-string 1 34) (kl:_waspvm_at_s V4126 (make-string 1 34)))))) (export shen.str->str) (quote shen.str->str)) +(begin (register-function-arity (quote shen.vector->str) 2) (define (kl:shen.vector->str V4130 V4131) (if (assert-boolean (kl:shen.print-vector? V4130)) ((kl:function (vector-ref V4130 0)) V4130) (if (assert-boolean (kl:vector? V4130)) (kl:_waspvm_at_s "<" (kl:_waspvm_at_s (kl:shen.iter-vector V4130 1 V4131 (kl:shen.maxseq)) ">")) (kl:_waspvm_at_s "<" (kl:_waspvm_at_s "<" (kl:_waspvm_at_s (kl:shen.iter-vector V4130 0 V4131 (kl:shen.maxseq)) ">>")))))) (export shen.vector->str) (quote shen.vector->str)) +(begin (register-function-arity (quote shen.print-vector?) 1) (define (kl:shen.print-vector? V4133) (let ((Zero (vector-ref V4133 0))) (if (eq? Zero (quote shen.tuple)) #t (if (eq? Zero (quote shen.pvar)) #t (if (eq? Zero (quote shen.dictionary)) #t (if (kl:not (number? Zero)) (kl:shen.fbound? Zero) #f)))))) (export shen.print-vector?) (quote shen.print-vector?)) +(begin (register-function-arity (quote shen.fbound?) 1) (define (kl:shen.fbound? V4135) (guard (lambda (E) #f) (begin (kl:shen.lookup-func V4135) #t))) (export shen.fbound?) (quote shen.fbound?)) +(begin (register-function-arity (quote shen.tuple) 1) (define (kl:shen.tuple V4137) (string-append "(@p " (kl:shen.app (vector-ref V4137 1) (string-append " " (kl:shen.app (vector-ref V4137 2) ")" (quote shen.s))) (quote shen.s)))) (export shen.tuple) (quote shen.tuple)) +(begin (register-function-arity (quote shen.dictionary) 1) (define (kl:shen.dictionary V4139) "(dict ...)") (export shen.dictionary) (quote shen.dictionary)) +(begin (register-function-arity (quote shen.iter-vector) 4) (define (kl:shen.iter-vector V4150 V4151 V4152 V4153) (cond ((kl:= 0 V4153) "... etc") (#t (let ((Item (guard (lambda (E) (quote shen.out-of-bounds)) (vector-ref V4150 V4151)))) (let ((Next (guard (lambda (E) (quote shen.out-of-bounds)) (vector-ref V4150 (+ V4151 1))))) (if (eq? Item (quote shen.out-of-bounds)) "" (if (eq? Next (quote shen.out-of-bounds)) (kl:shen.arg->str Item V4152) (kl:_waspvm_at_s (kl:shen.arg->str Item V4152) (kl:_waspvm_at_s " " (kl:shen.iter-vector V4150 (+ V4151 1) V4152 (- V4153 1))))))))))) (export shen.iter-vector) (quote shen.iter-vector)) +(begin (register-function-arity (quote shen.atom->str) 1) (define (kl:shen.atom->str V4155) (guard (lambda (E) (kl:shen.funexstring)) (kl:str V4155))) (export shen.atom->str) (quote shen.atom->str)) +(begin (register-function-arity (quote shen.funexstring) 0) (define (kl:shen.funexstring) (kl:_waspvm_at_s "\016" (kl:_waspvm_at_s "f" (kl:_waspvm_at_s "u" (kl:_waspvm_at_s "n" (kl:_waspvm_at_s "e" (kl:_waspvm_at_s (kl:shen.arg->str (kl:gensym (kl:intern "x")) (quote shen.a)) "\017"))))))) (export shen.funexstring) (quote shen.funexstring)) +(begin (register-function-arity (quote shen.list?) 1) (define (kl:shen.list? V4157) (or (kl:empty? V4157) (pair? V4157))) (export shen.list?) (quote shen.list?)) diff --git a/compiled/yacc.kl.ms b/compiled/yacc.kl.ms index 2ce1619..c76d0f0 100644 --- a/compiled/yacc.kl.ms +++ b/compiled/yacc.kl.ms @@ -1,33 +1,34 @@ +(module "compiled/yacc.kl") "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") (kl: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 _waspvm_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 (kl: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 (kl: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 (kl:fail)))) (quote )) -(begin (register-function-arity (quote ) 1) (define (kl: 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 ))))) (quote )) +(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))))) (export 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 ())))))))))) (export shen.yacc->shen) (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))) (export shen.kill-code) (quote shen.kill-code)) +(begin (register-function-arity (quote kill) 0) (define (kl:kill) (simple-error "yacc kill")) (export 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") (kl:fail) V4167))) (export shen.analyse-kill) (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 _waspvm_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))))) (export 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))))) (export 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)))) (export shen.semantic-completion-warning) (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))))) (export shen.default_semantics) (quote shen.default_semantics)) +(begin (register-function-arity (quote shen.grammar_symbol?) 1) (define (kl:shen.grammar_symbol? V4201) (and (kl:symbol? V4201) (assert-boolean (let ((Cs (kl:shen.strip-pathname (kl:explode V4201)))) (and (equal? (car Cs) "<") (equal? (car (kl:reverse Cs)) ">")))))) (export shen.grammar_symbol?) (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))))) (export 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))))) (export 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))))) (export 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 ())))))))))) (export shen.list-stream) (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))) (export shen.decons) (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))) (export shen.insert-runon) (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))))) (export 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))))) (export 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))))) (export 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))) (export shen.terminal?) (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))) (export shen.jump_stream?) (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))))) (export 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))))) (export 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))) (export shen.semantics) (quote shen.semantics)) +(begin (register-function-arity (quote shen.pair) 2) (define (kl:shen.pair V4289 V4290) (cons V4289 (cons V4290 (quote ())))) (export shen.pair) (quote shen.pair)) +(begin (register-function-arity (quote shen.hdtl) 1) (define (kl:shen.hdtl V4292) (car (cdr V4292))) (export shen.hdtl) (quote shen.hdtl)) +(begin (register-function-arity (quote shen.hdhd) 1) (define (kl:shen.hdhd V4294) (car (car V4294))) (export shen.hdhd) (quote shen.hdhd)) +(begin (register-function-arity (quote shen.tlhd) 1) (define (kl:shen.tlhd V4296) (cdr (car V4296))) (export shen.tlhd) (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 (kl:fail)))) (export shen.snd-or-fail) (quote shen.snd-or-fail)) +(begin (register-function-arity (quote fail) 0) (define (kl:fail) (quote shen.fail!)) (export 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 (kl:fail)))) (export ) (quote )) +(begin (register-function-arity (quote ) 1) (define (kl: 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 ))))) (export ) (quote )) diff --git a/compiler.ms b/compiler.ms index 44c6641..bef2495 100644 --- a/compiler.ms +++ b/compiler.ms @@ -318,6 +318,7 @@ `(begin (register-function-arity (quote ,name) ,(length args)) (define (,(prefix-op name) ,@args) ,(compile-expression body args)) + (export ,name) (quote ,name))) (else (compile-expression expr '())))) diff --git a/driver.ms b/driver.ms index 4cf16a8..80cfb41 100644 --- a/driver.ms +++ b/driver.ms @@ -108,7 +108,8 @@ (for-each (lambda (file) (print "Compiling ") (print file) (print "\n") - (write-lisp-file (string-append "compiled/" file ".ms") (map kl->wasp (read-kl-file (string-append "kl/" file)))) + (define compiled-name (string-append "compiled/" file)) + (write-lisp-file (string-append compiled-name ".ms") (cons `(module ,compiled-name) (map kl->wasp (read-kl-file (string-append "kl/" file))))) (waspc (string-append "compiled/" file ".ms"))) files) (waspc "overwrites-internal.ms")) @@ -129,7 +130,6 @@ "declarations.kl" "types.kl" "t-star.kl")) - (for-each (lambda (file) (print "Compiling ") (print file) (print "\n") diff --git a/primitives.ms b/primitives.ms index 07f73a4..efde5d6 100644 --- a/primitives.ms +++ b/primitives.ms @@ -4,6 +4,7 @@ ; Shen Scheme derived soure code is: ; Copyright (c) 2012-2015 Bruno Deferrari. All rights reserved. +(module "primitives") (import "lib/with-io") (import "lib/eval") @@ -18,6 +19,8 @@ (set! msg (wait q))) output) +(export call-with-output-string) + (define (write-u8 byte out) (define out (car out)) (cond @@ -28,6 +31,8 @@ (pause)))) out) +(export write-u8) + (define (read-u8 in) (define input-buffer (cdr in)) (define my-in (car in)) @@ -43,6 +48,8 @@ ((string? msg) -1) (else (error 'read-u8 "Non-string on input stream")))))) +(export read-u8) + (define (read-file-u8 in input-buffer) (if (> (string-length input-buffer) 0) (string-read-byte! input-buffer) @@ -55,6 +62,8 @@ ((string? msg) -1) (else (error 'read-file-u8 "Non-string on file stream")))))) +(export read-file-u8) + ;; Boolean Operators ;; @@ -63,6 +72,8 @@ value (error 'assert-boolean "expected a boolean, got" value))) +(export assert-boolean) + ;; Symbols ;; @@ -162,3 +173,4 @@ ((run) (now)) (else (error kl:get-time "get-time does not understand the parameter" sym)))) +(export kl:get-time kl:close kl:open kl:eval-kl kl:= kl:error-to-string kl:value kl:set kl:str kl:intern) diff --git a/shen-lib.ms b/shen-lib.ms new file mode 100644 index 0000000..4b6a5e7 --- /dev/null +++ b/shen-lib.ms @@ -0,0 +1,20 @@ +; Copyright (c) 2017 Chris Double. All rights reserved. +; BSD 3-Clause License: http://opensource.org/licenses/BSD-3-Clause +(module "shen-lib") +(import "driver") +(import "compiled/toplevel.kl") +(import "compiled/core.kl") +(import "compiled/sys.kl") +(import "compiled/sequent.kl") +(import "compiled/yacc.kl") +(import "compiled/reader.kl") +(import "compiled/prolog.kl") +(import "compiled/track.kl") +(import "compiled/load.kl") +(import "compiled/writer.kl") +(import "compiled/macros.kl") +(import "compiled/dict.kl") +(import "compiled/declarations.kl") +(import "overwrites-internal") +(import "compiled/types.kl") +(import "compiled/t-star.kl") diff --git a/shen.ms b/shen.ms index c3916f3..b3d5a95 100644 --- a/shen.ms +++ b/shen.ms @@ -1,23 +1,7 @@ ; Copyright (c) 2017 Chris Double. All rights reserved. ; BSD 3-Clause License: http://opensource.org/licenses/BSD-3-Clause -(import "driver") -(import "compiled/toplevel.kl") -(import "compiled/core.kl") -(import "compiled/sys.kl") -(import "compiled/sequent.kl") -(import "compiled/yacc.kl") -(import "compiled/reader.kl") -(import "compiled/prolog.kl") -(import "compiled/track.kl") -(import "compiled/load.kl") -(import "compiled/writer.kl") -(import "compiled/macros.kl") -(import "compiled/dict.kl") -(import "compiled/declarations.kl") -(import "overwrites-internal") -(import "compiled/types.kl") -(import "compiled/t-star.kl") +(import "shen-lib") (define (usage) (println* "Usage: shen [options] [...args...]\n"