diff --git a/CHANGELOG.md b/CHANGELOG.md index 6753c60..488ac39 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,9 @@ # Change Log +## 0.12 - 2022-04-29 + +- Update to Shen OS Kernel 22.4 + ## 0.11 - 2019-09-28 - Add module declarations to Wasp Lisp files and a `shen-libs.ms` that diff --git a/compiled/core.kl.ms b/compiled/core.kl.ms index 9515ced..ebcf961 100644 --- a/compiled/core.kl.ms +++ b/compiled/core.kl.ms @@ -1,66 +1,68 @@ (module "compiled/core.kl") "Copyright (c) 2010-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:\n\n1. Redistributions of source code must retain the above copyright notice,\nthis list of conditions and the following disclaimer.\n\n2. Redistributions in binary form must reproduce the above copyright notice,\nthis list of conditions and the following disclaimer in the documentation\nand/or other materials provided with the distribution.\n\n3. Neither the name of the copyright holder nor the names of its contributors\nmay be used to endorse or promote products derived from this software without\nspecific prior written permission.\n\nTHIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ''AS IS'' AND\nANY EXPRESS 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 THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE\nFOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL\nDAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR\nSERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER\nCAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,\nOR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE\nOF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.\n" -(begin (register-function-arity (quote shen.shen->kl) 2) (define (kl:shen.shen->kl V1261 V1262) (kl:compile (lambda (X) (kl:shen. X)) (cons V1261 V1262) (lambda (X) (kl:shen.shen-syntax-error V1261 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 V1269 V1270) (cond ((pair? V1270) (simple-error (string-append "syntax error in " (kl:shen.app V1269 (string-append " here:\n\n " (kl:shen.app (kl:shen.next-50 50 (car V1270)) "\n" (quote shen.a))) (quote shen.a))))) (#t (simple-error (string-append "syntax error in " (kl:shen.app V1269 "\n" (quote shen.a))))))) (export shen.shen-syntax-error) (quote shen.shen-syntax-error)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1272) (let ((YaccParse (let ((Parse_shen. (kl:shen. V1272))) (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. V1272))) (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. V1274) (if (pair? (car V1274)) (let ((Parse_X (kl:shen.hdhd V1274))) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V1274) (kl:shen.hdtl V1274))) (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? V1276) (kl:element? V1276 (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. V1280) (if (and (pair? (car V1280)) (eq? (quote {) (kl:shen.hdhd V1280))) (let ((NewStream1277 (kl:shen.pair (kl:shen.tlhd V1280) (kl:shen.hdtl V1280)))) (let ((Parse_shen. (kl:shen. NewStream1277))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (if (and (pair? (car Parse_shen.)) (eq? (quote }) (kl:shen.hdhd Parse_shen.))) (let ((NewStream1278 (kl:shen.pair (kl:shen.tlhd Parse_shen.) (kl:shen.hdtl Parse_shen.)))) (kl:shen.pair (car NewStream1278) (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 V1282) (kl:shen.active-cons (kl:shen.curry-type-h V1282))) (export shen.curry-type) (quote shen.curry-type)) -(begin (register-function-arity (quote shen.active-cons) 1) (define (kl:shen.active-cons V1284) (cond ((and (pair? V1284) (and (pair? (cdr V1284)) (and (pair? (cdr (cdr V1284))) (and (null? (cdr (cdr (cdr V1284)))) (eq? (car (cdr V1284)) (quote bar!)))))) (cons (kl:shen.active-cons (car V1284)) (kl:shen.active-cons (car (cdr (cdr V1284)))))) ((pair? V1284) (cons (kl:shen.active-cons (car V1284)) (kl:shen.active-cons (cdr V1284)))) (#t V1284))) (export shen.active-cons) (quote shen.active-cons)) -(begin (register-function-arity (quote shen.curry-type-h) 1) (define (kl:shen.curry-type-h V1286) (cond ((and (pair? V1286) (and (pair? (cdr V1286)) (and (eq? (quote -->) (car (cdr V1286))) (and (pair? (cdr (cdr V1286))) (and (pair? (cdr (cdr (cdr V1286)))) (eq? (quote -->) (car (cdr (cdr (cdr V1286)))))))))) (kl:shen.curry-type-h (cons (car V1286) (cons (quote -->) (cons (cdr (cdr V1286)) (quote ())))))) ((and (pair? V1286) (and (pair? (cdr V1286)) (and (eq? (quote *) (car (cdr V1286))) (and (pair? (cdr (cdr V1286))) (and (pair? (cdr (cdr (cdr V1286)))) (eq? (quote *) (car (cdr (cdr (cdr V1286)))))))))) (kl:shen.curry-type-h (cons (car V1286) (cons (quote *) (cons (cdr (cdr V1286)) (quote ())))))) ((pair? V1286) (kl:map (lambda (Z) (kl:shen.curry-type-h Z)) V1286)) (#t V1286))) (export shen.curry-type-h) (quote shen.curry-type-h)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1288) (let ((YaccParse (if (pair? (car V1288)) (let ((Parse_X (kl:shen.hdhd V1288))) (let ((Parse_shen. (kl:shen. (kl:shen.pair (kl:shen.tlhd V1288) (kl:shen.hdtl V1288))))) (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: V1288))) (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. V1290) (let ((YaccParse (let ((Parse_shen. (kl:shen. V1290))) (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. V1290))) (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. V1298) (let ((YaccParse (let ((Parse_shen. (kl:shen. V1298))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (if (and (pair? (car Parse_shen.)) (eq? (quote ->) (kl:shen.hdhd Parse_shen.))) (let ((NewStream1291 (kl:shen.pair (kl:shen.tlhd Parse_shen.) (kl:shen.hdtl Parse_shen.)))) (let ((Parse_shen. (kl:shen. NewStream1291))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (if (and (pair? (car Parse_shen.)) (eq? (quote where) (kl:shen.hdhd Parse_shen.))) (let ((NewStream1292 (kl:shen.pair (kl:shen.tlhd Parse_shen.) (kl:shen.hdtl Parse_shen.)))) (let ((Parse_shen. (kl:shen. NewStream1292))) (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. V1298))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (if (and (pair? (car Parse_shen.)) (eq? (quote ->) (kl:shen.hdhd Parse_shen.))) (let ((NewStream1293 (kl:shen.pair (kl:shen.tlhd Parse_shen.) (kl:shen.hdtl Parse_shen.)))) (let ((Parse_shen. (kl:shen. NewStream1293))) (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. V1298))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (if (and (pair? (car Parse_shen.)) (eq? (quote <-) (kl:shen.hdhd Parse_shen.))) (let ((NewStream1294 (kl:shen.pair (kl:shen.tlhd Parse_shen.) (kl:shen.hdtl Parse_shen.)))) (let ((Parse_shen. (kl:shen. NewStream1294))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (if (and (pair? (car Parse_shen.)) (eq? (quote where) (kl:shen.hdhd Parse_shen.))) (let ((NewStream1295 (kl:shen.pair (kl:shen.tlhd Parse_shen.) (kl:shen.hdtl Parse_shen.)))) (let ((Parse_shen. (kl:shen. NewStream1295))) (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. V1298))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (if (and (pair? (car Parse_shen.)) (eq? (quote <-) (kl:shen.hdhd Parse_shen.))) (let ((NewStream1296 (kl:shen.pair (kl:shen.tlhd Parse_shen.) (kl:shen.hdtl Parse_shen.)))) (let ((Parse_shen. (kl:shen. NewStream1296))) (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 V1301 V1302) (if (assert-boolean (V1301 V1302)) (kl:fail) V1302)) (export shen.fail_if) (quote shen.fail_if)) -(begin (register-function-arity (quote shen.succeeds?) 1) (define (kl:shen.succeeds? V1308) (cond ((kl:= V1308 (kl:fail)) #f) (#t #t))) (export shen.succeeds?) (quote shen.succeeds?)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1310) (let ((YaccParse (let ((Parse_shen. (kl:shen. V1310))) (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: V1310))) (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. V1323) (let ((YaccParse (if (and (pair? (car V1323)) (pair? (kl:shen.hdhd V1323))) (if (and (pair? (car (kl:shen.pair (kl:shen.hdhd V1323) (kl:shen.hdtl V1323)))) (eq? (quote _waspvm_at_p) (kl:shen.hdhd (kl:shen.pair (kl:shen.hdhd V1323) (kl:shen.hdtl V1323))))) (let ((NewStream1312 (kl:shen.pair (kl:shen.tlhd (kl:shen.pair (kl:shen.hdhd V1323) (kl:shen.hdtl V1323))) (kl:shen.hdtl (kl:shen.pair (kl:shen.hdhd V1323) (kl:shen.hdtl V1323)))))) (let ((Parse_shen. (kl:shen. NewStream1312))) (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 V1323) (kl:shen.hdtl V1323))) (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 V1323)) (pair? (kl:shen.hdhd V1323))) (if (and (pair? (car (kl:shen.pair (kl:shen.hdhd V1323) (kl:shen.hdtl V1323)))) (eq? (quote cons) (kl:shen.hdhd (kl:shen.pair (kl:shen.hdhd V1323) (kl:shen.hdtl V1323))))) (let ((NewStream1314 (kl:shen.pair (kl:shen.tlhd (kl:shen.pair (kl:shen.hdhd V1323) (kl:shen.hdtl V1323))) (kl:shen.hdtl (kl:shen.pair (kl:shen.hdhd V1323) (kl:shen.hdtl V1323)))))) (let ((Parse_shen. (kl:shen. NewStream1314))) (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 V1323) (kl:shen.hdtl V1323))) (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 V1323)) (pair? (kl:shen.hdhd V1323))) (if (and (pair? (car (kl:shen.pair (kl:shen.hdhd V1323) (kl:shen.hdtl V1323)))) (eq? (quote _waspvm_at_v) (kl:shen.hdhd (kl:shen.pair (kl:shen.hdhd V1323) (kl:shen.hdtl V1323))))) (let ((NewStream1316 (kl:shen.pair (kl:shen.tlhd (kl:shen.pair (kl:shen.hdhd V1323) (kl:shen.hdtl V1323))) (kl:shen.hdtl (kl:shen.pair (kl:shen.hdhd V1323) (kl:shen.hdtl V1323)))))) (let ((Parse_shen. (kl:shen. NewStream1316))) (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 V1323) (kl:shen.hdtl V1323))) (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 V1323)) (pair? (kl:shen.hdhd V1323))) (if (and (pair? (car (kl:shen.pair (kl:shen.hdhd V1323) (kl:shen.hdtl V1323)))) (eq? (quote _waspvm_at_s) (kl:shen.hdhd (kl:shen.pair (kl:shen.hdhd V1323) (kl:shen.hdtl V1323))))) (let ((NewStream1318 (kl:shen.pair (kl:shen.tlhd (kl:shen.pair (kl:shen.hdhd V1323) (kl:shen.hdtl V1323))) (kl:shen.hdtl (kl:shen.pair (kl:shen.hdhd V1323) (kl:shen.hdtl V1323)))))) (let ((Parse_shen. (kl:shen. NewStream1318))) (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 V1323) (kl:shen.hdtl V1323))) (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 V1323)) (pair? (kl:shen.hdhd V1323))) (if (and (pair? (car (kl:shen.pair (kl:shen.hdhd V1323) (kl:shen.hdtl V1323)))) (eq? (quote vector) (kl:shen.hdhd (kl:shen.pair (kl:shen.hdhd V1323) (kl:shen.hdtl V1323))))) (let ((NewStream1320 (kl:shen.pair (kl:shen.tlhd (kl:shen.pair (kl:shen.hdhd V1323) (kl:shen.hdtl V1323))) (kl:shen.hdtl (kl:shen.pair (kl:shen.hdhd V1323) (kl:shen.hdtl V1323)))))) (if (and (pair? (car NewStream1320)) (kl:= 0 (kl:shen.hdhd NewStream1320))) (let ((NewStream1321 (kl:shen.pair (kl:shen.tlhd NewStream1320) (kl:shen.hdtl NewStream1320)))) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V1323) (kl:shen.hdtl V1323))) (cons (quote vector) (cons 0 (quote ()))))) (kl:fail))) (kl:fail)) (kl:fail)))) (if (kl:= YaccParse (kl:fail)) (let ((YaccParse (if (pair? (car V1323)) (let ((Parse_X (kl:shen.hdhd V1323))) (if (pair? Parse_X) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V1323) (kl:shen.hdtl V1323))) (kl:shen.constructor-error Parse_X)) (kl:fail))) (kl:fail)))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_shen. (kl:shen. V1323))) (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 V1325) (simple-error (kl:shen.app V1325 " 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. V1327) (let ((YaccParse (if (pair? (car V1327)) (let ((Parse_X (kl:shen.hdhd V1327))) (if (eq? Parse_X (quote _)) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V1327) (kl:shen.hdtl V1327))) (kl:gensym (quote Parse_Y))) (kl:fail))) (kl:fail)))) (if (kl:= YaccParse (kl:fail)) (if (pair? (car V1327)) (let ((Parse_X (kl:shen.hdhd V1327))) (if (kl:not (kl:element? Parse_X (cons (quote ->) (cons (quote <-) (quote ()))))) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V1327) (kl:shen.hdtl V1327))) Parse_X) (kl:fail))) (kl:fail)) YaccParse))) (export shen.) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1329) (let ((Parse_shen. (kl:shen. V1329))) (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. V1331) (let ((Parse_shen. (kl:shen. V1331))) (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. V1333) (if (pair? (car V1333)) (let ((Parse_X (kl:shen.hdhd V1333))) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V1333) (kl:shen.hdtl V1333))) Parse_X)) (kl:fail))) (export shen.) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1335) (if (pair? (car V1335)) (let ((Parse_X (kl:shen.hdhd V1335))) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V1335) (kl:shen.hdtl V1335))) 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 V1338 V1339) (let ((Lambda+ (kl:shen.compile_to_lambda+ V1338 V1339))) (let ((KL (kl:shen.compile_to_kl V1338 Lambda+))) (let ((Record (kl:shen.record-source V1338 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 V1344 V1345) (cond ((assert-boolean (kl:value (quote shen.*installing-kl*))) (quote shen.skip)) (#t (kl:put V1344 (quote shen.source) V1345 (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+ V1348 V1349) (let ((Arity (kl:shen.aritycheck V1348 V1349))) (let ((UpDateSymbolTable (kl:shen.update-symbol-table V1348 Arity))) (let ((Free (kl:shen.for-each (lambda (Rule) (kl:shen.free_variable_check V1348 Rule)) V1349))) (let ((Variables (kl:shen.parameters Arity))) (let ((Strip (kl:map (lambda (X) (kl:shen.strip-protect X)) V1349))) (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 V1352 V1353) (cond ((kl:= 0 V1353) (quote shen.skip)) (#t (kl:put V1352 (quote shen.lambda-form) (kl:eval-kl (kl:shen.lambda-form V1352 V1353)) (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 V1356 V1357) (cond ((and (pair? V1357) (and (pair? (cdr V1357)) (null? (cdr (cdr V1357))))) (let ((Bound (kl:shen.extract_vars (car V1357)))) (let ((Free (kl:shen.extract_free_vars Bound (car (cdr V1357))))) (kl:shen.free_variable_warnings V1356 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 V1359) (cond ((kl:variable? V1359) (cons V1359 (quote ()))) ((pair? V1359) (kl:union (kl:shen.extract_vars (car V1359)) (kl:shen.extract_vars (cdr V1359)))) (#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 V1371 V1372) (cond ((and (pair? V1372) (and (pair? (cdr V1372)) (and (null? (cdr (cdr V1372))) (eq? (car V1372) (quote protect))))) (quote ())) ((and (kl:variable? V1372) (kl:not (kl:element? V1372 V1371))) (cons V1372 (quote ()))) ((and (pair? V1372) (and (eq? (quote lambda) (car V1372)) (and (pair? (cdr V1372)) (and (pair? (cdr (cdr V1372))) (null? (cdr (cdr (cdr V1372)))))))) (kl:shen.extract_free_vars (cons (car (cdr V1372)) V1371) (car (cdr (cdr V1372))))) ((and (pair? V1372) (and (eq? (quote let) (car V1372)) (and (pair? (cdr V1372)) (and (pair? (cdr (cdr V1372))) (and (pair? (cdr (cdr (cdr V1372)))) (null? (cdr (cdr (cdr (cdr V1372)))))))))) (kl:union (kl:shen.extract_free_vars V1371 (car (cdr (cdr V1372)))) (kl:shen.extract_free_vars (cons (car (cdr V1372)) V1371) (car (cdr (cdr (cdr V1372))))))) ((pair? V1372) (kl:union (kl:shen.extract_free_vars V1371 (car V1372)) (kl:shen.extract_free_vars V1371 (cdr V1372)))) (#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 V1377 V1378) (cond ((null? V1378) (quote _)) (#t (simple-error (string-append "error: the following variables are free in " (kl:shen.app V1377 (string-append ": " (kl:shen.app (kl:shen.list_variables V1378) "" (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 V1380) (cond ((and (pair? V1380) (null? (cdr V1380))) (string-append (kl:str (car V1380)) ".")) ((pair? V1380) (string-append (kl:str (car V1380)) (string-append ", " (kl:shen.list_variables (cdr V1380))))) (#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 V1382) (cond ((and (pair? V1382) (and (pair? (cdr V1382)) (and (null? (cdr (cdr V1382))) (eq? (car V1382) (quote protect))))) (kl:shen.strip-protect (car (cdr V1382)))) ((pair? V1382) (kl:map (lambda (Z) (kl:shen.strip-protect Z)) V1382)) (#t V1382))) (export shen.strip-protect) (quote shen.strip-protect)) -(begin (register-function-arity (quote shen.linearise) 1) (define (kl:shen.linearise V1384) (cond ((and (pair? V1384) (and (pair? (cdr V1384)) (null? (cdr (cdr V1384))))) (kl:shen.linearise_help (kl:shen.flatten (car V1384)) (car V1384) (car (cdr V1384)))) (#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 V1386) (cond ((null? V1386) (quote ())) ((pair? V1386) (kl:append (kl:shen.flatten (car V1386)) (kl:shen.flatten (cdr V1386)))) (#t (cons V1386 (quote ()))))) (export shen.flatten) (quote shen.flatten)) -(begin (register-function-arity (quote shen.linearise_help) 3) (define (kl:shen.linearise_help V1390 V1391 V1392) (cond ((null? V1390) (cons V1391 (cons V1392 (quote ())))) ((pair? V1390) (if (and (kl:variable? (car V1390)) (kl:element? (car V1390) (cdr V1390))) (let ((Var (kl:gensym (car V1390)))) (let ((NewAction (cons (quote where) (cons (cons (quote =) (cons (car V1390) (cons Var (quote ())))) (cons V1392 (quote ())))))) (let ((NewPatts (kl:shen.linearise_X (car V1390) Var V1391))) (kl:shen.linearise_help (cdr V1390) NewPatts NewAction)))) (kl:shen.linearise_help (cdr V1390) V1391 V1392))) (#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 V1405 V1406 V1407) (cond ((kl:= V1407 V1405) V1406) ((pair? V1407) (let ((L (kl:shen.linearise_X V1405 V1406 (car V1407)))) (if (kl:= L (car V1407)) (cons (car V1407) (kl:shen.linearise_X V1405 V1406 (cdr V1407))) (cons L (cdr V1407))))) (#t V1407))) (export shen.linearise_X) (quote shen.linearise_X)) -(begin (register-function-arity (quote shen.aritycheck) 2) (define (kl:shen.aritycheck V1410 V1411) (cond ((and (pair? V1411) (and (pair? (car V1411)) (and (pair? (cdr (car V1411))) (and (null? (cdr (cdr (car V1411)))) (null? (cdr V1411)))))) (begin (kl:shen.aritycheck-action (car (cdr (car V1411)))) (kl:shen.aritycheck-name V1410 (kl:arity V1410) (kl:length (car (car V1411)))))) ((and (pair? V1411) (and (pair? (car V1411)) (and (pair? (cdr (car V1411))) (and (null? (cdr (cdr (car V1411)))) (and (pair? (cdr V1411)) (and (pair? (car (cdr V1411))) (and (pair? (cdr (car (cdr V1411)))) (null? (cdr (cdr (car (cdr V1411)))))))))))) (if (kl:= (kl:length (car (car V1411))) (kl:length (car (car (cdr V1411))))) (begin (kl:shen.aritycheck-action (car (cdr (car V1411)))) (kl:shen.aritycheck V1410 (cdr V1411))) (simple-error (string-append "arity error in " (kl:shen.app V1410 "\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 V1424 V1425 V1426) (cond ((kl:= -1 V1425) V1426) ((kl:= V1426 V1425) V1426) (#t (begin (kl:shen.prhush (string-append "\nwarning: changing the arity of " (kl:shen.app V1424 " can cause errors.\n" (quote shen.a))) (kl:stoutput)) V1426)))) (export shen.aritycheck-name) (quote shen.aritycheck-name)) -(begin (register-function-arity (quote shen.aritycheck-action) 1) (define (kl:shen.aritycheck-action V1432) (cond ((pair? V1432) (begin (kl:shen.aah (car V1432) (cdr V1432)) (kl:shen.for-each (lambda (Y) (kl:shen.aritycheck-action Y)) V1432))) (#t (quote shen.skip)))) (export shen.aritycheck-action) (quote shen.aritycheck-action)) -(begin (register-function-arity (quote shen.aah) 2) (define (kl:shen.aah V1435 V1436) (let ((Arity (kl:arity V1435))) (let ((Len (kl:length V1436))) (if (and (> Arity -1) (> Len Arity)) (kl:shen.prhush (string-append "warning: " (kl:shen.app V1435 (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 V1438) (cond ((and (pair? V1438) (and (pair? (cdr V1438)) (null? (cdr (cdr V1438))))) (kl:shen.abstraction_build (car V1438) (car (cdr V1438)))) (#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 V1441 V1442) (cond ((null? V1441) V1442) ((pair? V1441) (cons (quote /.) (cons (car V1441) (cons (kl:shen.abstraction_build (cdr V1441) V1442) (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 V1444) (cond ((kl:= 0 V1444) (quote ())) (#t (cons (kl:gensym (quote V)) (kl:shen.parameters (- V1444 1)))))) (export shen.parameters) (quote shen.parameters)) -(begin (register-function-arity (quote shen.application_build) 2) (define (kl:shen.application_build V1447 V1448) (cond ((null? V1447) V1448) ((pair? V1447) (kl:shen.application_build (cdr V1447) (cons V1448 (cons (car V1447) (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 V1451 V1452) (cond ((and (pair? V1452) (and (pair? (cdr V1452)) (null? (cdr (cdr V1452))))) (let ((Arity (kl:shen.store-arity V1451 (kl:length (car V1452))))) (let ((Reduce (kl:map (lambda (X) (kl:shen.reduce X)) (car (cdr V1452))))) (let ((CondExpression (kl:shen.cond-expression V1451 (car V1452) Reduce))) (let ((TypeTable (if (assert-boolean (kl:value (quote shen.*optimise*))) (kl:shen.typextable (kl:shen.get-type V1451) (car V1452)) (quote shen.skip)))) (let ((TypedCondExpression (if (assert-boolean (kl:value (quote shen.*optimise*))) (kl:shen.assign-types (car V1452) TypeTable CondExpression) CondExpression))) (cons (quote defun) (cons V1451 (cons (car V1452) (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 V1458) (cond ((pair? V1458) (quote shen.skip)) (#t (let ((FType (kl:assoc V1458 (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 V1469 V1470) (cond ((and (pair? V1469) (and (pair? (cdr V1469)) (and (eq? (quote -->) (car (cdr V1469))) (and (pair? (cdr (cdr V1469))) (and (null? (cdr (cdr (cdr V1469)))) (pair? V1470)))))) (if (kl:variable? (car V1469)) (kl:shen.typextable (car (cdr (cdr V1469))) (cdr V1470)) (cons (cons (car V1470) (car V1469)) (kl:shen.typextable (car (cdr (cdr V1469))) (cdr V1470))))) (#t (quote ())))) (export shen.typextable) (quote shen.typextable)) -(begin (register-function-arity (quote shen.assign-types) 3) (define (kl:shen.assign-types V1474 V1475 V1476) (cond ((and (pair? V1476) (and (eq? (quote let) (car V1476)) (and (pair? (cdr V1476)) (and (pair? (cdr (cdr V1476))) (and (pair? (cdr (cdr (cdr V1476)))) (null? (cdr (cdr (cdr (cdr V1476)))))))))) (cons (quote let) (cons (car (cdr V1476)) (cons (kl:shen.assign-types V1474 V1475 (car (cdr (cdr V1476)))) (cons (kl:shen.assign-types (cons (car (cdr V1476)) V1474) V1475 (car (cdr (cdr (cdr V1476))))) (quote ())))))) ((and (pair? V1476) (and (eq? (quote lambda) (car V1476)) (and (pair? (cdr V1476)) (and (pair? (cdr (cdr V1476))) (null? (cdr (cdr (cdr V1476)))))))) (cons (quote lambda) (cons (car (cdr V1476)) (cons (kl:shen.assign-types (cons (car (cdr V1476)) V1474) V1475 (car (cdr (cdr V1476)))) (quote ()))))) ((and (pair? V1476) (eq? (quote cond) (car V1476))) (cons (quote cond) (kl:map (lambda (Y) (cons (kl:shen.assign-types V1474 V1475 (car Y)) (cons (kl:shen.assign-types V1474 V1475 (car (cdr Y))) (quote ())))) (cdr V1476)))) ((pair? V1476) (let ((NewTable (kl:shen.typextable (kl:shen.get-type (car V1476)) (cdr V1476)))) (cons (car V1476) (kl:map (lambda (Y) (kl:shen.assign-types V1474 (kl:append V1475 NewTable) Y)) (cdr V1476))))) (#t (let ((AtomType (kl:assoc V1476 V1475))) (if (pair? AtomType) (cons (quote type) (cons V1476 (cons (cdr AtomType) (quote ())))) (if (kl:element? V1476 V1474) V1476 (kl:shen.atom-type V1476))))))) (export shen.assign-types) (quote shen.assign-types)) -(begin (register-function-arity (quote shen.atom-type) 1) (define (kl:shen.atom-type V1478) (if (string? V1478) (cons (quote type) (cons V1478 (cons (quote string) (quote ())))) (if (number? V1478) (cons (quote type) (cons V1478 (cons (quote number) (quote ())))) (if (kl:boolean? V1478) (cons (quote type) (cons V1478 (cons (quote boolean) (quote ())))) (if (kl:symbol? V1478) (cons (quote type) (cons V1478 (cons (quote symbol) (quote ())))) V1478))))) (export shen.atom-type) (quote shen.atom-type)) -(begin (register-function-arity (quote shen.store-arity) 2) (define (kl:shen.store-arity V1483 V1484) (cond ((assert-boolean (kl:value (quote shen.*installing-kl*))) (quote shen.skip)) (#t (kl:put V1483 (quote arity) V1484 (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 V1486) (begin (kl:set (quote shen.*teststack*) (quote ())) (let ((Result (kl:shen.reduce_help V1486))) (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 V1488) (cond ((and (pair? V1488) (and (pair? (car V1488)) (and (eq? (quote /.) (car (car V1488))) (and (pair? (cdr (car V1488))) (and (pair? (car (cdr (car V1488)))) (and (eq? (quote cons) (car (car (cdr (car V1488))))) (and (pair? (cdr (car (cdr (car V1488))))) (and (pair? (cdr (cdr (car (cdr (car V1488)))))) (and (null? (cdr (cdr (cdr (car (cdr (car V1488))))))) (and (pair? (cdr (cdr (car V1488)))) (and (null? (cdr (cdr (cdr (car V1488))))) (and (pair? (cdr V1488)) (null? (cdr (cdr V1488))))))))))))))) (begin (kl:shen.add_test (cons (quote cons?) (cdr V1488))) (let ((Abstraction (cons (quote /.) (cons (car (cdr (car (cdr (car V1488))))) (cons (cons (quote /.) (cons (car (cdr (cdr (car (cdr (car V1488)))))) (cons (kl:shen.ebr (car (cdr V1488)) (car (cdr (car V1488))) (car (cdr (cdr (car V1488))))) (quote ())))) (quote ())))))) (let ((Application (cons (cons Abstraction (cons (cons (quote hd) (cdr V1488)) (quote ()))) (cons (cons (quote tl) (cdr V1488)) (quote ()))))) (kl:shen.reduce_help Application))))) ((and (pair? V1488) (and (pair? (car V1488)) (and (eq? (quote /.) (car (car V1488))) (and (pair? (cdr (car V1488))) (and (pair? (car (cdr (car V1488)))) (and (eq? (quote _waspvm_at_p) (car (car (cdr (car V1488))))) (and (pair? (cdr (car (cdr (car V1488))))) (and (pair? (cdr (cdr (car (cdr (car V1488)))))) (and (null? (cdr (cdr (cdr (car (cdr (car V1488))))))) (and (pair? (cdr (cdr (car V1488)))) (and (null? (cdr (cdr (cdr (car V1488))))) (and (pair? (cdr V1488)) (null? (cdr (cdr V1488))))))))))))))) (begin (kl:shen.add_test (cons (quote tuple?) (cdr V1488))) (let ((Abstraction (cons (quote /.) (cons (car (cdr (car (cdr (car V1488))))) (cons (cons (quote /.) (cons (car (cdr (cdr (car (cdr (car V1488)))))) (cons (kl:shen.ebr (car (cdr V1488)) (car (cdr (car V1488))) (car (cdr (cdr (car V1488))))) (quote ())))) (quote ())))))) (let ((Application (cons (cons Abstraction (cons (cons (quote fst) (cdr V1488)) (quote ()))) (cons (cons (quote snd) (cdr V1488)) (quote ()))))) (kl:shen.reduce_help Application))))) ((and (pair? V1488) (and (pair? (car V1488)) (and (eq? (quote /.) (car (car V1488))) (and (pair? (cdr (car V1488))) (and (pair? (car (cdr (car V1488)))) (and (eq? (quote _waspvm_at_v) (car (car (cdr (car V1488))))) (and (pair? (cdr (car (cdr (car V1488))))) (and (pair? (cdr (cdr (car (cdr (car V1488)))))) (and (null? (cdr (cdr (cdr (car (cdr (car V1488))))))) (and (pair? (cdr (cdr (car V1488)))) (and (null? (cdr (cdr (cdr (car V1488))))) (and (pair? (cdr V1488)) (null? (cdr (cdr V1488))))))))))))))) (begin (kl:shen.add_test (cons (quote shen.+vector?) (cdr V1488))) (let ((Abstraction (cons (quote /.) (cons (car (cdr (car (cdr (car V1488))))) (cons (cons (quote /.) (cons (car (cdr (cdr (car (cdr (car V1488)))))) (cons (kl:shen.ebr (car (cdr V1488)) (car (cdr (car V1488))) (car (cdr (cdr (car V1488))))) (quote ())))) (quote ())))))) (let ((Application (cons (cons Abstraction (cons (cons (quote hdv) (cdr V1488)) (quote ()))) (cons (cons (quote tlv) (cdr V1488)) (quote ()))))) (kl:shen.reduce_help Application))))) ((and (pair? V1488) (and (pair? (car V1488)) (and (eq? (quote /.) (car (car V1488))) (and (pair? (cdr (car V1488))) (and (pair? (car (cdr (car V1488)))) (and (eq? (quote _waspvm_at_s) (car (car (cdr (car V1488))))) (and (pair? (cdr (car (cdr (car V1488))))) (and (pair? (cdr (cdr (car (cdr (car V1488)))))) (and (null? (cdr (cdr (cdr (car (cdr (car V1488))))))) (and (pair? (cdr (cdr (car V1488)))) (and (null? (cdr (cdr (cdr (car V1488))))) (and (pair? (cdr V1488)) (null? (cdr (cdr V1488))))))))))))))) (begin (kl:shen.add_test (cons (quote shen.+string?) (cdr V1488))) (let ((Abstraction (cons (quote /.) (cons (car (cdr (car (cdr (car V1488))))) (cons (cons (quote /.) (cons (car (cdr (cdr (car (cdr (car V1488)))))) (cons (kl:shen.ebr (car (cdr V1488)) (car (cdr (car V1488))) (car (cdr (cdr (car V1488))))) (quote ())))) (quote ())))))) (let ((Application (cons (cons Abstraction (cons (cons (quote pos) (cons (car (cdr V1488)) (cons 0 (quote ())))) (quote ()))) (cons (cons (quote tlstr) (cdr V1488)) (quote ()))))) (kl:shen.reduce_help Application))))) ((and (pair? V1488) (and (pair? (car V1488)) (and (eq? (quote /.) (car (car V1488))) (and (pair? (cdr (car V1488))) (and (pair? (cdr (cdr (car V1488)))) (and (null? (cdr (cdr (cdr (car V1488))))) (and (pair? (cdr V1488)) (and (null? (cdr (cdr V1488))) (kl:not (kl:variable? (car (cdr (car V1488))))))))))))) (begin (kl:shen.add_test (cons (quote =) (cons (car (cdr (car V1488))) (cdr V1488)))) (kl:shen.reduce_help (car (cdr (cdr (car V1488))))))) ((and (pair? V1488) (and (pair? (car V1488)) (and (eq? (quote /.) (car (car V1488))) (and (pair? (cdr (car V1488))) (and (pair? (cdr (cdr (car V1488)))) (and (null? (cdr (cdr (cdr (car V1488))))) (and (pair? (cdr V1488)) (null? (cdr (cdr V1488)))))))))) (kl:shen.reduce_help (kl:shen.ebr (car (cdr V1488)) (car (cdr (car V1488))) (car (cdr (cdr (car V1488))))))) ((and (pair? V1488) (and (eq? (quote where) (car V1488)) (and (pair? (cdr V1488)) (and (pair? (cdr (cdr V1488))) (null? (cdr (cdr (cdr V1488)))))))) (begin (kl:shen.add_test (car (cdr V1488))) (kl:shen.reduce_help (car (cdr (cdr V1488)))))) ((and (pair? V1488) (and (pair? (cdr V1488)) (null? (cdr (cdr V1488))))) (let ((Z (kl:shen.reduce_help (car V1488)))) (if (kl:= (car V1488) Z) V1488 (kl:shen.reduce_help (cons Z (cdr V1488)))))) (#t V1488))) (export shen.reduce_help) (quote shen.reduce_help)) -(begin (register-function-arity (quote shen.+string?) 1) (define (kl:shen.+string? V1490) (cond ((equal? "" V1490) #f) (#t (string? V1490)))) (export shen.+string?) (quote shen.+string?)) -(begin (register-function-arity (quote shen.+vector?) 1) (define (kl:shen.+vector? V1492) (and (vector? V1492) (> (vector-ref V1492 0) 0))) (export shen.+vector?) (quote shen.+vector?)) -(begin (register-function-arity (quote shen.ebr) 3) (define (kl:shen.ebr V1505 V1506 V1507) (cond ((kl:= V1507 V1506) V1505) ((and (pair? V1507) (and (eq? (quote lambda) (car V1507)) (and (pair? (cdr V1507)) (and (pair? (cdr (cdr V1507))) (and (null? (cdr (cdr (cdr V1507)))) (assert-boolean (kl:shen.clash? (car (cdr V1507)) V1506))))))) V1507) ((and (pair? V1507) (and (eq? (quote let) (car V1507)) (and (pair? (cdr V1507)) (and (pair? (cdr (cdr V1507))) (and (pair? (cdr (cdr (cdr V1507)))) (and (null? (cdr (cdr (cdr (cdr V1507))))) (assert-boolean (kl:shen.clash? (car (cdr V1507)) V1506)))))))) (cons (quote let) (cons (car (cdr V1507)) (cons (kl:shen.ebr V1505 V1506 (car (cdr (cdr V1507)))) (cdr (cdr (cdr V1507))))))) ((pair? V1507) (cons (kl:shen.ebr V1505 V1506 (car V1507)) (kl:shen.ebr V1505 V1506 (cdr V1507)))) (#t V1507))) (export shen.ebr) (quote shen.ebr)) -(begin (register-function-arity (quote shen.clash?) 2) (define (kl:shen.clash? V1519 V1520) (cond ((kl:= V1520 V1519) #t) ((pair? V1520) (or (assert-boolean (kl:shen.clash? V1519 (car V1520))) (assert-boolean (kl:shen.clash? V1519 (cdr V1520))))) (#t #f))) (export shen.clash?) (quote shen.clash?)) -(begin (register-function-arity (quote shen.add_test) 1) (define (kl:shen.add_test V1522) (kl:set (quote shen.*teststack*) (cons V1522 (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 V1526 V1527 V1528) (let ((Err (kl:shen.err-condition V1526))) (let ((Cases (kl:shen.case-form V1528 Err))) (let ((EncodeChoices (kl:shen.encode-choices Cases V1526))) (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 V1532) (cond ((and (pair? V1532) (and (pair? (car V1532)) (and (kl:= #t (car (car V1532))) (and (pair? (cdr (car V1532))) (null? (cdr (cdr (car V1532)))))))) (car (cdr (car V1532)))) (#t (cons (quote cond) V1532)))) (export shen.cond-form) (quote shen.cond-form)) -(begin (register-function-arity (quote shen.encode-choices) 2) (define (kl:shen.encode-choices V1537 V1538) (cond ((null? V1537) (quote ())) ((and (pair? V1537) (and (pair? (car V1537)) (and (kl:= #t (car (car V1537))) (and (pair? (cdr (car V1537))) (and (pair? (car (cdr (car V1537)))) (and (eq? (quote shen.choicepoint!) (car (car (cdr (car V1537))))) (and (pair? (cdr (car (cdr (car V1537))))) (and (null? (cdr (cdr (car (cdr (car V1537)))))) (and (null? (cdr (cdr (car V1537)))) (null? (cdr V1537))))))))))) (cons (cons #t (cons (cons (quote let) (cons (quote Result) (cons (car (cdr (car (cdr (car V1537))))) (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 V1538 (quote ()))) (cons (quote shen.f_error) (cons V1538 (quote ())))) (cons (quote Result) (quote ()))))) (quote ()))))) (quote ()))) (quote ()))) ((and (pair? V1537) (and (pair? (car V1537)) (and (kl:= #t (car (car V1537))) (and (pair? (cdr (car V1537))) (and (pair? (car (cdr (car V1537)))) (and (eq? (quote shen.choicepoint!) (car (car (cdr (car V1537))))) (and (pair? (cdr (car (cdr (car V1537))))) (and (null? (cdr (cdr (car (cdr (car V1537)))))) (null? (cdr (cdr (car V1537)))))))))))) (cons (cons #t (cons (cons (quote let) (cons (quote Result) (cons (car (cdr (car (cdr (car V1537))))) (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 V1537) V1538)) (cons (quote Result) (quote ()))))) (quote ()))))) (quote ()))) (quote ()))) ((and (pair? V1537) (and (pair? (car V1537)) (and (pair? (cdr (car V1537))) (and (pair? (car (cdr (car V1537)))) (and (eq? (quote shen.choicepoint!) (car (car (cdr (car V1537))))) (and (pair? (cdr (car (cdr (car V1537))))) (and (null? (cdr (cdr (car (cdr (car V1537)))))) (null? (cdr (cdr (car V1537))))))))))) (cons (cons #t (cons (cons (quote let) (cons (quote Freeze) (cons (cons (quote freeze) (cons (kl:shen.cond-form (kl:shen.encode-choices (cdr V1537) V1538)) (quote ()))) (cons (cons (quote if) (cons (car (car V1537)) (cons (cons (quote let) (cons (quote Result) (cons (car (cdr (car (cdr (car V1537))))) (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? V1537) (and (pair? (car V1537)) (and (pair? (cdr (car V1537))) (null? (cdr (cdr (car V1537))))))) (cons (car V1537) (kl:shen.encode-choices (cdr V1537) V1538))) (#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 V1545 V1546) (cond ((null? V1545) (cons V1546 (quote ()))) ((and (pair? V1545) (and (pair? (car V1545)) (and (pair? (car (car V1545))) (and (eq? (quote :) (car (car (car V1545)))) (and (pair? (cdr (car (car V1545)))) (and (eq? (quote shen.tests) (car (cdr (car (car V1545))))) (and (null? (cdr (cdr (car (car V1545))))) (and (pair? (cdr (car V1545))) (and (pair? (car (cdr (car V1545)))) (and (eq? (quote shen.choicepoint!) (car (car (cdr (car V1545))))) (and (pair? (cdr (car (cdr (car V1545))))) (and (null? (cdr (cdr (car (cdr (car V1545)))))) (null? (cdr (cdr (car V1545)))))))))))))))) (cons (cons #t (cdr (car V1545))) (kl:shen.case-form (cdr V1545) V1546))) ((and (pair? V1545) (and (pair? (car V1545)) (and (pair? (car (car V1545))) (and (eq? (quote :) (car (car (car V1545)))) (and (pair? (cdr (car (car V1545)))) (and (eq? (quote shen.tests) (car (cdr (car (car V1545))))) (and (null? (cdr (cdr (car (car V1545))))) (and (pair? (cdr (car V1545))) (null? (cdr (cdr (car V1545)))))))))))) (cons (cons #t (cdr (car V1545))) (quote ()))) ((and (pair? V1545) (and (pair? (car V1545)) (and (pair? (car (car V1545))) (and (eq? (quote :) (car (car (car V1545)))) (and (pair? (cdr (car (car V1545)))) (and (eq? (quote shen.tests) (car (cdr (car (car V1545))))) (and (pair? (cdr (car V1545))) (null? (cdr (cdr (car V1545))))))))))) (cons (cons (kl:shen.embed-and (cdr (cdr (car (car V1545))))) (cdr (car V1545))) (kl:shen.case-form (cdr V1545) V1546))) (#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 V1548) (cond ((and (pair? V1548) (null? (cdr V1548))) (car V1548)) ((pair? V1548) (cons (quote and) (cons (car V1548) (cons (kl:shen.embed-and (cdr V1548)) (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 V1550) (cons #t (cons (cons (quote shen.f_error) (cons V1550 (quote ()))) (quote ())))) (export shen.err-condition) (quote shen.err-condition)) -(begin (register-function-arity (quote shen.sys-error) 1) (define (kl:shen.sys-error V1552) (simple-error (string-append "system function " (kl:shen.app V1552 ": unexpected argument\n" (quote shen.a))))) (export shen.sys-error) (quote shen.sys-error)) +(begin (register-function-arity (quote shen.shen->kl) 2) (define (kl:shen.shen->kl V94 V95) (kl:compile (lambda (X) (kl:shen. X)) (cons V94 V95) (lambda (X) (kl:shen.shen-syntax-error V94 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 V102 V103) (cond ((pair? V103) (simple-error (string-append "syntax error in " (kl:shen.app V102 (string-append " here:\n\n " (kl:shen.app (kl:shen.next-50 50 (car V103)) "\n" (quote shen.a))) (quote shen.a))))) (#t (simple-error (string-append "syntax error in " (kl:shen.app V102 "\n" (quote shen.a))))))) (export shen.shen-syntax-error) (quote shen.shen-syntax-error)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V105) (let ((YaccParse (let ((Parse_shen. (kl:shen. V105))) (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. V105))) (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. V107) (if (pair? (car V107)) (let ((Parse_X (kl:shen.hdhd V107))) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V107) (kl:shen.hdtl V107))) (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? V109) (kl:element? V109 (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. V113) (if (and (pair? (car V113)) (eq? (quote {) (kl:shen.hdhd V113))) (let ((NewStream110 (kl:shen.pair (kl:shen.tlhd V113) (kl:shen.hdtl V113)))) (let ((Parse_shen. (kl:shen. NewStream110))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (if (and (pair? (car Parse_shen.)) (eq? (quote }) (kl:shen.hdhd Parse_shen.))) (let ((NewStream111 (kl:shen.pair (kl:shen.tlhd Parse_shen.) (kl:shen.hdtl Parse_shen.)))) (kl:shen.pair (car NewStream111) (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 V115) (kl:shen.active-cons (kl:shen.curry-type-h V115))) (export shen.curry-type) (quote shen.curry-type)) +(begin (register-function-arity (quote shen.active-cons) 1) (define (kl:shen.active-cons V117) (cond ((and (pair? V117) (and (pair? (cdr V117)) (and (pair? (cdr (cdr V117))) (and (null? (cdr (cdr (cdr V117)))) (eq? (car (cdr V117)) (quote bar!)))))) (cons (kl:shen.active-cons (car V117)) (kl:shen.active-cons (car (cdr (cdr V117)))))) ((pair? V117) (cons (kl:shen.active-cons (car V117)) (kl:shen.active-cons (cdr V117)))) (#t V117))) (export shen.active-cons) (quote shen.active-cons)) +(begin (register-function-arity (quote shen.curry-type-h) 1) (define (kl:shen.curry-type-h V119) (cond ((and (pair? V119) (and (pair? (cdr V119)) (and (eq? (quote -->) (car (cdr V119))) (and (pair? (cdr (cdr V119))) (and (pair? (cdr (cdr (cdr V119)))) (eq? (quote -->) (car (cdr (cdr (cdr V119)))))))))) (kl:shen.curry-type-h (cons (car V119) (cons (quote -->) (cons (cdr (cdr V119)) (quote ())))))) ((and (pair? V119) (and (pair? (cdr V119)) (and (eq? (quote *) (car (cdr V119))) (and (pair? (cdr (cdr V119))) (and (pair? (cdr (cdr (cdr V119)))) (eq? (quote *) (car (cdr (cdr (cdr V119)))))))))) (kl:shen.curry-type-h (cons (car V119) (cons (quote *) (cons (cdr (cdr V119)) (quote ())))))) ((pair? V119) (kl:map (lambda (Z) (kl:shen.curry-type-h Z)) V119)) (#t V119))) (export shen.curry-type-h) (quote shen.curry-type-h)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V121) (let ((YaccParse (if (pair? (car V121)) (let ((Parse_X (kl:shen.hdhd V121))) (let ((Parse_shen. (kl:shen. (kl:shen.pair (kl:shen.tlhd V121) (kl:shen.hdtl V121))))) (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: V121))) (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. V123) (let ((YaccParse (let ((Parse_shen. (kl:shen. V123))) (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. V123))) (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. V131) (let ((YaccParse (let ((Parse_shen. (kl:shen. V131))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (if (and (pair? (car Parse_shen.)) (eq? (quote ->) (kl:shen.hdhd Parse_shen.))) (let ((NewStream124 (kl:shen.pair (kl:shen.tlhd Parse_shen.) (kl:shen.hdtl Parse_shen.)))) (let ((Parse_shen. (kl:shen. NewStream124))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (if (and (pair? (car Parse_shen.)) (eq? (quote where) (kl:shen.hdhd Parse_shen.))) (let ((NewStream125 (kl:shen.pair (kl:shen.tlhd Parse_shen.) (kl:shen.hdtl Parse_shen.)))) (let ((Parse_shen. (kl:shen. NewStream125))) (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. V131))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (if (and (pair? (car Parse_shen.)) (eq? (quote ->) (kl:shen.hdhd Parse_shen.))) (let ((NewStream126 (kl:shen.pair (kl:shen.tlhd Parse_shen.) (kl:shen.hdtl Parse_shen.)))) (let ((Parse_shen. (kl:shen. NewStream126))) (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. V131))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (if (and (pair? (car Parse_shen.)) (eq? (quote <-) (kl:shen.hdhd Parse_shen.))) (let ((NewStream127 (kl:shen.pair (kl:shen.tlhd Parse_shen.) (kl:shen.hdtl Parse_shen.)))) (let ((Parse_shen. (kl:shen. NewStream127))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (if (and (pair? (car Parse_shen.)) (eq? (quote where) (kl:shen.hdhd Parse_shen.))) (let ((NewStream128 (kl:shen.pair (kl:shen.tlhd Parse_shen.) (kl:shen.hdtl Parse_shen.)))) (let ((Parse_shen. (kl:shen. NewStream128))) (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. V131))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (if (and (pair? (car Parse_shen.)) (eq? (quote <-) (kl:shen.hdhd Parse_shen.))) (let ((NewStream129 (kl:shen.pair (kl:shen.tlhd Parse_shen.) (kl:shen.hdtl Parse_shen.)))) (let ((Parse_shen. (kl:shen. NewStream129))) (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 V134 V135) (if (assert-boolean (V134 V135)) (kl:fail) V135)) (export shen.fail_if) (quote shen.fail_if)) +(begin (register-function-arity (quote shen.succeeds?) 1) (define (kl:shen.succeeds? V141) (cond ((kl:= V141 (kl:fail)) #f) (#t #t))) (export shen.succeeds?) (quote shen.succeeds?)) +(begin (register-function-arity (quote shen.custom-pattern-compiler) 2) (define (kl:shen.custom-pattern-compiler V144 V145) (((kl:value (quote shen.*custom-pattern-compiler*)) V144) V145)) (export shen.custom-pattern-compiler) (quote shen.custom-pattern-compiler)) +(begin (register-function-arity (quote shen.custom-pattern-reducer) 1) (define (kl:shen.custom-pattern-reducer V147) ((kl:value (quote shen.*custom-pattern-reducer*)) V147)) (export shen.custom-pattern-reducer) (quote shen.custom-pattern-reducer)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V149) (let ((YaccParse (let ((Parse_shen. (kl:shen. V149))) (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: V149))) (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. V162) (let ((YaccParse (if (and (pair? (car V162)) (pair? (kl:shen.hdhd V162))) (if (and (pair? (car (kl:shen.pair (kl:shen.hdhd V162) (kl:shen.hdtl V162)))) (eq? (quote _waspvm_at_p) (kl:shen.hdhd (kl:shen.pair (kl:shen.hdhd V162) (kl:shen.hdtl V162))))) (let ((NewStream151 (kl:shen.pair (kl:shen.tlhd (kl:shen.pair (kl:shen.hdhd V162) (kl:shen.hdtl V162))) (kl:shen.hdtl (kl:shen.pair (kl:shen.hdhd V162) (kl:shen.hdtl V162)))))) (let ((Parse_shen. (kl:shen. NewStream151))) (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 V162) (kl:shen.hdtl V162))) (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 V162)) (pair? (kl:shen.hdhd V162))) (if (and (pair? (car (kl:shen.pair (kl:shen.hdhd V162) (kl:shen.hdtl V162)))) (eq? (quote cons) (kl:shen.hdhd (kl:shen.pair (kl:shen.hdhd V162) (kl:shen.hdtl V162))))) (let ((NewStream153 (kl:shen.pair (kl:shen.tlhd (kl:shen.pair (kl:shen.hdhd V162) (kl:shen.hdtl V162))) (kl:shen.hdtl (kl:shen.pair (kl:shen.hdhd V162) (kl:shen.hdtl V162)))))) (let ((Parse_shen. (kl:shen. NewStream153))) (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 V162) (kl:shen.hdtl V162))) (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 V162)) (pair? (kl:shen.hdhd V162))) (if (and (pair? (car (kl:shen.pair (kl:shen.hdhd V162) (kl:shen.hdtl V162)))) (eq? (quote _waspvm_at_v) (kl:shen.hdhd (kl:shen.pair (kl:shen.hdhd V162) (kl:shen.hdtl V162))))) (let ((NewStream155 (kl:shen.pair (kl:shen.tlhd (kl:shen.pair (kl:shen.hdhd V162) (kl:shen.hdtl V162))) (kl:shen.hdtl (kl:shen.pair (kl:shen.hdhd V162) (kl:shen.hdtl V162)))))) (let ((Parse_shen. (kl:shen. NewStream155))) (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 V162) (kl:shen.hdtl V162))) (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 V162)) (pair? (kl:shen.hdhd V162))) (if (and (pair? (car (kl:shen.pair (kl:shen.hdhd V162) (kl:shen.hdtl V162)))) (eq? (quote _waspvm_at_s) (kl:shen.hdhd (kl:shen.pair (kl:shen.hdhd V162) (kl:shen.hdtl V162))))) (let ((NewStream157 (kl:shen.pair (kl:shen.tlhd (kl:shen.pair (kl:shen.hdhd V162) (kl:shen.hdtl V162))) (kl:shen.hdtl (kl:shen.pair (kl:shen.hdhd V162) (kl:shen.hdtl V162)))))) (let ((Parse_shen. (kl:shen. NewStream157))) (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 V162) (kl:shen.hdtl V162))) (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 V162)) (pair? (kl:shen.hdhd V162))) (if (and (pair? (car (kl:shen.pair (kl:shen.hdhd V162) (kl:shen.hdtl V162)))) (eq? (quote vector) (kl:shen.hdhd (kl:shen.pair (kl:shen.hdhd V162) (kl:shen.hdtl V162))))) (let ((NewStream159 (kl:shen.pair (kl:shen.tlhd (kl:shen.pair (kl:shen.hdhd V162) (kl:shen.hdtl V162))) (kl:shen.hdtl (kl:shen.pair (kl:shen.hdhd V162) (kl:shen.hdtl V162)))))) (if (and (pair? (car NewStream159)) (kl:= 0 (kl:shen.hdhd NewStream159))) (let ((NewStream160 (kl:shen.pair (kl:shen.tlhd NewStream159) (kl:shen.hdtl NewStream159)))) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V162) (kl:shen.hdtl V162))) (cons (quote vector) (cons 0 (quote ()))))) (kl:fail))) (kl:fail)) (kl:fail)))) (if (kl:= YaccParse (kl:fail)) (let ((YaccParse (if (pair? (car V162)) (let ((Parse_X (kl:shen.hdhd V162))) (if (pair? Parse_X) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V162) (kl:shen.hdtl V162))) (kl:shen.custom-pattern-compiler Parse_X (lambda () (kl:shen.constructor-error Parse_X)))) (kl:fail))) (kl:fail)))) (if (kl:= YaccParse (kl:fail)) (let ((Parse_shen. (kl:shen. V162))) (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 V164) (simple-error (kl:shen.app V164 " 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. V166) (let ((YaccParse (if (pair? (car V166)) (let ((Parse_X (kl:shen.hdhd V166))) (if (eq? Parse_X (quote _)) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V166) (kl:shen.hdtl V166))) (kl:gensym (quote Parse_Y))) (kl:fail))) (kl:fail)))) (if (kl:= YaccParse (kl:fail)) (if (pair? (car V166)) (let ((Parse_X (kl:shen.hdhd V166))) (if (kl:not (kl:element? Parse_X (cons (quote ->) (cons (quote <-) (quote ()))))) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V166) (kl:shen.hdtl V166))) Parse_X) (kl:fail))) (kl:fail)) YaccParse))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V168) (let ((Parse_shen. (kl:shen. V168))) (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. V170) (let ((Parse_shen. (kl:shen. V170))) (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. V172) (if (pair? (car V172)) (let ((Parse_X (kl:shen.hdhd V172))) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V172) (kl:shen.hdtl V172))) Parse_X)) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V174) (if (pair? (car V174)) (let ((Parse_X (kl:shen.hdhd V174))) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V174) (kl:shen.hdtl V174))) 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 V177 V178) (let ((Lambda+ (kl:shen.compile_to_lambda+ V177 V178))) (let ((KL (kl:shen.compile_to_kl V177 Lambda+))) (let ((Record (kl:shen.record-source V177 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 V183 V184) (cond ((assert-boolean (kl:value (quote shen.*installing-kl*))) (quote shen.skip)) (#t (kl:put V183 (quote shen.source) V184 (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+ V187 V188) (let ((Arity (kl:shen.aritycheck V187 V188))) (let ((UpDateSymbolTable (kl:shen.update-symbol-table V187 Arity))) (let ((Free (kl:shen.for-each (lambda (Rule) (kl:shen.free_variable_check V187 Rule)) V188))) (let ((Variables (kl:shen.parameters Arity))) (let ((Strip (kl:map (lambda (X) (kl:shen.strip-protect X)) V188))) (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 V191 V192) (cond ((kl:= 0 V192) (quote shen.skip)) (#t (kl:put V191 (quote shen.lambda-form) (kl:eval-kl (kl:shen.lambda-form V191 V192)) (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 V195 V196) (cond ((and (pair? V196) (and (pair? (cdr V196)) (null? (cdr (cdr V196))))) (let ((Bound (kl:shen.extract_vars (car V196)))) (let ((Free (kl:shen.extract_free_vars Bound (car (cdr V196))))) (kl:shen.free_variable_warnings V195 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 V198) (cond ((kl:variable? V198) (cons V198 (quote ()))) ((pair? V198) (kl:union (kl:shen.extract_vars (car V198)) (kl:shen.extract_vars (cdr V198)))) (#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 V210 V211) (cond ((and (pair? V211) (and (pair? (cdr V211)) (and (null? (cdr (cdr V211))) (eq? (car V211) (quote protect))))) (quote ())) ((and (kl:variable? V211) (kl:not (kl:element? V211 V210))) (cons V211 (quote ()))) ((and (pair? V211) (and (eq? (quote lambda) (car V211)) (and (pair? (cdr V211)) (and (pair? (cdr (cdr V211))) (null? (cdr (cdr (cdr V211)))))))) (kl:shen.extract_free_vars (cons (car (cdr V211)) V210) (car (cdr (cdr V211))))) ((and (pair? V211) (and (eq? (quote let) (car V211)) (and (pair? (cdr V211)) (and (pair? (cdr (cdr V211))) (and (pair? (cdr (cdr (cdr V211)))) (null? (cdr (cdr (cdr (cdr V211)))))))))) (kl:union (kl:shen.extract_free_vars V210 (car (cdr (cdr V211)))) (kl:shen.extract_free_vars (cons (car (cdr V211)) V210) (car (cdr (cdr (cdr V211))))))) ((pair? V211) (kl:union (kl:shen.extract_free_vars V210 (car V211)) (kl:shen.extract_free_vars V210 (cdr V211)))) (#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 V216 V217) (cond ((null? V217) (quote _)) (#t (simple-error (string-append "error: the following variables are free in " (kl:shen.app V216 (string-append ": " (kl:shen.app (kl:shen.list_variables V217) "" (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 V219) (cond ((and (pair? V219) (null? (cdr V219))) (string-append (kl:str (car V219)) ".")) ((pair? V219) (string-append (kl:str (car V219)) (string-append ", " (kl:shen.list_variables (cdr V219))))) (#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 V221) (cond ((and (pair? V221) (and (pair? (cdr V221)) (and (null? (cdr (cdr V221))) (eq? (car V221) (quote protect))))) (kl:shen.strip-protect (car (cdr V221)))) ((pair? V221) (kl:map (lambda (Z) (kl:shen.strip-protect Z)) V221)) (#t V221))) (export shen.strip-protect) (quote shen.strip-protect)) +(begin (register-function-arity (quote shen.linearise) 1) (define (kl:shen.linearise V223) (cond ((and (pair? V223) (and (pair? (cdr V223)) (null? (cdr (cdr V223))))) (kl:shen.linearise_help (kl:shen.flatten (car V223)) (car V223) (car (cdr V223)))) (#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 V225) (cond ((null? V225) (quote ())) ((pair? V225) (kl:append (kl:shen.flatten (car V225)) (kl:shen.flatten (cdr V225)))) (#t (cons V225 (quote ()))))) (export shen.flatten) (quote shen.flatten)) +(begin (register-function-arity (quote shen.linearise_help) 3) (define (kl:shen.linearise_help V229 V230 V231) (cond ((null? V229) (cons V230 (cons V231 (quote ())))) ((pair? V229) (if (and (kl:variable? (car V229)) (kl:element? (car V229) (cdr V229))) (let ((Var (kl:gensym (car V229)))) (let ((NewAction (cons (quote where) (cons (cons (quote =) (cons (car V229) (cons Var (quote ())))) (cons V231 (quote ())))))) (let ((NewPatts (kl:shen.linearise_X (car V229) Var V230))) (kl:shen.linearise_help (cdr V229) NewPatts NewAction)))) (kl:shen.linearise_help (cdr V229) V230 V231))) (#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 V244 V245 V246) (cond ((kl:= V246 V244) V245) ((pair? V246) (let ((L (kl:shen.linearise_X V244 V245 (car V246)))) (if (kl:= L (car V246)) (cons (car V246) (kl:shen.linearise_X V244 V245 (cdr V246))) (cons L (cdr V246))))) (#t V246))) (export shen.linearise_X) (quote shen.linearise_X)) +(begin (register-function-arity (quote shen.aritycheck) 2) (define (kl:shen.aritycheck V249 V250) (cond ((and (pair? V250) (and (pair? (car V250)) (and (pair? (cdr (car V250))) (and (null? (cdr (cdr (car V250)))) (null? (cdr V250)))))) (begin (kl:shen.aritycheck-action (car (cdr (car V250)))) (kl:shen.aritycheck-name V249 (kl:arity V249) (kl:length (car (car V250)))))) ((and (pair? V250) (and (pair? (car V250)) (and (pair? (cdr (car V250))) (and (null? (cdr (cdr (car V250)))) (and (pair? (cdr V250)) (and (pair? (car (cdr V250))) (and (pair? (cdr (car (cdr V250)))) (null? (cdr (cdr (car (cdr V250)))))))))))) (if (kl:= (kl:length (car (car V250))) (kl:length (car (car (cdr V250))))) (begin (kl:shen.aritycheck-action (car (cdr (car V250)))) (kl:shen.aritycheck V249 (cdr V250))) (simple-error (string-append "arity error in " (kl:shen.app V249 "\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 V263 V264 V265) (cond ((kl:= -1 V264) V265) ((kl:= V265 V264) V265) (#t (begin (kl:shen.prhush (string-append "\nwarning: changing the arity of " (kl:shen.app V263 " can cause errors.\n" (quote shen.a))) (kl:stoutput)) V265)))) (export shen.aritycheck-name) (quote shen.aritycheck-name)) +(begin (register-function-arity (quote shen.aritycheck-action) 1) (define (kl:shen.aritycheck-action V271) (cond ((pair? V271) (begin (kl:shen.aah (car V271) (cdr V271)) (kl:shen.for-each (lambda (Y) (kl:shen.aritycheck-action Y)) V271))) (#t (quote shen.skip)))) (export shen.aritycheck-action) (quote shen.aritycheck-action)) +(begin (register-function-arity (quote shen.aah) 2) (define (kl:shen.aah V274 V275) (let ((Arity (kl:arity V274))) (let ((Len (kl:length V275))) (if (and (> Arity -1) (> Len Arity)) (kl:shen.prhush (string-append "warning: " (kl:shen.app V274 (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 V277) (cond ((and (pair? V277) (and (pair? (cdr V277)) (null? (cdr (cdr V277))))) (kl:shen.abstraction_build (car V277) (car (cdr V277)))) (#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 V280 V281) (cond ((null? V280) V281) ((pair? V280) (cons (quote /.) (cons (car V280) (cons (kl:shen.abstraction_build (cdr V280) V281) (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 V283) (cond ((kl:= 0 V283) (quote ())) (#t (cons (kl:gensym (quote V)) (kl:shen.parameters (- V283 1)))))) (export shen.parameters) (quote shen.parameters)) +(begin (register-function-arity (quote shen.application_build) 2) (define (kl:shen.application_build V286 V287) (cond ((null? V286) V287) ((pair? V286) (kl:shen.application_build (cdr V286) (cons V287 (cons (car V286) (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 V290 V291) (cond ((and (pair? V291) (and (pair? (cdr V291)) (null? (cdr (cdr V291))))) (let ((Arity (kl:shen.store-arity V290 (kl:length (car V291))))) (let ((Reduce (kl:map (lambda (X) (kl:shen.reduce X)) (car (cdr V291))))) (let ((CondExpression (kl:shen.cond-expression V290 (car V291) Reduce))) (let ((TypeTable (if (assert-boolean (kl:value (quote shen.*optimise*))) (kl:shen.typextable (kl:shen.get-type V290) (car V291)) (quote shen.skip)))) (let ((TypedCondExpression (if (assert-boolean (kl:value (quote shen.*optimise*))) (kl:shen.assign-types (car V291) TypeTable CondExpression) CondExpression))) (cons (quote defun) (cons V290 (cons (car V291) (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 V297) (cond ((pair? V297) (quote shen.skip)) (#t (let ((FType (kl:assoc V297 (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 V308 V309) (cond ((and (pair? V308) (and (pair? (cdr V308)) (and (eq? (quote -->) (car (cdr V308))) (and (pair? (cdr (cdr V308))) (and (null? (cdr (cdr (cdr V308)))) (pair? V309)))))) (if (kl:variable? (car V308)) (kl:shen.typextable (car (cdr (cdr V308))) (cdr V309)) (cons (cons (car V309) (car V308)) (kl:shen.typextable (car (cdr (cdr V308))) (cdr V309))))) (#t (quote ())))) (export shen.typextable) (quote shen.typextable)) +(begin (register-function-arity (quote shen.assign-types) 3) (define (kl:shen.assign-types V313 V314 V315) (cond ((and (pair? V315) (and (eq? (quote let) (car V315)) (and (pair? (cdr V315)) (and (pair? (cdr (cdr V315))) (and (pair? (cdr (cdr (cdr V315)))) (null? (cdr (cdr (cdr (cdr V315)))))))))) (cons (quote let) (cons (car (cdr V315)) (cons (kl:shen.assign-types V313 V314 (car (cdr (cdr V315)))) (cons (kl:shen.assign-types (cons (car (cdr V315)) V313) V314 (car (cdr (cdr (cdr V315))))) (quote ())))))) ((and (pair? V315) (and (eq? (quote lambda) (car V315)) (and (pair? (cdr V315)) (and (pair? (cdr (cdr V315))) (null? (cdr (cdr (cdr V315)))))))) (cons (quote lambda) (cons (car (cdr V315)) (cons (kl:shen.assign-types (cons (car (cdr V315)) V313) V314 (car (cdr (cdr V315)))) (quote ()))))) ((and (pair? V315) (eq? (quote cond) (car V315))) (cons (quote cond) (kl:map (lambda (Y) (cons (kl:shen.assign-types V313 V314 (car Y)) (cons (kl:shen.assign-types V313 V314 (car (cdr Y))) (quote ())))) (cdr V315)))) ((pair? V315) (let ((NewTable (kl:shen.typextable (kl:shen.get-type (car V315)) (cdr V315)))) (cons (car V315) (kl:map (lambda (Y) (kl:shen.assign-types V313 (kl:append V314 NewTable) Y)) (cdr V315))))) (#t (let ((AtomType (kl:assoc V315 V314))) (if (pair? AtomType) (cons (quote type) (cons V315 (cons (cdr AtomType) (quote ())))) (if (kl:element? V315 V313) V315 (kl:shen.atom-type V315))))))) (export shen.assign-types) (quote shen.assign-types)) +(begin (register-function-arity (quote shen.atom-type) 1) (define (kl:shen.atom-type V317) (if (string? V317) (cons (quote type) (cons V317 (cons (quote string) (quote ())))) (if (number? V317) (cons (quote type) (cons V317 (cons (quote number) (quote ())))) (if (kl:boolean? V317) (cons (quote type) (cons V317 (cons (quote boolean) (quote ())))) (if (kl:symbol? V317) (cons (quote type) (cons V317 (cons (quote symbol) (quote ())))) V317))))) (export shen.atom-type) (quote shen.atom-type)) +(begin (register-function-arity (quote shen.store-arity) 2) (define (kl:shen.store-arity V322 V323) (cond ((assert-boolean (kl:value (quote shen.*installing-kl*))) (quote shen.skip)) (#t (kl:put V322 (quote arity) V323 (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 V325) (begin (kl:set (quote shen.*teststack*) (quote ())) (let ((Result (kl:shen.reduce_help V325))) (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 V327) (cond ((and (pair? V327) (and (pair? (car V327)) (and (eq? (quote /.) (car (car V327))) (and (pair? (cdr (car V327))) (and (pair? (car (cdr (car V327)))) (and (eq? (quote cons) (car (car (cdr (car V327))))) (and (pair? (cdr (car (cdr (car V327))))) (and (pair? (cdr (cdr (car (cdr (car V327)))))) (and (null? (cdr (cdr (cdr (car (cdr (car V327))))))) (and (pair? (cdr (cdr (car V327)))) (and (null? (cdr (cdr (cdr (car V327))))) (and (pair? (cdr V327)) (null? (cdr (cdr V327))))))))))))))) (begin (kl:shen.add_test (cons (quote cons?) (cdr V327))) (let ((Abstraction (cons (quote /.) (cons (car (cdr (car (cdr (car V327))))) (cons (cons (quote /.) (cons (car (cdr (cdr (car (cdr (car V327)))))) (cons (kl:shen.ebr (car (cdr V327)) (car (cdr (car V327))) (car (cdr (cdr (car V327))))) (quote ())))) (quote ())))))) (let ((Application (cons (cons Abstraction (cons (cons (quote hd) (cdr V327)) (quote ()))) (cons (cons (quote tl) (cdr V327)) (quote ()))))) (kl:shen.reduce_help Application))))) ((and (pair? V327) (and (pair? (car V327)) (and (eq? (quote /.) (car (car V327))) (and (pair? (cdr (car V327))) (and (pair? (car (cdr (car V327)))) (and (eq? (quote _waspvm_at_p) (car (car (cdr (car V327))))) (and (pair? (cdr (car (cdr (car V327))))) (and (pair? (cdr (cdr (car (cdr (car V327)))))) (and (null? (cdr (cdr (cdr (car (cdr (car V327))))))) (and (pair? (cdr (cdr (car V327)))) (and (null? (cdr (cdr (cdr (car V327))))) (and (pair? (cdr V327)) (null? (cdr (cdr V327))))))))))))))) (begin (kl:shen.add_test (cons (quote tuple?) (cdr V327))) (let ((Abstraction (cons (quote /.) (cons (car (cdr (car (cdr (car V327))))) (cons (cons (quote /.) (cons (car (cdr (cdr (car (cdr (car V327)))))) (cons (kl:shen.ebr (car (cdr V327)) (car (cdr (car V327))) (car (cdr (cdr (car V327))))) (quote ())))) (quote ())))))) (let ((Application (cons (cons Abstraction (cons (cons (quote fst) (cdr V327)) (quote ()))) (cons (cons (quote snd) (cdr V327)) (quote ()))))) (kl:shen.reduce_help Application))))) ((and (pair? V327) (and (pair? (car V327)) (and (eq? (quote /.) (car (car V327))) (and (pair? (cdr (car V327))) (and (pair? (car (cdr (car V327)))) (and (eq? (quote _waspvm_at_v) (car (car (cdr (car V327))))) (and (pair? (cdr (car (cdr (car V327))))) (and (pair? (cdr (cdr (car (cdr (car V327)))))) (and (null? (cdr (cdr (cdr (car (cdr (car V327))))))) (and (pair? (cdr (cdr (car V327)))) (and (null? (cdr (cdr (cdr (car V327))))) (and (pair? (cdr V327)) (null? (cdr (cdr V327))))))))))))))) (begin (kl:shen.add_test (cons (quote shen.+vector?) (cdr V327))) (let ((Abstraction (cons (quote /.) (cons (car (cdr (car (cdr (car V327))))) (cons (cons (quote /.) (cons (car (cdr (cdr (car (cdr (car V327)))))) (cons (kl:shen.ebr (car (cdr V327)) (car (cdr (car V327))) (car (cdr (cdr (car V327))))) (quote ())))) (quote ())))))) (let ((Application (cons (cons Abstraction (cons (cons (quote hdv) (cdr V327)) (quote ()))) (cons (cons (quote tlv) (cdr V327)) (quote ()))))) (kl:shen.reduce_help Application))))) ((and (pair? V327) (and (pair? (car V327)) (and (eq? (quote /.) (car (car V327))) (and (pair? (cdr (car V327))) (and (pair? (car (cdr (car V327)))) (and (eq? (quote _waspvm_at_s) (car (car (cdr (car V327))))) (and (pair? (cdr (car (cdr (car V327))))) (and (pair? (cdr (cdr (car (cdr (car V327)))))) (and (null? (cdr (cdr (cdr (car (cdr (car V327))))))) (and (pair? (cdr (cdr (car V327)))) (and (null? (cdr (cdr (cdr (car V327))))) (and (pair? (cdr V327)) (null? (cdr (cdr V327))))))))))))))) (begin (kl:shen.add_test (cons (quote shen.+string?) (cdr V327))) (let ((Abstraction (cons (quote /.) (cons (car (cdr (car (cdr (car V327))))) (cons (cons (quote /.) (cons (car (cdr (cdr (car (cdr (car V327)))))) (cons (kl:shen.ebr (car (cdr V327)) (car (cdr (car V327))) (car (cdr (cdr (car V327))))) (quote ())))) (quote ())))))) (let ((Application (cons (cons Abstraction (cons (cons (quote pos) (cons (car (cdr V327)) (cons 0 (quote ())))) (quote ()))) (cons (cons (quote tlstr) (cdr V327)) (quote ()))))) (kl:shen.reduce_help Application))))) ((and (pair? V327) (and (pair? (car V327)) (and (eq? (quote /.) (car (car V327))) (and (pair? (cdr (car V327))) (and (pair? (car (cdr (car V327)))) (and (eq? (quote vector) (car (car (cdr (car V327))))) (and (pair? (cdr (car (cdr (car V327))))) (and (kl:= 0 (car (cdr (car (cdr (car V327)))))) (and (null? (cdr (cdr (car (cdr (car V327)))))) (and (pair? (cdr (cdr (car V327)))) (and (null? (cdr (cdr (cdr (car V327))))) (and (pair? (cdr V327)) (null? (cdr (cdr V327))))))))))))))) (begin (kl:shen.add_test (cons (quote vector?) (cdr V327))) (begin (kl:shen.add_test (cons (quote =) (cons 0 (cons (cons (quote limit) (cdr V327)) (quote ()))))) (kl:shen.reduce_help (kl:shen.ebr (car (cdr V327)) (car (cdr (car V327))) (car (cdr (cdr (car V327))))))))) ((and (pair? V327) (and (pair? (car V327)) (and (eq? (quote /.) (car (car V327))) (and (pair? (cdr (car V327))) (and (pair? (car (cdr (car V327)))) (and (pair? (cdr (cdr (car V327)))) (and (null? (cdr (cdr (cdr (car V327))))) (and (pair? (cdr V327)) (null? (cdr (cdr V327))))))))))) (kl:shen.custom-pattern-reducer V327)) ((and (pair? V327) (and (pair? (car V327)) (and (eq? (quote /.) (car (car V327))) (and (pair? (cdr (car V327))) (and (pair? (cdr (cdr (car V327)))) (and (null? (cdr (cdr (cdr (car V327))))) (and (pair? (cdr V327)) (and (null? (cdr (cdr V327))) (kl:not (kl:variable? (car (cdr (car V327))))))))))))) (begin (kl:shen.add_test (cons (quote =) (cons (car (cdr (car V327))) (cdr V327)))) (kl:shen.reduce_help (car (cdr (cdr (car V327))))))) ((and (pair? V327) (and (pair? (car V327)) (and (eq? (quote /.) (car (car V327))) (and (pair? (cdr (car V327))) (and (pair? (cdr (cdr (car V327)))) (and (null? (cdr (cdr (cdr (car V327))))) (and (pair? (cdr V327)) (null? (cdr (cdr V327)))))))))) (kl:shen.reduce_help (kl:shen.ebr (car (cdr V327)) (car (cdr (car V327))) (car (cdr (cdr (car V327))))))) ((and (pair? V327) (and (eq? (quote where) (car V327)) (and (pair? (cdr V327)) (and (pair? (cdr (cdr V327))) (null? (cdr (cdr (cdr V327)))))))) (begin (kl:shen.add_test (car (cdr V327))) (kl:shen.reduce_help (car (cdr (cdr V327)))))) ((and (pair? V327) (and (pair? (cdr V327)) (null? (cdr (cdr V327))))) (let ((Z (kl:shen.reduce_help (car V327)))) (if (kl:= (car V327) Z) V327 (kl:shen.reduce_help (cons Z (cdr V327)))))) (#t V327))) (export shen.reduce_help) (quote shen.reduce_help)) +(begin (register-function-arity (quote shen.+string?) 1) (define (kl:shen.+string? V329) (cond ((equal? "" V329) #f) (#t (string? V329)))) (export shen.+string?) (quote shen.+string?)) +(begin (register-function-arity (quote shen.+vector?) 1) (define (kl:shen.+vector? V331) (and (vector? V331) (> (vector-ref V331 0) 0))) (export shen.+vector?) (quote shen.+vector?)) +(begin (register-function-arity (quote shen.ebr) 3) (define (kl:shen.ebr V344 V345 V346) (cond ((kl:= V346 V345) V344) ((and (pair? V346) (and (eq? (quote lambda) (car V346)) (and (pair? (cdr V346)) (and (pair? (cdr (cdr V346))) (and (null? (cdr (cdr (cdr V346)))) (assert-boolean (kl:shen.clash? (car (cdr V346)) V345))))))) V346) ((and (pair? V346) (and (eq? (quote let) (car V346)) (and (pair? (cdr V346)) (and (pair? (cdr (cdr V346))) (and (pair? (cdr (cdr (cdr V346)))) (and (null? (cdr (cdr (cdr (cdr V346))))) (assert-boolean (kl:shen.clash? (car (cdr V346)) V345)))))))) (cons (quote let) (cons (car (cdr V346)) (cons (kl:shen.ebr V344 V345 (car (cdr (cdr V346)))) (cdr (cdr (cdr V346))))))) ((pair? V346) (cons (kl:shen.ebr V344 V345 (car V346)) (kl:shen.ebr V344 V345 (cdr V346)))) (#t V346))) (export shen.ebr) (quote shen.ebr)) +(begin (register-function-arity (quote shen.clash?) 2) (define (kl:shen.clash? V358 V359) (cond ((kl:= V359 V358) #t) ((pair? V359) (or (assert-boolean (kl:shen.clash? V358 (car V359))) (assert-boolean (kl:shen.clash? V358 (cdr V359))))) (#t #f))) (export shen.clash?) (quote shen.clash?)) +(begin (register-function-arity (quote shen.add_test) 1) (define (kl:shen.add_test V361) (kl:set (quote shen.*teststack*) (cons V361 (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 V365 V366 V367) (let ((Err (kl:shen.err-condition V365))) (let ((Cases (kl:shen.case-form V367 Err))) (let ((EncodeChoices (kl:shen.encode-choices Cases V365))) (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 V371) (cond ((and (pair? V371) (and (pair? (car V371)) (and (kl:= #t (car (car V371))) (and (pair? (cdr (car V371))) (null? (cdr (cdr (car V371)))))))) (car (cdr (car V371)))) (#t (cons (quote cond) V371)))) (export shen.cond-form) (quote shen.cond-form)) +(begin (register-function-arity (quote shen.encode-choices) 2) (define (kl:shen.encode-choices V376 V377) (cond ((null? V376) (quote ())) ((and (pair? V376) (and (pair? (car V376)) (and (kl:= #t (car (car V376))) (and (pair? (cdr (car V376))) (and (pair? (car (cdr (car V376)))) (and (eq? (quote shen.choicepoint!) (car (car (cdr (car V376))))) (and (pair? (cdr (car (cdr (car V376))))) (and (null? (cdr (cdr (car (cdr (car V376)))))) (and (null? (cdr (cdr (car V376)))) (null? (cdr V376))))))))))) (cons (cons #t (cons (cons (quote let) (cons (quote Result) (cons (car (cdr (car (cdr (car V376))))) (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 V377 (quote ()))) (cons (quote shen.f_error) (cons V377 (quote ())))) (cons (quote Result) (quote ()))))) (quote ()))))) (quote ()))) (quote ()))) ((and (pair? V376) (and (pair? (car V376)) (and (kl:= #t (car (car V376))) (and (pair? (cdr (car V376))) (and (pair? (car (cdr (car V376)))) (and (eq? (quote shen.choicepoint!) (car (car (cdr (car V376))))) (and (pair? (cdr (car (cdr (car V376))))) (and (null? (cdr (cdr (car (cdr (car V376)))))) (null? (cdr (cdr (car V376)))))))))))) (cons (cons #t (cons (cons (quote let) (cons (quote Result) (cons (car (cdr (car (cdr (car V376))))) (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 V376) V377)) (cons (quote Result) (quote ()))))) (quote ()))))) (quote ()))) (quote ()))) ((and (pair? V376) (and (pair? (car V376)) (and (pair? (cdr (car V376))) (and (pair? (car (cdr (car V376)))) (and (eq? (quote shen.choicepoint!) (car (car (cdr (car V376))))) (and (pair? (cdr (car (cdr (car V376))))) (and (null? (cdr (cdr (car (cdr (car V376)))))) (null? (cdr (cdr (car V376))))))))))) (cons (cons #t (cons (cons (quote let) (cons (quote Freeze) (cons (cons (quote freeze) (cons (kl:shen.cond-form (kl:shen.encode-choices (cdr V376) V377)) (quote ()))) (cons (cons (quote if) (cons (car (car V376)) (cons (cons (quote let) (cons (quote Result) (cons (car (cdr (car (cdr (car V376))))) (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? V376) (and (pair? (car V376)) (and (pair? (cdr (car V376))) (null? (cdr (cdr (car V376))))))) (cons (car V376) (kl:shen.encode-choices (cdr V376) V377))) (#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 V384 V385) (cond ((null? V384) (cons V385 (quote ()))) ((and (pair? V384) (and (pair? (car V384)) (and (pair? (car (car V384))) (and (eq? (quote :) (car (car (car V384)))) (and (pair? (cdr (car (car V384)))) (and (eq? (quote shen.tests) (car (cdr (car (car V384))))) (and (null? (cdr (cdr (car (car V384))))) (and (pair? (cdr (car V384))) (and (pair? (car (cdr (car V384)))) (and (eq? (quote shen.choicepoint!) (car (car (cdr (car V384))))) (and (pair? (cdr (car (cdr (car V384))))) (and (null? (cdr (cdr (car (cdr (car V384)))))) (null? (cdr (cdr (car V384)))))))))))))))) (cons (cons #t (cdr (car V384))) (kl:shen.case-form (cdr V384) V385))) ((and (pair? V384) (and (pair? (car V384)) (and (pair? (car (car V384))) (and (eq? (quote :) (car (car (car V384)))) (and (pair? (cdr (car (car V384)))) (and (eq? (quote shen.tests) (car (cdr (car (car V384))))) (and (null? (cdr (cdr (car (car V384))))) (and (pair? (cdr (car V384))) (null? (cdr (cdr (car V384)))))))))))) (cons (cons #t (cdr (car V384))) (quote ()))) ((and (pair? V384) (and (pair? (car V384)) (and (pair? (car (car V384))) (and (eq? (quote :) (car (car (car V384)))) (and (pair? (cdr (car (car V384)))) (and (eq? (quote shen.tests) (car (cdr (car (car V384))))) (and (pair? (cdr (car V384))) (null? (cdr (cdr (car V384))))))))))) (cons (cons (kl:shen.embed-and (cdr (cdr (car (car V384))))) (cdr (car V384))) (kl:shen.case-form (cdr V384) V385))) (#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 V387) (cond ((and (pair? V387) (null? (cdr V387))) (car V387)) ((pair? V387) (cons (quote and) (cons (car V387) (cons (kl:shen.embed-and (cdr V387)) (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 V389) (cons #t (cons (cons (quote shen.f_error) (cons V389 (quote ()))) (quote ())))) (export shen.err-condition) (quote shen.err-condition)) +(begin (register-function-arity (quote shen.sys-error) 1) (define (kl:shen.sys-error V391) (simple-error (string-append "system function " (kl:shen.app V391 ": 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 4374498..11f3486 100644 --- a/compiled/declarations.kl.ms +++ b/compiled/declarations.kl.ms @@ -1,12 +1,12 @@ (module "compiled/declarations.kl") "Copyright (c) 2010-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:\n\n1. Redistributions of source code must retain the above copyright notice,\nthis list of conditions and the following disclaimer.\n\n2. Redistributions in binary form must reproduce the above copyright notice,\nthis list of conditions and the following disclaimer in the documentation\nand/or other materials provided with the distribution.\n\n3. Neither the name of the copyright holder nor the names of its contributors\nmay be used to endorse or promote products derived from this software without\nspecific prior written permission.\n\nTHIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ''AS IS'' AND\nANY EXPRESS 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 THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE\nFOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL\nDAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR\nSERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER\nCAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,\nOR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE\nOF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.\n" -(begin (register-function-arity (quote shen.initialise_arity_table) 1) (define (kl:shen.initialise_arity_table V1554) (cond ((null? V1554) (quote ())) ((and (pair? V1554) (pair? (cdr V1554))) (let ((DecArity (kl:put (car V1554) (quote arity) (car (cdr V1554)) (kl:value (quote *property-vector*))))) (kl:shen.initialise_arity_table (cdr (cdr V1554))))) (#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 V1556) (guard (lambda (E) -1) (kl:get V1556 (quote arity) (kl:value (quote *property-vector*))))) (export arity) (quote arity)) -(begin (register-function-arity (quote systemf) 1) (define (kl:systemf V1558) (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 V1558 External) (kl:value (quote *property-vector*))))) V1558)))) (export systemf) (quote systemf)) -(begin (register-function-arity (quote adjoin) 2) (define (kl:adjoin V1561 V1562) (if (kl:element? V1561 V1562) V1562 (cons V1561 V1562))) (export adjoin) (quote adjoin)) -(begin (register-function-arity (quote shen.lambda-form-entry) 1) (define (kl:shen.lambda-form-entry V1564) (cond ((eq? (quote package) V1564) (quote ())) ((eq? (quote receive) V1564) (quote ())) (#t (let ((ArityF (kl:arity V1564))) (if (kl:= ArityF -1) (quote ()) (if (kl:= ArityF 0) (quote ()) (cons (cons V1564 (kl:eval-kl (kl:shen.lambda-form V1564 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 V1567 V1568) (cond ((kl:= 0 V1568) V1567) (#t (let ((X (kl:gensym (quote V)))) (cons (quote lambda) (cons X (cons (kl:shen.lambda-form (kl:shen.add-end V1567 X) (- V1568 1)) (quote ())))))))) (export shen.lambda-form) (quote shen.lambda-form)) -(begin (register-function-arity (quote shen.add-end) 2) (define (kl:shen.add-end V1571 V1572) (cond ((pair? V1571) (kl:append V1571 (cons V1572 (quote ())))) (#t (cons V1571 (cons V1572 (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 V1574) (cond ((pair? V1574) (kl:put (car V1574) (quote shen.lambda-form) (cdr V1574) (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)) -(begin (register-function-arity (quote specialise) 1) (define (kl:specialise V1576) (begin (kl:set (quote shen.*special*) (cons V1576 (kl:value (quote shen.*special*)))) V1576)) (export specialise) (quote specialise)) -(begin (register-function-arity (quote unspecialise) 1) (define (kl:unspecialise V1578) (begin (kl:set (quote shen.*special*) (kl:remove V1578 (kl:value (quote shen.*special*)))) V1578)) (export unspecialise) (quote unspecialise)) +(begin (register-function-arity (quote shen.initialise_arity_table) 1) (define (kl:shen.initialise_arity_table V393) (cond ((null? V393) (quote ())) ((and (pair? V393) (pair? (cdr V393))) (let ((DecArity (kl:put (car V393) (quote arity) (car (cdr V393)) (kl:value (quote *property-vector*))))) (kl:shen.initialise_arity_table (cdr (cdr V393))))) (#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 V395) (guard (lambda (E) -1) (kl:get V395 (quote arity) (kl:value (quote *property-vector*))))) (export arity) (quote arity)) +(begin (register-function-arity (quote systemf) 1) (define (kl:systemf V397) (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 V397 External) (kl:value (quote *property-vector*))))) V397)))) (export systemf) (quote systemf)) +(begin (register-function-arity (quote adjoin) 2) (define (kl:adjoin V400 V401) (if (kl:element? V400 V401) V401 (cons V400 V401))) (export adjoin) (quote adjoin)) +(begin (register-function-arity (quote shen.lambda-form-entry) 1) (define (kl:shen.lambda-form-entry V403) (cond ((eq? (quote package) V403) (quote ())) ((eq? (quote receive) V403) (quote ())) (#t (let ((ArityF (kl:arity V403))) (if (kl:= ArityF -1) (quote ()) (if (kl:= ArityF 0) (quote ()) (cons (cons V403 (kl:eval-kl (kl:shen.lambda-form V403 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 V406 V407) (cond ((kl:= 0 V407) V406) (#t (let ((X (kl:gensym (quote V)))) (cons (quote lambda) (cons X (cons (kl:shen.lambda-form (kl:shen.add-end V406 X) (- V407 1)) (quote ())))))))) (export shen.lambda-form) (quote shen.lambda-form)) +(begin (register-function-arity (quote shen.add-end) 2) (define (kl:shen.add-end V410 V411) (cond ((pair? V410) (kl:append V410 (cons V411 (quote ())))) (#t (cons V410 (cons V411 (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 V413) (cond ((pair? V413) (kl:put (car V413) (quote shen.lambda-form) (cdr V413) (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)) +(begin (register-function-arity (quote specialise) 1) (define (kl:specialise V415) (begin (kl:set (quote shen.*special*) (cons V415 (kl:value (quote shen.*special*)))) V415)) (export specialise) (quote specialise)) +(begin (register-function-arity (quote unspecialise) 1) (define (kl:unspecialise V417) (begin (kl:set (quote shen.*special*) (kl:remove V417 (kl:value (quote shen.*special*)))) V417)) (export unspecialise) (quote unspecialise)) diff --git a/compiled/dict.kl.ms b/compiled/dict.kl.ms index 381d717..b5d8e24 100644 --- a/compiled/dict.kl.ms +++ b/compiled/dict.kl.ms @@ -1,18 +1,18 @@ (module "compiled/dict.kl") "Copyright (c) 2010-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:\n\n1. Redistributions of source code must retain the above copyright notice,\nthis list of conditions and the following disclaimer.\n\n2. Redistributions in binary form must reproduce the above copyright notice,\nthis list of conditions and the following disclaimer in the documentation\nand/or other materials provided with the distribution.\n\n3. Neither the name of the copyright holder nor the names of its contributors\nmay be used to endorse or promote products derived from this software without\nspecific prior written permission.\n\nTHIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ''AS IS'' AND\nANY EXPRESS 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 THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE\nFOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL\nDAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR\nSERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER\nCAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,\nOR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE\nOF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.\n" -(begin (register-function-arity (quote shen.dict) 1) (define (kl:shen.dict V3445) (cond ((< V3445 1) (simple-error (string-append "invalid initial dict size: " (kl:shen.app V3445 "" (quote shen.s))))) (#t (let ((D (make-vector (+ 3 V3445) (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 V3445) _tmp))) (let ((Count (let ((_tmp D)) (vector-set! _tmp 2 0) _tmp))) (let ((Fill (kl:shen.fillvector D 3 (+ 2 V3445) (quote ())))) D)))))))) (export shen.dict) (quote shen.dict)) -(begin (register-function-arity (quote shen.dict?) 1) (define (kl:shen.dict? V3447) (and (vector? V3447) (eq? (guard (lambda (E) (quote shen.not-dictionary)) (vector-ref V3447 0)) (quote shen.dictionary)))) (export shen.dict?) (quote shen.dict?)) -(begin (register-function-arity (quote shen.dict-capacity) 1) (define (kl:shen.dict-capacity V3449) (vector-ref V3449 1)) (export shen.dict-capacity) (quote shen.dict-capacity)) -(begin (register-function-arity (quote shen.dict-count) 1) (define (kl:shen.dict-count V3451) (vector-ref V3451 2)) (export shen.dict-count) (quote shen.dict-count)) -(begin (register-function-arity (quote shen.dict-count->) 2) (define (kl:shen.dict-count-> V3454 V3455) (let ((_tmp V3454)) (vector-set! _tmp 2 V3455) _tmp)) (export shen.dict-count->) (quote shen.dict-count->)) -(begin (register-function-arity (quote shen.<-dict-bucket) 2) (define (kl:shen.<-dict-bucket V3458 V3459) (vector-ref V3458 (+ 3 V3459))) (export shen.<-dict-bucket) (quote shen.<-dict-bucket)) -(begin (register-function-arity (quote shen.dict-bucket->) 3) (define (kl:shen.dict-bucket-> V3463 V3464 V3465) (let ((_tmp V3463)) (vector-set! _tmp (+ 3 V3464) V3465) _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 V3469 V3470 V3471) (let ((Diff (- (kl:length V3471) (kl:length V3470)))) (kl:shen.dict-count-> V3469 (+ Diff (kl:shen.dict-count V3469))))) (export shen.dict-update-count) (quote shen.dict-update-count)) -(begin (register-function-arity (quote shen.dict->) 3) (define (kl:shen.dict-> V3475 V3476 V3477) (let ((N (kl:hash V3476 (kl:shen.dict-capacity V3475)))) (let ((Bucket (kl:shen.<-dict-bucket V3475 N))) (let ((NewBucket (kl:shen.assoc-set V3476 V3477 Bucket))) (let ((Change (kl:shen.dict-bucket-> V3475 N NewBucket))) (let ((Count (kl:shen.dict-update-count V3475 Bucket NewBucket))) V3477)))))) (export shen.dict->) (quote shen.dict->)) -(begin (register-function-arity (quote shen.<-dict) 2) (define (kl:shen.<-dict V3480 V3481) (let ((N (kl:hash V3481 (kl:shen.dict-capacity V3480)))) (let ((Bucket (kl:shen.<-dict-bucket V3480 N))) (let ((Result (kl:assoc V3481 Bucket))) (if (kl:empty? Result) (simple-error (string-append "value " (kl:shen.app V3481 " 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 V3484 V3485) (let ((N (kl:hash V3485 (kl:shen.dict-capacity V3484)))) (let ((Bucket (kl:shen.<-dict-bucket V3484 N))) (let ((NewBucket (kl:shen.assoc-rm V3485 Bucket))) (let ((Change (kl:shen.dict-bucket-> V3484 N NewBucket))) (let ((Count (kl:shen.dict-update-count V3484 Bucket NewBucket))) V3485)))))) (export shen.dict-rm) (quote shen.dict-rm)) -(begin (register-function-arity (quote shen.dict-fold) 3) (define (kl:shen.dict-fold V3489 V3490 V3491) (let ((Limit (kl:shen.dict-capacity V3490))) (kl:shen.dict-fold-h V3489 V3490 V3491 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 V3498 V3499 V3500 V3501 V3502) (cond ((kl:= V3502 V3501) V3500) (#t (let ((B (kl:shen.<-dict-bucket V3499 V3501))) (let ((Acc (kl:shen.bucket-fold V3498 B V3500))) (kl:shen.dict-fold-h V3498 V3499 Acc (+ 1 V3501) V3502)))))) (export shen.dict-fold-h) (quote shen.dict-fold-h)) -(begin (register-function-arity (quote shen.bucket-fold) 3) (define (kl:shen.bucket-fold V3506 V3507 V3508) (cond ((null? V3507) V3508) ((and (pair? V3507) (pair? (car V3507))) (((V3506 (car (car V3507))) (cdr (car V3507))) (kl:shen.bucket-fold V3506 (cdr V3507) V3508))) (#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 V3510) (kl:shen.dict-fold (lambda (K) (lambda (_) (lambda (Acc) (cons K Acc)))) V3510 (quote ()))) (export shen.dict-keys) (quote shen.dict-keys)) -(begin (register-function-arity (quote shen.dict-values) 1) (define (kl:shen.dict-values V3512) (kl:shen.dict-fold (lambda (_) (lambda (V) (lambda (Acc) (cons V Acc)))) V3512 (quote ()))) (export shen.dict-values) (quote shen.dict-values)) +(begin (register-function-arity (quote shen.dict) 1) (define (kl:shen.dict V2284) (cond ((< V2284 1) (simple-error (string-append "invalid initial dict size: " (kl:shen.app V2284 "" (quote shen.s))))) (#t (let ((D (make-vector (+ 3 V2284) (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 V2284) _tmp))) (let ((Count (let ((_tmp D)) (vector-set! _tmp 2 0) _tmp))) (let ((Fill (kl:shen.fillvector D 3 (+ 2 V2284) (quote ())))) D)))))))) (export shen.dict) (quote shen.dict)) +(begin (register-function-arity (quote shen.dict?) 1) (define (kl:shen.dict? V2286) (and (vector? V2286) (eq? (guard (lambda (E) (quote shen.not-dictionary)) (vector-ref V2286 0)) (quote shen.dictionary)))) (export shen.dict?) (quote shen.dict?)) +(begin (register-function-arity (quote shen.dict-capacity) 1) (define (kl:shen.dict-capacity V2288) (vector-ref V2288 1)) (export shen.dict-capacity) (quote shen.dict-capacity)) +(begin (register-function-arity (quote shen.dict-count) 1) (define (kl:shen.dict-count V2290) (vector-ref V2290 2)) (export shen.dict-count) (quote shen.dict-count)) +(begin (register-function-arity (quote shen.dict-count->) 2) (define (kl:shen.dict-count-> V2293 V2294) (let ((_tmp V2293)) (vector-set! _tmp 2 V2294) _tmp)) (export shen.dict-count->) (quote shen.dict-count->)) +(begin (register-function-arity (quote shen.<-dict-bucket) 2) (define (kl:shen.<-dict-bucket V2297 V2298) (vector-ref V2297 (+ 3 V2298))) (export shen.<-dict-bucket) (quote shen.<-dict-bucket)) +(begin (register-function-arity (quote shen.dict-bucket->) 3) (define (kl:shen.dict-bucket-> V2302 V2303 V2304) (let ((_tmp V2302)) (vector-set! _tmp (+ 3 V2303) V2304) _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 V2308 V2309 V2310) (let ((Diff (- (kl:length V2310) (kl:length V2309)))) (kl:shen.dict-count-> V2308 (+ Diff (kl:shen.dict-count V2308))))) (export shen.dict-update-count) (quote shen.dict-update-count)) +(begin (register-function-arity (quote shen.dict->) 3) (define (kl:shen.dict-> V2314 V2315 V2316) (let ((N (kl:hash V2315 (kl:shen.dict-capacity V2314)))) (let ((Bucket (kl:shen.<-dict-bucket V2314 N))) (let ((NewBucket (kl:shen.assoc-set V2315 V2316 Bucket))) (let ((Change (kl:shen.dict-bucket-> V2314 N NewBucket))) (let ((Count (kl:shen.dict-update-count V2314 Bucket NewBucket))) V2316)))))) (export shen.dict->) (quote shen.dict->)) +(begin (register-function-arity (quote shen.<-dict) 2) (define (kl:shen.<-dict V2319 V2320) (let ((N (kl:hash V2320 (kl:shen.dict-capacity V2319)))) (let ((Bucket (kl:shen.<-dict-bucket V2319 N))) (let ((Result (kl:assoc V2320 Bucket))) (if (kl:empty? Result) (simple-error (string-append "value " (kl:shen.app V2320 " 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 V2323 V2324) (let ((N (kl:hash V2324 (kl:shen.dict-capacity V2323)))) (let ((Bucket (kl:shen.<-dict-bucket V2323 N))) (let ((NewBucket (kl:shen.assoc-rm V2324 Bucket))) (let ((Change (kl:shen.dict-bucket-> V2323 N NewBucket))) (let ((Count (kl:shen.dict-update-count V2323 Bucket NewBucket))) V2324)))))) (export shen.dict-rm) (quote shen.dict-rm)) +(begin (register-function-arity (quote shen.dict-fold) 3) (define (kl:shen.dict-fold V2328 V2329 V2330) (let ((Limit (kl:shen.dict-capacity V2329))) (kl:shen.dict-fold-h V2328 V2329 V2330 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 V2337 V2338 V2339 V2340 V2341) (cond ((kl:= V2341 V2340) V2339) (#t (let ((B (kl:shen.<-dict-bucket V2338 V2340))) (let ((Acc (kl:shen.bucket-fold V2337 B V2339))) (kl:shen.dict-fold-h V2337 V2338 Acc (+ 1 V2340) V2341)))))) (export shen.dict-fold-h) (quote shen.dict-fold-h)) +(begin (register-function-arity (quote shen.bucket-fold) 3) (define (kl:shen.bucket-fold V2345 V2346 V2347) (cond ((null? V2346) V2347) ((and (pair? V2346) (pair? (car V2346))) (((V2345 (car (car V2346))) (cdr (car V2346))) (kl:shen.bucket-fold V2345 (cdr V2346) V2347))) (#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 V2349) (kl:shen.dict-fold (lambda (K) (lambda (_) (lambda (Acc) (cons K Acc)))) V2349 (quote ()))) (export shen.dict-keys) (quote shen.dict-keys)) +(begin (register-function-arity (quote shen.dict-values) 1) (define (kl:shen.dict-values V2351) (kl:shen.dict-fold (lambda (_) (lambda (V) (lambda (Acc) (cons V Acc)))) V2351 (quote ()))) (export shen.dict-values) (quote shen.dict-values)) diff --git a/compiled/extension-factorise-defun.kl.ms b/compiled/extension-factorise-defun.kl.ms new file mode 100644 index 0000000..53bba41 --- /dev/null +++ b/compiled/extension-factorise-defun.kl.ms @@ -0,0 +1,27 @@ +(module "compiled/extension-factorise-defun.kl") +"Copyright (c) 2012-2019 Bruno Deferrari. All rights reserved.\nBSD 3-Clause License: http://opensource.org/licenses/BSD-3-Clause" +(begin (register-function-arity (quote shen.x.factorise-defun.factorise-defun) 1) (define (kl:shen.x.factorise-defun.factorise-defun V4873) (cond ((and (pair? V4873) (and (eq? (quote defun) (car V4873)) (and (pair? (cdr V4873)) (and (pair? (cdr (cdr V4873))) (and (pair? (cdr (cdr (cdr V4873)))) (and (pair? (car (cdr (cdr (cdr V4873))))) (and (eq? (quote cond) (car (car (cdr (cdr (cdr V4873)))))) (null? (cdr (cdr (cdr (cdr V4873)))))))))))) (cons (quote defun) (cons (car (cdr V4873)) (cons (car (cdr (cdr V4873))) (cons (kl:shen.x.factorise-defun.factorise-cond (car (cdr (cdr (cdr V4873)))) (cons (quote shen.f_error) (cons (car (cdr V4873)) (quote ()))) (car (cdr (cdr V4873)))) (quote ())))))) (#t V4873))) (export shen.x.factorise-defun.factorise-defun) (quote shen.x.factorise-defun.factorise-defun)) +(begin (register-function-arity (quote shen.x.factorise-defun.factorise-cond) 3) (define (kl:shen.x.factorise-defun.factorise-cond V4885 V4886 V4887) (cond ((and (pair? V4885) (eq? (quote cond) (car V4885))) (kl:shen.x.factorise-defun.inline-mono-labels (kl:shen.x.factorise-defun.rebranch (kl:shen.x.factorise-defun.add-returns (cdr V4885)) V4886) V4887)) (#t V4885))) (export shen.x.factorise-defun.factorise-cond) (quote shen.x.factorise-defun.factorise-cond)) +(begin (register-function-arity (quote shen.x.factorise-defun.add-returns) 1) (define (kl:shen.x.factorise-defun.add-returns V4889) (cond ((null? V4889) (quote ())) ((and (pair? V4889) (and (pair? (car V4889)) (and (pair? (cdr (car V4889))) (null? (cdr (cdr (car V4889))))))) (cons (cons (car (car V4889)) (cons (cons (quote %%return) (cdr (car V4889))) (quote ()))) (kl:shen.x.factorise-defun.add-returns (cdr V4889)))) (#t (kl:shen.f_error (quote shen.x.factorise-defun.add-returns))))) (export shen.x.factorise-defun.add-returns) (quote shen.x.factorise-defun.add-returns)) +(begin (register-function-arity (quote shen.x.factorise-defun.generate-label) 0) (define (kl:shen.x.factorise-defun.generate-label) (kl:gensym (quote %%label))) (export shen.x.factorise-defun.generate-label) (quote shen.x.factorise-defun.generate-label)) +(begin (register-function-arity (quote shen.x.factorise-defun.free-variables) 2) (define (kl:shen.x.factorise-defun.free-variables V4892 V4893) (kl:reverse (kl:shen.x.factorise-defun.free-variables-h V4892 V4893 (quote ())))) (export shen.x.factorise-defun.free-variables) (quote shen.x.factorise-defun.free-variables)) +(begin (register-function-arity (quote shen.x.factorise-defun.free-variables-h) 3) (define (kl:shen.x.factorise-defun.free-variables-h V4905 V4906 V4907) (cond ((and (pair? V4905) (and (eq? (quote let) (car V4905)) (and (pair? (cdr V4905)) (and (pair? (cdr (cdr V4905))) (and (pair? (cdr (cdr (cdr V4905)))) (null? (cdr (cdr (cdr (cdr V4905)))))))))) (kl:shen.x.factorise-defun.free-variables-h (car (cdr (cdr (cdr V4905)))) (kl:remove (car (cdr V4905)) V4906) (kl:shen.x.factorise-defun.free-variables-h (car (cdr (cdr V4905))) V4906 V4907))) ((and (pair? V4905) (and (eq? (quote lambda) (car V4905)) (and (pair? (cdr V4905)) (and (pair? (cdr (cdr V4905))) (null? (cdr (cdr (cdr V4905)))))))) (kl:shen.x.factorise-defun.free-variables-h (car (cdr (cdr V4905))) (kl:remove (car (cdr V4905)) V4906) V4907)) ((pair? V4905) (kl:shen.x.factorise-defun.free-variables-h (cdr V4905) V4906 (kl:shen.x.factorise-defun.free-variables-h (car V4905) V4906 V4907))) ((kl:element? V4905 V4906) (kl:adjoin V4905 V4907)) (#t V4907))) (export shen.x.factorise-defun.free-variables-h) (quote shen.x.factorise-defun.free-variables-h)) +(begin (register-function-arity (quote shen.x.factorise-defun.attach-free-variables) 2) (define (kl:shen.x.factorise-defun.attach-free-variables V4910 V4911) (cond ((and (pair? V4910) (and (eq? (quote %%let-label) (car V4910)) (and (pair? (cdr V4910)) (and (pair? (cdr (cdr V4910))) (and (pair? (cdr (cdr (cdr V4910)))) (null? (cdr (cdr (cdr (cdr V4910)))))))))) (let ((FreeVars (kl:shen.x.factorise-defun.free-variables (car (cdr (cdr V4910))) V4911))) (let ((NewBody (if (null? FreeVars) (car (cdr (cdr (cdr V4910)))) (kl:subst (cons (quote %%goto-label) (cons (car (cdr V4910)) FreeVars)) (cons (quote %%goto-label) (cons (car (cdr V4910)) (quote ()))) (car (cdr (cdr (cdr V4910)))))))) (cons (quote %%let-label) (cons (cons (car (cdr V4910)) FreeVars) (cons (car (cdr (cdr V4910))) (cons (kl:shen.x.factorise-defun.inline-mono-labels NewBody V4911) (quote ())))))))) (#t (kl:shen.f_error (quote shen.x.factorise-defun.attach-free-variables))))) (export shen.x.factorise-defun.attach-free-variables) (quote shen.x.factorise-defun.attach-free-variables)) +(begin (register-function-arity (quote shen.x.factorise-defun.inline-mono-labels) 2) (define (kl:shen.x.factorise-defun.inline-mono-labels V4918 V4919) (cond ((and (pair? V4918) (and (eq? (quote %%let-label) (car V4918)) (and (pair? (cdr V4918)) (and (pair? (cdr (cdr V4918))) (and (pair? (cdr (cdr (cdr V4918)))) (and (null? (cdr (cdr (cdr (cdr V4918))))) (> (kl:occurrences (cons (quote %%goto-label) (cons (car (cdr V4918)) (quote ()))) (car (cdr (cdr (cdr V4918))))) 1))))))) (kl:shen.x.factorise-defun.attach-free-variables (cons (quote %%let-label) (cons (car (cdr V4918)) (cons (kl:shen.x.factorise-defun.inline-mono-labels (car (cdr (cdr V4918))) V4919) (cdr (cdr (cdr V4918)))))) V4919)) ((and (pair? V4918) (and (eq? (quote %%let-label) (car V4918)) (and (pair? (cdr V4918)) (and (pair? (cdr (cdr V4918))) (and (pair? (cdr (cdr (cdr V4918)))) (null? (cdr (cdr (cdr (cdr V4918)))))))))) (kl:subst (kl:shen.x.factorise-defun.inline-mono-labels (car (cdr (cdr V4918))) V4919) (cons (quote %%goto-label) (cons (car (cdr V4918)) (quote ()))) (kl:shen.x.factorise-defun.inline-mono-labels (car (cdr (cdr (cdr V4918)))) V4919))) ((and (pair? V4918) (and (eq? (quote if) (car V4918)) (and (pair? (cdr V4918)) (and (pair? (cdr (cdr V4918))) (and (pair? (cdr (cdr (cdr V4918)))) (null? (cdr (cdr (cdr (cdr V4918)))))))))) (cons (quote if) (cons (car (cdr V4918)) (cons (kl:shen.x.factorise-defun.inline-mono-labels (car (cdr (cdr V4918))) V4919) (cons (kl:shen.x.factorise-defun.inline-mono-labels (car (cdr (cdr (cdr V4918)))) V4919) (quote ())))))) ((and (pair? V4918) (and (eq? (quote let) (car V4918)) (and (pair? (cdr V4918)) (and (pair? (cdr (cdr V4918))) (and (pair? (cdr (cdr (cdr V4918)))) (null? (cdr (cdr (cdr (cdr V4918)))))))))) (cons (quote let) (cons (car (cdr V4918)) (cons (car (cdr (cdr V4918))) (cons (kl:shen.x.factorise-defun.inline-mono-labels (car (cdr (cdr (cdr V4918)))) (cons (car (cdr V4918)) V4919)) (quote ())))))) (#t V4918))) (export shen.x.factorise-defun.inline-mono-labels) (quote shen.x.factorise-defun.inline-mono-labels)) +(begin (register-function-arity (quote shen.x.factorise-defun.rebranch) 2) (define (kl:shen.x.factorise-defun.rebranch V4926 V4927) (cond ((null? V4926) V4927) ((and (pair? V4926) (and (pair? (car V4926)) (and (kl:= #t (car (car V4926))) (and (pair? (cdr (car V4926))) (null? (cdr (cdr (car V4926)))))))) (car (cdr (car V4926)))) ((and (pair? V4926) (and (pair? (car V4926)) (and (pair? (car (car V4926))) (and (eq? (quote and) (car (car (car V4926)))) (and (pair? (cdr (car (car V4926)))) (and (pair? (cdr (cdr (car (car V4926))))) (and (null? (cdr (cdr (cdr (car (car V4926)))))) (and (pair? (cdr (car V4926))) (null? (cdr (cdr (car V4926)))))))))))) (let ((TrueBranch (kl:shen.x.factorise-defun.true-branch (car (cdr (car (car V4926)))) V4926))) (let ((FalseBranch (kl:shen.x.factorise-defun.false-branch (car (cdr (car (car V4926)))) V4926))) (kl:shen.x.factorise-defun.rebranch-h (car (cdr (car (car V4926)))) TrueBranch FalseBranch V4927)))) ((and (pair? V4926) (and (pair? (car V4926)) (and (pair? (cdr (car V4926))) (null? (cdr (cdr (car V4926))))))) (let ((TrueBranch (kl:shen.x.factorise-defun.true-branch (car (car V4926)) V4926))) (let ((FalseBranch (kl:shen.x.factorise-defun.false-branch (car (car V4926)) V4926))) (kl:shen.x.factorise-defun.rebranch-h (car (car V4926)) TrueBranch FalseBranch V4927)))) (#t (kl:shen.f_error (quote shen.x.factorise-defun.rebranch))))) (export shen.x.factorise-defun.rebranch) (quote shen.x.factorise-defun.rebranch)) +(begin (register-function-arity (quote shen.x.factorise-defun.rebranch-h) 4) (define (kl:shen.x.factorise-defun.rebranch-h V4932 V4933 V4934 V4935) (let ((NewElse (kl:shen.x.factorise-defun.rebranch V4934 V4935))) (kl:shen.x.factorise-defun.with-labelled-else NewElse (lambda (GotoElse) (kl:shen.x.factorise-defun.merge-same-else-ifs (cons (quote if) (cons V4932 (cons (kl:shen.x.factorise-defun.optimize-selectors V4932 (kl:shen.x.factorise-defun.rebranch V4933 GotoElse)) (cons GotoElse (quote ())))))))))) (export shen.x.factorise-defun.rebranch-h) (quote shen.x.factorise-defun.rebranch-h)) +(begin (register-function-arity (quote shen.x.factorise-defun.true-branch) 2) (define (kl:shen.x.factorise-defun.true-branch V4948 V4949) (cond ((and (pair? V4949) (and (pair? (car V4949)) (and (pair? (car (car V4949))) (and (eq? (quote and) (car (car (car V4949)))) (and (pair? (cdr (car (car V4949)))) (and (pair? (cdr (cdr (car (car V4949))))) (and (null? (cdr (cdr (cdr (car (car V4949)))))) (and (pair? (cdr (car V4949))) (and (null? (cdr (cdr (car V4949)))) (kl:= (car (cdr (car (car V4949)))) V4948)))))))))) (cons (cons (car (cdr (cdr (car (car V4949))))) (cdr (car V4949))) (kl:shen.x.factorise-defun.true-branch (car (cdr (car (car V4949)))) (cdr V4949)))) ((and (pair? V4949) (and (pair? (car V4949)) (and (pair? (cdr (car V4949))) (and (null? (cdr (cdr (car V4949)))) (kl:= (car (car V4949)) V4948))))) (cons (cons #t (cdr (car V4949))) (quote ()))) (#t (quote ())))) (export shen.x.factorise-defun.true-branch) (quote shen.x.factorise-defun.true-branch)) +(begin (register-function-arity (quote shen.x.factorise-defun.false-branch) 2) (define (kl:shen.x.factorise-defun.false-branch V4958 V4959) (cond ((and (pair? V4959) (and (pair? (car V4959)) (and (pair? (car (car V4959))) (and (eq? (quote and) (car (car (car V4959)))) (and (pair? (cdr (car (car V4959)))) (and (pair? (cdr (cdr (car (car V4959))))) (and (null? (cdr (cdr (cdr (car (car V4959)))))) (and (pair? (cdr (car V4959))) (and (null? (cdr (cdr (car V4959)))) (kl:= (car (cdr (car (car V4959)))) V4958)))))))))) (kl:shen.x.factorise-defun.false-branch (car (cdr (car (car V4959)))) (cdr V4959))) ((and (pair? V4959) (and (pair? (car V4959)) (and (pair? (cdr (car V4959))) (and (null? (cdr (cdr (car V4959)))) (kl:= (car (car V4959)) V4958))))) (kl:shen.x.factorise-defun.false-branch (car (car V4959)) (cdr V4959))) (#t V4959))) (export shen.x.factorise-defun.false-branch) (quote shen.x.factorise-defun.false-branch)) +(begin (register-function-arity (quote shen.x.factorise-defun.with-labelled-else) 2) (define (kl:shen.x.factorise-defun.with-labelled-else V4962 V4963) (cond ((and (pair? V4962) (and (eq? (quote %%return) (car V4962)) (and (pair? (cdr V4962)) (and (null? (cdr (cdr V4962))) (kl:not (pair? (car (cdr V4962)))))))) (V4963 V4962)) ((and (pair? V4962) (and (eq? (quote fail) (car V4962)) (null? (cdr V4962)))) (V4963 V4962)) ((and (pair? V4962) (and (eq? (quote %%goto-label) (car V4962)) (and (pair? (cdr V4962)) (null? (cdr (cdr V4962)))))) (V4963 V4962)) (#t (let ((Label (kl:shen.x.factorise-defun.generate-label))) (cons (quote %%let-label) (cons Label (cons V4962 (cons (V4963 (cons (quote %%goto-label) (cons Label (quote ())))) (quote ()))))))))) (export shen.x.factorise-defun.with-labelled-else) (quote shen.x.factorise-defun.with-labelled-else)) +(begin (register-function-arity (quote shen.x.factorise-defun.merge-same-else-ifs) 1) (define (kl:shen.x.factorise-defun.merge-same-else-ifs V4966) (cond ((and (pair? V4966) (and (eq? (quote if) (car V4966)) (and (pair? (cdr V4966)) (and (pair? (cdr (cdr V4966))) (and (pair? (car (cdr (cdr V4966)))) (and (eq? (quote if) (car (car (cdr (cdr V4966))))) (and (pair? (cdr (car (cdr (cdr V4966))))) (and (pair? (cdr (cdr (car (cdr (cdr V4966)))))) (and (pair? (cdr (cdr (cdr (car (cdr (cdr V4966))))))) (and (null? (cdr (cdr (cdr (cdr (car (cdr (cdr V4966)))))))) (and (pair? (cdr (cdr (cdr V4966)))) (and (null? (cdr (cdr (cdr (cdr V4966))))) (kl:= (car (cdr (cdr (cdr V4966)))) (car (cdr (cdr (cdr (car (cdr (cdr V4966)))))))))))))))))))) (cons (quote if) (cons (cons (quote and) (cons (car (cdr V4966)) (cons (car (cdr (car (cdr (cdr V4966))))) (quote ())))) (cons (car (cdr (cdr (car (cdr (cdr V4966)))))) (cdr (cdr (cdr V4966))))))) (#t V4966))) (export shen.x.factorise-defun.merge-same-else-ifs) (quote shen.x.factorise-defun.merge-same-else-ifs)) +(begin (register-function-arity (quote shen.x.factorise-defun.concat/) 2) (define (kl:shen.x.factorise-defun.concat/ V4969 V4970) (kl:concat V4969 (kl:concat (quote /) V4970))) (export shen.x.factorise-defun.concat/) (quote shen.x.factorise-defun.concat/)) +(begin (register-function-arity (quote shen.x.factorise-defun.exp-var) 1) (define (kl:shen.x.factorise-defun.exp-var V4974) (cond ((and (pair? V4974) (and (pair? (cdr V4974)) (and (null? (cdr (cdr V4974))) (kl:symbol? (car V4974))))) (kl:shen.x.factorise-defun.concat/ (kl:shen.x.factorise-defun.exp-var (car (cdr V4974))) (car V4974))) ((pair? V4974) (kl:gensym (car V4974))) (#t V4974))) (export shen.x.factorise-defun.exp-var) (quote shen.x.factorise-defun.exp-var)) +(begin (register-function-arity (quote shen.x.factorise-defun.optimize-selectors) 2) (define (kl:shen.x.factorise-defun.optimize-selectors V4977 V4978) (kl:shen.x.factorise-defun.bind-repeating-selectors (kl:shen.x.factorise-defun.test->selectors V4977) V4978)) (export shen.x.factorise-defun.optimize-selectors) (quote shen.x.factorise-defun.optimize-selectors)) +(begin (register-function-arity (quote shen.x.factorise-defun.test->selectors) 1) (define (kl:shen.x.factorise-defun.test->selectors V4984) (cond ((and (pair? V4984) (and (eq? (quote cons?) (car V4984)) (and (pair? (cdr V4984)) (null? (cdr (cdr V4984)))))) (cons (cons (quote hd) (cdr V4984)) (cons (cons (quote tl) (cdr V4984)) (quote ())))) ((and (pair? V4984) (and (eq? (quote tuple?) (car V4984)) (and (pair? (cdr V4984)) (null? (cdr (cdr V4984)))))) (cons (cons (quote fst) (cdr V4984)) (cons (cons (quote snd) (cdr V4984)) (quote ())))) ((and (pair? V4984) (and (eq? (quote shen.+string?) (car V4984)) (and (pair? (cdr V4984)) (null? (cdr (cdr V4984)))))) (cons (cons (quote hdstr) (cdr V4984)) (cons (cons (quote tlstr) (cdr V4984)) (quote ())))) ((and (pair? V4984) (and (eq? (quote shen.+vector?) (car V4984)) (and (pair? (cdr V4984)) (null? (cdr (cdr V4984)))))) (cons (cons (quote hdv) (cdr V4984)) (cons (cons (quote tlv) (cdr V4984)) (quote ())))) (#t (let ((Result (kl:shen.x.factorise-defun.apply-selector-handlers (kl:value (quote shen.x.factorise-defun.*selector-handlers*)) V4984))) (if (kl:= Result (kl:fail)) (quote ()) Result))))) (export shen.x.factorise-defun.test->selectors) (quote shen.x.factorise-defun.test->selectors)) +(begin (register-function-arity (quote shen.x.factorise-defun.bind-repeating-selectors) 2) (define (kl:shen.x.factorise-defun.bind-repeating-selectors V4987 V4988) (cond ((pair? V4987) (kl:shen.x.factorise-defun.bind-selector (car V4987) (kl:shen.x.factorise-defun.bind-repeating-selectors (cdr V4987) V4988))) ((null? V4987) V4988) (#t (kl:shen.f_error (quote shen.x.factorise-defun.bind-repeating-selectors))))) (export shen.x.factorise-defun.bind-repeating-selectors) (quote shen.x.factorise-defun.bind-repeating-selectors)) +(begin (register-function-arity (quote shen.x.factorise-defun.bind-selector) 2) (define (kl:shen.x.factorise-defun.bind-selector V4995 V4996) (cond ((> (kl:occurrences V4995 V4996) 1) (let ((Var (kl:shen.x.factorise-defun.exp-var V4995))) (cons (quote let) (cons Var (cons V4995 (cons (kl:subst Var V4995 V4996) (quote ()))))))) (#t V4996))) (export shen.x.factorise-defun.bind-selector) (quote shen.x.factorise-defun.bind-selector)) +(begin (register-function-arity (quote shen.x.factorise-defun.apply-selector-handlers) 2) (define (kl:shen.x.factorise-defun.apply-selector-handlers V5009 V5010) (cond ((null? V5009) (kl:fail)) (#t (let ((Freeze (lambda () (cond ((pair? V5009) (kl:shen.x.factorise-defun.apply-selector-handlers (cdr V5009) V5010)) (#t (kl:shen.f_error (quote shen.x.factorise-defun.apply-selector-handlers))))))) (if (pair? V5009) (let ((Result ((car V5009) V5010))) (if (kl:= Result (kl:fail)) (kl:thaw Freeze) Result)) (kl:thaw Freeze)))))) (export shen.x.factorise-defun.apply-selector-handlers) (quote shen.x.factorise-defun.apply-selector-handlers)) +(begin (register-function-arity (quote shen.x.factorise-defun.initialise) 0) (define (kl:shen.x.factorise-defun.initialise) (begin (kl:set (quote shen.x.factorise-defun.*selector-handlers*) (quote ())) (begin (kl:set (quote shen.x.factorise-defun.*selector-handlers-reg*) (quote ())) (quote shen.x.factorise-defun.done)))) (export shen.x.factorise-defun.initialise) (quote shen.x.factorise-defun.initialise)) +(begin (register-function-arity (quote shen.x.factorise-defun.register-selector-handler) 1) (define (kl:shen.x.factorise-defun.register-selector-handler V5012) (cond ((kl:element? V5012 (kl:value (quote shen.x.factorise-defun.*selector-handlers*))) V5012) (#t (begin (kl:set (quote shen.x.factorise-defun.*selector-handlers-reg*) (cons V5012 (kl:value (quote shen.x.factorise-defun.*selector-handlers*)))) (begin (kl:set (quote shen.x.factorise-defun.*selector-handlers*) (cons (kl:function V5012) (kl:value (quote shen.x.factorise-defun.*selector-handlers*)))) V5012))))) (export shen.x.factorise-defun.register-selector-handler) (quote shen.x.factorise-defun.register-selector-handler)) +(begin (register-function-arity (quote shen.x.factorise-defun.findpos) 2) (define (kl:shen.x.factorise-defun.findpos V5015 V5016) (guard (lambda (_) (simple-error (kl:shen.app V5015 " is not a selector handler\n" (quote shen.a)))) (kl:shen.findpos V5015 V5016))) (export shen.x.factorise-defun.findpos) (quote shen.x.factorise-defun.findpos)) +(begin (register-function-arity (quote shen.x.factorise-defun.unregister-selector-handler) 1) (define (kl:shen.x.factorise-defun.unregister-selector-handler V5018) (let ((Reg (kl:value (quote shen.x.factorise-defun.*selector-handlers-reg*)))) (let ((Pos (kl:shen.x.factorise-defun.findpos V5018 Reg))) (let ((RemoveReg (kl:set (quote shen.x.factorise-defun.*selector-handlers-reg*) (kl:remove V5018 Reg)))) (let ((RemoveFun (kl:set (quote shen.x.factorise-defun.*selector-handlers*) (kl:shen.remove-nth Pos (kl:value (quote shen.x.factorise-defun.*selector-handlers*)))))) V5018))))) (export shen.x.factorise-defun.unregister-selector-handler) (quote shen.x.factorise-defun.unregister-selector-handler)) diff --git a/compiled/extension-features.kl.ms b/compiled/extension-features.kl.ms index 0af62a9..1455335 100644 --- a/compiled/extension-features.kl.ms +++ b/compiled/extension-features.kl.ms @@ -1,6 +1,6 @@ (module "compiled/extension-features.kl") "Copyright (c) 2019 Bruno Deferrari.\nBSD 3-Clause License: http://opensource.org/licenses/BSD-3-Clause" -(begin (register-function-arity (quote shen.x.features.cond-expand-macro) 1) (define (kl:shen.x.features.cond-expand-macro V5988) (cond ((and (pair? V5988) (and (eq? (quote shen.x.features.cond-expand) (car V5988)) (null? (cdr V5988)))) (simple-error "Unfulfilled shen.x.features.cond-expand clause.")) ((and (pair? V5988) (and (eq? (quote shen.x.features.cond-expand) (car V5988)) (and (pair? (cdr V5988)) (and (kl:= #t (car (cdr V5988))) (and (pair? (cdr (cdr V5988))) (null? (cdr (cdr (cdr V5988))))))))) (car (cdr (cdr V5988)))) ((and (pair? V5988) (and (eq? (quote shen.x.features.cond-expand) (car V5988)) (and (pair? (cdr V5988)) (and (pair? (car (cdr V5988))) (and (eq? (quote and) (car (car (cdr V5988)))) (and (null? (cdr (car (cdr V5988)))) (pair? (cdr (cdr V5988))))))))) (car (cdr (cdr V5988)))) ((and (pair? V5988) (and (eq? (quote shen.x.features.cond-expand) (car V5988)) (and (pair? (cdr V5988)) (and (pair? (car (cdr V5988))) (and (eq? (quote and) (car (car (cdr V5988)))) (and (pair? (cdr (car (cdr V5988)))) (pair? (cdr (cdr V5988))))))))) (cons (quote shen.x.features.cond-expand) (cons (car (cdr (car (cdr V5988)))) (cons (cons (quote shen.x.features.cond-expand) (cons (cons (quote and) (cdr (cdr (car (cdr V5988))))) (cdr (cdr V5988)))) (cdr (cdr (cdr V5988))))))) ((and (pair? V5988) (and (eq? (quote shen.x.features.cond-expand) (car V5988)) (and (pair? (cdr V5988)) (and (pair? (car (cdr V5988))) (and (eq? (quote or) (car (car (cdr V5988)))) (and (null? (cdr (car (cdr V5988)))) (pair? (cdr (cdr V5988))))))))) (cons (quote shen.x.features.cond-expand) (cdr (cdr (cdr V5988))))) ((and (pair? V5988) (and (eq? (quote shen.x.features.cond-expand) (car V5988)) (and (pair? (cdr V5988)) (and (pair? (car (cdr V5988))) (and (eq? (quote or) (car (car (cdr V5988)))) (and (pair? (cdr (car (cdr V5988)))) (pair? (cdr (cdr V5988))))))))) (cons (quote shen.x.features.cond-expand) (cons (car (cdr (car (cdr V5988)))) (cons (car (cdr (cdr V5988))) (cons #t (cons (cons (quote shen.x.features.cond-expand) (cons (cons (quote or) (cdr (cdr (car (cdr V5988))))) (cdr (cdr V5988)))) (quote ()))))))) ((and (pair? V5988) (and (eq? (quote shen.x.features.cond-expand) (car V5988)) (and (pair? (cdr V5988)) (and (pair? (car (cdr V5988))) (and (eq? (quote not) (car (car (cdr V5988)))) (and (pair? (cdr (car (cdr V5988)))) (and (null? (cdr (cdr (car (cdr V5988))))) (pair? (cdr (cdr V5988)))))))))) (cons (quote shen.x.features.cond-expand) (cons (car (cdr (car (cdr V5988)))) (cons (cons (quote shen.x.features.cond-expand) (cdr (cdr (cdr V5988)))) (cons #t (cons (car (cdr (cdr V5988))) (quote ()))))))) ((and (pair? V5988) (and (eq? (quote shen.x.features.cond-expand) (car V5988)) (and (pair? (cdr V5988)) (and (pair? (cdr (cdr V5988))) (kl:element? (car (cdr V5988)) (kl:value (quote shen.x.features.*features*))))))) (car (cdr (cdr V5988)))) ((and (pair? V5988) (and (eq? (quote shen.x.features.cond-expand) (car V5988)) (and (pair? (cdr V5988)) (pair? (cdr (cdr V5988)))))) (cons (quote shen.x.features.cond-expand) (cdr (cdr (cdr V5988))))) (#t V5988))) (export shen.x.features.cond-expand-macro) (quote shen.x.features.cond-expand-macro)) +(begin (register-function-arity (quote shen.x.features.cond-expand-macro) 1) (define (kl:shen.x.features.cond-expand-macro V4827) (cond ((and (pair? V4827) (and (eq? (quote shen.x.features.cond-expand) (car V4827)) (null? (cdr V4827)))) (simple-error "Unfulfilled shen.x.features.cond-expand clause.")) ((and (pair? V4827) (and (eq? (quote shen.x.features.cond-expand) (car V4827)) (and (pair? (cdr V4827)) (and (kl:= #t (car (cdr V4827))) (and (pair? (cdr (cdr V4827))) (null? (cdr (cdr (cdr V4827))))))))) (car (cdr (cdr V4827)))) ((and (pair? V4827) (and (eq? (quote shen.x.features.cond-expand) (car V4827)) (and (pair? (cdr V4827)) (and (pair? (car (cdr V4827))) (and (eq? (quote and) (car (car (cdr V4827)))) (and (null? (cdr (car (cdr V4827)))) (pair? (cdr (cdr V4827))))))))) (car (cdr (cdr V4827)))) ((and (pair? V4827) (and (eq? (quote shen.x.features.cond-expand) (car V4827)) (and (pair? (cdr V4827)) (and (pair? (car (cdr V4827))) (and (eq? (quote and) (car (car (cdr V4827)))) (and (pair? (cdr (car (cdr V4827)))) (pair? (cdr (cdr V4827))))))))) (cons (quote shen.x.features.cond-expand) (cons (car (cdr (car (cdr V4827)))) (cons (cons (quote shen.x.features.cond-expand) (cons (cons (quote and) (cdr (cdr (car (cdr V4827))))) (cdr (cdr V4827)))) (cdr (cdr (cdr V4827))))))) ((and (pair? V4827) (and (eq? (quote shen.x.features.cond-expand) (car V4827)) (and (pair? (cdr V4827)) (and (pair? (car (cdr V4827))) (and (eq? (quote or) (car (car (cdr V4827)))) (and (null? (cdr (car (cdr V4827)))) (pair? (cdr (cdr V4827))))))))) (cons (quote shen.x.features.cond-expand) (cdr (cdr (cdr V4827))))) ((and (pair? V4827) (and (eq? (quote shen.x.features.cond-expand) (car V4827)) (and (pair? (cdr V4827)) (and (pair? (car (cdr V4827))) (and (eq? (quote or) (car (car (cdr V4827)))) (and (pair? (cdr (car (cdr V4827)))) (pair? (cdr (cdr V4827))))))))) (cons (quote shen.x.features.cond-expand) (cons (car (cdr (car (cdr V4827)))) (cons (car (cdr (cdr V4827))) (cons #t (cons (cons (quote shen.x.features.cond-expand) (cons (cons (quote or) (cdr (cdr (car (cdr V4827))))) (cdr (cdr V4827)))) (quote ()))))))) ((and (pair? V4827) (and (eq? (quote shen.x.features.cond-expand) (car V4827)) (and (pair? (cdr V4827)) (and (pair? (car (cdr V4827))) (and (eq? (quote not) (car (car (cdr V4827)))) (and (pair? (cdr (car (cdr V4827)))) (and (null? (cdr (cdr (car (cdr V4827))))) (pair? (cdr (cdr V4827)))))))))) (cons (quote shen.x.features.cond-expand) (cons (car (cdr (car (cdr V4827)))) (cons (cons (quote shen.x.features.cond-expand) (cdr (cdr (cdr V4827)))) (cons #t (cons (car (cdr (cdr V4827))) (quote ()))))))) ((and (pair? V4827) (and (eq? (quote shen.x.features.cond-expand) (car V4827)) (and (pair? (cdr V4827)) (and (pair? (cdr (cdr V4827))) (kl:element? (car (cdr V4827)) (kl:value (quote shen.x.features.*features*))))))) (car (cdr (cdr V4827)))) ((and (pair? V4827) (and (eq? (quote shen.x.features.cond-expand) (car V4827)) (and (pair? (cdr V4827)) (pair? (cdr (cdr V4827)))))) (cons (quote shen.x.features.cond-expand) (cdr (cdr (cdr V4827))))) (#t V4827))) (export shen.x.features.cond-expand-macro) (quote shen.x.features.cond-expand-macro)) (begin (register-function-arity (quote shen.x.features.current) 0) (define (kl:shen.x.features.current) (kl:value (quote shen.x.features.*features*))) (export shen.x.features.current) (quote shen.x.features.current)) -(begin (register-function-arity (quote shen.x.features.initialise) 1) (define (kl:shen.x.features.initialise V5990) (let ((_ (guard (lambda (E) (begin (kl:set (quote shen.x.features.*features*) (quote ())) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.x.features.cond-expand-macro) (lambda (X) (kl:shen.x.features.cond-expand-macro X)))) (kl:shen.add-macro (quote shen.x.features.cond-expand-macro))))) (kl:value (quote shen.x.features.*features*))))) (let ((Old (kl:shen.x.features.current))) (let ((_ (kl:set (quote shen.x.features.*features*) V5990))) Old)))) (export shen.x.features.initialise) (quote shen.x.features.initialise)) -(begin (register-function-arity (quote shen.x.features.add) 1) (define (kl:shen.x.features.add V5992) (let ((Old (kl:shen.x.features.current))) (let ((_ (kl:set (quote shen.x.features.*features*) (kl:adjoin V5992 Old)))) Old))) (export shen.x.features.add) (quote shen.x.features.add)) +(begin (register-function-arity (quote shen.x.features.initialise) 1) (define (kl:shen.x.features.initialise V4829) (let ((_ (guard (lambda (E) (begin (kl:set (quote shen.x.features.*features*) (quote ())) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.x.features.cond-expand-macro) (lambda (X) (kl:shen.x.features.cond-expand-macro X)))) (kl:shen.add-macro (quote shen.x.features.cond-expand-macro))))) (kl:value (quote shen.x.features.*features*))))) (let ((Old (kl:shen.x.features.current))) (let ((_ (kl:set (quote shen.x.features.*features*) V4829))) Old)))) (export shen.x.features.initialise) (quote shen.x.features.initialise)) +(begin (register-function-arity (quote shen.x.features.add) 1) (define (kl:shen.x.features.add V4831) (let ((Old (kl:shen.x.features.current))) (let ((_ (kl:set (quote shen.x.features.*features*) (kl:adjoin V4831 Old)))) Old))) (export shen.x.features.add) (quote shen.x.features.add)) diff --git a/compiled/extension-launcher.kl.ms b/compiled/extension-launcher.kl.ms index 46a7482..b9c5041 100644 --- a/compiled/extension-launcher.kl.ms +++ b/compiled/extension-launcher.kl.ms @@ -1,14 +1,14 @@ (module "compiled/extension-launcher.kl") "Copyright (c) 2019 Bruno Deferrari.\nBSD 3-Clause License: http://opensource.org/licenses/BSD-3-Clause" -(begin (register-function-arity (quote shen.x.launcher.quiet-load) 1) (define (kl:shen.x.launcher.quiet-load V5994) (let ((Contents (kl:read-file V5994))) (kl:map (lambda (X) (kl:shen.eval-without-macros X)) Contents))) (export shen.x.launcher.quiet-load) (quote shen.x.launcher.quiet-load)) +(begin (register-function-arity (quote shen.x.launcher.quiet-load) 1) (define (kl:shen.x.launcher.quiet-load V4833) (let ((Contents (kl:read-file V4833))) (kl:map (lambda (X) (kl:shen.eval-without-macros X)) Contents))) (export shen.x.launcher.quiet-load) (quote shen.x.launcher.quiet-load)) (begin (register-function-arity (quote shen.x.launcher.version-string) 0) (define (kl:shen.x.launcher.version-string) (kl:shen.app (kl:version) (string-append " " (kl:shen.app (cons (quote port) (cons (cons (kl:language) (cons (kl:port) (quote ()))) (cons (quote implementation) (cons (cons (kl:implementation) (cons (kl:release) (quote ()))) (quote ()))))) "\n" (quote shen.r))) (quote shen.a))) (export shen.x.launcher.version-string) (quote shen.x.launcher.version-string)) -(begin (register-function-arity (quote shen.x.launcher.help-text) 1) (define (kl:shen.x.launcher.help-text V5996) (string-append "Usage: " (kl:shen.app V5996 " [--version] [--help] []\n\ncommands:\n repl\n Launches the interactive REPL.\n Default action if no command is supplied.\n\n script []\n Runs the script in FILE. *argv* is set to [FILE | ARGS].\n\n eval \n Evaluates expressions and files. ARGS are evaluated from\n left to right and can be a combination of:\n -e, --eval \n Evaluates EXPR and prints result.\n -l, --load \n Reads and evaluates FILE.\n -q, --quiet\n Silences interactive output.\n -s, --set \n Evaluates KEY, VALUE and sets as global.\n -r, --repl\n Launches the interactive REPL after evaluating\n all the previous expresions." (quote shen.a)))) (export shen.x.launcher.help-text) (quote shen.x.launcher.help-text)) -(begin (register-function-arity (quote shen.x.launcher.execute-all) 1) (define (kl:shen.x.launcher.execute-all V5998) (cond ((null? V5998) (cons (quote success) (quote ()))) ((pair? V5998) (begin (kl:thaw (car V5998)) (kl:shen.x.launcher.execute-all (cdr V5998)))) (#t (kl:shen.f_error (quote shen.x.launcher.execute-all))))) (export shen.x.launcher.execute-all) (quote shen.x.launcher.execute-all)) -(begin (register-function-arity (quote shen.x.launcher.eval-string) 1) (define (kl:shen.x.launcher.eval-string V6000) (kl:eval (kl:head (kl:read-from-string V6000)))) (export shen.x.launcher.eval-string) (quote shen.x.launcher.eval-string)) -(begin (register-function-arity (quote shen.x.launcher.eval-flag-map) 1) (define (kl:shen.x.launcher.eval-flag-map V6006) (cond ((equal? "-e" V6006) "--eval") ((equal? "-l" V6006) "--load") ((equal? "-q" V6006) "--quiet") ((equal? "-s" V6006) "--set") ((equal? "-r" V6006) "--repl") (#t #f))) (export shen.x.launcher.eval-flag-map) (quote shen.x.launcher.eval-flag-map)) -(begin (register-function-arity (quote shen.x.launcher.eval-command-h) 2) (define (kl:shen.x.launcher.eval-command-h V6017 V6018) (cond ((null? V6017) (kl:shen.x.launcher.execute-all (kl:reverse V6018))) ((and (pair? V6017) (and (equal? "--eval" (car V6017)) (pair? (cdr V6017)))) (kl:shen.x.launcher.eval-command-h (cdr (cdr V6017)) (cons (lambda () (kl:shen.prhush (kl:shen.app (kl:shen.x.launcher.eval-string (car (cdr V6017))) "\n" (quote shen.a)) (kl:stoutput))) V6018))) ((and (pair? V6017) (and (equal? "--load" (car V6017)) (pair? (cdr V6017)))) (kl:shen.x.launcher.eval-command-h (cdr (cdr V6017)) (cons (lambda () (kl:load (car (cdr V6017)))) V6018))) ((and (pair? V6017) (equal? "--quiet" (car V6017))) (kl:shen.x.launcher.eval-command-h (cdr V6017) (cons (lambda () (kl:set (quote *hush*) #t)) V6018))) ((and (pair? V6017) (and (equal? "--set" (car V6017)) (and (pair? (cdr V6017)) (pair? (cdr (cdr V6017)))))) (kl:shen.x.launcher.eval-command-h (cdr (cdr (cdr V6017))) (cons (lambda () (kl:set (kl:shen.x.launcher.eval-string (car (cdr V6017))) (kl:shen.x.launcher.eval-string (car (cdr (cdr V6017)))))) V6018))) ((and (pair? V6017) (equal? "--repl" (car V6017))) (begin (kl:shen.x.launcher.eval-command-h (quote ()) V6018) (cons (quote launch-repl) (cdr V6017)))) (#t (let ((Freeze (lambda () (cond ((pair? V6017) (cons (quote error) (cons (string-append "Invalid eval argument: " (kl:shen.app (car V6017) "" (quote shen.a))) (quote ())))) (#t (kl:shen.f_error (quote shen.x.launcher.eval-command-h))))))) (if (pair? V6017) (let ((Result (let ((Long (kl:shen.x.launcher.eval-flag-map (car V6017)))) (if (kl:= #f Long) (kl:fail) (kl:shen.x.launcher.eval-command-h (cons Long (cdr V6017)) V6018))))) (if (kl:= Result (kl:fail)) (kl:thaw Freeze) Result)) (kl:thaw Freeze)))))) (export shen.x.launcher.eval-command-h) (quote shen.x.launcher.eval-command-h)) -(begin (register-function-arity (quote shen.x.launcher.eval-command) 1) (define (kl:shen.x.launcher.eval-command V6020) (kl:shen.x.launcher.eval-command-h V6020 (quote ()))) (export shen.x.launcher.eval-command) (quote shen.x.launcher.eval-command)) -(begin (register-function-arity (quote shen.x.launcher.script-command) 2) (define (kl:shen.x.launcher.script-command V6023 V6024) (begin (kl:set (quote *argv*) (cons V6023 V6024)) (begin (kl:shen.x.launcher.quiet-load V6023) (cons (quote success) (quote ()))))) (export shen.x.launcher.script-command) (quote shen.x.launcher.script-command)) -(begin (register-function-arity (quote shen.x.launcher.launch-shen) 1) (define (kl:shen.x.launcher.launch-shen V6026) (cond ((and (pair? V6026) (null? (cdr V6026))) (cons (quote launch-repl) (quote ()))) ((and (pair? V6026) (and (pair? (cdr V6026)) (equal? "--help" (car (cdr V6026))))) (cons (quote show-help) (cons (kl:shen.x.launcher.help-text (car V6026)) (quote ())))) ((and (pair? V6026) (and (pair? (cdr V6026)) (equal? "--version" (car (cdr V6026))))) (cons (quote success) (cons (kl:shen.x.launcher.version-string) (quote ())))) ((and (pair? V6026) (and (pair? (cdr V6026)) (equal? "repl" (car (cdr V6026))))) (cons (quote launch-repl) (cdr (cdr V6026)))) ((and (pair? V6026) (and (pair? (cdr V6026)) (and (equal? "script" (car (cdr V6026))) (pair? (cdr (cdr V6026)))))) (kl:shen.x.launcher.script-command (car (cdr (cdr V6026))) (cdr (cdr (cdr V6026))))) ((and (pair? V6026) (and (pair? (cdr V6026)) (equal? "eval" (car (cdr V6026))))) (kl:shen.x.launcher.eval-command (cdr (cdr V6026)))) ((and (pair? V6026) (pair? (cdr V6026))) (cons (quote unknown-arguments) V6026)) (#t (kl:shen.f_error (quote shen.x.launcher.launch-shen))))) (export shen.x.launcher.launch-shen) (quote shen.x.launcher.launch-shen)) -(begin (register-function-arity (quote shen.x.launcher.default-handle-result) 1) (define (kl:shen.x.launcher.default-handle-result V6030) (cond ((and (pair? V6030) (and (eq? (quote success) (car V6030)) (null? (cdr V6030)))) (quote shen.x.launcher.done)) ((and (pair? V6030) (and (eq? (quote success) (car V6030)) (and (pair? (cdr V6030)) (null? (cdr (cdr V6030)))))) (kl:shen.prhush (kl:shen.app (car (cdr V6030)) "\n" (quote shen.a)) (kl:stoutput))) ((and (pair? V6030) (and (eq? (quote error) (car V6030)) (and (pair? (cdr V6030)) (null? (cdr (cdr V6030)))))) (kl:shen.prhush (string-append "ERROR: " (kl:shen.app (car (cdr V6030)) "\n" (quote shen.a))) (kl:stoutput))) ((and (pair? V6030) (eq? (quote launch-repl) (car V6030))) (kl:shen.repl)) ((and (pair? V6030) (and (eq? (quote show-help) (car V6030)) (and (pair? (cdr V6030)) (null? (cdr (cdr V6030)))))) (kl:shen.prhush (kl:shen.app (car (cdr V6030)) "\n" (quote shen.a)) (kl:stoutput))) ((and (pair? V6030) (and (eq? (quote unknown-arguments) (car V6030)) (and (pair? (cdr V6030)) (pair? (cdr (cdr V6030)))))) (kl:shen.prhush (string-append "ERROR: Invalid argument: " (kl:shen.app (car (cdr (cdr V6030))) (string-append "\nTry `" (kl:shen.app (car (cdr V6030)) " --help' for more information.\n" (quote shen.a))) (quote shen.a))) (kl:stoutput))) (#t (kl:shen.f_error (quote shen.x.launcher.default-handle-result))))) (export shen.x.launcher.default-handle-result) (quote shen.x.launcher.default-handle-result)) -(begin (register-function-arity (quote shen.x.launcher.main) 1) (define (kl:shen.x.launcher.main V6032) (kl:shen.x.launcher.default-handle-result (kl:shen.x.launcher.launch-shen V6032))) (export shen.x.launcher.main) (quote shen.x.launcher.main)) +(begin (register-function-arity (quote shen.x.launcher.help-text) 1) (define (kl:shen.x.launcher.help-text V4835) (string-append "Usage: " (kl:shen.app V4835 " [--version] [--help] []\n\ncommands:\n repl\n Launches the interactive REPL.\n Default action if no command is supplied.\n\n script []\n Runs the script in FILE. *argv* is set to [FILE | ARGS].\n\n eval \n Evaluates expressions and files. ARGS are evaluated from\n left to right and can be a combination of:\n -e, --eval \n Evaluates EXPR and prints result.\n -l, --load \n Reads and evaluates FILE.\n -q, --quiet\n Silences interactive output.\n -s, --set \n Evaluates KEY, VALUE and sets as global.\n -r, --repl\n Launches the interactive REPL after evaluating\n all the previous expresions." (quote shen.a)))) (export shen.x.launcher.help-text) (quote shen.x.launcher.help-text)) +(begin (register-function-arity (quote shen.x.launcher.execute-all) 1) (define (kl:shen.x.launcher.execute-all V4837) (cond ((null? V4837) (cons (quote success) (quote ()))) ((pair? V4837) (begin (kl:thaw (car V4837)) (kl:shen.x.launcher.execute-all (cdr V4837)))) (#t (kl:shen.f_error (quote shen.x.launcher.execute-all))))) (export shen.x.launcher.execute-all) (quote shen.x.launcher.execute-all)) +(begin (register-function-arity (quote shen.x.launcher.eval-string) 1) (define (kl:shen.x.launcher.eval-string V4839) (kl:eval (kl:head (kl:read-from-string V4839)))) (export shen.x.launcher.eval-string) (quote shen.x.launcher.eval-string)) +(begin (register-function-arity (quote shen.x.launcher.eval-flag-map) 1) (define (kl:shen.x.launcher.eval-flag-map V4845) (cond ((equal? "-e" V4845) "--eval") ((equal? "-l" V4845) "--load") ((equal? "-q" V4845) "--quiet") ((equal? "-s" V4845) "--set") ((equal? "-r" V4845) "--repl") (#t #f))) (export shen.x.launcher.eval-flag-map) (quote shen.x.launcher.eval-flag-map)) +(begin (register-function-arity (quote shen.x.launcher.eval-command-h) 2) (define (kl:shen.x.launcher.eval-command-h V4856 V4857) (cond ((null? V4856) (kl:shen.x.launcher.execute-all (kl:reverse V4857))) ((and (pair? V4856) (and (equal? "--eval" (car V4856)) (pair? (cdr V4856)))) (kl:shen.x.launcher.eval-command-h (cdr (cdr V4856)) (cons (lambda () (kl:shen.prhush (kl:shen.app (kl:shen.x.launcher.eval-string (car (cdr V4856))) "\n" (quote shen.a)) (kl:stoutput))) V4857))) ((and (pair? V4856) (and (equal? "--load" (car V4856)) (pair? (cdr V4856)))) (kl:shen.x.launcher.eval-command-h (cdr (cdr V4856)) (cons (lambda () (kl:load (car (cdr V4856)))) V4857))) ((and (pair? V4856) (equal? "--quiet" (car V4856))) (kl:shen.x.launcher.eval-command-h (cdr V4856) (cons (lambda () (kl:set (quote *hush*) #t)) V4857))) ((and (pair? V4856) (and (equal? "--set" (car V4856)) (and (pair? (cdr V4856)) (pair? (cdr (cdr V4856)))))) (kl:shen.x.launcher.eval-command-h (cdr (cdr (cdr V4856))) (cons (lambda () (kl:set (kl:shen.x.launcher.eval-string (car (cdr V4856))) (kl:shen.x.launcher.eval-string (car (cdr (cdr V4856)))))) V4857))) ((and (pair? V4856) (equal? "--repl" (car V4856))) (begin (kl:shen.x.launcher.eval-command-h (quote ()) V4857) (cons (quote launch-repl) (cdr V4856)))) (#t (let ((Freeze (lambda () (cond ((pair? V4856) (cons (quote error) (cons (string-append "Invalid eval argument: " (kl:shen.app (car V4856) "" (quote shen.a))) (quote ())))) (#t (kl:shen.f_error (quote shen.x.launcher.eval-command-h))))))) (if (pair? V4856) (let ((Result (let ((Long (kl:shen.x.launcher.eval-flag-map (car V4856)))) (if (kl:= #f Long) (kl:fail) (kl:shen.x.launcher.eval-command-h (cons Long (cdr V4856)) V4857))))) (if (kl:= Result (kl:fail)) (kl:thaw Freeze) Result)) (kl:thaw Freeze)))))) (export shen.x.launcher.eval-command-h) (quote shen.x.launcher.eval-command-h)) +(begin (register-function-arity (quote shen.x.launcher.eval-command) 1) (define (kl:shen.x.launcher.eval-command V4859) (kl:shen.x.launcher.eval-command-h V4859 (quote ()))) (export shen.x.launcher.eval-command) (quote shen.x.launcher.eval-command)) +(begin (register-function-arity (quote shen.x.launcher.script-command) 2) (define (kl:shen.x.launcher.script-command V4862 V4863) (begin (kl:set (quote *argv*) (cons V4862 V4863)) (begin (kl:shen.x.launcher.quiet-load V4862) (cons (quote success) (quote ()))))) (export shen.x.launcher.script-command) (quote shen.x.launcher.script-command)) +(begin (register-function-arity (quote shen.x.launcher.launch-shen) 1) (define (kl:shen.x.launcher.launch-shen V4865) (cond ((and (pair? V4865) (null? (cdr V4865))) (cons (quote launch-repl) (quote ()))) ((and (pair? V4865) (and (pair? (cdr V4865)) (equal? "--help" (car (cdr V4865))))) (cons (quote show-help) (cons (kl:shen.x.launcher.help-text (car V4865)) (quote ())))) ((and (pair? V4865) (and (pair? (cdr V4865)) (equal? "--version" (car (cdr V4865))))) (cons (quote success) (cons (kl:shen.x.launcher.version-string) (quote ())))) ((and (pair? V4865) (and (pair? (cdr V4865)) (equal? "repl" (car (cdr V4865))))) (cons (quote launch-repl) (cdr (cdr V4865)))) ((and (pair? V4865) (and (pair? (cdr V4865)) (and (equal? "script" (car (cdr V4865))) (pair? (cdr (cdr V4865)))))) (kl:shen.x.launcher.script-command (car (cdr (cdr V4865))) (cdr (cdr (cdr V4865))))) ((and (pair? V4865) (and (pair? (cdr V4865)) (equal? "eval" (car (cdr V4865))))) (kl:shen.x.launcher.eval-command (cdr (cdr V4865)))) ((and (pair? V4865) (pair? (cdr V4865))) (cons (quote unknown-arguments) V4865)) (#t (kl:shen.f_error (quote shen.x.launcher.launch-shen))))) (export shen.x.launcher.launch-shen) (quote shen.x.launcher.launch-shen)) +(begin (register-function-arity (quote shen.x.launcher.default-handle-result) 1) (define (kl:shen.x.launcher.default-handle-result V4869) (cond ((and (pair? V4869) (and (eq? (quote success) (car V4869)) (null? (cdr V4869)))) (quote shen.x.launcher.done)) ((and (pair? V4869) (and (eq? (quote success) (car V4869)) (and (pair? (cdr V4869)) (null? (cdr (cdr V4869)))))) (kl:shen.prhush (kl:shen.app (car (cdr V4869)) "\n" (quote shen.a)) (kl:stoutput))) ((and (pair? V4869) (and (eq? (quote error) (car V4869)) (and (pair? (cdr V4869)) (null? (cdr (cdr V4869)))))) (kl:shen.prhush (string-append "ERROR: " (kl:shen.app (car (cdr V4869)) "\n" (quote shen.a))) (kl:stoutput))) ((and (pair? V4869) (eq? (quote launch-repl) (car V4869))) (kl:shen.repl)) ((and (pair? V4869) (and (eq? (quote show-help) (car V4869)) (and (pair? (cdr V4869)) (null? (cdr (cdr V4869)))))) (kl:shen.prhush (kl:shen.app (car (cdr V4869)) "\n" (quote shen.a)) (kl:stoutput))) ((and (pair? V4869) (and (eq? (quote unknown-arguments) (car V4869)) (and (pair? (cdr V4869)) (pair? (cdr (cdr V4869)))))) (kl:shen.prhush (string-append "ERROR: Invalid argument: " (kl:shen.app (car (cdr (cdr V4869))) (string-append "\nTry `" (kl:shen.app (car (cdr V4869)) " --help' for more information.\n" (quote shen.a))) (quote shen.a))) (kl:stoutput))) (#t (kl:shen.f_error (quote shen.x.launcher.default-handle-result))))) (export shen.x.launcher.default-handle-result) (quote shen.x.launcher.default-handle-result)) +(begin (register-function-arity (quote shen.x.launcher.main) 1) (define (kl:shen.x.launcher.main V4871) (kl:shen.x.launcher.default-handle-result (kl:shen.x.launcher.launch-shen V4871))) (export shen.x.launcher.main) (quote shen.x.launcher.main)) diff --git a/compiled/extension-programmable-pattern-matching.kl.ms b/compiled/extension-programmable-pattern-matching.kl.ms new file mode 100644 index 0000000..2d9e6cd --- /dev/null +++ b/compiled/extension-programmable-pattern-matching.kl.ms @@ -0,0 +1,13 @@ +(module "compiled/extension-programmable-pattern-matching.kl") +"Copyright (c) 2019 Bruno Deferrari. All rights reserved.\nBSD 3-Clause License: http://opensource.org/licenses/BSD-3-Clause" +(begin (register-function-arity (quote shen.x.programmable-pattern-matching.apply-pattern-handlers) 5) (define (kl:shen.x.programmable-pattern-matching.apply-pattern-handlers V5042 V5043 V5044 V5045 V5046) (cond ((null? V5042) (kl:fail)) (#t (let ((Freeze (lambda () (cond ((pair? V5042) (kl:shen.x.programmable-pattern-matching.apply-pattern-handlers (cdr V5042) V5043 V5044 V5045 V5046)) (#t (kl:shen.f_error (quote shen.x.programmable-pattern-matching.apply-pattern-handlers))))))) (if (pair? V5042) (let ((Result (((((car V5042) V5043) V5044) V5045) V5046))) (if (kl:= Result (kl:fail)) (kl:thaw Freeze) Result)) (kl:thaw Freeze)))))) (export shen.x.programmable-pattern-matching.apply-pattern-handlers) (quote shen.x.programmable-pattern-matching.apply-pattern-handlers)) +(begin (register-function-arity (quote shen.x.programmable-pattern-matching.make-stack) 0) (define (kl:shen.x.programmable-pattern-matching.make-stack) (let ((_tmp (make-vector 1 (quote (quote shen.fail!))))) (vector-set! _tmp 0 (quote ())) _tmp)) (export shen.x.programmable-pattern-matching.make-stack) (quote shen.x.programmable-pattern-matching.make-stack)) +(begin (register-function-arity (quote shen.x.programmable-pattern-matching.push) 2) (define (kl:shen.x.programmable-pattern-matching.push V5049 V5050) (let ((_tmp V5049)) (vector-set! _tmp 0 (cons V5050 (vector-ref V5049 0))) _tmp)) (export shen.x.programmable-pattern-matching.push) (quote shen.x.programmable-pattern-matching.push)) +(begin (register-function-arity (quote shen.x.programmable-pattern-matching.pop-all) 1) (define (kl:shen.x.programmable-pattern-matching.pop-all V5052) (let ((Res (vector-ref V5052 0))) (let ((_ (let ((_tmp V5052)) (vector-set! _tmp 0 (quote ())) _tmp))) Res))) (export shen.x.programmable-pattern-matching.pop-all) (quote shen.x.programmable-pattern-matching.pop-all)) +(begin (register-function-arity (quote shen.x.programmable-pattern-matching.compile-pattern) 3) (define (kl:shen.x.programmable-pattern-matching.compile-pattern V5056 V5057 V5058) (let ((VarsStack (kl:shen.x.programmable-pattern-matching.make-stack))) (let ((Self (quote Self_waspvm_dl__waspvm_dl_7907_waspvm_dl__waspvm_dl_))) (let ((AddTest (lambda (_) (quote shen.x.programmable-pattern-matching.ignored)))) (let ((Bind (lambda (Var) (lambda (_) (kl:shen.x.programmable-pattern-matching.push VarsStack Var))))) (let ((Result (kl:shen.x.programmable-pattern-matching.apply-pattern-handlers V5057 Self AddTest Bind V5056))) (if (kl:= Result (kl:fail)) (kl:thaw V5058) (kl:shen.x.programmable-pattern-matching.compile-pattern-h V5056 (kl:reverse (kl:shen.x.programmable-pattern-matching.pop-all VarsStack)))))))))) (export shen.x.programmable-pattern-matching.compile-pattern) (quote shen.x.programmable-pattern-matching.compile-pattern)) +(begin (register-function-arity (quote shen.x.programmable-pattern-matching.compile-pattern-h) 2) (define (kl:shen.x.programmable-pattern-matching.compile-pattern-h V5061 V5062) (cond ((pair? V5061) (let ((Compile (lambda (X) (kl:shen. X)))) (let ((Handler (lambda (E) (simple-error (string-append "failed to compile " (kl:shen.app E "" (quote shen.a))))))) (let ((NewArgs (kl:map (lambda (Arg) (if (kl:element? Arg V5062) (kl:compile Compile (cons Arg (quote ())) Handler) Arg)) (cdr V5061)))) (cons (car V5061) NewArgs))))) (#t (kl:shen.f_error (quote shen.x.programmable-pattern-matching.compile-pattern-h))))) (export shen.x.programmable-pattern-matching.compile-pattern-h) (quote shen.x.programmable-pattern-matching.compile-pattern-h)) +(begin (register-function-arity (quote shen.x.programmable-pattern-matching.reduce) 2) (define (kl:shen.x.programmable-pattern-matching.reduce V5065 V5066) (cond ((and (pair? V5065) (and (pair? (car V5065)) (and (eq? (quote /.) (car (car V5065))) (and (pair? (cdr (car V5065))) (and (pair? (car (cdr (car V5065)))) (and (pair? (cdr (cdr (car V5065)))) (and (null? (cdr (cdr (cdr (car V5065))))) (and (pair? (cdr V5065)) (null? (cdr (cdr V5065))))))))))) (let ((SelectorStack (kl:shen.x.programmable-pattern-matching.make-stack))) (let ((AddTest (lambda (Expr) (kl:shen.add_test Expr)))) (let ((Bind (lambda (Var) (lambda (Expr) (kl:shen.x.programmable-pattern-matching.push SelectorStack (kl:_waspvm_at_p Var Expr)))))) (let ((Result (kl:shen.x.programmable-pattern-matching.apply-pattern-handlers V5066 (car (cdr V5065)) AddTest Bind (car (cdr (car V5065)))))) (let ((Vars+Sels (kl:reverse (kl:shen.x.programmable-pattern-matching.pop-all SelectorStack)))) (let ((Vars (kl:map (lambda (V5019) (kl:fst V5019)) Vars+Sels))) (let ((Selectors (kl:map (lambda (V5020) (kl:snd V5020)) Vars+Sels))) (let ((Abstraction (kl:shen.abstraction_build Vars (kl:shen.ebr (car (cdr V5065)) (car (cdr (car V5065))) (car (cdr (cdr (car V5065)))))))) (let ((Application (kl:shen.application_build Selectors Abstraction))) (kl:shen.reduce_help Application))))))))))) (#t (kl:shen.f_error (quote shen.x.programmable-pattern-matching.reduce))))) (export shen.x.programmable-pattern-matching.reduce) (quote shen.x.programmable-pattern-matching.reduce)) +(begin (register-function-arity (quote shen.x.programmable-pattern-matching.initialise) 0) (define (kl:shen.x.programmable-pattern-matching.initialise) (begin (kl:set (quote shen.*custom-pattern-compiler*) (lambda (Arg) (lambda (OnFail) (kl:shen.x.programmable-pattern-matching.compile-pattern Arg (kl:value (quote shen.x.programmable-pattern-matching.*pattern-handlers*)) OnFail)))) (begin (kl:set (quote shen.*custom-pattern-reducer*) (lambda (Arg) (kl:shen.x.programmable-pattern-matching.reduce Arg (kl:value (quote shen.x.programmable-pattern-matching.*pattern-handlers*))))) (begin (kl:set (quote shen.x.programmable-pattern-matching.*pattern-handlers*) (quote ())) (begin (kl:set (quote shen.x.programmable-pattern-matching.*pattern-handlers-reg*) (quote ())) (quote shen.x.programmable-pattern-matching.done)))))) (export shen.x.programmable-pattern-matching.initialise) (quote shen.x.programmable-pattern-matching.initialise)) +(begin (register-function-arity (quote shen.x.programmable-pattern-matching.register-handler) 1) (define (kl:shen.x.programmable-pattern-matching.register-handler V5068) (cond ((kl:element? V5068 (kl:value (quote shen.x.programmable-pattern-matching.*pattern-handlers-reg*))) V5068) (#t (begin (kl:set (quote shen.x.programmable-pattern-matching.*pattern-handlers-reg*) (cons V5068 (kl:value (quote shen.x.programmable-pattern-matching.*pattern-handlers-reg*)))) (begin (kl:set (quote shen.x.programmable-pattern-matching.*pattern-handlers*) (cons (kl:function V5068) (kl:value (quote shen.x.programmable-pattern-matching.*pattern-handlers*)))) V5068))))) (export shen.x.programmable-pattern-matching.register-handler) (quote shen.x.programmable-pattern-matching.register-handler)) +(begin (register-function-arity (quote shen.x.programmable-pattern-matching.findpos) 2) (define (kl:shen.x.programmable-pattern-matching.findpos V5071 V5072) (guard (lambda (_) (simple-error (kl:shen.app V5071 " is not a pattern handler\n" (quote shen.a)))) (kl:shen.findpos V5071 V5072))) (export shen.x.programmable-pattern-matching.findpos) (quote shen.x.programmable-pattern-matching.findpos)) +(begin (register-function-arity (quote shen.x.programmable-pattern-matching.unregister-handler) 1) (define (kl:shen.x.programmable-pattern-matching.unregister-handler V5074) (let ((Reg (kl:value (quote shen.x.programmable-pattern-matching.*pattern-handlers-reg*)))) (let ((Pos (kl:shen.x.programmable-pattern-matching.findpos V5074 Reg))) (let ((RemoveReg (kl:set (quote shen.x.programmable-pattern-matching.*pattern-handlers-reg*) (kl:remove V5074 Reg)))) (let ((RemoveFun (kl:set (quote shen.x.programmable-pattern-matching.*pattern-handlers*) (kl:shen.remove-nth Pos (kl:value (quote shen.x.programmable-pattern-matching.*pattern-handlers*)))))) V5074))))) (export shen.x.programmable-pattern-matching.unregister-handler) (quote shen.x.programmable-pattern-matching.unregister-handler)) diff --git a/compiled/init.kl.ms b/compiled/init.kl.ms index 1044b91..94d3613 100644 --- a/compiled/init.kl.ms +++ b/compiled/init.kl.ms @@ -1,3 +1,7 @@ (module "compiled/init.kl") "Copyright (c) 2010-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:\n\n1. Redistributions of source code must retain the above copyright notice,\nthis list of conditions and the following disclaimer.\n\n2. Redistributions in binary form must reproduce the above copyright notice,\nthis list of conditions and the following disclaimer in the documentation\nand/or other materials provided with the distribution.\n\n3. Neither the name of the copyright holder nor the names of its contributors\nmay be used to endorse or promote products derived from this software without\nspecific prior written permission.\n\nTHIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ''AS IS'' AND\nANY EXPRESS 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 THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE\nFOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL\nDAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR\nSERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER\nCAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,\nOR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE\nOF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.\n" -(begin (register-function-arity (quote shen.initialise) 0) (define (kl:shen.initialise) (begin (kl:set (quote shen.*installing-kl*) #f) (begin (kl:set (quote shen.*history*) (quote ())) (begin (kl:set (quote shen.*tc*) #f) (begin (kl:set (quote *property-vector*) (kl:shen.dict 20000)) (begin (kl:set (quote shen.*process-counter*) 0) (begin (kl:set (quote shen.*varcounter*) (kl:vector 10000)) (begin (kl:set (quote shen.*prologvectors*) (kl:vector 10000)) (begin (kl:set (quote shen.*demodulation-function*) (lambda (X) X)) (begin (kl:set (quote shen.*macroreg*) (cons (quote shen.timer-macro) (cons (quote shen.cases-macro) (cons (quote shen.abs-macro) (cons (quote shen.put/get-macro) (cons (quote shen.compile-macro) (cons (quote shen.datatype-macro) (cons (quote shen.let-macro) (cons (quote shen.assoc-macro) (cons (quote shen.make-string-macro) (cons (quote shen.output-macro) (cons (quote shen.input-macro) (cons (quote shen.error-macro) (cons (quote shen.prolog-macro) (cons (quote shen.synonyms-macro) (cons (quote shen.nl-macro) (cons (quote shen._waspvm_at_s-macro) (cons (quote shen.defprolog-macro) (cons (quote shen.function-macro) (quote ())))))))))))))))))))) (begin (kl:set (quote *macros*) (cons (lambda (X) (kl:shen.timer-macro X)) (cons (lambda (X) (kl:shen.cases-macro X)) (cons (lambda (X) (kl:shen.abs-macro X)) (cons (lambda (X) (kl:shen.put/get-macro X)) (cons (lambda (X) (kl:shen.compile-macro X)) (cons (lambda (X) (kl:shen.datatype-macro X)) (cons (lambda (X) (kl:shen.let-macro X)) (cons (lambda (X) (kl:shen.assoc-macro X)) (cons (lambda (X) (kl:shen.make-string-macro X)) (cons (lambda (X) (kl:shen.output-macro X)) (cons (lambda (X) (kl:shen.input-macro X)) (cons (lambda (X) (kl:shen.error-macro X)) (cons (lambda (X) (kl:shen.prolog-macro X)) (cons (lambda (X) (kl:shen.synonyms-macro X)) (cons (lambda (X) (kl:shen.nl-macro X)) (cons (lambda (X) (kl:shen._waspvm_at_s-macro X)) (cons (lambda (X) (kl:shen.defprolog-macro X)) (cons (lambda (X) (kl:shen.function-macro X)) (quote ())))))))))))))))))))) (begin (kl:set (quote shen.*gensym*) 0) (begin (kl:set (quote shen.*tracking*) (quote ())) (begin (kl:set (quote shen.*alphabet*) (cons (quote A) (cons (quote B) (cons (quote C) (cons (quote D) (cons (quote E) (cons (quote F) (cons (quote G) (cons (quote H) (cons (quote I) (cons (quote J) (cons (quote K) (cons (quote L) (cons (quote M) (cons (quote N) (cons (quote O) (cons (quote P) (cons (quote Q) (cons (quote R) (cons (quote S) (cons (quote T) (cons (quote U) (cons (quote V) (cons (quote W) (cons (quote X) (cons (quote Y) (cons (quote Z) (quote ())))))))))))))))))))))))))))) (begin (kl:set (quote shen.*special*) (cons (quote _waspvm_at_p) (cons (quote _waspvm_at_s) (cons (quote _waspvm_at_v) (cons (quote cons) (cons (quote lambda) (cons (quote let) (cons (quote where) (cons (quote set) (cons (quote open) (quote ()))))))))))) (begin (kl:set (quote shen.*extraspecial*) (cons (quote define) (cons (quote shen.process-datatype) (cons (quote input+) (cons (quote defcc) (cons (quote shen.read+) (cons (quote defmacro) (quote ())))))))) (begin (kl:set (quote shen.*spy*) #f) (begin (kl:set (quote shen.*datatypes*) (quote ())) (begin (kl:set (quote shen.*alldatatypes*) (quote ())) (begin (kl:set (quote shen.*shen-type-theory-enabled?*) #t) (begin (kl:set (quote shen.*synonyms*) (quote ())) (begin (kl:set (quote shen.*system*) (quote ())) (begin (kl:set (quote shen.*signedfuncs*) (quote ())) (begin (kl:set (quote shen.*maxcomplexity*) 128) (begin (kl:set (quote shen.*occurs*) #t) (begin (kl:set (quote shen.*maxinferences*) 1000000) (begin (kl:set (quote *maximum-print-sequence-size*) 20) (begin (kl:set (quote shen.*catch*) 0) (begin (kl:set (quote shen.*call*) 0) (begin (kl:set (quote shen.*infs*) 0) (begin (kl:set (quote *hush*) #f) (begin (kl:set (quote shen.*optimise*) #f) (begin (kl:set (quote *version*) "Shen 22.0") (begin (if (kl:not (kl:bound? (quote *home-directory*))) (kl:set (quote *home-directory*) "") (quote shen.skip)) (begin (if (kl:not (kl:bound? (quote *sterror*))) (kl:set (quote *sterror*) (kl:value (quote *stoutput*))) (quote shen.skip)) (begin (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 (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 (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 (kl:shen.set-lambda-form-entry (cons (quote shen.datatype-error) (lambda (X) (kl:shen.datatype-error X)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.tuple) (lambda (X) (kl:shen.tuple X)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.pvar) (lambda (X) (kl:shen.pvar X)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.dictionary) (lambda (X) (kl:shen.dictionary X)))) (begin (kl:shen.set-lambda-form-entry (cons (quote _waspvm_at_v) (lambda (V1579) (lambda (V1580) (kl:_waspvm_at_v V1579 V1580))))) (begin (kl:shen.set-lambda-form-entry (cons (quote _waspvm_at_p) (lambda (V1581) (lambda (V1582) (kl:_waspvm_at_p V1581 V1582))))) (begin (kl:shen.set-lambda-form-entry (cons (quote _waspvm_at_s) (lambda (V1583) (lambda (V1584) (kl:_waspvm_at_s V1583 V1584))))) (begin (kl:shen.set-lambda-form-entry (cons (quote ) (lambda (V1585) (kl: V1585)))) (begin (kl:shen.set-lambda-form-entry (cons (quote ) (lambda (V1586) (kl: V1586)))) (begin (kl:shen.set-lambda-form-entry (cons (quote ==) (lambda (V1587) (lambda (V1588) (kl:== V1587 V1588))))) (begin (kl:shen.set-lambda-form-entry (cons (quote =) (lambda (V1589) (lambda (V1590) (kl:= V1589 V1590))))) (begin (kl:shen.set-lambda-form-entry (cons (quote >=) (lambda (V1591) (lambda (V1592) (>= V1591 V1592))))) (begin (kl:shen.set-lambda-form-entry (cons (quote >) (lambda (V1593) (lambda (V1594) (> V1593 V1594))))) (begin (kl:shen.set-lambda-form-entry (cons (quote -) (lambda (V1595) (lambda (V1596) (- V1595 V1596))))) (begin (kl:shen.set-lambda-form-entry (cons (quote /) (lambda (V1597) (lambda (V1598) (/ V1597 V1598))))) (begin (kl:shen.set-lambda-form-entry (cons (quote *) (lambda (V1599) (lambda (V1600) (* V1599 V1600))))) (begin (kl:shen.set-lambda-form-entry (cons (quote +) (lambda (V1601) (lambda (V1602) (+ V1601 V1602))))) (begin (kl:shen.set-lambda-form-entry (cons (quote <=) (lambda (V1603) (lambda (V1604) (<= V1603 V1604))))) (begin (kl:shen.set-lambda-form-entry (cons (quote <) (lambda (V1605) (lambda (V1606) (< V1605 V1606))))) (begin (kl:shen.set-lambda-form-entry (cons (quote y-or-n?) (lambda (V1607) (kl:y-or-n? V1607)))) (begin (kl:shen.set-lambda-form-entry (cons (quote write-to-file) (lambda (V1608) (lambda (V1609) (kl:write-to-file V1608 V1609))))) (begin (kl:shen.set-lambda-form-entry (cons (quote write-byte) (lambda (V1610) (lambda (V1611) (write-u8 V1610 V1611))))) (begin (kl:shen.set-lambda-form-entry (cons (quote variable?) (lambda (V1612) (kl:variable? V1612)))) (begin (kl:shen.set-lambda-form-entry (cons (quote value) (lambda (V1613) (kl:value V1613)))) (begin (kl:shen.set-lambda-form-entry (cons (quote vector->) (lambda (V1614) (lambda (V1615) (lambda (V1616) (kl:vector-> V1614 V1615 V1616)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote <-vector) (lambda (V1617) (lambda (V1618) (kl:<-vector V1617 V1618))))) (begin (kl:shen.set-lambda-form-entry (cons (quote vector) (lambda (V1619) (kl:vector V1619)))) (begin (kl:shen.set-lambda-form-entry (cons (quote vector?) (lambda (V1620) (kl:vector? V1620)))) (begin (kl:shen.set-lambda-form-entry (cons (quote unspecialise) (lambda (V1621) (kl:unspecialise V1621)))) (begin (kl:shen.set-lambda-form-entry (cons (quote untrack) (lambda (V1622) (kl:untrack V1622)))) (begin (kl:shen.set-lambda-form-entry (cons (quote union) (lambda (V1623) (lambda (V1624) (kl:union V1623 V1624))))) (begin (kl:shen.set-lambda-form-entry (cons (quote unify) (lambda (V1625) (lambda (V1626) (lambda (V1627) (lambda (V1628) (kl:unify V1625 V1626 V1627 V1628))))))) (begin (kl:shen.set-lambda-form-entry (cons (quote unify!) (lambda (V1629) (lambda (V1630) (lambda (V1631) (lambda (V1632) (kl:unify! V1629 V1630 V1631 V1632))))))) (begin (kl:shen.set-lambda-form-entry (cons (quote unput) (lambda (V1633) (lambda (V1634) (lambda (V1635) (kl:unput V1633 V1634 V1635)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote unprofile) (lambda (V1636) (kl:unprofile V1636)))) (begin (kl:shen.set-lambda-form-entry (cons (quote undefmacro) (lambda (V1637) (kl:undefmacro V1637)))) (begin (kl:shen.set-lambda-form-entry (cons (quote return) (lambda (V1638) (lambda (V1639) (lambda (V1640) (kl:return V1638 V1639 V1640)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote type) (lambda (V1641) (lambda (V1642) V1641)))) (begin (kl:shen.set-lambda-form-entry (cons (quote tuple?) (lambda (V1643) (kl:tuple? V1643)))) (begin (kl:shen.set-lambda-form-entry (cons (quote trap-error) (lambda (V1644) (lambda (V1645) (guard (lambda (e) (V1645 e)) V1644))))) (begin (kl:shen.set-lambda-form-entry (cons (quote track) (lambda (V1646) (kl:track V1646)))) (begin (kl:shen.set-lambda-form-entry (cons (quote thaw) (lambda (V1647) (kl:thaw V1647)))) (begin (kl:shen.set-lambda-form-entry (cons (quote tc) (lambda (V1648) (kl:tc V1648)))) (begin (kl:shen.set-lambda-form-entry (cons (quote tl) (lambda (V1649) (cdr V1649)))) (begin (kl:shen.set-lambda-form-entry (cons (quote tlstr) (lambda (V1650) (string-tail V1650 1)))) (begin (kl:shen.set-lambda-form-entry (cons (quote tail) (lambda (V1651) (kl:tail V1651)))) (begin (kl:shen.set-lambda-form-entry (cons (quote systemf) (lambda (V1652) (kl:systemf V1652)))) (begin (kl:shen.set-lambda-form-entry (cons (quote symbol?) (lambda (V1653) (kl:symbol? V1653)))) (begin (kl:shen.set-lambda-form-entry (cons (quote string->symbol) (lambda (V1654) (kl:string->symbol V1654)))) (begin (kl:shen.set-lambda-form-entry (cons (quote sum) (lambda (V1655) (kl:sum V1655)))) (begin (kl:shen.set-lambda-form-entry (cons (quote subst) (lambda (V1656) (lambda (V1657) (lambda (V1658) (kl:subst V1656 V1657 V1658)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote string?) (lambda (V1659) (string? V1659)))) (begin (kl:shen.set-lambda-form-entry (cons (quote string->n) (lambda (V1660) (string-ref V1660 0)))) (begin (kl:shen.set-lambda-form-entry (cons (quote step) (lambda (V1661) (kl:step V1661)))) (begin (kl:shen.set-lambda-form-entry (cons (quote spy) (lambda (V1662) (kl:spy V1662)))) (begin (kl:shen.set-lambda-form-entry (cons (quote specialise) (lambda (V1663) (kl:specialise V1663)))) (begin (kl:shen.set-lambda-form-entry (cons (quote snd) (lambda (V1664) (kl:snd V1664)))) (begin (kl:shen.set-lambda-form-entry (cons (quote simple-error) (lambda (V1665) (simple-error V1665)))) (begin (kl:shen.set-lambda-form-entry (cons (quote set) (lambda (V1666) (lambda (V1667) (kl:set V1666 V1667))))) (begin (kl:shen.set-lambda-form-entry (cons (quote str) (lambda (V1668) (kl:str V1668)))) (begin (kl:shen.set-lambda-form-entry (cons (quote reverse) (lambda (V1669) (kl:reverse V1669)))) (begin (kl:shen.set-lambda-form-entry (cons (quote remove) (lambda (V1670) (lambda (V1671) (kl:remove V1670 V1671))))) (begin (kl:shen.set-lambda-form-entry (cons (quote read) (lambda (V1672) (kl:read V1672)))) (begin (kl:shen.set-lambda-form-entry (cons (quote read-file) (lambda (V1673) (kl:read-file V1673)))) (begin (kl:shen.set-lambda-form-entry (cons (quote read-file-as-bytelist) (lambda (V1674) (kl:read-file-as-bytelist V1674)))) (begin (kl:shen.set-lambda-form-entry (cons (quote read-file-as-string) (lambda (V1675) (kl:read-file-as-string V1675)))) (begin (kl:shen.set-lambda-form-entry (cons (quote read-byte) (lambda (V1676) (read-u8 V1676)))) (begin (kl:shen.set-lambda-form-entry (cons (quote read-from-string) (lambda (V1677) (kl:read-from-string V1677)))) (begin (kl:shen.set-lambda-form-entry (cons (quote package?) (lambda (V1678) (kl:package? V1678)))) (begin (kl:shen.set-lambda-form-entry (cons (quote put) (lambda (V1679) (lambda (V1680) (lambda (V1681) (lambda (V1682) (kl:put V1679 V1680 V1681 V1682))))))) (begin (kl:shen.set-lambda-form-entry (cons (quote preclude) (lambda (V1683) (kl:preclude V1683)))) (begin (kl:shen.set-lambda-form-entry (cons (quote preclude-all-but) (lambda (V1684) (kl:preclude-all-but V1684)))) (begin (kl:shen.set-lambda-form-entry (cons (quote ps) (lambda (V1685) (kl:ps V1685)))) (begin (kl:shen.set-lambda-form-entry (cons (quote protect) (lambda (V1686) (kl:protect V1686)))) (begin (kl:shen.set-lambda-form-entry (cons (quote profile-results) (lambda (V1687) (kl:profile-results V1687)))) (begin (kl:shen.set-lambda-form-entry (cons (quote profile) (lambda (V1688) (kl:profile V1688)))) (begin (kl:shen.set-lambda-form-entry (cons (quote print) (lambda (V1689) (kl:print V1689)))) (begin (kl:shen.set-lambda-form-entry (cons (quote pr) (lambda (V1690) (lambda (V1691) (kl:pr V1690 V1691))))) (begin (kl:shen.set-lambda-form-entry (cons (quote pos) (lambda (V1692) (lambda (V1693) (make-string 1 (string-ref V1692 V1693)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote or) (lambda (V1694) (lambda (V1695) (or (assert-boolean V1694) (assert-boolean V1695)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote optimise) (lambda (V1696) (kl:optimise V1696)))) (begin (kl:shen.set-lambda-form-entry (cons (quote open) (lambda (V1697) (lambda (V1698) (kl:open V1697 V1698))))) (begin (kl:shen.set-lambda-form-entry (cons (quote occurrences) (lambda (V1699) (lambda (V1700) (kl:occurrences V1699 V1700))))) (begin (kl:shen.set-lambda-form-entry (cons (quote occurs-check) (lambda (V1701) (kl:occurs-check V1701)))) (begin (kl:shen.set-lambda-form-entry (cons (quote n->string) (lambda (V1702) (make-string 1 V1702)))) (begin (kl:shen.set-lambda-form-entry (cons (quote number?) (lambda (V1703) (number? V1703)))) (begin (kl:shen.set-lambda-form-entry (cons (quote nth) (lambda (V1704) (lambda (V1705) (kl:nth V1704 V1705))))) (begin (kl:shen.set-lambda-form-entry (cons (quote not) (lambda (V1706) (kl:not V1706)))) (begin (kl:shen.set-lambda-form-entry (cons (quote nl) (lambda (V1707) (kl:nl V1707)))) (begin (kl:shen.set-lambda-form-entry (cons (quote macroexpand) (lambda (V1708) (kl:macroexpand V1708)))) (begin (kl:shen.set-lambda-form-entry (cons (quote maxinferences) (lambda (V1709) (kl:maxinferences V1709)))) (begin (kl:shen.set-lambda-form-entry (cons (quote mapcan) (lambda (V1710) (lambda (V1711) (kl:mapcan V1710 V1711))))) (begin (kl:shen.set-lambda-form-entry (cons (quote map) (lambda (V1712) (lambda (V1713) (kl:map V1712 V1713))))) (begin (kl:shen.set-lambda-form-entry (cons (quote load) (lambda (V1714) (kl:load V1714)))) (begin (kl:shen.set-lambda-form-entry (cons (quote lineread) (lambda (V1715) (kl:lineread V1715)))) (begin (kl:shen.set-lambda-form-entry (cons (quote limit) (lambda (V1716) (kl:limit V1716)))) (begin (kl:shen.set-lambda-form-entry (cons (quote length) (lambda (V1717) (kl:length V1717)))) (begin (kl:shen.set-lambda-form-entry (cons (quote intersection) (lambda (V1718) (lambda (V1719) (kl:intersection V1718 V1719))))) (begin (kl:shen.set-lambda-form-entry (cons (quote intern) (lambda (V1720) (kl:intern V1720)))) (begin (kl:shen.set-lambda-form-entry (cons (quote integer?) (lambda (V1721) (kl:integer? V1721)))) (begin (kl:shen.set-lambda-form-entry (cons (quote input) (lambda (V1722) (kl:input V1722)))) (begin (kl:shen.set-lambda-form-entry (cons (quote input+) (lambda (V1723) (lambda (V1724) (kl:input+ V1723 V1724))))) (begin (kl:shen.set-lambda-form-entry (cons (quote include) (lambda (V1725) (kl:include V1725)))) (begin (kl:shen.set-lambda-form-entry (cons (quote include-all-but) (lambda (V1726) (kl:include-all-but V1726)))) (begin (kl:shen.set-lambda-form-entry (cons (quote internal) (lambda (V1727) (kl:internal V1727)))) (begin (kl:shen.set-lambda-form-entry (cons (quote if) (lambda (V1728) (lambda (V1729) (lambda (V1730) (if (assert-boolean V1728) V1729 V1730)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote identical) (lambda (V1731) (lambda (V1732) (lambda (V1733) (lambda (V1734) (kl:identical V1731 V1732 V1733 V1734))))))) (begin (kl:shen.set-lambda-form-entry (cons (quote head) (lambda (V1735) (kl:head V1735)))) (begin (kl:shen.set-lambda-form-entry (cons (quote hd) (lambda (V1736) (car V1736)))) (begin (kl:shen.set-lambda-form-entry (cons (quote hdv) (lambda (V1737) (kl:hdv V1737)))) (begin (kl:shen.set-lambda-form-entry (cons (quote hdstr) (lambda (V1738) (kl:hdstr V1738)))) (begin (kl:shen.set-lambda-form-entry (cons (quote hash) (lambda (V1739) (lambda (V1740) (kl:hash V1739 V1740))))) (begin (kl:shen.set-lambda-form-entry (cons (quote get) (lambda (V1741) (lambda (V1742) (lambda (V1743) (kl:get V1741 V1742 V1743)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote get-time) (lambda (V1744) (kl:get-time V1744)))) (begin (kl:shen.set-lambda-form-entry (cons (quote gensym) (lambda (V1745) (kl:gensym V1745)))) (begin (kl:shen.set-lambda-form-entry (cons (quote fst) (lambda (V1746) (kl:fst V1746)))) (begin (kl:shen.set-lambda-form-entry (cons (quote freeze) (lambda (V1747) (lambda () V1747)))) (begin (kl:shen.set-lambda-form-entry (cons (quote fix) (lambda (V1748) (lambda (V1749) (kl:fix V1748 V1749))))) (begin (kl:shen.set-lambda-form-entry (cons (quote fail-if) (lambda (V1750) (lambda (V1751) (kl:fail-if V1750 V1751))))) (begin (kl:shen.set-lambda-form-entry (cons (quote findall) (lambda (V1752) (lambda (V1753) (lambda (V1754) (lambda (V1755) (lambda (V1756) (kl:findall V1752 V1753 V1754 V1755 V1756)))))))) (begin (kl:shen.set-lambda-form-entry (cons (quote enable-type-theory) (lambda (V1757) (kl:enable-type-theory V1757)))) (begin (kl:shen.set-lambda-form-entry (cons (quote explode) (lambda (V1758) (kl:explode V1758)))) (begin (kl:shen.set-lambda-form-entry (cons (quote external) (lambda (V1759) (kl:external V1759)))) (begin (kl:shen.set-lambda-form-entry (cons (quote eval-kl) (lambda (V1760) (kl:eval-kl V1760)))) (begin (kl:shen.set-lambda-form-entry (cons (quote eval) (lambda (V1761) (kl:eval V1761)))) (begin (kl:shen.set-lambda-form-entry (cons (quote error-to-string) (lambda (V1762) (kl:error-to-string V1762)))) (begin (kl:shen.set-lambda-form-entry (cons (quote empty?) (lambda (V1763) (kl:empty? V1763)))) (begin (kl:shen.set-lambda-form-entry (cons (quote element?) (lambda (V1764) (lambda (V1765) (kl:element? V1764 V1765))))) (begin (kl:shen.set-lambda-form-entry (cons (quote do) (lambda (V1766) (lambda (V1767) (begin V1766 V1767))))) (begin (kl:shen.set-lambda-form-entry (cons (quote difference) (lambda (V1768) (lambda (V1769) (kl:difference V1768 V1769))))) (begin (kl:shen.set-lambda-form-entry (cons (quote destroy) (lambda (V1770) (kl:destroy V1770)))) (begin (kl:shen.set-lambda-form-entry (cons (quote declare) (lambda (V1771) (lambda (V1772) (kl:declare V1771 V1772))))) (begin (kl:shen.set-lambda-form-entry (cons (quote cn) (lambda (V1773) (lambda (V1774) (string-append V1773 V1774))))) (begin (kl:shen.set-lambda-form-entry (cons (quote cons?) (lambda (V1775) (pair? V1775)))) (begin (kl:shen.set-lambda-form-entry (cons (quote cons) (lambda (V1776) (lambda (V1777) (cons V1776 V1777))))) (begin (kl:shen.set-lambda-form-entry (cons (quote concat) (lambda (V1778) (lambda (V1779) (kl:concat V1778 V1779))))) (begin (kl:shen.set-lambda-form-entry (cons (quote compile) (lambda (V1780) (lambda (V1781) (lambda (V1782) (kl:compile V1780 V1781 V1782)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote cd) (lambda (V1783) (kl:cd V1783)))) (begin (kl:shen.set-lambda-form-entry (cons (quote close) (lambda (V1784) (kl:close V1784)))) (begin (kl:shen.set-lambda-form-entry (cons (quote bound?) (lambda (V1785) (kl:bound? V1785)))) (begin (kl:shen.set-lambda-form-entry (cons (quote boolean?) (lambda (V1786) (kl:boolean? V1786)))) (begin (kl:shen.set-lambda-form-entry (cons (quote assoc) (lambda (V1787) (lambda (V1788) (kl:assoc V1787 V1788))))) (begin (kl:shen.set-lambda-form-entry (cons (quote arity) (lambda (V1789) (kl:arity V1789)))) (begin (kl:shen.set-lambda-form-entry (cons (quote append) (lambda (V1790) (lambda (V1791) (kl:append V1790 V1791))))) (begin (kl:shen.set-lambda-form-entry (cons (quote and) (lambda (V1792) (lambda (V1793) (and (assert-boolean V1792) (assert-boolean V1793)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote adjoin) (lambda (V1794) (lambda (V1795) (kl:adjoin V1794 V1795))))) (begin (kl:shen.set-lambda-form-entry (cons (quote <-address) (lambda (V1796) (lambda (V1797) (vector-ref V1796 V1797))))) (begin (kl:shen.set-lambda-form-entry (cons (quote address->) (lambda (V1798) (lambda (V1799) (lambda (V1800) (let ((_tmp V1798)) (vector-set! _tmp V1799 V1800) _tmp)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote absvector?) (lambda (V1801) (vector? V1801)))) (begin (kl:shen.set-lambda-form-entry (cons (quote absvector) (lambda (V1802) (make-vector V1802 (quote (quote shen.fail!)))))) (begin (kl:set (quote shen.*history*) (quote ())) (begin (kl:set (quote shen.*step*) #f) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote absvector?) (cons (quote A) (cons (quote -->) (cons (quote boolean) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-absvector?) (lambda (V4342) (lambda (V4343) (lambda (V4344) (kl:shen.type-signature-of-absvector? V4342 V4343 V4344)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (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:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-adjoin) (lambda (V4352) (lambda (V4353) (lambda (V4354) (kl:shen.type-signature-of-adjoin V4352 V4353 V4354)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote and) (cons (quote boolean) (cons (quote -->) (cons (cons (quote boolean) (cons (quote -->) (cons (quote boolean) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-and) (lambda (V4362) (lambda (V4363) (lambda (V4364) (kl:shen.type-signature-of-and V4362 V4363 V4364)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote shen.app) (cons (quote A) (cons (quote -->) (cons (cons (quote string) (cons (quote -->) (cons (cons (quote symbol) (cons (quote -->) (cons (quote string) (quote ())))) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-shen.app) (lambda (V4372) (lambda (V4373) (lambda (V4374) (kl:shen.type-signature-of-shen.app V4372 V4373 V4374)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote append) (cons (cons (quote list) (cons (quote A) (quote ()))) (cons (quote -->) (cons (cons (cons (quote list) (cons (quote A) (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons (quote A) (quote ()))) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-append) (lambda (V4382) (lambda (V4383) (lambda (V4384) (kl:shen.type-signature-of-append V4382 V4383 V4384)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote arity) (cons (quote A) (cons (quote -->) (cons (quote number) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-arity) (lambda (V4392) (lambda (V4393) (lambda (V4394) (kl:shen.type-signature-of-arity V4392 V4393 V4394)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote assoc) (cons (quote A) (cons (quote -->) (cons (cons (cons (quote list) (cons (cons (quote list) (cons (quote A) (quote ()))) (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons (quote A) (quote ()))) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-assoc) (lambda (V4402) (lambda (V4403) (lambda (V4404) (kl:shen.type-signature-of-assoc V4402 V4403 V4404)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote boolean?) (cons (quote A) (cons (quote -->) (cons (quote boolean) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-boolean?) (lambda (V4412) (lambda (V4413) (lambda (V4414) (kl:shen.type-signature-of-boolean? V4412 V4413 V4414)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote bound?) (cons (quote symbol) (cons (quote -->) (cons (quote boolean) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-bound?) (lambda (V4422) (lambda (V4423) (lambda (V4424) (kl:shen.type-signature-of-bound? V4422 V4423 V4424)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote cd) (cons (quote string) (cons (quote -->) (cons (quote string) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-cd) (lambda (V4432) (lambda (V4433) (lambda (V4434) (kl:shen.type-signature-of-cd V4432 V4433 V4434)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote close) (cons (cons (quote stream) (cons (quote A) (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons (quote B) (quote ()))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-close) (lambda (V4442) (lambda (V4443) (lambda (V4444) (kl:shen.type-signature-of-close V4442 V4443 V4444)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote cn) (cons (quote string) (cons (quote -->) (cons (cons (quote string) (cons (quote -->) (cons (quote string) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-cn) (lambda (V4452) (lambda (V4453) (lambda (V4454) (kl:shen.type-signature-of-cn V4452 V4453 V4454)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote compile) (cons (cons (quote A) (cons (quote shen.==>) (cons (quote B) (quote ())))) (cons (quote -->) (cons (cons (quote A) (cons (quote -->) (cons (cons (cons (quote A) (cons (quote -->) (cons (quote B) (quote ())))) (cons (quote -->) (cons (quote B) (quote ())))) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-compile) (lambda (V4462) (lambda (V4463) (lambda (V4464) (kl:shen.type-signature-of-compile V4462 V4463 V4464)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote cons?) (cons (quote A) (cons (quote -->) (cons (quote boolean) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-cons?) (lambda (V4472) (lambda (V4473) (lambda (V4474) (kl:shen.type-signature-of-cons? V4472 V4473 V4474)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote destroy) (cons (cons (quote A) (cons (quote -->) (cons (quote B) (quote ())))) (cons (quote -->) (cons (quote symbol) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-destroy) (lambda (V4482) (lambda (V4483) (lambda (V4484) (kl:shen.type-signature-of-destroy V4482 V4483 V4484)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote difference) (cons (cons (quote list) (cons (quote A) (quote ()))) (cons (quote -->) (cons (cons (cons (quote list) (cons (quote A) (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons (quote A) (quote ()))) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-difference) (lambda (V4492) (lambda (V4493) (lambda (V4494) (kl:shen.type-signature-of-difference V4492 V4493 V4494)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote do) (cons (quote A) (cons (quote -->) (cons (cons (quote B) (cons (quote -->) (cons (quote B) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-do) (lambda (V4502) (lambda (V4503) (lambda (V4504) (kl:shen.type-signature-of-do V4502 V4503 V4504)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote ) (cons (cons (quote list) (cons (quote A) (quote ()))) (cons (quote shen.==>) (cons (cons (quote list) (cons (quote B) (quote ()))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-) (lambda (V4512) (lambda (V4513) (lambda (V4514) (kl:shen.type-signature-of- V4512 V4513 V4514)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote ) (cons (cons (quote list) (cons (quote A) (quote ()))) (cons (quote shen.==>) (cons (cons (quote list) (cons (quote A) (quote ()))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-) (lambda (V4522) (lambda (V4523) (lambda (V4524) (kl:shen.type-signature-of- V4522 V4523 V4524)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote element?) (cons (quote A) (cons (quote -->) (cons (cons (cons (quote list) (cons (quote A) (quote ()))) (cons (quote -->) (cons (quote boolean) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-element?) (lambda (V4532) (lambda (V4533) (lambda (V4534) (kl:shen.type-signature-of-element? V4532 V4533 V4534)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote empty?) (cons (quote A) (cons (quote -->) (cons (quote boolean) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-empty?) (lambda (V4542) (lambda (V4543) (lambda (V4544) (kl:shen.type-signature-of-empty? V4542 V4543 V4544)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote enable-type-theory) (cons (quote symbol) (cons (quote -->) (cons (quote boolean) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-enable-type-theory) (lambda (V4552) (lambda (V4553) (lambda (V4554) (kl:shen.type-signature-of-enable-type-theory V4552 V4553 V4554)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote external) (cons (quote symbol) (cons (quote -->) (cons (cons (quote list) (cons (quote symbol) (quote ()))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-external) (lambda (V4562) (lambda (V4563) (lambda (V4564) (kl:shen.type-signature-of-external V4562 V4563 V4564)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote error-to-string) (cons (quote exception) (cons (quote -->) (cons (quote string) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-error-to-string) (lambda (V4572) (lambda (V4573) (lambda (V4574) (kl:shen.type-signature-of-error-to-string V4572 V4573 V4574)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote explode) (cons (quote A) (cons (quote -->) (cons (cons (quote list) (cons (quote string) (quote ()))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-explode) (lambda (V4582) (lambda (V4583) (lambda (V4584) (kl:shen.type-signature-of-explode V4582 V4583 V4584)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote fail) (cons (quote -->) (cons (quote symbol) (quote ())))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-fail) (lambda (V4592) (lambda (V4593) (lambda (V4594) (kl:shen.type-signature-of-fail V4592 V4593 V4594)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote fail-if) (cons (cons (quote symbol) (cons (quote -->) (cons (quote boolean) (quote ())))) (cons (quote -->) (cons (cons (quote symbol) (cons (quote -->) (cons (quote symbol) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-fail-if) (lambda (V4602) (lambda (V4603) (lambda (V4604) (kl:shen.type-signature-of-fail-if V4602 V4603 V4604)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote fix) (cons (cons (quote A) (cons (quote -->) (cons (quote A) (quote ())))) (cons (quote -->) (cons (cons (quote A) (cons (quote -->) (cons (quote A) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-fix) (lambda (V4612) (lambda (V4613) (lambda (V4614) (kl:shen.type-signature-of-fix V4612 V4613 V4614)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote freeze) (cons (quote A) (cons (quote -->) (cons (cons (quote lazy) (cons (quote A) (quote ()))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-freeze) (lambda (V4622) (lambda (V4623) (lambda (V4624) (kl:shen.type-signature-of-freeze V4622 V4623 V4624)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote fst) (cons (cons (quote A) (cons (quote *) (cons (quote B) (quote ())))) (cons (quote -->) (cons (quote A) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-fst) (lambda (V4632) (lambda (V4633) (lambda (V4634) (kl:shen.type-signature-of-fst V4632 V4633 V4634)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote function) (cons (cons (quote A) (cons (quote -->) (cons (quote B) (quote ())))) (cons (quote -->) (cons (cons (quote A) (cons (quote -->) (cons (quote B) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-function) (lambda (V4642) (lambda (V4643) (lambda (V4644) (kl:shen.type-signature-of-function V4642 V4643 V4644)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote gensym) (cons (quote symbol) (cons (quote -->) (cons (quote symbol) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-gensym) (lambda (V4652) (lambda (V4653) (lambda (V4654) (kl:shen.type-signature-of-gensym V4652 V4653 V4654)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote <-vector) (cons (cons (quote vector) (cons (quote A) (quote ()))) (cons (quote -->) (cons (cons (quote number) (cons (quote -->) (cons (quote A) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-<-vector) (lambda (V4662) (lambda (V4663) (lambda (V4664) (kl:shen.type-signature-of-<-vector V4662 V4663 V4664)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote vector->) (cons (cons (quote vector) (cons (quote A) (quote ()))) (cons (quote -->) (cons (cons (quote number) (cons (quote -->) (cons (cons (quote A) (cons (quote -->) (cons (cons (quote vector) (cons (quote A) (quote ()))) (quote ())))) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-vector->) (lambda (V4672) (lambda (V4673) (lambda (V4674) (kl:shen.type-signature-of-vector-> V4672 V4673 V4674)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote vector) (cons (quote number) (cons (quote -->) (cons (cons (quote vector) (cons (quote A) (quote ()))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-vector) (lambda (V4682) (lambda (V4683) (lambda (V4684) (kl:shen.type-signature-of-vector V4682 V4683 V4684)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote get-time) (cons (quote symbol) (cons (quote -->) (cons (quote number) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-get-time) (lambda (V4692) (lambda (V4693) (lambda (V4694) (kl:shen.type-signature-of-get-time V4692 V4693 V4694)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote hash) (cons (quote A) (cons (quote -->) (cons (cons (quote number) (cons (quote -->) (cons (quote number) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-hash) (lambda (V4702) (lambda (V4703) (lambda (V4704) (kl:shen.type-signature-of-hash V4702 V4703 V4704)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote head) (cons (cons (quote list) (cons (quote A) (quote ()))) (cons (quote -->) (cons (quote A) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-head) (lambda (V4712) (lambda (V4713) (lambda (V4714) (kl:shen.type-signature-of-head V4712 V4713 V4714)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote hdv) (cons (cons (quote vector) (cons (quote A) (quote ()))) (cons (quote -->) (cons (quote A) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-hdv) (lambda (V4722) (lambda (V4723) (lambda (V4724) (kl:shen.type-signature-of-hdv V4722 V4723 V4724)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote hdstr) (cons (quote string) (cons (quote -->) (cons (quote string) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-hdstr) (lambda (V4732) (lambda (V4733) (lambda (V4734) (kl:shen.type-signature-of-hdstr V4732 V4733 V4734)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote if) (cons (quote boolean) (cons (quote -->) (cons (cons (quote A) (cons (quote -->) (cons (cons (quote A) (cons (quote -->) (cons (quote A) (quote ())))) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-if) (lambda (V4742) (lambda (V4743) (lambda (V4744) (kl:shen.type-signature-of-if V4742 V4743 V4744)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote it) (cons (quote -->) (cons (quote string) (quote ())))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-it) (lambda (V4752) (lambda (V4753) (lambda (V4754) (kl:shen.type-signature-of-it V4752 V4753 V4754)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote implementation) (cons (quote -->) (cons (quote string) (quote ())))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-implementation) (lambda (V4762) (lambda (V4763) (lambda (V4764) (kl:shen.type-signature-of-implementation V4762 V4763 V4764)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote include) (cons (cons (quote list) (cons (quote symbol) (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons (quote symbol) (quote ()))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-include) (lambda (V4772) (lambda (V4773) (lambda (V4774) (kl:shen.type-signature-of-include V4772 V4773 V4774)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote include-all-but) (cons (cons (quote list) (cons (quote symbol) (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons (quote symbol) (quote ()))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-include-all-but) (lambda (V4782) (lambda (V4783) (lambda (V4784) (kl:shen.type-signature-of-include-all-but V4782 V4783 V4784)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote inferences) (cons (quote -->) (cons (quote number) (quote ())))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-inferences) (lambda (V4792) (lambda (V4793) (lambda (V4794) (kl:shen.type-signature-of-inferences V4792 V4793 V4794)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote shen.insert) (cons (quote A) (cons (quote -->) (cons (cons (quote string) (cons (quote -->) (cons (quote string) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-shen.insert) (lambda (V4802) (lambda (V4803) (lambda (V4804) (kl:shen.type-signature-of-shen.insert V4802 V4803 V4804)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote integer?) (cons (quote A) (cons (quote -->) (cons (quote boolean) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-integer?) (lambda (V4812) (lambda (V4813) (lambda (V4814) (kl:shen.type-signature-of-integer? V4812 V4813 V4814)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote internal) (cons (quote symbol) (cons (quote -->) (cons (cons (quote list) (cons (quote symbol) (quote ()))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-internal) (lambda (V4822) (lambda (V4823) (lambda (V4824) (kl:shen.type-signature-of-internal V4822 V4823 V4824)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote intersection) (cons (cons (quote list) (cons (quote A) (quote ()))) (cons (quote -->) (cons (cons (cons (quote list) (cons (quote A) (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons (quote A) (quote ()))) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-intersection) (lambda (V4832) (lambda (V4833) (lambda (V4834) (kl:shen.type-signature-of-intersection V4832 V4833 V4834)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote kill) (cons (quote -->) (cons (quote A) (quote ())))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-kill) (lambda (V4842) (lambda (V4843) (lambda (V4844) (kl:shen.type-signature-of-kill V4842 V4843 V4844)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote language) (cons (quote -->) (cons (quote string) (quote ())))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-language) (lambda (V4852) (lambda (V4853) (lambda (V4854) (kl:shen.type-signature-of-language V4852 V4853 V4854)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote length) (cons (cons (quote list) (cons (quote A) (quote ()))) (cons (quote -->) (cons (quote number) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-length) (lambda (V4862) (lambda (V4863) (lambda (V4864) (kl:shen.type-signature-of-length V4862 V4863 V4864)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote limit) (cons (cons (quote vector) (cons (quote A) (quote ()))) (cons (quote -->) (cons (quote number) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-limit) (lambda (V4872) (lambda (V4873) (lambda (V4874) (kl:shen.type-signature-of-limit V4872 V4873 V4874)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote load) (cons (quote string) (cons (quote -->) (cons (quote symbol) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-load) (lambda (V4882) (lambda (V4883) (lambda (V4884) (kl:shen.type-signature-of-load V4882 V4883 V4884)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote map) (cons (cons (quote A) (cons (quote -->) (cons (quote B) (quote ())))) (cons (quote -->) (cons (cons (cons (quote list) (cons (quote A) (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons (quote B) (quote ()))) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-map) (lambda (V4892) (lambda (V4893) (lambda (V4894) (kl:shen.type-signature-of-map V4892 V4893 V4894)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote mapcan) (cons (cons (quote A) (cons (quote -->) (cons (cons (quote list) (cons (quote B) (quote ()))) (quote ())))) (cons (quote -->) (cons (cons (cons (quote list) (cons (quote A) (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons (quote B) (quote ()))) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-mapcan) (lambda (V4902) (lambda (V4903) (lambda (V4904) (kl:shen.type-signature-of-mapcan V4902 V4903 V4904)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote maxinferences) (cons (quote number) (cons (quote -->) (cons (quote number) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-maxinferences) (lambda (V4912) (lambda (V4913) (lambda (V4914) (kl:shen.type-signature-of-maxinferences V4912 V4913 V4914)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote n->string) (cons (quote number) (cons (quote -->) (cons (quote string) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-n->string) (lambda (V4922) (lambda (V4923) (lambda (V4924) (kl:shen.type-signature-of-n->string V4922 V4923 V4924)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote nl) (cons (quote number) (cons (quote -->) (cons (quote number) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-nl) (lambda (V4932) (lambda (V4933) (lambda (V4934) (kl:shen.type-signature-of-nl V4932 V4933 V4934)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote not) (cons (quote boolean) (cons (quote -->) (cons (quote boolean) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-not) (lambda (V4942) (lambda (V4943) (lambda (V4944) (kl:shen.type-signature-of-not V4942 V4943 V4944)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote nth) (cons (quote number) (cons (quote -->) (cons (cons (cons (quote list) (cons (quote A) (quote ()))) (cons (quote -->) (cons (quote A) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-nth) (lambda (V4952) (lambda (V4953) (lambda (V4954) (kl:shen.type-signature-of-nth V4952 V4953 V4954)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote number?) (cons (quote A) (cons (quote -->) (cons (quote boolean) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-number?) (lambda (V4962) (lambda (V4963) (lambda (V4964) (kl:shen.type-signature-of-number? V4962 V4963 V4964)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote occurrences) (cons (quote A) (cons (quote -->) (cons (cons (quote B) (cons (quote -->) (cons (quote number) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-occurrences) (lambda (V4972) (lambda (V4973) (lambda (V4974) (kl:shen.type-signature-of-occurrences V4972 V4973 V4974)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote occurs-check) (cons (quote symbol) (cons (quote -->) (cons (quote boolean) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-occurs-check) (lambda (V4982) (lambda (V4983) (lambda (V4984) (kl:shen.type-signature-of-occurs-check V4982 V4983 V4984)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote optimise) (cons (quote symbol) (cons (quote -->) (cons (quote boolean) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-optimise) (lambda (V4992) (lambda (V4993) (lambda (V4994) (kl:shen.type-signature-of-optimise V4992 V4993 V4994)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote or) (cons (quote boolean) (cons (quote -->) (cons (cons (quote boolean) (cons (quote -->) (cons (quote boolean) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-or) (lambda (V5002) (lambda (V5003) (lambda (V5004) (kl:shen.type-signature-of-or V5002 V5003 V5004)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote os) (cons (quote -->) (cons (quote string) (quote ())))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-os) (lambda (V5012) (lambda (V5013) (lambda (V5014) (kl:shen.type-signature-of-os V5012 V5013 V5014)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote package?) (cons (quote symbol) (cons (quote -->) (cons (quote boolean) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-package?) (lambda (V5022) (lambda (V5023) (lambda (V5024) (kl:shen.type-signature-of-package? V5022 V5023 V5024)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote port) (cons (quote -->) (cons (quote string) (quote ())))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-port) (lambda (V5032) (lambda (V5033) (lambda (V5034) (kl:shen.type-signature-of-port V5032 V5033 V5034)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote porters) (cons (quote -->) (cons (quote string) (quote ())))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-porters) (lambda (V5042) (lambda (V5043) (lambda (V5044) (kl:shen.type-signature-of-porters V5042 V5043 V5044)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote pos) (cons (quote string) (cons (quote -->) (cons (cons (quote number) (cons (quote -->) (cons (quote string) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-pos) (lambda (V5052) (lambda (V5053) (lambda (V5054) (kl:shen.type-signature-of-pos V5052 V5053 V5054)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote pr) (cons (quote string) (cons (quote -->) (cons (cons (cons (quote stream) (cons (quote out) (quote ()))) (cons (quote -->) (cons (quote string) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-pr) (lambda (V5062) (lambda (V5063) (lambda (V5064) (kl:shen.type-signature-of-pr V5062 V5063 V5064)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote print) (cons (quote A) (cons (quote -->) (cons (quote A) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-print) (lambda (V5072) (lambda (V5073) (lambda (V5074) (kl:shen.type-signature-of-print V5072 V5073 V5074)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote profile) (cons (cons (quote A) (cons (quote -->) (cons (quote B) (quote ())))) (cons (quote -->) (cons (cons (quote A) (cons (quote -->) (cons (quote B) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-profile) (lambda (V5082) (lambda (V5083) (lambda (V5084) (kl:shen.type-signature-of-profile V5082 V5083 V5084)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote preclude) (cons (cons (quote list) (cons (quote symbol) (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons (quote symbol) (quote ()))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-preclude) (lambda (V5092) (lambda (V5093) (lambda (V5094) (kl:shen.type-signature-of-preclude V5092 V5093 V5094)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote shen.proc-nl) (cons (quote string) (cons (quote -->) (cons (quote string) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-shen.proc-nl) (lambda (V5102) (lambda (V5103) (lambda (V5104) (kl:shen.type-signature-of-shen.proc-nl V5102 V5103 V5104)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote profile-results) (cons (cons (quote A) (cons (quote -->) (cons (quote B) (quote ())))) (cons (quote -->) (cons (cons (cons (quote A) (cons (quote -->) (cons (quote B) (quote ())))) (cons (quote *) (cons (quote number) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-profile-results) (lambda (V5112) (lambda (V5113) (lambda (V5114) (kl:shen.type-signature-of-profile-results V5112 V5113 V5114)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote protect) (cons (quote symbol) (cons (quote -->) (cons (quote symbol) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-protect) (lambda (V5122) (lambda (V5123) (lambda (V5124) (kl:shen.type-signature-of-protect V5122 V5123 V5124)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote preclude-all-but) (cons (cons (quote list) (cons (quote symbol) (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons (quote symbol) (quote ()))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-preclude-all-but) (lambda (V5132) (lambda (V5133) (lambda (V5134) (kl:shen.type-signature-of-preclude-all-but V5132 V5133 V5134)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote shen.prhush) (cons (quote string) (cons (quote -->) (cons (cons (cons (quote stream) (cons (quote out) (quote ()))) (cons (quote -->) (cons (quote string) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-shen.prhush) (lambda (V5142) (lambda (V5143) (lambda (V5144) (kl:shen.type-signature-of-shen.prhush V5142 V5143 V5144)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote ps) (cons (quote symbol) (cons (quote -->) (cons (cons (quote list) (cons (quote unit) (quote ()))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-ps) (lambda (V5152) (lambda (V5153) (lambda (V5154) (kl:shen.type-signature-of-ps V5152 V5153 V5154)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote read) (cons (cons (quote stream) (cons (quote in) (quote ()))) (cons (quote -->) (cons (quote unit) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-read) (lambda (V5162) (lambda (V5163) (lambda (V5164) (kl:shen.type-signature-of-read V5162 V5163 V5164)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote read-byte) (cons (cons (quote stream) (cons (quote in) (quote ()))) (cons (quote -->) (cons (quote number) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-read-byte) (lambda (V5172) (lambda (V5173) (lambda (V5174) (kl:shen.type-signature-of-read-byte V5172 V5173 V5174)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote read-file-as-bytelist) (cons (quote string) (cons (quote -->) (cons (cons (quote list) (cons (quote number) (quote ()))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-read-file-as-bytelist) (lambda (V5182) (lambda (V5183) (lambda (V5184) (kl:shen.type-signature-of-read-file-as-bytelist V5182 V5183 V5184)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote read-file-as-string) (cons (quote string) (cons (quote -->) (cons (quote string) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-read-file-as-string) (lambda (V5192) (lambda (V5193) (lambda (V5194) (kl:shen.type-signature-of-read-file-as-string V5192 V5193 V5194)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote read-file) (cons (quote string) (cons (quote -->) (cons (cons (quote list) (cons (quote unit) (quote ()))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-read-file) (lambda (V5202) (lambda (V5203) (lambda (V5204) (kl:shen.type-signature-of-read-file V5202 V5203 V5204)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote read-from-string) (cons (quote string) (cons (quote -->) (cons (cons (quote list) (cons (quote unit) (quote ()))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-read-from-string) (lambda (V5212) (lambda (V5213) (lambda (V5214) (kl:shen.type-signature-of-read-from-string V5212 V5213 V5214)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote release) (cons (quote -->) (cons (quote string) (quote ())))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-release) (lambda (V5222) (lambda (V5223) (lambda (V5224) (kl:shen.type-signature-of-release V5222 V5223 V5224)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote remove) (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:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-remove) (lambda (V5232) (lambda (V5233) (lambda (V5234) (kl:shen.type-signature-of-remove V5232 V5233 V5234)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote reverse) (cons (cons (quote list) (cons (quote A) (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons (quote A) (quote ()))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-reverse) (lambda (V5242) (lambda (V5243) (lambda (V5244) (kl:shen.type-signature-of-reverse V5242 V5243 V5244)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote simple-error) (cons (quote string) (cons (quote -->) (cons (quote A) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-simple-error) (lambda (V5252) (lambda (V5253) (lambda (V5254) (kl:shen.type-signature-of-simple-error V5252 V5253 V5254)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote snd) (cons (cons (quote A) (cons (quote *) (cons (quote B) (quote ())))) (cons (quote -->) (cons (quote B) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-snd) (lambda (V5262) (lambda (V5263) (lambda (V5264) (kl:shen.type-signature-of-snd V5262 V5263 V5264)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote specialise) (cons (quote symbol) (cons (quote -->) (cons (quote symbol) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-specialise) (lambda (V5272) (lambda (V5273) (lambda (V5274) (kl:shen.type-signature-of-specialise V5272 V5273 V5274)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote spy) (cons (quote symbol) (cons (quote -->) (cons (quote boolean) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-spy) (lambda (V5282) (lambda (V5283) (lambda (V5284) (kl:shen.type-signature-of-spy V5282 V5283 V5284)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote step) (cons (quote symbol) (cons (quote -->) (cons (quote boolean) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-step) (lambda (V5292) (lambda (V5293) (lambda (V5294) (kl:shen.type-signature-of-step V5292 V5293 V5294)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote stinput) (cons (quote -->) (cons (cons (quote stream) (cons (quote in) (quote ()))) (quote ())))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-stinput) (lambda (V5302) (lambda (V5303) (lambda (V5304) (kl:shen.type-signature-of-stinput V5302 V5303 V5304)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote sterror) (cons (quote -->) (cons (cons (quote stream) (cons (quote out) (quote ()))) (quote ())))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-sterror) (lambda (V5312) (lambda (V5313) (lambda (V5314) (kl:shen.type-signature-of-sterror V5312 V5313 V5314)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote stoutput) (cons (quote -->) (cons (cons (quote stream) (cons (quote out) (quote ()))) (quote ())))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-stoutput) (lambda (V5322) (lambda (V5323) (lambda (V5324) (kl:shen.type-signature-of-stoutput V5322 V5323 V5324)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote string?) (cons (quote A) (cons (quote -->) (cons (quote boolean) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-string?) (lambda (V5332) (lambda (V5333) (lambda (V5334) (kl:shen.type-signature-of-string? V5332 V5333 V5334)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote str) (cons (quote A) (cons (quote -->) (cons (quote string) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-str) (lambda (V5342) (lambda (V5343) (lambda (V5344) (kl:shen.type-signature-of-str V5342 V5343 V5344)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote string->n) (cons (quote string) (cons (quote -->) (cons (quote number) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-string->n) (lambda (V5352) (lambda (V5353) (lambda (V5354) (kl:shen.type-signature-of-string->n V5352 V5353 V5354)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote string->symbol) (cons (quote string) (cons (quote -->) (cons (quote symbol) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-string->symbol) (lambda (V5362) (lambda (V5363) (lambda (V5364) (kl:shen.type-signature-of-string->symbol V5362 V5363 V5364)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote sum) (cons (cons (quote list) (cons (quote number) (quote ()))) (cons (quote -->) (cons (quote number) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-sum) (lambda (V5372) (lambda (V5373) (lambda (V5374) (kl:shen.type-signature-of-sum V5372 V5373 V5374)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote symbol?) (cons (quote A) (cons (quote -->) (cons (quote boolean) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-symbol?) (lambda (V5382) (lambda (V5383) (lambda (V5384) (kl:shen.type-signature-of-symbol? V5382 V5383 V5384)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote systemf) (cons (quote symbol) (cons (quote -->) (cons (quote symbol) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-systemf) (lambda (V5392) (lambda (V5393) (lambda (V5394) (kl:shen.type-signature-of-systemf V5392 V5393 V5394)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote tail) (cons (cons (quote list) (cons (quote A) (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons (quote A) (quote ()))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-tail) (lambda (V5402) (lambda (V5403) (lambda (V5404) (kl:shen.type-signature-of-tail V5402 V5403 V5404)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote tlstr) (cons (quote string) (cons (quote -->) (cons (quote string) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-tlstr) (lambda (V5412) (lambda (V5413) (lambda (V5414) (kl:shen.type-signature-of-tlstr V5412 V5413 V5414)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote tlv) (cons (cons (quote vector) (cons (quote A) (quote ()))) (cons (quote -->) (cons (cons (quote vector) (cons (quote A) (quote ()))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-tlv) (lambda (V5422) (lambda (V5423) (lambda (V5424) (kl:shen.type-signature-of-tlv V5422 V5423 V5424)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote tc) (cons (quote symbol) (cons (quote -->) (cons (quote boolean) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-tc) (lambda (V5432) (lambda (V5433) (lambda (V5434) (kl:shen.type-signature-of-tc V5432 V5433 V5434)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote tc?) (cons (quote -->) (cons (quote boolean) (quote ())))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-tc?) (lambda (V5442) (lambda (V5443) (lambda (V5444) (kl:shen.type-signature-of-tc? V5442 V5443 V5444)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote thaw) (cons (cons (quote lazy) (cons (quote A) (quote ()))) (cons (quote -->) (cons (quote A) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-thaw) (lambda (V5452) (lambda (V5453) (lambda (V5454) (kl:shen.type-signature-of-thaw V5452 V5453 V5454)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote track) (cons (quote symbol) (cons (quote -->) (cons (quote symbol) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-track) (lambda (V5462) (lambda (V5463) (lambda (V5464) (kl:shen.type-signature-of-track V5462 V5463 V5464)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote trap-error) (cons (quote A) (cons (quote -->) (cons (cons (cons (quote exception) (cons (quote -->) (cons (quote A) (quote ())))) (cons (quote -->) (cons (quote A) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-trap-error) (lambda (V5472) (lambda (V5473) (lambda (V5474) (kl:shen.type-signature-of-trap-error V5472 V5473 V5474)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote tuple?) (cons (quote A) (cons (quote -->) (cons (quote boolean) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-tuple?) (lambda (V5482) (lambda (V5483) (lambda (V5484) (kl:shen.type-signature-of-tuple? V5482 V5483 V5484)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote undefmacro) (cons (quote symbol) (cons (quote -->) (cons (quote symbol) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-undefmacro) (lambda (V5492) (lambda (V5493) (lambda (V5494) (kl:shen.type-signature-of-undefmacro V5492 V5493 V5494)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote union) (cons (cons (quote list) (cons (quote A) (quote ()))) (cons (quote -->) (cons (cons (cons (quote list) (cons (quote A) (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons (quote A) (quote ()))) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-union) (lambda (V5502) (lambda (V5503) (lambda (V5504) (kl:shen.type-signature-of-union V5502 V5503 V5504)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote unprofile) (cons (cons (quote A) (cons (quote -->) (cons (quote B) (quote ())))) (cons (quote -->) (cons (cons (quote A) (cons (quote -->) (cons (quote B) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-unprofile) (lambda (V5512) (lambda (V5513) (lambda (V5514) (kl:shen.type-signature-of-unprofile V5512 V5513 V5514)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote untrack) (cons (quote symbol) (cons (quote -->) (cons (quote symbol) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-untrack) (lambda (V5522) (lambda (V5523) (lambda (V5524) (kl:shen.type-signature-of-untrack V5522 V5523 V5524)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote unspecialise) (cons (quote symbol) (cons (quote -->) (cons (quote symbol) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-unspecialise) (lambda (V5532) (lambda (V5533) (lambda (V5534) (kl:shen.type-signature-of-unspecialise V5532 V5533 V5534)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote variable?) (cons (quote A) (cons (quote -->) (cons (quote boolean) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-variable?) (lambda (V5542) (lambda (V5543) (lambda (V5544) (kl:shen.type-signature-of-variable? V5542 V5543 V5544)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote vector?) (cons (quote A) (cons (quote -->) (cons (quote boolean) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-vector?) (lambda (V5552) (lambda (V5553) (lambda (V5554) (kl:shen.type-signature-of-vector? V5552 V5553 V5554)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote version) (cons (quote -->) (cons (quote string) (quote ())))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-version) (lambda (V5562) (lambda (V5563) (lambda (V5564) (kl:shen.type-signature-of-version V5562 V5563 V5564)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote write-to-file) (cons (quote string) (cons (quote -->) (cons (cons (quote A) (cons (quote -->) (cons (quote A) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-write-to-file) (lambda (V5572) (lambda (V5573) (lambda (V5574) (kl:shen.type-signature-of-write-to-file V5572 V5573 V5574)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote write-byte) (cons (quote number) (cons (quote -->) (cons (cons (cons (quote stream) (cons (quote out) (quote ()))) (cons (quote -->) (cons (quote number) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-write-byte) (lambda (V5582) (lambda (V5583) (lambda (V5584) (kl:shen.type-signature-of-write-byte V5582 V5583 V5584)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote y-or-n?) (cons (quote string) (cons (quote -->) (cons (quote boolean) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-y-or-n?) (lambda (V5592) (lambda (V5593) (lambda (V5594) (kl:shen.type-signature-of-y-or-n? V5592 V5593 V5594)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote >) (cons (quote number) (cons (quote -->) (cons (cons (quote number) (cons (quote -->) (cons (quote boolean) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of->) (lambda (V5602) (lambda (V5603) (lambda (V5604) (kl:shen.type-signature-of-> V5602 V5603 V5604)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote <) (cons (quote number) (cons (quote -->) (cons (cons (quote number) (cons (quote -->) (cons (quote boolean) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-<) (lambda (V5612) (lambda (V5613) (lambda (V5614) (kl:shen.type-signature-of-< V5612 V5613 V5614)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote >=) (cons (quote number) (cons (quote -->) (cons (cons (quote number) (cons (quote -->) (cons (quote boolean) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of->=) (lambda (V5622) (lambda (V5623) (lambda (V5624) (kl:shen.type-signature-of->= V5622 V5623 V5624)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote <=) (cons (quote number) (cons (quote -->) (cons (cons (quote number) (cons (quote -->) (cons (quote boolean) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-<=) (lambda (V5632) (lambda (V5633) (lambda (V5634) (kl:shen.type-signature-of-<= V5632 V5633 V5634)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote =) (cons (quote A) (cons (quote -->) (cons (cons (quote A) (cons (quote -->) (cons (quote boolean) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-=) (lambda (V5642) (lambda (V5643) (lambda (V5644) (kl:shen.type-signature-of-= V5642 V5643 V5644)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote +) (cons (quote number) (cons (quote -->) (cons (cons (quote number) (cons (quote -->) (cons (quote number) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-+) (lambda (V5652) (lambda (V5653) (lambda (V5654) (kl:shen.type-signature-of-+ V5652 V5653 V5654)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote /) (cons (quote number) (cons (quote -->) (cons (cons (quote number) (cons (quote -->) (cons (quote number) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-/) (lambda (V5662) (lambda (V5663) (lambda (V5664) (kl:shen.type-signature-of-/ V5662 V5663 V5664)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote -) (cons (quote number) (cons (quote -->) (cons (cons (quote number) (cons (quote -->) (cons (quote number) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of--) (lambda (V5672) (lambda (V5673) (lambda (V5674) (kl:shen.type-signature-of-- V5672 V5673 V5674)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote *) (cons (quote number) (cons (quote -->) (cons (cons (quote number) (cons (quote -->) (cons (quote number) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-*) (lambda (V5682) (lambda (V5683) (lambda (V5684) (kl:shen.type-signature-of-* V5682 V5683 V5684)))))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote ==) (cons (quote A) (cons (quote -->) (cons (cons (quote B) (cons (quote -->) (cons (quote boolean) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-==) (lambda (V5692) (lambda (V5693) (lambda (V5694) (kl:shen.type-signature-of-== V5692 V5693 V5694)))))) (kl:set (quote shen.*empty-absvector*) (make-vector 0 (quote (quote shen.fail!))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) (export shen.initialise) (quote shen.initialise)) +(begin (register-function-arity (quote shen.initialise-environment) 0) (define (kl:shen.initialise-environment) (begin (kl:set (quote shen.*installing-kl*) #f) (begin (kl:set (quote shen.*history*) (quote ())) (begin (kl:set (quote shen.*tc*) #f) (begin (kl:set (quote *property-vector*) (kl:shen.dict 20000)) (begin (kl:set (quote shen.*process-counter*) 0) (begin (kl:set (quote shen.*varcounter*) (kl:vector 10000)) (begin (kl:set (quote shen.*prologvectors*) (kl:vector 10000)) (begin (kl:set (quote shen.*demodulation-function*) (lambda (X) X)) (begin (kl:set (quote shen.*custom-pattern-compiler*) (lambda (Arg) (lambda (OnFail) (kl:thaw OnFail)))) (begin (kl:set (quote shen.*custom-pattern-reducer*) (lambda (Arg) Arg)) (begin (kl:set (quote shen.*macroreg*) (cons (quote shen.timer-macro) (cons (quote shen.cases-macro) (cons (quote shen.abs-macro) (cons (quote shen.put/get-macro) (cons (quote shen.compile-macro) (cons (quote shen.datatype-macro) (cons (quote shen.let-macro) (cons (quote shen.assoc-macro) (cons (quote shen.make-string-macro) (cons (quote shen.output-macro) (cons (quote shen.input-macro) (cons (quote shen.error-macro) (cons (quote shen.prolog-macro) (cons (quote shen.synonyms-macro) (cons (quote shen.nl-macro) (cons (quote shen._waspvm_at_s-macro) (cons (quote shen.defprolog-macro) (cons (quote shen.function-macro) (quote ())))))))))))))))))))) (begin (kl:set (quote *macros*) (cons (lambda (X) (kl:shen.timer-macro X)) (cons (lambda (X) (kl:shen.cases-macro X)) (cons (lambda (X) (kl:shen.abs-macro X)) (cons (lambda (X) (kl:shen.put/get-macro X)) (cons (lambda (X) (kl:shen.compile-macro X)) (cons (lambda (X) (kl:shen.datatype-macro X)) (cons (lambda (X) (kl:shen.let-macro X)) (cons (lambda (X) (kl:shen.assoc-macro X)) (cons (lambda (X) (kl:shen.make-string-macro X)) (cons (lambda (X) (kl:shen.output-macro X)) (cons (lambda (X) (kl:shen.input-macro X)) (cons (lambda (X) (kl:shen.error-macro X)) (cons (lambda (X) (kl:shen.prolog-macro X)) (cons (lambda (X) (kl:shen.synonyms-macro X)) (cons (lambda (X) (kl:shen.nl-macro X)) (cons (lambda (X) (kl:shen._waspvm_at_s-macro X)) (cons (lambda (X) (kl:shen.defprolog-macro X)) (cons (lambda (X) (kl:shen.function-macro X)) (quote ())))))))))))))))))))) (begin (kl:set (quote shen.*gensym*) 0) (begin (kl:set (quote shen.*tracking*) (quote ())) (begin (kl:set (quote shen.*alphabet*) (cons (quote A) (cons (quote B) (cons (quote C) (cons (quote D) (cons (quote E) (cons (quote F) (cons (quote G) (cons (quote H) (cons (quote I) (cons (quote J) (cons (quote K) (cons (quote L) (cons (quote M) (cons (quote N) (cons (quote O) (cons (quote P) (cons (quote Q) (cons (quote R) (cons (quote S) (cons (quote T) (cons (quote U) (cons (quote V) (cons (quote W) (cons (quote X) (cons (quote Y) (cons (quote Z) (quote ())))))))))))))))))))))))))))) (begin (kl:set (quote shen.*special*) (cons (quote _waspvm_at_p) (cons (quote _waspvm_at_s) (cons (quote _waspvm_at_v) (cons (quote cons) (cons (quote lambda) (cons (quote let) (cons (quote where) (cons (quote set) (cons (quote open) (quote ()))))))))))) (begin (kl:set (quote shen.*extraspecial*) (cons (quote define) (cons (quote shen.process-datatype) (cons (quote input+) (cons (quote defcc) (cons (quote shen.read+) (cons (quote defmacro) (quote ())))))))) (begin (kl:set (quote shen.*spy*) #f) (begin (kl:set (quote shen.*datatypes*) (quote ())) (begin (kl:set (quote shen.*alldatatypes*) (quote ())) (begin (kl:set (quote shen.*shen-type-theory-enabled?*) #t) (begin (kl:set (quote shen.*synonyms*) (quote ())) (begin (kl:set (quote shen.*system*) (quote ())) (begin (kl:set (quote shen.*maxcomplexity*) 128) (begin (kl:set (quote shen.*occurs*) #t) (begin (kl:set (quote shen.*maxinferences*) 1000000) (begin (kl:set (quote *maximum-print-sequence-size*) 20) (begin (kl:set (quote shen.*catch*) 0) (begin (kl:set (quote shen.*call*) 0) (begin (kl:set (quote shen.*infs*) 0) (begin (kl:set (quote *hush*) #f) (begin (kl:set (quote shen.*optimise*) #f) (begin (kl:set (quote *version*) "Shen 22.4") (begin (if (kl:not (kl:bound? (quote *home-directory*))) (kl:set (quote *home-directory*) "") (quote shen.skip)) (begin (if (kl:not (kl:bound? (quote *sterror*))) (kl:set (quote *sterror*) (kl:value (quote *stoutput*))) (quote shen.skip)) (begin (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 (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 (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 (kl:set (quote shen.*history*) (quote ())) (begin (kl:set (quote shen.*step*) #f) (kl:set (quote shen.*empty-absvector*) (make-vector 0 (quote (quote shen.fail!)))))))))))))))))))))))))))))))))))))))))))) (export shen.initialise-environment) (quote shen.initialise-environment)) +(begin (register-function-arity (quote shen.initialise-signedfuncs) 0) (define (kl:shen.initialise-signedfuncs) (begin (kl:set (quote shen.*signedfuncs*) (quote ())) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote absvector?) (cons (quote A) (cons (quote -->) (cons (quote boolean) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (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:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote and) (cons (quote boolean) (cons (quote -->) (cons (cons (quote boolean) (cons (quote -->) (cons (quote boolean) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote shen.app) (cons (quote A) (cons (quote -->) (cons (cons (quote string) (cons (quote -->) (cons (cons (quote symbol) (cons (quote -->) (cons (quote string) (quote ())))) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote append) (cons (cons (quote list) (cons (quote A) (quote ()))) (cons (quote -->) (cons (cons (cons (quote list) (cons (quote A) (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons (quote A) (quote ()))) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote arity) (cons (quote A) (cons (quote -->) (cons (quote number) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote assoc) (cons (quote A) (cons (quote -->) (cons (cons (cons (quote list) (cons (cons (quote list) (cons (quote A) (quote ()))) (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons (quote A) (quote ()))) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote boolean?) (cons (quote A) (cons (quote -->) (cons (quote boolean) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote bound?) (cons (quote symbol) (cons (quote -->) (cons (quote boolean) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote cd) (cons (quote string) (cons (quote -->) (cons (quote string) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote close) (cons (cons (quote stream) (cons (quote A) (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons (quote B) (quote ()))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote cn) (cons (quote string) (cons (quote -->) (cons (cons (quote string) (cons (quote -->) (cons (quote string) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote compile) (cons (cons (quote A) (cons (quote shen.==>) (cons (quote B) (quote ())))) (cons (quote -->) (cons (cons (quote A) (cons (quote -->) (cons (cons (cons (quote A) (cons (quote -->) (cons (quote B) (quote ())))) (cons (quote -->) (cons (quote B) (quote ())))) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote cons?) (cons (quote A) (cons (quote -->) (cons (quote boolean) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote destroy) (cons (cons (quote A) (cons (quote -->) (cons (quote B) (quote ())))) (cons (quote -->) (cons (quote symbol) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote difference) (cons (cons (quote list) (cons (quote A) (quote ()))) (cons (quote -->) (cons (cons (cons (quote list) (cons (quote A) (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons (quote A) (quote ()))) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote do) (cons (quote A) (cons (quote -->) (cons (cons (quote B) (cons (quote -->) (cons (quote B) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote ) (cons (cons (quote list) (cons (quote A) (quote ()))) (cons (quote shen.==>) (cons (cons (quote list) (cons (quote B) (quote ()))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote ) (cons (cons (quote list) (cons (quote A) (quote ()))) (cons (quote shen.==>) (cons (cons (quote list) (cons (quote A) (quote ()))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote element?) (cons (quote A) (cons (quote -->) (cons (cons (cons (quote list) (cons (quote A) (quote ()))) (cons (quote -->) (cons (quote boolean) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote empty?) (cons (quote A) (cons (quote -->) (cons (quote boolean) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote enable-type-theory) (cons (quote symbol) (cons (quote -->) (cons (quote boolean) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote external) (cons (quote symbol) (cons (quote -->) (cons (cons (quote list) (cons (quote symbol) (quote ()))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote error-to-string) (cons (quote exception) (cons (quote -->) (cons (quote string) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote explode) (cons (quote A) (cons (quote -->) (cons (cons (quote list) (cons (quote string) (quote ()))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote fail) (cons (quote -->) (cons (quote symbol) (quote ())))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote fail-if) (cons (cons (quote symbol) (cons (quote -->) (cons (quote boolean) (quote ())))) (cons (quote -->) (cons (cons (quote symbol) (cons (quote -->) (cons (quote symbol) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote fix) (cons (cons (quote A) (cons (quote -->) (cons (quote A) (quote ())))) (cons (quote -->) (cons (cons (quote A) (cons (quote -->) (cons (quote A) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote freeze) (cons (quote A) (cons (quote -->) (cons (cons (quote lazy) (cons (quote A) (quote ()))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote fst) (cons (cons (quote A) (cons (quote *) (cons (quote B) (quote ())))) (cons (quote -->) (cons (quote A) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote function) (cons (cons (quote A) (cons (quote -->) (cons (quote B) (quote ())))) (cons (quote -->) (cons (cons (quote A) (cons (quote -->) (cons (quote B) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote gensym) (cons (quote symbol) (cons (quote -->) (cons (quote symbol) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote <-vector) (cons (cons (quote vector) (cons (quote A) (quote ()))) (cons (quote -->) (cons (cons (quote number) (cons (quote -->) (cons (quote A) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote vector->) (cons (cons (quote vector) (cons (quote A) (quote ()))) (cons (quote -->) (cons (cons (quote number) (cons (quote -->) (cons (cons (quote A) (cons (quote -->) (cons (cons (quote vector) (cons (quote A) (quote ()))) (quote ())))) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote vector) (cons (quote number) (cons (quote -->) (cons (cons (quote vector) (cons (quote A) (quote ()))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote get-time) (cons (quote symbol) (cons (quote -->) (cons (quote number) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote hash) (cons (quote A) (cons (quote -->) (cons (cons (quote number) (cons (quote -->) (cons (quote number) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote head) (cons (cons (quote list) (cons (quote A) (quote ()))) (cons (quote -->) (cons (quote A) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote hdv) (cons (cons (quote vector) (cons (quote A) (quote ()))) (cons (quote -->) (cons (quote A) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote hdstr) (cons (quote string) (cons (quote -->) (cons (quote string) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote if) (cons (quote boolean) (cons (quote -->) (cons (cons (quote A) (cons (quote -->) (cons (cons (quote A) (cons (quote -->) (cons (quote A) (quote ())))) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote it) (cons (quote -->) (cons (quote string) (quote ())))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote implementation) (cons (quote -->) (cons (quote string) (quote ())))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote include) (cons (cons (quote list) (cons (quote symbol) (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons (quote symbol) (quote ()))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote include-all-but) (cons (cons (quote list) (cons (quote symbol) (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons (quote symbol) (quote ()))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote inferences) (cons (quote -->) (cons (quote number) (quote ())))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote shen.insert) (cons (quote A) (cons (quote -->) (cons (cons (quote string) (cons (quote -->) (cons (quote string) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote integer?) (cons (quote A) (cons (quote -->) (cons (quote boolean) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote internal) (cons (quote symbol) (cons (quote -->) (cons (cons (quote list) (cons (quote symbol) (quote ()))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote intersection) (cons (cons (quote list) (cons (quote A) (quote ()))) (cons (quote -->) (cons (cons (cons (quote list) (cons (quote A) (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons (quote A) (quote ()))) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote kill) (cons (quote -->) (cons (quote A) (quote ())))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote language) (cons (quote -->) (cons (quote string) (quote ())))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote length) (cons (cons (quote list) (cons (quote A) (quote ()))) (cons (quote -->) (cons (quote number) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote limit) (cons (cons (quote vector) (cons (quote A) (quote ()))) (cons (quote -->) (cons (quote number) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote load) (cons (quote string) (cons (quote -->) (cons (quote symbol) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote map) (cons (cons (quote A) (cons (quote -->) (cons (quote B) (quote ())))) (cons (quote -->) (cons (cons (cons (quote list) (cons (quote A) (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons (quote B) (quote ()))) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote mapcan) (cons (cons (quote A) (cons (quote -->) (cons (cons (quote list) (cons (quote B) (quote ()))) (quote ())))) (cons (quote -->) (cons (cons (cons (quote list) (cons (quote A) (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons (quote B) (quote ()))) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote maxinferences) (cons (quote number) (cons (quote -->) (cons (quote number) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote n->string) (cons (quote number) (cons (quote -->) (cons (quote string) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote nl) (cons (quote number) (cons (quote -->) (cons (quote number) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote not) (cons (quote boolean) (cons (quote -->) (cons (quote boolean) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote nth) (cons (quote number) (cons (quote -->) (cons (cons (cons (quote list) (cons (quote A) (quote ()))) (cons (quote -->) (cons (quote A) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote number?) (cons (quote A) (cons (quote -->) (cons (quote boolean) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote occurrences) (cons (quote A) (cons (quote -->) (cons (cons (quote B) (cons (quote -->) (cons (quote number) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote occurs-check) (cons (quote symbol) (cons (quote -->) (cons (quote boolean) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote optimise) (cons (quote symbol) (cons (quote -->) (cons (quote boolean) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote or) (cons (quote boolean) (cons (quote -->) (cons (cons (quote boolean) (cons (quote -->) (cons (quote boolean) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote os) (cons (quote -->) (cons (quote string) (quote ())))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote package?) (cons (quote symbol) (cons (quote -->) (cons (quote boolean) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote port) (cons (quote -->) (cons (quote string) (quote ())))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote porters) (cons (quote -->) (cons (quote string) (quote ())))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote pos) (cons (quote string) (cons (quote -->) (cons (cons (quote number) (cons (quote -->) (cons (quote string) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote pr) (cons (quote string) (cons (quote -->) (cons (cons (cons (quote stream) (cons (quote out) (quote ()))) (cons (quote -->) (cons (quote string) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote print) (cons (quote A) (cons (quote -->) (cons (quote A) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote profile) (cons (cons (quote A) (cons (quote -->) (cons (quote B) (quote ())))) (cons (quote -->) (cons (cons (quote A) (cons (quote -->) (cons (quote B) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote preclude) (cons (cons (quote list) (cons (quote symbol) (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons (quote symbol) (quote ()))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote shen.proc-nl) (cons (quote string) (cons (quote -->) (cons (quote string) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote profile-results) (cons (cons (quote A) (cons (quote -->) (cons (quote B) (quote ())))) (cons (quote -->) (cons (cons (cons (quote A) (cons (quote -->) (cons (quote B) (quote ())))) (cons (quote *) (cons (quote number) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote protect) (cons (quote symbol) (cons (quote -->) (cons (quote symbol) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote preclude-all-but) (cons (cons (quote list) (cons (quote symbol) (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons (quote symbol) (quote ()))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote shen.prhush) (cons (quote string) (cons (quote -->) (cons (cons (cons (quote stream) (cons (quote out) (quote ()))) (cons (quote -->) (cons (quote string) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote ps) (cons (quote symbol) (cons (quote -->) (cons (cons (quote list) (cons (quote unit) (quote ()))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote read) (cons (cons (quote stream) (cons (quote in) (quote ()))) (cons (quote -->) (cons (quote unit) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote read-byte) (cons (cons (quote stream) (cons (quote in) (quote ()))) (cons (quote -->) (cons (quote number) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote read-file-as-bytelist) (cons (quote string) (cons (quote -->) (cons (cons (quote list) (cons (quote number) (quote ()))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote read-file-as-string) (cons (quote string) (cons (quote -->) (cons (quote string) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote read-file) (cons (quote string) (cons (quote -->) (cons (cons (quote list) (cons (quote unit) (quote ()))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote read-from-string) (cons (quote string) (cons (quote -->) (cons (cons (quote list) (cons (quote unit) (quote ()))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote release) (cons (quote -->) (cons (quote string) (quote ())))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote remove) (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:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote reverse) (cons (cons (quote list) (cons (quote A) (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons (quote A) (quote ()))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote simple-error) (cons (quote string) (cons (quote -->) (cons (quote A) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote snd) (cons (cons (quote A) (cons (quote *) (cons (quote B) (quote ())))) (cons (quote -->) (cons (quote B) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote specialise) (cons (quote symbol) (cons (quote -->) (cons (quote symbol) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote spy) (cons (quote symbol) (cons (quote -->) (cons (quote boolean) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote step) (cons (quote symbol) (cons (quote -->) (cons (quote boolean) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote stinput) (cons (quote -->) (cons (cons (quote stream) (cons (quote in) (quote ()))) (quote ())))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote sterror) (cons (quote -->) (cons (cons (quote stream) (cons (quote out) (quote ()))) (quote ())))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote stoutput) (cons (quote -->) (cons (cons (quote stream) (cons (quote out) (quote ()))) (quote ())))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote string?) (cons (quote A) (cons (quote -->) (cons (quote boolean) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote str) (cons (quote A) (cons (quote -->) (cons (quote string) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote string->n) (cons (quote string) (cons (quote -->) (cons (quote number) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote string->symbol) (cons (quote string) (cons (quote -->) (cons (quote symbol) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote sum) (cons (cons (quote list) (cons (quote number) (quote ()))) (cons (quote -->) (cons (quote number) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote symbol?) (cons (quote A) (cons (quote -->) (cons (quote boolean) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote systemf) (cons (quote symbol) (cons (quote -->) (cons (quote symbol) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote tail) (cons (cons (quote list) (cons (quote A) (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons (quote A) (quote ()))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote tlstr) (cons (quote string) (cons (quote -->) (cons (quote string) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote tlv) (cons (cons (quote vector) (cons (quote A) (quote ()))) (cons (quote -->) (cons (cons (quote vector) (cons (quote A) (quote ()))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote tc) (cons (quote symbol) (cons (quote -->) (cons (quote boolean) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote tc?) (cons (quote -->) (cons (quote boolean) (quote ())))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote thaw) (cons (cons (quote lazy) (cons (quote A) (quote ()))) (cons (quote -->) (cons (quote A) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote track) (cons (quote symbol) (cons (quote -->) (cons (quote symbol) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote trap-error) (cons (quote A) (cons (quote -->) (cons (cons (cons (quote exception) (cons (quote -->) (cons (quote A) (quote ())))) (cons (quote -->) (cons (quote A) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote tuple?) (cons (quote A) (cons (quote -->) (cons (quote boolean) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote undefmacro) (cons (quote symbol) (cons (quote -->) (cons (quote symbol) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote union) (cons (cons (quote list) (cons (quote A) (quote ()))) (cons (quote -->) (cons (cons (cons (quote list) (cons (quote A) (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons (quote A) (quote ()))) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote unprofile) (cons (cons (quote A) (cons (quote -->) (cons (quote B) (quote ())))) (cons (quote -->) (cons (cons (quote A) (cons (quote -->) (cons (quote B) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote untrack) (cons (quote symbol) (cons (quote -->) (cons (quote symbol) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote unspecialise) (cons (quote symbol) (cons (quote -->) (cons (quote symbol) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote variable?) (cons (quote A) (cons (quote -->) (cons (quote boolean) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote vector?) (cons (quote A) (cons (quote -->) (cons (quote boolean) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote version) (cons (quote -->) (cons (quote string) (quote ())))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote write-to-file) (cons (quote string) (cons (quote -->) (cons (cons (quote A) (cons (quote -->) (cons (quote A) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote write-byte) (cons (quote number) (cons (quote -->) (cons (cons (cons (quote stream) (cons (quote out) (quote ()))) (cons (quote -->) (cons (quote number) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote y-or-n?) (cons (quote string) (cons (quote -->) (cons (quote boolean) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote >) (cons (quote number) (cons (quote -->) (cons (cons (quote number) (cons (quote -->) (cons (quote boolean) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote <) (cons (quote number) (cons (quote -->) (cons (cons (quote number) (cons (quote -->) (cons (quote boolean) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote >=) (cons (quote number) (cons (quote -->) (cons (cons (quote number) (cons (quote -->) (cons (quote boolean) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote <=) (cons (quote number) (cons (quote -->) (cons (cons (quote number) (cons (quote -->) (cons (quote boolean) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote =) (cons (quote A) (cons (quote -->) (cons (cons (quote A) (cons (quote -->) (cons (quote boolean) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote +) (cons (quote number) (cons (quote -->) (cons (cons (quote number) (cons (quote -->) (cons (quote number) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote /) (cons (quote number) (cons (quote -->) (cons (cons (quote number) (cons (quote -->) (cons (quote number) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote -) (cons (quote number) (cons (quote -->) (cons (cons (quote number) (cons (quote -->) (cons (quote number) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (begin (kl:set (quote shen.*signedfuncs*) (cons (cons (quote *) (cons (quote number) (cons (quote -->) (cons (cons (quote number) (cons (quote -->) (cons (quote number) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*)))) (kl:set (quote shen.*signedfuncs*) (cons (cons (quote ==) (cons (quote A) (cons (quote -->) (cons (cons (quote B) (cons (quote -->) (cons (quote boolean) (quote ())))) (quote ()))))) (kl:value (quote shen.*signedfuncs*))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) (export shen.initialise-signedfuncs) (quote shen.initialise-signedfuncs)) +(begin (register-function-arity (quote shen.initialise-signedfunc-lambda-forms) 0) (define (kl:shen.initialise-signedfunc-lambda-forms) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-absvector?) (lambda (V3181) (lambda (V3182) (lambda (V3183) (kl:shen.type-signature-of-absvector? V3181 V3182 V3183)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-adjoin) (lambda (V3191) (lambda (V3192) (lambda (V3193) (kl:shen.type-signature-of-adjoin V3191 V3192 V3193)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-and) (lambda (V3201) (lambda (V3202) (lambda (V3203) (kl:shen.type-signature-of-and V3201 V3202 V3203)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-shen.app) (lambda (V3211) (lambda (V3212) (lambda (V3213) (kl:shen.type-signature-of-shen.app V3211 V3212 V3213)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-append) (lambda (V3221) (lambda (V3222) (lambda (V3223) (kl:shen.type-signature-of-append V3221 V3222 V3223)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-arity) (lambda (V3231) (lambda (V3232) (lambda (V3233) (kl:shen.type-signature-of-arity V3231 V3232 V3233)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-assoc) (lambda (V3241) (lambda (V3242) (lambda (V3243) (kl:shen.type-signature-of-assoc V3241 V3242 V3243)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-boolean?) (lambda (V3251) (lambda (V3252) (lambda (V3253) (kl:shen.type-signature-of-boolean? V3251 V3252 V3253)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-bound?) (lambda (V3261) (lambda (V3262) (lambda (V3263) (kl:shen.type-signature-of-bound? V3261 V3262 V3263)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-cd) (lambda (V3271) (lambda (V3272) (lambda (V3273) (kl:shen.type-signature-of-cd V3271 V3272 V3273)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-close) (lambda (V3281) (lambda (V3282) (lambda (V3283) (kl:shen.type-signature-of-close V3281 V3282 V3283)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-cn) (lambda (V3291) (lambda (V3292) (lambda (V3293) (kl:shen.type-signature-of-cn V3291 V3292 V3293)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-compile) (lambda (V3301) (lambda (V3302) (lambda (V3303) (kl:shen.type-signature-of-compile V3301 V3302 V3303)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-cons?) (lambda (V3311) (lambda (V3312) (lambda (V3313) (kl:shen.type-signature-of-cons? V3311 V3312 V3313)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-destroy) (lambda (V3321) (lambda (V3322) (lambda (V3323) (kl:shen.type-signature-of-destroy V3321 V3322 V3323)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-difference) (lambda (V3331) (lambda (V3332) (lambda (V3333) (kl:shen.type-signature-of-difference V3331 V3332 V3333)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-do) (lambda (V3341) (lambda (V3342) (lambda (V3343) (kl:shen.type-signature-of-do V3341 V3342 V3343)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-) (lambda (V3351) (lambda (V3352) (lambda (V3353) (kl:shen.type-signature-of- V3351 V3352 V3353)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-) (lambda (V3361) (lambda (V3362) (lambda (V3363) (kl:shen.type-signature-of- V3361 V3362 V3363)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-element?) (lambda (V3371) (lambda (V3372) (lambda (V3373) (kl:shen.type-signature-of-element? V3371 V3372 V3373)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-empty?) (lambda (V3381) (lambda (V3382) (lambda (V3383) (kl:shen.type-signature-of-empty? V3381 V3382 V3383)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-enable-type-theory) (lambda (V3391) (lambda (V3392) (lambda (V3393) (kl:shen.type-signature-of-enable-type-theory V3391 V3392 V3393)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-external) (lambda (V3401) (lambda (V3402) (lambda (V3403) (kl:shen.type-signature-of-external V3401 V3402 V3403)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-error-to-string) (lambda (V3411) (lambda (V3412) (lambda (V3413) (kl:shen.type-signature-of-error-to-string V3411 V3412 V3413)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-explode) (lambda (V3421) (lambda (V3422) (lambda (V3423) (kl:shen.type-signature-of-explode V3421 V3422 V3423)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-fail) (lambda (V3431) (lambda (V3432) (lambda (V3433) (kl:shen.type-signature-of-fail V3431 V3432 V3433)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-fail-if) (lambda (V3441) (lambda (V3442) (lambda (V3443) (kl:shen.type-signature-of-fail-if V3441 V3442 V3443)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-fix) (lambda (V3451) (lambda (V3452) (lambda (V3453) (kl:shen.type-signature-of-fix V3451 V3452 V3453)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-freeze) (lambda (V3461) (lambda (V3462) (lambda (V3463) (kl:shen.type-signature-of-freeze V3461 V3462 V3463)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-fst) (lambda (V3471) (lambda (V3472) (lambda (V3473) (kl:shen.type-signature-of-fst V3471 V3472 V3473)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-function) (lambda (V3481) (lambda (V3482) (lambda (V3483) (kl:shen.type-signature-of-function V3481 V3482 V3483)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-gensym) (lambda (V3491) (lambda (V3492) (lambda (V3493) (kl:shen.type-signature-of-gensym V3491 V3492 V3493)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-<-vector) (lambda (V3501) (lambda (V3502) (lambda (V3503) (kl:shen.type-signature-of-<-vector V3501 V3502 V3503)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-vector->) (lambda (V3511) (lambda (V3512) (lambda (V3513) (kl:shen.type-signature-of-vector-> V3511 V3512 V3513)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-vector) (lambda (V3521) (lambda (V3522) (lambda (V3523) (kl:shen.type-signature-of-vector V3521 V3522 V3523)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-get-time) (lambda (V3531) (lambda (V3532) (lambda (V3533) (kl:shen.type-signature-of-get-time V3531 V3532 V3533)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-hash) (lambda (V3541) (lambda (V3542) (lambda (V3543) (kl:shen.type-signature-of-hash V3541 V3542 V3543)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-head) (lambda (V3551) (lambda (V3552) (lambda (V3553) (kl:shen.type-signature-of-head V3551 V3552 V3553)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-hdv) (lambda (V3561) (lambda (V3562) (lambda (V3563) (kl:shen.type-signature-of-hdv V3561 V3562 V3563)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-hdstr) (lambda (V3571) (lambda (V3572) (lambda (V3573) (kl:shen.type-signature-of-hdstr V3571 V3572 V3573)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-if) (lambda (V3581) (lambda (V3582) (lambda (V3583) (kl:shen.type-signature-of-if V3581 V3582 V3583)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-it) (lambda (V3591) (lambda (V3592) (lambda (V3593) (kl:shen.type-signature-of-it V3591 V3592 V3593)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-implementation) (lambda (V3601) (lambda (V3602) (lambda (V3603) (kl:shen.type-signature-of-implementation V3601 V3602 V3603)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-include) (lambda (V3611) (lambda (V3612) (lambda (V3613) (kl:shen.type-signature-of-include V3611 V3612 V3613)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-include-all-but) (lambda (V3621) (lambda (V3622) (lambda (V3623) (kl:shen.type-signature-of-include-all-but V3621 V3622 V3623)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-inferences) (lambda (V3631) (lambda (V3632) (lambda (V3633) (kl:shen.type-signature-of-inferences V3631 V3632 V3633)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-shen.insert) (lambda (V3641) (lambda (V3642) (lambda (V3643) (kl:shen.type-signature-of-shen.insert V3641 V3642 V3643)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-integer?) (lambda (V3651) (lambda (V3652) (lambda (V3653) (kl:shen.type-signature-of-integer? V3651 V3652 V3653)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-internal) (lambda (V3661) (lambda (V3662) (lambda (V3663) (kl:shen.type-signature-of-internal V3661 V3662 V3663)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-intersection) (lambda (V3671) (lambda (V3672) (lambda (V3673) (kl:shen.type-signature-of-intersection V3671 V3672 V3673)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-kill) (lambda (V3681) (lambda (V3682) (lambda (V3683) (kl:shen.type-signature-of-kill V3681 V3682 V3683)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-language) (lambda (V3691) (lambda (V3692) (lambda (V3693) (kl:shen.type-signature-of-language V3691 V3692 V3693)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-length) (lambda (V3701) (lambda (V3702) (lambda (V3703) (kl:shen.type-signature-of-length V3701 V3702 V3703)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-limit) (lambda (V3711) (lambda (V3712) (lambda (V3713) (kl:shen.type-signature-of-limit V3711 V3712 V3713)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-load) (lambda (V3721) (lambda (V3722) (lambda (V3723) (kl:shen.type-signature-of-load V3721 V3722 V3723)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-map) (lambda (V3731) (lambda (V3732) (lambda (V3733) (kl:shen.type-signature-of-map V3731 V3732 V3733)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-mapcan) (lambda (V3741) (lambda (V3742) (lambda (V3743) (kl:shen.type-signature-of-mapcan V3741 V3742 V3743)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-maxinferences) (lambda (V3751) (lambda (V3752) (lambda (V3753) (kl:shen.type-signature-of-maxinferences V3751 V3752 V3753)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-n->string) (lambda (V3761) (lambda (V3762) (lambda (V3763) (kl:shen.type-signature-of-n->string V3761 V3762 V3763)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-nl) (lambda (V3771) (lambda (V3772) (lambda (V3773) (kl:shen.type-signature-of-nl V3771 V3772 V3773)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-not) (lambda (V3781) (lambda (V3782) (lambda (V3783) (kl:shen.type-signature-of-not V3781 V3782 V3783)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-nth) (lambda (V3791) (lambda (V3792) (lambda (V3793) (kl:shen.type-signature-of-nth V3791 V3792 V3793)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-number?) (lambda (V3801) (lambda (V3802) (lambda (V3803) (kl:shen.type-signature-of-number? V3801 V3802 V3803)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-occurrences) (lambda (V3811) (lambda (V3812) (lambda (V3813) (kl:shen.type-signature-of-occurrences V3811 V3812 V3813)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-occurs-check) (lambda (V3821) (lambda (V3822) (lambda (V3823) (kl:shen.type-signature-of-occurs-check V3821 V3822 V3823)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-optimise) (lambda (V3831) (lambda (V3832) (lambda (V3833) (kl:shen.type-signature-of-optimise V3831 V3832 V3833)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-or) (lambda (V3841) (lambda (V3842) (lambda (V3843) (kl:shen.type-signature-of-or V3841 V3842 V3843)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-os) (lambda (V3851) (lambda (V3852) (lambda (V3853) (kl:shen.type-signature-of-os V3851 V3852 V3853)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-package?) (lambda (V3861) (lambda (V3862) (lambda (V3863) (kl:shen.type-signature-of-package? V3861 V3862 V3863)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-port) (lambda (V3871) (lambda (V3872) (lambda (V3873) (kl:shen.type-signature-of-port V3871 V3872 V3873)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-porters) (lambda (V3881) (lambda (V3882) (lambda (V3883) (kl:shen.type-signature-of-porters V3881 V3882 V3883)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-pos) (lambda (V3891) (lambda (V3892) (lambda (V3893) (kl:shen.type-signature-of-pos V3891 V3892 V3893)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-pr) (lambda (V3901) (lambda (V3902) (lambda (V3903) (kl:shen.type-signature-of-pr V3901 V3902 V3903)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-print) (lambda (V3911) (lambda (V3912) (lambda (V3913) (kl:shen.type-signature-of-print V3911 V3912 V3913)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-profile) (lambda (V3921) (lambda (V3922) (lambda (V3923) (kl:shen.type-signature-of-profile V3921 V3922 V3923)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-preclude) (lambda (V3931) (lambda (V3932) (lambda (V3933) (kl:shen.type-signature-of-preclude V3931 V3932 V3933)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-shen.proc-nl) (lambda (V3941) (lambda (V3942) (lambda (V3943) (kl:shen.type-signature-of-shen.proc-nl V3941 V3942 V3943)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-profile-results) (lambda (V3951) (lambda (V3952) (lambda (V3953) (kl:shen.type-signature-of-profile-results V3951 V3952 V3953)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-protect) (lambda (V3961) (lambda (V3962) (lambda (V3963) (kl:shen.type-signature-of-protect V3961 V3962 V3963)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-preclude-all-but) (lambda (V3971) (lambda (V3972) (lambda (V3973) (kl:shen.type-signature-of-preclude-all-but V3971 V3972 V3973)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-shen.prhush) (lambda (V3981) (lambda (V3982) (lambda (V3983) (kl:shen.type-signature-of-shen.prhush V3981 V3982 V3983)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-ps) (lambda (V3991) (lambda (V3992) (lambda (V3993) (kl:shen.type-signature-of-ps V3991 V3992 V3993)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-read) (lambda (V4001) (lambda (V4002) (lambda (V4003) (kl:shen.type-signature-of-read V4001 V4002 V4003)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-read-byte) (lambda (V4011) (lambda (V4012) (lambda (V4013) (kl:shen.type-signature-of-read-byte V4011 V4012 V4013)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-read-file-as-bytelist) (lambda (V4021) (lambda (V4022) (lambda (V4023) (kl:shen.type-signature-of-read-file-as-bytelist V4021 V4022 V4023)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-read-file-as-string) (lambda (V4031) (lambda (V4032) (lambda (V4033) (kl:shen.type-signature-of-read-file-as-string V4031 V4032 V4033)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-read-file) (lambda (V4041) (lambda (V4042) (lambda (V4043) (kl:shen.type-signature-of-read-file V4041 V4042 V4043)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-read-from-string) (lambda (V4051) (lambda (V4052) (lambda (V4053) (kl:shen.type-signature-of-read-from-string V4051 V4052 V4053)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-release) (lambda (V4061) (lambda (V4062) (lambda (V4063) (kl:shen.type-signature-of-release V4061 V4062 V4063)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-remove) (lambda (V4071) (lambda (V4072) (lambda (V4073) (kl:shen.type-signature-of-remove V4071 V4072 V4073)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-reverse) (lambda (V4081) (lambda (V4082) (lambda (V4083) (kl:shen.type-signature-of-reverse V4081 V4082 V4083)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-simple-error) (lambda (V4091) (lambda (V4092) (lambda (V4093) (kl:shen.type-signature-of-simple-error V4091 V4092 V4093)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-snd) (lambda (V4101) (lambda (V4102) (lambda (V4103) (kl:shen.type-signature-of-snd V4101 V4102 V4103)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-specialise) (lambda (V4111) (lambda (V4112) (lambda (V4113) (kl:shen.type-signature-of-specialise V4111 V4112 V4113)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-spy) (lambda (V4121) (lambda (V4122) (lambda (V4123) (kl:shen.type-signature-of-spy V4121 V4122 V4123)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-step) (lambda (V4131) (lambda (V4132) (lambda (V4133) (kl:shen.type-signature-of-step V4131 V4132 V4133)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-stinput) (lambda (V4141) (lambda (V4142) (lambda (V4143) (kl:shen.type-signature-of-stinput V4141 V4142 V4143)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-sterror) (lambda (V4151) (lambda (V4152) (lambda (V4153) (kl:shen.type-signature-of-sterror V4151 V4152 V4153)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-stoutput) (lambda (V4161) (lambda (V4162) (lambda (V4163) (kl:shen.type-signature-of-stoutput V4161 V4162 V4163)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-string?) (lambda (V4171) (lambda (V4172) (lambda (V4173) (kl:shen.type-signature-of-string? V4171 V4172 V4173)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-str) (lambda (V4181) (lambda (V4182) (lambda (V4183) (kl:shen.type-signature-of-str V4181 V4182 V4183)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-string->n) (lambda (V4191) (lambda (V4192) (lambda (V4193) (kl:shen.type-signature-of-string->n V4191 V4192 V4193)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-string->symbol) (lambda (V4201) (lambda (V4202) (lambda (V4203) (kl:shen.type-signature-of-string->symbol V4201 V4202 V4203)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-sum) (lambda (V4211) (lambda (V4212) (lambda (V4213) (kl:shen.type-signature-of-sum V4211 V4212 V4213)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-symbol?) (lambda (V4221) (lambda (V4222) (lambda (V4223) (kl:shen.type-signature-of-symbol? V4221 V4222 V4223)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-systemf) (lambda (V4231) (lambda (V4232) (lambda (V4233) (kl:shen.type-signature-of-systemf V4231 V4232 V4233)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-tail) (lambda (V4241) (lambda (V4242) (lambda (V4243) (kl:shen.type-signature-of-tail V4241 V4242 V4243)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-tlstr) (lambda (V4251) (lambda (V4252) (lambda (V4253) (kl:shen.type-signature-of-tlstr V4251 V4252 V4253)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-tlv) (lambda (V4261) (lambda (V4262) (lambda (V4263) (kl:shen.type-signature-of-tlv V4261 V4262 V4263)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-tc) (lambda (V4271) (lambda (V4272) (lambda (V4273) (kl:shen.type-signature-of-tc V4271 V4272 V4273)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-tc?) (lambda (V4281) (lambda (V4282) (lambda (V4283) (kl:shen.type-signature-of-tc? V4281 V4282 V4283)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-thaw) (lambda (V4291) (lambda (V4292) (lambda (V4293) (kl:shen.type-signature-of-thaw V4291 V4292 V4293)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-track) (lambda (V4301) (lambda (V4302) (lambda (V4303) (kl:shen.type-signature-of-track V4301 V4302 V4303)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-trap-error) (lambda (V4311) (lambda (V4312) (lambda (V4313) (kl:shen.type-signature-of-trap-error V4311 V4312 V4313)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-tuple?) (lambda (V4321) (lambda (V4322) (lambda (V4323) (kl:shen.type-signature-of-tuple? V4321 V4322 V4323)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-undefmacro) (lambda (V4331) (lambda (V4332) (lambda (V4333) (kl:shen.type-signature-of-undefmacro V4331 V4332 V4333)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-union) (lambda (V4341) (lambda (V4342) (lambda (V4343) (kl:shen.type-signature-of-union V4341 V4342 V4343)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-unprofile) (lambda (V4351) (lambda (V4352) (lambda (V4353) (kl:shen.type-signature-of-unprofile V4351 V4352 V4353)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-untrack) (lambda (V4361) (lambda (V4362) (lambda (V4363) (kl:shen.type-signature-of-untrack V4361 V4362 V4363)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-unspecialise) (lambda (V4371) (lambda (V4372) (lambda (V4373) (kl:shen.type-signature-of-unspecialise V4371 V4372 V4373)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-variable?) (lambda (V4381) (lambda (V4382) (lambda (V4383) (kl:shen.type-signature-of-variable? V4381 V4382 V4383)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-vector?) (lambda (V4391) (lambda (V4392) (lambda (V4393) (kl:shen.type-signature-of-vector? V4391 V4392 V4393)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-version) (lambda (V4401) (lambda (V4402) (lambda (V4403) (kl:shen.type-signature-of-version V4401 V4402 V4403)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-write-to-file) (lambda (V4411) (lambda (V4412) (lambda (V4413) (kl:shen.type-signature-of-write-to-file V4411 V4412 V4413)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-write-byte) (lambda (V4421) (lambda (V4422) (lambda (V4423) (kl:shen.type-signature-of-write-byte V4421 V4422 V4423)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-y-or-n?) (lambda (V4431) (lambda (V4432) (lambda (V4433) (kl:shen.type-signature-of-y-or-n? V4431 V4432 V4433)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of->) (lambda (V4441) (lambda (V4442) (lambda (V4443) (kl:shen.type-signature-of-> V4441 V4442 V4443)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-<) (lambda (V4451) (lambda (V4452) (lambda (V4453) (kl:shen.type-signature-of-< V4451 V4452 V4453)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of->=) (lambda (V4461) (lambda (V4462) (lambda (V4463) (kl:shen.type-signature-of->= V4461 V4462 V4463)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-<=) (lambda (V4471) (lambda (V4472) (lambda (V4473) (kl:shen.type-signature-of-<= V4471 V4472 V4473)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-=) (lambda (V4481) (lambda (V4482) (lambda (V4483) (kl:shen.type-signature-of-= V4481 V4482 V4483)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-+) (lambda (V4491) (lambda (V4492) (lambda (V4493) (kl:shen.type-signature-of-+ V4491 V4492 V4493)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-/) (lambda (V4501) (lambda (V4502) (lambda (V4503) (kl:shen.type-signature-of-/ V4501 V4502 V4503)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of--) (lambda (V4511) (lambda (V4512) (lambda (V4513) (kl:shen.type-signature-of-- V4511 V4512 V4513)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-*) (lambda (V4521) (lambda (V4522) (lambda (V4523) (kl:shen.type-signature-of-* V4521 V4522 V4523)))))) (kl:shen.set-lambda-form-entry (cons (quote shen.type-signature-of-==) (lambda (V4531) (lambda (V4532) (lambda (V4533) (kl:shen.type-signature-of-== V4531 V4532 V4533)))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) (export shen.initialise-signedfunc-lambda-forms) (quote shen.initialise-signedfunc-lambda-forms)) +(begin (register-function-arity (quote shen.initialise-lambda-forms) 0) (define (kl:shen.initialise-lambda-forms) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.datatype-error) (lambda (X) (kl:shen.datatype-error X)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.tuple) (lambda (X) (kl:shen.tuple X)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.pvar) (lambda (X) (kl:shen.pvar X)))) (begin (kl:shen.set-lambda-form-entry (cons (quote shen.dictionary) (lambda (X) (kl:shen.dictionary X)))) (begin (kl:shen.set-lambda-form-entry (cons (quote _waspvm_at_v) (lambda (V418) (lambda (V419) (kl:_waspvm_at_v V418 V419))))) (begin (kl:shen.set-lambda-form-entry (cons (quote _waspvm_at_p) (lambda (V420) (lambda (V421) (kl:_waspvm_at_p V420 V421))))) (begin (kl:shen.set-lambda-form-entry (cons (quote _waspvm_at_s) (lambda (V422) (lambda (V423) (kl:_waspvm_at_s V422 V423))))) (begin (kl:shen.set-lambda-form-entry (cons (quote ) (lambda (V424) (kl: V424)))) (begin (kl:shen.set-lambda-form-entry (cons (quote ) (lambda (V425) (kl: V425)))) (begin (kl:shen.set-lambda-form-entry (cons (quote ==) (lambda (V426) (lambda (V427) (kl:== V426 V427))))) (begin (kl:shen.set-lambda-form-entry (cons (quote =) (lambda (V428) (lambda (V429) (kl:= V428 V429))))) (begin (kl:shen.set-lambda-form-entry (cons (quote >=) (lambda (V430) (lambda (V431) (>= V430 V431))))) (begin (kl:shen.set-lambda-form-entry (cons (quote >) (lambda (V432) (lambda (V433) (> V432 V433))))) (begin (kl:shen.set-lambda-form-entry (cons (quote -) (lambda (V434) (lambda (V435) (- V434 V435))))) (begin (kl:shen.set-lambda-form-entry (cons (quote /) (lambda (V436) (lambda (V437) (/ V436 V437))))) (begin (kl:shen.set-lambda-form-entry (cons (quote *) (lambda (V438) (lambda (V439) (* V438 V439))))) (begin (kl:shen.set-lambda-form-entry (cons (quote +) (lambda (V440) (lambda (V441) (+ V440 V441))))) (begin (kl:shen.set-lambda-form-entry (cons (quote <=) (lambda (V442) (lambda (V443) (<= V442 V443))))) (begin (kl:shen.set-lambda-form-entry (cons (quote <) (lambda (V444) (lambda (V445) (< V444 V445))))) (begin (kl:shen.set-lambda-form-entry (cons (quote y-or-n?) (lambda (V446) (kl:y-or-n? V446)))) (begin (kl:shen.set-lambda-form-entry (cons (quote write-to-file) (lambda (V447) (lambda (V448) (kl:write-to-file V447 V448))))) (begin (kl:shen.set-lambda-form-entry (cons (quote write-byte) (lambda (V449) (lambda (V450) (write-u8 V449 V450))))) (begin (kl:shen.set-lambda-form-entry (cons (quote variable?) (lambda (V451) (kl:variable? V451)))) (begin (kl:shen.set-lambda-form-entry (cons (quote value) (lambda (V452) (kl:value V452)))) (begin (kl:shen.set-lambda-form-entry (cons (quote vector->) (lambda (V453) (lambda (V454) (lambda (V455) (kl:vector-> V453 V454 V455)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote <-vector) (lambda (V456) (lambda (V457) (kl:<-vector V456 V457))))) (begin (kl:shen.set-lambda-form-entry (cons (quote vector) (lambda (V458) (kl:vector V458)))) (begin (kl:shen.set-lambda-form-entry (cons (quote vector?) (lambda (V459) (kl:vector? V459)))) (begin (kl:shen.set-lambda-form-entry (cons (quote unspecialise) (lambda (V460) (kl:unspecialise V460)))) (begin (kl:shen.set-lambda-form-entry (cons (quote untrack) (lambda (V461) (kl:untrack V461)))) (begin (kl:shen.set-lambda-form-entry (cons (quote union) (lambda (V462) (lambda (V463) (kl:union V462 V463))))) (begin (kl:shen.set-lambda-form-entry (cons (quote unify) (lambda (V464) (lambda (V465) (lambda (V466) (lambda (V467) (kl:unify V464 V465 V466 V467))))))) (begin (kl:shen.set-lambda-form-entry (cons (quote unify!) (lambda (V468) (lambda (V469) (lambda (V470) (lambda (V471) (kl:unify! V468 V469 V470 V471))))))) (begin (kl:shen.set-lambda-form-entry (cons (quote unput) (lambda (V472) (lambda (V473) (lambda (V474) (kl:unput V472 V473 V474)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote unprofile) (lambda (V475) (kl:unprofile V475)))) (begin (kl:shen.set-lambda-form-entry (cons (quote undefmacro) (lambda (V476) (kl:undefmacro V476)))) (begin (kl:shen.set-lambda-form-entry (cons (quote return) (lambda (V477) (lambda (V478) (lambda (V479) (kl:return V477 V478 V479)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote type) (lambda (V480) (lambda (V481) V480)))) (begin (kl:shen.set-lambda-form-entry (cons (quote tuple?) (lambda (V482) (kl:tuple? V482)))) (begin (kl:shen.set-lambda-form-entry (cons (quote trap-error) (lambda (V483) (lambda (V484) (guard (lambda (e) (V484 e)) V483))))) (begin (kl:shen.set-lambda-form-entry (cons (quote track) (lambda (V485) (kl:track V485)))) (begin (kl:shen.set-lambda-form-entry (cons (quote thaw) (lambda (V486) (kl:thaw V486)))) (begin (kl:shen.set-lambda-form-entry (cons (quote tc) (lambda (V487) (kl:tc V487)))) (begin (kl:shen.set-lambda-form-entry (cons (quote tl) (lambda (V488) (cdr V488)))) (begin (kl:shen.set-lambda-form-entry (cons (quote tlstr) (lambda (V489) (string-tail V489 1)))) (begin (kl:shen.set-lambda-form-entry (cons (quote tail) (lambda (V490) (kl:tail V490)))) (begin (kl:shen.set-lambda-form-entry (cons (quote systemf) (lambda (V491) (kl:systemf V491)))) (begin (kl:shen.set-lambda-form-entry (cons (quote symbol?) (lambda (V492) (kl:symbol? V492)))) (begin (kl:shen.set-lambda-form-entry (cons (quote string->symbol) (lambda (V493) (kl:string->symbol V493)))) (begin (kl:shen.set-lambda-form-entry (cons (quote sum) (lambda (V494) (kl:sum V494)))) (begin (kl:shen.set-lambda-form-entry (cons (quote subst) (lambda (V495) (lambda (V496) (lambda (V497) (kl:subst V495 V496 V497)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote string?) (lambda (V498) (string? V498)))) (begin (kl:shen.set-lambda-form-entry (cons (quote string->n) (lambda (V499) (string-ref V499 0)))) (begin (kl:shen.set-lambda-form-entry (cons (quote step) (lambda (V500) (kl:step V500)))) (begin (kl:shen.set-lambda-form-entry (cons (quote spy) (lambda (V501) (kl:spy V501)))) (begin (kl:shen.set-lambda-form-entry (cons (quote specialise) (lambda (V502) (kl:specialise V502)))) (begin (kl:shen.set-lambda-form-entry (cons (quote snd) (lambda (V503) (kl:snd V503)))) (begin (kl:shen.set-lambda-form-entry (cons (quote simple-error) (lambda (V504) (simple-error V504)))) (begin (kl:shen.set-lambda-form-entry (cons (quote set) (lambda (V505) (lambda (V506) (kl:set V505 V506))))) (begin (kl:shen.set-lambda-form-entry (cons (quote str) (lambda (V507) (kl:str V507)))) (begin (kl:shen.set-lambda-form-entry (cons (quote reverse) (lambda (V508) (kl:reverse V508)))) (begin (kl:shen.set-lambda-form-entry (cons (quote remove) (lambda (V509) (lambda (V510) (kl:remove V509 V510))))) (begin (kl:shen.set-lambda-form-entry (cons (quote read) (lambda (V511) (kl:read V511)))) (begin (kl:shen.set-lambda-form-entry (cons (quote read-file) (lambda (V512) (kl:read-file V512)))) (begin (kl:shen.set-lambda-form-entry (cons (quote read-file-as-bytelist) (lambda (V513) (kl:read-file-as-bytelist V513)))) (begin (kl:shen.set-lambda-form-entry (cons (quote read-file-as-string) (lambda (V514) (kl:read-file-as-string V514)))) (begin (kl:shen.set-lambda-form-entry (cons (quote read-byte) (lambda (V515) (read-u8 V515)))) (begin (kl:shen.set-lambda-form-entry (cons (quote read-from-string) (lambda (V516) (kl:read-from-string V516)))) (begin (kl:shen.set-lambda-form-entry (cons (quote package?) (lambda (V517) (kl:package? V517)))) (begin (kl:shen.set-lambda-form-entry (cons (quote put) (lambda (V518) (lambda (V519) (lambda (V520) (lambda (V521) (kl:put V518 V519 V520 V521))))))) (begin (kl:shen.set-lambda-form-entry (cons (quote preclude) (lambda (V522) (kl:preclude V522)))) (begin (kl:shen.set-lambda-form-entry (cons (quote preclude-all-but) (lambda (V523) (kl:preclude-all-but V523)))) (begin (kl:shen.set-lambda-form-entry (cons (quote ps) (lambda (V524) (kl:ps V524)))) (begin (kl:shen.set-lambda-form-entry (cons (quote protect) (lambda (V525) (kl:protect V525)))) (begin (kl:shen.set-lambda-form-entry (cons (quote profile-results) (lambda (V526) (kl:profile-results V526)))) (begin (kl:shen.set-lambda-form-entry (cons (quote profile) (lambda (V527) (kl:profile V527)))) (begin (kl:shen.set-lambda-form-entry (cons (quote print) (lambda (V528) (kl:print V528)))) (begin (kl:shen.set-lambda-form-entry (cons (quote pr) (lambda (V529) (lambda (V530) (kl:pr V529 V530))))) (begin (kl:shen.set-lambda-form-entry (cons (quote pos) (lambda (V531) (lambda (V532) (make-string 1 (string-ref V531 V532)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote or) (lambda (V533) (lambda (V534) (or (assert-boolean V533) (assert-boolean V534)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote optimise) (lambda (V535) (kl:optimise V535)))) (begin (kl:shen.set-lambda-form-entry (cons (quote open) (lambda (V536) (lambda (V537) (kl:open V536 V537))))) (begin (kl:shen.set-lambda-form-entry (cons (quote occurrences) (lambda (V538) (lambda (V539) (kl:occurrences V538 V539))))) (begin (kl:shen.set-lambda-form-entry (cons (quote occurs-check) (lambda (V540) (kl:occurs-check V540)))) (begin (kl:shen.set-lambda-form-entry (cons (quote n->string) (lambda (V541) (make-string 1 V541)))) (begin (kl:shen.set-lambda-form-entry (cons (quote number?) (lambda (V542) (number? V542)))) (begin (kl:shen.set-lambda-form-entry (cons (quote nth) (lambda (V543) (lambda (V544) (kl:nth V543 V544))))) (begin (kl:shen.set-lambda-form-entry (cons (quote not) (lambda (V545) (kl:not V545)))) (begin (kl:shen.set-lambda-form-entry (cons (quote nl) (lambda (V546) (kl:nl V546)))) (begin (kl:shen.set-lambda-form-entry (cons (quote macroexpand) (lambda (V547) (kl:macroexpand V547)))) (begin (kl:shen.set-lambda-form-entry (cons (quote maxinferences) (lambda (V548) (kl:maxinferences V548)))) (begin (kl:shen.set-lambda-form-entry (cons (quote mapcan) (lambda (V549) (lambda (V550) (kl:mapcan V549 V550))))) (begin (kl:shen.set-lambda-form-entry (cons (quote map) (lambda (V551) (lambda (V552) (kl:map V551 V552))))) (begin (kl:shen.set-lambda-form-entry (cons (quote load) (lambda (V553) (kl:load V553)))) (begin (kl:shen.set-lambda-form-entry (cons (quote lineread) (lambda (V554) (kl:lineread V554)))) (begin (kl:shen.set-lambda-form-entry (cons (quote limit) (lambda (V555) (kl:limit V555)))) (begin (kl:shen.set-lambda-form-entry (cons (quote length) (lambda (V556) (kl:length V556)))) (begin (kl:shen.set-lambda-form-entry (cons (quote intersection) (lambda (V557) (lambda (V558) (kl:intersection V557 V558))))) (begin (kl:shen.set-lambda-form-entry (cons (quote intern) (lambda (V559) (kl:intern V559)))) (begin (kl:shen.set-lambda-form-entry (cons (quote integer?) (lambda (V560) (kl:integer? V560)))) (begin (kl:shen.set-lambda-form-entry (cons (quote input) (lambda (V561) (kl:input V561)))) (begin (kl:shen.set-lambda-form-entry (cons (quote input+) (lambda (V562) (lambda (V563) (kl:input+ V562 V563))))) (begin (kl:shen.set-lambda-form-entry (cons (quote include) (lambda (V564) (kl:include V564)))) (begin (kl:shen.set-lambda-form-entry (cons (quote include-all-but) (lambda (V565) (kl:include-all-but V565)))) (begin (kl:shen.set-lambda-form-entry (cons (quote internal) (lambda (V566) (kl:internal V566)))) (begin (kl:shen.set-lambda-form-entry (cons (quote if) (lambda (V567) (lambda (V568) (lambda (V569) (if (assert-boolean V567) V568 V569)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote identical) (lambda (V570) (lambda (V571) (lambda (V572) (lambda (V573) (kl:identical V570 V571 V572 V573))))))) (begin (kl:shen.set-lambda-form-entry (cons (quote head) (lambda (V574) (kl:head V574)))) (begin (kl:shen.set-lambda-form-entry (cons (quote hd) (lambda (V575) (car V575)))) (begin (kl:shen.set-lambda-form-entry (cons (quote hdv) (lambda (V576) (kl:hdv V576)))) (begin (kl:shen.set-lambda-form-entry (cons (quote hdstr) (lambda (V577) (kl:hdstr V577)))) (begin (kl:shen.set-lambda-form-entry (cons (quote hash) (lambda (V578) (lambda (V579) (kl:hash V578 V579))))) (begin (kl:shen.set-lambda-form-entry (cons (quote get) (lambda (V580) (lambda (V581) (lambda (V582) (kl:get V580 V581 V582)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote get-time) (lambda (V583) (kl:get-time V583)))) (begin (kl:shen.set-lambda-form-entry (cons (quote gensym) (lambda (V584) (kl:gensym V584)))) (begin (kl:shen.set-lambda-form-entry (cons (quote fst) (lambda (V585) (kl:fst V585)))) (begin (kl:shen.set-lambda-form-entry (cons (quote freeze) (lambda (V586) (lambda () V586)))) (begin (kl:shen.set-lambda-form-entry (cons (quote fix) (lambda (V587) (lambda (V588) (kl:fix V587 V588))))) (begin (kl:shen.set-lambda-form-entry (cons (quote fail-if) (lambda (V589) (lambda (V590) (kl:fail-if V589 V590))))) (begin (kl:shen.set-lambda-form-entry (cons (quote findall) (lambda (V591) (lambda (V592) (lambda (V593) (lambda (V594) (lambda (V595) (kl:findall V591 V592 V593 V594 V595)))))))) (begin (kl:shen.set-lambda-form-entry (cons (quote enable-type-theory) (lambda (V596) (kl:enable-type-theory V596)))) (begin (kl:shen.set-lambda-form-entry (cons (quote explode) (lambda (V597) (kl:explode V597)))) (begin (kl:shen.set-lambda-form-entry (cons (quote external) (lambda (V598) (kl:external V598)))) (begin (kl:shen.set-lambda-form-entry (cons (quote eval-kl) (lambda (V599) (kl:eval-kl V599)))) (begin (kl:shen.set-lambda-form-entry (cons (quote eval) (lambda (V600) (kl:eval V600)))) (begin (kl:shen.set-lambda-form-entry (cons (quote error-to-string) (lambda (V601) (kl:error-to-string V601)))) (begin (kl:shen.set-lambda-form-entry (cons (quote empty?) (lambda (V602) (kl:empty? V602)))) (begin (kl:shen.set-lambda-form-entry (cons (quote element?) (lambda (V603) (lambda (V604) (kl:element? V603 V604))))) (begin (kl:shen.set-lambda-form-entry (cons (quote do) (lambda (V605) (lambda (V606) (begin V605 V606))))) (begin (kl:shen.set-lambda-form-entry (cons (quote difference) (lambda (V607) (lambda (V608) (kl:difference V607 V608))))) (begin (kl:shen.set-lambda-form-entry (cons (quote destroy) (lambda (V609) (kl:destroy V609)))) (begin (kl:shen.set-lambda-form-entry (cons (quote declare) (lambda (V610) (lambda (V611) (kl:declare V610 V611))))) (begin (kl:shen.set-lambda-form-entry (cons (quote cn) (lambda (V612) (lambda (V613) (string-append V612 V613))))) (begin (kl:shen.set-lambda-form-entry (cons (quote cons?) (lambda (V614) (pair? V614)))) (begin (kl:shen.set-lambda-form-entry (cons (quote cons) (lambda (V615) (lambda (V616) (cons V615 V616))))) (begin (kl:shen.set-lambda-form-entry (cons (quote concat) (lambda (V617) (lambda (V618) (kl:concat V617 V618))))) (begin (kl:shen.set-lambda-form-entry (cons (quote compile) (lambda (V619) (lambda (V620) (lambda (V621) (kl:compile V619 V620 V621)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote cd) (lambda (V622) (kl:cd V622)))) (begin (kl:shen.set-lambda-form-entry (cons (quote close) (lambda (V623) (kl:close V623)))) (begin (kl:shen.set-lambda-form-entry (cons (quote bound?) (lambda (V624) (kl:bound? V624)))) (begin (kl:shen.set-lambda-form-entry (cons (quote boolean?) (lambda (V625) (kl:boolean? V625)))) (begin (kl:shen.set-lambda-form-entry (cons (quote assoc) (lambda (V626) (lambda (V627) (kl:assoc V626 V627))))) (begin (kl:shen.set-lambda-form-entry (cons (quote arity) (lambda (V628) (kl:arity V628)))) (begin (kl:shen.set-lambda-form-entry (cons (quote append) (lambda (V629) (lambda (V630) (kl:append V629 V630))))) (begin (kl:shen.set-lambda-form-entry (cons (quote and) (lambda (V631) (lambda (V632) (and (assert-boolean V631) (assert-boolean V632)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote adjoin) (lambda (V633) (lambda (V634) (kl:adjoin V633 V634))))) (begin (kl:shen.set-lambda-form-entry (cons (quote <-address) (lambda (V635) (lambda (V636) (vector-ref V635 V636))))) (begin (kl:shen.set-lambda-form-entry (cons (quote address->) (lambda (V637) (lambda (V638) (lambda (V639) (let ((_tmp V637)) (vector-set! _tmp V638 V639) _tmp)))))) (begin (kl:shen.set-lambda-form-entry (cons (quote absvector?) (lambda (V640) (vector? V640)))) (kl:shen.set-lambda-form-entry (cons (quote absvector) (lambda (V641) (make-vector V641 (quote (quote shen.fail!)))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) (export shen.initialise-lambda-forms) (quote shen.initialise-lambda-forms)) +(begin (register-function-arity (quote shen.initialise) 0) (define (kl:shen.initialise) (begin (kl:shen.initialise-environment) (begin (kl:shen.initialise-lambda-forms) (begin (kl:shen.initialise-signedfunc-lambda-forms) (kl:shen.initialise-signedfuncs))))) (export shen.initialise) (quote shen.initialise)) diff --git a/compiled/load.kl.ms b/compiled/load.kl.ms index 81ce3d7..8d9f090 100644 --- a/compiled/load.kl.ms +++ b/compiled/load.kl.ms @@ -1,13 +1,13 @@ (module "compiled/load.kl") "Copyright (c) 2010-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:\n\n1. Redistributions of source code must retain the above copyright notice,\nthis list of conditions and the following disclaimer.\n\n2. Redistributions in binary form must reproduce the above copyright notice,\nthis list of conditions and the following disclaimer in the documentation\nand/or other materials provided with the distribution.\n\n3. Neither the name of the copyright holder nor the names of its contributors\nmay be used to endorse or promote products derived from this software without\nspecific prior written permission.\n\nTHIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ''AS IS'' AND\nANY EXPRESS 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 THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE\nFOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL\nDAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR\nSERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER\nCAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,\nOR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE\nOF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.\n" -(begin (register-function-arity (quote load) 1) (define (kl:load V1804) (let ((Load (let ((Start (kl:get-time (quote run)))) (let ((Result (kl:shen.load-help (kl:value (quote shen.*tc*)) (kl:read-file V1804)))) (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 V1811 V1812) (cond ((kl:= #f V1811) (kl:shen.for-each (lambda (X) (kl:shen.prhush (kl:shen.app (kl:shen.eval-without-macros X) "\n" (quote shen.s)) (kl:stoutput))) V1812)) (#t (let ((RemoveSynonyms (kl:mapcan (lambda (X) (kl:shen.remove-synonyms X)) V1812))) (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 V1814) (cond ((and (pair? V1814) (eq? (quote shen.synonyms-help) (car V1814))) (begin (kl:eval V1814) (quote ()))) (#t (cons V1814 (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 V1816) (begin (kl:nl 1) (kl:shen.typecheck-and-evaluate V1816 (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 V1822) (cond ((and (pair? V1822) (and (eq? (quote define) (car V1822)) (pair? (cdr V1822)))) (let ((Sig (kl:compile (lambda (Y) (kl:shen. Y)) (cdr (cdr V1822)) (lambda (E) (simple-error (kl:shen.app (car (cdr V1822)) " lacks a proper signature.\n" (quote shen.a))))))) (cons (cons (car (cdr V1822)) Sig) (quote ())))) (#t (quote ())))) (export shen.typetable) (quote shen.typetable)) -(begin (register-function-arity (quote shen.assumetype) 1) (define (kl:shen.assumetype V1824) (cond ((pair? V1824) (kl:declare (car V1824) (cdr V1824))) (#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 V1831 V1832) (cond ((null? V1832) (simple-error (kl:error-to-string V1831))) ((and (pair? V1832) (pair? (car V1832))) (begin (kl:shen.remtype (car (car V1832))) (kl:shen.unwind-types V1831 (cdr V1832)))) (#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 V1834) (kl:set (quote shen.*signedfuncs*) (kl:shen.removetype V1834 (kl:value (quote shen.*signedfuncs*))))) (export shen.remtype) (quote shen.remtype)) -(begin (register-function-arity (quote shen.removetype) 2) (define (kl:shen.removetype V1842 V1843) (cond ((null? V1843) (quote ())) ((and (pair? V1843) (and (pair? (car V1843)) (kl:= (car (car V1843)) V1842))) (kl:shen.removetype (car (car V1843)) (cdr V1843))) ((pair? V1843) (cons (car V1843) (kl:shen.removetype V1842 (cdr V1843)))) (#t (kl:shen.f_error (quote shen.removetype))))) (export shen.removetype) (quote shen.removetype)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1845) (let ((Parse_shen. (kl:shen. V1845))) (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 V1848 V1849) (let ((Stream (kl:open V1848 (quote out)))) (let ((String (if (string? V1849) (kl:shen.app V1849 "\n\n" (quote shen.a)) (kl:shen.app V1849 "\n\n" (quote shen.s))))) (let ((Write (kl:pr String Stream))) (let ((Close (kl:close Stream))) V1849))))) (export write-to-file) (quote write-to-file)) +(begin (register-function-arity (quote load) 1) (define (kl:load V643) (let ((Load (let ((Start (kl:get-time (quote run)))) (let ((Result (kl:shen.load-help (kl:value (quote shen.*tc*)) (kl:read-file V643)))) (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 V650 V651) (cond ((kl:= #f V650) (kl:shen.for-each (lambda (X) (kl:shen.prhush (kl:shen.app (kl:shen.eval-without-macros X) "\n" (quote shen.s)) (kl:stoutput))) V651)) (#t (let ((RemoveSynonyms (kl:mapcan (lambda (X) (kl:shen.remove-synonyms X)) V651))) (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 V653) (cond ((and (pair? V653) (eq? (quote shen.synonyms-help) (car V653))) (begin (kl:eval V653) (quote ()))) (#t (cons V653 (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 V655) (begin (kl:nl 1) (kl:shen.typecheck-and-evaluate V655 (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 V661) (cond ((and (pair? V661) (and (eq? (quote define) (car V661)) (pair? (cdr V661)))) (let ((Sig (kl:compile (lambda (Y) (kl:shen. Y)) (cdr (cdr V661)) (lambda (E) (simple-error (kl:shen.app (car (cdr V661)) " lacks a proper signature.\n" (quote shen.a))))))) (cons (cons (car (cdr V661)) Sig) (quote ())))) (#t (quote ())))) (export shen.typetable) (quote shen.typetable)) +(begin (register-function-arity (quote shen.assumetype) 1) (define (kl:shen.assumetype V663) (cond ((pair? V663) (kl:declare (car V663) (cdr V663))) (#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 V670 V671) (cond ((null? V671) (simple-error (kl:error-to-string V670))) ((and (pair? V671) (pair? (car V671))) (begin (kl:shen.remtype (car (car V671))) (kl:shen.unwind-types V670 (cdr V671)))) (#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 V673) (kl:set (quote shen.*signedfuncs*) (kl:shen.removetype V673 (kl:value (quote shen.*signedfuncs*))))) (export shen.remtype) (quote shen.remtype)) +(begin (register-function-arity (quote shen.removetype) 2) (define (kl:shen.removetype V681 V682) (cond ((null? V682) (quote ())) ((and (pair? V682) (and (pair? (car V682)) (kl:= (car (car V682)) V681))) (kl:shen.removetype (car (car V682)) (cdr V682))) ((pair? V682) (cons (car V682) (kl:shen.removetype V681 (cdr V682)))) (#t (kl:shen.f_error (quote shen.removetype))))) (export shen.removetype) (quote shen.removetype)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V684) (let ((Parse_shen. (kl:shen. V684))) (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 V687 V688) (let ((Stream (kl:open V687 (quote out)))) (let ((String (if (string? V688) (kl:shen.app V688 "\n\n" (quote shen.a)) (kl:shen.app V688 "\n\n" (quote shen.s))))) (let ((Write (kl:pr String Stream))) (let ((Close (kl:close Stream))) V688))))) (export write-to-file) (quote write-to-file)) diff --git a/compiled/macros.kl.ms b/compiled/macros.kl.ms index 5d41606..c4e2cb9 100644 --- a/compiled/macros.kl.ms +++ b/compiled/macros.kl.ms @@ -1,33 +1,33 @@ (module "compiled/macros.kl") "Copyright (c) 2010-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:\n\n1. Redistributions of source code must retain the above copyright notice,\nthis list of conditions and the following disclaimer.\n\n2. Redistributions in binary form must reproduce the above copyright notice,\nthis list of conditions and the following disclaimer in the documentation\nand/or other materials provided with the distribution.\n\n3. Neither the name of the copyright holder nor the names of its contributors\nmay be used to endorse or promote products derived from this software without\nspecific prior written permission.\n\nTHIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ''AS IS'' AND\nANY EXPRESS 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 THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE\nFOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL\nDAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR\nSERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER\nCAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,\nOR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE\nOF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.\n" -(begin (register-function-arity (quote macroexpand) 1) (define (kl:macroexpand V1851) (let ((Y (kl:shen.compose (kl:value (quote *macros*)) V1851))) (if (kl:= V1851 Y) V1851 (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 V1853) (cond ((and (pair? V1853) (and (eq? (quote error) (car V1853)) (pair? (cdr V1853)))) (cons (quote simple-error) (cons (kl:shen.mkstr (car (cdr V1853)) (cdr (cdr V1853))) (quote ())))) (#t V1853))) (export shen.error-macro) (quote shen.error-macro)) -(begin (register-function-arity (quote shen.output-macro) 1) (define (kl:shen.output-macro V1855) (cond ((and (pair? V1855) (and (eq? (quote output) (car V1855)) (pair? (cdr V1855)))) (cons (quote shen.prhush) (cons (kl:shen.mkstr (car (cdr V1855)) (cdr (cdr V1855))) (cons (cons (quote stoutput) (quote ())) (quote ()))))) ((and (pair? V1855) (and (eq? (quote pr) (car V1855)) (and (pair? (cdr V1855)) (null? (cdr (cdr V1855)))))) (cons (quote pr) (cons (car (cdr V1855)) (cons (cons (quote stoutput) (quote ())) (quote ()))))) (#t V1855))) (export shen.output-macro) (quote shen.output-macro)) -(begin (register-function-arity (quote shen.make-string-macro) 1) (define (kl:shen.make-string-macro V1857) (cond ((and (pair? V1857) (and (eq? (quote make-string) (car V1857)) (pair? (cdr V1857)))) (kl:shen.mkstr (car (cdr V1857)) (cdr (cdr V1857)))) (#t V1857))) (export shen.make-string-macro) (quote shen.make-string-macro)) -(begin (register-function-arity (quote shen.input-macro) 1) (define (kl:shen.input-macro V1859) (cond ((and (pair? V1859) (and (eq? (quote lineread) (car V1859)) (null? (cdr V1859)))) (cons (quote lineread) (cons (cons (quote stinput) (quote ())) (quote ())))) ((and (pair? V1859) (and (eq? (quote input) (car V1859)) (null? (cdr V1859)))) (cons (quote input) (cons (cons (quote stinput) (quote ())) (quote ())))) ((and (pair? V1859) (and (eq? (quote read) (car V1859)) (null? (cdr V1859)))) (cons (quote read) (cons (cons (quote stinput) (quote ())) (quote ())))) ((and (pair? V1859) (and (eq? (quote input+) (car V1859)) (and (pair? (cdr V1859)) (null? (cdr (cdr V1859)))))) (cons (quote input+) (cons (car (cdr V1859)) (cons (cons (quote stinput) (quote ())) (quote ()))))) ((and (pair? V1859) (and (eq? (quote read-byte) (car V1859)) (null? (cdr V1859)))) (cons (quote read-byte) (cons (cons (quote stinput) (quote ())) (quote ())))) (#t V1859))) (export shen.input-macro) (quote shen.input-macro)) -(begin (register-function-arity (quote shen.compose) 2) (define (kl:shen.compose V1862 V1863) (cond ((null? V1862) V1863) ((pair? V1862) (kl:shen.compose (cdr V1862) ((car V1862) V1863))) (#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 V1865) (cond ((and (pair? V1865) (and (eq? (quote compile) (car V1865)) (and (pair? (cdr V1865)) (and (pair? (cdr (cdr V1865))) (null? (cdr (cdr (cdr V1865)))))))) (cons (quote compile) (cons (car (cdr V1865)) (cons (car (cdr (cdr V1865))) (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 V1865))) (export shen.compile-macro) (quote shen.compile-macro)) -(begin (register-function-arity (quote shen.prolog-macro) 1) (define (kl:shen.prolog-macro V1867) (cond ((and (pair? V1867) (eq? (quote prolog?) (car V1867))) (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 V1867)))) (let ((Vs (kl:shen.extract_vars (cdr V1867)))) (let ((External (kl:shen.externally-bound (cdr V1867)))) (let ((PrologVs (kl:difference Vs External))) (kl:shen.locally-bind-prolog-vs (quote NPP) PrologVs Calls))))) (quote ())))))) (#t V1867))) (export shen.prolog-macro) (quote shen.prolog-macro)) -(begin (register-function-arity (quote shen.externally-bound) 1) (define (kl:shen.externally-bound V1873) (cond ((and (pair? V1873) (and (eq? (quote receive) (car V1873)) (and (pair? (cdr V1873)) (null? (cdr (cdr V1873)))))) (cdr V1873)) ((pair? V1873) (kl:union (kl:shen.externally-bound (car V1873)) (kl:shen.externally-bound (cdr V1873)))) (#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 V1891 V1892 V1893) (cond ((null? V1892) V1893) ((pair? V1892) (cons (quote let) (cons (car V1892) (cons (cons (quote shen.newpv) (cons V1891 (quote ()))) (cons (kl:shen.locally-bind-prolog-vs V1891 (cdr V1892) V1893) (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 V1906 V1907) (cond ((null? V1907) #t) ((and (pair? V1907) (eq? (quote !) (car V1907))) (cons (quote cut) (cons #f (cons V1906 (cons (cons (quote freeze) (cons (kl:shen.bld-prolog-call V1906 (cdr V1907)) (quote ()))) (quote ())))))) ((and (pair? V1907) (and (pair? (car V1907)) (and (eq? (quote when) (car (car V1907))) (and (pair? (cdr (car V1907))) (null? (cdr (cdr (car V1907)))))))) (cons (quote fwhen) (cons (kl:shen.insert-deref (car (cdr (car V1907))) V1906) (cons V1906 (cons (cons (quote freeze) (cons (kl:shen.bld-prolog-call V1906 (cdr V1907)) (quote ()))) (quote ())))))) ((and (pair? V1907) (and (pair? (car V1907)) (and (eq? (quote is) (car (car V1907))) (and (pair? (cdr (car V1907))) (and (pair? (cdr (cdr (car V1907)))) (null? (cdr (cdr (cdr (car V1907)))))))))) (cons (quote bind) (cons (car (cdr (car V1907))) (cons (kl:shen.insert-deref (car (cdr (cdr (car V1907)))) V1906) (cons V1906 (cons (cons (quote freeze) (cons (kl:shen.bld-prolog-call V1906 (cdr V1907)) (quote ()))) (quote ()))))))) ((and (pair? V1907) (and (pair? (car V1907)) (and (eq? (quote receive) (car (car V1907))) (and (pair? (cdr (car V1907))) (null? (cdr (cdr (car V1907)))))))) (kl:shen.bld-prolog-call V1906 (cdr V1907))) ((and (pair? V1907) (and (pair? (car V1907)) (and (eq? (quote bind) (car (car V1907))) (and (pair? (cdr (car V1907))) (and (pair? (cdr (cdr (car V1907)))) (null? (cdr (cdr (cdr (car V1907)))))))))) (cons (quote bind) (cons (car (cdr (car V1907))) (cons (kl:shen.insert-lazyderef (car (cdr (cdr (car V1907)))) V1906) (cons V1906 (cons (cons (quote freeze) (cons (kl:shen.bld-prolog-call V1906 (cdr V1907)) (quote ()))) (quote ()))))))) ((and (pair? V1907) (and (pair? (car V1907)) (and (eq? (quote fwhen) (car (car V1907))) (and (pair? (cdr (car V1907))) (null? (cdr (cdr (car V1907)))))))) (cons (quote fwhen) (cons (kl:shen.insert-lazyderef (car (cdr (car V1907))) V1906) (cons V1906 (cons (cons (quote freeze) (cons (kl:shen.bld-prolog-call V1906 (cdr V1907)) (quote ()))) (quote ())))))) ((pair? V1907) (kl:append (car V1907) (cons V1906 (cons (cons (quote freeze) (cons (kl:shen.bld-prolog-call V1906 (cdr V1907)) (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 V1909) (cond ((and (pair? V1909) (and (eq? (quote defprolog) (car V1909)) (pair? (cdr V1909)))) (kl:compile (lambda (Y) (kl:shen. Y)) (cdr V1909) (lambda (Y) (kl:shen.prolog-error (car (cdr V1909)) Y)))) (#t V1909))) (export shen.defprolog-macro) (quote shen.defprolog-macro)) -(begin (register-function-arity (quote shen.datatype-macro) 1) (define (kl:shen.datatype-macro V1911) (cond ((and (pair? V1911) (and (eq? (quote datatype) (car V1911)) (pair? (cdr V1911)))) (cons (quote shen.process-datatype) (cons (kl:shen.intern-type (car (cdr V1911))) (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 V1911))) (cons (cons (quote function) (cons (quote shen.datatype-error) (quote ()))) (quote ()))))) (quote ()))))) (#t V1911))) (export shen.datatype-macro) (quote shen.datatype-macro)) -(begin (register-function-arity (quote shen.intern-type) 1) (define (kl:shen.intern-type V1913) (kl:intern (string-append (kl:str V1913) "#type"))) (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 V1915) (cond ((and (pair? V1915) (and (eq? (quote _waspvm_at_s) (car V1915)) (and (pair? (cdr V1915)) (and (pair? (cdr (cdr V1915))) (pair? (cdr (cdr (cdr V1915)))))))) (cons (quote _waspvm_at_s) (cons (car (cdr V1915)) (cons (kl:shen._waspvm_at_s-macro (cons (quote _waspvm_at_s) (cdr (cdr V1915)))) (quote ()))))) ((and (pair? V1915) (and (eq? (quote _waspvm_at_s) (car V1915)) (and (pair? (cdr V1915)) (and (pair? (cdr (cdr V1915))) (and (null? (cdr (cdr (cdr V1915)))) (string? (car (cdr V1915)))))))) (let ((E (kl:explode (car (cdr V1915))))) (if (> (kl:length E) 1) (kl:shen._waspvm_at_s-macro (cons (quote _waspvm_at_s) (kl:append E (cdr (cdr V1915))))) V1915))) (#t V1915))) (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 V1917) (cond ((and (pair? V1917) (eq? (quote synonyms) (car V1917))) (cons (quote shen.synonyms-help) (cons (kl:shen.rcons_form (kl:shen.curry-synonyms (cdr V1917))) (quote ())))) (#t V1917))) (export shen.synonyms-macro) (quote shen.synonyms-macro)) -(begin (register-function-arity (quote shen.curry-synonyms) 1) (define (kl:shen.curry-synonyms V1919) (kl:map (lambda (X) (kl:shen.curry-type X)) V1919)) (export shen.curry-synonyms) (quote shen.curry-synonyms)) -(begin (register-function-arity (quote shen.nl-macro) 1) (define (kl:shen.nl-macro V1921) (cond ((and (pair? V1921) (and (eq? (quote nl) (car V1921)) (null? (cdr V1921)))) (cons (quote nl) (cons 1 (quote ())))) (#t V1921))) (export shen.nl-macro) (quote shen.nl-macro)) -(begin (register-function-arity (quote shen.assoc-macro) 1) (define (kl:shen.assoc-macro V1923) (cond ((and (pair? V1923) (and (pair? (cdr V1923)) (and (pair? (cdr (cdr V1923))) (and (pair? (cdr (cdr (cdr V1923)))) (kl:element? (car V1923) (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 V1923) (cons (car (cdr V1923)) (cons (kl:shen.assoc-macro (cons (car V1923) (cdr (cdr V1923)))) (quote ()))))) (#t V1923))) (export shen.assoc-macro) (quote shen.assoc-macro)) -(begin (register-function-arity (quote shen.let-macro) 1) (define (kl:shen.let-macro V1925) (cond ((and (pair? V1925) (and (eq? (quote let) (car V1925)) (and (pair? (cdr V1925)) (and (pair? (cdr (cdr V1925))) (and (pair? (cdr (cdr (cdr V1925)))) (pair? (cdr (cdr (cdr (cdr V1925)))))))))) (cons (quote let) (cons (car (cdr V1925)) (cons (car (cdr (cdr V1925))) (cons (kl:shen.let-macro (cons (quote let) (cdr (cdr (cdr V1925))))) (quote ())))))) (#t V1925))) (export shen.let-macro) (quote shen.let-macro)) -(begin (register-function-arity (quote shen.abs-macro) 1) (define (kl:shen.abs-macro V1927) (cond ((and (pair? V1927) (and (eq? (quote /.) (car V1927)) (and (pair? (cdr V1927)) (and (pair? (cdr (cdr V1927))) (pair? (cdr (cdr (cdr V1927)))))))) (cons (quote lambda) (cons (car (cdr V1927)) (cons (kl:shen.abs-macro (cons (quote /.) (cdr (cdr V1927)))) (quote ()))))) ((and (pair? V1927) (and (eq? (quote /.) (car V1927)) (and (pair? (cdr V1927)) (and (pair? (cdr (cdr V1927))) (null? (cdr (cdr (cdr V1927)))))))) (cons (quote lambda) (cdr V1927))) (#t V1927))) (export shen.abs-macro) (quote shen.abs-macro)) -(begin (register-function-arity (quote shen.cases-macro) 1) (define (kl:shen.cases-macro V1931) (cond ((and (pair? V1931) (and (eq? (quote cases) (car V1931)) (and (pair? (cdr V1931)) (and (kl:= #t (car (cdr V1931))) (pair? (cdr (cdr V1931))))))) (car (cdr (cdr V1931)))) ((and (pair? V1931) (and (eq? (quote cases) (car V1931)) (and (pair? (cdr V1931)) (and (pair? (cdr (cdr V1931))) (null? (cdr (cdr (cdr V1931)))))))) (cons (quote if) (cons (car (cdr V1931)) (cons (car (cdr (cdr V1931))) (cons (cons (quote simple-error) (cons "error: cases exhausted" (quote ()))) (quote ())))))) ((and (pair? V1931) (and (eq? (quote cases) (car V1931)) (and (pair? (cdr V1931)) (pair? (cdr (cdr V1931)))))) (cons (quote if) (cons (car (cdr V1931)) (cons (car (cdr (cdr V1931))) (cons (kl:shen.cases-macro (cons (quote cases) (cdr (cdr (cdr V1931))))) (quote ())))))) ((and (pair? V1931) (and (eq? (quote cases) (car V1931)) (and (pair? (cdr V1931)) (null? (cdr (cdr V1931)))))) (simple-error "error: odd number of case elements\n")) (#t V1931))) (export shen.cases-macro) (quote shen.cases-macro)) -(begin (register-function-arity (quote shen.timer-macro) 1) (define (kl:shen.timer-macro V1933) (cond ((and (pair? V1933) (and (eq? (quote time) (car V1933)) (and (pair? (cdr V1933)) (null? (cdr (cdr V1933)))))) (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 V1933)) (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 V1933))) (export shen.timer-macro) (quote shen.timer-macro)) -(begin (register-function-arity (quote shen.tuple-up) 1) (define (kl:shen.tuple-up V1935) (cond ((pair? V1935) (cons (quote _waspvm_at_p) (cons (car V1935) (cons (kl:shen.tuple-up (cdr V1935)) (quote ()))))) (#t V1935))) (export shen.tuple-up) (quote shen.tuple-up)) -(begin (register-function-arity (quote shen.put/get-macro) 1) (define (kl:shen.put/get-macro V1937) (cond ((and (pair? V1937) (and (eq? (quote put) (car V1937)) (and (pair? (cdr V1937)) (and (pair? (cdr (cdr V1937))) (and (pair? (cdr (cdr (cdr V1937)))) (null? (cdr (cdr (cdr (cdr V1937)))))))))) (cons (quote put) (cons (car (cdr V1937)) (cons (car (cdr (cdr V1937))) (cons (car (cdr (cdr (cdr V1937)))) (cons (cons (quote value) (cons (quote *property-vector*) (quote ()))) (quote ()))))))) ((and (pair? V1937) (and (eq? (quote get) (car V1937)) (and (pair? (cdr V1937)) (and (pair? (cdr (cdr V1937))) (null? (cdr (cdr (cdr V1937)))))))) (cons (quote get) (cons (car (cdr V1937)) (cons (car (cdr (cdr V1937))) (cons (cons (quote value) (cons (quote *property-vector*) (quote ()))) (quote ())))))) ((and (pair? V1937) (and (eq? (quote unput) (car V1937)) (and (pair? (cdr V1937)) (and (pair? (cdr (cdr V1937))) (null? (cdr (cdr (cdr V1937)))))))) (cons (quote unput) (cons (car (cdr V1937)) (cons (car (cdr (cdr V1937))) (cons (cons (quote value) (cons (quote *property-vector*) (quote ()))) (quote ())))))) (#t V1937))) (export shen.put/get-macro) (quote shen.put/get-macro)) -(begin (register-function-arity (quote shen.function-macro) 1) (define (kl:shen.function-macro V1939) (cond ((and (pair? V1939) (and (eq? (quote function) (car V1939)) (and (pair? (cdr V1939)) (null? (cdr (cdr V1939)))))) (kl:shen.function-abstraction (car (cdr V1939)) (kl:arity (car (cdr V1939))))) (#t V1939))) (export shen.function-macro) (quote shen.function-macro)) -(begin (register-function-arity (quote shen.function-abstraction) 2) (define (kl:shen.function-abstraction V1942 V1943) (cond ((kl:= 0 V1943) (simple-error (kl:shen.app V1942 " has no lambda form\n" (quote shen.a)))) ((kl:= -1 V1943) (cons (quote function) (cons V1942 (quote ())))) (#t (kl:shen.function-abstraction-help V1942 V1943 (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 V1947 V1948 V1949) (cond ((kl:= 0 V1948) (cons V1947 V1949)) (#t (let ((X (kl:gensym (quote V)))) (cons (quote /.) (cons X (cons (kl:shen.function-abstraction-help V1947 (- V1948 1) (kl:append V1949 (cons X (quote ())))) (quote ())))))))) (export shen.function-abstraction-help) (quote shen.function-abstraction-help)) -(begin (register-function-arity (quote undefmacro) 1) (define (kl:undefmacro V1951) (let ((MacroReg (kl:value (quote shen.*macroreg*)))) (let ((Pos (kl:shen.findpos V1951 MacroReg))) (let ((Remove1 (kl:set (quote shen.*macroreg*) (kl:remove V1951 MacroReg)))) (let ((Remove2 (kl:set (quote *macros*) (kl:shen.remove-nth Pos (kl:value (quote *macros*)))))) V1951))))) (export undefmacro) (quote undefmacro)) -(begin (register-function-arity (quote shen.findpos) 2) (define (kl:shen.findpos V1961 V1962) (cond ((null? V1962) (simple-error (kl:shen.app V1961 " is not a macro\n" (quote shen.a)))) ((and (pair? V1962) (kl:= (car V1962) V1961)) 1) ((pair? V1962) (+ 1 (kl:shen.findpos V1961 (cdr V1962)))) (#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 V1967 V1968) (cond ((and (kl:= 1 V1967) (pair? V1968)) (cdr V1968)) ((pair? V1968) (cons (car V1968) (kl:shen.remove-nth (- V1967 1) (cdr V1968)))) (#t (kl:shen.f_error (quote shen.remove-nth))))) (export shen.remove-nth) (quote shen.remove-nth)) +(begin (register-function-arity (quote macroexpand) 1) (define (kl:macroexpand V690) (let ((Y (kl:shen.compose (kl:value (quote *macros*)) V690))) (if (kl:= V690 Y) V690 (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 V692) (cond ((and (pair? V692) (and (eq? (quote error) (car V692)) (pair? (cdr V692)))) (cons (quote simple-error) (cons (kl:shen.mkstr (car (cdr V692)) (cdr (cdr V692))) (quote ())))) (#t V692))) (export shen.error-macro) (quote shen.error-macro)) +(begin (register-function-arity (quote shen.output-macro) 1) (define (kl:shen.output-macro V694) (cond ((and (pair? V694) (and (eq? (quote output) (car V694)) (pair? (cdr V694)))) (cons (quote shen.prhush) (cons (kl:shen.mkstr (car (cdr V694)) (cdr (cdr V694))) (cons (cons (quote stoutput) (quote ())) (quote ()))))) ((and (pair? V694) (and (eq? (quote pr) (car V694)) (and (pair? (cdr V694)) (null? (cdr (cdr V694)))))) (cons (quote pr) (cons (car (cdr V694)) (cons (cons (quote stoutput) (quote ())) (quote ()))))) (#t V694))) (export shen.output-macro) (quote shen.output-macro)) +(begin (register-function-arity (quote shen.make-string-macro) 1) (define (kl:shen.make-string-macro V696) (cond ((and (pair? V696) (and (eq? (quote make-string) (car V696)) (pair? (cdr V696)))) (kl:shen.mkstr (car (cdr V696)) (cdr (cdr V696)))) (#t V696))) (export shen.make-string-macro) (quote shen.make-string-macro)) +(begin (register-function-arity (quote shen.input-macro) 1) (define (kl:shen.input-macro V698) (cond ((and (pair? V698) (and (eq? (quote lineread) (car V698)) (null? (cdr V698)))) (cons (quote lineread) (cons (cons (quote stinput) (quote ())) (quote ())))) ((and (pair? V698) (and (eq? (quote input) (car V698)) (null? (cdr V698)))) (cons (quote input) (cons (cons (quote stinput) (quote ())) (quote ())))) ((and (pair? V698) (and (eq? (quote read) (car V698)) (null? (cdr V698)))) (cons (quote read) (cons (cons (quote stinput) (quote ())) (quote ())))) ((and (pair? V698) (and (eq? (quote input+) (car V698)) (and (pair? (cdr V698)) (null? (cdr (cdr V698)))))) (cons (quote input+) (cons (car (cdr V698)) (cons (cons (quote stinput) (quote ())) (quote ()))))) ((and (pair? V698) (and (eq? (quote read-byte) (car V698)) (null? (cdr V698)))) (cons (quote read-byte) (cons (cons (quote stinput) (quote ())) (quote ())))) (#t V698))) (export shen.input-macro) (quote shen.input-macro)) +(begin (register-function-arity (quote shen.compose) 2) (define (kl:shen.compose V701 V702) (cond ((null? V701) V702) ((pair? V701) (kl:shen.compose (cdr V701) ((car V701) V702))) (#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 V704) (cond ((and (pair? V704) (and (eq? (quote compile) (car V704)) (and (pair? (cdr V704)) (and (pair? (cdr (cdr V704))) (null? (cdr (cdr (cdr V704)))))))) (cons (quote compile) (cons (car (cdr V704)) (cons (car (cdr (cdr V704))) (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 V704))) (export shen.compile-macro) (quote shen.compile-macro)) +(begin (register-function-arity (quote shen.prolog-macro) 1) (define (kl:shen.prolog-macro V706) (cond ((and (pair? V706) (eq? (quote prolog?) (car V706))) (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 V706)))) (let ((Vs (kl:shen.extract_vars (cdr V706)))) (let ((External (kl:shen.externally-bound (cdr V706)))) (let ((PrologVs (kl:difference Vs External))) (kl:shen.locally-bind-prolog-vs (quote NPP) PrologVs Calls))))) (quote ())))))) (#t V706))) (export shen.prolog-macro) (quote shen.prolog-macro)) +(begin (register-function-arity (quote shen.externally-bound) 1) (define (kl:shen.externally-bound V712) (cond ((and (pair? V712) (and (eq? (quote receive) (car V712)) (and (pair? (cdr V712)) (null? (cdr (cdr V712)))))) (cdr V712)) ((pair? V712) (kl:union (kl:shen.externally-bound (car V712)) (kl:shen.externally-bound (cdr V712)))) (#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 V730 V731 V732) (cond ((null? V731) V732) ((pair? V731) (cons (quote let) (cons (car V731) (cons (cons (quote shen.newpv) (cons V730 (quote ()))) (cons (kl:shen.locally-bind-prolog-vs V730 (cdr V731) V732) (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 V745 V746) (cond ((null? V746) #t) ((and (pair? V746) (eq? (quote !) (car V746))) (cons (quote cut) (cons #f (cons V745 (cons (cons (quote freeze) (cons (kl:shen.bld-prolog-call V745 (cdr V746)) (quote ()))) (quote ())))))) ((and (pair? V746) (and (pair? (car V746)) (and (eq? (quote when) (car (car V746))) (and (pair? (cdr (car V746))) (null? (cdr (cdr (car V746)))))))) (cons (quote fwhen) (cons (kl:shen.insert-deref (car (cdr (car V746))) V745) (cons V745 (cons (cons (quote freeze) (cons (kl:shen.bld-prolog-call V745 (cdr V746)) (quote ()))) (quote ())))))) ((and (pair? V746) (and (pair? (car V746)) (and (eq? (quote is) (car (car V746))) (and (pair? (cdr (car V746))) (and (pair? (cdr (cdr (car V746)))) (null? (cdr (cdr (cdr (car V746)))))))))) (cons (quote bind) (cons (car (cdr (car V746))) (cons (kl:shen.insert-deref (car (cdr (cdr (car V746)))) V745) (cons V745 (cons (cons (quote freeze) (cons (kl:shen.bld-prolog-call V745 (cdr V746)) (quote ()))) (quote ()))))))) ((and (pair? V746) (and (pair? (car V746)) (and (eq? (quote receive) (car (car V746))) (and (pair? (cdr (car V746))) (null? (cdr (cdr (car V746)))))))) (kl:shen.bld-prolog-call V745 (cdr V746))) ((and (pair? V746) (and (pair? (car V746)) (and (eq? (quote bind) (car (car V746))) (and (pair? (cdr (car V746))) (and (pair? (cdr (cdr (car V746)))) (null? (cdr (cdr (cdr (car V746)))))))))) (cons (quote bind) (cons (car (cdr (car V746))) (cons (kl:shen.insert-lazyderef (car (cdr (cdr (car V746)))) V745) (cons V745 (cons (cons (quote freeze) (cons (kl:shen.bld-prolog-call V745 (cdr V746)) (quote ()))) (quote ()))))))) ((and (pair? V746) (and (pair? (car V746)) (and (eq? (quote fwhen) (car (car V746))) (and (pair? (cdr (car V746))) (null? (cdr (cdr (car V746)))))))) (cons (quote fwhen) (cons (kl:shen.insert-lazyderef (car (cdr (car V746))) V745) (cons V745 (cons (cons (quote freeze) (cons (kl:shen.bld-prolog-call V745 (cdr V746)) (quote ()))) (quote ())))))) ((pair? V746) (kl:append (car V746) (cons V745 (cons (cons (quote freeze) (cons (kl:shen.bld-prolog-call V745 (cdr V746)) (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 V748) (cond ((and (pair? V748) (and (eq? (quote defprolog) (car V748)) (pair? (cdr V748)))) (kl:compile (lambda (Y) (kl:shen. Y)) (cdr V748) (lambda (Y) (kl:shen.prolog-error (car (cdr V748)) Y)))) (#t V748))) (export shen.defprolog-macro) (quote shen.defprolog-macro)) +(begin (register-function-arity (quote shen.datatype-macro) 1) (define (kl:shen.datatype-macro V750) (cond ((and (pair? V750) (and (eq? (quote datatype) (car V750)) (pair? (cdr V750)))) (cons (quote shen.process-datatype) (cons (kl:shen.intern-type (car (cdr V750))) (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 V750))) (cons (cons (quote function) (cons (quote shen.datatype-error) (quote ()))) (quote ()))))) (quote ()))))) (#t V750))) (export shen.datatype-macro) (quote shen.datatype-macro)) +(begin (register-function-arity (quote shen.intern-type) 1) (define (kl:shen.intern-type V752) (kl:intern (string-append (kl:str V752) "#type"))) (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 V754) (cond ((and (pair? V754) (and (eq? (quote _waspvm_at_s) (car V754)) (and (pair? (cdr V754)) (and (pair? (cdr (cdr V754))) (pair? (cdr (cdr (cdr V754)))))))) (cons (quote _waspvm_at_s) (cons (car (cdr V754)) (cons (kl:shen._waspvm_at_s-macro (cons (quote _waspvm_at_s) (cdr (cdr V754)))) (quote ()))))) ((and (pair? V754) (and (eq? (quote _waspvm_at_s) (car V754)) (and (pair? (cdr V754)) (and (pair? (cdr (cdr V754))) (and (null? (cdr (cdr (cdr V754)))) (string? (car (cdr V754)))))))) (let ((E (kl:explode (car (cdr V754))))) (if (> (kl:length E) 1) (kl:shen._waspvm_at_s-macro (cons (quote _waspvm_at_s) (kl:append E (cdr (cdr V754))))) V754))) (#t V754))) (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 V756) (cond ((and (pair? V756) (eq? (quote synonyms) (car V756))) (cons (quote shen.synonyms-help) (cons (kl:shen.rcons_form (kl:shen.curry-synonyms (cdr V756))) (quote ())))) (#t V756))) (export shen.synonyms-macro) (quote shen.synonyms-macro)) +(begin (register-function-arity (quote shen.curry-synonyms) 1) (define (kl:shen.curry-synonyms V758) (kl:map (lambda (X) (kl:shen.curry-type X)) V758)) (export shen.curry-synonyms) (quote shen.curry-synonyms)) +(begin (register-function-arity (quote shen.nl-macro) 1) (define (kl:shen.nl-macro V760) (cond ((and (pair? V760) (and (eq? (quote nl) (car V760)) (null? (cdr V760)))) (cons (quote nl) (cons 1 (quote ())))) (#t V760))) (export shen.nl-macro) (quote shen.nl-macro)) +(begin (register-function-arity (quote shen.assoc-macro) 1) (define (kl:shen.assoc-macro V762) (cond ((and (pair? V762) (and (pair? (cdr V762)) (and (pair? (cdr (cdr V762))) (and (pair? (cdr (cdr (cdr V762)))) (kl:element? (car V762) (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 V762) (cons (car (cdr V762)) (cons (kl:shen.assoc-macro (cons (car V762) (cdr (cdr V762)))) (quote ()))))) (#t V762))) (export shen.assoc-macro) (quote shen.assoc-macro)) +(begin (register-function-arity (quote shen.let-macro) 1) (define (kl:shen.let-macro V764) (cond ((and (pair? V764) (and (eq? (quote let) (car V764)) (and (pair? (cdr V764)) (and (pair? (cdr (cdr V764))) (and (pair? (cdr (cdr (cdr V764)))) (pair? (cdr (cdr (cdr (cdr V764)))))))))) (cons (quote let) (cons (car (cdr V764)) (cons (car (cdr (cdr V764))) (cons (kl:shen.let-macro (cons (quote let) (cdr (cdr (cdr V764))))) (quote ())))))) (#t V764))) (export shen.let-macro) (quote shen.let-macro)) +(begin (register-function-arity (quote shen.abs-macro) 1) (define (kl:shen.abs-macro V766) (cond ((and (pair? V766) (and (eq? (quote /.) (car V766)) (and (pair? (cdr V766)) (and (pair? (cdr (cdr V766))) (pair? (cdr (cdr (cdr V766)))))))) (cons (quote lambda) (cons (car (cdr V766)) (cons (kl:shen.abs-macro (cons (quote /.) (cdr (cdr V766)))) (quote ()))))) ((and (pair? V766) (and (eq? (quote /.) (car V766)) (and (pair? (cdr V766)) (and (pair? (cdr (cdr V766))) (null? (cdr (cdr (cdr V766)))))))) (cons (quote lambda) (cdr V766))) (#t V766))) (export shen.abs-macro) (quote shen.abs-macro)) +(begin (register-function-arity (quote shen.cases-macro) 1) (define (kl:shen.cases-macro V770) (cond ((and (pair? V770) (and (eq? (quote cases) (car V770)) (and (pair? (cdr V770)) (and (kl:= #t (car (cdr V770))) (pair? (cdr (cdr V770))))))) (car (cdr (cdr V770)))) ((and (pair? V770) (and (eq? (quote cases) (car V770)) (and (pair? (cdr V770)) (and (pair? (cdr (cdr V770))) (null? (cdr (cdr (cdr V770)))))))) (cons (quote if) (cons (car (cdr V770)) (cons (car (cdr (cdr V770))) (cons (cons (quote simple-error) (cons "error: cases exhausted" (quote ()))) (quote ())))))) ((and (pair? V770) (and (eq? (quote cases) (car V770)) (and (pair? (cdr V770)) (pair? (cdr (cdr V770)))))) (cons (quote if) (cons (car (cdr V770)) (cons (car (cdr (cdr V770))) (cons (kl:shen.cases-macro (cons (quote cases) (cdr (cdr (cdr V770))))) (quote ())))))) ((and (pair? V770) (and (eq? (quote cases) (car V770)) (and (pair? (cdr V770)) (null? (cdr (cdr V770)))))) (simple-error "error: odd number of case elements\n")) (#t V770))) (export shen.cases-macro) (quote shen.cases-macro)) +(begin (register-function-arity (quote shen.timer-macro) 1) (define (kl:shen.timer-macro V772) (cond ((and (pair? V772) (and (eq? (quote time) (car V772)) (and (pair? (cdr V772)) (null? (cdr (cdr V772)))))) (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 V772)) (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 V772))) (export shen.timer-macro) (quote shen.timer-macro)) +(begin (register-function-arity (quote shen.tuple-up) 1) (define (kl:shen.tuple-up V774) (cond ((pair? V774) (cons (quote _waspvm_at_p) (cons (car V774) (cons (kl:shen.tuple-up (cdr V774)) (quote ()))))) (#t V774))) (export shen.tuple-up) (quote shen.tuple-up)) +(begin (register-function-arity (quote shen.put/get-macro) 1) (define (kl:shen.put/get-macro V776) (cond ((and (pair? V776) (and (eq? (quote put) (car V776)) (and (pair? (cdr V776)) (and (pair? (cdr (cdr V776))) (and (pair? (cdr (cdr (cdr V776)))) (null? (cdr (cdr (cdr (cdr V776)))))))))) (cons (quote put) (cons (car (cdr V776)) (cons (car (cdr (cdr V776))) (cons (car (cdr (cdr (cdr V776)))) (cons (cons (quote value) (cons (quote *property-vector*) (quote ()))) (quote ()))))))) ((and (pair? V776) (and (eq? (quote get) (car V776)) (and (pair? (cdr V776)) (and (pair? (cdr (cdr V776))) (null? (cdr (cdr (cdr V776)))))))) (cons (quote get) (cons (car (cdr V776)) (cons (car (cdr (cdr V776))) (cons (cons (quote value) (cons (quote *property-vector*) (quote ()))) (quote ())))))) ((and (pair? V776) (and (eq? (quote unput) (car V776)) (and (pair? (cdr V776)) (and (pair? (cdr (cdr V776))) (null? (cdr (cdr (cdr V776)))))))) (cons (quote unput) (cons (car (cdr V776)) (cons (car (cdr (cdr V776))) (cons (cons (quote value) (cons (quote *property-vector*) (quote ()))) (quote ())))))) (#t V776))) (export shen.put/get-macro) (quote shen.put/get-macro)) +(begin (register-function-arity (quote shen.function-macro) 1) (define (kl:shen.function-macro V778) (cond ((and (pair? V778) (and (eq? (quote function) (car V778)) (and (pair? (cdr V778)) (null? (cdr (cdr V778)))))) (kl:shen.function-abstraction (car (cdr V778)) (kl:arity (car (cdr V778))))) (#t V778))) (export shen.function-macro) (quote shen.function-macro)) +(begin (register-function-arity (quote shen.function-abstraction) 2) (define (kl:shen.function-abstraction V781 V782) (cond ((kl:= 0 V782) (simple-error (kl:shen.app V781 " has no lambda form\n" (quote shen.a)))) ((kl:= -1 V782) (cons (quote function) (cons V781 (quote ())))) (#t (kl:shen.function-abstraction-help V781 V782 (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 V786 V787 V788) (cond ((kl:= 0 V787) (cons V786 V788)) (#t (let ((X (kl:gensym (quote V)))) (cons (quote /.) (cons X (cons (kl:shen.function-abstraction-help V786 (- V787 1) (kl:append V788 (cons X (quote ())))) (quote ())))))))) (export shen.function-abstraction-help) (quote shen.function-abstraction-help)) +(begin (register-function-arity (quote undefmacro) 1) (define (kl:undefmacro V790) (let ((MacroReg (kl:value (quote shen.*macroreg*)))) (let ((Pos (kl:shen.findpos V790 MacroReg))) (let ((Remove1 (kl:set (quote shen.*macroreg*) (kl:remove V790 MacroReg)))) (let ((Remove2 (kl:set (quote *macros*) (kl:shen.remove-nth Pos (kl:value (quote *macros*)))))) V790))))) (export undefmacro) (quote undefmacro)) +(begin (register-function-arity (quote shen.findpos) 2) (define (kl:shen.findpos V800 V801) (cond ((null? V801) (simple-error (kl:shen.app V800 " is not a macro\n" (quote shen.a)))) ((and (pair? V801) (kl:= (car V801) V800)) 1) ((pair? V801) (+ 1 (kl:shen.findpos V800 (cdr V801)))) (#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 V806 V807) (cond ((and (kl:= 1 V806) (pair? V807)) (cdr V807)) ((pair? V807) (cons (car V807) (kl:shen.remove-nth (- V806 1) (cdr V807)))) (#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 121d7cd..a161a29 100644 --- a/compiled/prolog.kl.ms +++ b/compiled/prolog.kl.ms @@ -1,99 +1,99 @@ (module "compiled/prolog.kl") "Copyright (c) 2010-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:\n\n1. Redistributions of source code must retain the above copyright notice,\nthis list of conditions and the following disclaimer.\n\n2. Redistributions in binary form must reproduce the above copyright notice,\nthis list of conditions and the following disclaimer in the documentation\nand/or other materials provided with the distribution.\n\n3. Neither the name of the copyright holder nor the names of its contributors\nmay be used to endorse or promote products derived from this software without\nspecific prior written permission.\n\nTHIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ''AS IS'' AND\nANY EXPRESS 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 THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE\nFOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL\nDAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR\nSERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER\nCAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,\nOR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE\nOF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.\n" -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1970) (let ((Parse_shen. (kl:shen. V1970))) (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 V1979 V1980) (cond ((and (pair? V1980) (and (pair? (cdr V1980)) (null? (cdr (cdr V1980))))) (simple-error (string-append "prolog syntax error in " (kl:shen.app V1979 (string-append " here:\n\n " (kl:shen.app (kl:shen.next-50 50 (car V1980)) "\n" (quote shen.a))) (quote shen.a))))) (#t (simple-error (string-append "prolog syntax error in " (kl:shen.app V1979 "\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 V1987 V1988) (cond ((null? V1988) "") ((kl:= 0 V1987) "") ((pair? V1988) (string-append (kl:shen.decons-string (car V1988)) (kl:shen.next-50 (- V1987 1) (cdr V1988)))) (#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 V1990) (cond ((and (pair? V1990) (and (eq? (quote cons) (car V1990)) (and (pair? (cdr V1990)) (and (pair? (cdr (cdr V1990))) (null? (cdr (cdr (cdr V1990)))))))) (kl:shen.app (kl:shen.eval-cons V1990) " " (quote shen.s))) (#t (kl:shen.app V1990 " " (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 V1993 V1994) (cond ((and (pair? V1994) (and (pair? (cdr V1994)) (null? (cdr (cdr V1994))))) (cons (cons V1993 (car V1994)) (cons (quote :-) (cdr V1994)))) (#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. V1996) (if (pair? (car V1996)) (let ((Parse_X (kl:shen.hdhd V1996))) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V1996) (kl:shen.hdtl V1996))) Parse_X)) (kl:fail))) (export shen.) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1998) (let ((YaccParse (let ((Parse_shen. (kl:shen. V1998))) (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: V1998))) (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. V2001) (let ((Parse_shen. (kl:shen. V2001))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (if (and (pair? (car Parse_shen.)) (eq? (quote <--) (kl:shen.hdhd Parse_shen.))) (let ((NewStream1999 (kl:shen.pair (kl:shen.tlhd Parse_shen.) (kl:shen.hdtl Parse_shen.)))) (let ((Parse_shen. (kl:shen. NewStream1999))) (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. V2003) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2003))) (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: V2003))) (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. V2005) (if (pair? (car V2005)) (let ((Parse_X (kl:shen.hdhd V2005))) (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 V2005) (kl:shen.hdtl V2005))) (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? V2011) (cond ((and (pair? V2011) (and (eq? (quote cons) (car V2011)) (and (pair? (cdr V2011)) (and (pair? (cdr (cdr V2011))) (null? (cdr (cdr (cdr V2011)))))))) (and (assert-boolean (kl:shen.legitimate-term? (car (cdr V2011)))) (assert-boolean (kl:shen.legitimate-term? (car (cdr (cdr V2011))))))) ((and (pair? V2011) (and (eq? (quote mode) (car V2011)) (and (pair? (cdr V2011)) (and (pair? (cdr (cdr V2011))) (and (eq? (quote +) (car (cdr (cdr V2011)))) (null? (cdr (cdr (cdr V2011))))))))) (kl:shen.legitimate-term? (car (cdr V2011)))) ((and (pair? V2011) (and (eq? (quote mode) (car V2011)) (and (pair? (cdr V2011)) (and (pair? (cdr (cdr V2011))) (and (eq? (quote -) (car (cdr (cdr V2011)))) (null? (cdr (cdr (cdr V2011))))))))) (kl:shen.legitimate-term? (car (cdr V2011)))) ((pair? V2011) #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 V2013) (cond ((and (pair? V2013) (and (eq? (quote cons) (car V2013)) (and (pair? (cdr V2013)) (and (pair? (cdr (cdr V2013))) (null? (cdr (cdr (cdr V2013)))))))) (cons (kl:shen.eval-cons (car (cdr V2013))) (kl:shen.eval-cons (car (cdr (cdr V2013)))))) ((and (pair? V2013) (and (eq? (quote mode) (car V2013)) (and (pair? (cdr V2013)) (and (pair? (cdr (cdr V2013))) (null? (cdr (cdr (cdr V2013)))))))) (cons (quote mode) (cons (kl:shen.eval-cons (car (cdr V2013))) (cdr (cdr V2013))))) (#t V2013))) (export shen.eval-cons) (quote shen.eval-cons)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2015) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2015))) (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: V2015))) (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. V2018) (let ((YaccParse (if (and (pair? (car V2018)) (eq? (quote !) (kl:shen.hdhd V2018))) (let ((NewStream2016 (kl:shen.pair (kl:shen.tlhd V2018) (kl:shen.hdtl V2018)))) (kl:shen.pair (car NewStream2016) (cons (quote cut) (cons (kl:intern "Throwcontrol") (quote ()))))) (kl:fail)))) (if (kl:= YaccParse (kl:fail)) (if (pair? (car V2018)) (let ((Parse_X (kl:shen.hdhd V2018))) (if (pair? Parse_X) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V2018) (kl:shen.hdtl V2018))) Parse_X) (kl:fail))) (kl:fail)) YaccParse))) (export shen.) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2020) (if (pair? (car V2020)) (let ((Parse_X (kl:shen.hdhd V2020))) (if (eq? Parse_X (quote _waspvm_sc_)) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V2020) (kl:shen.hdtl V2020))) Parse_X) (kl:fail))) (kl:fail))) (export shen.) (quote shen.)) -(begin (register-function-arity (quote cut) 3) (define (kl:cut V2024 V2025 V2026) (let ((Result (kl:thaw V2026))) (if (kl:= Result #f) V2024 Result))) (export cut) (quote cut)) -(begin (register-function-arity (quote shen.insert_modes) 1) (define (kl:shen.insert_modes V2028) (cond ((and (pair? V2028) (and (eq? (quote mode) (car V2028)) (and (pair? (cdr V2028)) (and (pair? (cdr (cdr V2028))) (null? (cdr (cdr (cdr V2028)))))))) V2028) ((null? V2028) (quote ())) ((pair? V2028) (cons (cons (quote mode) (cons (car V2028) (cons (quote +) (quote ())))) (cons (quote mode) (cons (kl:shen.insert_modes (cdr V2028)) (cons (quote -) (quote ())))))) (#t V2028))) (export shen.insert_modes) (quote shen.insert_modes)) -(begin (register-function-arity (quote shen.s-prolog) 1) (define (kl:shen.s-prolog V2030) (kl:map (lambda (X) (kl:eval X)) (kl:shen.prolog->shen V2030))) (export shen.s-prolog) (quote shen.s-prolog)) -(begin (register-function-arity (quote shen.prolog->shen) 1) (define (kl:shen.prolog->shen V2032) (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)) V2032))))) (export shen.prolog->shen) (quote shen.prolog->shen)) -(begin (register-function-arity (quote shen.s-prolog_clause) 1) (define (kl:shen.s-prolog_clause V2034) (cond ((and (pair? V2034) (and (pair? (cdr V2034)) (and (eq? (quote :-) (car (cdr V2034))) (and (pair? (cdr (cdr V2034))) (null? (cdr (cdr (cdr V2034)))))))) (cons (car V2034) (cons (quote :-) (cons (kl:map (lambda (X) (kl:shen.s-prolog_literal X)) (car (cdr (cdr V2034)))) (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 V2036) (cond ((and (pair? V2036) (and (pair? (cdr V2036)) (and (eq? (quote :-) (car (cdr V2036))) (and (pair? (cdr (cdr V2036))) (and (null? (cdr (cdr (cdr V2036)))) (assert-boolean (guard (lambda (_) #f) (< (kl:shen.complexity_head (car V2036)) (kl:value (quote shen.*maxcomplexity*)))))))))) (cons V2036 (quote ()))) ((and (pair? V2036) (and (pair? (car V2036)) (and (pair? (cdr V2036)) (and (eq? (quote :-) (car (cdr V2036))) (and (pair? (cdr (cdr V2036))) (null? (cdr (cdr (cdr V2036))))))))) (let ((Terms (kl:map (lambda (Y) (kl:gensym (quote V))) (cdr (car V2036))))) (let ((XTerms (kl:shen.rcons_form (kl:shen.remove_modes (cdr (car V2036)))))) (let ((Literal (cons (quote unify) (cons (kl:shen.cons_form Terms) (cons XTerms (quote ())))))) (let ((Clause (cons (cons (car (car V2036)) Terms) (cons (quote :-) (cons (cons Literal (car (cdr (cdr V2036)))) (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 V2042) (cond ((pair? V2042) (kl:shen.safe-product (kl:map (lambda (X) (kl:shen.complexity X)) (cdr V2042)))) (#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 V2045 V2046) (* V2045 V2046)) (export shen.safe-multiply) (quote shen.safe-multiply)) -(begin (register-function-arity (quote shen.complexity) 1) (define (kl:shen.complexity V2055) (cond ((and (pair? V2055) (and (eq? (quote mode) (car V2055)) (and (pair? (cdr V2055)) (and (pair? (car (cdr V2055))) (and (eq? (quote mode) (car (car (cdr V2055)))) (and (pair? (cdr (car (cdr V2055)))) (and (pair? (cdr (cdr (car (cdr V2055))))) (and (null? (cdr (cdr (cdr (car (cdr V2055)))))) (and (pair? (cdr (cdr V2055))) (null? (cdr (cdr (cdr V2055))))))))))))) (kl:shen.complexity (car (cdr V2055)))) ((and (pair? V2055) (and (eq? (quote mode) (car V2055)) (and (pair? (cdr V2055)) (and (pair? (car (cdr V2055))) (and (pair? (cdr (cdr V2055))) (and (eq? (quote +) (car (cdr (cdr V2055)))) (null? (cdr (cdr (cdr V2055)))))))))) (kl:shen.safe-multiply 2 (kl:shen.safe-multiply (kl:shen.complexity (cons (quote mode) (cons (car (car (cdr V2055))) (cdr (cdr V2055))))) (kl:shen.complexity (cons (quote mode) (cons (cdr (car (cdr V2055))) (cdr (cdr V2055)))))))) ((and (pair? V2055) (and (eq? (quote mode) (car V2055)) (and (pair? (cdr V2055)) (and (pair? (car (cdr V2055))) (and (pair? (cdr (cdr V2055))) (and (eq? (quote -) (car (cdr (cdr V2055)))) (null? (cdr (cdr (cdr V2055)))))))))) (kl:shen.safe-multiply (kl:shen.complexity (cons (quote mode) (cons (car (car (cdr V2055))) (cdr (cdr V2055))))) (kl:shen.complexity (cons (quote mode) (cons (cdr (car (cdr V2055))) (cdr (cdr V2055))))))) ((and (pair? V2055) (and (eq? (quote mode) (car V2055)) (and (pair? (cdr V2055)) (and (pair? (cdr (cdr V2055))) (and (null? (cdr (cdr (cdr V2055)))) (kl:variable? (car (cdr V2055)))))))) 1) ((and (pair? V2055) (and (eq? (quote mode) (car V2055)) (and (pair? (cdr V2055)) (and (pair? (cdr (cdr V2055))) (and (eq? (quote +) (car (cdr (cdr V2055)))) (null? (cdr (cdr (cdr V2055))))))))) 2) ((and (pair? V2055) (and (eq? (quote mode) (car V2055)) (and (pair? (cdr V2055)) (and (pair? (cdr (cdr V2055))) (and (eq? (quote -) (car (cdr (cdr V2055)))) (null? (cdr (cdr (cdr V2055))))))))) 1) (#t (kl:shen.complexity (cons (quote mode) (cons V2055 (cons (quote +) (quote ())))))))) (export shen.complexity) (quote shen.complexity)) -(begin (register-function-arity (quote shen.safe-product) 1) (define (kl:shen.safe-product V2057) (cond ((null? V2057) 1) ((pair? V2057) (kl:shen.safe-multiply (car V2057) (kl:shen.safe-product (cdr V2057)))) (#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 V2059) (cond ((and (pair? V2059) (and (eq? (quote is) (car V2059)) (and (pair? (cdr V2059)) (and (pair? (cdr (cdr V2059))) (null? (cdr (cdr (cdr V2059)))))))) (cons (quote bind) (cons (car (cdr V2059)) (cons (kl:shen.insert-deref (car (cdr (cdr V2059))) (quote ProcessN)) (quote ()))))) ((and (pair? V2059) (and (eq? (quote when) (car V2059)) (and (pair? (cdr V2059)) (null? (cdr (cdr V2059)))))) (cons (quote fwhen) (cons (kl:shen.insert-deref (car (cdr V2059)) (quote ProcessN)) (quote ())))) ((and (pair? V2059) (and (eq? (quote bind) (car V2059)) (and (pair? (cdr V2059)) (and (pair? (cdr (cdr V2059))) (null? (cdr (cdr (cdr V2059)))))))) (cons (quote bind) (cons (car (cdr V2059)) (cons (kl:shen.insert-lazyderef (car (cdr (cdr V2059))) (quote ProcessN)) (quote ()))))) ((and (pair? V2059) (and (eq? (quote fwhen) (car V2059)) (and (pair? (cdr V2059)) (null? (cdr (cdr V2059)))))) (cons (quote fwhen) (cons (kl:shen.insert-lazyderef (car (cdr V2059)) (quote ProcessN)) (quote ())))) ((pair? V2059) V2059) (#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 V2066 V2067) (cond ((kl:variable? V2066) (cons (quote shen.deref) (cons V2066 (cons V2067 (quote ()))))) ((and (pair? V2066) (and (eq? (quote lambda) (car V2066)) (and (pair? (cdr V2066)) (and (pair? (cdr (cdr V2066))) (null? (cdr (cdr (cdr V2066)))))))) (cons (quote lambda) (cons (car (cdr V2066)) (cons (kl:shen.insert-deref (car (cdr (cdr V2066))) V2067) (quote ()))))) ((and (pair? V2066) (and (eq? (quote let) (car V2066)) (and (pair? (cdr V2066)) (and (pair? (cdr (cdr V2066))) (and (pair? (cdr (cdr (cdr V2066)))) (null? (cdr (cdr (cdr (cdr V2066)))))))))) (cons (quote let) (cons (car (cdr V2066)) (cons (kl:shen.insert-deref (car (cdr (cdr V2066))) V2067) (cons (kl:shen.insert-deref (car (cdr (cdr (cdr V2066)))) V2067) (quote ())))))) ((pair? V2066) (cons (kl:shen.insert-deref (car V2066) V2067) (kl:shen.insert-deref (cdr V2066) V2067))) (#t V2066))) (export shen.insert-deref) (quote shen.insert-deref)) -(begin (register-function-arity (quote shen.insert-lazyderef) 2) (define (kl:shen.insert-lazyderef V2074 V2075) (cond ((kl:variable? V2074) (cons (quote shen.lazyderef) (cons V2074 (cons V2075 (quote ()))))) ((and (pair? V2074) (and (eq? (quote lambda) (car V2074)) (and (pair? (cdr V2074)) (and (pair? (cdr (cdr V2074))) (null? (cdr (cdr (cdr V2074)))))))) (cons (quote lambda) (cons (car (cdr V2074)) (cons (kl:shen.insert-lazyderef (car (cdr (cdr V2074))) V2075) (quote ()))))) ((and (pair? V2074) (and (eq? (quote let) (car V2074)) (and (pair? (cdr V2074)) (and (pair? (cdr (cdr V2074))) (and (pair? (cdr (cdr (cdr V2074)))) (null? (cdr (cdr (cdr (cdr V2074)))))))))) (cons (quote let) (cons (car (cdr V2074)) (cons (kl:shen.insert-lazyderef (car (cdr (cdr V2074))) V2075) (cons (kl:shen.insert-lazyderef (car (cdr (cdr (cdr V2074)))) V2075) (quote ())))))) ((pair? V2074) (cons (kl:shen.insert-lazyderef (car V2074) V2075) (kl:shen.insert-lazyderef (cdr V2074) V2075))) (#t V2074))) (export shen.insert-lazyderef) (quote shen.insert-lazyderef)) -(begin (register-function-arity (quote shen.group_clauses) 1) (define (kl:shen.group_clauses V2077) (cond ((null? V2077) (quote ())) ((pair? V2077) (let ((Group (kl:shen.collect (lambda (X) (kl:shen.same_predicate? (car V2077) X)) V2077))) (let ((Rest (kl:difference V2077 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 V2082 V2083) (cond ((null? V2083) (quote ())) ((pair? V2083) (if (assert-boolean (V2082 (car V2083))) (cons (car V2083) (kl:shen.collect V2082 (cdr V2083))) (kl:shen.collect V2082 (cdr V2083)))) (#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? V2102 V2103) (cond ((and (pair? V2102) (and (pair? (car V2102)) (and (pair? V2103) (pair? (car V2103))))) (kl:= (car (car V2102)) (car (car V2103)))) (#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 V2105) (let ((F (kl:shen.procedure_name V2105))) (let ((Shen (kl:shen.clauses-to-shen F V2105))) 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 V2119) (cond ((and (pair? V2119) (and (pair? (car V2119)) (pair? (car (car V2119))))) (car (car (car V2119)))) (#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 V2122 V2123) (let ((Linear (kl:map (lambda (X) (kl:shen.linearise-clause X)) V2123))) (let ((Arity (kl:shen.prolog-aritycheck V2122 (kl:map (lambda (X) (kl:head X)) V2123)))) (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 V2122 (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 V2125) (cond ((kl:not (kl:shen.occurs? (quote cut) V2125)) V2125) (#t (cons (quote let) (cons (quote Throwcontrol) (cons (cons (quote shen.catchpoint) (quote ())) (cons (cons (quote shen.cutpoint) (cons (quote Throwcontrol) (cons V2125 (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 V2133 V2134) (cond ((kl:= V2134 V2133) #f) (#t V2134))) (export shen.cutpoint) (quote shen.cutpoint)) -(begin (register-function-arity (quote shen.nest-disjunct) 1) (define (kl:shen.nest-disjunct V2136) (cond ((and (pair? V2136) (null? (cdr V2136))) (car V2136)) ((pair? V2136) (kl:shen.lisp-or (car V2136) (kl:shen.nest-disjunct (cdr V2136)))) (#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 V2139 V2140) (cons (quote let) (cons (quote Case) (cons V2139 (cons (cons (quote if) (cons (cons (quote =) (cons (quote Case) (cons #f (quote ())))) (cons V2140 (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 V2145 V2146) (cond ((and (pair? V2146) (null? (cdr V2146))) (- (kl:length (car V2146)) 1)) ((and (pair? V2146) (pair? (cdr V2146))) (if (kl:= (kl:length (car V2146)) (kl:length (car (cdr V2146)))) (kl:shen.prolog-aritycheck V2145 (cdr V2146)) (simple-error (string-append "arity error in prolog procedure " (kl:shen.app (cons V2145 (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 V2148) (cond ((and (pair? V2148) (and (pair? (cdr V2148)) (and (eq? (quote :-) (car (cdr V2148))) (and (pair? (cdr (cdr V2148))) (null? (cdr (cdr (cdr V2148)))))))) (let ((Linear (kl:shen.linearise (cons (car V2148) (cdr (cdr V2148)))))) (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 V2150) (cond ((and (pair? V2150) (and (pair? (cdr V2150)) (null? (cdr (cdr V2150))))) (cons (kl:shen.explicit_modes (car V2150)) (cons (quote :-) (cons (kl:shen.cf_help (car (cdr V2150))) (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 V2152) (cond ((pair? V2152) (cons (car V2152) (kl:map (lambda (X) (kl:shen.em_help X)) (cdr V2152)))) (#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 V2154) (cond ((and (pair? V2154) (and (eq? (quote mode) (car V2154)) (and (pair? (cdr V2154)) (and (pair? (cdr (cdr V2154))) (null? (cdr (cdr (cdr V2154)))))))) V2154) (#t (cons (quote mode) (cons V2154 (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 V2156) (cond ((and (pair? V2156) (and (eq? (quote where) (car V2156)) (and (pair? (cdr V2156)) (and (pair? (car (cdr V2156))) (and (eq? (quote =) (car (car (cdr V2156)))) (and (pair? (cdr (car (cdr V2156)))) (and (pair? (cdr (cdr (car (cdr V2156))))) (and (null? (cdr (cdr (cdr (car (cdr V2156)))))) (and (pair? (cdr (cdr V2156))) (null? (cdr (cdr (cdr V2156))))))))))))) (cons (cons (if (assert-boolean (kl:value (quote shen.*occurs*))) (quote unify!) (quote unify)) (cdr (car (cdr V2156)))) (kl:shen.cf_help (car (cdr (cdr V2156)))))) (#t V2156))) (export shen.cf_help) (quote shen.cf_help)) -(begin (register-function-arity (quote occurs-check) 1) (define (kl:occurs-check V2162) (cond ((eq? (quote +) V2162) (kl:set (quote shen.*occurs*) #t)) ((eq? (quote -) V2162) (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 V2165 V2166) (cond ((and (pair? V2165) (and (pair? (car V2165)) (and (pair? (cdr V2165)) (and (eq? (quote :-) (car (cdr V2165))) (and (pair? (cdr (cdr V2165))) (null? (cdr (cdr (cdr V2165))))))))) (let ((MuApplication (kl:shen.make_mu_application (cons (quote shen.mu) (cons (cdr (car V2165)) (cons (kl:shen.continuation_call (cdr (car V2165)) (car (cdr (cdr V2165)))) (quote ())))) V2166))) (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 V2169 V2170) (let ((VTerms (cons (quote ProcessN) (kl:shen.extract_vars V2169)))) (let ((VBody (kl:shen.extract_vars V2170))) (let ((Free (kl:remove (quote Throwcontrol) (kl:difference VBody VTerms)))) (kl:shen.cc_help Free V2170))))) (export shen.continuation_call) (quote shen.continuation_call)) -(begin (register-function-arity (quote remove) 2) (define (kl:remove V2173 V2174) (kl:shen.remove-h V2173 V2174 (quote ()))) (export remove) (quote remove)) -(begin (register-function-arity (quote shen.remove-h) 3) (define (kl:shen.remove-h V2181 V2182 V2183) (cond ((null? V2182) (kl:reverse V2183)) ((and (pair? V2182) (kl:= (car V2182) V2181)) (kl:shen.remove-h (car V2182) (cdr V2182) V2183)) ((pair? V2182) (kl:shen.remove-h V2181 (cdr V2182) (cons (car V2182) V2183))) (#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 V2186 V2187) (cond ((and (null? V2186) (null? V2187)) (cons (quote shen.pop) (cons (quote shen.the) (cons (quote shen.stack) (quote ()))))) ((null? V2187) (cons (quote shen.rename) (cons (quote shen.the) (cons (quote shen.variables) (cons (quote in) (cons V2186 (cons (quote and) (cons (quote shen.then) (cons (cons (quote shen.pop) (cons (quote shen.the) (cons (quote shen.stack) (quote ())))) (quote ())))))))))) ((null? V2186) (cons (quote call) (cons (quote shen.the) (cons (quote shen.continuation) (cons V2187 (quote ())))))) (#t (cons (quote shen.rename) (cons (quote shen.the) (cons (quote shen.variables) (cons (quote in) (cons V2186 (cons (quote and) (cons (quote shen.then) (cons (cons (quote call) (cons (quote shen.the) (cons (quote shen.continuation) (cons V2187 (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 V2190 V2191) (cond ((and (pair? V2190) (and (eq? (quote shen.mu) (car V2190)) (and (pair? (cdr V2190)) (and (null? (car (cdr V2190))) (and (pair? (cdr (cdr V2190))) (and (null? (cdr (cdr (cdr V2190)))) (null? V2191))))))) (car (cdr (cdr V2190)))) ((and (pair? V2190) (and (eq? (quote shen.mu) (car V2190)) (and (pair? (cdr V2190)) (and (pair? (car (cdr V2190))) (and (pair? (cdr (cdr V2190))) (and (null? (cdr (cdr (cdr V2190)))) (pair? V2191))))))) (cons (cons (quote shen.mu) (cons (car (car (cdr V2190))) (cons (kl:shen.make_mu_application (cons (quote shen.mu) (cons (cdr (car (cdr V2190))) (cdr (cdr V2190)))) (cdr V2191)) (quote ())))) (cons (car V2191) (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 V2200 V2201) (cond ((and (pair? V2200) (and (pair? (car V2200)) (and (eq? (quote shen.mu) (car (car V2200))) (and (pair? (cdr (car V2200))) (and (pair? (car (cdr (car V2200)))) (and (eq? (quote mode) (car (car (cdr (car V2200))))) (and (pair? (cdr (car (cdr (car V2200))))) (and (pair? (cdr (cdr (car (cdr (car V2200)))))) (and (null? (cdr (cdr (cdr (car (cdr (car V2200))))))) (and (pair? (cdr (cdr (car V2200)))) (and (null? (cdr (cdr (cdr (car V2200))))) (and (pair? (cdr V2200)) (null? (cdr (cdr V2200))))))))))))))) (kl:shen.mu_reduction (cons (cons (quote shen.mu) (cons (car (cdr (car (cdr (car V2200))))) (cdr (cdr (car V2200))))) (cdr V2200)) (car (cdr (cdr (car (cdr (car V2200)))))))) ((and (pair? V2200) (and (pair? (car V2200)) (and (eq? (quote shen.mu) (car (car V2200))) (and (pair? (cdr (car V2200))) (and (pair? (cdr (cdr (car V2200)))) (and (null? (cdr (cdr (cdr (car V2200))))) (and (pair? (cdr V2200)) (and (null? (cdr (cdr V2200))) (eq? (quote _) (car (cdr (car V2200)))))))))))) (kl:shen.mu_reduction (car (cdr (cdr (car V2200)))) V2201)) ((and (pair? V2200) (and (pair? (car V2200)) (and (eq? (quote shen.mu) (car (car V2200))) (and (pair? (cdr (car V2200))) (and (pair? (cdr (cdr (car V2200)))) (and (null? (cdr (cdr (cdr (car V2200))))) (and (pair? (cdr V2200)) (and (null? (cdr (cdr V2200))) (assert-boolean (kl:shen.ephemeral_variable? (car (cdr (car V2200))) (car (cdr V2200)))))))))))) (kl:subst (car (cdr V2200)) (car (cdr (car V2200))) (kl:shen.mu_reduction (car (cdr (cdr (car V2200)))) V2201))) ((and (pair? V2200) (and (pair? (car V2200)) (and (eq? (quote shen.mu) (car (car V2200))) (and (pair? (cdr (car V2200))) (and (pair? (cdr (cdr (car V2200)))) (and (null? (cdr (cdr (cdr (car V2200))))) (and (pair? (cdr V2200)) (and (null? (cdr (cdr V2200))) (kl:variable? (car (cdr (car V2200)))))))))))) (cons (quote let) (cons (car (cdr (car V2200))) (cons (quote shen.be) (cons (car (cdr V2200)) (cons (quote in) (cons (kl:shen.mu_reduction (car (cdr (cdr (car V2200)))) V2201) (quote ())))))))) ((and (pair? V2200) (and (pair? (car V2200)) (and (eq? (quote shen.mu) (car (car V2200))) (and (pair? (cdr (car V2200))) (and (pair? (cdr (cdr (car V2200)))) (and (null? (cdr (cdr (cdr (car V2200))))) (and (pair? (cdr V2200)) (and (null? (cdr (cdr V2200))) (and (eq? (quote -) V2201) (assert-boolean (kl:shen.prolog_constant? (car (cdr (car V2200)))))))))))))) (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 V2200))))) (cons (quote in) (cons (cons (quote if) (cons (cons Z (cons (quote is) (cons (quote identical) (cons (quote shen.to) (cons (car (cdr (car V2200))) (quote ())))))) (cons (quote shen.then) (cons (kl:shen.mu_reduction (car (cdr (cdr (car V2200)))) (quote -)) (cons (quote shen.else) (cons (quote shen.failed!) (quote ()))))))) (quote ()))))))))) ((and (pair? V2200) (and (pair? (car V2200)) (and (eq? (quote shen.mu) (car (car V2200))) (and (pair? (cdr (car V2200))) (and (pair? (cdr (cdr (car V2200)))) (and (null? (cdr (cdr (cdr (car V2200))))) (and (pair? (cdr V2200)) (and (null? (cdr (cdr V2200))) (and (eq? (quote +) V2201) (assert-boolean (kl:shen.prolog_constant? (car (cdr (car V2200)))))))))))))) (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 V2200))))) (cons (quote in) (cons (cons (quote if) (cons (cons Z (cons (quote is) (cons (quote identical) (cons (quote shen.to) (cons (car (cdr (car V2200))) (quote ())))))) (cons (quote shen.then) (cons (kl:shen.mu_reduction (car (cdr (cdr (car V2200)))) (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 V2200))) (cons (quote in) (cons (kl:shen.mu_reduction (car (cdr (cdr (car V2200)))) (quote +)) (quote ()))))))) (cons (quote shen.else) (cons (quote shen.failed!) (quote ()))))))) (quote ()))))))) (quote ()))))))))) ((and (pair? V2200) (and (pair? (car V2200)) (and (eq? (quote shen.mu) (car (car V2200))) (and (pair? (cdr (car V2200))) (and (pair? (car (cdr (car V2200)))) (and (pair? (cdr (cdr (car V2200)))) (and (null? (cdr (cdr (cdr (car V2200))))) (and (pair? (cdr V2200)) (and (null? (cdr (cdr V2200))) (eq? (quote -) V2201)))))))))) (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 V2200))))) (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 V2200)))) (cons (cons (cons (quote shen.mu) (cons (cdr (car (cdr (car V2200)))) (cdr (cdr (car V2200))))) (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? V2200) (and (pair? (car V2200)) (and (eq? (quote shen.mu) (car (car V2200))) (and (pair? (cdr (car V2200))) (and (pair? (car (cdr (car V2200)))) (and (pair? (cdr (cdr (car V2200)))) (and (null? (cdr (cdr (cdr (car V2200))))) (and (pair? (cdr V2200)) (and (null? (cdr (cdr V2200))) (eq? (quote +) V2201)))))))))) (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 V2200))))) (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 V2200)))) (cons (cons (cons (quote shen.mu) (cons (cdr (car (cdr (car V2200)))) (cdr (cdr (car V2200))))) (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 V2200)))) (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 V2200))))) (cons (quote in) (cons (kl:shen.mu_reduction (car (cdr (cdr (car V2200)))) (quote +)) (quote ()))))))) (quote ()))))))))) (cons (quote shen.else) (cons (quote shen.failed!) (quote ()))))))) (quote ()))))))) (quote ()))))))))) (#t V2200))) (export shen.mu_reduction) (quote shen.mu_reduction)) -(begin (register-function-arity (quote shen.rcons_form) 1) (define (kl:shen.rcons_form V2203) (cond ((pair? V2203) (cons (quote cons) (cons (kl:shen.rcons_form (car V2203)) (cons (kl:shen.rcons_form (cdr V2203)) (quote ()))))) (#t V2203))) (export shen.rcons_form) (quote shen.rcons_form)) -(begin (register-function-arity (quote shen.remove_modes) 1) (define (kl:shen.remove_modes V2205) (cond ((and (pair? V2205) (and (eq? (quote mode) (car V2205)) (and (pair? (cdr V2205)) (and (pair? (cdr (cdr V2205))) (and (eq? (quote +) (car (cdr (cdr V2205)))) (null? (cdr (cdr (cdr V2205))))))))) (kl:shen.remove_modes (car (cdr V2205)))) ((and (pair? V2205) (and (eq? (quote mode) (car V2205)) (and (pair? (cdr V2205)) (and (pair? (cdr (cdr V2205))) (and (eq? (quote -) (car (cdr (cdr V2205)))) (null? (cdr (cdr (cdr V2205))))))))) (kl:shen.remove_modes (car (cdr V2205)))) ((pair? V2205) (cons (kl:shen.remove_modes (car V2205)) (kl:shen.remove_modes (cdr V2205)))) (#t V2205))) (export shen.remove_modes) (quote shen.remove_modes)) -(begin (register-function-arity (quote shen.ephemeral_variable?) 2) (define (kl:shen.ephemeral_variable? V2208 V2209) (and (kl:variable? V2208) (kl:variable? V2209))) (export shen.ephemeral_variable?) (quote shen.ephemeral_variable?)) -(begin (register-function-arity (quote shen.prolog_constant?) 1) (define (kl:shen.prolog_constant? V2219) (cond ((pair? V2219) #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 V2221) (cond ((and (pair? V2221) (and (eq? (quote let) (car V2221)) (and (pair? (cdr V2221)) (and (pair? (cdr (cdr V2221))) (and (eq? (quote shen.be) (car (cdr (cdr V2221)))) (and (pair? (cdr (cdr (cdr V2221)))) (and (pair? (cdr (cdr (cdr (cdr V2221))))) (and (eq? (quote in) (car (cdr (cdr (cdr (cdr V2221)))))) (and (pair? (cdr (cdr (cdr (cdr (cdr V2221)))))) (null? (cdr (cdr (cdr (cdr (cdr (cdr V2221)))))))))))))))) (cons (quote let) (cons (car (cdr V2221)) (cons (kl:shen.aum_to_shen (car (cdr (cdr (cdr V2221))))) (cons (kl:shen.aum_to_shen (car (cdr (cdr (cdr (cdr (cdr V2221))))))) (quote ())))))) ((and (pair? V2221) (and (eq? (quote shen.the) (car V2221)) (and (pair? (cdr V2221)) (and (eq? (quote shen.result) (car (cdr V2221))) (and (pair? (cdr (cdr V2221))) (and (eq? (quote shen.of) (car (cdr (cdr V2221)))) (and (pair? (cdr (cdr (cdr V2221)))) (and (eq? (quote shen.dereferencing) (car (cdr (cdr (cdr V2221))))) (and (pair? (cdr (cdr (cdr (cdr V2221))))) (null? (cdr (cdr (cdr (cdr (cdr V2221))))))))))))))) (cons (quote shen.lazyderef) (cons (kl:shen.aum_to_shen (car (cdr (cdr (cdr (cdr V2221)))))) (cons (quote ProcessN) (quote ()))))) ((and (pair? V2221) (and (eq? (quote if) (car V2221)) (and (pair? (cdr V2221)) (and (pair? (cdr (cdr V2221))) (and (eq? (quote shen.then) (car (cdr (cdr V2221)))) (and (pair? (cdr (cdr (cdr V2221)))) (and (pair? (cdr (cdr (cdr (cdr V2221))))) (and (eq? (quote shen.else) (car (cdr (cdr (cdr (cdr V2221)))))) (and (pair? (cdr (cdr (cdr (cdr (cdr V2221)))))) (null? (cdr (cdr (cdr (cdr (cdr (cdr V2221)))))))))))))))) (cons (quote if) (cons (kl:shen.aum_to_shen (car (cdr V2221))) (cons (kl:shen.aum_to_shen (car (cdr (cdr (cdr V2221))))) (cons (kl:shen.aum_to_shen (car (cdr (cdr (cdr (cdr (cdr V2221))))))) (quote ())))))) ((and (pair? V2221) (and (pair? (cdr V2221)) (and (eq? (quote is) (car (cdr V2221))) (and (pair? (cdr (cdr V2221))) (and (eq? (quote shen.a) (car (cdr (cdr V2221)))) (and (pair? (cdr (cdr (cdr V2221)))) (and (eq? (quote shen.variable) (car (cdr (cdr (cdr V2221))))) (null? (cdr (cdr (cdr (cdr V2221)))))))))))) (cons (quote shen.pvar?) (cons (car V2221) (quote ())))) ((and (pair? V2221) (and (pair? (cdr V2221)) (and (eq? (quote is) (car (cdr V2221))) (and (pair? (cdr (cdr V2221))) (and (eq? (quote shen.a) (car (cdr (cdr V2221)))) (and (pair? (cdr (cdr (cdr V2221)))) (and (eq? (quote shen.non-empty) (car (cdr (cdr (cdr V2221))))) (and (pair? (cdr (cdr (cdr (cdr V2221))))) (and (eq? (quote list) (car (cdr (cdr (cdr (cdr V2221)))))) (null? (cdr (cdr (cdr (cdr (cdr V2221))))))))))))))) (cons (quote cons?) (cons (car V2221) (quote ())))) ((and (pair? V2221) (and (eq? (quote shen.rename) (car V2221)) (and (pair? (cdr V2221)) (and (eq? (quote shen.the) (car (cdr V2221))) (and (pair? (cdr (cdr V2221))) (and (eq? (quote shen.variables) (car (cdr (cdr V2221)))) (and (pair? (cdr (cdr (cdr V2221)))) (and (eq? (quote in) (car (cdr (cdr (cdr V2221))))) (and (pair? (cdr (cdr (cdr (cdr V2221))))) (and (null? (car (cdr (cdr (cdr (cdr V2221)))))) (and (pair? (cdr (cdr (cdr (cdr (cdr V2221)))))) (and (eq? (quote and) (car (cdr (cdr (cdr (cdr (cdr V2221))))))) (and (pair? (cdr (cdr (cdr (cdr (cdr (cdr V2221))))))) (and (eq? (quote shen.then) (car (cdr (cdr (cdr (cdr (cdr (cdr V2221)))))))) (and (pair? (cdr (cdr (cdr (cdr (cdr (cdr (cdr V2221)))))))) (null? (cdr (cdr (cdr (cdr (cdr (cdr (cdr (cdr V2221)))))))))))))))))))))))) (kl:shen.aum_to_shen (car (cdr (cdr (cdr (cdr (cdr (cdr (cdr V2221)))))))))) ((and (pair? V2221) (and (eq? (quote shen.rename) (car V2221)) (and (pair? (cdr V2221)) (and (eq? (quote shen.the) (car (cdr V2221))) (and (pair? (cdr (cdr V2221))) (and (eq? (quote shen.variables) (car (cdr (cdr V2221)))) (and (pair? (cdr (cdr (cdr V2221)))) (and (eq? (quote in) (car (cdr (cdr (cdr V2221))))) (and (pair? (cdr (cdr (cdr (cdr V2221))))) (and (pair? (car (cdr (cdr (cdr (cdr V2221)))))) (and (pair? (cdr (cdr (cdr (cdr (cdr V2221)))))) (and (eq? (quote and) (car (cdr (cdr (cdr (cdr (cdr V2221))))))) (and (pair? (cdr (cdr (cdr (cdr (cdr (cdr V2221))))))) (and (eq? (quote shen.then) (car (cdr (cdr (cdr (cdr (cdr (cdr V2221)))))))) (and (pair? (cdr (cdr (cdr (cdr (cdr (cdr (cdr V2221)))))))) (null? (cdr (cdr (cdr (cdr (cdr (cdr (cdr (cdr V2221)))))))))))))))))))))))) (cons (quote let) (cons (car (car (cdr (cdr (cdr (cdr V2221)))))) (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 V2221)))))) (cdr (cdr (cdr (cdr (cdr V2221))))))))))) (quote ())))))) ((and (pair? V2221) (and (eq? (quote bind) (car V2221)) (and (pair? (cdr V2221)) (and (pair? (cdr (cdr V2221))) (and (eq? (quote shen.to) (car (cdr (cdr V2221)))) (and (pair? (cdr (cdr (cdr V2221)))) (and (pair? (cdr (cdr (cdr (cdr V2221))))) (and (eq? (quote in) (car (cdr (cdr (cdr (cdr V2221)))))) (and (pair? (cdr (cdr (cdr (cdr (cdr V2221)))))) (null? (cdr (cdr (cdr (cdr (cdr (cdr V2221)))))))))))))))) (cons (quote do) (cons (cons (quote shen.bindv) (cons (car (cdr V2221)) (cons (kl:shen.chwild (car (cdr (cdr (cdr V2221))))) (cons (quote ProcessN) (quote ()))))) (cons (cons (quote let) (cons (quote Result) (cons (kl:shen.aum_to_shen (car (cdr (cdr (cdr (cdr (cdr V2221))))))) (cons (cons (quote do) (cons (cons (quote shen.unbindv) (cons (car (cdr V2221)) (cons (quote ProcessN) (quote ())))) (cons (quote Result) (quote ())))) (quote ()))))) (quote ()))))) ((and (pair? V2221) (and (pair? (cdr V2221)) (and (eq? (quote is) (car (cdr V2221))) (and (pair? (cdr (cdr V2221))) (and (eq? (quote identical) (car (cdr (cdr V2221)))) (and (pair? (cdr (cdr (cdr V2221)))) (and (eq? (quote shen.to) (car (cdr (cdr (cdr V2221))))) (and (pair? (cdr (cdr (cdr (cdr V2221))))) (null? (cdr (cdr (cdr (cdr (cdr V2221)))))))))))))) (cons (quote =) (cons (car (cdr (cdr (cdr (cdr V2221))))) (cons (car V2221) (quote ()))))) ((eq? (quote shen.failed!) V2221) #f) ((and (pair? V2221) (and (eq? (quote shen.the) (car V2221)) (and (pair? (cdr V2221)) (and (eq? (quote head) (car (cdr V2221))) (and (pair? (cdr (cdr V2221))) (and (eq? (quote shen.of) (car (cdr (cdr V2221)))) (and (pair? (cdr (cdr (cdr V2221)))) (null? (cdr (cdr (cdr (cdr V2221)))))))))))) (cons (quote hd) (cdr (cdr (cdr V2221))))) ((and (pair? V2221) (and (eq? (quote shen.the) (car V2221)) (and (pair? (cdr V2221)) (and (eq? (quote tail) (car (cdr V2221))) (and (pair? (cdr (cdr V2221))) (and (eq? (quote shen.of) (car (cdr (cdr V2221)))) (and (pair? (cdr (cdr (cdr V2221)))) (null? (cdr (cdr (cdr (cdr V2221)))))))))))) (cons (quote tl) (cdr (cdr (cdr V2221))))) ((and (pair? V2221) (and (eq? (quote shen.pop) (car V2221)) (and (pair? (cdr V2221)) (and (eq? (quote shen.the) (car (cdr V2221))) (and (pair? (cdr (cdr V2221))) (and (eq? (quote shen.stack) (car (cdr (cdr V2221)))) (null? (cdr (cdr (cdr V2221)))))))))) (cons (quote do) (cons (cons (quote shen.incinfs) (quote ())) (cons (cons (quote thaw) (cons (quote Continuation) (quote ()))) (quote ()))))) ((and (pair? V2221) (and (eq? (quote call) (car V2221)) (and (pair? (cdr V2221)) (and (eq? (quote shen.the) (car (cdr V2221))) (and (pair? (cdr (cdr V2221))) (and (eq? (quote shen.continuation) (car (cdr (cdr V2221)))) (and (pair? (cdr (cdr (cdr V2221)))) (null? (cdr (cdr (cdr (cdr V2221)))))))))))) (cons (quote do) (cons (cons (quote shen.incinfs) (quote ())) (cons (kl:shen.call_the_continuation (kl:shen.chwild (car (cdr (cdr (cdr V2221))))) (quote ProcessN) (quote Continuation)) (quote ()))))) (#t V2221))) (export shen.aum_to_shen) (quote shen.aum_to_shen)) -(begin (register-function-arity (quote shen.chwild) 1) (define (kl:shen.chwild V2223) (cond ((eq? V2223 (quote _)) (cons (quote shen.newpv) (cons (quote ProcessN) (quote ())))) ((pair? V2223) (kl:map (lambda (Z) (kl:shen.chwild Z)) V2223)) (#t V2223))) (export shen.chwild) (quote shen.chwild)) -(begin (register-function-arity (quote shen.newpv) 1) (define (kl:shen.newpv V2225) (let ((Count+1 (+ (vector-ref (kl:value (quote shen.*varcounter*)) V2225) 1))) (let ((IncVar (let ((_tmp (kl:value (quote shen.*varcounter*)))) (vector-set! _tmp V2225 Count+1) _tmp))) (let ((Vector (vector-ref (kl:value (quote shen.*prologvectors*)) V2225))) (let ((ResizeVectorIfNeeded (if (kl:= Count+1 (kl:limit Vector)) (kl:shen.resizeprocessvector V2225 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 V2228 V2229) (let ((Vector (vector-ref (kl:value (quote shen.*prologvectors*)) V2228))) (let ((BigVector (kl:shen.resize-vector Vector (+ V2229 V2229) (quote shen.-null-)))) (let ((_tmp (kl:value (quote shen.*prologvectors*)))) (vector-set! _tmp V2228 BigVector) _tmp)))) (export shen.resizeprocessvector) (quote shen.resizeprocessvector)) -(begin (register-function-arity (quote shen.resize-vector) 3) (define (kl:shen.resize-vector V2233 V2234 V2235) (let ((BigVector (let ((_tmp (make-vector (+ 1 V2234) (quote (quote shen.fail!))))) (vector-set! _tmp 0 V2234) _tmp))) (kl:shen.copy-vector V2233 BigVector (kl:limit V2233) V2234 V2235))) (export shen.resize-vector) (quote shen.resize-vector)) -(begin (register-function-arity (quote shen.copy-vector) 5) (define (kl:shen.copy-vector V2241 V2242 V2243 V2244 V2245) (kl:shen.copy-vector-stage-2 (+ 1 V2243) (+ V2244 1) V2245 (kl:shen.copy-vector-stage-1 1 V2241 V2242 (+ 1 V2243)))) (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 V2253 V2254 V2255 V2256) (cond ((kl:= V2256 V2253) V2255) (#t (kl:shen.copy-vector-stage-1 (+ 1 V2253) V2254 (let ((_tmp V2255)) (vector-set! _tmp V2253 (vector-ref V2254 V2253)) _tmp) V2256)))) (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 V2264 V2265 V2266 V2267) (cond ((kl:= V2265 V2264) V2267) (#t (kl:shen.copy-vector-stage-2 (+ V2264 1) V2265 V2266 (let ((_tmp V2267)) (vector-set! _tmp V2264 V2266) _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 V2269) (let ((_tmp (let ((_tmp (make-vector 2 (quote (quote shen.fail!))))) (vector-set! _tmp 0 (quote shen.pvar)) _tmp))) (vector-set! _tmp 1 V2269) _tmp)) (export shen.mk-pvar) (quote shen.mk-pvar)) -(begin (register-function-arity (quote shen.pvar?) 1) (define (kl:shen.pvar? V2271) (and (vector? V2271) (eq? (guard (lambda (E) (quote shen.not-pvar)) (vector-ref V2271 0)) (quote shen.pvar)))) (export shen.pvar?) (quote shen.pvar?)) -(begin (register-function-arity (quote shen.bindv) 3) (define (kl:shen.bindv V2275 V2276 V2277) (let ((Vector (vector-ref (kl:value (quote shen.*prologvectors*)) V2277))) (let ((_tmp Vector)) (vector-set! _tmp (vector-ref V2275 1) V2276) _tmp))) (export shen.bindv) (quote shen.bindv)) -(begin (register-function-arity (quote shen.unbindv) 2) (define (kl:shen.unbindv V2280 V2281) (let ((Vector (vector-ref (kl:value (quote shen.*prologvectors*)) V2281))) (let ((_tmp Vector)) (vector-set! _tmp (vector-ref V2280 1) (quote shen.-null-)) _tmp))) (export shen.unbindv) (quote shen.unbindv)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V809) (let ((Parse_shen. (kl:shen. V809))) (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 V818 V819) (cond ((and (pair? V819) (and (pair? (cdr V819)) (null? (cdr (cdr V819))))) (simple-error (string-append "prolog syntax error in " (kl:shen.app V818 (string-append " here:\n\n " (kl:shen.app (kl:shen.next-50 50 (car V819)) "\n" (quote shen.a))) (quote shen.a))))) (#t (simple-error (string-append "prolog syntax error in " (kl:shen.app V818 "\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 V826 V827) (cond ((null? V827) "") ((kl:= 0 V826) "") ((pair? V827) (string-append (kl:shen.decons-string (car V827)) (kl:shen.next-50 (- V826 1) (cdr V827)))) (#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 V829) (cond ((and (pair? V829) (and (eq? (quote cons) (car V829)) (and (pair? (cdr V829)) (and (pair? (cdr (cdr V829))) (null? (cdr (cdr (cdr V829)))))))) (kl:shen.app (kl:shen.eval-cons V829) " " (quote shen.s))) (#t (kl:shen.app V829 " " (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 V832 V833) (cond ((and (pair? V833) (and (pair? (cdr V833)) (null? (cdr (cdr V833))))) (cons (cons V832 (car V833)) (cons (quote :-) (cdr V833)))) (#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. V835) (if (pair? (car V835)) (let ((Parse_X (kl:shen.hdhd V835))) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V835) (kl:shen.hdtl V835))) Parse_X)) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V837) (let ((YaccParse (let ((Parse_shen. (kl:shen. V837))) (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: V837))) (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. V840) (let ((Parse_shen. (kl:shen. V840))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (if (and (pair? (car Parse_shen.)) (eq? (quote <--) (kl:shen.hdhd Parse_shen.))) (let ((NewStream838 (kl:shen.pair (kl:shen.tlhd Parse_shen.) (kl:shen.hdtl Parse_shen.)))) (let ((Parse_shen. (kl:shen. NewStream838))) (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. V842) (let ((YaccParse (let ((Parse_shen. (kl:shen. V842))) (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: V842))) (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. V844) (if (pair? (car V844)) (let ((Parse_X (kl:shen.hdhd V844))) (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 V844) (kl:shen.hdtl V844))) (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? V850) (cond ((and (pair? V850) (and (eq? (quote cons) (car V850)) (and (pair? (cdr V850)) (and (pair? (cdr (cdr V850))) (null? (cdr (cdr (cdr V850)))))))) (and (assert-boolean (kl:shen.legitimate-term? (car (cdr V850)))) (assert-boolean (kl:shen.legitimate-term? (car (cdr (cdr V850))))))) ((and (pair? V850) (and (eq? (quote mode) (car V850)) (and (pair? (cdr V850)) (and (pair? (cdr (cdr V850))) (and (eq? (quote +) (car (cdr (cdr V850)))) (null? (cdr (cdr (cdr V850))))))))) (kl:shen.legitimate-term? (car (cdr V850)))) ((and (pair? V850) (and (eq? (quote mode) (car V850)) (and (pair? (cdr V850)) (and (pair? (cdr (cdr V850))) (and (eq? (quote -) (car (cdr (cdr V850)))) (null? (cdr (cdr (cdr V850))))))))) (kl:shen.legitimate-term? (car (cdr V850)))) ((pair? V850) #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 V852) (cond ((and (pair? V852) (and (eq? (quote cons) (car V852)) (and (pair? (cdr V852)) (and (pair? (cdr (cdr V852))) (null? (cdr (cdr (cdr V852)))))))) (cons (kl:shen.eval-cons (car (cdr V852))) (kl:shen.eval-cons (car (cdr (cdr V852)))))) ((and (pair? V852) (and (eq? (quote mode) (car V852)) (and (pair? (cdr V852)) (and (pair? (cdr (cdr V852))) (null? (cdr (cdr (cdr V852)))))))) (cons (quote mode) (cons (kl:shen.eval-cons (car (cdr V852))) (cdr (cdr V852))))) (#t V852))) (export shen.eval-cons) (quote shen.eval-cons)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V854) (let ((YaccParse (let ((Parse_shen. (kl:shen. V854))) (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: V854))) (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. V857) (let ((YaccParse (if (and (pair? (car V857)) (eq? (quote !) (kl:shen.hdhd V857))) (let ((NewStream855 (kl:shen.pair (kl:shen.tlhd V857) (kl:shen.hdtl V857)))) (kl:shen.pair (car NewStream855) (cons (quote cut) (cons (kl:intern "Throwcontrol") (quote ()))))) (kl:fail)))) (if (kl:= YaccParse (kl:fail)) (if (pair? (car V857)) (let ((Parse_X (kl:shen.hdhd V857))) (if (pair? Parse_X) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V857) (kl:shen.hdtl V857))) Parse_X) (kl:fail))) (kl:fail)) YaccParse))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V859) (if (pair? (car V859)) (let ((Parse_X (kl:shen.hdhd V859))) (if (eq? Parse_X (quote _waspvm_sc_)) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V859) (kl:shen.hdtl V859))) Parse_X) (kl:fail))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote cut) 3) (define (kl:cut V863 V864 V865) (let ((Result (kl:thaw V865))) (if (kl:= Result #f) V863 Result))) (export cut) (quote cut)) +(begin (register-function-arity (quote shen.insert_modes) 1) (define (kl:shen.insert_modes V867) (cond ((and (pair? V867) (and (eq? (quote mode) (car V867)) (and (pair? (cdr V867)) (and (pair? (cdr (cdr V867))) (null? (cdr (cdr (cdr V867)))))))) V867) ((null? V867) (quote ())) ((pair? V867) (cons (cons (quote mode) (cons (car V867) (cons (quote +) (quote ())))) (cons (quote mode) (cons (kl:shen.insert_modes (cdr V867)) (cons (quote -) (quote ())))))) (#t V867))) (export shen.insert_modes) (quote shen.insert_modes)) +(begin (register-function-arity (quote shen.s-prolog) 1) (define (kl:shen.s-prolog V869) (kl:map (lambda (X) (kl:eval X)) (kl:shen.prolog->shen V869))) (export shen.s-prolog) (quote shen.s-prolog)) +(begin (register-function-arity (quote shen.prolog->shen) 1) (define (kl:shen.prolog->shen V871) (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)) V871))))) (export shen.prolog->shen) (quote shen.prolog->shen)) +(begin (register-function-arity (quote shen.s-prolog_clause) 1) (define (kl:shen.s-prolog_clause V873) (cond ((and (pair? V873) (and (pair? (cdr V873)) (and (eq? (quote :-) (car (cdr V873))) (and (pair? (cdr (cdr V873))) (null? (cdr (cdr (cdr V873)))))))) (cons (car V873) (cons (quote :-) (cons (kl:map (lambda (X) (kl:shen.s-prolog_literal X)) (car (cdr (cdr V873)))) (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 V875) (cond ((and (pair? V875) (and (pair? (cdr V875)) (and (eq? (quote :-) (car (cdr V875))) (and (pair? (cdr (cdr V875))) (and (null? (cdr (cdr (cdr V875)))) (assert-boolean (guard (lambda (_) #f) (< (kl:shen.complexity_head (car V875)) (kl:value (quote shen.*maxcomplexity*)))))))))) (cons V875 (quote ()))) ((and (pair? V875) (and (pair? (car V875)) (and (pair? (cdr V875)) (and (eq? (quote :-) (car (cdr V875))) (and (pair? (cdr (cdr V875))) (null? (cdr (cdr (cdr V875))))))))) (let ((Terms (kl:map (lambda (Y) (kl:gensym (quote V))) (cdr (car V875))))) (let ((XTerms (kl:shen.rcons_form (kl:shen.remove_modes (cdr (car V875)))))) (let ((Literal (cons (quote unify) (cons (kl:shen.cons_form Terms) (cons XTerms (quote ())))))) (let ((Clause (cons (cons (car (car V875)) Terms) (cons (quote :-) (cons (cons Literal (car (cdr (cdr V875)))) (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 V881) (cond ((pair? V881) (kl:shen.safe-product (kl:map (lambda (X) (kl:shen.complexity X)) (cdr V881)))) (#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 V884 V885) (* V884 V885)) (export shen.safe-multiply) (quote shen.safe-multiply)) +(begin (register-function-arity (quote shen.complexity) 1) (define (kl:shen.complexity V894) (cond ((and (pair? V894) (and (eq? (quote mode) (car V894)) (and (pair? (cdr V894)) (and (pair? (car (cdr V894))) (and (eq? (quote mode) (car (car (cdr V894)))) (and (pair? (cdr (car (cdr V894)))) (and (pair? (cdr (cdr (car (cdr V894))))) (and (null? (cdr (cdr (cdr (car (cdr V894)))))) (and (pair? (cdr (cdr V894))) (null? (cdr (cdr (cdr V894))))))))))))) (kl:shen.complexity (car (cdr V894)))) ((and (pair? V894) (and (eq? (quote mode) (car V894)) (and (pair? (cdr V894)) (and (pair? (car (cdr V894))) (and (pair? (cdr (cdr V894))) (and (eq? (quote +) (car (cdr (cdr V894)))) (null? (cdr (cdr (cdr V894)))))))))) (kl:shen.safe-multiply 2 (kl:shen.safe-multiply (kl:shen.complexity (cons (quote mode) (cons (car (car (cdr V894))) (cdr (cdr V894))))) (kl:shen.complexity (cons (quote mode) (cons (cdr (car (cdr V894))) (cdr (cdr V894)))))))) ((and (pair? V894) (and (eq? (quote mode) (car V894)) (and (pair? (cdr V894)) (and (pair? (car (cdr V894))) (and (pair? (cdr (cdr V894))) (and (eq? (quote -) (car (cdr (cdr V894)))) (null? (cdr (cdr (cdr V894)))))))))) (kl:shen.safe-multiply (kl:shen.complexity (cons (quote mode) (cons (car (car (cdr V894))) (cdr (cdr V894))))) (kl:shen.complexity (cons (quote mode) (cons (cdr (car (cdr V894))) (cdr (cdr V894))))))) ((and (pair? V894) (and (eq? (quote mode) (car V894)) (and (pair? (cdr V894)) (and (pair? (cdr (cdr V894))) (and (null? (cdr (cdr (cdr V894)))) (kl:variable? (car (cdr V894)))))))) 1) ((and (pair? V894) (and (eq? (quote mode) (car V894)) (and (pair? (cdr V894)) (and (pair? (cdr (cdr V894))) (and (eq? (quote +) (car (cdr (cdr V894)))) (null? (cdr (cdr (cdr V894))))))))) 2) ((and (pair? V894) (and (eq? (quote mode) (car V894)) (and (pair? (cdr V894)) (and (pair? (cdr (cdr V894))) (and (eq? (quote -) (car (cdr (cdr V894)))) (null? (cdr (cdr (cdr V894))))))))) 1) (#t (kl:shen.complexity (cons (quote mode) (cons V894 (cons (quote +) (quote ())))))))) (export shen.complexity) (quote shen.complexity)) +(begin (register-function-arity (quote shen.safe-product) 1) (define (kl:shen.safe-product V896) (cond ((null? V896) 1) ((pair? V896) (kl:shen.safe-multiply (car V896) (kl:shen.safe-product (cdr V896)))) (#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 V898) (cond ((and (pair? V898) (and (eq? (quote is) (car V898)) (and (pair? (cdr V898)) (and (pair? (cdr (cdr V898))) (null? (cdr (cdr (cdr V898)))))))) (cons (quote bind) (cons (car (cdr V898)) (cons (kl:shen.insert-deref (car (cdr (cdr V898))) (quote ProcessN)) (quote ()))))) ((and (pair? V898) (and (eq? (quote when) (car V898)) (and (pair? (cdr V898)) (null? (cdr (cdr V898)))))) (cons (quote fwhen) (cons (kl:shen.insert-deref (car (cdr V898)) (quote ProcessN)) (quote ())))) ((and (pair? V898) (and (eq? (quote bind) (car V898)) (and (pair? (cdr V898)) (and (pair? (cdr (cdr V898))) (null? (cdr (cdr (cdr V898)))))))) (cons (quote bind) (cons (car (cdr V898)) (cons (kl:shen.insert-lazyderef (car (cdr (cdr V898))) (quote ProcessN)) (quote ()))))) ((and (pair? V898) (and (eq? (quote fwhen) (car V898)) (and (pair? (cdr V898)) (null? (cdr (cdr V898)))))) (cons (quote fwhen) (cons (kl:shen.insert-lazyderef (car (cdr V898)) (quote ProcessN)) (quote ())))) ((pair? V898) V898) (#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 V905 V906) (cond ((kl:variable? V905) (cons (quote shen.deref) (cons V905 (cons V906 (quote ()))))) ((and (pair? V905) (and (eq? (quote lambda) (car V905)) (and (pair? (cdr V905)) (and (pair? (cdr (cdr V905))) (null? (cdr (cdr (cdr V905)))))))) (cons (quote lambda) (cons (car (cdr V905)) (cons (kl:shen.insert-deref (car (cdr (cdr V905))) V906) (quote ()))))) ((and (pair? V905) (and (eq? (quote let) (car V905)) (and (pair? (cdr V905)) (and (pair? (cdr (cdr V905))) (and (pair? (cdr (cdr (cdr V905)))) (null? (cdr (cdr (cdr (cdr V905)))))))))) (cons (quote let) (cons (car (cdr V905)) (cons (kl:shen.insert-deref (car (cdr (cdr V905))) V906) (cons (kl:shen.insert-deref (car (cdr (cdr (cdr V905)))) V906) (quote ())))))) ((pair? V905) (cons (kl:shen.insert-deref (car V905) V906) (kl:shen.insert-deref (cdr V905) V906))) (#t V905))) (export shen.insert-deref) (quote shen.insert-deref)) +(begin (register-function-arity (quote shen.insert-lazyderef) 2) (define (kl:shen.insert-lazyderef V913 V914) (cond ((kl:variable? V913) (cons (quote shen.lazyderef) (cons V913 (cons V914 (quote ()))))) ((and (pair? V913) (and (eq? (quote lambda) (car V913)) (and (pair? (cdr V913)) (and (pair? (cdr (cdr V913))) (null? (cdr (cdr (cdr V913)))))))) (cons (quote lambda) (cons (car (cdr V913)) (cons (kl:shen.insert-lazyderef (car (cdr (cdr V913))) V914) (quote ()))))) ((and (pair? V913) (and (eq? (quote let) (car V913)) (and (pair? (cdr V913)) (and (pair? (cdr (cdr V913))) (and (pair? (cdr (cdr (cdr V913)))) (null? (cdr (cdr (cdr (cdr V913)))))))))) (cons (quote let) (cons (car (cdr V913)) (cons (kl:shen.insert-lazyderef (car (cdr (cdr V913))) V914) (cons (kl:shen.insert-lazyderef (car (cdr (cdr (cdr V913)))) V914) (quote ())))))) ((pair? V913) (cons (kl:shen.insert-lazyderef (car V913) V914) (kl:shen.insert-lazyderef (cdr V913) V914))) (#t V913))) (export shen.insert-lazyderef) (quote shen.insert-lazyderef)) +(begin (register-function-arity (quote shen.group_clauses) 1) (define (kl:shen.group_clauses V916) (cond ((null? V916) (quote ())) ((pair? V916) (let ((Group (kl:shen.collect (lambda (X) (kl:shen.same_predicate? (car V916) X)) V916))) (let ((Rest (kl:difference V916 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 V921 V922) (cond ((null? V922) (quote ())) ((pair? V922) (if (assert-boolean (V921 (car V922))) (cons (car V922) (kl:shen.collect V921 (cdr V922))) (kl:shen.collect V921 (cdr V922)))) (#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? V941 V942) (cond ((and (pair? V941) (and (pair? (car V941)) (and (pair? V942) (pair? (car V942))))) (kl:= (car (car V941)) (car (car V942)))) (#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 V944) (let ((F (kl:shen.procedure_name V944))) (let ((Shen (kl:shen.clauses-to-shen F V944))) 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 V958) (cond ((and (pair? V958) (and (pair? (car V958)) (pair? (car (car V958))))) (car (car (car V958)))) (#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 V961 V962) (let ((Linear (kl:map (lambda (X) (kl:shen.linearise-clause X)) V962))) (let ((Arity (kl:shen.prolog-aritycheck V961 (kl:map (lambda (X) (kl:head X)) V962)))) (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 V961 (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 V964) (cond ((kl:not (kl:shen.occurs? (quote cut) V964)) V964) (#t (cons (quote let) (cons (quote Throwcontrol) (cons (cons (quote shen.catchpoint) (quote ())) (cons (cons (quote shen.cutpoint) (cons (quote Throwcontrol) (cons V964 (quote ())))) (quote ())))))))) (export shen.catch-cut) (quote shen.catch-cut)) +(begin (register-function-arity (quote shen.catchpoint) 0) (define (kl:shen.catchpoint) (cons (quote 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 V972 V973) (cond ((kl:= V973 V972) #f) (#t V973))) (export shen.cutpoint) (quote shen.cutpoint)) +(begin (register-function-arity (quote shen.nest-disjunct) 1) (define (kl:shen.nest-disjunct V975) (cond ((and (pair? V975) (null? (cdr V975))) (car V975)) ((pair? V975) (kl:shen.lisp-or (car V975) (kl:shen.nest-disjunct (cdr V975)))) (#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 V978 V979) (cons (quote let) (cons (quote Case) (cons V978 (cons (cons (quote if) (cons (cons (quote =) (cons (quote Case) (cons #f (quote ())))) (cons V979 (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 V984 V985) (cond ((and (pair? V985) (null? (cdr V985))) (- (kl:length (car V985)) 1)) ((and (pair? V985) (pair? (cdr V985))) (if (kl:= (kl:length (car V985)) (kl:length (car (cdr V985)))) (kl:shen.prolog-aritycheck V984 (cdr V985)) (simple-error (string-append "arity error in prolog procedure " (kl:shen.app (cons V984 (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 V987) (cond ((and (pair? V987) (and (pair? (cdr V987)) (and (eq? (quote :-) (car (cdr V987))) (and (pair? (cdr (cdr V987))) (null? (cdr (cdr (cdr V987)))))))) (let ((Linear (kl:shen.linearise (cons (car V987) (cdr (cdr V987)))))) (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 V989) (cond ((and (pair? V989) (and (pair? (cdr V989)) (null? (cdr (cdr V989))))) (cons (kl:shen.explicit_modes (car V989)) (cons (quote :-) (cons (kl:shen.cf_help (car (cdr V989))) (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 V991) (cond ((pair? V991) (cons (car V991) (kl:map (lambda (X) (kl:shen.em_help X)) (cdr V991)))) (#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 V993) (cond ((and (pair? V993) (and (eq? (quote mode) (car V993)) (and (pair? (cdr V993)) (and (pair? (cdr (cdr V993))) (null? (cdr (cdr (cdr V993)))))))) V993) (#t (cons (quote mode) (cons V993 (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 V995) (cond ((and (pair? V995) (and (eq? (quote where) (car V995)) (and (pair? (cdr V995)) (and (pair? (car (cdr V995))) (and (eq? (quote =) (car (car (cdr V995)))) (and (pair? (cdr (car (cdr V995)))) (and (pair? (cdr (cdr (car (cdr V995))))) (and (null? (cdr (cdr (cdr (car (cdr V995)))))) (and (pair? (cdr (cdr V995))) (null? (cdr (cdr (cdr V995))))))))))))) (cons (cons (if (assert-boolean (kl:value (quote shen.*occurs*))) (quote unify!) (quote unify)) (cdr (car (cdr V995)))) (kl:shen.cf_help (car (cdr (cdr V995)))))) (#t V995))) (export shen.cf_help) (quote shen.cf_help)) +(begin (register-function-arity (quote occurs-check) 1) (define (kl:occurs-check V1001) (cond ((eq? (quote +) V1001) (kl:set (quote shen.*occurs*) #t)) ((eq? (quote -) V1001) (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 V1004 V1005) (cond ((and (pair? V1004) (and (pair? (car V1004)) (and (pair? (cdr V1004)) (and (eq? (quote :-) (car (cdr V1004))) (and (pair? (cdr (cdr V1004))) (null? (cdr (cdr (cdr V1004))))))))) (let ((MuApplication (kl:shen.make_mu_application (cons (quote shen.mu) (cons (cdr (car V1004)) (cons (kl:shen.continuation_call (cdr (car V1004)) (car (cdr (cdr V1004)))) (quote ())))) V1005))) (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 V1008 V1009) (let ((VTerms (cons (quote ProcessN) (kl:shen.extract_vars V1008)))) (let ((VBody (kl:shen.extract_vars V1009))) (let ((Free (kl:remove (quote Throwcontrol) (kl:difference VBody VTerms)))) (kl:shen.cc_help Free V1009))))) (export shen.continuation_call) (quote shen.continuation_call)) +(begin (register-function-arity (quote remove) 2) (define (kl:remove V1012 V1013) (kl:shen.remove-h V1012 V1013 (quote ()))) (export remove) (quote remove)) +(begin (register-function-arity (quote shen.remove-h) 3) (define (kl:shen.remove-h V1020 V1021 V1022) (cond ((null? V1021) (kl:reverse V1022)) ((and (pair? V1021) (kl:= (car V1021) V1020)) (kl:shen.remove-h (car V1021) (cdr V1021) V1022)) ((pair? V1021) (kl:shen.remove-h V1020 (cdr V1021) (cons (car V1021) V1022))) (#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 V1025 V1026) (cond ((and (null? V1025) (null? V1026)) (cons (quote shen.pop) (cons (quote shen.the) (cons (quote shen.stack) (quote ()))))) ((null? V1026) (cons (quote shen.rename) (cons (quote shen.the) (cons (quote shen.variables) (cons (quote in) (cons V1025 (cons (quote and) (cons (quote shen.then) (cons (cons (quote shen.pop) (cons (quote shen.the) (cons (quote shen.stack) (quote ())))) (quote ())))))))))) ((null? V1025) (cons (quote call) (cons (quote shen.the) (cons (quote shen.continuation) (cons V1026 (quote ())))))) (#t (cons (quote shen.rename) (cons (quote shen.the) (cons (quote shen.variables) (cons (quote in) (cons V1025 (cons (quote and) (cons (quote shen.then) (cons (cons (quote call) (cons (quote shen.the) (cons (quote shen.continuation) (cons V1026 (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 V1029 V1030) (cond ((and (pair? V1029) (and (eq? (quote shen.mu) (car V1029)) (and (pair? (cdr V1029)) (and (null? (car (cdr V1029))) (and (pair? (cdr (cdr V1029))) (and (null? (cdr (cdr (cdr V1029)))) (null? V1030))))))) (car (cdr (cdr V1029)))) ((and (pair? V1029) (and (eq? (quote shen.mu) (car V1029)) (and (pair? (cdr V1029)) (and (pair? (car (cdr V1029))) (and (pair? (cdr (cdr V1029))) (and (null? (cdr (cdr (cdr V1029)))) (pair? V1030))))))) (cons (cons (quote shen.mu) (cons (car (car (cdr V1029))) (cons (kl:shen.make_mu_application (cons (quote shen.mu) (cons (cdr (car (cdr V1029))) (cdr (cdr V1029)))) (cdr V1030)) (quote ())))) (cons (car V1030) (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 V1039 V1040) (cond ((and (pair? V1039) (and (pair? (car V1039)) (and (eq? (quote shen.mu) (car (car V1039))) (and (pair? (cdr (car V1039))) (and (pair? (car (cdr (car V1039)))) (and (eq? (quote mode) (car (car (cdr (car V1039))))) (and (pair? (cdr (car (cdr (car V1039))))) (and (pair? (cdr (cdr (car (cdr (car V1039)))))) (and (null? (cdr (cdr (cdr (car (cdr (car V1039))))))) (and (pair? (cdr (cdr (car V1039)))) (and (null? (cdr (cdr (cdr (car V1039))))) (and (pair? (cdr V1039)) (null? (cdr (cdr V1039))))))))))))))) (kl:shen.mu_reduction (cons (cons (quote shen.mu) (cons (car (cdr (car (cdr (car V1039))))) (cdr (cdr (car V1039))))) (cdr V1039)) (car (cdr (cdr (car (cdr (car V1039)))))))) ((and (pair? V1039) (and (pair? (car V1039)) (and (eq? (quote shen.mu) (car (car V1039))) (and (pair? (cdr (car V1039))) (and (pair? (cdr (cdr (car V1039)))) (and (null? (cdr (cdr (cdr (car V1039))))) (and (pair? (cdr V1039)) (and (null? (cdr (cdr V1039))) (eq? (quote _) (car (cdr (car V1039)))))))))))) (kl:shen.mu_reduction (car (cdr (cdr (car V1039)))) V1040)) ((and (pair? V1039) (and (pair? (car V1039)) (and (eq? (quote shen.mu) (car (car V1039))) (and (pair? (cdr (car V1039))) (and (pair? (cdr (cdr (car V1039)))) (and (null? (cdr (cdr (cdr (car V1039))))) (and (pair? (cdr V1039)) (and (null? (cdr (cdr V1039))) (assert-boolean (kl:shen.ephemeral_variable? (car (cdr (car V1039))) (car (cdr V1039)))))))))))) (kl:subst (car (cdr V1039)) (car (cdr (car V1039))) (kl:shen.mu_reduction (car (cdr (cdr (car V1039)))) V1040))) ((and (pair? V1039) (and (pair? (car V1039)) (and (eq? (quote shen.mu) (car (car V1039))) (and (pair? (cdr (car V1039))) (and (pair? (cdr (cdr (car V1039)))) (and (null? (cdr (cdr (cdr (car V1039))))) (and (pair? (cdr V1039)) (and (null? (cdr (cdr V1039))) (kl:variable? (car (cdr (car V1039)))))))))))) (cons (quote let) (cons (car (cdr (car V1039))) (cons (quote shen.be) (cons (car (cdr V1039)) (cons (quote in) (cons (kl:shen.mu_reduction (car (cdr (cdr (car V1039)))) V1040) (quote ())))))))) ((and (pair? V1039) (and (pair? (car V1039)) (and (eq? (quote shen.mu) (car (car V1039))) (and (pair? (cdr (car V1039))) (and (pair? (cdr (cdr (car V1039)))) (and (null? (cdr (cdr (cdr (car V1039))))) (and (pair? (cdr V1039)) (and (null? (cdr (cdr V1039))) (and (eq? (quote -) V1040) (assert-boolean (kl:shen.prolog_constant? (car (cdr (car V1039)))))))))))))) (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 V1039))))) (cons (quote in) (cons (cons (quote if) (cons (cons Z (cons (quote is) (cons (quote identical) (cons (quote shen.to) (cons (car (cdr (car V1039))) (quote ())))))) (cons (quote shen.then) (cons (kl:shen.mu_reduction (car (cdr (cdr (car V1039)))) (quote -)) (cons (quote shen.else) (cons (quote shen.failed!) (quote ()))))))) (quote ()))))))))) ((and (pair? V1039) (and (pair? (car V1039)) (and (eq? (quote shen.mu) (car (car V1039))) (and (pair? (cdr (car V1039))) (and (pair? (cdr (cdr (car V1039)))) (and (null? (cdr (cdr (cdr (car V1039))))) (and (pair? (cdr V1039)) (and (null? (cdr (cdr V1039))) (and (eq? (quote +) V1040) (assert-boolean (kl:shen.prolog_constant? (car (cdr (car V1039)))))))))))))) (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 V1039))))) (cons (quote in) (cons (cons (quote if) (cons (cons Z (cons (quote is) (cons (quote identical) (cons (quote shen.to) (cons (car (cdr (car V1039))) (quote ())))))) (cons (quote shen.then) (cons (kl:shen.mu_reduction (car (cdr (cdr (car V1039)))) (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 V1039))) (cons (quote in) (cons (kl:shen.mu_reduction (car (cdr (cdr (car V1039)))) (quote +)) (quote ()))))))) (cons (quote shen.else) (cons (quote shen.failed!) (quote ()))))))) (quote ()))))))) (quote ()))))))))) ((and (pair? V1039) (and (pair? (car V1039)) (and (eq? (quote shen.mu) (car (car V1039))) (and (pair? (cdr (car V1039))) (and (pair? (car (cdr (car V1039)))) (and (pair? (cdr (cdr (car V1039)))) (and (null? (cdr (cdr (cdr (car V1039))))) (and (pair? (cdr V1039)) (and (null? (cdr (cdr V1039))) (eq? (quote -) V1040)))))))))) (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 V1039))))) (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 V1039)))) (cons (cons (cons (quote shen.mu) (cons (cdr (car (cdr (car V1039)))) (cdr (cdr (car V1039))))) (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? V1039) (and (pair? (car V1039)) (and (eq? (quote shen.mu) (car (car V1039))) (and (pair? (cdr (car V1039))) (and (pair? (car (cdr (car V1039)))) (and (pair? (cdr (cdr (car V1039)))) (and (null? (cdr (cdr (cdr (car V1039))))) (and (pair? (cdr V1039)) (and (null? (cdr (cdr V1039))) (eq? (quote +) V1040)))))))))) (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 V1039))))) (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 V1039)))) (cons (cons (cons (quote shen.mu) (cons (cdr (car (cdr (car V1039)))) (cdr (cdr (car V1039))))) (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 V1039)))) (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 V1039))))) (cons (quote in) (cons (kl:shen.mu_reduction (car (cdr (cdr (car V1039)))) (quote +)) (quote ()))))))) (quote ()))))))))) (cons (quote shen.else) (cons (quote shen.failed!) (quote ()))))))) (quote ()))))))) (quote ()))))))))) (#t V1039))) (export shen.mu_reduction) (quote shen.mu_reduction)) +(begin (register-function-arity (quote shen.rcons_form) 1) (define (kl:shen.rcons_form V1042) (cond ((pair? V1042) (cons (quote cons) (cons (kl:shen.rcons_form (car V1042)) (cons (kl:shen.rcons_form (cdr V1042)) (quote ()))))) (#t V1042))) (export shen.rcons_form) (quote shen.rcons_form)) +(begin (register-function-arity (quote shen.remove_modes) 1) (define (kl:shen.remove_modes V1044) (cond ((and (pair? V1044) (and (eq? (quote mode) (car V1044)) (and (pair? (cdr V1044)) (and (pair? (cdr (cdr V1044))) (and (eq? (quote +) (car (cdr (cdr V1044)))) (null? (cdr (cdr (cdr V1044))))))))) (kl:shen.remove_modes (car (cdr V1044)))) ((and (pair? V1044) (and (eq? (quote mode) (car V1044)) (and (pair? (cdr V1044)) (and (pair? (cdr (cdr V1044))) (and (eq? (quote -) (car (cdr (cdr V1044)))) (null? (cdr (cdr (cdr V1044))))))))) (kl:shen.remove_modes (car (cdr V1044)))) ((pair? V1044) (cons (kl:shen.remove_modes (car V1044)) (kl:shen.remove_modes (cdr V1044)))) (#t V1044))) (export shen.remove_modes) (quote shen.remove_modes)) +(begin (register-function-arity (quote shen.ephemeral_variable?) 2) (define (kl:shen.ephemeral_variable? V1047 V1048) (and (kl:variable? V1047) (kl:variable? V1048))) (export shen.ephemeral_variable?) (quote shen.ephemeral_variable?)) +(begin (register-function-arity (quote shen.prolog_constant?) 1) (define (kl:shen.prolog_constant? V1058) (cond ((pair? V1058) #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 V1060) (cond ((and (pair? V1060) (and (eq? (quote let) (car V1060)) (and (pair? (cdr V1060)) (and (pair? (cdr (cdr V1060))) (and (eq? (quote shen.be) (car (cdr (cdr V1060)))) (and (pair? (cdr (cdr (cdr V1060)))) (and (pair? (cdr (cdr (cdr (cdr V1060))))) (and (eq? (quote in) (car (cdr (cdr (cdr (cdr V1060)))))) (and (pair? (cdr (cdr (cdr (cdr (cdr V1060)))))) (null? (cdr (cdr (cdr (cdr (cdr (cdr V1060)))))))))))))))) (cons (quote let) (cons (car (cdr V1060)) (cons (kl:shen.aum_to_shen (car (cdr (cdr (cdr V1060))))) (cons (kl:shen.aum_to_shen (car (cdr (cdr (cdr (cdr (cdr V1060))))))) (quote ())))))) ((and (pair? V1060) (and (eq? (quote shen.the) (car V1060)) (and (pair? (cdr V1060)) (and (eq? (quote shen.result) (car (cdr V1060))) (and (pair? (cdr (cdr V1060))) (and (eq? (quote shen.of) (car (cdr (cdr V1060)))) (and (pair? (cdr (cdr (cdr V1060)))) (and (eq? (quote shen.dereferencing) (car (cdr (cdr (cdr V1060))))) (and (pair? (cdr (cdr (cdr (cdr V1060))))) (null? (cdr (cdr (cdr (cdr (cdr V1060))))))))))))))) (cons (quote shen.lazyderef) (cons (kl:shen.aum_to_shen (car (cdr (cdr (cdr (cdr V1060)))))) (cons (quote ProcessN) (quote ()))))) ((and (pair? V1060) (and (eq? (quote if) (car V1060)) (and (pair? (cdr V1060)) (and (pair? (cdr (cdr V1060))) (and (eq? (quote shen.then) (car (cdr (cdr V1060)))) (and (pair? (cdr (cdr (cdr V1060)))) (and (pair? (cdr (cdr (cdr (cdr V1060))))) (and (eq? (quote shen.else) (car (cdr (cdr (cdr (cdr V1060)))))) (and (pair? (cdr (cdr (cdr (cdr (cdr V1060)))))) (null? (cdr (cdr (cdr (cdr (cdr (cdr V1060)))))))))))))))) (cons (quote if) (cons (kl:shen.aum_to_shen (car (cdr V1060))) (cons (kl:shen.aum_to_shen (car (cdr (cdr (cdr V1060))))) (cons (kl:shen.aum_to_shen (car (cdr (cdr (cdr (cdr (cdr V1060))))))) (quote ())))))) ((and (pair? V1060) (and (pair? (cdr V1060)) (and (eq? (quote is) (car (cdr V1060))) (and (pair? (cdr (cdr V1060))) (and (eq? (quote shen.a) (car (cdr (cdr V1060)))) (and (pair? (cdr (cdr (cdr V1060)))) (and (eq? (quote shen.variable) (car (cdr (cdr (cdr V1060))))) (null? (cdr (cdr (cdr (cdr V1060)))))))))))) (cons (quote shen.pvar?) (cons (car V1060) (quote ())))) ((and (pair? V1060) (and (pair? (cdr V1060)) (and (eq? (quote is) (car (cdr V1060))) (and (pair? (cdr (cdr V1060))) (and (eq? (quote shen.a) (car (cdr (cdr V1060)))) (and (pair? (cdr (cdr (cdr V1060)))) (and (eq? (quote shen.non-empty) (car (cdr (cdr (cdr V1060))))) (and (pair? (cdr (cdr (cdr (cdr V1060))))) (and (eq? (quote list) (car (cdr (cdr (cdr (cdr V1060)))))) (null? (cdr (cdr (cdr (cdr (cdr V1060))))))))))))))) (cons (quote cons?) (cons (car V1060) (quote ())))) ((and (pair? V1060) (and (eq? (quote shen.rename) (car V1060)) (and (pair? (cdr V1060)) (and (eq? (quote shen.the) (car (cdr V1060))) (and (pair? (cdr (cdr V1060))) (and (eq? (quote shen.variables) (car (cdr (cdr V1060)))) (and (pair? (cdr (cdr (cdr V1060)))) (and (eq? (quote in) (car (cdr (cdr (cdr V1060))))) (and (pair? (cdr (cdr (cdr (cdr V1060))))) (and (null? (car (cdr (cdr (cdr (cdr V1060)))))) (and (pair? (cdr (cdr (cdr (cdr (cdr V1060)))))) (and (eq? (quote and) (car (cdr (cdr (cdr (cdr (cdr V1060))))))) (and (pair? (cdr (cdr (cdr (cdr (cdr (cdr V1060))))))) (and (eq? (quote shen.then) (car (cdr (cdr (cdr (cdr (cdr (cdr V1060)))))))) (and (pair? (cdr (cdr (cdr (cdr (cdr (cdr (cdr V1060)))))))) (null? (cdr (cdr (cdr (cdr (cdr (cdr (cdr (cdr V1060)))))))))))))))))))))))) (kl:shen.aum_to_shen (car (cdr (cdr (cdr (cdr (cdr (cdr (cdr V1060)))))))))) ((and (pair? V1060) (and (eq? (quote shen.rename) (car V1060)) (and (pair? (cdr V1060)) (and (eq? (quote shen.the) (car (cdr V1060))) (and (pair? (cdr (cdr V1060))) (and (eq? (quote shen.variables) (car (cdr (cdr V1060)))) (and (pair? (cdr (cdr (cdr V1060)))) (and (eq? (quote in) (car (cdr (cdr (cdr V1060))))) (and (pair? (cdr (cdr (cdr (cdr V1060))))) (and (pair? (car (cdr (cdr (cdr (cdr V1060)))))) (and (pair? (cdr (cdr (cdr (cdr (cdr V1060)))))) (and (eq? (quote and) (car (cdr (cdr (cdr (cdr (cdr V1060))))))) (and (pair? (cdr (cdr (cdr (cdr (cdr (cdr V1060))))))) (and (eq? (quote shen.then) (car (cdr (cdr (cdr (cdr (cdr (cdr V1060)))))))) (and (pair? (cdr (cdr (cdr (cdr (cdr (cdr (cdr V1060)))))))) (null? (cdr (cdr (cdr (cdr (cdr (cdr (cdr (cdr V1060)))))))))))))))))))))))) (cons (quote let) (cons (car (car (cdr (cdr (cdr (cdr V1060)))))) (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 V1060)))))) (cdr (cdr (cdr (cdr (cdr V1060))))))))))) (quote ())))))) ((and (pair? V1060) (and (eq? (quote bind) (car V1060)) (and (pair? (cdr V1060)) (and (pair? (cdr (cdr V1060))) (and (eq? (quote shen.to) (car (cdr (cdr V1060)))) (and (pair? (cdr (cdr (cdr V1060)))) (and (pair? (cdr (cdr (cdr (cdr V1060))))) (and (eq? (quote in) (car (cdr (cdr (cdr (cdr V1060)))))) (and (pair? (cdr (cdr (cdr (cdr (cdr V1060)))))) (null? (cdr (cdr (cdr (cdr (cdr (cdr V1060)))))))))))))))) (cons (quote do) (cons (cons (quote shen.bindv) (cons (car (cdr V1060)) (cons (kl:shen.chwild (car (cdr (cdr (cdr V1060))))) (cons (quote ProcessN) (quote ()))))) (cons (cons (quote let) (cons (quote Result) (cons (kl:shen.aum_to_shen (car (cdr (cdr (cdr (cdr (cdr V1060))))))) (cons (cons (quote do) (cons (cons (quote shen.unbindv) (cons (car (cdr V1060)) (cons (quote ProcessN) (quote ())))) (cons (quote Result) (quote ())))) (quote ()))))) (quote ()))))) ((and (pair? V1060) (and (pair? (cdr V1060)) (and (eq? (quote is) (car (cdr V1060))) (and (pair? (cdr (cdr V1060))) (and (eq? (quote identical) (car (cdr (cdr V1060)))) (and (pair? (cdr (cdr (cdr V1060)))) (and (eq? (quote shen.to) (car (cdr (cdr (cdr V1060))))) (and (pair? (cdr (cdr (cdr (cdr V1060))))) (null? (cdr (cdr (cdr (cdr (cdr V1060)))))))))))))) (cons (quote =) (cons (car (cdr (cdr (cdr (cdr V1060))))) (cons (car V1060) (quote ()))))) ((eq? (quote shen.failed!) V1060) #f) ((and (pair? V1060) (and (eq? (quote shen.the) (car V1060)) (and (pair? (cdr V1060)) (and (eq? (quote head) (car (cdr V1060))) (and (pair? (cdr (cdr V1060))) (and (eq? (quote shen.of) (car (cdr (cdr V1060)))) (and (pair? (cdr (cdr (cdr V1060)))) (null? (cdr (cdr (cdr (cdr V1060)))))))))))) (cons (quote hd) (cdr (cdr (cdr V1060))))) ((and (pair? V1060) (and (eq? (quote shen.the) (car V1060)) (and (pair? (cdr V1060)) (and (eq? (quote tail) (car (cdr V1060))) (and (pair? (cdr (cdr V1060))) (and (eq? (quote shen.of) (car (cdr (cdr V1060)))) (and (pair? (cdr (cdr (cdr V1060)))) (null? (cdr (cdr (cdr (cdr V1060)))))))))))) (cons (quote tl) (cdr (cdr (cdr V1060))))) ((and (pair? V1060) (and (eq? (quote shen.pop) (car V1060)) (and (pair? (cdr V1060)) (and (eq? (quote shen.the) (car (cdr V1060))) (and (pair? (cdr (cdr V1060))) (and (eq? (quote shen.stack) (car (cdr (cdr V1060)))) (null? (cdr (cdr (cdr V1060)))))))))) (cons (quote do) (cons (cons (quote shen.incinfs) (quote ())) (cons (cons (quote thaw) (cons (quote Continuation) (quote ()))) (quote ()))))) ((and (pair? V1060) (and (eq? (quote call) (car V1060)) (and (pair? (cdr V1060)) (and (eq? (quote shen.the) (car (cdr V1060))) (and (pair? (cdr (cdr V1060))) (and (eq? (quote shen.continuation) (car (cdr (cdr V1060)))) (and (pair? (cdr (cdr (cdr V1060)))) (null? (cdr (cdr (cdr (cdr V1060)))))))))))) (cons (quote do) (cons (cons (quote shen.incinfs) (quote ())) (cons (kl:shen.call_the_continuation (kl:shen.chwild (car (cdr (cdr (cdr V1060))))) (quote ProcessN) (quote Continuation)) (quote ()))))) (#t V1060))) (export shen.aum_to_shen) (quote shen.aum_to_shen)) +(begin (register-function-arity (quote shen.chwild) 1) (define (kl:shen.chwild V1062) (cond ((eq? V1062 (quote _)) (cons (quote shen.newpv) (cons (quote ProcessN) (quote ())))) ((pair? V1062) (kl:map (lambda (Z) (kl:shen.chwild Z)) V1062)) (#t V1062))) (export shen.chwild) (quote shen.chwild)) +(begin (register-function-arity (quote shen.newpv) 1) (define (kl:shen.newpv V1064) (let ((Count+1 (+ (vector-ref (kl:value (quote shen.*varcounter*)) V1064) 1))) (let ((IncVar (let ((_tmp (kl:value (quote shen.*varcounter*)))) (vector-set! _tmp V1064 Count+1) _tmp))) (let ((Vector (vector-ref (kl:value (quote shen.*prologvectors*)) V1064))) (let ((ResizeVectorIfNeeded (if (kl:= Count+1 (kl:limit Vector)) (kl:shen.resizeprocessvector V1064 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 V1067 V1068) (let ((Vector (vector-ref (kl:value (quote shen.*prologvectors*)) V1067))) (let ((BigVector (kl:shen.resize-vector Vector (+ V1068 V1068) (quote shen.-null-)))) (let ((_tmp (kl:value (quote shen.*prologvectors*)))) (vector-set! _tmp V1067 BigVector) _tmp)))) (export shen.resizeprocessvector) (quote shen.resizeprocessvector)) +(begin (register-function-arity (quote shen.resize-vector) 3) (define (kl:shen.resize-vector V1072 V1073 V1074) (let ((BigVector (let ((_tmp (make-vector (+ 1 V1073) (quote (quote shen.fail!))))) (vector-set! _tmp 0 V1073) _tmp))) (kl:shen.copy-vector V1072 BigVector (kl:limit V1072) V1073 V1074))) (export shen.resize-vector) (quote shen.resize-vector)) +(begin (register-function-arity (quote shen.copy-vector) 5) (define (kl:shen.copy-vector V1080 V1081 V1082 V1083 V1084) (kl:shen.copy-vector-stage-2 (+ 1 V1082) (+ V1083 1) V1084 (kl:shen.copy-vector-stage-1 1 V1080 V1081 (+ 1 V1082)))) (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 V1092 V1093 V1094 V1095) (cond ((kl:= V1095 V1092) V1094) (#t (kl:shen.copy-vector-stage-1 (+ 1 V1092) V1093 (let ((_tmp V1094)) (vector-set! _tmp V1092 (vector-ref V1093 V1092)) _tmp) V1095)))) (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 V1103 V1104 V1105 V1106) (cond ((kl:= V1104 V1103) V1106) (#t (kl:shen.copy-vector-stage-2 (+ V1103 1) V1104 V1105 (let ((_tmp V1106)) (vector-set! _tmp V1103 V1105) _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 V1108) (let ((_tmp (let ((_tmp (make-vector 2 (quote (quote shen.fail!))))) (vector-set! _tmp 0 (quote shen.pvar)) _tmp))) (vector-set! _tmp 1 V1108) _tmp)) (export shen.mk-pvar) (quote shen.mk-pvar)) +(begin (register-function-arity (quote shen.pvar?) 1) (define (kl:shen.pvar? V1110) (and (vector? V1110) (eq? (guard (lambda (E) (quote shen.not-pvar)) (vector-ref V1110 0)) (quote shen.pvar)))) (export shen.pvar?) (quote shen.pvar?)) +(begin (register-function-arity (quote shen.bindv) 3) (define (kl:shen.bindv V1114 V1115 V1116) (let ((Vector (vector-ref (kl:value (quote shen.*prologvectors*)) V1116))) (let ((_tmp Vector)) (vector-set! _tmp (vector-ref V1114 1) V1115) _tmp))) (export shen.bindv) (quote shen.bindv)) +(begin (register-function-arity (quote shen.unbindv) 2) (define (kl:shen.unbindv V1119 V1120) (let ((Vector (vector-ref (kl:value (quote shen.*prologvectors*)) V1120))) (let ((_tmp Vector)) (vector-set! _tmp (vector-ref V1119 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 V2285 V2286 V2287) (cond ((and (pair? V2285) (and (pair? (car V2285)) (null? (cdr V2285)))) (cons (car (car V2285)) (kl:append (cdr (car V2285)) (cons V2286 (cons V2287 (quote ())))))) ((and (pair? V2285) (pair? (car V2285))) (let ((NewContinuation (kl:shen.newcontinuation (cdr V2285) V2286 V2287))) (cons (car (car V2285)) (kl:append (cdr (car V2285)) (cons V2286 (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 V2291 V2292 V2293) (cond ((null? V2291) V2293) ((and (pair? V2291) (pair? (car V2291))) (cons (quote freeze) (cons (cons (car (car V2291)) (kl:append (cdr (car V2291)) (cons V2292 (cons (kl:shen.newcontinuation (cdr V2291) V2292 V2293) (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 V2301 V2302 V2303) (kl:shen.deref V2301 V2302)) (export return) (quote return)) -(begin (register-function-arity (quote shen.measure&return) 3) (define (kl:shen.measure&return V2311 V2312 V2313) (begin (kl:shen.prhush (kl:shen.app (kl:value (quote shen.*infs*)) " inferences\n" (quote shen.a)) (kl:stoutput)) (kl:shen.deref V2311 V2312))) (export shen.measure&return) (quote shen.measure&return)) -(begin (register-function-arity (quote unify) 4) (define (kl:unify V2318 V2319 V2320 V2321) (kl:shen.lzy= (kl:shen.lazyderef V2318 V2320) (kl:shen.lazyderef V2319 V2320) V2320 V2321)) (export unify) (quote unify)) -(begin (register-function-arity (quote shen.lzy=) 4) (define (kl:shen.lzy= V2343 V2344 V2345 V2346) (cond ((kl:= V2344 V2343) (kl:thaw V2346)) ((kl:shen.pvar? V2343) (kl:bind V2343 V2344 V2345 V2346)) ((kl:shen.pvar? V2344) (kl:bind V2344 V2343 V2345 V2346)) ((and (pair? V2343) (pair? V2344)) (kl:shen.lzy= (kl:shen.lazyderef (car V2343) V2345) (kl:shen.lazyderef (car V2344) V2345) V2345 (lambda () (kl:shen.lzy= (kl:shen.lazyderef (cdr V2343) V2345) (kl:shen.lazyderef (cdr V2344) V2345) V2345 V2346)))) (#t #f))) (export shen.lzy=) (quote shen.lzy=)) -(begin (register-function-arity (quote shen.deref) 2) (define (kl:shen.deref V2349 V2350) (cond ((pair? V2349) (cons (kl:shen.deref (car V2349) V2350) (kl:shen.deref (cdr V2349) V2350))) (#t (if (kl:shen.pvar? V2349) (let ((Value (kl:shen.valvector V2349 V2350))) (if (eq? Value (quote shen.-null-)) V2349 (kl:shen.deref Value V2350))) V2349)))) (export shen.deref) (quote shen.deref)) -(begin (register-function-arity (quote shen.lazyderef) 2) (define (kl:shen.lazyderef V2353 V2354) (if (kl:shen.pvar? V2353) (let ((Value (kl:shen.valvector V2353 V2354))) (if (eq? Value (quote shen.-null-)) V2353 (kl:shen.lazyderef Value V2354))) V2353)) (export shen.lazyderef) (quote shen.lazyderef)) -(begin (register-function-arity (quote shen.valvector) 2) (define (kl:shen.valvector V2357 V2358) (vector-ref (vector-ref (kl:value (quote shen.*prologvectors*)) V2358) (vector-ref V2357 1))) (export shen.valvector) (quote shen.valvector)) -(begin (register-function-arity (quote unify!) 4) (define (kl:unify! V2363 V2364 V2365 V2366) (kl:shen.lzy=! (kl:shen.lazyderef V2363 V2365) (kl:shen.lazyderef V2364 V2365) V2365 V2366)) (export unify!) (quote unify!)) -(begin (register-function-arity (quote shen.lzy=!) 4) (define (kl:shen.lzy=! V2388 V2389 V2390 V2391) (cond ((kl:= V2389 V2388) (kl:thaw V2391)) ((and (kl:shen.pvar? V2388) (kl:not (kl:shen.occurs? V2388 (kl:shen.deref V2389 V2390)))) (kl:bind V2388 V2389 V2390 V2391)) ((and (kl:shen.pvar? V2389) (kl:not (kl:shen.occurs? V2389 (kl:shen.deref V2388 V2390)))) (kl:bind V2389 V2388 V2390 V2391)) ((and (pair? V2388) (pair? V2389)) (kl:shen.lzy=! (kl:shen.lazyderef (car V2388) V2390) (kl:shen.lazyderef (car V2389) V2390) V2390 (lambda () (kl:shen.lzy=! (kl:shen.lazyderef (cdr V2388) V2390) (kl:shen.lazyderef (cdr V2389) V2390) V2390 V2391)))) (#t #f))) (export shen.lzy=!) (quote shen.lzy=!)) -(begin (register-function-arity (quote shen.occurs?) 2) (define (kl:shen.occurs? V2403 V2404) (cond ((kl:= V2404 V2403) #t) ((pair? V2404) (or (assert-boolean (kl:shen.occurs? V2403 (car V2404))) (assert-boolean (kl:shen.occurs? V2403 (cdr V2404))))) (#t #f))) (export shen.occurs?) (quote shen.occurs?)) -(begin (register-function-arity (quote identical) 4) (define (kl:identical V2409 V2410 V2411 V2412) (kl:shen.lzy== (kl:shen.lazyderef V2409 V2411) (kl:shen.lazyderef V2410 V2411) V2411 V2412)) (export identical) (quote identical)) -(begin (register-function-arity (quote shen.lzy==) 4) (define (kl:shen.lzy== V2434 V2435 V2436 V2437) (cond ((kl:= V2435 V2434) (kl:thaw V2437)) ((and (pair? V2434) (pair? V2435)) (kl:shen.lzy== (kl:shen.lazyderef (car V2434) V2436) (kl:shen.lazyderef (car V2435) V2436) V2436 (lambda () (kl:shen.lzy== (cdr V2434) (cdr V2435) V2436 V2437)))) (#t #f))) (export shen.lzy==) (quote shen.lzy==)) -(begin (register-function-arity (quote shen.pvar) 1) (define (kl:shen.pvar V2439) (string-append "Var" (kl:shen.app (vector-ref V2439 1) "" (quote shen.a)))) (export shen.pvar) (quote shen.pvar)) -(begin (register-function-arity (quote bind) 4) (define (kl:bind V2444 V2445 V2446 V2447) (begin (kl:shen.bindv V2444 V2445 V2446) (let ((Result (kl:thaw V2447))) (begin (kl:shen.unbindv V2444 V2446) Result)))) (export bind) (quote bind)) -(begin (register-function-arity (quote fwhen) 3) (define (kl:fwhen V2465 V2466 V2467) (cond ((kl:= #t V2465) (kl:thaw V2467)) ((kl:= #f V2465) #f) (#t (simple-error (string-append "fwhen expects a boolean: not " (kl:shen.app V2465 "%" (quote shen.s))))))) (export fwhen) (quote fwhen)) -(begin (register-function-arity (quote call) 3) (define (kl:call V2483 V2484 V2485) (cond ((pair? V2483) (kl:shen.call-help (kl:function (kl:shen.lazyderef (car V2483) V2484)) (cdr V2483) V2484 V2485)) ((kl:shen.pvar? V2483) (kl:call (kl:shen.lazyderef V2483 V2484) V2484 V2485)) (#t #f))) (export call) (quote call)) -(begin (register-function-arity (quote shen.call-help) 4) (define (kl:shen.call-help V2490 V2491 V2492 V2493) (cond ((null? V2491) ((V2490 V2492) V2493)) ((pair? V2491) (kl:shen.call-help (V2490 (car V2491)) (cdr V2491) V2492 V2493)) (#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 V2495) (cond ((and (pair? V2495) (pair? (car V2495))) (let ((ProcessN (kl:shen.start-new-prolog-process))) (kl:shen.intprolog-help (car (car V2495)) (kl:shen.insert-prolog-variables (cons (cdr (car V2495)) (cons (cdr V2495) (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 V2499 V2500 V2501) (cond ((and (pair? V2500) (and (pair? (cdr V2500)) (null? (cdr (cdr V2500))))) (kl:shen.intprolog-help-help V2499 (car V2500) (car (cdr V2500)) V2501)) (#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 V2506 V2507 V2508 V2509) (cond ((null? V2507) ((V2506 V2509) (lambda () (kl:shen.call-rest V2508 V2509)))) ((pair? V2507) (kl:shen.intprolog-help-help (V2506 (car V2507)) (cdr V2507) V2508 V2509)) (#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 V2514 V2515) (cond ((null? V2514) #t) ((and (pair? V2514) (and (pair? (car V2514)) (pair? (cdr (car V2514))))) (kl:shen.call-rest (cons (cons ((car (car V2514)) (car (cdr (car V2514)))) (cdr (cdr (car V2514)))) (cdr V2514)) V2515)) ((and (pair? V2514) (and (pair? (car V2514)) (null? (cdr (car V2514))))) (((car (car V2514)) V2515) (lambda () (kl:shen.call-rest (cdr V2514) V2515)))) (#t (kl:shen.f_error (quote shen.call-rest))))) (export shen.call-rest) (quote shen.call-rest)) +(begin (register-function-arity (quote shen.call_the_continuation) 3) (define (kl:shen.call_the_continuation V1124 V1125 V1126) (cond ((and (pair? V1124) (and (pair? (car V1124)) (null? (cdr V1124)))) (cons (car (car V1124)) (kl:append (cdr (car V1124)) (cons V1125 (cons V1126 (quote ())))))) ((and (pair? V1124) (pair? (car V1124))) (let ((NewContinuation (kl:shen.newcontinuation (cdr V1124) V1125 V1126))) (cons (car (car V1124)) (kl:append (cdr (car V1124)) (cons V1125 (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 V1130 V1131 V1132) (cond ((null? V1130) V1132) ((and (pair? V1130) (pair? (car V1130))) (cons (quote freeze) (cons (cons (car (car V1130)) (kl:append (cdr (car V1130)) (cons V1131 (cons (kl:shen.newcontinuation (cdr V1130) V1131 V1132) (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 V1140 V1141 V1142) (kl:shen.deref V1140 V1141)) (export return) (quote return)) +(begin (register-function-arity (quote shen.measure&return) 3) (define (kl:shen.measure&return V1150 V1151 V1152) (begin (kl:shen.prhush (kl:shen.app (kl:value (quote shen.*infs*)) " inferences\n" (quote shen.a)) (kl:stoutput)) (kl:shen.deref V1150 V1151))) (export shen.measure&return) (quote shen.measure&return)) +(begin (register-function-arity (quote unify) 4) (define (kl:unify V1157 V1158 V1159 V1160) (kl:shen.lzy= (kl:shen.lazyderef V1157 V1159) (kl:shen.lazyderef V1158 V1159) V1159 V1160)) (export unify) (quote unify)) +(begin (register-function-arity (quote shen.lzy=) 4) (define (kl:shen.lzy= V1182 V1183 V1184 V1185) (cond ((kl:= V1183 V1182) (kl:thaw V1185)) ((kl:shen.pvar? V1182) (kl:bind V1182 V1183 V1184 V1185)) ((kl:shen.pvar? V1183) (kl:bind V1183 V1182 V1184 V1185)) ((and (pair? V1182) (pair? V1183)) (kl:shen.lzy= (kl:shen.lazyderef (car V1182) V1184) (kl:shen.lazyderef (car V1183) V1184) V1184 (lambda () (kl:shen.lzy= (kl:shen.lazyderef (cdr V1182) V1184) (kl:shen.lazyderef (cdr V1183) V1184) V1184 V1185)))) (#t #f))) (export shen.lzy=) (quote shen.lzy=)) +(begin (register-function-arity (quote shen.deref) 2) (define (kl:shen.deref V1188 V1189) (cond ((pair? V1188) (cons (kl:shen.deref (car V1188) V1189) (kl:shen.deref (cdr V1188) V1189))) (#t (if (kl:shen.pvar? V1188) (let ((Value (kl:shen.valvector V1188 V1189))) (if (eq? Value (quote shen.-null-)) V1188 (kl:shen.deref Value V1189))) V1188)))) (export shen.deref) (quote shen.deref)) +(begin (register-function-arity (quote shen.lazyderef) 2) (define (kl:shen.lazyderef V1192 V1193) (if (kl:shen.pvar? V1192) (let ((Value (kl:shen.valvector V1192 V1193))) (if (eq? Value (quote shen.-null-)) V1192 (kl:shen.lazyderef Value V1193))) V1192)) (export shen.lazyderef) (quote shen.lazyderef)) +(begin (register-function-arity (quote shen.valvector) 2) (define (kl:shen.valvector V1196 V1197) (vector-ref (vector-ref (kl:value (quote shen.*prologvectors*)) V1197) (vector-ref V1196 1))) (export shen.valvector) (quote shen.valvector)) +(begin (register-function-arity (quote unify!) 4) (define (kl:unify! V1202 V1203 V1204 V1205) (kl:shen.lzy=! (kl:shen.lazyderef V1202 V1204) (kl:shen.lazyderef V1203 V1204) V1204 V1205)) (export unify!) (quote unify!)) +(begin (register-function-arity (quote shen.lzy=!) 4) (define (kl:shen.lzy=! V1227 V1228 V1229 V1230) (cond ((kl:= V1228 V1227) (kl:thaw V1230)) ((and (kl:shen.pvar? V1227) (kl:not (kl:shen.occurs? V1227 (kl:shen.deref V1228 V1229)))) (kl:bind V1227 V1228 V1229 V1230)) ((and (kl:shen.pvar? V1228) (kl:not (kl:shen.occurs? V1228 (kl:shen.deref V1227 V1229)))) (kl:bind V1228 V1227 V1229 V1230)) ((and (pair? V1227) (pair? V1228)) (kl:shen.lzy=! (kl:shen.lazyderef (car V1227) V1229) (kl:shen.lazyderef (car V1228) V1229) V1229 (lambda () (kl:shen.lzy=! (kl:shen.lazyderef (cdr V1227) V1229) (kl:shen.lazyderef (cdr V1228) V1229) V1229 V1230)))) (#t #f))) (export shen.lzy=!) (quote shen.lzy=!)) +(begin (register-function-arity (quote shen.occurs?) 2) (define (kl:shen.occurs? V1242 V1243) (cond ((kl:= V1243 V1242) #t) ((pair? V1243) (or (assert-boolean (kl:shen.occurs? V1242 (car V1243))) (assert-boolean (kl:shen.occurs? V1242 (cdr V1243))))) (#t #f))) (export shen.occurs?) (quote shen.occurs?)) +(begin (register-function-arity (quote identical) 4) (define (kl:identical V1248 V1249 V1250 V1251) (kl:shen.lzy== (kl:shen.lazyderef V1248 V1250) (kl:shen.lazyderef V1249 V1250) V1250 V1251)) (export identical) (quote identical)) +(begin (register-function-arity (quote shen.lzy==) 4) (define (kl:shen.lzy== V1273 V1274 V1275 V1276) (cond ((kl:= V1274 V1273) (kl:thaw V1276)) ((and (pair? V1273) (pair? V1274)) (kl:shen.lzy== (kl:shen.lazyderef (car V1273) V1275) (kl:shen.lazyderef (car V1274) V1275) V1275 (lambda () (kl:shen.lzy== (cdr V1273) (cdr V1274) V1275 V1276)))) (#t #f))) (export shen.lzy==) (quote shen.lzy==)) +(begin (register-function-arity (quote shen.pvar) 1) (define (kl:shen.pvar V1278) (string-append "Var" (kl:shen.app (vector-ref V1278 1) "" (quote shen.a)))) (export shen.pvar) (quote shen.pvar)) +(begin (register-function-arity (quote bind) 4) (define (kl:bind V1283 V1284 V1285 V1286) (begin (kl:shen.bindv V1283 V1284 V1285) (let ((Result (kl:thaw V1286))) (begin (kl:shen.unbindv V1283 V1285) Result)))) (export bind) (quote bind)) +(begin (register-function-arity (quote fwhen) 3) (define (kl:fwhen V1304 V1305 V1306) (cond ((kl:= #t V1304) (kl:thaw V1306)) ((kl:= #f V1304) #f) (#t (simple-error (string-append "fwhen expects a boolean: not " (kl:shen.app V1304 "%" (quote shen.s))))))) (export fwhen) (quote fwhen)) +(begin (register-function-arity (quote call) 3) (define (kl:call V1322 V1323 V1324) (cond ((pair? V1322) (kl:shen.call-help (kl:function (kl:shen.lazyderef (car V1322) V1323)) (cdr V1322) V1323 V1324)) ((kl:shen.pvar? V1322) (kl:call (kl:shen.lazyderef V1322 V1323) V1323 V1324)) (#t #f))) (export call) (quote call)) +(begin (register-function-arity (quote shen.call-help) 4) (define (kl:shen.call-help V1329 V1330 V1331 V1332) (cond ((null? V1330) ((V1329 V1331) V1332)) ((pair? V1330) (kl:shen.call-help (V1329 (car V1330)) (cdr V1330) V1331 V1332)) (#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 V1334) (cond ((and (pair? V1334) (pair? (car V1334))) (let ((ProcessN (kl:shen.start-new-prolog-process))) (kl:shen.intprolog-help (car (car V1334)) (kl:shen.insert-prolog-variables (cons (cdr (car V1334)) (cons (cdr V1334) (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 V1338 V1339 V1340) (cond ((and (pair? V1339) (and (pair? (cdr V1339)) (null? (cdr (cdr V1339))))) (kl:shen.intprolog-help-help V1338 (car V1339) (car (cdr V1339)) V1340)) (#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 V1345 V1346 V1347 V1348) (cond ((null? V1346) ((V1345 V1348) (lambda () (kl:shen.call-rest V1347 V1348)))) ((pair? V1346) (kl:shen.intprolog-help-help (V1345 (car V1346)) (cdr V1346) V1347 V1348)) (#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 V1353 V1354) (cond ((null? V1353) #t) ((and (pair? V1353) (and (pair? (car V1353)) (pair? (cdr (car V1353))))) (kl:shen.call-rest (cons (cons ((car (car V1353)) (car (cdr (car V1353)))) (cdr (cdr (car V1353)))) (cdr V1353)) V1354)) ((and (pair? V1353) (and (pair? (car V1353)) (null? (cdr (car V1353))))) (((car (car V1353)) V1354) (lambda () (kl:shen.call-rest (cdr V1353) V1354)))) (#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 V2518 V2519) (kl:shen.insert-prolog-variables-help V2518 (kl:shen.flatten V2518) V2519)) (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 V2527 V2528 V2529) (cond ((null? V2528) V2527) ((and (pair? V2528) (kl:variable? (car V2528))) (let ((V (kl:shen.newpv V2529))) (let ((XV/Y (kl:subst V (car V2528) V2527))) (let ((Z-Y (kl:remove (car V2528) (cdr V2528)))) (kl:shen.insert-prolog-variables-help XV/Y Z-Y V2529))))) ((pair? V2528) (kl:shen.insert-prolog-variables-help V2527 (cdr V2528) V2529)) (#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 V2531) (let ((Vector (let ((_tmp (kl:value (quote shen.*prologvectors*)))) (vector-set! _tmp V2531 (kl:shen.fillvector (kl:vector 10) 1 10 (quote shen.-null-))) _tmp))) (let ((Counter (let ((_tmp (kl:value (quote shen.*varcounter*)))) (vector-set! _tmp V2531 1) _tmp))) V2531))) (export shen.initialise-prolog) (quote shen.initialise-prolog)) +(begin (register-function-arity (quote shen.insert-prolog-variables) 2) (define (kl:shen.insert-prolog-variables V1357 V1358) (kl:shen.insert-prolog-variables-help V1357 (kl:shen.flatten V1357) V1358)) (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 V1366 V1367 V1368) (cond ((null? V1367) V1366) ((and (pair? V1367) (kl:variable? (car V1367))) (let ((V (kl:shen.newpv V1368))) (let ((XV/Y (kl:subst V (car V1367) V1366))) (let ((Z-Y (kl:remove (car V1367) (cdr V1367)))) (kl:shen.insert-prolog-variables-help XV/Y Z-Y V1368))))) ((pair? V1367) (kl:shen.insert-prolog-variables-help V1366 (cdr V1367) V1368)) (#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 V1370) (let ((Vector (let ((_tmp (kl:value (quote shen.*prologvectors*)))) (vector-set! _tmp V1370 (kl:shen.fillvector (kl:vector 10) 1 10 (quote shen.-null-))) _tmp))) (let ((Counter (let ((_tmp (kl:value (quote shen.*varcounter*)))) (vector-set! _tmp V1370 1) _tmp))) V1370))) (export shen.initialise-prolog) (quote shen.initialise-prolog)) diff --git a/compiled/reader.kl.ms b/compiled/reader.kl.ms index 9364ef4..ecf30b5 100644 --- a/compiled/reader.kl.ms +++ b/compiled/reader.kl.ms @@ -1,89 +1,89 @@ (module "compiled/reader.kl") "Copyright (c) 2010-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:\n\n1. Redistributions of source code must retain the above copyright notice,\nthis list of conditions and the following disclaimer.\n\n2. Redistributions in binary form must reproduce the above copyright notice,\nthis list of conditions and the following disclaimer in the documentation\nand/or other materials provided with the distribution.\n\n3. Neither the name of the copyright holder nor the names of its contributors\nmay be used to endorse or promote products derived from this software without\nspecific prior written permission.\n\nTHIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ''AS IS'' AND\nANY EXPRESS 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 THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE\nFOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL\nDAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR\nSERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER\nCAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,\nOR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE\nOF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.\n" -(begin (register-function-arity (quote shen.read-char-code) 1) (define (kl:shen.read-char-code V2533) (read-u8 V2533)) (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 V2535) (kl:shen.read-file-as-Xlist V2535 (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 V2537) (kl:shen.read-file-as-Xlist V2537 (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 V2540 V2541) (let ((Stream (kl:open V2540 (quote in)))) (let ((X (V2541 Stream))) (let ((Xs (kl:shen.read-file-as-Xlist-help Stream V2541 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 V2546 V2547 V2548 V2549) (cond ((kl:= -1 V2548) V2549) (#t (kl:shen.read-file-as-Xlist-help V2546 V2547 (V2547 V2546) (cons V2548 V2549))))) (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 V2551) (let ((Stream (kl:open V2551 (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 V2555 V2556 V2557) (cond ((kl:= -1 V2556) (begin (kl:close V2555) V2557)) (#t (kl:shen.rfas-h V2555 (kl:shen.read-char-code V2555) (string-append V2557 (make-string 1 V2556)))))) (export shen.rfas-h) (quote shen.rfas-h)) -(begin (register-function-arity (quote input) 1) (define (kl:input V2559) (kl:eval-kl (kl:read V2559))) (export input) (quote input)) -(begin (register-function-arity (quote input+) 2) (define (kl:input+ V2562 V2563) (let ((Mono? (kl:shen.monotype V2562))) (let ((Input (kl:read V2563))) (if (kl:= #f (kl:shen.typecheck Input (kl:shen.demodulate V2562))) (simple-error (string-append "type error: " (kl:shen.app Input (string-append " is not of type " (kl:shen.app V2562 "\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 V2565) (cond ((pair? V2565) (kl:map (lambda (Z) (kl:shen.monotype Z)) V2565)) (#t (if (kl:variable? V2565) (simple-error (string-append "input+ expects a monotype: not " (kl:shen.app V2565 "\n" (quote shen.a)))) V2565)))) (export shen.monotype) (quote shen.monotype)) -(begin (register-function-arity (quote read) 1) (define (kl:read V2567) (car (kl:shen.read-loop V2567 (kl:shen.read-char-code V2567) (quote ())))) (export read) (quote read)) +(begin (register-function-arity (quote shen.read-char-code) 1) (define (kl:shen.read-char-code V1372) (read-u8 V1372)) (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 V1374) (kl:shen.read-file-as-Xlist V1374 (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 V1376) (kl:shen.read-file-as-Xlist V1376 (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 V1379 V1380) (let ((Stream (kl:open V1379 (quote in)))) (let ((X (V1380 Stream))) (let ((Xs (kl:shen.read-file-as-Xlist-help Stream V1380 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 V1385 V1386 V1387 V1388) (cond ((kl:= -1 V1387) V1388) (#t (kl:shen.read-file-as-Xlist-help V1385 V1386 (V1386 V1385) (cons V1387 V1388))))) (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 V1390) (let ((Stream (kl:open V1390 (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 V1394 V1395 V1396) (cond ((kl:= -1 V1395) (begin (kl:close V1394) V1396)) (#t (kl:shen.rfas-h V1394 (kl:shen.read-char-code V1394) (string-append V1396 (make-string 1 V1395)))))) (export shen.rfas-h) (quote shen.rfas-h)) +(begin (register-function-arity (quote input) 1) (define (kl:input V1398) (kl:eval-kl (kl:read V1398))) (export input) (quote input)) +(begin (register-function-arity (quote input+) 2) (define (kl:input+ V1401 V1402) (let ((Mono? (kl:shen.monotype V1401))) (let ((Input (kl:read V1402))) (if (kl:= #f (kl:shen.typecheck Input (kl:shen.demodulate V1401))) (simple-error (string-append "type error: " (kl:shen.app Input (string-append " is not of type " (kl:shen.app V1401 "\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 V1404) (cond ((pair? V1404) (kl:map (lambda (Z) (kl:shen.monotype Z)) V1404)) (#t (if (kl:variable? V1404) (simple-error (string-append "input+ expects a monotype: not " (kl:shen.app V1404 "\n" (quote shen.a)))) V1404)))) (export shen.monotype) (quote shen.monotype)) +(begin (register-function-arity (quote read) 1) (define (kl:read V1406) (car (kl:shen.read-loop V1406 (kl:shen.read-char-code V1406) (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 V2575 V2576 V2577) (cond ((kl:= 94 V2576) (simple-error "read aborted")) ((kl:= -1 V2576) (if (kl:empty? V2577) (simple-error "error: empty stream") (kl:compile (lambda (X) (kl:shen. X)) V2577 (lambda (E) E)))) ((assert-boolean (kl:shen.terminator? V2576)) (let ((AllChars (kl:append V2577 (cons V2576 (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 V2575 (kl:shen.read-char-code V2575) AllChars) Read))))) (#t (kl:shen.read-loop V2575 (kl:shen.read-char-code V2575) (kl:append V2577 (cons V2576 (quote ()))))))) (export shen.read-loop) (quote shen.read-loop)) -(begin (register-function-arity (quote shen.terminator?) 1) (define (kl:shen.terminator? V2579) (kl:element? V2579 (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 V2581) (kl:shen.lineread-loop (kl:shen.read-char-code V2581) (quote ()) V2581)) (export lineread) (quote lineread)) -(begin (register-function-arity (quote shen.lineread-loop) 3) (define (kl:shen.lineread-loop V2586 V2587 V2588) (cond ((kl:= -1 V2586) (if (kl:empty? V2587) (simple-error "empty stream") (kl:compile (lambda (X) (kl:shen. X)) V2587 (lambda (E) E)))) ((kl:= V2586 (kl:shen.hat)) (simple-error "line read aborted")) ((kl:element? V2586 (cons (kl:shen.newline) (cons (kl:shen.carriage-return) (quote ())))) (let ((Line (kl:compile (lambda (X) (kl:shen. X)) V2587 (lambda (E) (quote shen.nextline))))) (let ((It (kl:shen.record-it V2587))) (if (or (eq? Line (quote shen.nextline)) (kl:empty? Line)) (kl:shen.lineread-loop (kl:shen.read-char-code V2588) (kl:append V2587 (cons V2586 (quote ()))) V2588) Line)))) (#t (kl:shen.lineread-loop (kl:shen.read-char-code V2588) (kl:append V2587 (cons V2586 (quote ()))) V2588)))) (export shen.lineread-loop) (quote shen.lineread-loop)) -(begin (register-function-arity (quote shen.record-it) 1) (define (kl:shen.record-it V2590) (let ((TrimLeft (kl:shen.trim-whitespace V2590))) (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 V2592) (cond ((and (pair? V2592) (kl:element? (car V2592) (cons 9 (cons 10 (cons 13 (cons 32 (quote ()))))))) (kl:shen.trim-whitespace (cdr V2592))) (#t V2592))) (export shen.trim-whitespace) (quote shen.trim-whitespace)) -(begin (register-function-arity (quote shen.record-it-h) 1) (define (kl:shen.record-it-h V2594) (begin (kl:set (quote shen.*it*) (kl:shen.cn-all (kl:map (lambda (X) (make-string 1 X)) V2594))) V2594)) (export shen.record-it-h) (quote shen.record-it-h)) -(begin (register-function-arity (quote shen.cn-all) 1) (define (kl:shen.cn-all V2596) (cond ((null? V2596) "") ((pair? V2596) (string-append (car V2596) (kl:shen.cn-all (cdr V2596)))) (#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 V2598) (let ((Charlist (kl:shen.read-file-as-charlist V2598))) (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 V2600) (let ((Ns (kl:map (lambda (X) (string-ref X 0)) (kl:explode V2600)))) (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 V2608) (cond ((and (pair? V2608) (and (pair? (car V2608)) (and (pair? (cdr V2608)) (null? (cdr (cdr V2608)))))) (simple-error (string-append "read error here:\n\n " (kl:shen.app (kl:shen.compress-50 50 (car V2608)) "\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 V2615 V2616) (cond ((null? V2616) "") ((kl:= 0 V2615) "") ((pair? V2616) (string-append (make-string 1 (car V2616)) (kl:shen.compress-50 (- V2615 1) (cdr V2616)))) (#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. V2618) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2618))) (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. V2618))) (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. V2618))) (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. V2618))) (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. V2618))) (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. V2618))) (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. V2618))) (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. V2618))) (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. V2618))) (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. V2618))) (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. V2618))) (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. V2618))) (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. V2618))) (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: V2618))) (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. V2621) (if (and (pair? (car V2621)) (kl:= 91 (kl:shen.hdhd V2621))) (let ((NewStream2619 (kl:shen.pair (kl:shen.tlhd V2621) (kl:shen.hdtl V2621)))) (kl:shen.pair (car NewStream2619) (quote shen.skip))) (kl:fail))) (export shen.) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2624) (if (and (pair? (car V2624)) (kl:= 93 (kl:shen.hdhd V2624))) (let ((NewStream2622 (kl:shen.pair (kl:shen.tlhd V2624) (kl:shen.hdtl V2624)))) (kl:shen.pair (car NewStream2622) (quote shen.skip))) (kl:fail))) (export shen.) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2627) (if (and (pair? (car V2627)) (kl:= 123 (kl:shen.hdhd V2627))) (let ((NewStream2625 (kl:shen.pair (kl:shen.tlhd V2627) (kl:shen.hdtl V2627)))) (kl:shen.pair (car NewStream2625) (quote shen.skip))) (kl:fail))) (export shen.) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2630) (if (and (pair? (car V2630)) (kl:= 125 (kl:shen.hdhd V2630))) (let ((NewStream2628 (kl:shen.pair (kl:shen.tlhd V2630) (kl:shen.hdtl V2630)))) (kl:shen.pair (car NewStream2628) (quote shen.skip))) (kl:fail))) (export shen.) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2633) (if (and (pair? (car V2633)) (kl:= 124 (kl:shen.hdhd V2633))) (let ((NewStream2631 (kl:shen.pair (kl:shen.tlhd V2633) (kl:shen.hdtl V2633)))) (kl:shen.pair (car NewStream2631) (quote shen.skip))) (kl:fail))) (export shen.) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2636) (if (and (pair? (car V2636)) (kl:= 59 (kl:shen.hdhd V2636))) (let ((NewStream2634 (kl:shen.pair (kl:shen.tlhd V2636) (kl:shen.hdtl V2636)))) (kl:shen.pair (car NewStream2634) (quote shen.skip))) (kl:fail))) (export shen.) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2639) (if (and (pair? (car V2639)) (kl:= 58 (kl:shen.hdhd V2639))) (let ((NewStream2637 (kl:shen.pair (kl:shen.tlhd V2639) (kl:shen.hdtl V2639)))) (kl:shen.pair (car NewStream2637) (quote shen.skip))) (kl:fail))) (export shen.) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2642) (if (and (pair? (car V2642)) (kl:= 44 (kl:shen.hdhd V2642))) (let ((NewStream2640 (kl:shen.pair (kl:shen.tlhd V2642) (kl:shen.hdtl V2642)))) (kl:shen.pair (car NewStream2640) (quote shen.skip))) (kl:fail))) (export shen.) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2645) (if (and (pair? (car V2645)) (kl:= 61 (kl:shen.hdhd V2645))) (let ((NewStream2643 (kl:shen.pair (kl:shen.tlhd V2645) (kl:shen.hdtl V2645)))) (kl:shen.pair (car NewStream2643) (quote shen.skip))) (kl:fail))) (export shen.) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2648) (if (and (pair? (car V2648)) (kl:= 45 (kl:shen.hdhd V2648))) (let ((NewStream2646 (kl:shen.pair (kl:shen.tlhd V2648) (kl:shen.hdtl V2648)))) (kl:shen.pair (car NewStream2646) (quote shen.skip))) (kl:fail))) (export shen.) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2651) (if (and (pair? (car V2651)) (kl:= 40 (kl:shen.hdhd V2651))) (let ((NewStream2649 (kl:shen.pair (kl:shen.tlhd V2651) (kl:shen.hdtl V2651)))) (kl:shen.pair (car NewStream2649) (quote shen.skip))) (kl:fail))) (export shen.) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2654) (if (and (pair? (car V2654)) (kl:= 41 (kl:shen.hdhd V2654))) (let ((NewStream2652 (kl:shen.pair (kl:shen.tlhd V2654) (kl:shen.hdtl V2654)))) (kl:shen.pair (car NewStream2652) (quote shen.skip))) (kl:fail))) (export shen.) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2656) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2656))) (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. V2656))) (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. V2656))) (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 V2658) (cond ((null? V2658) "") ((and (pair? V2658) (and (equal? "c" (car V2658)) (and (pair? (cdr V2658)) (equal? "#" (car (cdr V2658)))))) (let ((CodePoint (kl:shen.code-point (cdr (cdr V2658))))) (let ((AfterCodePoint (kl:shen.after-codepoint (cdr (cdr V2658))))) (kl:_waspvm_at_s (make-string 1 (kl:shen.decimalise CodePoint)) (kl:shen.control-chars AfterCodePoint))))) ((pair? V2658) (kl:_waspvm_at_s (car V2658) (kl:shen.control-chars (cdr V2658)))) (#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 V2662) (cond ((and (pair? V2662) (equal? ";" (car V2662))) "") ((and (pair? V2662) (kl:element? (car V2662) (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 V2662) (kl:shen.code-point (cdr V2662)))) (#t (simple-error (string-append "code point parse error " (kl:shen.app V2662 "\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 V2668) (cond ((null? V2668) (quote ())) ((and (pair? V2668) (equal? ";" (car V2668))) (cdr V2668)) ((pair? V2668) (kl:shen.after-codepoint (cdr V2668))) (#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 V2670) (kl:shen.pre (kl:reverse (kl:shen.digits->integers V2670)) 0)) (export shen.decimalise) (quote shen.decimalise)) -(begin (register-function-arity (quote shen.digits->integers) 1) (define (kl:shen.digits->integers V2676) (cond ((and (pair? V2676) (equal? "0" (car V2676))) (cons 0 (kl:shen.digits->integers (cdr V2676)))) ((and (pair? V2676) (equal? "1" (car V2676))) (cons 1 (kl:shen.digits->integers (cdr V2676)))) ((and (pair? V2676) (equal? "2" (car V2676))) (cons 2 (kl:shen.digits->integers (cdr V2676)))) ((and (pair? V2676) (equal? "3" (car V2676))) (cons 3 (kl:shen.digits->integers (cdr V2676)))) ((and (pair? V2676) (equal? "4" (car V2676))) (cons 4 (kl:shen.digits->integers (cdr V2676)))) ((and (pair? V2676) (equal? "5" (car V2676))) (cons 5 (kl:shen.digits->integers (cdr V2676)))) ((and (pair? V2676) (equal? "6" (car V2676))) (cons 6 (kl:shen.digits->integers (cdr V2676)))) ((and (pair? V2676) (equal? "7" (car V2676))) (cons 7 (kl:shen.digits->integers (cdr V2676)))) ((and (pair? V2676) (equal? "8" (car V2676))) (cons 8 (kl:shen.digits->integers (cdr V2676)))) ((and (pair? V2676) (equal? "9" (car V2676))) (cons 9 (kl:shen.digits->integers (cdr V2676)))) (#t (quote ())))) (export shen.digits->integers) (quote shen.digits->integers)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2678) (let ((Parse_shen. (kl:shen. V2678))) (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. V2680) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2680))) (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: V2680))) (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. V2682) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2682))) (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. V2682))) (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. V2684) (if (pair? (car V2684)) (let ((Parse_Char (kl:shen.hdhd V2684))) (if (assert-boolean (kl:shen.numbyte? Parse_Char)) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V2684) (kl:shen.hdtl V2684))) (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? V2690) (cond ((kl:= 48 V2690) #t) ((kl:= 49 V2690) #t) ((kl:= 50 V2690) #t) ((kl:= 51 V2690) #t) ((kl:= 52 V2690) #t) ((kl:= 53 V2690) #t) ((kl:= 54 V2690) #t) ((kl:= 55 V2690) #t) ((kl:= 56 V2690) #t) ((kl:= 57 V2690) #t) (#t #f))) (export shen.numbyte?) (quote shen.numbyte?)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2692) (if (pair? (car V2692)) (let ((Parse_Char (kl:shen.hdhd V2692))) (if (assert-boolean (kl:shen.symbol-code? Parse_Char)) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V2692) (kl:shen.hdtl V2692))) (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? V2694) (or (kl:= V2694 126) (or (and (> V2694 94) (< V2694 123)) (or (and (> V2694 59) (< V2694 91)) (or (and (> V2694 41) (and (< V2694 58) (kl:not (kl:= V2694 44)))) (or (and (> V2694 34) (< V2694 40)) (kl:= V2694 33))))))) (export shen.symbol-code?) (quote shen.symbol-code?)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2696) (let ((Parse_shen. (kl:shen. V2696))) (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. V2698) (if (pair? (car V2698)) (let ((Parse_Char (kl:shen.hdhd V2698))) (if (kl:= Parse_Char 34) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V2698) (kl:shen.hdtl V2698))) Parse_Char) (kl:fail))) (kl:fail))) (export shen.) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2700) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2700))) (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: V2700))) (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. V2702) (if (pair? (car V2702)) (let ((Parse_Char (kl:shen.hdhd V2702))) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V2702) (kl:shen.hdtl V2702))) (make-string 1 Parse_Char))) (kl:fail))) (export shen.) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2704) (if (pair? (car V2704)) (let ((Parse_Char (kl:shen.hdhd V2704))) (if (kl:not (kl:= Parse_Char 34)) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V2704) (kl:shen.hdtl V2704))) (make-string 1 Parse_Char)) (kl:fail))) (kl:fail))) (export shen.) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2706) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2706))) (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. V2706))) (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. V2706))) (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. V2706))) (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. V2706))) (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. V2706))) (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. V2709) (if (and (pair? (car V2709)) (kl:= 101 (kl:shen.hdhd V2709))) (let ((NewStream2707 (kl:shen.pair (kl:shen.tlhd V2709) (kl:shen.hdtl V2709)))) (kl:shen.pair (car NewStream2707) (quote shen.skip))) (kl:fail))) (export shen.) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2711) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2711))) (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. V2711))) (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. V2713) (if (pair? (car V2713)) (let ((Parse_Char (kl:shen.hdhd V2713))) (if (kl:= Parse_Char 43) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V2713) (kl:shen.hdtl V2713))) Parse_Char) (kl:fail))) (kl:fail))) (export shen.) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2715) (if (pair? (car V2715)) (let ((Parse_Char (kl:shen.hdhd V2715))) (if (kl:= Parse_Char 46) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V2715) (kl:shen.hdtl V2715))) Parse_Char) (kl:fail))) (kl:fail))) (export shen.) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2717) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2717))) (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: V2717))) (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. V2719) (let ((Parse_shen. (kl:shen. V2719))) (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. V2721) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2721))) (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. V2721))) (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. V2723) (if (pair? (car V2723)) (let ((Parse_X (kl:shen.hdhd V2723))) (if (assert-boolean (kl:shen.numbyte? Parse_X)) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V2723) (kl:shen.hdtl V2723))) (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 V2725) (cond ((kl:= 48 V2725) 0) ((kl:= 49 V2725) 1) ((kl:= 50 V2725) 2) ((kl:= 51 V2725) 3) ((kl:= 52 V2725) 4) ((kl:= 53 V2725) 5) ((kl:= 54 V2725) 6) ((kl:= 55 V2725) 7) ((kl:= 56 V2725) 8) ((kl:= 57 V2725) 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 V2730 V2731) (cond ((null? V2730) 0) ((pair? V2730) (+ (* (kl:shen.expt 10 V2731) (car V2730)) (kl:shen.pre (cdr V2730) (+ V2731 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 V2736 V2737) (cond ((null? V2736) 0) ((pair? V2736) (+ (* (kl:shen.expt 10 (- 0 V2737)) (car V2736)) (kl:shen.post (cdr V2736) (+ V2737 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 V2742 V2743) (cond ((kl:= 0 V2743) 1) ((> V2743 0) (* V2742 (kl:shen.expt V2742 (- V2743 1)))) (#t (* 1 (/ (kl:shen.expt V2742 (+ V2743 1)) V2742))))) (export shen.expt) (quote shen.expt)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2745) (let ((Parse_shen. (kl:shen. V2745))) (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. V2747) (let ((Parse_shen. (kl:shen. V2747))) (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. V2749) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2749))) (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. V2749))) (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. V2751) (let ((Parse_shen. (kl:shen. V2751))) (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. V2754) (if (and (pair? (car V2754)) (kl:= 92 (kl:shen.hdhd V2754))) (let ((NewStream2752 (kl:shen.pair (kl:shen.tlhd V2754) (kl:shen.hdtl V2754)))) (kl:shen.pair (car NewStream2752) (quote shen.skip))) (kl:fail))) (export shen.) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2756) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2756))) (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: V2756))) (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. V2758) (if (pair? (car V2758)) (let ((Parse_X (kl:shen.hdhd V2758))) (if (kl:not (kl:element? Parse_X (cons 10 (cons 13 (quote ()))))) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V2758) (kl:shen.hdtl V2758))) (quote shen.skip)) (kl:fail))) (kl:fail))) (export shen.) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2760) (if (pair? (car V2760)) (let ((Parse_X (kl:shen.hdhd V2760))) (if (kl:element? Parse_X (cons 10 (cons 13 (quote ())))) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V2760) (kl:shen.hdtl V2760))) (quote shen.skip)) (kl:fail))) (kl:fail))) (export shen.) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2762) (let ((Parse_shen. (kl:shen. V2762))) (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. V2765) (if (and (pair? (car V2765)) (kl:= 42 (kl:shen.hdhd V2765))) (let ((NewStream2763 (kl:shen.pair (kl:shen.tlhd V2765) (kl:shen.hdtl V2765)))) (kl:shen.pair (car NewStream2763) (quote shen.skip))) (kl:fail))) (export shen.) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2767) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2767))) (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. V2767))) (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 V2767)) (let ((Parse_X (kl:shen.hdhd V2767))) (let ((Parse_shen. (kl:shen. (kl:shen.pair (kl:shen.tlhd V2767) (kl:shen.hdtl V2767))))) (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. V2769) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2769))) (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. V2769))) (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. V2771) (if (pair? (car V2771)) (let ((Parse_X (kl:shen.hdhd V2771))) (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 V2771) (kl:shen.hdtl V2771))) (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 V2773) (cond ((null? V2773) (quote ())) ((and (pair? V2773) (and (pair? (cdr V2773)) (and (pair? (cdr (cdr V2773))) (and (null? (cdr (cdr (cdr V2773)))) (eq? (car (cdr V2773)) (quote bar!)))))) (cons (quote cons) (cons (car V2773) (cdr (cdr V2773))))) ((pair? V2773) (cons (quote cons) (cons (car V2773) (cons (kl:shen.cons_form (cdr V2773)) (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 V2778 V2779) (cond ((and (pair? V2778) (and (eq? (quote _waspvm_dl_) (car V2778)) (and (pair? (cdr V2778)) (null? (cdr (cdr V2778)))))) (kl:append (kl:explode (car (cdr V2778))) V2779)) ((and (pair? V2778) (and (eq? (quote package) (car V2778)) (and (pair? (cdr V2778)) (and (eq? (quote null) (car (cdr V2778))) (pair? (cdr (cdr V2778))))))) (kl:append (cdr (cdr (cdr V2778))) V2779)) ((and (pair? V2778) (and (eq? (quote package) (car V2778)) (and (pair? (cdr V2778)) (pair? (cdr (cdr V2778)))))) (let ((ListofExceptions (kl:shen.eval-without-macros (car (cdr (cdr V2778)))))) (let ((External (kl:shen.record-exceptions ListofExceptions (car (cdr V2778))))) (let ((PackageNameDot (kl:intern (string-append (kl:str (car (cdr V2778))) ".")))) (let ((ExpPackageNameDot (kl:explode PackageNameDot))) (let ((Packaged (kl:shen.packageh PackageNameDot ListofExceptions (cdr (cdr (cdr V2778))) ExpPackageNameDot))) (let ((Internal (kl:shen.record-internal (car (cdr V2778)) (kl:shen.internal-symbols ExpPackageNameDot Packaged)))) (kl:append Packaged V2779)))))))) (#t (cons V2778 V2779)))) (export shen.package-macro) (quote shen.package-macro)) -(begin (register-function-arity (quote shen.record-exceptions) 2) (define (kl:shen.record-exceptions V2782 V2783) (let ((CurrExceptions (guard (lambda (E) (quote ())) (kl:get V2783 (quote shen.external-symbols) (kl:value (quote *property-vector*)))))) (let ((AllExceptions (kl:union V2782 CurrExceptions))) (kl:put V2783 (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 V2786 V2787) (kl:put V2786 (quote shen.internal-symbols) (kl:union V2787 (guard (lambda (E) (quote ())) (kl:get V2786 (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 V2798 V2799) (cond ((and (kl:symbol? V2799) (assert-boolean (kl:shen.prefix? V2798 (kl:explode V2799)))) (cons V2799 (quote ()))) ((pair? V2799) (kl:union (kl:shen.internal-symbols V2798 (car V2799)) (kl:shen.internal-symbols V2798 (cdr V2799)))) (#t (quote ())))) (export shen.internal-symbols) (quote shen.internal-symbols)) -(begin (register-function-arity (quote shen.packageh) 4) (define (kl:shen.packageh V2816 V2817 V2818 V2819) (cond ((pair? V2818) (cons (kl:shen.packageh V2816 V2817 (car V2818) V2819) (kl:shen.packageh V2816 V2817 (cdr V2818) V2819))) ((or (assert-boolean (kl:shen.sysfunc? V2818)) (or (kl:variable? V2818) (or (kl:element? V2818 V2817) (or (assert-boolean (kl:shen.doubleunderline? V2818)) (assert-boolean (kl:shen.singleunderline? V2818)))))) V2818) ((and (kl:symbol? V2818) (assert-boolean (let ((ExplodeX (kl:explode V2818))) (and (kl:not (kl:shen.prefix? (cons "s" (cons "h" (cons "e" (cons "n" (cons "." (quote ())))))) ExplodeX)) (kl:not (kl:shen.prefix? V2819 ExplodeX)))))) (kl:concat V2816 V2818)) (#t V2818))) (export shen.packageh) (quote shen.packageh)) +(begin (register-function-arity (quote shen.read-loop) 3) (define (kl:shen.read-loop V1414 V1415 V1416) (cond ((kl:= 94 V1415) (simple-error "read aborted")) ((kl:= -1 V1415) (if (kl:empty? V1416) (simple-error "error: empty stream") (kl:compile (lambda (X) (kl:shen. X)) V1416 (lambda (E) E)))) ((assert-boolean (kl:shen.terminator? V1415)) (let ((AllChars (kl:append V1416 (cons V1415 (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 V1414 (kl:shen.read-char-code V1414) AllChars) Read))))) (#t (kl:shen.read-loop V1414 (kl:shen.read-char-code V1414) (kl:append V1416 (cons V1415 (quote ()))))))) (export shen.read-loop) (quote shen.read-loop)) +(begin (register-function-arity (quote shen.terminator?) 1) (define (kl:shen.terminator? V1418) (kl:element? V1418 (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 V1420) (kl:shen.lineread-loop (kl:shen.read-char-code V1420) (quote ()) V1420)) (export lineread) (quote lineread)) +(begin (register-function-arity (quote shen.lineread-loop) 3) (define (kl:shen.lineread-loop V1425 V1426 V1427) (cond ((kl:= -1 V1425) (if (kl:empty? V1426) (simple-error "empty stream") (kl:compile (lambda (X) (kl:shen. X)) V1426 (lambda (E) E)))) ((kl:= V1425 (kl:shen.hat)) (simple-error "line read aborted")) ((kl:element? V1425 (cons (kl:shen.newline) (cons (kl:shen.carriage-return) (quote ())))) (let ((Line (kl:compile (lambda (X) (kl:shen. X)) V1426 (lambda (E) (quote shen.nextline))))) (let ((It (kl:shen.record-it V1426))) (if (or (eq? Line (quote shen.nextline)) (kl:empty? Line)) (kl:shen.lineread-loop (kl:shen.read-char-code V1427) (kl:append V1426 (cons V1425 (quote ()))) V1427) Line)))) (#t (kl:shen.lineread-loop (kl:shen.read-char-code V1427) (kl:append V1426 (cons V1425 (quote ()))) V1427)))) (export shen.lineread-loop) (quote shen.lineread-loop)) +(begin (register-function-arity (quote shen.record-it) 1) (define (kl:shen.record-it V1429) (let ((TrimLeft (kl:shen.trim-whitespace V1429))) (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 V1431) (cond ((and (pair? V1431) (kl:element? (car V1431) (cons 9 (cons 10 (cons 13 (cons 32 (quote ()))))))) (kl:shen.trim-whitespace (cdr V1431))) (#t V1431))) (export shen.trim-whitespace) (quote shen.trim-whitespace)) +(begin (register-function-arity (quote shen.record-it-h) 1) (define (kl:shen.record-it-h V1433) (begin (kl:set (quote shen.*it*) (kl:shen.cn-all (kl:map (lambda (X) (make-string 1 X)) V1433))) V1433)) (export shen.record-it-h) (quote shen.record-it-h)) +(begin (register-function-arity (quote shen.cn-all) 1) (define (kl:shen.cn-all V1435) (cond ((null? V1435) "") ((pair? V1435) (string-append (car V1435) (kl:shen.cn-all (cdr V1435)))) (#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 V1437) (let ((Charlist (kl:shen.read-file-as-charlist V1437))) (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 V1439) (let ((Ns (kl:map (lambda (X) (string-ref X 0)) (kl:explode V1439)))) (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 V1447) (cond ((and (pair? V1447) (and (pair? (car V1447)) (and (pair? (cdr V1447)) (null? (cdr (cdr V1447)))))) (simple-error (string-append "read error here:\n\n " (kl:shen.app (kl:shen.compress-50 50 (car V1447)) "\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 V1454 V1455) (cond ((null? V1455) "") ((kl:= 0 V1454) "") ((pair? V1455) (string-append (make-string 1 (car V1455)) (kl:shen.compress-50 (- V1454 1) (cdr V1455)))) (#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. V1457) (let ((YaccParse (let ((Parse_shen. (kl:shen. V1457))) (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. V1457))) (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. V1457))) (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. V1457))) (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. V1457))) (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. V1457))) (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. V1457))) (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. V1457))) (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. V1457))) (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. V1457))) (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. V1457))) (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. V1457))) (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. V1457))) (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: V1457))) (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. V1460) (if (and (pair? (car V1460)) (kl:= 91 (kl:shen.hdhd V1460))) (let ((NewStream1458 (kl:shen.pair (kl:shen.tlhd V1460) (kl:shen.hdtl V1460)))) (kl:shen.pair (car NewStream1458) (quote shen.skip))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1463) (if (and (pair? (car V1463)) (kl:= 93 (kl:shen.hdhd V1463))) (let ((NewStream1461 (kl:shen.pair (kl:shen.tlhd V1463) (kl:shen.hdtl V1463)))) (kl:shen.pair (car NewStream1461) (quote shen.skip))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1466) (if (and (pair? (car V1466)) (kl:= 123 (kl:shen.hdhd V1466))) (let ((NewStream1464 (kl:shen.pair (kl:shen.tlhd V1466) (kl:shen.hdtl V1466)))) (kl:shen.pair (car NewStream1464) (quote shen.skip))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1469) (if (and (pair? (car V1469)) (kl:= 125 (kl:shen.hdhd V1469))) (let ((NewStream1467 (kl:shen.pair (kl:shen.tlhd V1469) (kl:shen.hdtl V1469)))) (kl:shen.pair (car NewStream1467) (quote shen.skip))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1472) (if (and (pair? (car V1472)) (kl:= 124 (kl:shen.hdhd V1472))) (let ((NewStream1470 (kl:shen.pair (kl:shen.tlhd V1472) (kl:shen.hdtl V1472)))) (kl:shen.pair (car NewStream1470) (quote shen.skip))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1475) (if (and (pair? (car V1475)) (kl:= 59 (kl:shen.hdhd V1475))) (let ((NewStream1473 (kl:shen.pair (kl:shen.tlhd V1475) (kl:shen.hdtl V1475)))) (kl:shen.pair (car NewStream1473) (quote shen.skip))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1478) (if (and (pair? (car V1478)) (kl:= 58 (kl:shen.hdhd V1478))) (let ((NewStream1476 (kl:shen.pair (kl:shen.tlhd V1478) (kl:shen.hdtl V1478)))) (kl:shen.pair (car NewStream1476) (quote shen.skip))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1481) (if (and (pair? (car V1481)) (kl:= 44 (kl:shen.hdhd V1481))) (let ((NewStream1479 (kl:shen.pair (kl:shen.tlhd V1481) (kl:shen.hdtl V1481)))) (kl:shen.pair (car NewStream1479) (quote shen.skip))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1484) (if (and (pair? (car V1484)) (kl:= 61 (kl:shen.hdhd V1484))) (let ((NewStream1482 (kl:shen.pair (kl:shen.tlhd V1484) (kl:shen.hdtl V1484)))) (kl:shen.pair (car NewStream1482) (quote shen.skip))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1487) (if (and (pair? (car V1487)) (kl:= 45 (kl:shen.hdhd V1487))) (let ((NewStream1485 (kl:shen.pair (kl:shen.tlhd V1487) (kl:shen.hdtl V1487)))) (kl:shen.pair (car NewStream1485) (quote shen.skip))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1490) (if (and (pair? (car V1490)) (kl:= 40 (kl:shen.hdhd V1490))) (let ((NewStream1488 (kl:shen.pair (kl:shen.tlhd V1490) (kl:shen.hdtl V1490)))) (kl:shen.pair (car NewStream1488) (quote shen.skip))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1493) (if (and (pair? (car V1493)) (kl:= 41 (kl:shen.hdhd V1493))) (let ((NewStream1491 (kl:shen.pair (kl:shen.tlhd V1493) (kl:shen.hdtl V1493)))) (kl:shen.pair (car NewStream1491) (quote shen.skip))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1495) (let ((YaccParse (let ((Parse_shen. (kl:shen. V1495))) (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. V1495))) (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. V1495))) (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 V1497) (cond ((null? V1497) "") ((and (pair? V1497) (and (equal? "c" (car V1497)) (and (pair? (cdr V1497)) (equal? "#" (car (cdr V1497)))))) (let ((CodePoint (kl:shen.code-point (cdr (cdr V1497))))) (let ((AfterCodePoint (kl:shen.after-codepoint (cdr (cdr V1497))))) (kl:_waspvm_at_s (make-string 1 (kl:shen.decimalise CodePoint)) (kl:shen.control-chars AfterCodePoint))))) ((pair? V1497) (kl:_waspvm_at_s (car V1497) (kl:shen.control-chars (cdr V1497)))) (#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 V1501) (cond ((and (pair? V1501) (equal? ";" (car V1501))) "") ((and (pair? V1501) (kl:element? (car V1501) (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 V1501) (kl:shen.code-point (cdr V1501)))) (#t (simple-error (string-append "code point parse error " (kl:shen.app V1501 "\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 V1507) (cond ((null? V1507) (quote ())) ((and (pair? V1507) (equal? ";" (car V1507))) (cdr V1507)) ((pair? V1507) (kl:shen.after-codepoint (cdr V1507))) (#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 V1509) (kl:shen.pre (kl:reverse (kl:shen.digits->integers V1509)) 0)) (export shen.decimalise) (quote shen.decimalise)) +(begin (register-function-arity (quote shen.digits->integers) 1) (define (kl:shen.digits->integers V1515) (cond ((and (pair? V1515) (equal? "0" (car V1515))) (cons 0 (kl:shen.digits->integers (cdr V1515)))) ((and (pair? V1515) (equal? "1" (car V1515))) (cons 1 (kl:shen.digits->integers (cdr V1515)))) ((and (pair? V1515) (equal? "2" (car V1515))) (cons 2 (kl:shen.digits->integers (cdr V1515)))) ((and (pair? V1515) (equal? "3" (car V1515))) (cons 3 (kl:shen.digits->integers (cdr V1515)))) ((and (pair? V1515) (equal? "4" (car V1515))) (cons 4 (kl:shen.digits->integers (cdr V1515)))) ((and (pair? V1515) (equal? "5" (car V1515))) (cons 5 (kl:shen.digits->integers (cdr V1515)))) ((and (pair? V1515) (equal? "6" (car V1515))) (cons 6 (kl:shen.digits->integers (cdr V1515)))) ((and (pair? V1515) (equal? "7" (car V1515))) (cons 7 (kl:shen.digits->integers (cdr V1515)))) ((and (pair? V1515) (equal? "8" (car V1515))) (cons 8 (kl:shen.digits->integers (cdr V1515)))) ((and (pair? V1515) (equal? "9" (car V1515))) (cons 9 (kl:shen.digits->integers (cdr V1515)))) (#t (quote ())))) (export shen.digits->integers) (quote shen.digits->integers)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1517) (let ((Parse_shen. (kl:shen. V1517))) (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. V1519) (let ((YaccParse (let ((Parse_shen. (kl:shen. V1519))) (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: V1519))) (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. V1521) (let ((YaccParse (let ((Parse_shen. (kl:shen. V1521))) (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. V1521))) (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. V1523) (if (pair? (car V1523)) (let ((Parse_Char (kl:shen.hdhd V1523))) (if (assert-boolean (kl:shen.numbyte? Parse_Char)) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V1523) (kl:shen.hdtl V1523))) (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? V1529) (cond ((kl:= 48 V1529) #t) ((kl:= 49 V1529) #t) ((kl:= 50 V1529) #t) ((kl:= 51 V1529) #t) ((kl:= 52 V1529) #t) ((kl:= 53 V1529) #t) ((kl:= 54 V1529) #t) ((kl:= 55 V1529) #t) ((kl:= 56 V1529) #t) ((kl:= 57 V1529) #t) (#t #f))) (export shen.numbyte?) (quote shen.numbyte?)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1531) (if (pair? (car V1531)) (let ((Parse_Char (kl:shen.hdhd V1531))) (if (assert-boolean (kl:shen.symbol-code? Parse_Char)) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V1531) (kl:shen.hdtl V1531))) (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? V1533) (or (kl:= V1533 126) (or (and (> V1533 94) (< V1533 123)) (or (and (> V1533 59) (< V1533 91)) (or (and (> V1533 41) (and (< V1533 58) (kl:not (kl:= V1533 44)))) (or (and (> V1533 34) (< V1533 40)) (kl:= V1533 33))))))) (export shen.symbol-code?) (quote shen.symbol-code?)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1535) (let ((Parse_shen. (kl:shen. V1535))) (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. V1537) (if (pair? (car V1537)) (let ((Parse_Char (kl:shen.hdhd V1537))) (if (kl:= Parse_Char 34) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V1537) (kl:shen.hdtl V1537))) Parse_Char) (kl:fail))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1539) (let ((YaccParse (let ((Parse_shen. (kl:shen. V1539))) (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: V1539))) (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. V1541) (if (pair? (car V1541)) (let ((Parse_Char (kl:shen.hdhd V1541))) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V1541) (kl:shen.hdtl V1541))) (make-string 1 Parse_Char))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1543) (if (pair? (car V1543)) (let ((Parse_Char (kl:shen.hdhd V1543))) (if (kl:not (kl:= Parse_Char 34)) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V1543) (kl:shen.hdtl V1543))) (make-string 1 Parse_Char)) (kl:fail))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1545) (let ((YaccParse (let ((Parse_shen. (kl:shen. V1545))) (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. V1545))) (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. V1545))) (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. V1545))) (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. V1545))) (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. V1545))) (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. V1548) (if (and (pair? (car V1548)) (kl:= 101 (kl:shen.hdhd V1548))) (let ((NewStream1546 (kl:shen.pair (kl:shen.tlhd V1548) (kl:shen.hdtl V1548)))) (kl:shen.pair (car NewStream1546) (quote shen.skip))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1550) (let ((YaccParse (let ((Parse_shen. (kl:shen. V1550))) (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. V1550))) (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. V1552) (if (pair? (car V1552)) (let ((Parse_Char (kl:shen.hdhd V1552))) (if (kl:= Parse_Char 43) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V1552) (kl:shen.hdtl V1552))) Parse_Char) (kl:fail))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1554) (if (pair? (car V1554)) (let ((Parse_Char (kl:shen.hdhd V1554))) (if (kl:= Parse_Char 46) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V1554) (kl:shen.hdtl V1554))) Parse_Char) (kl:fail))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1556) (let ((YaccParse (let ((Parse_shen. (kl:shen. V1556))) (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: V1556))) (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. V1558) (let ((Parse_shen. (kl:shen. V1558))) (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. V1560) (let ((YaccParse (let ((Parse_shen. (kl:shen. V1560))) (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. V1560))) (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. V1562) (if (pair? (car V1562)) (let ((Parse_X (kl:shen.hdhd V1562))) (if (assert-boolean (kl:shen.numbyte? Parse_X)) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V1562) (kl:shen.hdtl V1562))) (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 V1564) (cond ((kl:= 48 V1564) 0) ((kl:= 49 V1564) 1) ((kl:= 50 V1564) 2) ((kl:= 51 V1564) 3) ((kl:= 52 V1564) 4) ((kl:= 53 V1564) 5) ((kl:= 54 V1564) 6) ((kl:= 55 V1564) 7) ((kl:= 56 V1564) 8) ((kl:= 57 V1564) 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 V1569 V1570) (cond ((null? V1569) 0) ((pair? V1569) (+ (* (kl:shen.expt 10 V1570) (car V1569)) (kl:shen.pre (cdr V1569) (+ V1570 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 V1575 V1576) (cond ((null? V1575) 0) ((pair? V1575) (+ (* (kl:shen.expt 10 (- 0 V1576)) (car V1575)) (kl:shen.post (cdr V1575) (+ V1576 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 V1581 V1582) (cond ((kl:= 0 V1582) 1) ((> V1582 0) (* V1581 (kl:shen.expt V1581 (- V1582 1)))) (#t (* 1.000000 (/ (kl:shen.expt V1581 (+ V1582 1)) V1581))))) (export shen.expt) (quote shen.expt)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1584) (let ((Parse_shen. (kl:shen. V1584))) (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. V1586) (let ((Parse_shen. (kl:shen. V1586))) (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. V1588) (let ((YaccParse (let ((Parse_shen. (kl:shen. V1588))) (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. V1588))) (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. V1590) (let ((Parse_shen. (kl:shen. V1590))) (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. V1593) (if (and (pair? (car V1593)) (kl:= 92 (kl:shen.hdhd V1593))) (let ((NewStream1591 (kl:shen.pair (kl:shen.tlhd V1593) (kl:shen.hdtl V1593)))) (kl:shen.pair (car NewStream1591) (quote shen.skip))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1595) (let ((YaccParse (let ((Parse_shen. (kl:shen. V1595))) (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: V1595))) (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. V1597) (if (pair? (car V1597)) (let ((Parse_X (kl:shen.hdhd V1597))) (if (kl:not (kl:element? Parse_X (cons 10 (cons 13 (quote ()))))) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V1597) (kl:shen.hdtl V1597))) (quote shen.skip)) (kl:fail))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1599) (if (pair? (car V1599)) (let ((Parse_X (kl:shen.hdhd V1599))) (if (kl:element? Parse_X (cons 10 (cons 13 (quote ())))) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V1599) (kl:shen.hdtl V1599))) (quote shen.skip)) (kl:fail))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1601) (let ((Parse_shen. (kl:shen. V1601))) (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. V1604) (if (and (pair? (car V1604)) (kl:= 42 (kl:shen.hdhd V1604))) (let ((NewStream1602 (kl:shen.pair (kl:shen.tlhd V1604) (kl:shen.hdtl V1604)))) (kl:shen.pair (car NewStream1602) (quote shen.skip))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1606) (let ((YaccParse (let ((Parse_shen. (kl:shen. V1606))) (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. V1606))) (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 V1606)) (let ((Parse_X (kl:shen.hdhd V1606))) (let ((Parse_shen. (kl:shen. (kl:shen.pair (kl:shen.tlhd V1606) (kl:shen.hdtl V1606))))) (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. V1608) (let ((YaccParse (let ((Parse_shen. (kl:shen. V1608))) (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. V1608))) (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. V1610) (if (pair? (car V1610)) (let ((Parse_X (kl:shen.hdhd V1610))) (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 V1610) (kl:shen.hdtl V1610))) (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 V1612) (cond ((null? V1612) (quote ())) ((and (pair? V1612) (and (pair? (cdr V1612)) (and (pair? (cdr (cdr V1612))) (and (null? (cdr (cdr (cdr V1612)))) (eq? (car (cdr V1612)) (quote bar!)))))) (cons (quote cons) (cons (car V1612) (cdr (cdr V1612))))) ((pair? V1612) (cons (quote cons) (cons (car V1612) (cons (kl:shen.cons_form (cdr V1612)) (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 V1617 V1618) (cond ((and (pair? V1617) (and (eq? (quote _waspvm_dl_) (car V1617)) (and (pair? (cdr V1617)) (null? (cdr (cdr V1617)))))) (kl:append (kl:explode (car (cdr V1617))) V1618)) ((and (pair? V1617) (and (eq? (quote package) (car V1617)) (and (pair? (cdr V1617)) (and (eq? (quote null) (car (cdr V1617))) (pair? (cdr (cdr V1617))))))) (kl:append (cdr (cdr (cdr V1617))) V1618)) ((and (pair? V1617) (and (eq? (quote package) (car V1617)) (and (pair? (cdr V1617)) (pair? (cdr (cdr V1617)))))) (let ((ListofExceptions (kl:shen.eval-without-macros (car (cdr (cdr V1617)))))) (let ((External (kl:shen.record-exceptions ListofExceptions (car (cdr V1617))))) (let ((PackageNameDot (kl:intern (string-append (kl:str (car (cdr V1617))) ".")))) (let ((ExpPackageNameDot (kl:explode PackageNameDot))) (let ((Packaged (kl:shen.packageh PackageNameDot ListofExceptions (cdr (cdr (cdr V1617))) ExpPackageNameDot))) (let ((Internal (kl:shen.record-internal (car (cdr V1617)) (kl:shen.internal-symbols ExpPackageNameDot Packaged)))) (kl:append Packaged V1618)))))))) (#t (cons V1617 V1618)))) (export shen.package-macro) (quote shen.package-macro)) +(begin (register-function-arity (quote shen.record-exceptions) 2) (define (kl:shen.record-exceptions V1621 V1622) (let ((CurrExceptions (guard (lambda (E) (quote ())) (kl:get V1622 (quote shen.external-symbols) (kl:value (quote *property-vector*)))))) (let ((AllExceptions (kl:union V1621 CurrExceptions))) (kl:put V1622 (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 V1625 V1626) (kl:put V1625 (quote shen.internal-symbols) (kl:union V1626 (guard (lambda (E) (quote ())) (kl:get V1625 (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 V1637 V1638) (cond ((and (kl:symbol? V1638) (assert-boolean (kl:shen.prefix? V1637 (kl:explode V1638)))) (cons V1638 (quote ()))) ((pair? V1638) (kl:union (kl:shen.internal-symbols V1637 (car V1638)) (kl:shen.internal-symbols V1637 (cdr V1638)))) (#t (quote ())))) (export shen.internal-symbols) (quote shen.internal-symbols)) +(begin (register-function-arity (quote shen.packageh) 4) (define (kl:shen.packageh V1655 V1656 V1657 V1658) (cond ((pair? V1657) (cons (kl:shen.packageh V1655 V1656 (car V1657) V1658) (kl:shen.packageh V1655 V1656 (cdr V1657) V1658))) ((or (assert-boolean (kl:shen.sysfunc? V1657)) (or (kl:variable? V1657) (or (kl:element? V1657 V1656) (or (assert-boolean (kl:shen.doubleunderline? V1657)) (assert-boolean (kl:shen.singleunderline? V1657)))))) V1657) ((and (kl:symbol? V1657) (assert-boolean (let ((ExplodeX (kl:explode V1657))) (and (kl:not (kl:shen.prefix? (cons "s" (cons "h" (cons "e" (cons "n" (cons "." (quote ())))))) ExplodeX)) (kl:not (kl:shen.prefix? V1658 ExplodeX)))))) (kl:concat V1655 V1657)) (#t V1657))) (export shen.packageh) (quote shen.packageh)) diff --git a/compiled/sequent.kl.ms b/compiled/sequent.kl.ms index b975a57..a5eb33a 100644 --- a/compiled/sequent.kl.ms +++ b/compiled/sequent.kl.ms @@ -1,58 +1,58 @@ (module "compiled/sequent.kl") "Copyright (c) 2010-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:\n\n1. Redistributions of source code must retain the above copyright notice,\nthis list of conditions and the following disclaimer.\n\n2. Redistributions in binary form must reproduce the above copyright notice,\nthis list of conditions and the following disclaimer in the documentation\nand/or other materials provided with the distribution.\n\n3. Neither the name of the copyright holder nor the names of its contributors\nmay be used to endorse or promote products derived from this software without\nspecific prior written permission.\n\nTHIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ''AS IS'' AND\nANY EXPRESS 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 THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE\nFOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL\nDAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR\nSERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER\nCAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,\nOR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE\nOF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.\n" -(begin (register-function-arity (quote shen.datatype-error) 1) (define (kl:shen.datatype-error V2825) (cond ((and (pair? V2825) (and (pair? (cdr V2825)) (null? (cdr (cdr V2825))))) (simple-error (string-append "datatype syntax error here:\n\n " (kl:shen.app (kl:shen.next-50 50 (car V2825)) "\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. V2827) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2827))) (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: V2827))) (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. V2829) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2829))) (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. V2829))) (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. V2831) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2831))) (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: V2831))) (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. V2835) (let ((YaccParse (if (and (pair? (car V2835)) (eq? (quote if) (kl:shen.hdhd V2835))) (let ((NewStream2832 (kl:shen.pair (kl:shen.tlhd V2835) (kl:shen.hdtl V2835)))) (let ((Parse_shen. (kl:shen. NewStream2832))) (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 V2835)) (eq? (quote let) (kl:shen.hdhd V2835))) (let ((NewStream2833 (kl:shen.pair (kl:shen.tlhd V2835) (kl:shen.hdtl V2835)))) (let ((Parse_shen. (kl:shen. NewStream2833))) (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. V2837) (if (pair? (car V2837)) (let ((Parse_X (kl:shen.hdhd V2837))) (if (kl:variable? Parse_X) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V2837) (kl:shen.hdtl V2837))) Parse_X) (kl:fail))) (kl:fail))) (export shen.) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2839) (if (pair? (car V2839)) (let ((Parse_X (kl:shen.hdhd V2839))) (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 V2839) (kl:shen.hdtl V2839))) (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 V2841) (cond ((and (pair? V2841) (and (pair? (cdr V2841)) (and (pair? (cdr (cdr V2841))) (and (null? (cdr (cdr (cdr V2841)))) (eq? (car (cdr V2841)) (quote bar!)))))) (cons (car V2841) (car (cdr (cdr V2841))))) ((pair? V2841) (cons (kl:shen.remove-bar (car V2841)) (kl:shen.remove-bar (cdr V2841)))) (#t V2841))) (export shen.remove-bar) (quote shen.remove-bar)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2843) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2843))) (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: V2843))) (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. V2845) (if (pair? (car V2845)) (let ((Parse_X (kl:shen.hdhd V2845))) (if (eq? Parse_X (quote _waspvm_sc_)) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V2845) (kl:shen.hdtl V2845))) (quote shen.skip)) (kl:fail))) (kl:fail))) (export shen.) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2849) (let ((YaccParse (if (and (pair? (car V2849)) (eq? (quote !) (kl:shen.hdhd V2849))) (let ((NewStream2846 (kl:shen.pair (kl:shen.tlhd V2849) (kl:shen.hdtl V2849)))) (kl:shen.pair (car NewStream2846) (quote !))) (kl:fail)))) (if (kl:= YaccParse (kl:fail)) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2849))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (if (and (pair? (car Parse_shen.)) (eq? (quote >>) (kl:shen.hdhd Parse_shen.))) (let ((NewStream2847 (kl:shen.pair (kl:shen.tlhd Parse_shen.) (kl:shen.hdtl Parse_shen.)))) (let ((Parse_shen. (kl:shen. NewStream2847))) (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. V2849))) (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. V2852) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2852))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (if (and (pair? (car Parse_shen.)) (eq? (quote >>) (kl:shen.hdhd Parse_shen.))) (let ((NewStream2850 (kl:shen.pair (kl:shen.tlhd Parse_shen.) (kl:shen.hdtl Parse_shen.)))) (let ((Parse_shen. (kl:shen. NewStream2850))) (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. V2852))) (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 V2855 V2856) (kl:_waspvm_at_p V2855 V2856)) (export shen.sequent) (quote shen.sequent)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2858) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2858))) (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. V2858))) (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: V2858))) (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. V2860) (if (pair? (car V2860)) (let ((Parse_X (kl:shen.hdhd V2860))) (if (kl:= Parse_X (kl:intern ",")) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V2860) (kl:shen.hdtl V2860))) (quote shen.skip)) (kl:fail))) (kl:fail))) (export shen.) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2863) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2863))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (if (and (pair? (car Parse_shen.)) (eq? (quote :) (kl:shen.hdhd Parse_shen.))) (let ((NewStream2861 (kl:shen.pair (kl:shen.tlhd Parse_shen.) (kl:shen.hdtl Parse_shen.)))) (let ((Parse_shen. (kl:shen. NewStream2861))) (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. V2863))) (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. V2865) (let ((Parse_shen. (kl:shen. V2865))) (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. V2867) (if (pair? (car V2867)) (let ((Parse_X (kl:shen.hdhd V2867))) (if (assert-boolean (kl:shen.doubleunderline? Parse_X)) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V2867) (kl:shen.hdtl V2867))) Parse_X) (kl:fail))) (kl:fail))) (export shen.) (quote shen.)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2869) (if (pair? (car V2869)) (let ((Parse_X (kl:shen.hdhd V2869))) (if (assert-boolean (kl:shen.singleunderline? Parse_X)) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V2869) (kl:shen.hdtl V2869))) Parse_X) (kl:fail))) (kl:fail))) (export shen.) (quote shen.)) -(begin (register-function-arity (quote shen.singleunderline?) 1) (define (kl:shen.singleunderline? V2871) (and (kl:symbol? V2871) (assert-boolean (kl:shen.sh? (kl:str V2871))))) (export shen.singleunderline?) (quote shen.singleunderline?)) -(begin (register-function-arity (quote shen.sh?) 1) (define (kl:shen.sh? V2873) (cond ((equal? "_" V2873) #t) (#t (and (equal? (make-string 1 (string-ref V2873 0)) "_") (assert-boolean (kl:shen.sh? (string-tail V2873 1))))))) (export shen.sh?) (quote shen.sh?)) -(begin (register-function-arity (quote shen.doubleunderline?) 1) (define (kl:shen.doubleunderline? V2875) (and (kl:symbol? V2875) (assert-boolean (kl:shen.dh? (kl:str V2875))))) (export shen.doubleunderline?) (quote shen.doubleunderline?)) -(begin (register-function-arity (quote shen.dh?) 1) (define (kl:shen.dh? V2877) (cond ((equal? "=" V2877) #t) (#t (and (equal? (make-string 1 (string-ref V2877 0)) "=") (assert-boolean (kl:shen.dh? (string-tail V2877 1))))))) (export shen.dh?) (quote shen.dh?)) -(begin (register-function-arity (quote shen.process-datatype) 2) (define (kl:shen.process-datatype V2880 V2881) (kl:shen.remember-datatype (kl:shen.s-prolog (kl:shen.rules->horn-clauses V2880 V2881)))) (export shen.process-datatype) (quote shen.process-datatype)) -(begin (register-function-arity (quote shen.remember-datatype) 1) (define (kl:shen.remember-datatype V2887) (cond ((pair? V2887) (begin (kl:set (quote shen.*datatypes*) (kl:adjoin (car V2887) (kl:value (quote shen.*datatypes*)))) (begin (kl:set (quote shen.*alldatatypes*) (kl:adjoin (car V2887) (kl:value (quote shen.*alldatatypes*)))) (car V2887)))) (#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 V2892 V2893) (cond ((null? V2893) (quote ())) ((and (pair? V2893) (and (kl:tuple? (car V2893)) (eq? (quote shen.single) (kl:fst (car V2893))))) (cons (kl:shen.rule->horn-clause V2892 (kl:snd (car V2893))) (kl:shen.rules->horn-clauses V2892 (cdr V2893)))) ((and (pair? V2893) (and (kl:tuple? (car V2893)) (eq? (quote shen.double) (kl:fst (car V2893))))) (kl:shen.rules->horn-clauses V2892 (kl:append (kl:shen.double->singles (kl:snd (car V2893))) (cdr V2893)))) (#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 V2895) (cons (kl:shen.right-rule V2895) (cons (kl:shen.left-rule V2895) (quote ())))) (export shen.double->singles) (quote shen.double->singles)) -(begin (register-function-arity (quote shen.right-rule) 1) (define (kl:shen.right-rule V2897) (kl:_waspvm_at_p (quote shen.single) V2897)) (export shen.right-rule) (quote shen.right-rule)) -(begin (register-function-arity (quote shen.left-rule) 1) (define (kl:shen.left-rule V2899) (cond ((and (pair? V2899) (and (pair? (cdr V2899)) (and (pair? (cdr (cdr V2899))) (and (kl:tuple? (car (cdr (cdr V2899)))) (and (null? (kl:fst (car (cdr (cdr V2899))))) (null? (cdr (cdr (cdr V2899))))))))) (let ((Q (kl:gensym (quote Qv)))) (let ((NewConclusion (kl:_waspvm_at_p (cons (kl:snd (car (cdr (cdr V2899)))) (quote ())) Q))) (let ((NewPremises (cons (kl:_waspvm_at_p (kl:map (lambda (X) (kl:shen.right->left X)) (car (cdr V2899))) Q) (quote ())))) (kl:_waspvm_at_p (quote shen.single) (cons (car V2899) (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 V2905) (cond ((and (kl:tuple? V2905) (null? (kl:fst V2905))) (kl:snd V2905)) (#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 V2908 V2909) (cond ((and (pair? V2909) (and (pair? (cdr V2909)) (and (pair? (cdr (cdr V2909))) (and (kl:tuple? (car (cdr (cdr V2909)))) (null? (cdr (cdr (cdr V2909)))))))) (cons (kl:shen.rule->horn-clause-head V2908 (kl:snd (car (cdr (cdr V2909))))) (cons (quote :-) (cons (kl:shen.rule->horn-clause-body (car V2909) (car (cdr V2909)) (kl:fst (car (cdr (cdr V2909))))) (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 V2912 V2913) (cons V2912 (cons (kl:shen.mode-ify V2913) (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 V2915) (cond ((and (pair? V2915) (and (pair? (cdr V2915)) (and (eq? (quote :) (car (cdr V2915))) (and (pair? (cdr (cdr V2915))) (null? (cdr (cdr (cdr V2915)))))))) (cons (quote mode) (cons (cons (car V2915) (cons (quote :) (cons (cons (quote mode) (cons (car (cdr (cdr V2915))) (cons (quote +) (quote ())))) (quote ())))) (cons (quote -) (quote ()))))) (#t V2915))) (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 V2919 V2920 V2921) (let ((Variables (kl:map (lambda (X) (kl:shen.extract_vars X)) V2921))) (let ((Predicates (kl:map (lambda (X) (kl:gensym (quote shen.cl))) V2921))) (let ((SearchLiterals (kl:shen.construct-search-literals Predicates Variables (quote Context_1957) (quote Context1_1957)))) (let ((SearchClauses (kl:shen.construct-search-clauses Predicates V2921 Variables))) (let ((SideLiterals (kl:shen.construct-side-literals V2919))) (let ((PremissLiterals (kl:map (lambda (X) (kl:shen.construct-premiss-literal X (kl:empty? V2921))) V2920))) (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 V2930 V2931 V2932 V2933) (cond ((and (null? V2930) (null? V2931)) (quote ())) (#t (kl:shen.csl-help V2930 V2931 V2932 V2933)))) (export shen.construct-search-literals) (quote shen.construct-search-literals)) -(begin (register-function-arity (quote shen.csl-help) 4) (define (kl:shen.csl-help V2940 V2941 V2942 V2943) (cond ((and (null? V2940) (null? V2941)) (cons (cons (quote bind) (cons (quote ContextOut_1957) (cons V2942 (quote ())))) (quote ()))) ((and (pair? V2940) (pair? V2941)) (cons (cons (car V2940) (cons V2942 (cons V2943 (car V2941)))) (kl:shen.csl-help (cdr V2940) (cdr V2941) V2943 (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 V2947 V2948 V2949) (cond ((and (null? V2947) (and (null? V2948) (null? V2949))) (quote shen.skip)) ((and (pair? V2947) (and (pair? V2948) (pair? V2949))) (begin (kl:shen.construct-search-clause (car V2947) (car V2948) (car V2949)) (kl:shen.construct-search-clauses (cdr V2947) (cdr V2948) (cdr V2949)))) (#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 V2953 V2954 V2955) (kl:shen.s-prolog (cons (kl:shen.construct-base-search-clause V2953 V2954 V2955) (cons (kl:shen.construct-recursive-search-clause V2953 V2954 V2955) (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 V2959 V2960 V2961) (cons (cons V2959 (cons (cons (kl:shen.mode-ify V2960) (quote In_1957)) (cons (quote In_1957) V2961))) (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 V2965 V2966 V2967) (cons (cons V2965 (cons (cons (quote Assumption_1957) (quote Assumptions_1957)) (cons (cons (quote Assumption_1957) (quote Out_1957)) V2967))) (cons (quote :-) (cons (cons (cons V2965 (cons (quote Assumptions_1957) (cons (quote Out_1957) V2967))) (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 V2973) (cond ((null? V2973) (quote ())) ((and (pair? V2973) (and (pair? (car V2973)) (and (eq? (quote if) (car (car V2973))) (and (pair? (cdr (car V2973))) (null? (cdr (cdr (car V2973)))))))) (cons (cons (quote when) (cdr (car V2973))) (kl:shen.construct-side-literals (cdr V2973)))) ((and (pair? V2973) (and (pair? (car V2973)) (and (eq? (quote let) (car (car V2973))) (and (pair? (cdr (car V2973))) (and (pair? (cdr (cdr (car V2973)))) (null? (cdr (cdr (cdr (car V2973)))))))))) (cons (cons (quote is) (cdr (car V2973))) (kl:shen.construct-side-literals (cdr V2973)))) ((pair? V2973) (kl:shen.construct-side-literals (cdr V2973))) (#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 V2980 V2981) (cond ((kl:tuple? V2980) (cons (quote shen.t*) (cons (kl:shen.recursive_cons_form (kl:snd V2980)) (cons (kl:shen.construct-context V2981 (kl:fst V2980)) (quote ()))))) ((eq? (quote !) V2980) (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 V2984 V2985) (cond ((and (kl:= #t V2984) (null? V2985)) (quote Context_1957)) ((and (kl:= #f V2984) (null? V2985)) (quote ContextOut_1957)) ((pair? V2985) (cons (quote cons) (cons (kl:shen.recursive_cons_form (car V2985)) (cons (kl:shen.construct-context V2984 (cdr V2985)) (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 V2987) (cond ((pair? V2987) (cons (quote cons) (cons (kl:shen.recursive_cons_form (car V2987)) (cons (kl:shen.recursive_cons_form (cdr V2987)) (quote ()))))) (#t V2987))) (export shen.recursive_cons_form) (quote shen.recursive_cons_form)) -(begin (register-function-arity (quote preclude) 1) (define (kl:preclude V2989) (kl:shen.preclude-h (kl:map (lambda (X) (kl:shen.intern-type X)) V2989))) (export preclude) (quote preclude)) -(begin (register-function-arity (quote shen.preclude-h) 1) (define (kl:shen.preclude-h V2991) (let ((FilterDatatypes (kl:set (quote shen.*datatypes*) (kl:difference (kl:value (quote shen.*datatypes*)) V2991)))) (kl:value (quote shen.*datatypes*)))) (export shen.preclude-h) (quote shen.preclude-h)) -(begin (register-function-arity (quote include) 1) (define (kl:include V2993) (kl:shen.include-h (kl:map (lambda (X) (kl:shen.intern-type X)) V2993))) (export include) (quote include)) -(begin (register-function-arity (quote shen.include-h) 1) (define (kl:shen.include-h V2995) (let ((ValidTypes (kl:intersection V2995 (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 V2997) (kl:shen.preclude-h (kl:difference (kl:value (quote shen.*alldatatypes*)) (kl:map (lambda (X) (kl:shen.intern-type X)) V2997)))) (export preclude-all-but) (quote preclude-all-but)) -(begin (register-function-arity (quote include-all-but) 1) (define (kl:include-all-but V2999) (kl:shen.include-h (kl:difference (kl:value (quote shen.*alldatatypes*)) (kl:map (lambda (X) (kl:shen.intern-type X)) V2999)))) (export include-all-but) (quote include-all-but)) -(begin (register-function-arity (quote shen.synonyms-help) 1) (define (kl:shen.synonyms-help V3005) (cond ((null? V3005) (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? V3005) (pair? (cdr V3005))) (let ((Vs (kl:difference (kl:shen.extract_vars (car (cdr V3005))) (kl:shen.extract_vars (car V3005))))) (if (kl:empty? Vs) (begin (kl:shen.pushnew (cons (car V3005) (cons (car (cdr V3005)) (quote ()))) (quote shen.*synonyms*)) (kl:shen.synonyms-help (cdr (cdr V3005)))) (kl:shen.free_variable_warnings (car (cdr V3005)) 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 V3008 V3009) (if (kl:element? V3008 (kl:value V3009)) (kl:value V3009) (kl:set V3009 (cons V3008 (kl:value V3009))))) (export shen.pushnew) (quote shen.pushnew)) -(begin (register-function-arity (quote shen.demod-rule) 1) (define (kl:shen.demod-rule V3011) (cond ((and (pair? V3011) (and (pair? (cdr V3011)) (null? (cdr (cdr V3011))))) (cons (kl:shen.rcons_form (car V3011)) (cons (quote ->) (cons (kl:shen.rcons_form (car (cdr V3011))) (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 V3017) (cond ((and (pair? V3017) (and (eq? (quote defun) (car V3017)) (and (pair? (cdr V3017)) (and (pair? (cdr (cdr V3017))) (and (pair? (car (cdr (cdr V3017)))) (and (null? (cdr (car (cdr (cdr V3017))))) (and (pair? (cdr (cdr (cdr V3017)))) (null? (cdr (cdr (cdr (cdr V3017)))))))))))) (kl:eval (cons (quote /.) (cons (car (car (cdr (cdr V3017)))) (cdr (cdr (cdr V3017))))))) (#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 V3020 V3021) (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 V3021 (kl:shen.default-rule))))))) (begin (if (assert-boolean V3020) (kl:tc (quote +)) (quote shen.skip)) (quote synonyms))))) (export shen.update-demodulation-function) (quote shen.update-demodulation-function)) +(begin (register-function-arity (quote shen.datatype-error) 1) (define (kl:shen.datatype-error V1664) (cond ((and (pair? V1664) (and (pair? (cdr V1664)) (null? (cdr (cdr V1664))))) (simple-error (string-append "datatype syntax error here:\n\n " (kl:shen.app (kl:shen.next-50 50 (car V1664)) "\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. V1666) (let ((YaccParse (let ((Parse_shen. (kl:shen. V1666))) (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: V1666))) (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. V1668) (let ((YaccParse (let ((Parse_shen. (kl:shen. V1668))) (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. V1668))) (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. V1670) (let ((YaccParse (let ((Parse_shen. (kl:shen. V1670))) (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: V1670))) (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. V1674) (let ((YaccParse (if (and (pair? (car V1674)) (eq? (quote if) (kl:shen.hdhd V1674))) (let ((NewStream1671 (kl:shen.pair (kl:shen.tlhd V1674) (kl:shen.hdtl V1674)))) (let ((Parse_shen. (kl:shen. NewStream1671))) (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 V1674)) (eq? (quote let) (kl:shen.hdhd V1674))) (let ((NewStream1672 (kl:shen.pair (kl:shen.tlhd V1674) (kl:shen.hdtl V1674)))) (let ((Parse_shen. (kl:shen. NewStream1672))) (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. V1676) (if (pair? (car V1676)) (let ((Parse_X (kl:shen.hdhd V1676))) (if (kl:variable? Parse_X) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V1676) (kl:shen.hdtl V1676))) Parse_X) (kl:fail))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1678) (if (pair? (car V1678)) (let ((Parse_X (kl:shen.hdhd V1678))) (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 V1678) (kl:shen.hdtl V1678))) (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 V1680) (cond ((and (pair? V1680) (and (pair? (cdr V1680)) (and (pair? (cdr (cdr V1680))) (and (null? (cdr (cdr (cdr V1680)))) (eq? (car (cdr V1680)) (quote bar!)))))) (cons (car V1680) (car (cdr (cdr V1680))))) ((pair? V1680) (cons (kl:shen.remove-bar (car V1680)) (kl:shen.remove-bar (cdr V1680)))) (#t V1680))) (export shen.remove-bar) (quote shen.remove-bar)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1682) (let ((YaccParse (let ((Parse_shen. (kl:shen. V1682))) (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: V1682))) (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. V1684) (if (pair? (car V1684)) (let ((Parse_X (kl:shen.hdhd V1684))) (if (eq? Parse_X (quote _waspvm_sc_)) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V1684) (kl:shen.hdtl V1684))) (quote shen.skip)) (kl:fail))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1688) (let ((YaccParse (if (and (pair? (car V1688)) (eq? (quote !) (kl:shen.hdhd V1688))) (let ((NewStream1685 (kl:shen.pair (kl:shen.tlhd V1688) (kl:shen.hdtl V1688)))) (kl:shen.pair (car NewStream1685) (quote !))) (kl:fail)))) (if (kl:= YaccParse (kl:fail)) (let ((YaccParse (let ((Parse_shen. (kl:shen. V1688))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (if (and (pair? (car Parse_shen.)) (eq? (quote >>) (kl:shen.hdhd Parse_shen.))) (let ((NewStream1686 (kl:shen.pair (kl:shen.tlhd Parse_shen.) (kl:shen.hdtl Parse_shen.)))) (let ((Parse_shen. (kl:shen. NewStream1686))) (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. V1688))) (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. V1691) (let ((YaccParse (let ((Parse_shen. (kl:shen. V1691))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (if (and (pair? (car Parse_shen.)) (eq? (quote >>) (kl:shen.hdhd Parse_shen.))) (let ((NewStream1689 (kl:shen.pair (kl:shen.tlhd Parse_shen.) (kl:shen.hdtl Parse_shen.)))) (let ((Parse_shen. (kl:shen. NewStream1689))) (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. V1691))) (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 V1694 V1695) (kl:_waspvm_at_p V1694 V1695)) (export shen.sequent) (quote shen.sequent)) +(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.)) (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. V1697))) (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: V1697))) (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. V1699) (if (pair? (car V1699)) (let ((Parse_X (kl:shen.hdhd V1699))) (if (kl:= Parse_X (kl:intern ",")) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V1699) (kl:shen.hdtl V1699))) (quote shen.skip)) (kl:fail))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1702) (let ((YaccParse (let ((Parse_shen. (kl:shen. V1702))) (if (kl:not (kl:= (kl:fail) Parse_shen.)) (if (and (pair? (car Parse_shen.)) (eq? (quote :) (kl:shen.hdhd Parse_shen.))) (let ((NewStream1700 (kl:shen.pair (kl:shen.tlhd Parse_shen.) (kl:shen.hdtl Parse_shen.)))) (let ((Parse_shen. (kl:shen. NewStream1700))) (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. V1702))) (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. V1704) (let ((Parse_shen. (kl:shen. V1704))) (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. V1706) (if (pair? (car V1706)) (let ((Parse_X (kl:shen.hdhd V1706))) (if (assert-boolean (kl:shen.doubleunderline? Parse_X)) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V1706) (kl:shen.hdtl V1706))) Parse_X) (kl:fail))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V1708) (if (pair? (car V1708)) (let ((Parse_X (kl:shen.hdhd V1708))) (if (assert-boolean (kl:shen.singleunderline? Parse_X)) (kl:shen.pair (car (kl:shen.pair (kl:shen.tlhd V1708) (kl:shen.hdtl V1708))) Parse_X) (kl:fail))) (kl:fail))) (export shen.) (quote shen.)) +(begin (register-function-arity (quote shen.singleunderline?) 1) (define (kl:shen.singleunderline? V1710) (and (kl:symbol? V1710) (assert-boolean (kl:shen.sh? (kl:str V1710))))) (export shen.singleunderline?) (quote shen.singleunderline?)) +(begin (register-function-arity (quote shen.sh?) 1) (define (kl:shen.sh? V1712) (cond ((equal? "_" V1712) #t) (#t (and (equal? (make-string 1 (string-ref V1712 0)) "_") (assert-boolean (kl:shen.sh? (string-tail V1712 1))))))) (export shen.sh?) (quote shen.sh?)) +(begin (register-function-arity (quote shen.doubleunderline?) 1) (define (kl:shen.doubleunderline? V1714) (and (kl:symbol? V1714) (assert-boolean (kl:shen.dh? (kl:str V1714))))) (export shen.doubleunderline?) (quote shen.doubleunderline?)) +(begin (register-function-arity (quote shen.dh?) 1) (define (kl:shen.dh? V1716) (cond ((equal? "=" V1716) #t) (#t (and (equal? (make-string 1 (string-ref V1716 0)) "=") (assert-boolean (kl:shen.dh? (string-tail V1716 1))))))) (export shen.dh?) (quote shen.dh?)) +(begin (register-function-arity (quote shen.process-datatype) 2) (define (kl:shen.process-datatype V1719 V1720) (kl:shen.remember-datatype (kl:shen.s-prolog (kl:shen.rules->horn-clauses V1719 V1720)))) (export shen.process-datatype) (quote shen.process-datatype)) +(begin (register-function-arity (quote shen.remember-datatype) 1) (define (kl:shen.remember-datatype V1726) (cond ((pair? V1726) (begin (kl:set (quote shen.*datatypes*) (kl:adjoin (car V1726) (kl:value (quote shen.*datatypes*)))) (begin (kl:set (quote shen.*alldatatypes*) (kl:adjoin (car V1726) (kl:value (quote shen.*alldatatypes*)))) (car V1726)))) (#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 V1731 V1732) (cond ((null? V1732) (quote ())) ((and (pair? V1732) (and (kl:tuple? (car V1732)) (eq? (quote shen.single) (kl:fst (car V1732))))) (cons (kl:shen.rule->horn-clause V1731 (kl:snd (car V1732))) (kl:shen.rules->horn-clauses V1731 (cdr V1732)))) ((and (pair? V1732) (and (kl:tuple? (car V1732)) (eq? (quote shen.double) (kl:fst (car V1732))))) (kl:shen.rules->horn-clauses V1731 (kl:append (kl:shen.double->singles (kl:snd (car V1732))) (cdr V1732)))) (#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 V1734) (cons (kl:shen.right-rule V1734) (cons (kl:shen.left-rule V1734) (quote ())))) (export shen.double->singles) (quote shen.double->singles)) +(begin (register-function-arity (quote shen.right-rule) 1) (define (kl:shen.right-rule V1736) (kl:_waspvm_at_p (quote shen.single) V1736)) (export shen.right-rule) (quote shen.right-rule)) +(begin (register-function-arity (quote shen.left-rule) 1) (define (kl:shen.left-rule V1738) (cond ((and (pair? V1738) (and (pair? (cdr V1738)) (and (pair? (cdr (cdr V1738))) (and (kl:tuple? (car (cdr (cdr V1738)))) (and (null? (kl:fst (car (cdr (cdr V1738))))) (null? (cdr (cdr (cdr V1738))))))))) (let ((Q (kl:gensym (quote Qv)))) (let ((NewConclusion (kl:_waspvm_at_p (cons (kl:snd (car (cdr (cdr V1738)))) (quote ())) Q))) (let ((NewPremises (cons (kl:_waspvm_at_p (kl:map (lambda (X) (kl:shen.right->left X)) (car (cdr V1738))) Q) (quote ())))) (kl:_waspvm_at_p (quote shen.single) (cons (car V1738) (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 V1744) (cond ((and (kl:tuple? V1744) (null? (kl:fst V1744))) (kl:snd V1744)) (#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 V1747 V1748) (cond ((and (pair? V1748) (and (pair? (cdr V1748)) (and (pair? (cdr (cdr V1748))) (and (kl:tuple? (car (cdr (cdr V1748)))) (null? (cdr (cdr (cdr V1748)))))))) (cons (kl:shen.rule->horn-clause-head V1747 (kl:snd (car (cdr (cdr V1748))))) (cons (quote :-) (cons (kl:shen.rule->horn-clause-body (car V1748) (car (cdr V1748)) (kl:fst (car (cdr (cdr V1748))))) (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 V1751 V1752) (cons V1751 (cons (kl:shen.mode-ify V1752) (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 V1754) (cond ((and (pair? V1754) (and (pair? (cdr V1754)) (and (eq? (quote :) (car (cdr V1754))) (and (pair? (cdr (cdr V1754))) (null? (cdr (cdr (cdr V1754)))))))) (cons (quote mode) (cons (cons (car V1754) (cons (quote :) (cons (cons (quote mode) (cons (car (cdr (cdr V1754))) (cons (quote +) (quote ())))) (quote ())))) (cons (quote -) (quote ()))))) (#t V1754))) (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 V1758 V1759 V1760) (let ((Variables (kl:map (lambda (X) (kl:shen.extract_vars X)) V1760))) (let ((Predicates (kl:map (lambda (X) (kl:gensym (quote shen.cl))) V1760))) (let ((SearchLiterals (kl:shen.construct-search-literals Predicates Variables (quote Context_1957) (quote Context1_1957)))) (let ((SearchClauses (kl:shen.construct-search-clauses Predicates V1760 Variables))) (let ((SideLiterals (kl:shen.construct-side-literals V1758))) (let ((PremissLiterals (kl:map (lambda (X) (kl:shen.construct-premiss-literal X (kl:empty? V1760))) V1759))) (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 V1769 V1770 V1771 V1772) (cond ((and (null? V1769) (null? V1770)) (quote ())) (#t (kl:shen.csl-help V1769 V1770 V1771 V1772)))) (export shen.construct-search-literals) (quote shen.construct-search-literals)) +(begin (register-function-arity (quote shen.csl-help) 4) (define (kl:shen.csl-help V1779 V1780 V1781 V1782) (cond ((and (null? V1779) (null? V1780)) (cons (cons (quote bind) (cons (quote ContextOut_1957) (cons V1781 (quote ())))) (quote ()))) ((and (pair? V1779) (pair? V1780)) (cons (cons (car V1779) (cons V1781 (cons V1782 (car V1780)))) (kl:shen.csl-help (cdr V1779) (cdr V1780) V1782 (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 V1786 V1787 V1788) (cond ((and (null? V1786) (and (null? V1787) (null? V1788))) (quote shen.skip)) ((and (pair? V1786) (and (pair? V1787) (pair? V1788))) (begin (kl:shen.construct-search-clause (car V1786) (car V1787) (car V1788)) (kl:shen.construct-search-clauses (cdr V1786) (cdr V1787) (cdr V1788)))) (#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 V1792 V1793 V1794) (kl:shen.s-prolog (cons (kl:shen.construct-base-search-clause V1792 V1793 V1794) (cons (kl:shen.construct-recursive-search-clause V1792 V1793 V1794) (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 V1798 V1799 V1800) (cons (cons V1798 (cons (cons (kl:shen.mode-ify V1799) (quote In_1957)) (cons (quote In_1957) V1800))) (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 V1804 V1805 V1806) (cons (cons V1804 (cons (cons (quote Assumption_1957) (quote Assumptions_1957)) (cons (cons (quote Assumption_1957) (quote Out_1957)) V1806))) (cons (quote :-) (cons (cons (cons V1804 (cons (quote Assumptions_1957) (cons (quote Out_1957) V1806))) (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 V1812) (cond ((null? V1812) (quote ())) ((and (pair? V1812) (and (pair? (car V1812)) (and (eq? (quote if) (car (car V1812))) (and (pair? (cdr (car V1812))) (null? (cdr (cdr (car V1812)))))))) (cons (cons (quote when) (cdr (car V1812))) (kl:shen.construct-side-literals (cdr V1812)))) ((and (pair? V1812) (and (pair? (car V1812)) (and (eq? (quote let) (car (car V1812))) (and (pair? (cdr (car V1812))) (and (pair? (cdr (cdr (car V1812)))) (null? (cdr (cdr (cdr (car V1812)))))))))) (cons (cons (quote is) (cdr (car V1812))) (kl:shen.construct-side-literals (cdr V1812)))) ((pair? V1812) (kl:shen.construct-side-literals (cdr V1812))) (#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 V1819 V1820) (cond ((kl:tuple? V1819) (cons (quote shen.t*) (cons (kl:shen.recursive_cons_form (kl:snd V1819)) (cons (kl:shen.construct-context V1820 (kl:fst V1819)) (quote ()))))) ((eq? (quote !) V1819) (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 V1823 V1824) (cond ((and (kl:= #t V1823) (null? V1824)) (quote Context_1957)) ((and (kl:= #f V1823) (null? V1824)) (quote ContextOut_1957)) ((pair? V1824) (cons (quote cons) (cons (kl:shen.recursive_cons_form (car V1824)) (cons (kl:shen.construct-context V1823 (cdr V1824)) (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 V1826) (cond ((pair? V1826) (cons (quote cons) (cons (kl:shen.recursive_cons_form (car V1826)) (cons (kl:shen.recursive_cons_form (cdr V1826)) (quote ()))))) (#t V1826))) (export shen.recursive_cons_form) (quote shen.recursive_cons_form)) +(begin (register-function-arity (quote preclude) 1) (define (kl:preclude V1828) (kl:shen.preclude-h (kl:map (lambda (X) (kl:shen.intern-type X)) V1828))) (export preclude) (quote preclude)) +(begin (register-function-arity (quote shen.preclude-h) 1) (define (kl:shen.preclude-h V1830) (let ((FilterDatatypes (kl:set (quote shen.*datatypes*) (kl:difference (kl:value (quote shen.*datatypes*)) V1830)))) (kl:value (quote shen.*datatypes*)))) (export shen.preclude-h) (quote shen.preclude-h)) +(begin (register-function-arity (quote include) 1) (define (kl:include V1832) (kl:shen.include-h (kl:map (lambda (X) (kl:shen.intern-type X)) V1832))) (export include) (quote include)) +(begin (register-function-arity (quote shen.include-h) 1) (define (kl:shen.include-h V1834) (let ((ValidTypes (kl:intersection V1834 (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 V1836) (kl:shen.preclude-h (kl:difference (kl:value (quote shen.*alldatatypes*)) (kl:map (lambda (X) (kl:shen.intern-type X)) V1836)))) (export preclude-all-but) (quote preclude-all-but)) +(begin (register-function-arity (quote include-all-but) 1) (define (kl:include-all-but V1838) (kl:shen.include-h (kl:difference (kl:value (quote shen.*alldatatypes*)) (kl:map (lambda (X) (kl:shen.intern-type X)) V1838)))) (export include-all-but) (quote include-all-but)) +(begin (register-function-arity (quote shen.synonyms-help) 1) (define (kl:shen.synonyms-help V1844) (cond ((null? V1844) (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? V1844) (pair? (cdr V1844))) (let ((Vs (kl:difference (kl:shen.extract_vars (car (cdr V1844))) (kl:shen.extract_vars (car V1844))))) (if (kl:empty? Vs) (begin (kl:shen.pushnew (cons (car V1844) (cons (car (cdr V1844)) (quote ()))) (quote shen.*synonyms*)) (kl:shen.synonyms-help (cdr (cdr V1844)))) (kl:shen.free_variable_warnings (car (cdr V1844)) 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 V1847 V1848) (if (kl:element? V1847 (kl:value V1848)) (kl:value V1848) (kl:set V1848 (cons V1847 (kl:value V1848))))) (export shen.pushnew) (quote shen.pushnew)) +(begin (register-function-arity (quote shen.demod-rule) 1) (define (kl:shen.demod-rule V1850) (cond ((and (pair? V1850) (and (pair? (cdr V1850)) (null? (cdr (cdr V1850))))) (cons (kl:shen.rcons_form (car V1850)) (cons (quote ->) (cons (kl:shen.rcons_form (car (cdr V1850))) (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 V1856) (cond ((and (pair? V1856) (and (eq? (quote defun) (car V1856)) (and (pair? (cdr V1856)) (and (pair? (cdr (cdr V1856))) (and (pair? (car (cdr (cdr V1856)))) (and (null? (cdr (car (cdr (cdr V1856))))) (and (pair? (cdr (cdr (cdr V1856)))) (null? (cdr (cdr (cdr (cdr V1856)))))))))))) (kl:eval (cons (quote /.) (cons (car (car (cdr (cdr V1856)))) (cdr (cdr (cdr V1856))))))) (#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 V1859 V1860) (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 V1860 (kl:shen.default-rule))))))) (begin (if (assert-boolean V1859) (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 96eac21..0664f3e 100644 --- a/compiled/sys.kl.ms +++ b/compiled/sys.kl.ms @@ -1,105 +1,105 @@ (module "compiled/sys.kl") "Copyright (c) 2010-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:\n\n1. Redistributions of source code must retain the above copyright notice,\nthis list of conditions and the following disclaimer.\n\n2. Redistributions in binary form must reproduce the above copyright notice,\nthis list of conditions and the following disclaimer in the documentation\nand/or other materials provided with the distribution.\n\n3. Neither the name of the copyright holder nor the names of its contributors\nmay be used to endorse or promote products derived from this software without\nspecific prior written permission.\n\nTHIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ''AS IS'' AND\nANY EXPRESS 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 THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE\nFOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL\nDAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR\nSERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER\nCAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,\nOR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE\nOF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.\n" -(begin (register-function-arity (quote thaw) 1) (define (kl:thaw V3023) (V3023)) (export thaw) (quote thaw)) -(begin (register-function-arity (quote eval) 1) (define (kl:eval V3025) (let ((Macroexpand (kl:shen.walk (lambda (Y) (kl:macroexpand Y)) V3025))) (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 V3027) (kl:eval-kl (kl:shen.elim-def (kl:shen.proc-input+ V3027)))) (export shen.eval-without-macros) (quote shen.eval-without-macros)) -(begin (register-function-arity (quote shen.proc-input+) 1) (define (kl:shen.proc-input+ V3029) (cond ((and (pair? V3029) (and (eq? (quote input+) (car V3029)) (and (pair? (cdr V3029)) (and (pair? (cdr (cdr V3029))) (null? (cdr (cdr (cdr V3029)))))))) (cons (quote input+) (cons (kl:shen.rcons_form (car (cdr V3029))) (cdr (cdr V3029))))) ((and (pair? V3029) (and (eq? (quote shen.read+) (car V3029)) (and (pair? (cdr V3029)) (and (pair? (cdr (cdr V3029))) (null? (cdr (cdr (cdr V3029)))))))) (cons (quote shen.read+) (cons (kl:shen.rcons_form (car (cdr V3029))) (cdr (cdr V3029))))) ((pair? V3029) (kl:map (lambda (Z) (kl:shen.proc-input+ Z)) V3029)) (#t V3029))) (export shen.proc-input+) (quote shen.proc-input+)) -(begin (register-function-arity (quote shen.elim-def) 1) (define (kl:shen.elim-def V3031) (cond ((and (pair? V3031) (and (eq? (quote define) (car V3031)) (pair? (cdr V3031)))) (kl:shen.shen->kl (car (cdr V3031)) (cdr (cdr V3031)))) ((and (pair? V3031) (and (eq? (quote defmacro) (car V3031)) (pair? (cdr V3031)))) (let ((Default (cons (quote X) (cons (quote ->) (cons (quote X) (quote ())))))) (let ((Def (kl:shen.elim-def (cons (quote define) (cons (car (cdr V3031)) (kl:append (cdr (cdr V3031)) Default)))))) (let ((MacroAdd (kl:shen.add-macro (car (cdr V3031))))) Def)))) ((and (pair? V3031) (and (eq? (quote defcc) (car V3031)) (pair? (cdr V3031)))) (kl:shen.elim-def (kl:shen.yacc V3031))) ((pair? V3031) (kl:map (lambda (Z) (kl:shen.elim-def Z)) V3031)) (#t V3031))) (export shen.elim-def) (quote shen.elim-def)) -(begin (register-function-arity (quote shen.add-macro) 1) (define (kl:shen.add-macro V3033) (let ((MacroReg (kl:value (quote shen.*macroreg*)))) (let ((NewMacroReg (kl:set (quote shen.*macroreg*) (kl:adjoin V3033 (kl:value (quote shen.*macroreg*)))))) (if (kl:= MacroReg NewMacroReg) (quote shen.skip) (kl:set (quote *macros*) (cons (kl:function V3033) (kl:value (quote *macros*)))))))) (export shen.add-macro) (quote shen.add-macro)) -(begin (register-function-arity (quote shen.packaged?) 1) (define (kl:shen.packaged? V3041) (cond ((and (pair? V3041) (and (eq? (quote package) (car V3041)) (and (pair? (cdr V3041)) (pair? (cdr (cdr V3041)))))) #t) (#t #f))) (export shen.packaged?) (quote shen.packaged?)) -(begin (register-function-arity (quote external) 1) (define (kl:external V3043) (guard (lambda (E) (simple-error (string-append "package " (kl:shen.app V3043 " has not been used.\n" (quote shen.a))))) (kl:get V3043 (quote shen.external-symbols) (kl:value (quote *property-vector*))))) (export external) (quote external)) -(begin (register-function-arity (quote internal) 1) (define (kl:internal V3045) (guard (lambda (E) (simple-error (string-append "package " (kl:shen.app V3045 " has not been used.\n" (quote shen.a))))) (kl:get V3045 (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 V3049) (cond ((and (pair? V3049) (and (eq? (quote package) (car V3049)) (and (pair? (cdr V3049)) (and (eq? (quote null) (car (cdr V3049))) (pair? (cdr (cdr V3049))))))) (cdr (cdr (cdr V3049)))) ((and (pair? V3049) (and (eq? (quote package) (car V3049)) (and (pair? (cdr V3049)) (pair? (cdr (cdr V3049)))))) (let ((PackageNameDot (kl:intern (string-append (kl:str (car (cdr V3049))) ".")))) (let ((ExpPackageNameDot (kl:explode PackageNameDot))) (kl:shen.packageh (car (cdr V3049)) (car (cdr (cdr V3049))) (cdr (cdr (cdr V3049))) 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 V3052 V3053) (cond ((pair? V3053) (V3052 (kl:map (lambda (Z) (kl:shen.walk V3052 Z)) V3053))) (#t (V3052 V3053)))) (export shen.walk) (quote shen.walk)) -(begin (register-function-arity (quote compile) 3) (define (kl:compile V3057 V3058 V3059) (let ((O (V3057 (cons V3058 (cons (quote ()) (quote ())))))) (if (or (kl:= (kl:fail) O) (kl:not (kl:empty? (car O)))) (V3059 O) (kl:shen.hdtl O)))) (export compile) (quote compile)) -(begin (register-function-arity (quote fail-if) 2) (define (kl:fail-if V3062 V3063) (if (assert-boolean (V3062 V3063)) (kl:fail) V3063)) (export fail-if) (quote fail-if)) -(begin (register-function-arity (quote _waspvm_at_s) 2) (define (kl:_waspvm_at_s V3066 V3067) (string-append V3066 V3067)) (export _waspvm_at_s) (quote _waspvm_at_s)) +(begin (register-function-arity (quote thaw) 1) (define (kl:thaw V1862) (V1862)) (export thaw) (quote thaw)) +(begin (register-function-arity (quote eval) 1) (define (kl:eval V1864) (let ((Macroexpand (kl:shen.walk (lambda (Y) (kl:macroexpand Y)) V1864))) (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 V1866) (kl:eval-kl (kl:shen.elim-def (kl:shen.proc-input+ V1866)))) (export shen.eval-without-macros) (quote shen.eval-without-macros)) +(begin (register-function-arity (quote shen.proc-input+) 1) (define (kl:shen.proc-input+ V1868) (cond ((and (pair? V1868) (and (eq? (quote input+) (car V1868)) (and (pair? (cdr V1868)) (and (pair? (cdr (cdr V1868))) (null? (cdr (cdr (cdr V1868)))))))) (cons (quote input+) (cons (kl:shen.rcons_form (car (cdr V1868))) (cdr (cdr V1868))))) ((and (pair? V1868) (and (eq? (quote shen.read+) (car V1868)) (and (pair? (cdr V1868)) (and (pair? (cdr (cdr V1868))) (null? (cdr (cdr (cdr V1868)))))))) (cons (quote shen.read+) (cons (kl:shen.rcons_form (car (cdr V1868))) (cdr (cdr V1868))))) ((pair? V1868) (kl:map (lambda (Z) (kl:shen.proc-input+ Z)) V1868)) (#t V1868))) (export shen.proc-input+) (quote shen.proc-input+)) +(begin (register-function-arity (quote shen.elim-def) 1) (define (kl:shen.elim-def V1870) (cond ((and (pair? V1870) (and (eq? (quote define) (car V1870)) (pair? (cdr V1870)))) (kl:shen.shen->kl (car (cdr V1870)) (cdr (cdr V1870)))) ((and (pair? V1870) (and (eq? (quote defmacro) (car V1870)) (pair? (cdr V1870)))) (let ((Default (cons (quote X) (cons (quote ->) (cons (quote X) (quote ())))))) (let ((Def (kl:shen.elim-def (cons (quote define) (cons (car (cdr V1870)) (kl:append (cdr (cdr V1870)) Default)))))) (let ((MacroAdd (kl:shen.add-macro (car (cdr V1870))))) Def)))) ((and (pair? V1870) (and (eq? (quote defcc) (car V1870)) (pair? (cdr V1870)))) (kl:shen.elim-def (kl:shen.yacc V1870))) ((pair? V1870) (kl:map (lambda (Z) (kl:shen.elim-def Z)) V1870)) (#t V1870))) (export shen.elim-def) (quote shen.elim-def)) +(begin (register-function-arity (quote shen.add-macro) 1) (define (kl:shen.add-macro V1872) (let ((MacroReg (kl:value (quote shen.*macroreg*)))) (let ((NewMacroReg (kl:set (quote shen.*macroreg*) (kl:adjoin V1872 (kl:value (quote shen.*macroreg*)))))) (if (kl:= MacroReg NewMacroReg) (quote shen.skip) (kl:set (quote *macros*) (cons (kl:function V1872) (kl:value (quote *macros*)))))))) (export shen.add-macro) (quote shen.add-macro)) +(begin (register-function-arity (quote shen.packaged?) 1) (define (kl:shen.packaged? V1880) (cond ((and (pair? V1880) (and (eq? (quote package) (car V1880)) (and (pair? (cdr V1880)) (pair? (cdr (cdr V1880)))))) #t) (#t #f))) (export shen.packaged?) (quote shen.packaged?)) +(begin (register-function-arity (quote external) 1) (define (kl:external V1882) (guard (lambda (E) (simple-error (string-append "package " (kl:shen.app V1882 " has not been used.\n" (quote shen.a))))) (kl:get V1882 (quote shen.external-symbols) (kl:value (quote *property-vector*))))) (export external) (quote external)) +(begin (register-function-arity (quote internal) 1) (define (kl:internal V1884) (guard (lambda (E) (simple-error (string-append "package " (kl:shen.app V1884 " has not been used.\n" (quote shen.a))))) (kl:get V1884 (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 V1888) (cond ((and (pair? V1888) (and (eq? (quote package) (car V1888)) (and (pair? (cdr V1888)) (and (eq? (quote null) (car (cdr V1888))) (pair? (cdr (cdr V1888))))))) (cdr (cdr (cdr V1888)))) ((and (pair? V1888) (and (eq? (quote package) (car V1888)) (and (pair? (cdr V1888)) (pair? (cdr (cdr V1888)))))) (let ((PackageNameDot (kl:intern (string-append (kl:str (car (cdr V1888))) ".")))) (let ((ExpPackageNameDot (kl:explode PackageNameDot))) (kl:shen.packageh (car (cdr V1888)) (car (cdr (cdr V1888))) (cdr (cdr (cdr V1888))) 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 V1891 V1892) (cond ((pair? V1892) (V1891 (kl:map (lambda (Z) (kl:shen.walk V1891 Z)) V1892))) (#t (V1891 V1892)))) (export shen.walk) (quote shen.walk)) +(begin (register-function-arity (quote compile) 3) (define (kl:compile V1896 V1897 V1898) (let ((O (V1896 (cons V1897 (cons (quote ()) (quote ())))))) (if (or (kl:= (kl:fail) O) (kl:not (kl:empty? (car O)))) (V1898 O) (kl:shen.hdtl O)))) (export compile) (quote compile)) +(begin (register-function-arity (quote fail-if) 2) (define (kl:fail-if V1901 V1902) (if (assert-boolean (V1901 V1902)) (kl:fail) V1902)) (export fail-if) (quote fail-if)) +(begin (register-function-arity (quote _waspvm_at_s) 2) (define (kl:_waspvm_at_s V1905 V1906) (string-append V1905 V1906)) (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 V3069) (guard (lambda (E) (simple-error (kl:shen.app V3069 " not found.\n" (quote shen.a)))) (kl:get V3069 (quote shen.source) (kl:value (quote *property-vector*))))) (export ps) (quote ps)) +(begin (register-function-arity (quote ps) 1) (define (kl:ps V1908) (guard (lambda (E) (simple-error (kl:shen.app V1908 " not found.\n" (quote shen.a)))) (kl:get V1908 (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 V3071) (let ((Vector (make-vector (+ V3071 1) (quote (quote shen.fail!))))) (let ((ZeroStamp (let ((_tmp Vector)) (vector-set! _tmp 0 V3071) _tmp))) (let ((Standard (if (kl:= V3071 0) ZeroStamp (kl:shen.fillvector ZeroStamp 1 V3071 (kl:fail))))) Standard)))) (export vector) (quote vector)) -(begin (register-function-arity (quote shen.fillvector) 4) (define (kl:shen.fillvector V3077 V3078 V3079 V3080) (cond ((kl:= V3079 V3078) (let ((_tmp V3077)) (vector-set! _tmp V3079 V3080) _tmp)) (#t (kl:shen.fillvector (let ((_tmp V3077)) (vector-set! _tmp V3078 V3080) _tmp) (+ 1 V3078) V3079 V3080)))) (export shen.fillvector) (quote shen.fillvector)) -(begin (register-function-arity (quote vector?) 1) (define (kl:vector? V3082) (and (vector? V3082) (assert-boolean (let ((X (guard (lambda (E) -1) (vector-ref V3082 0)))) (and (number? X) (>= X 0)))))) (export vector?) (quote vector?)) -(begin (register-function-arity (quote vector->) 3) (define (kl:vector-> V3086 V3087 V3088) (if (kl:= V3087 0) (simple-error "cannot access 0th element of a vector\n") (let ((_tmp V3086)) (vector-set! _tmp V3087 V3088) _tmp))) (export vector->) (quote vector->)) -(begin (register-function-arity (quote <-vector) 2) (define (kl:<-vector V3091 V3092) (if (kl:= V3092 0) (simple-error "cannot access 0th element of a vector\n") (let ((VectorElement (vector-ref V3091 V3092))) (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? V3094) (and (assert-boolean (kl:integer? V3094)) (>= V3094 0))) (export shen.posint?) (quote shen.posint?)) -(begin (register-function-arity (quote limit) 1) (define (kl:limit V3096) (vector-ref V3096 0)) (export limit) (quote limit)) -(begin (register-function-arity (quote symbol?) 1) (define (kl:symbol? V3098) (cond ((or (kl:boolean? V3098) (or (number? V3098) (string? V3098))) #f) (#t (guard (lambda (E) #f) (let ((String (kl:str V3098))) (kl:shen.analyse-symbol? String)))))) (export symbol?) (quote symbol?)) -(begin (register-function-arity (quote shen.analyse-symbol?) 1) (define (kl:shen.analyse-symbol? V3100) (cond ((equal? "" V3100) #f) ((assert-boolean (kl:shen.+string? V3100)) (and (assert-boolean (kl:shen.alpha? (make-string 1 (string-ref V3100 0)))) (assert-boolean (kl:shen.alphanums? (string-tail V3100 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? V3102) (kl:element? V3102 (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? V3104) (cond ((equal? "" V3104) #t) ((assert-boolean (kl:shen.+string? V3104)) (and (assert-boolean (kl:shen.alphanum? (make-string 1 (string-ref V3104 0)))) (assert-boolean (kl:shen.alphanums? (string-tail V3104 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? V3106) (or (assert-boolean (kl:shen.alpha? V3106)) (assert-boolean (kl:shen.digit? V3106)))) (export shen.alphanum?) (quote shen.alphanum?)) -(begin (register-function-arity (quote shen.digit?) 1) (define (kl:shen.digit? V3108) (kl:element? V3108 (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? V3110) (cond ((or (kl:boolean? V3110) (or (number? V3110) (string? V3110))) #f) (#t (guard (lambda (E) #f) (let ((String (kl:str V3110))) (kl:shen.analyse-variable? String)))))) (export variable?) (quote variable?)) -(begin (register-function-arity (quote shen.analyse-variable?) 1) (define (kl:shen.analyse-variable? V3112) (cond ((assert-boolean (kl:shen.+string? V3112)) (and (assert-boolean (kl:shen.uppercase? (make-string 1 (string-ref V3112 0)))) (assert-boolean (kl:shen.alphanums? (string-tail V3112 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? V3114) (kl:element? V3114 (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 V3116) (kl:concat V3116 (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 V3119 V3120) (kl:intern (string-append (kl:str V3119) (kl:str V3120)))) (export concat) (quote concat)) -(begin (register-function-arity (quote _waspvm_at_p) 2) (define (kl:_waspvm_at_p V3123 V3124) (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 V3123) _tmp))) (let ((Snd (let ((_tmp Vector)) (vector-set! _tmp 2 V3124) _tmp))) Vector))))) (export _waspvm_at_p) (quote _waspvm_at_p)) -(begin (register-function-arity (quote fst) 1) (define (kl:fst V3126) (vector-ref V3126 1)) (export fst) (quote fst)) -(begin (register-function-arity (quote snd) 1) (define (kl:snd V3128) (vector-ref V3128 2)) (export snd) (quote snd)) -(begin (register-function-arity (quote tuple?) 1) (define (kl:tuple? V3130) (and (vector? V3130) (eq? (quote shen.tuple) (guard (lambda (E) (quote shen.not-tuple)) (vector-ref V3130 0))))) (export tuple?) (quote tuple?)) -(begin (register-function-arity (quote append) 2) (define (kl:append V3133 V3134) (cond ((null? V3133) V3134) ((pair? V3133) (cons (car V3133) (kl:append (cdr V3133) V3134))) (#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 V3137 V3138) (let ((Limit (kl:limit V3138))) (let ((NewVector (kl:vector (+ Limit 1)))) (let ((X+NewVector (kl:vector-> NewVector 1 V3137))) (if (kl:= Limit 0) X+NewVector (kl:shen._waspvm_at_v-help V3138 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 V3144 V3145 V3146 V3147) (cond ((kl:= V3146 V3145) (kl:shen.copyfromvector V3144 V3147 V3146 (+ V3146 1))) (#t (kl:shen._waspvm_at_v-help V3144 (+ V3145 1) V3146 (kl:shen.copyfromvector V3144 V3147 V3145 (+ V3145 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 V3152 V3153 V3154 V3155) (guard (lambda (E) V3153) (kl:vector-> V3153 V3155 (kl:<-vector V3152 V3154)))) (export shen.copyfromvector) (quote shen.copyfromvector)) -(begin (register-function-arity (quote hdv) 1) (define (kl:hdv V3157) (guard (lambda (E) (simple-error (string-append "hdv needs a non-empty vector as an argument; not " (kl:shen.app V3157 "\n" (quote shen.s))))) (kl:<-vector V3157 1))) (export hdv) (quote hdv)) -(begin (register-function-arity (quote tlv) 1) (define (kl:tlv V3159) (let ((Limit (kl:limit V3159))) (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 V3159 2 Limit (kl:vector (- Limit 1)))))))) (export tlv) (quote tlv)) -(begin (register-function-arity (quote shen.tlv-help) 4) (define (kl:shen.tlv-help V3165 V3166 V3167 V3168) (cond ((kl:= V3167 V3166) (kl:shen.copyfromvector V3165 V3168 V3167 (- V3167 1))) (#t (kl:shen.tlv-help V3165 (+ V3166 1) V3167 (kl:shen.copyfromvector V3165 V3168 V3166 (- V3166 1)))))) (export shen.tlv-help) (quote shen.tlv-help)) -(begin (register-function-arity (quote assoc) 2) (define (kl:assoc V3180 V3181) (cond ((null? V3181) (quote ())) ((and (pair? V3181) (and (pair? (car V3181)) (kl:= (car (car V3181)) V3180))) (car V3181)) ((pair? V3181) (kl:assoc V3180 (cdr V3181))) (#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 V3188 V3189 V3190) (cond ((null? V3190) (cons (cons V3188 V3189) (quote ()))) ((and (pair? V3190) (and (pair? (car V3190)) (kl:= (car (car V3190)) V3188))) (cons (cons (car (car V3190)) V3189) (cdr V3190))) ((pair? V3190) (cons (car V3190) (kl:shen.assoc-set V3188 V3189 (cdr V3190)))) (#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 V3196 V3197) (cond ((null? V3197) (quote ())) ((and (pair? V3197) (and (pair? (car V3197)) (kl:= (car (car V3197)) V3196))) (cdr V3197)) ((pair? V3197) (cons (car V3197) (kl:shen.assoc-rm V3196 (cdr V3197)))) (#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? V3203) (cond ((kl:= #t V3203) #t) ((kl:= #f V3203) #t) (#t #f))) (export boolean?) (quote boolean?)) -(begin (register-function-arity (quote nl) 1) (define (kl:nl V3205) (cond ((kl:= 0 V3205) 0) (#t (begin (kl:shen.prhush "\n" (kl:stoutput)) (kl:nl (- V3205 1)))))) (export nl) (quote nl)) -(begin (register-function-arity (quote difference) 2) (define (kl:difference V3210 V3211) (cond ((null? V3210) (quote ())) ((pair? V3210) (if (kl:element? (car V3210) V3211) (kl:difference (cdr V3210) V3211) (cons (car V3210) (kl:difference (cdr V3210) V3211)))) (#t (kl:shen.f_error (quote difference))))) (export difference) (quote difference)) -(begin (register-function-arity (quote do) 2) (define (kl:do V3214 V3215) V3215) (export do) (quote do)) -(begin (register-function-arity (quote element?) 2) (define (kl:element? V3227 V3228) (cond ((null? V3228) #f) ((and (pair? V3228) (kl:= (car V3228) V3227)) #t) ((pair? V3228) (kl:element? V3227 (cdr V3228))) (#t (kl:shen.f_error (quote element?))))) (export element?) (quote element?)) -(begin (register-function-arity (quote empty?) 1) (define (kl:empty? V3234) (cond ((null? V3234) #t) (#t #f))) (export empty?) (quote empty?)) -(begin (register-function-arity (quote fix) 2) (define (kl:fix V3237 V3238) (kl:shen.fix-help V3237 V3238 (V3237 V3238))) (export fix) (quote fix)) -(begin (register-function-arity (quote shen.fix-help) 3) (define (kl:shen.fix-help V3249 V3250 V3251) (cond ((kl:= V3251 V3250) V3251) (#t (kl:shen.fix-help V3249 V3251 (V3249 V3251))))) (export shen.fix-help) (quote shen.fix-help)) -(begin (register-function-arity (quote put) 4) (define (kl:put V3256 V3257 V3258 V3259) (let ((Curr (guard (lambda (E) (quote ())) (kl:shen.<-dict V3259 V3256)))) (let ((Added (kl:shen.assoc-set V3257 V3258 Curr))) (let ((Update (kl:shen.dict-> V3259 V3256 Added))) V3258)))) (export put) (quote put)) -(begin (register-function-arity (quote unput) 3) (define (kl:unput V3263 V3264 V3265) (let ((Curr (guard (lambda (E) (quote ())) (kl:shen.<-dict V3265 V3263)))) (let ((Removed (kl:shen.assoc-rm V3264 Curr))) (let ((Update (kl:shen.dict-> V3265 V3263 Removed))) V3263)))) (export unput) (quote unput)) -(begin (register-function-arity (quote get) 3) (define (kl:get V3269 V3270 V3271) (let ((Entry (guard (lambda (E) (quote ())) (kl:shen.<-dict V3271 V3269)))) (let ((Result (kl:assoc V3270 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 V3274 V3275) (kl:shen.mod (kl:sum (kl:map (lambda (X) (string-ref X 0)) (kl:explode V3274))) V3275)) (export hash) (quote hash)) -(begin (register-function-arity (quote shen.mod) 2) (define (kl:shen.mod V3278 V3279) (kl:shen.modh V3278 (kl:shen.multiples V3278 (cons V3279 (quote ()))))) (export shen.mod) (quote shen.mod)) -(begin (register-function-arity (quote shen.multiples) 2) (define (kl:shen.multiples V3282 V3283) (cond ((and (pair? V3283) (> (car V3283) V3282)) (cdr V3283)) ((pair? V3283) (kl:shen.multiples V3282 (cons (* 2 (car V3283)) V3283))) (#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 V3288 V3289) (cond ((kl:= 0 V3288) 0) ((null? V3289) V3288) ((and (pair? V3289) (> (car V3289) V3288)) (if (kl:empty? (cdr V3289)) V3288 (kl:shen.modh V3288 (cdr V3289)))) ((pair? V3289) (kl:shen.modh (- V3288 (car V3289)) V3289)) (#t (kl:shen.f_error (quote shen.modh))))) (export shen.modh) (quote shen.modh)) -(begin (register-function-arity (quote sum) 1) (define (kl:sum V3291) (cond ((null? V3291) 0) ((pair? V3291) (+ (car V3291) (kl:sum (cdr V3291)))) (#t (kl:shen.f_error (quote sum))))) (export sum) (quote sum)) -(begin (register-function-arity (quote head) 1) (define (kl:head V3299) (cond ((pair? V3299) (car V3299)) (#t (simple-error "head expects a non-empty list")))) (export head) (quote head)) -(begin (register-function-arity (quote tail) 1) (define (kl:tail V3307) (cond ((pair? V3307) (cdr V3307)) (#t (simple-error "tail expects a non-empty list")))) (export tail) (quote tail)) -(begin (register-function-arity (quote hdstr) 1) (define (kl:hdstr V3309) (make-string 1 (string-ref V3309 0))) (export hdstr) (quote hdstr)) -(begin (register-function-arity (quote intersection) 2) (define (kl:intersection V3314 V3315) (cond ((null? V3314) (quote ())) ((pair? V3314) (if (kl:element? (car V3314) V3315) (cons (car V3314) (kl:intersection (cdr V3314) V3315)) (kl:intersection (cdr V3314) V3315))) (#t (kl:shen.f_error (quote intersection))))) (export intersection) (quote intersection)) -(begin (register-function-arity (quote reverse) 1) (define (kl:reverse V3317) (kl:shen.reverse_help V3317 (quote ()))) (export reverse) (quote reverse)) -(begin (register-function-arity (quote shen.reverse_help) 2) (define (kl:shen.reverse_help V3320 V3321) (cond ((null? V3320) V3321) ((pair? V3320) (kl:shen.reverse_help (cdr V3320) (cons (car V3320) V3321))) (#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 V3324 V3325) (cond ((null? V3324) V3325) ((pair? V3324) (if (kl:element? (car V3324) V3325) (kl:union (cdr V3324) V3325) (cons (car V3324) (kl:union (cdr V3324) V3325)))) (#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? V3327) (let ((Message (kl:shen.prhush (kl:shen.proc-nl V3327) (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? V3327)))))))) (export y-or-n?) (quote y-or-n?)) -(begin (register-function-arity (quote not) 1) (define (kl:not V3329) (if (assert-boolean V3329) #f #t)) (export not) (quote not)) -(begin (register-function-arity (quote subst) 3) (define (kl:subst V3342 V3343 V3344) (cond ((kl:= V3344 V3343) V3342) ((pair? V3344) (kl:map (lambda (W) (kl:subst V3342 V3343 W)) V3344)) (#t V3344))) (export subst) (quote subst)) -(begin (register-function-arity (quote explode) 1) (define (kl:explode V3346) (kl:shen.explode-h (kl:shen.app V3346 "" (quote shen.a)))) (export explode) (quote explode)) -(begin (register-function-arity (quote shen.explode-h) 1) (define (kl:shen.explode-h V3348) (cond ((equal? "" V3348) (quote ())) ((assert-boolean (kl:shen.+string? V3348)) (cons (make-string 1 (string-ref V3348 0)) (kl:shen.explode-h (string-tail V3348 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 V3350) (kl:set (quote *home-directory*) (if (equal? V3350 "") "" (kl:shen.app V3350 "/" (quote shen.a))))) (export cd) (quote cd)) -(begin (register-function-arity (quote shen.for-each) 2) (define (kl:shen.for-each V3353 V3354) (cond ((null? V3354) #t) ((pair? V3354) (let ((_ (V3353 (car V3354)))) (kl:shen.for-each V3353 (cdr V3354)))) (#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 V3359 V3360) (cond ((null? V3360) (quote ())) ((pair? V3360) (cons (V3359 (car V3360)) (kl:map V3359 (cdr V3360)))) (#t (V3359 V3360)))) (export map) (quote map)) -(begin (register-function-arity (quote length) 1) (define (kl:length V3362) (kl:shen.length-h V3362 0)) (export length) (quote length)) -(begin (register-function-arity (quote shen.length-h) 2) (define (kl:shen.length-h V3365 V3366) (cond ((null? V3365) V3366) (#t (kl:shen.length-h (cdr V3365) (+ V3366 1))))) (export shen.length-h) (quote shen.length-h)) -(begin (register-function-arity (quote occurrences) 2) (define (kl:occurrences V3378 V3379) (cond ((kl:= V3379 V3378) 1) ((pair? V3379) (+ (kl:occurrences V3378 (car V3379)) (kl:occurrences V3378 (cdr V3379)))) (#t 0))) (export occurrences) (quote occurrences)) -(begin (register-function-arity (quote nth) 2) (define (kl:nth V3386 V3387) (cond ((and (kl:= 1 V3386) (pair? V3387)) (car V3387)) ((pair? V3387) (kl:nth (- V3386 1) (cdr V3387))) (#t (simple-error (string-append "nth applied to " (kl:shen.app V3386 (string-append ", " (kl:shen.app V3387 "\n" (quote shen.a))) (quote shen.a))))))) (export nth) (quote nth)) -(begin (register-function-arity (quote integer?) 1) (define (kl:integer? V3389) (and (number? V3389) (assert-boolean (let ((Abs (kl:shen.abs V3389))) (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 V3391) (if (> V3391 0) V3391 (- 0 V3391))) (export shen.abs) (quote shen.abs)) -(begin (register-function-arity (quote shen.magless) 2) (define (kl:shen.magless V3394 V3395) (let ((Nx2 (* V3395 2))) (if (> Nx2 V3394) V3395 (kl:shen.magless V3394 Nx2)))) (export shen.magless) (quote shen.magless)) -(begin (register-function-arity (quote shen.integer-test?) 2) (define (kl:shen.integer-test? V3401 V3402) (cond ((kl:= 0 V3401) #t) ((> 1 V3401) #f) (#t (let ((Abs-N (- V3401 V3402))) (if (> 0 Abs-N) (kl:integer? V3401) (kl:shen.integer-test? Abs-N V3402)))))) (export shen.integer-test?) (quote shen.integer-test?)) -(begin (register-function-arity (quote mapcan) 2) (define (kl:mapcan V3407 V3408) (cond ((null? V3408) (quote ())) ((pair? V3408) (kl:append (V3407 (car V3408)) (kl:mapcan V3407 (cdr V3408)))) (#t (kl:shen.f_error (quote mapcan))))) (export mapcan) (quote mapcan)) -(begin (register-function-arity (quote ==) 2) (define (kl:== V3420 V3421) (cond ((kl:= V3421 V3420) #t) (#t #f))) (export ==) (quote ==)) +(begin (register-function-arity (quote vector) 1) (define (kl:vector V1910) (let ((Vector (make-vector (+ V1910 1) (quote (quote shen.fail!))))) (let ((ZeroStamp (let ((_tmp Vector)) (vector-set! _tmp 0 V1910) _tmp))) (let ((Standard (if (kl:= V1910 0) ZeroStamp (kl:shen.fillvector ZeroStamp 1 V1910 (kl:fail))))) Standard)))) (export vector) (quote vector)) +(begin (register-function-arity (quote shen.fillvector) 4) (define (kl:shen.fillvector V1916 V1917 V1918 V1919) (cond ((kl:= V1918 V1917) (let ((_tmp V1916)) (vector-set! _tmp V1918 V1919) _tmp)) (#t (kl:shen.fillvector (let ((_tmp V1916)) (vector-set! _tmp V1917 V1919) _tmp) (+ 1 V1917) V1918 V1919)))) (export shen.fillvector) (quote shen.fillvector)) +(begin (register-function-arity (quote vector?) 1) (define (kl:vector? V1921) (and (vector? V1921) (assert-boolean (let ((X (guard (lambda (E) -1) (vector-ref V1921 0)))) (and (number? X) (>= X 0)))))) (export vector?) (quote vector?)) +(begin (register-function-arity (quote vector->) 3) (define (kl:vector-> V1925 V1926 V1927) (if (kl:= V1926 0) (simple-error "cannot access 0th element of a vector\n") (let ((_tmp V1925)) (vector-set! _tmp V1926 V1927) _tmp))) (export vector->) (quote vector->)) +(begin (register-function-arity (quote <-vector) 2) (define (kl:<-vector V1930 V1931) (if (kl:= V1931 0) (simple-error "cannot access 0th element of a vector\n") (let ((VectorElement (vector-ref V1930 V1931))) (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? V1933) (and (assert-boolean (kl:integer? V1933)) (>= V1933 0))) (export shen.posint?) (quote shen.posint?)) +(begin (register-function-arity (quote limit) 1) (define (kl:limit V1935) (vector-ref V1935 0)) (export limit) (quote limit)) +(begin (register-function-arity (quote symbol?) 1) (define (kl:symbol? V1937) (cond ((or (kl:boolean? V1937) (or (number? V1937) (string? V1937))) #f) (#t (guard (lambda (E) #f) (let ((String (kl:str V1937))) (kl:shen.analyse-symbol? String)))))) (export symbol?) (quote symbol?)) +(begin (register-function-arity (quote shen.analyse-symbol?) 1) (define (kl:shen.analyse-symbol? V1939) (cond ((equal? "" V1939) #f) ((assert-boolean (kl:shen.+string? V1939)) (and (assert-boolean (kl:shen.alpha? (make-string 1 (string-ref V1939 0)))) (assert-boolean (kl:shen.alphanums? (string-tail V1939 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? V1941) (kl:element? V1941 (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? V1943) (cond ((equal? "" V1943) #t) ((assert-boolean (kl:shen.+string? V1943)) (and (assert-boolean (kl:shen.alphanum? (make-string 1 (string-ref V1943 0)))) (assert-boolean (kl:shen.alphanums? (string-tail V1943 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? V1945) (or (assert-boolean (kl:shen.alpha? V1945)) (assert-boolean (kl:shen.digit? V1945)))) (export shen.alphanum?) (quote shen.alphanum?)) +(begin (register-function-arity (quote shen.digit?) 1) (define (kl:shen.digit? V1947) (kl:element? V1947 (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? V1949) (cond ((or (kl:boolean? V1949) (or (number? V1949) (string? V1949))) #f) (#t (guard (lambda (E) #f) (let ((String (kl:str V1949))) (kl:shen.analyse-variable? String)))))) (export variable?) (quote variable?)) +(begin (register-function-arity (quote shen.analyse-variable?) 1) (define (kl:shen.analyse-variable? V1951) (cond ((assert-boolean (kl:shen.+string? V1951)) (and (assert-boolean (kl:shen.uppercase? (make-string 1 (string-ref V1951 0)))) (assert-boolean (kl:shen.alphanums? (string-tail V1951 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? V1953) (kl:element? V1953 (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 V1955) (kl:concat V1955 (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 V1958 V1959) (kl:intern (string-append (kl:str V1958) (kl:str V1959)))) (export concat) (quote concat)) +(begin (register-function-arity (quote _waspvm_at_p) 2) (define (kl:_waspvm_at_p V1962 V1963) (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 V1962) _tmp))) (let ((Snd (let ((_tmp Vector)) (vector-set! _tmp 2 V1963) _tmp))) Vector))))) (export _waspvm_at_p) (quote _waspvm_at_p)) +(begin (register-function-arity (quote fst) 1) (define (kl:fst V1965) (vector-ref V1965 1)) (export fst) (quote fst)) +(begin (register-function-arity (quote snd) 1) (define (kl:snd V1967) (vector-ref V1967 2)) (export snd) (quote snd)) +(begin (register-function-arity (quote tuple?) 1) (define (kl:tuple? V1969) (and (vector? V1969) (eq? (quote shen.tuple) (guard (lambda (E) (quote shen.not-tuple)) (vector-ref V1969 0))))) (export tuple?) (quote tuple?)) +(begin (register-function-arity (quote append) 2) (define (kl:append V1972 V1973) (cond ((null? V1972) V1973) ((pair? V1972) (cons (car V1972) (kl:append (cdr V1972) V1973))) (#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 V1976 V1977) (let ((Limit (kl:limit V1977))) (let ((NewVector (kl:vector (+ Limit 1)))) (let ((X+NewVector (kl:vector-> NewVector 1 V1976))) (if (kl:= Limit 0) X+NewVector (kl:shen._waspvm_at_v-help V1977 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 V1983 V1984 V1985 V1986) (cond ((kl:= V1985 V1984) (kl:shen.copyfromvector V1983 V1986 V1985 (+ V1985 1))) (#t (kl:shen._waspvm_at_v-help V1983 (+ V1984 1) V1985 (kl:shen.copyfromvector V1983 V1986 V1984 (+ V1984 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 V1991 V1992 V1993 V1994) (guard (lambda (E) V1992) (kl:vector-> V1992 V1994 (kl:<-vector V1991 V1993)))) (export shen.copyfromvector) (quote shen.copyfromvector)) +(begin (register-function-arity (quote hdv) 1) (define (kl:hdv V1996) (guard (lambda (E) (simple-error (string-append "hdv needs a non-empty vector as an argument; not " (kl:shen.app V1996 "\n" (quote shen.s))))) (kl:<-vector V1996 1))) (export hdv) (quote hdv)) +(begin (register-function-arity (quote tlv) 1) (define (kl:tlv V1998) (let ((Limit (kl:limit V1998))) (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 V1998 2 Limit (kl:vector (- Limit 1)))))))) (export tlv) (quote tlv)) +(begin (register-function-arity (quote shen.tlv-help) 4) (define (kl:shen.tlv-help V2004 V2005 V2006 V2007) (cond ((kl:= V2006 V2005) (kl:shen.copyfromvector V2004 V2007 V2006 (- V2006 1))) (#t (kl:shen.tlv-help V2004 (+ V2005 1) V2006 (kl:shen.copyfromvector V2004 V2007 V2005 (- V2005 1)))))) (export shen.tlv-help) (quote shen.tlv-help)) +(begin (register-function-arity (quote assoc) 2) (define (kl:assoc V2019 V2020) (cond ((null? V2020) (quote ())) ((and (pair? V2020) (and (pair? (car V2020)) (kl:= (car (car V2020)) V2019))) (car V2020)) ((pair? V2020) (kl:assoc V2019 (cdr V2020))) (#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 V2027 V2028 V2029) (cond ((null? V2029) (cons (cons V2027 V2028) (quote ()))) ((and (pair? V2029) (and (pair? (car V2029)) (kl:= (car (car V2029)) V2027))) (cons (cons (car (car V2029)) V2028) (cdr V2029))) ((pair? V2029) (cons (car V2029) (kl:shen.assoc-set V2027 V2028 (cdr V2029)))) (#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 V2035 V2036) (cond ((null? V2036) (quote ())) ((and (pair? V2036) (and (pair? (car V2036)) (kl:= (car (car V2036)) V2035))) (cdr V2036)) ((pair? V2036) (cons (car V2036) (kl:shen.assoc-rm V2035 (cdr V2036)))) (#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? V2042) (cond ((kl:= #t V2042) #t) ((kl:= #f V2042) #t) (#t #f))) (export boolean?) (quote boolean?)) +(begin (register-function-arity (quote nl) 1) (define (kl:nl V2044) (cond ((kl:= 0 V2044) 0) (#t (begin (kl:shen.prhush "\n" (kl:stoutput)) (kl:nl (- V2044 1)))))) (export nl) (quote nl)) +(begin (register-function-arity (quote difference) 2) (define (kl:difference V2049 V2050) (cond ((null? V2049) (quote ())) ((pair? V2049) (if (kl:element? (car V2049) V2050) (kl:difference (cdr V2049) V2050) (cons (car V2049) (kl:difference (cdr V2049) V2050)))) (#t (kl:shen.f_error (quote difference))))) (export difference) (quote difference)) +(begin (register-function-arity (quote do) 2) (define (kl:do V2053 V2054) V2054) (export do) (quote do)) +(begin (register-function-arity (quote element?) 2) (define (kl:element? V2066 V2067) (cond ((null? V2067) #f) ((and (pair? V2067) (kl:= (car V2067) V2066)) #t) ((pair? V2067) (kl:element? V2066 (cdr V2067))) (#t (kl:shen.f_error (quote element?))))) (export element?) (quote element?)) +(begin (register-function-arity (quote empty?) 1) (define (kl:empty? V2073) (cond ((null? V2073) #t) (#t #f))) (export empty?) (quote empty?)) +(begin (register-function-arity (quote fix) 2) (define (kl:fix V2076 V2077) (kl:shen.fix-help V2076 V2077 (V2076 V2077))) (export fix) (quote fix)) +(begin (register-function-arity (quote shen.fix-help) 3) (define (kl:shen.fix-help V2088 V2089 V2090) (cond ((kl:= V2090 V2089) V2090) (#t (kl:shen.fix-help V2088 V2090 (V2088 V2090))))) (export shen.fix-help) (quote shen.fix-help)) +(begin (register-function-arity (quote put) 4) (define (kl:put V2095 V2096 V2097 V2098) (let ((Curr (guard (lambda (E) (quote ())) (kl:shen.<-dict V2098 V2095)))) (let ((Added (kl:shen.assoc-set V2096 V2097 Curr))) (let ((Update (kl:shen.dict-> V2098 V2095 Added))) V2097)))) (export put) (quote put)) +(begin (register-function-arity (quote unput) 3) (define (kl:unput V2102 V2103 V2104) (let ((Curr (guard (lambda (E) (quote ())) (kl:shen.<-dict V2104 V2102)))) (let ((Removed (kl:shen.assoc-rm V2103 Curr))) (let ((Update (kl:shen.dict-> V2104 V2102 Removed))) V2102)))) (export unput) (quote unput)) +(begin (register-function-arity (quote get) 3) (define (kl:get V2108 V2109 V2110) (let ((Entry (guard (lambda (E) (quote ())) (kl:shen.<-dict V2110 V2108)))) (let ((Result (kl:assoc V2109 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 V2113 V2114) (kl:shen.mod (kl:sum (kl:map (lambda (X) (string-ref X 0)) (kl:explode V2113))) V2114)) (export hash) (quote hash)) +(begin (register-function-arity (quote shen.mod) 2) (define (kl:shen.mod V2117 V2118) (kl:shen.modh V2117 (kl:shen.multiples V2117 (cons V2118 (quote ()))))) (export shen.mod) (quote shen.mod)) +(begin (register-function-arity (quote shen.multiples) 2) (define (kl:shen.multiples V2121 V2122) (cond ((and (pair? V2122) (> (car V2122) V2121)) (cdr V2122)) ((pair? V2122) (kl:shen.multiples V2121 (cons (* 2 (car V2122)) V2122))) (#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 V2127 V2128) (cond ((kl:= 0 V2127) 0) ((null? V2128) V2127) ((and (pair? V2128) (> (car V2128) V2127)) (if (kl:empty? (cdr V2128)) V2127 (kl:shen.modh V2127 (cdr V2128)))) ((pair? V2128) (kl:shen.modh (- V2127 (car V2128)) V2128)) (#t (kl:shen.f_error (quote shen.modh))))) (export shen.modh) (quote shen.modh)) +(begin (register-function-arity (quote sum) 1) (define (kl:sum V2130) (cond ((null? V2130) 0) ((pair? V2130) (+ (car V2130) (kl:sum (cdr V2130)))) (#t (kl:shen.f_error (quote sum))))) (export sum) (quote sum)) +(begin (register-function-arity (quote head) 1) (define (kl:head V2138) (cond ((pair? V2138) (car V2138)) (#t (simple-error "head expects a non-empty list")))) (export head) (quote head)) +(begin (register-function-arity (quote tail) 1) (define (kl:tail V2146) (cond ((pair? V2146) (cdr V2146)) (#t (simple-error "tail expects a non-empty list")))) (export tail) (quote tail)) +(begin (register-function-arity (quote hdstr) 1) (define (kl:hdstr V2148) (make-string 1 (string-ref V2148 0))) (export hdstr) (quote hdstr)) +(begin (register-function-arity (quote intersection) 2) (define (kl:intersection V2153 V2154) (cond ((null? V2153) (quote ())) ((pair? V2153) (if (kl:element? (car V2153) V2154) (cons (car V2153) (kl:intersection (cdr V2153) V2154)) (kl:intersection (cdr V2153) V2154))) (#t (kl:shen.f_error (quote intersection))))) (export intersection) (quote intersection)) +(begin (register-function-arity (quote reverse) 1) (define (kl:reverse V2156) (kl:shen.reverse_help V2156 (quote ()))) (export reverse) (quote reverse)) +(begin (register-function-arity (quote shen.reverse_help) 2) (define (kl:shen.reverse_help V2159 V2160) (cond ((null? V2159) V2160) ((pair? V2159) (kl:shen.reverse_help (cdr V2159) (cons (car V2159) V2160))) (#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 V2163 V2164) (cond ((null? V2163) V2164) ((pair? V2163) (if (kl:element? (car V2163) V2164) (kl:union (cdr V2163) V2164) (cons (car V2163) (kl:union (cdr V2163) V2164)))) (#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? V2166) (let ((Message (kl:shen.prhush (kl:shen.proc-nl V2166) (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? V2166)))))))) (export y-or-n?) (quote y-or-n?)) +(begin (register-function-arity (quote not) 1) (define (kl:not V2168) (if (assert-boolean V2168) #f #t)) (export not) (quote not)) +(begin (register-function-arity (quote subst) 3) (define (kl:subst V2181 V2182 V2183) (cond ((kl:= V2183 V2182) V2181) ((pair? V2183) (kl:map (lambda (W) (kl:subst V2181 V2182 W)) V2183)) (#t V2183))) (export subst) (quote subst)) +(begin (register-function-arity (quote explode) 1) (define (kl:explode V2185) (kl:shen.explode-h (kl:shen.app V2185 "" (quote shen.a)))) (export explode) (quote explode)) +(begin (register-function-arity (quote shen.explode-h) 1) (define (kl:shen.explode-h V2187) (cond ((equal? "" V2187) (quote ())) ((assert-boolean (kl:shen.+string? V2187)) (cons (make-string 1 (string-ref V2187 0)) (kl:shen.explode-h (string-tail V2187 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 V2189) (kl:set (quote *home-directory*) (if (equal? V2189 "") "" (kl:shen.app V2189 "/" (quote shen.a))))) (export cd) (quote cd)) +(begin (register-function-arity (quote shen.for-each) 2) (define (kl:shen.for-each V2192 V2193) (cond ((null? V2193) #t) ((pair? V2193) (let ((_ (V2192 (car V2193)))) (kl:shen.for-each V2192 (cdr V2193)))) (#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 V2198 V2199) (cond ((null? V2199) (quote ())) ((pair? V2199) (cons (V2198 (car V2199)) (kl:map V2198 (cdr V2199)))) (#t (V2198 V2199)))) (export map) (quote map)) +(begin (register-function-arity (quote length) 1) (define (kl:length V2201) (kl:shen.length-h V2201 0)) (export length) (quote length)) +(begin (register-function-arity (quote shen.length-h) 2) (define (kl:shen.length-h V2204 V2205) (cond ((null? V2204) V2205) (#t (kl:shen.length-h (cdr V2204) (+ V2205 1))))) (export shen.length-h) (quote shen.length-h)) +(begin (register-function-arity (quote occurrences) 2) (define (kl:occurrences V2217 V2218) (cond ((kl:= V2218 V2217) 1) ((pair? V2218) (+ (kl:occurrences V2217 (car V2218)) (kl:occurrences V2217 (cdr V2218)))) (#t 0))) (export occurrences) (quote occurrences)) +(begin (register-function-arity (quote nth) 2) (define (kl:nth V2225 V2226) (cond ((and (kl:= 1 V2225) (pair? V2226)) (car V2226)) ((pair? V2226) (kl:nth (- V2225 1) (cdr V2226))) (#t (simple-error (string-append "nth applied to " (kl:shen.app V2225 (string-append ", " (kl:shen.app V2226 "\n" (quote shen.a))) (quote shen.a))))))) (export nth) (quote nth)) +(begin (register-function-arity (quote integer?) 1) (define (kl:integer? V2228) (and (number? V2228) (assert-boolean (let ((Abs (kl:shen.abs V2228))) (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 V2230) (if (> V2230 0) V2230 (- 0 V2230))) (export shen.abs) (quote shen.abs)) +(begin (register-function-arity (quote shen.magless) 2) (define (kl:shen.magless V2233 V2234) (let ((Nx2 (* V2234 2))) (if (> Nx2 V2233) V2234 (kl:shen.magless V2233 Nx2)))) (export shen.magless) (quote shen.magless)) +(begin (register-function-arity (quote shen.integer-test?) 2) (define (kl:shen.integer-test? V2240 V2241) (cond ((kl:= 0 V2240) #t) ((> 1 V2240) #f) (#t (let ((Abs-N (- V2240 V2241))) (if (> 0 Abs-N) (kl:integer? V2240) (kl:shen.integer-test? Abs-N V2241)))))) (export shen.integer-test?) (quote shen.integer-test?)) +(begin (register-function-arity (quote mapcan) 2) (define (kl:mapcan V2246 V2247) (cond ((null? V2247) (quote ())) ((pair? V2247) (kl:append (V2246 (car V2247)) (kl:mapcan V2246 (cdr V2247)))) (#t (kl:shen.f_error (quote mapcan))))) (export mapcan) (quote mapcan)) +(begin (register-function-arity (quote ==) 2) (define (kl:== V2259 V2260) (cond ((kl:= V2260 V2259) #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? V3423) (and (kl:symbol? V3423) (assert-boolean (let ((Val (guard (lambda (E) (quote shen.this-symbol-is-unbound)) (kl:value V3423)))) (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 V3425) (cond ((equal? "" V3425) (quote ())) (#t (cons (string-ref (make-string 1 (string-ref V3425 0)) 0) (kl:shen.string->bytes (string-tail V3425 1)))))) (export shen.string->bytes) (quote shen.string->bytes)) -(begin (register-function-arity (quote maxinferences) 1) (define (kl:maxinferences V3427) (kl:set (quote shen.*maxinferences*) V3427)) (export maxinferences) (quote maxinferences)) +(begin (register-function-arity (quote bound?) 1) (define (kl:bound? V2262) (and (kl:symbol? V2262) (assert-boolean (let ((Val (guard (lambda (E) (quote shen.this-symbol-is-unbound)) (kl:value V2262)))) (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 V2264) (cond ((equal? "" V2264) (quote ())) (#t (cons (string-ref (make-string 1 (string-ref V2264 0)) 0) (kl:shen.string->bytes (string-tail V2264 1)))))) (export shen.string->bytes) (quote shen.string->bytes)) +(begin (register-function-arity (quote maxinferences) 1) (define (kl:maxinferences V2266) (kl:set (quote shen.*maxinferences*) V2266)) (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 V3429) V3429) (export protect) (quote protect)) +(begin (register-function-arity (quote protect) 1) (define (kl:protect V2268) V2268) (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 V3431) (let ((Symbol (kl:intern V3431))) (if (kl:symbol? Symbol) Symbol (simple-error (string-append "cannot intern " (kl:shen.app V3431 " to a symbol" (quote shen.s))))))) (export string->symbol) (quote string->symbol)) -(begin (register-function-arity (quote optimise) 1) (define (kl:optimise V3437) (cond ((eq? (quote +) V3437) (kl:set (quote shen.*optimise*) #t)) ((eq? (quote -) V3437) (kl:set (quote shen.*optimise*) #f)) (#t (simple-error "optimise expects a + or a -.\n")))) (export optimise) (quote optimise)) +(begin (register-function-arity (quote string->symbol) 1) (define (kl:string->symbol V2270) (let ((Symbol (kl:intern V2270))) (if (kl:symbol? Symbol) Symbol (simple-error (string-append "cannot intern " (kl:shen.app V2270 " to a symbol" (quote shen.s))))))) (export string->symbol) (quote string->symbol)) +(begin (register-function-arity (quote optimise) 1) (define (kl:optimise V2276) (cond ((eq? (quote +) V2276) (kl:set (quote shen.*optimise*) #t)) ((eq? (quote -) V2276) (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)) @@ -107,6 +107,6 @@ (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? V3439) (guard (lambda (E) #f) (begin (kl:external V3439) #t))) (export package?) (quote package?)) -(begin (register-function-arity (quote function) 1) (define (kl:function V3441) (kl:shen.lookup-func V3441)) (export function) (quote function)) -(begin (register-function-arity (quote shen.lookup-func) 1) (define (kl:shen.lookup-func V3443) (guard (lambda (E) (simple-error (kl:shen.app V3443 " has no lambda expansion\n" (quote shen.a)))) (kl:get V3443 (quote shen.lambda-form) (kl:value (quote *property-vector*))))) (export shen.lookup-func) (quote shen.lookup-func)) +(begin (register-function-arity (quote package?) 1) (define (kl:package? V2278) (guard (lambda (E) #f) (begin (kl:external V2278) #t))) (export package?) (quote package?)) +(begin (register-function-arity (quote function) 1) (define (kl:function V2280) (kl:shen.lookup-func V2280)) (export function) (quote function)) +(begin (register-function-arity (quote shen.lookup-func) 1) (define (kl:shen.lookup-func V2282) (guard (lambda (E) (simple-error (kl:shen.app V2282 " has no lambda expansion\n" (quote shen.a)))) (kl:get V2282 (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 926d9a7..0ed684e 100644 --- a/compiled/t-star.kl.ms +++ b/compiled/t-star.kl.ms @@ -1,47 +1,47 @@ (module "compiled/t-star.kl") "Copyright (c) 2010-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:\n\n1. Redistributions of source code must retain the above copyright notice,\nthis list of conditions and the following disclaimer.\n\n2. Redistributions in binary form must reproduce the above copyright notice,\nthis list of conditions and the following disclaimer in the documentation\nand/or other materials provided with the distribution.\n\n3. Neither the name of the copyright holder nor the names of its contributors\nmay be used to endorse or promote products derived from this software without\nspecific prior written permission.\n\nTHIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ''AS IS'' AND\nANY EXPRESS 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 THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE\nFOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL\nDAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR\nSERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER\nCAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,\nOR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE\nOF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.\n" -(begin (register-function-arity (quote shen.typecheck) 2) (define (kl:shen.typecheck V3834 V3835) (let ((Curry (kl:shen.curry V3834))) (let ((ProcessN (kl:shen.start-new-prolog-process))) (let ((Type (kl:shen.insert-prolog-variables (kl:shen.demodulate (kl:shen.curry-type V3835)) 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 V3837) (cond ((and (pair? V3837) (assert-boolean (kl:shen.special? (car V3837)))) (cons (car V3837) (kl:map (lambda (Y) (kl:shen.curry Y)) (cdr V3837)))) ((and (pair? V3837) (and (pair? (cdr V3837)) (assert-boolean (kl:shen.extraspecial? (car V3837))))) V3837) ((and (pair? V3837) (and (eq? (quote type) (car V3837)) (and (pair? (cdr V3837)) (and (pair? (cdr (cdr V3837))) (null? (cdr (cdr (cdr V3837)))))))) (cons (quote type) (cons (kl:shen.curry (car (cdr V3837))) (cdr (cdr V3837))))) ((and (pair? V3837) (and (pair? (cdr V3837)) (pair? (cdr (cdr V3837))))) (kl:shen.curry (cons (cons (car V3837) (cons (car (cdr V3837)) (quote ()))) (cdr (cdr V3837))))) ((and (pair? V3837) (and (pair? (cdr V3837)) (null? (cdr (cdr V3837))))) (cons (kl:shen.curry (car V3837)) (cons (kl:shen.curry (car (cdr V3837))) (quote ())))) (#t V3837))) (export shen.curry) (quote shen.curry)) -(begin (register-function-arity (quote shen.special?) 1) (define (kl:shen.special? V3839) (kl:element? V3839 (kl:value (quote shen.*special*)))) (export shen.special?) (quote shen.special?)) -(begin (register-function-arity (quote shen.extraspecial?) 1) (define (kl:shen.extraspecial? V3841) (kl:element? V3841 (kl:value (quote shen.*extraspecial*)))) (export shen.extraspecial?) (quote shen.extraspecial?)) -(begin (register-function-arity (quote shen.t*) 4) (define (kl:shen.t* V3846 V3847 V3848 V3849) (let ((Throwcontrol (kl:shen.catchpoint))) (kl:shen.cutpoint Throwcontrol (let ((Case (let ((Error (kl:shen.newpv V3848))) (begin (kl:shen.incinfs) (kl:fwhen (kl:shen.maxinfexceeded?) V3848 (lambda () (kl:bind Error (kl:shen.errormaxinfs) V3848 V3849))))))) (if (kl:= Case #f) (let ((Case (let ((V3826 (kl:shen.lazyderef V3846 V3848))) (if (eq? (quote fail) V3826) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V3848 (lambda () (kl:shen.prolog-failure V3848 V3849)))) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3827 (kl:shen.lazyderef V3846 V3848))) (if (pair? V3827) (let ((X (car V3827))) (let ((V3828 (kl:shen.lazyderef (cdr V3827) V3848))) (if (pair? V3828) (let ((V3829 (kl:shen.lazyderef (car V3828) V3848))) (if (eq? (quote :) V3829) (let ((V3830 (kl:shen.lazyderef (cdr V3828) V3848))) (if (pair? V3830) (let ((A (car V3830))) (let ((V3831 (kl:shen.lazyderef (cdr V3830) V3848))) (if (null? V3831) (begin (kl:shen.incinfs) (kl:fwhen (kl:shen.type-theory-enabled?) V3848 (lambda () (kl:cut Throwcontrol V3848 (lambda () (kl:shen.th* X A V3847 V3848 V3849)))))) #f))) #f)) #f)) #f))) #f)))) (if (kl:= Case #f) (let ((Datatypes (kl:shen.newpv V3848))) (begin (kl:shen.incinfs) (kl:shen.show V3846 V3847 V3848 (lambda () (kl:bind Datatypes (kl:value (quote shen.*datatypes*)) V3848 (lambda () (kl:shen.udefs* V3846 V3847 Datatypes V3848 V3849))))))) Case)) Case)) Case))))) (export shen.t*) (quote shen.t*)) +(begin (register-function-arity (quote shen.typecheck) 2) (define (kl:shen.typecheck V2673 V2674) (let ((Curry (kl:shen.curry V2673))) (let ((ProcessN (kl:shen.start-new-prolog-process))) (let ((Type (kl:shen.insert-prolog-variables (kl:shen.demodulate (kl:shen.curry-type V2674)) 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 V2676) (cond ((and (pair? V2676) (assert-boolean (kl:shen.special? (car V2676)))) (cons (car V2676) (kl:map (lambda (Y) (kl:shen.curry Y)) (cdr V2676)))) ((and (pair? V2676) (and (pair? (cdr V2676)) (assert-boolean (kl:shen.extraspecial? (car V2676))))) V2676) ((and (pair? V2676) (and (eq? (quote type) (car V2676)) (and (pair? (cdr V2676)) (and (pair? (cdr (cdr V2676))) (null? (cdr (cdr (cdr V2676)))))))) (cons (quote type) (cons (kl:shen.curry (car (cdr V2676))) (cdr (cdr V2676))))) ((and (pair? V2676) (and (pair? (cdr V2676)) (pair? (cdr (cdr V2676))))) (kl:shen.curry (cons (cons (car V2676) (cons (car (cdr V2676)) (quote ()))) (cdr (cdr V2676))))) ((and (pair? V2676) (and (pair? (cdr V2676)) (null? (cdr (cdr V2676))))) (cons (kl:shen.curry (car V2676)) (cons (kl:shen.curry (car (cdr V2676))) (quote ())))) (#t V2676))) (export shen.curry) (quote shen.curry)) +(begin (register-function-arity (quote shen.special?) 1) (define (kl:shen.special? V2678) (kl:element? V2678 (kl:value (quote shen.*special*)))) (export shen.special?) (quote shen.special?)) +(begin (register-function-arity (quote shen.extraspecial?) 1) (define (kl:shen.extraspecial? V2680) (kl:element? V2680 (kl:value (quote shen.*extraspecial*)))) (export shen.extraspecial?) (quote shen.extraspecial?)) +(begin (register-function-arity (quote shen.t*) 4) (define (kl:shen.t* V2685 V2686 V2687 V2688) (let ((Throwcontrol (kl:shen.catchpoint))) (kl:shen.cutpoint Throwcontrol (let ((Case (let ((Error (kl:shen.newpv V2687))) (begin (kl:shen.incinfs) (kl:fwhen (kl:shen.maxinfexceeded?) V2687 (lambda () (kl:bind Error (kl:shen.errormaxinfs) V2687 V2688))))))) (if (kl:= Case #f) (let ((Case (let ((V2665 (kl:shen.lazyderef V2685 V2687))) (if (eq? (quote fail) V2665) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V2687 (lambda () (kl:shen.prolog-failure V2687 V2688)))) #f)))) (if (kl:= Case #f) (let ((Case (let ((V2666 (kl:shen.lazyderef V2685 V2687))) (if (pair? V2666) (let ((X (car V2666))) (let ((V2667 (kl:shen.lazyderef (cdr V2666) V2687))) (if (pair? V2667) (let ((V2668 (kl:shen.lazyderef (car V2667) V2687))) (if (eq? (quote :) V2668) (let ((V2669 (kl:shen.lazyderef (cdr V2667) V2687))) (if (pair? V2669) (let ((A (car V2669))) (let ((V2670 (kl:shen.lazyderef (cdr V2669) V2687))) (if (null? V2670) (begin (kl:shen.incinfs) (kl:fwhen (kl:shen.type-theory-enabled?) V2687 (lambda () (kl:cut Throwcontrol V2687 (lambda () (kl:shen.th* X A V2686 V2687 V2688)))))) #f))) #f)) #f)) #f))) #f)))) (if (kl:= Case #f) (let ((Datatypes (kl:shen.newpv V2687))) (begin (kl:shen.incinfs) (kl:shen.show V2685 V2686 V2687 (lambda () (kl:bind Datatypes (kl:value (quote shen.*datatypes*)) V2687 (lambda () (kl:shen.udefs* V2685 V2686 Datatypes V2687 V2688))))))) 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 V3855) (cond ((eq? (quote +) V3855) (kl:set (quote shen.*shen-type-theory-enabled?*) #t)) ((eq? (quote -) V3855) (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 V3866 V3867) #f) (export shen.prolog-failure) (quote shen.prolog-failure)) +(begin (register-function-arity (quote enable-type-theory) 1) (define (kl:enable-type-theory V2694) (cond ((eq? (quote +) V2694) (kl:set (quote shen.*shen-type-theory-enabled?*) #t)) ((eq? (quote -) V2694) (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 V2705 V2706) #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* V3873 V3874 V3875 V3876 V3877) (let ((Case (let ((V3822 (kl:shen.lazyderef V3875 V3876))) (if (pair? V3822) (let ((D (car V3822))) (begin (kl:shen.incinfs) (kl:call (cons D (cons V3873 (cons V3874 (quote ())))) V3876 V3877))) #f)))) (if (kl:= Case #f) (let ((V3823 (kl:shen.lazyderef V3875 V3876))) (if (pair? V3823) (let ((Ds (cdr V3823))) (begin (kl:shen.incinfs) (kl:shen.udefs* V3873 V3874 Ds V3876 V3877))) #f)) Case))) (export shen.udefs*) (quote shen.udefs*)) -(begin (register-function-arity (quote shen.th*) 5) (define (kl:shen.th* V3883 V3884 V3885 V3886 V3887) (let ((Throwcontrol (kl:shen.catchpoint))) (kl:shen.cutpoint Throwcontrol (let ((Case (begin (kl:shen.incinfs) (kl:shen.show (cons V3883 (cons (quote :) (cons V3884 (quote ())))) V3885 V3886 (lambda () (kl:fwhen #f V3886 V3887)))))) (if (kl:= Case #f) (let ((Case (let ((F (kl:shen.newpv V3886))) (begin (kl:shen.incinfs) (kl:fwhen (kl:shen.typedf? (kl:shen.lazyderef V3883 V3886)) V3886 (lambda () (kl:bind F (kl:shen.sigf (kl:shen.lazyderef V3883 V3886)) V3886 (lambda () (kl:call (cons F (cons V3884 (quote ()))) V3886 V3887))))))))) (if (kl:= Case #f) (let ((Case (begin (kl:shen.incinfs) (kl:shen.base V3883 V3884 V3886 V3887)))) (if (kl:= Case #f) (let ((Case (begin (kl:shen.incinfs) (kl:shen.by_hypothesis V3883 V3884 V3885 V3886 V3887)))) (if (kl:= Case #f) (let ((Case (let ((V3718 (kl:shen.lazyderef V3883 V3886))) (if (pair? V3718) (let ((F (car V3718))) (let ((V3719 (kl:shen.lazyderef (cdr V3718) V3886))) (if (null? V3719) (begin (kl:shen.incinfs) (kl:shen.th* F (cons (quote -->) (cons V3884 (quote ()))) V3885 V3886 V3887)) #f))) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3720 (kl:shen.lazyderef V3883 V3886))) (if (pair? V3720) (let ((F (car V3720))) (let ((V3721 (kl:shen.lazyderef (cdr V3720) V3886))) (if (pair? V3721) (let ((X (car V3721))) (let ((V3722 (kl:shen.lazyderef (cdr V3721) V3886))) (if (null? V3722) (let ((B (kl:shen.newpv V3886))) (begin (kl:shen.incinfs) (kl:shen.th* F (cons B (cons (quote -->) (cons V3884 (quote ())))) V3885 V3886 (lambda () (kl:shen.th* X B V3885 V3886 V3887))))) #f))) #f))) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3723 (kl:shen.lazyderef V3883 V3886))) (if (pair? V3723) (let ((V3724 (kl:shen.lazyderef (car V3723) V3886))) (if (eq? (quote cons) V3724) (let ((V3725 (kl:shen.lazyderef (cdr V3723) V3886))) (if (pair? V3725) (let ((X (car V3725))) (let ((V3726 (kl:shen.lazyderef (cdr V3725) V3886))) (if (pair? V3726) (let ((Y (car V3726))) (let ((V3727 (kl:shen.lazyderef (cdr V3726) V3886))) (if (null? V3727) (let ((V3728 (kl:shen.lazyderef V3884 V3886))) (if (pair? V3728) (let ((V3729 (kl:shen.lazyderef (car V3728) V3886))) (if (eq? (quote list) V3729) (let ((V3730 (kl:shen.lazyderef (cdr V3728) V3886))) (if (pair? V3730) (let ((A (car V3730))) (let ((V3731 (kl:shen.lazyderef (cdr V3730) V3886))) (if (null? V3731) (begin (kl:shen.incinfs) (kl:shen.th* X A V3885 V3886 (lambda () (kl:shen.th* Y (cons (quote list) (cons A (quote ()))) V3885 V3886 V3887)))) (if (kl:shen.pvar? V3731) (begin (kl:shen.bindv V3731 (quote ()) V3886) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V3885 V3886 (lambda () (kl:shen.th* Y (cons (quote list) (cons A (quote ()))) V3885 V3886 V3887)))))) (begin (kl:shen.unbindv V3731 V3886) Result))) #f)))) (if (kl:shen.pvar? V3730) (let ((A (kl:shen.newpv V3886))) (begin (kl:shen.bindv V3730 (cons A (quote ())) V3886) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V3885 V3886 (lambda () (kl:shen.th* Y (cons (quote list) (cons A (quote ()))) V3885 V3886 V3887)))))) (begin (kl:shen.unbindv V3730 V3886) Result)))) #f))) (if (kl:shen.pvar? V3729) (begin (kl:shen.bindv V3729 (quote list) V3886) (let ((Result (let ((V3732 (kl:shen.lazyderef (cdr V3728) V3886))) (if (pair? V3732) (let ((A (car V3732))) (let ((V3733 (kl:shen.lazyderef (cdr V3732) V3886))) (if (null? V3733) (begin (kl:shen.incinfs) (kl:shen.th* X A V3885 V3886 (lambda () (kl:shen.th* Y (cons (quote list) (cons A (quote ()))) V3885 V3886 V3887)))) (if (kl:shen.pvar? V3733) (begin (kl:shen.bindv V3733 (quote ()) V3886) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V3885 V3886 (lambda () (kl:shen.th* Y (cons (quote list) (cons A (quote ()))) V3885 V3886 V3887)))))) (begin (kl:shen.unbindv V3733 V3886) Result))) #f)))) (if (kl:shen.pvar? V3732) (let ((A (kl:shen.newpv V3886))) (begin (kl:shen.bindv V3732 (cons A (quote ())) V3886) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V3885 V3886 (lambda () (kl:shen.th* Y (cons (quote list) (cons A (quote ()))) V3885 V3886 V3887)))))) (begin (kl:shen.unbindv V3732 V3886) Result)))) #f))))) (begin (kl:shen.unbindv V3729 V3886) Result))) #f))) (if (kl:shen.pvar? V3728) (let ((A (kl:shen.newpv V3886))) (begin (kl:shen.bindv V3728 (cons (quote list) (cons A (quote ()))) V3886) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V3885 V3886 (lambda () (kl:shen.th* Y (cons (quote list) (cons A (quote ()))) V3885 V3886 V3887)))))) (begin (kl:shen.unbindv V3728 V3886) Result)))) #f))) #f))) #f))) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3734 (kl:shen.lazyderef V3883 V3886))) (if (pair? V3734) (let ((V3735 (kl:shen.lazyderef (car V3734) V3886))) (if (eq? (quote _waspvm_at_p) V3735) (let ((V3736 (kl:shen.lazyderef (cdr V3734) V3886))) (if (pair? V3736) (let ((X (car V3736))) (let ((V3737 (kl:shen.lazyderef (cdr V3736) V3886))) (if (pair? V3737) (let ((Y (car V3737))) (let ((V3738 (kl:shen.lazyderef (cdr V3737) V3886))) (if (null? V3738) (let ((V3739 (kl:shen.lazyderef V3884 V3886))) (if (pair? V3739) (let ((A (car V3739))) (let ((V3740 (kl:shen.lazyderef (cdr V3739) V3886))) (if (pair? V3740) (let ((V3741 (kl:shen.lazyderef (car V3740) V3886))) (if (eq? (quote *) V3741) (let ((V3742 (kl:shen.lazyderef (cdr V3740) V3886))) (if (pair? V3742) (let ((B (car V3742))) (let ((V3743 (kl:shen.lazyderef (cdr V3742) V3886))) (if (null? V3743) (begin (kl:shen.incinfs) (kl:shen.th* X A V3885 V3886 (lambda () (kl:shen.th* Y B V3885 V3886 V3887)))) (if (kl:shen.pvar? V3743) (begin (kl:shen.bindv V3743 (quote ()) V3886) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V3885 V3886 (lambda () (kl:shen.th* Y B V3885 V3886 V3887)))))) (begin (kl:shen.unbindv V3743 V3886) Result))) #f)))) (if (kl:shen.pvar? V3742) (let ((B (kl:shen.newpv V3886))) (begin (kl:shen.bindv V3742 (cons B (quote ())) V3886) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V3885 V3886 (lambda () (kl:shen.th* Y B V3885 V3886 V3887)))))) (begin (kl:shen.unbindv V3742 V3886) Result)))) #f))) (if (kl:shen.pvar? V3741) (begin (kl:shen.bindv V3741 (quote *) V3886) (let ((Result (let ((V3744 (kl:shen.lazyderef (cdr V3740) V3886))) (if (pair? V3744) (let ((B (car V3744))) (let ((V3745 (kl:shen.lazyderef (cdr V3744) V3886))) (if (null? V3745) (begin (kl:shen.incinfs) (kl:shen.th* X A V3885 V3886 (lambda () (kl:shen.th* Y B V3885 V3886 V3887)))) (if (kl:shen.pvar? V3745) (begin (kl:shen.bindv V3745 (quote ()) V3886) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V3885 V3886 (lambda () (kl:shen.th* Y B V3885 V3886 V3887)))))) (begin (kl:shen.unbindv V3745 V3886) Result))) #f)))) (if (kl:shen.pvar? V3744) (let ((B (kl:shen.newpv V3886))) (begin (kl:shen.bindv V3744 (cons B (quote ())) V3886) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V3885 V3886 (lambda () (kl:shen.th* Y B V3885 V3886 V3887)))))) (begin (kl:shen.unbindv V3744 V3886) Result)))) #f))))) (begin (kl:shen.unbindv V3741 V3886) Result))) #f))) (if (kl:shen.pvar? V3740) (let ((B (kl:shen.newpv V3886))) (begin (kl:shen.bindv V3740 (cons (quote *) (cons B (quote ()))) V3886) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V3885 V3886 (lambda () (kl:shen.th* Y B V3885 V3886 V3887)))))) (begin (kl:shen.unbindv V3740 V3886) Result)))) #f)))) (if (kl:shen.pvar? V3739) (let ((A (kl:shen.newpv V3886))) (let ((B (kl:shen.newpv V3886))) (begin (kl:shen.bindv V3739 (cons A (cons (quote *) (cons B (quote ())))) V3886) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V3885 V3886 (lambda () (kl:shen.th* Y B V3885 V3886 V3887)))))) (begin (kl:shen.unbindv V3739 V3886) Result))))) #f))) #f))) #f))) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3746 (kl:shen.lazyderef V3883 V3886))) (if (pair? V3746) (let ((V3747 (kl:shen.lazyderef (car V3746) V3886))) (if (eq? (quote _waspvm_at_v) V3747) (let ((V3748 (kl:shen.lazyderef (cdr V3746) V3886))) (if (pair? V3748) (let ((X (car V3748))) (let ((V3749 (kl:shen.lazyderef (cdr V3748) V3886))) (if (pair? V3749) (let ((Y (car V3749))) (let ((V3750 (kl:shen.lazyderef (cdr V3749) V3886))) (if (null? V3750) (let ((V3751 (kl:shen.lazyderef V3884 V3886))) (if (pair? V3751) (let ((V3752 (kl:shen.lazyderef (car V3751) V3886))) (if (eq? (quote vector) V3752) (let ((V3753 (kl:shen.lazyderef (cdr V3751) V3886))) (if (pair? V3753) (let ((A (car V3753))) (let ((V3754 (kl:shen.lazyderef (cdr V3753) V3886))) (if (null? V3754) (begin (kl:shen.incinfs) (kl:shen.th* X A V3885 V3886 (lambda () (kl:shen.th* Y (cons (quote vector) (cons A (quote ()))) V3885 V3886 V3887)))) (if (kl:shen.pvar? V3754) (begin (kl:shen.bindv V3754 (quote ()) V3886) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V3885 V3886 (lambda () (kl:shen.th* Y (cons (quote vector) (cons A (quote ()))) V3885 V3886 V3887)))))) (begin (kl:shen.unbindv V3754 V3886) Result))) #f)))) (if (kl:shen.pvar? V3753) (let ((A (kl:shen.newpv V3886))) (begin (kl:shen.bindv V3753 (cons A (quote ())) V3886) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V3885 V3886 (lambda () (kl:shen.th* Y (cons (quote vector) (cons A (quote ()))) V3885 V3886 V3887)))))) (begin (kl:shen.unbindv V3753 V3886) Result)))) #f))) (if (kl:shen.pvar? V3752) (begin (kl:shen.bindv V3752 (quote vector) V3886) (let ((Result (let ((V3755 (kl:shen.lazyderef (cdr V3751) V3886))) (if (pair? V3755) (let ((A (car V3755))) (let ((V3756 (kl:shen.lazyderef (cdr V3755) V3886))) (if (null? V3756) (begin (kl:shen.incinfs) (kl:shen.th* X A V3885 V3886 (lambda () (kl:shen.th* Y (cons (quote vector) (cons A (quote ()))) V3885 V3886 V3887)))) (if (kl:shen.pvar? V3756) (begin (kl:shen.bindv V3756 (quote ()) V3886) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V3885 V3886 (lambda () (kl:shen.th* Y (cons (quote vector) (cons A (quote ()))) V3885 V3886 V3887)))))) (begin (kl:shen.unbindv V3756 V3886) Result))) #f)))) (if (kl:shen.pvar? V3755) (let ((A (kl:shen.newpv V3886))) (begin (kl:shen.bindv V3755 (cons A (quote ())) V3886) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V3885 V3886 (lambda () (kl:shen.th* Y (cons (quote vector) (cons A (quote ()))) V3885 V3886 V3887)))))) (begin (kl:shen.unbindv V3755 V3886) Result)))) #f))))) (begin (kl:shen.unbindv V3752 V3886) Result))) #f))) (if (kl:shen.pvar? V3751) (let ((A (kl:shen.newpv V3886))) (begin (kl:shen.bindv V3751 (cons (quote vector) (cons A (quote ()))) V3886) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V3885 V3886 (lambda () (kl:shen.th* Y (cons (quote vector) (cons A (quote ()))) V3885 V3886 V3887)))))) (begin (kl:shen.unbindv V3751 V3886) Result)))) #f))) #f))) #f))) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3757 (kl:shen.lazyderef V3883 V3886))) (if (pair? V3757) (let ((V3758 (kl:shen.lazyderef (car V3757) V3886))) (if (eq? (quote _waspvm_at_s) V3758) (let ((V3759 (kl:shen.lazyderef (cdr V3757) V3886))) (if (pair? V3759) (let ((X (car V3759))) (let ((V3760 (kl:shen.lazyderef (cdr V3759) V3886))) (if (pair? V3760) (let ((Y (car V3760))) (let ((V3761 (kl:shen.lazyderef (cdr V3760) V3886))) (if (null? V3761) (let ((V3762 (kl:shen.lazyderef V3884 V3886))) (if (eq? (quote string) V3762) (begin (kl:shen.incinfs) (kl:shen.th* X (quote string) V3885 V3886 (lambda () (kl:shen.th* Y (quote string) V3885 V3886 V3887)))) (if (kl:shen.pvar? V3762) (begin (kl:shen.bindv V3762 (quote string) V3886) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X (quote string) V3885 V3886 (lambda () (kl:shen.th* Y (quote string) V3885 V3886 V3887)))))) (begin (kl:shen.unbindv V3762 V3886) Result))) #f))) #f))) #f))) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3763 (kl:shen.lazyderef V3883 V3886))) (if (pair? V3763) (let ((V3764 (kl:shen.lazyderef (car V3763) V3886))) (if (eq? (quote lambda) V3764) (let ((V3765 (kl:shen.lazyderef (cdr V3763) V3886))) (if (pair? V3765) (let ((X (car V3765))) (let ((V3766 (kl:shen.lazyderef (cdr V3765) V3886))) (if (pair? V3766) (let ((Y (car V3766))) (let ((V3767 (kl:shen.lazyderef (cdr V3766) V3886))) (if (null? V3767) (let ((V3768 (kl:shen.lazyderef V3884 V3886))) (if (pair? V3768) (let ((A (car V3768))) (let ((V3769 (kl:shen.lazyderef (cdr V3768) V3886))) (if (pair? V3769) (let ((V3770 (kl:shen.lazyderef (car V3769) V3886))) (if (eq? (quote -->) V3770) (let ((V3771 (kl:shen.lazyderef (cdr V3769) V3886))) (if (pair? V3771) (let ((B (car V3771))) (let ((V3772 (kl:shen.lazyderef (cdr V3771) V3886))) (if (null? V3772) (let ((Z (kl:shen.newpv V3886))) (let ((X&& (kl:shen.newpv V3886))) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V3886 (lambda () (kl:bind X&& (kl:shen.placeholder) V3886 (lambda () (kl:bind Z (kl:shen.ebr (kl:shen.lazyderef X&& V3886) (kl:shen.lazyderef X V3886) (kl:shen.lazyderef Y V3886)) V3886 (lambda () (kl:shen.th* Z B (cons (cons X&& (cons (quote :) (cons A (quote ())))) V3885) V3886 V3887)))))))))) (if (kl:shen.pvar? V3772) (begin (kl:shen.bindv V3772 (quote ()) V3886) (let ((Result (let ((Z (kl:shen.newpv V3886))) (let ((X&& (kl:shen.newpv V3886))) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V3886 (lambda () (kl:bind X&& (kl:shen.placeholder) V3886 (lambda () (kl:bind Z (kl:shen.ebr (kl:shen.lazyderef X&& V3886) (kl:shen.lazyderef X V3886) (kl:shen.lazyderef Y V3886)) V3886 (lambda () (kl:shen.th* Z B (cons (cons X&& (cons (quote :) (cons A (quote ())))) V3885) V3886 V3887)))))))))))) (begin (kl:shen.unbindv V3772 V3886) Result))) #f)))) (if (kl:shen.pvar? V3771) (let ((B (kl:shen.newpv V3886))) (begin (kl:shen.bindv V3771 (cons B (quote ())) V3886) (let ((Result (let ((Z (kl:shen.newpv V3886))) (let ((X&& (kl:shen.newpv V3886))) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V3886 (lambda () (kl:bind X&& (kl:shen.placeholder) V3886 (lambda () (kl:bind Z (kl:shen.ebr (kl:shen.lazyderef X&& V3886) (kl:shen.lazyderef X V3886) (kl:shen.lazyderef Y V3886)) V3886 (lambda () (kl:shen.th* Z B (cons (cons X&& (cons (quote :) (cons A (quote ())))) V3885) V3886 V3887)))))))))))) (begin (kl:shen.unbindv V3771 V3886) Result)))) #f))) (if (kl:shen.pvar? V3770) (begin (kl:shen.bindv V3770 (quote -->) V3886) (let ((Result (let ((V3773 (kl:shen.lazyderef (cdr V3769) V3886))) (if (pair? V3773) (let ((B (car V3773))) (let ((V3774 (kl:shen.lazyderef (cdr V3773) V3886))) (if (null? V3774) (let ((Z (kl:shen.newpv V3886))) (let ((X&& (kl:shen.newpv V3886))) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V3886 (lambda () (kl:bind X&& (kl:shen.placeholder) V3886 (lambda () (kl:bind Z (kl:shen.ebr (kl:shen.lazyderef X&& V3886) (kl:shen.lazyderef X V3886) (kl:shen.lazyderef Y V3886)) V3886 (lambda () (kl:shen.th* Z B (cons (cons X&& (cons (quote :) (cons A (quote ())))) V3885) V3886 V3887)))))))))) (if (kl:shen.pvar? V3774) (begin (kl:shen.bindv V3774 (quote ()) V3886) (let ((Result (let ((Z (kl:shen.newpv V3886))) (let ((X&& (kl:shen.newpv V3886))) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V3886 (lambda () (kl:bind X&& (kl:shen.placeholder) V3886 (lambda () (kl:bind Z (kl:shen.ebr (kl:shen.lazyderef X&& V3886) (kl:shen.lazyderef X V3886) (kl:shen.lazyderef Y V3886)) V3886 (lambda () (kl:shen.th* Z B (cons (cons X&& (cons (quote :) (cons A (quote ())))) V3885) V3886 V3887)))))))))))) (begin (kl:shen.unbindv V3774 V3886) Result))) #f)))) (if (kl:shen.pvar? V3773) (let ((B (kl:shen.newpv V3886))) (begin (kl:shen.bindv V3773 (cons B (quote ())) V3886) (let ((Result (let ((Z (kl:shen.newpv V3886))) (let ((X&& (kl:shen.newpv V3886))) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V3886 (lambda () (kl:bind X&& (kl:shen.placeholder) V3886 (lambda () (kl:bind Z (kl:shen.ebr (kl:shen.lazyderef X&& V3886) (kl:shen.lazyderef X V3886) (kl:shen.lazyderef Y V3886)) V3886 (lambda () (kl:shen.th* Z B (cons (cons X&& (cons (quote :) (cons A (quote ())))) V3885) V3886 V3887)))))))))))) (begin (kl:shen.unbindv V3773 V3886) Result)))) #f))))) (begin (kl:shen.unbindv V3770 V3886) Result))) #f))) (if (kl:shen.pvar? V3769) (let ((B (kl:shen.newpv V3886))) (begin (kl:shen.bindv V3769 (cons (quote -->) (cons B (quote ()))) V3886) (let ((Result (let ((Z (kl:shen.newpv V3886))) (let ((X&& (kl:shen.newpv V3886))) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V3886 (lambda () (kl:bind X&& (kl:shen.placeholder) V3886 (lambda () (kl:bind Z (kl:shen.ebr (kl:shen.lazyderef X&& V3886) (kl:shen.lazyderef X V3886) (kl:shen.lazyderef Y V3886)) V3886 (lambda () (kl:shen.th* Z B (cons (cons X&& (cons (quote :) (cons A (quote ())))) V3885) V3886 V3887)))))))))))) (begin (kl:shen.unbindv V3769 V3886) Result)))) #f)))) (if (kl:shen.pvar? V3768) (let ((A (kl:shen.newpv V3886))) (let ((B (kl:shen.newpv V3886))) (begin (kl:shen.bindv V3768 (cons A (cons (quote -->) (cons B (quote ())))) V3886) (let ((Result (let ((Z (kl:shen.newpv V3886))) (let ((X&& (kl:shen.newpv V3886))) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V3886 (lambda () (kl:bind X&& (kl:shen.placeholder) V3886 (lambda () (kl:bind Z (kl:shen.ebr (kl:shen.lazyderef X&& V3886) (kl:shen.lazyderef X V3886) (kl:shen.lazyderef Y V3886)) V3886 (lambda () (kl:shen.th* Z B (cons (cons X&& (cons (quote :) (cons A (quote ())))) V3885) V3886 V3887)))))))))))) (begin (kl:shen.unbindv V3768 V3886) Result))))) #f))) #f))) #f))) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3775 (kl:shen.lazyderef V3883 V3886))) (if (pair? V3775) (let ((V3776 (kl:shen.lazyderef (car V3775) V3886))) (if (eq? (quote let) V3776) (let ((V3777 (kl:shen.lazyderef (cdr V3775) V3886))) (if (pair? V3777) (let ((X (car V3777))) (let ((V3778 (kl:shen.lazyderef (cdr V3777) V3886))) (if (pair? V3778) (let ((Y (car V3778))) (let ((V3779 (kl:shen.lazyderef (cdr V3778) V3886))) (if (pair? V3779) (let ((Z (car V3779))) (let ((V3780 (kl:shen.lazyderef (cdr V3779) V3886))) (if (null? V3780) (let ((W (kl:shen.newpv V3886))) (let ((X&& (kl:shen.newpv V3886))) (let ((B (kl:shen.newpv V3886))) (begin (kl:shen.incinfs) (kl:shen.th* Y B V3885 V3886 (lambda () (kl:bind X&& (kl:shen.placeholder) V3886 (lambda () (kl:bind W (kl:shen.ebr (kl:shen.lazyderef X&& V3886) (kl:shen.lazyderef X V3886) (kl:shen.lazyderef Z V3886)) V3886 (lambda () (kl:shen.th* W V3884 (cons (cons X&& (cons (quote :) (cons B (quote ())))) V3885) V3886 V3887))))))))))) #f))) #f))) #f))) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3781 (kl:shen.lazyderef V3883 V3886))) (if (pair? V3781) (let ((V3782 (kl:shen.lazyderef (car V3781) V3886))) (if (eq? (quote open) V3782) (let ((V3783 (kl:shen.lazyderef (cdr V3781) V3886))) (if (pair? V3783) (let ((FileName (car V3783))) (let ((V3784 (kl:shen.lazyderef (cdr V3783) V3886))) (if (pair? V3784) (let ((Direction3714 (car V3784))) (let ((V3785 (kl:shen.lazyderef (cdr V3784) V3886))) (if (null? V3785) (let ((V3786 (kl:shen.lazyderef V3884 V3886))) (if (pair? V3786) (let ((V3787 (kl:shen.lazyderef (car V3786) V3886))) (if (eq? (quote stream) V3787) (let ((V3788 (kl:shen.lazyderef (cdr V3786) V3886))) (if (pair? V3788) (let ((Direction (car V3788))) (let ((V3789 (kl:shen.lazyderef (cdr V3788) V3886))) (if (null? V3789) (begin (kl:shen.incinfs) (kl:unify! Direction Direction3714 V3886 (lambda () (kl:cut Throwcontrol V3886 (lambda () (kl:fwhen (kl:element? (kl:shen.lazyderef Direction V3886) (cons (quote in) (cons (quote out) (quote ())))) V3886 (lambda () (kl:shen.th* FileName (quote string) V3885 V3886 V3887)))))))) (if (kl:shen.pvar? V3789) (begin (kl:shen.bindv V3789 (quote ()) V3886) (let ((Result (begin (kl:shen.incinfs) (kl:unify! Direction Direction3714 V3886 (lambda () (kl:cut Throwcontrol V3886 (lambda () (kl:fwhen (kl:element? (kl:shen.lazyderef Direction V3886) (cons (quote in) (cons (quote out) (quote ())))) V3886 (lambda () (kl:shen.th* FileName (quote string) V3885 V3886 V3887)))))))))) (begin (kl:shen.unbindv V3789 V3886) Result))) #f)))) (if (kl:shen.pvar? V3788) (let ((Direction (kl:shen.newpv V3886))) (begin (kl:shen.bindv V3788 (cons Direction (quote ())) V3886) (let ((Result (begin (kl:shen.incinfs) (kl:unify! Direction Direction3714 V3886 (lambda () (kl:cut Throwcontrol V3886 (lambda () (kl:fwhen (kl:element? (kl:shen.lazyderef Direction V3886) (cons (quote in) (cons (quote out) (quote ())))) V3886 (lambda () (kl:shen.th* FileName (quote string) V3885 V3886 V3887)))))))))) (begin (kl:shen.unbindv V3788 V3886) Result)))) #f))) (if (kl:shen.pvar? V3787) (begin (kl:shen.bindv V3787 (quote stream) V3886) (let ((Result (let ((V3790 (kl:shen.lazyderef (cdr V3786) V3886))) (if (pair? V3790) (let ((Direction (car V3790))) (let ((V3791 (kl:shen.lazyderef (cdr V3790) V3886))) (if (null? V3791) (begin (kl:shen.incinfs) (kl:unify! Direction Direction3714 V3886 (lambda () (kl:cut Throwcontrol V3886 (lambda () (kl:fwhen (kl:element? (kl:shen.lazyderef Direction V3886) (cons (quote in) (cons (quote out) (quote ())))) V3886 (lambda () (kl:shen.th* FileName (quote string) V3885 V3886 V3887)))))))) (if (kl:shen.pvar? V3791) (begin (kl:shen.bindv V3791 (quote ()) V3886) (let ((Result (begin (kl:shen.incinfs) (kl:unify! Direction Direction3714 V3886 (lambda () (kl:cut Throwcontrol V3886 (lambda () (kl:fwhen (kl:element? (kl:shen.lazyderef Direction V3886) (cons (quote in) (cons (quote out) (quote ())))) V3886 (lambda () (kl:shen.th* FileName (quote string) V3885 V3886 V3887)))))))))) (begin (kl:shen.unbindv V3791 V3886) Result))) #f)))) (if (kl:shen.pvar? V3790) (let ((Direction (kl:shen.newpv V3886))) (begin (kl:shen.bindv V3790 (cons Direction (quote ())) V3886) (let ((Result (begin (kl:shen.incinfs) (kl:unify! Direction Direction3714 V3886 (lambda () (kl:cut Throwcontrol V3886 (lambda () (kl:fwhen (kl:element? (kl:shen.lazyderef Direction V3886) (cons (quote in) (cons (quote out) (quote ())))) V3886 (lambda () (kl:shen.th* FileName (quote string) V3885 V3886 V3887)))))))))) (begin (kl:shen.unbindv V3790 V3886) Result)))) #f))))) (begin (kl:shen.unbindv V3787 V3886) Result))) #f))) (if (kl:shen.pvar? V3786) (let ((Direction (kl:shen.newpv V3886))) (begin (kl:shen.bindv V3786 (cons (quote stream) (cons Direction (quote ()))) V3886) (let ((Result (begin (kl:shen.incinfs) (kl:unify! Direction Direction3714 V3886 (lambda () (kl:cut Throwcontrol V3886 (lambda () (kl:fwhen (kl:element? (kl:shen.lazyderef Direction V3886) (cons (quote in) (cons (quote out) (quote ())))) V3886 (lambda () (kl:shen.th* FileName (quote string) V3885 V3886 V3887)))))))))) (begin (kl:shen.unbindv V3786 V3886) Result)))) #f))) #f))) #f))) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3792 (kl:shen.lazyderef V3883 V3886))) (if (pair? V3792) (let ((V3793 (kl:shen.lazyderef (car V3792) V3886))) (if (eq? (quote type) V3793) (let ((V3794 (kl:shen.lazyderef (cdr V3792) V3886))) (if (pair? V3794) (let ((X (car V3794))) (let ((V3795 (kl:shen.lazyderef (cdr V3794) V3886))) (if (pair? V3795) (let ((A (car V3795))) (let ((V3796 (kl:shen.lazyderef (cdr V3795) V3886))) (if (null? V3796) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V3886 (lambda () (kl:unify A V3884 V3886 (lambda () (kl:shen.th* X A V3885 V3886 V3887)))))) #f))) #f))) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3797 (kl:shen.lazyderef V3883 V3886))) (if (pair? V3797) (let ((V3798 (kl:shen.lazyderef (car V3797) V3886))) (if (eq? (quote input+) V3798) (let ((V3799 (kl:shen.lazyderef (cdr V3797) V3886))) (if (pair? V3799) (let ((A (car V3799))) (let ((V3800 (kl:shen.lazyderef (cdr V3799) V3886))) (if (pair? V3800) (let ((Stream (car V3800))) (let ((V3801 (kl:shen.lazyderef (cdr V3800) V3886))) (if (null? V3801) (let ((C (kl:shen.newpv V3886))) (begin (kl:shen.incinfs) (kl:bind C (kl:shen.demodulate (kl:shen.lazyderef A V3886)) V3886 (lambda () (kl:unify V3884 C V3886 (lambda () (kl:shen.th* Stream (cons (quote stream) (cons (quote in) (quote ()))) V3885 V3886 V3887))))))) #f))) #f))) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3802 (kl:shen.lazyderef V3883 V3886))) (if (pair? V3802) (let ((V3803 (kl:shen.lazyderef (car V3802) V3886))) (if (eq? (quote set) V3803) (let ((V3804 (kl:shen.lazyderef (cdr V3802) V3886))) (if (pair? V3804) (let ((Var (car V3804))) (let ((V3805 (kl:shen.lazyderef (cdr V3804) V3886))) (if (pair? V3805) (let ((Val (car V3805))) (let ((V3806 (kl:shen.lazyderef (cdr V3805) V3886))) (if (null? V3806) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V3886 (lambda () (kl:shen.th* Var (quote symbol) V3885 V3886 (lambda () (kl:cut Throwcontrol V3886 (lambda () (kl:shen.th* (cons (quote value) (cons Var (quote ()))) V3884 V3885 V3886 (lambda () (kl:shen.th* Val V3884 V3885 V3886 V3887)))))))))) #f))) #f))) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((NewHyp (kl:shen.newpv V3886))) (begin (kl:shen.incinfs) (kl:shen.t*-hyps V3885 NewHyp V3886 (lambda () (kl:shen.th* V3883 V3884 NewHyp V3886 V3887))))))) (if (kl:= Case #f) (let ((Case (let ((V3807 (kl:shen.lazyderef V3883 V3886))) (if (pair? V3807) (let ((V3808 (kl:shen.lazyderef (car V3807) V3886))) (if (eq? (quote define) V3808) (let ((V3809 (kl:shen.lazyderef (cdr V3807) V3886))) (if (pair? V3809) (let ((F (car V3809))) (let ((X (cdr V3809))) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V3886 (lambda () (kl:shen.t*-def (cons (quote define) (cons F X)) V3884 V3885 V3886 V3887)))))) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3810 (kl:shen.lazyderef V3883 V3886))) (if (pair? V3810) (let ((V3811 (kl:shen.lazyderef (car V3810) V3886))) (if (eq? (quote defmacro) V3811) (let ((V3812 (kl:shen.lazyderef V3884 V3886))) (if (eq? (quote unit) V3812) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V3886 V3887)) (if (kl:shen.pvar? V3812) (begin (kl:shen.bindv V3812 (quote unit) V3886) (let ((Result (begin (kl:shen.incinfs) (kl:cut Throwcontrol V3886 V3887)))) (begin (kl:shen.unbindv V3812 V3886) Result))) #f))) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3813 (kl:shen.lazyderef V3883 V3886))) (if (pair? V3813) (let ((V3814 (kl:shen.lazyderef (car V3813) V3886))) (if (eq? (quote shen.process-datatype) V3814) (let ((V3815 (kl:shen.lazyderef V3884 V3886))) (if (eq? (quote symbol) V3815) (begin (kl:shen.incinfs) (kl:thaw V3887)) (if (kl:shen.pvar? V3815) (begin (kl:shen.bindv V3815 (quote symbol) V3886) (let ((Result (begin (kl:shen.incinfs) (kl:thaw V3887)))) (begin (kl:shen.unbindv V3815 V3886) Result))) #f))) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3816 (kl:shen.lazyderef V3883 V3886))) (if (pair? V3816) (let ((V3817 (kl:shen.lazyderef (car V3816) V3886))) (if (eq? (quote shen.synonyms-help) V3817) (let ((V3818 (kl:shen.lazyderef V3884 V3886))) (if (eq? (quote symbol) V3818) (begin (kl:shen.incinfs) (kl:thaw V3887)) (if (kl:shen.pvar? V3818) (begin (kl:shen.bindv V3818 (quote symbol) V3886) (let ((Result (begin (kl:shen.incinfs) (kl:thaw V3887)))) (begin (kl:shen.unbindv V3818 V3886) Result))) #f))) #f)) #f)))) (if (kl:= Case #f) (let ((Datatypes (kl:shen.newpv V3886))) (begin (kl:shen.incinfs) (kl:bind Datatypes (kl:value (quote shen.*datatypes*)) V3886 (lambda () (kl:shen.udefs* (cons V3883 (cons (quote :) (cons V3884 (quote ())))) V3885 Datatypes V3886 V3887))))) 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 V3892 V3893 V3894 V3895) (let ((Case (let ((V3629 (kl:shen.lazyderef V3892 V3894))) (if (pair? V3629) (let ((V3630 (kl:shen.lazyderef (car V3629) V3894))) (if (pair? V3630) (let ((V3631 (kl:shen.lazyderef (car V3630) V3894))) (if (pair? V3631) (let ((V3632 (kl:shen.lazyderef (car V3631) V3894))) (if (eq? (quote cons) V3632) (let ((V3633 (kl:shen.lazyderef (cdr V3631) V3894))) (if (pair? V3633) (let ((X (car V3633))) (let ((V3634 (kl:shen.lazyderef (cdr V3633) V3894))) (if (pair? V3634) (let ((Y (car V3634))) (let ((V3635 (kl:shen.lazyderef (cdr V3634) V3894))) (if (null? V3635) (let ((V3636 (kl:shen.lazyderef (cdr V3630) V3894))) (if (pair? V3636) (let ((V3637 (kl:shen.lazyderef (car V3636) V3894))) (if (eq? (quote :) V3637) (let ((V3638 (kl:shen.lazyderef (cdr V3636) V3894))) (if (pair? V3638) (let ((V3639 (kl:shen.lazyderef (car V3638) V3894))) (if (pair? V3639) (let ((V3640 (kl:shen.lazyderef (car V3639) V3894))) (if (eq? (quote list) V3640) (let ((V3641 (kl:shen.lazyderef (cdr V3639) V3894))) (if (pair? V3641) (let ((A (car V3641))) (let ((V3642 (kl:shen.lazyderef (cdr V3641) V3894))) (if (null? V3642) (let ((V3643 (kl:shen.lazyderef (cdr V3638) V3894))) (if (null? V3643) (let ((Hyp (cdr V3629))) (begin (kl:shen.incinfs) (kl:bind V3893 (cons (cons (kl:shen.lazyderef X V3894) (cons (quote :) (cons (kl:shen.lazyderef A V3894) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3894) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V3894) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3894))) V3894 V3895))) (if (kl:shen.pvar? V3643) (begin (kl:shen.bindv V3643 (quote ()) V3894) (let ((Result (let ((Hyp (cdr V3629))) (begin (kl:shen.incinfs) (kl:bind V3893 (cons (cons (kl:shen.lazyderef X V3894) (cons (quote :) (cons (kl:shen.lazyderef A V3894) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3894) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V3894) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3894))) V3894 V3895))))) (begin (kl:shen.unbindv V3643 V3894) Result))) #f))) (if (kl:shen.pvar? V3642) (begin (kl:shen.bindv V3642 (quote ()) V3894) (let ((Result (let ((V3644 (kl:shen.lazyderef (cdr V3638) V3894))) (if (null? V3644) (let ((Hyp (cdr V3629))) (begin (kl:shen.incinfs) (kl:bind V3893 (cons (cons (kl:shen.lazyderef X V3894) (cons (quote :) (cons (kl:shen.lazyderef A V3894) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3894) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V3894) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3894))) V3894 V3895))) (if (kl:shen.pvar? V3644) (begin (kl:shen.bindv V3644 (quote ()) V3894) (let ((Result (let ((Hyp (cdr V3629))) (begin (kl:shen.incinfs) (kl:bind V3893 (cons (cons (kl:shen.lazyderef X V3894) (cons (quote :) (cons (kl:shen.lazyderef A V3894) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3894) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V3894) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3894))) V3894 V3895))))) (begin (kl:shen.unbindv V3644 V3894) Result))) #f))))) (begin (kl:shen.unbindv V3642 V3894) Result))) #f)))) (if (kl:shen.pvar? V3641) (let ((A (kl:shen.newpv V3894))) (begin (kl:shen.bindv V3641 (cons A (quote ())) V3894) (let ((Result (let ((V3645 (kl:shen.lazyderef (cdr V3638) V3894))) (if (null? V3645) (let ((Hyp (cdr V3629))) (begin (kl:shen.incinfs) (kl:bind V3893 (cons (cons (kl:shen.lazyderef X V3894) (cons (quote :) (cons (kl:shen.lazyderef A V3894) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3894) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V3894) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3894))) V3894 V3895))) (if (kl:shen.pvar? V3645) (begin (kl:shen.bindv V3645 (quote ()) V3894) (let ((Result (let ((Hyp (cdr V3629))) (begin (kl:shen.incinfs) (kl:bind V3893 (cons (cons (kl:shen.lazyderef X V3894) (cons (quote :) (cons (kl:shen.lazyderef A V3894) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3894) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V3894) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3894))) V3894 V3895))))) (begin (kl:shen.unbindv V3645 V3894) Result))) #f))))) (begin (kl:shen.unbindv V3641 V3894) Result)))) #f))) (if (kl:shen.pvar? V3640) (begin (kl:shen.bindv V3640 (quote list) V3894) (let ((Result (let ((V3646 (kl:shen.lazyderef (cdr V3639) V3894))) (if (pair? V3646) (let ((A (car V3646))) (let ((V3647 (kl:shen.lazyderef (cdr V3646) V3894))) (if (null? V3647) (let ((V3648 (kl:shen.lazyderef (cdr V3638) V3894))) (if (null? V3648) (let ((Hyp (cdr V3629))) (begin (kl:shen.incinfs) (kl:bind V3893 (cons (cons (kl:shen.lazyderef X V3894) (cons (quote :) (cons (kl:shen.lazyderef A V3894) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3894) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V3894) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3894))) V3894 V3895))) (if (kl:shen.pvar? V3648) (begin (kl:shen.bindv V3648 (quote ()) V3894) (let ((Result (let ((Hyp (cdr V3629))) (begin (kl:shen.incinfs) (kl:bind V3893 (cons (cons (kl:shen.lazyderef X V3894) (cons (quote :) (cons (kl:shen.lazyderef A V3894) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3894) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V3894) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3894))) V3894 V3895))))) (begin (kl:shen.unbindv V3648 V3894) Result))) #f))) (if (kl:shen.pvar? V3647) (begin (kl:shen.bindv V3647 (quote ()) V3894) (let ((Result (let ((V3649 (kl:shen.lazyderef (cdr V3638) V3894))) (if (null? V3649) (let ((Hyp (cdr V3629))) (begin (kl:shen.incinfs) (kl:bind V3893 (cons (cons (kl:shen.lazyderef X V3894) (cons (quote :) (cons (kl:shen.lazyderef A V3894) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3894) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V3894) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3894))) V3894 V3895))) (if (kl:shen.pvar? V3649) (begin (kl:shen.bindv V3649 (quote ()) V3894) (let ((Result (let ((Hyp (cdr V3629))) (begin (kl:shen.incinfs) (kl:bind V3893 (cons (cons (kl:shen.lazyderef X V3894) (cons (quote :) (cons (kl:shen.lazyderef A V3894) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3894) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V3894) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3894))) V3894 V3895))))) (begin (kl:shen.unbindv V3649 V3894) Result))) #f))))) (begin (kl:shen.unbindv V3647 V3894) Result))) #f)))) (if (kl:shen.pvar? V3646) (let ((A (kl:shen.newpv V3894))) (begin (kl:shen.bindv V3646 (cons A (quote ())) V3894) (let ((Result (let ((V3650 (kl:shen.lazyderef (cdr V3638) V3894))) (if (null? V3650) (let ((Hyp (cdr V3629))) (begin (kl:shen.incinfs) (kl:bind V3893 (cons (cons (kl:shen.lazyderef X V3894) (cons (quote :) (cons (kl:shen.lazyderef A V3894) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3894) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V3894) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3894))) V3894 V3895))) (if (kl:shen.pvar? V3650) (begin (kl:shen.bindv V3650 (quote ()) V3894) (let ((Result (let ((Hyp (cdr V3629))) (begin (kl:shen.incinfs) (kl:bind V3893 (cons (cons (kl:shen.lazyderef X V3894) (cons (quote :) (cons (kl:shen.lazyderef A V3894) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3894) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V3894) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3894))) V3894 V3895))))) (begin (kl:shen.unbindv V3650 V3894) Result))) #f))))) (begin (kl:shen.unbindv V3646 V3894) Result)))) #f))))) (begin (kl:shen.unbindv V3640 V3894) Result))) #f))) (if (kl:shen.pvar? V3639) (let ((A (kl:shen.newpv V3894))) (begin (kl:shen.bindv V3639 (cons (quote list) (cons A (quote ()))) V3894) (let ((Result (let ((V3651 (kl:shen.lazyderef (cdr V3638) V3894))) (if (null? V3651) (let ((Hyp (cdr V3629))) (begin (kl:shen.incinfs) (kl:bind V3893 (cons (cons (kl:shen.lazyderef X V3894) (cons (quote :) (cons (kl:shen.lazyderef A V3894) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3894) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V3894) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3894))) V3894 V3895))) (if (kl:shen.pvar? V3651) (begin (kl:shen.bindv V3651 (quote ()) V3894) (let ((Result (let ((Hyp (cdr V3629))) (begin (kl:shen.incinfs) (kl:bind V3893 (cons (cons (kl:shen.lazyderef X V3894) (cons (quote :) (cons (kl:shen.lazyderef A V3894) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3894) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V3894) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3894))) V3894 V3895))))) (begin (kl:shen.unbindv V3651 V3894) Result))) #f))))) (begin (kl:shen.unbindv V3639 V3894) Result)))) #f))) #f)) #f)) #f)) #f))) #f))) #f)) #f)) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3652 (kl:shen.lazyderef V3892 V3894))) (if (pair? V3652) (let ((V3653 (kl:shen.lazyderef (car V3652) V3894))) (if (pair? V3653) (let ((V3654 (kl:shen.lazyderef (car V3653) V3894))) (if (pair? V3654) (let ((V3655 (kl:shen.lazyderef (car V3654) V3894))) (if (eq? (quote _waspvm_at_p) V3655) (let ((V3656 (kl:shen.lazyderef (cdr V3654) V3894))) (if (pair? V3656) (let ((X (car V3656))) (let ((V3657 (kl:shen.lazyderef (cdr V3656) V3894))) (if (pair? V3657) (let ((Y (car V3657))) (let ((V3658 (kl:shen.lazyderef (cdr V3657) V3894))) (if (null? V3658) (let ((V3659 (kl:shen.lazyderef (cdr V3653) V3894))) (if (pair? V3659) (let ((V3660 (kl:shen.lazyderef (car V3659) V3894))) (if (eq? (quote :) V3660) (let ((V3661 (kl:shen.lazyderef (cdr V3659) V3894))) (if (pair? V3661) (let ((V3662 (kl:shen.lazyderef (car V3661) V3894))) (if (pair? V3662) (let ((A (car V3662))) (let ((V3663 (kl:shen.lazyderef (cdr V3662) V3894))) (if (pair? V3663) (let ((V3664 (kl:shen.lazyderef (car V3663) V3894))) (if (eq? (quote *) V3664) (let ((V3665 (kl:shen.lazyderef (cdr V3663) V3894))) (if (pair? V3665) (let ((B (car V3665))) (let ((V3666 (kl:shen.lazyderef (cdr V3665) V3894))) (if (null? V3666) (let ((V3667 (kl:shen.lazyderef (cdr V3661) V3894))) (if (null? V3667) (let ((Hyp (cdr V3652))) (begin (kl:shen.incinfs) (kl:bind V3893 (cons (cons (kl:shen.lazyderef X V3894) (cons (quote :) (cons (kl:shen.lazyderef A V3894) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3894) (cons (quote :) (cons (kl:shen.lazyderef B V3894) (quote ())))) (kl:shen.lazyderef Hyp V3894))) V3894 V3895))) (if (kl:shen.pvar? V3667) (begin (kl:shen.bindv V3667 (quote ()) V3894) (let ((Result (let ((Hyp (cdr V3652))) (begin (kl:shen.incinfs) (kl:bind V3893 (cons (cons (kl:shen.lazyderef X V3894) (cons (quote :) (cons (kl:shen.lazyderef A V3894) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3894) (cons (quote :) (cons (kl:shen.lazyderef B V3894) (quote ())))) (kl:shen.lazyderef Hyp V3894))) V3894 V3895))))) (begin (kl:shen.unbindv V3667 V3894) Result))) #f))) (if (kl:shen.pvar? V3666) (begin (kl:shen.bindv V3666 (quote ()) V3894) (let ((Result (let ((V3668 (kl:shen.lazyderef (cdr V3661) V3894))) (if (null? V3668) (let ((Hyp (cdr V3652))) (begin (kl:shen.incinfs) (kl:bind V3893 (cons (cons (kl:shen.lazyderef X V3894) (cons (quote :) (cons (kl:shen.lazyderef A V3894) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3894) (cons (quote :) (cons (kl:shen.lazyderef B V3894) (quote ())))) (kl:shen.lazyderef Hyp V3894))) V3894 V3895))) (if (kl:shen.pvar? V3668) (begin (kl:shen.bindv V3668 (quote ()) V3894) (let ((Result (let ((Hyp (cdr V3652))) (begin (kl:shen.incinfs) (kl:bind V3893 (cons (cons (kl:shen.lazyderef X V3894) (cons (quote :) (cons (kl:shen.lazyderef A V3894) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3894) (cons (quote :) (cons (kl:shen.lazyderef B V3894) (quote ())))) (kl:shen.lazyderef Hyp V3894))) V3894 V3895))))) (begin (kl:shen.unbindv V3668 V3894) Result))) #f))))) (begin (kl:shen.unbindv V3666 V3894) Result))) #f)))) (if (kl:shen.pvar? V3665) (let ((B (kl:shen.newpv V3894))) (begin (kl:shen.bindv V3665 (cons B (quote ())) V3894) (let ((Result (let ((V3669 (kl:shen.lazyderef (cdr V3661) V3894))) (if (null? V3669) (let ((Hyp (cdr V3652))) (begin (kl:shen.incinfs) (kl:bind V3893 (cons (cons (kl:shen.lazyderef X V3894) (cons (quote :) (cons (kl:shen.lazyderef A V3894) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3894) (cons (quote :) (cons (kl:shen.lazyderef B V3894) (quote ())))) (kl:shen.lazyderef Hyp V3894))) V3894 V3895))) (if (kl:shen.pvar? V3669) (begin (kl:shen.bindv V3669 (quote ()) V3894) (let ((Result (let ((Hyp (cdr V3652))) (begin (kl:shen.incinfs) (kl:bind V3893 (cons (cons (kl:shen.lazyderef X V3894) (cons (quote :) (cons (kl:shen.lazyderef A V3894) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3894) (cons (quote :) (cons (kl:shen.lazyderef B V3894) (quote ())))) (kl:shen.lazyderef Hyp V3894))) V3894 V3895))))) (begin (kl:shen.unbindv V3669 V3894) Result))) #f))))) (begin (kl:shen.unbindv V3665 V3894) Result)))) #f))) (if (kl:shen.pvar? V3664) (begin (kl:shen.bindv V3664 (quote *) V3894) (let ((Result (let ((V3670 (kl:shen.lazyderef (cdr V3663) V3894))) (if (pair? V3670) (let ((B (car V3670))) (let ((V3671 (kl:shen.lazyderef (cdr V3670) V3894))) (if (null? V3671) (let ((V3672 (kl:shen.lazyderef (cdr V3661) V3894))) (if (null? V3672) (let ((Hyp (cdr V3652))) (begin (kl:shen.incinfs) (kl:bind V3893 (cons (cons (kl:shen.lazyderef X V3894) (cons (quote :) (cons (kl:shen.lazyderef A V3894) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3894) (cons (quote :) (cons (kl:shen.lazyderef B V3894) (quote ())))) (kl:shen.lazyderef Hyp V3894))) V3894 V3895))) (if (kl:shen.pvar? V3672) (begin (kl:shen.bindv V3672 (quote ()) V3894) (let ((Result (let ((Hyp (cdr V3652))) (begin (kl:shen.incinfs) (kl:bind V3893 (cons (cons (kl:shen.lazyderef X V3894) (cons (quote :) (cons (kl:shen.lazyderef A V3894) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3894) (cons (quote :) (cons (kl:shen.lazyderef B V3894) (quote ())))) (kl:shen.lazyderef Hyp V3894))) V3894 V3895))))) (begin (kl:shen.unbindv V3672 V3894) Result))) #f))) (if (kl:shen.pvar? V3671) (begin (kl:shen.bindv V3671 (quote ()) V3894) (let ((Result (let ((V3673 (kl:shen.lazyderef (cdr V3661) V3894))) (if (null? V3673) (let ((Hyp (cdr V3652))) (begin (kl:shen.incinfs) (kl:bind V3893 (cons (cons (kl:shen.lazyderef X V3894) (cons (quote :) (cons (kl:shen.lazyderef A V3894) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3894) (cons (quote :) (cons (kl:shen.lazyderef B V3894) (quote ())))) (kl:shen.lazyderef Hyp V3894))) V3894 V3895))) (if (kl:shen.pvar? V3673) (begin (kl:shen.bindv V3673 (quote ()) V3894) (let ((Result (let ((Hyp (cdr V3652))) (begin (kl:shen.incinfs) (kl:bind V3893 (cons (cons (kl:shen.lazyderef X V3894) (cons (quote :) (cons (kl:shen.lazyderef A V3894) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3894) (cons (quote :) (cons (kl:shen.lazyderef B V3894) (quote ())))) (kl:shen.lazyderef Hyp V3894))) V3894 V3895))))) (begin (kl:shen.unbindv V3673 V3894) Result))) #f))))) (begin (kl:shen.unbindv V3671 V3894) Result))) #f)))) (if (kl:shen.pvar? V3670) (let ((B (kl:shen.newpv V3894))) (begin (kl:shen.bindv V3670 (cons B (quote ())) V3894) (let ((Result (let ((V3674 (kl:shen.lazyderef (cdr V3661) V3894))) (if (null? V3674) (let ((Hyp (cdr V3652))) (begin (kl:shen.incinfs) (kl:bind V3893 (cons (cons (kl:shen.lazyderef X V3894) (cons (quote :) (cons (kl:shen.lazyderef A V3894) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3894) (cons (quote :) (cons (kl:shen.lazyderef B V3894) (quote ())))) (kl:shen.lazyderef Hyp V3894))) V3894 V3895))) (if (kl:shen.pvar? V3674) (begin (kl:shen.bindv V3674 (quote ()) V3894) (let ((Result (let ((Hyp (cdr V3652))) (begin (kl:shen.incinfs) (kl:bind V3893 (cons (cons (kl:shen.lazyderef X V3894) (cons (quote :) (cons (kl:shen.lazyderef A V3894) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3894) (cons (quote :) (cons (kl:shen.lazyderef B V3894) (quote ())))) (kl:shen.lazyderef Hyp V3894))) V3894 V3895))))) (begin (kl:shen.unbindv V3674 V3894) Result))) #f))))) (begin (kl:shen.unbindv V3670 V3894) Result)))) #f))))) (begin (kl:shen.unbindv V3664 V3894) Result))) #f))) (if (kl:shen.pvar? V3663) (let ((B (kl:shen.newpv V3894))) (begin (kl:shen.bindv V3663 (cons (quote *) (cons B (quote ()))) V3894) (let ((Result (let ((V3675 (kl:shen.lazyderef (cdr V3661) V3894))) (if (null? V3675) (let ((Hyp (cdr V3652))) (begin (kl:shen.incinfs) (kl:bind V3893 (cons (cons (kl:shen.lazyderef X V3894) (cons (quote :) (cons (kl:shen.lazyderef A V3894) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3894) (cons (quote :) (cons (kl:shen.lazyderef B V3894) (quote ())))) (kl:shen.lazyderef Hyp V3894))) V3894 V3895))) (if (kl:shen.pvar? V3675) (begin (kl:shen.bindv V3675 (quote ()) V3894) (let ((Result (let ((Hyp (cdr V3652))) (begin (kl:shen.incinfs) (kl:bind V3893 (cons (cons (kl:shen.lazyderef X V3894) (cons (quote :) (cons (kl:shen.lazyderef A V3894) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3894) (cons (quote :) (cons (kl:shen.lazyderef B V3894) (quote ())))) (kl:shen.lazyderef Hyp V3894))) V3894 V3895))))) (begin (kl:shen.unbindv V3675 V3894) Result))) #f))))) (begin (kl:shen.unbindv V3663 V3894) Result)))) #f)))) (if (kl:shen.pvar? V3662) (let ((A (kl:shen.newpv V3894))) (let ((B (kl:shen.newpv V3894))) (begin (kl:shen.bindv V3662 (cons A (cons (quote *) (cons B (quote ())))) V3894) (let ((Result (let ((V3676 (kl:shen.lazyderef (cdr V3661) V3894))) (if (null? V3676) (let ((Hyp (cdr V3652))) (begin (kl:shen.incinfs) (kl:bind V3893 (cons (cons (kl:shen.lazyderef X V3894) (cons (quote :) (cons (kl:shen.lazyderef A V3894) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3894) (cons (quote :) (cons (kl:shen.lazyderef B V3894) (quote ())))) (kl:shen.lazyderef Hyp V3894))) V3894 V3895))) (if (kl:shen.pvar? V3676) (begin (kl:shen.bindv V3676 (quote ()) V3894) (let ((Result (let ((Hyp (cdr V3652))) (begin (kl:shen.incinfs) (kl:bind V3893 (cons (cons (kl:shen.lazyderef X V3894) (cons (quote :) (cons (kl:shen.lazyderef A V3894) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3894) (cons (quote :) (cons (kl:shen.lazyderef B V3894) (quote ())))) (kl:shen.lazyderef Hyp V3894))) V3894 V3895))))) (begin (kl:shen.unbindv V3676 V3894) Result))) #f))))) (begin (kl:shen.unbindv V3662 V3894) Result))))) #f))) #f)) #f)) #f)) #f))) #f))) #f)) #f)) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3677 (kl:shen.lazyderef V3892 V3894))) (if (pair? V3677) (let ((V3678 (kl:shen.lazyderef (car V3677) V3894))) (if (pair? V3678) (let ((V3679 (kl:shen.lazyderef (car V3678) V3894))) (if (pair? V3679) (let ((V3680 (kl:shen.lazyderef (car V3679) V3894))) (if (eq? (quote _waspvm_at_v) V3680) (let ((V3681 (kl:shen.lazyderef (cdr V3679) V3894))) (if (pair? V3681) (let ((X (car V3681))) (let ((V3682 (kl:shen.lazyderef (cdr V3681) V3894))) (if (pair? V3682) (let ((Y (car V3682))) (let ((V3683 (kl:shen.lazyderef (cdr V3682) V3894))) (if (null? V3683) (let ((V3684 (kl:shen.lazyderef (cdr V3678) V3894))) (if (pair? V3684) (let ((V3685 (kl:shen.lazyderef (car V3684) V3894))) (if (eq? (quote :) V3685) (let ((V3686 (kl:shen.lazyderef (cdr V3684) V3894))) (if (pair? V3686) (let ((V3687 (kl:shen.lazyderef (car V3686) V3894))) (if (pair? V3687) (let ((V3688 (kl:shen.lazyderef (car V3687) V3894))) (if (eq? (quote vector) V3688) (let ((V3689 (kl:shen.lazyderef (cdr V3687) V3894))) (if (pair? V3689) (let ((A (car V3689))) (let ((V3690 (kl:shen.lazyderef (cdr V3689) V3894))) (if (null? V3690) (let ((V3691 (kl:shen.lazyderef (cdr V3686) V3894))) (if (null? V3691) (let ((Hyp (cdr V3677))) (begin (kl:shen.incinfs) (kl:bind V3893 (cons (cons (kl:shen.lazyderef X V3894) (cons (quote :) (cons (kl:shen.lazyderef A V3894) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3894) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V3894) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3894))) V3894 V3895))) (if (kl:shen.pvar? V3691) (begin (kl:shen.bindv V3691 (quote ()) V3894) (let ((Result (let ((Hyp (cdr V3677))) (begin (kl:shen.incinfs) (kl:bind V3893 (cons (cons (kl:shen.lazyderef X V3894) (cons (quote :) (cons (kl:shen.lazyderef A V3894) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3894) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V3894) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3894))) V3894 V3895))))) (begin (kl:shen.unbindv V3691 V3894) Result))) #f))) (if (kl:shen.pvar? V3690) (begin (kl:shen.bindv V3690 (quote ()) V3894) (let ((Result (let ((V3692 (kl:shen.lazyderef (cdr V3686) V3894))) (if (null? V3692) (let ((Hyp (cdr V3677))) (begin (kl:shen.incinfs) (kl:bind V3893 (cons (cons (kl:shen.lazyderef X V3894) (cons (quote :) (cons (kl:shen.lazyderef A V3894) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3894) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V3894) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3894))) V3894 V3895))) (if (kl:shen.pvar? V3692) (begin (kl:shen.bindv V3692 (quote ()) V3894) (let ((Result (let ((Hyp (cdr V3677))) (begin (kl:shen.incinfs) (kl:bind V3893 (cons (cons (kl:shen.lazyderef X V3894) (cons (quote :) (cons (kl:shen.lazyderef A V3894) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3894) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V3894) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3894))) V3894 V3895))))) (begin (kl:shen.unbindv V3692 V3894) Result))) #f))))) (begin (kl:shen.unbindv V3690 V3894) Result))) #f)))) (if (kl:shen.pvar? V3689) (let ((A (kl:shen.newpv V3894))) (begin (kl:shen.bindv V3689 (cons A (quote ())) V3894) (let ((Result (let ((V3693 (kl:shen.lazyderef (cdr V3686) V3894))) (if (null? V3693) (let ((Hyp (cdr V3677))) (begin (kl:shen.incinfs) (kl:bind V3893 (cons (cons (kl:shen.lazyderef X V3894) (cons (quote :) (cons (kl:shen.lazyderef A V3894) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3894) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V3894) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3894))) V3894 V3895))) (if (kl:shen.pvar? V3693) (begin (kl:shen.bindv V3693 (quote ()) V3894) (let ((Result (let ((Hyp (cdr V3677))) (begin (kl:shen.incinfs) (kl:bind V3893 (cons (cons (kl:shen.lazyderef X V3894) (cons (quote :) (cons (kl:shen.lazyderef A V3894) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3894) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V3894) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3894))) V3894 V3895))))) (begin (kl:shen.unbindv V3693 V3894) Result))) #f))))) (begin (kl:shen.unbindv V3689 V3894) Result)))) #f))) (if (kl:shen.pvar? V3688) (begin (kl:shen.bindv V3688 (quote vector) V3894) (let ((Result (let ((V3694 (kl:shen.lazyderef (cdr V3687) V3894))) (if (pair? V3694) (let ((A (car V3694))) (let ((V3695 (kl:shen.lazyderef (cdr V3694) V3894))) (if (null? V3695) (let ((V3696 (kl:shen.lazyderef (cdr V3686) V3894))) (if (null? V3696) (let ((Hyp (cdr V3677))) (begin (kl:shen.incinfs) (kl:bind V3893 (cons (cons (kl:shen.lazyderef X V3894) (cons (quote :) (cons (kl:shen.lazyderef A V3894) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3894) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V3894) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3894))) V3894 V3895))) (if (kl:shen.pvar? V3696) (begin (kl:shen.bindv V3696 (quote ()) V3894) (let ((Result (let ((Hyp (cdr V3677))) (begin (kl:shen.incinfs) (kl:bind V3893 (cons (cons (kl:shen.lazyderef X V3894) (cons (quote :) (cons (kl:shen.lazyderef A V3894) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3894) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V3894) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3894))) V3894 V3895))))) (begin (kl:shen.unbindv V3696 V3894) Result))) #f))) (if (kl:shen.pvar? V3695) (begin (kl:shen.bindv V3695 (quote ()) V3894) (let ((Result (let ((V3697 (kl:shen.lazyderef (cdr V3686) V3894))) (if (null? V3697) (let ((Hyp (cdr V3677))) (begin (kl:shen.incinfs) (kl:bind V3893 (cons (cons (kl:shen.lazyderef X V3894) (cons (quote :) (cons (kl:shen.lazyderef A V3894) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3894) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V3894) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3894))) V3894 V3895))) (if (kl:shen.pvar? V3697) (begin (kl:shen.bindv V3697 (quote ()) V3894) (let ((Result (let ((Hyp (cdr V3677))) (begin (kl:shen.incinfs) (kl:bind V3893 (cons (cons (kl:shen.lazyderef X V3894) (cons (quote :) (cons (kl:shen.lazyderef A V3894) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3894) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V3894) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3894))) V3894 V3895))))) (begin (kl:shen.unbindv V3697 V3894) Result))) #f))))) (begin (kl:shen.unbindv V3695 V3894) Result))) #f)))) (if (kl:shen.pvar? V3694) (let ((A (kl:shen.newpv V3894))) (begin (kl:shen.bindv V3694 (cons A (quote ())) V3894) (let ((Result (let ((V3698 (kl:shen.lazyderef (cdr V3686) V3894))) (if (null? V3698) (let ((Hyp (cdr V3677))) (begin (kl:shen.incinfs) (kl:bind V3893 (cons (cons (kl:shen.lazyderef X V3894) (cons (quote :) (cons (kl:shen.lazyderef A V3894) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3894) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V3894) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3894))) V3894 V3895))) (if (kl:shen.pvar? V3698) (begin (kl:shen.bindv V3698 (quote ()) V3894) (let ((Result (let ((Hyp (cdr V3677))) (begin (kl:shen.incinfs) (kl:bind V3893 (cons (cons (kl:shen.lazyderef X V3894) (cons (quote :) (cons (kl:shen.lazyderef A V3894) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3894) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V3894) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3894))) V3894 V3895))))) (begin (kl:shen.unbindv V3698 V3894) Result))) #f))))) (begin (kl:shen.unbindv V3694 V3894) Result)))) #f))))) (begin (kl:shen.unbindv V3688 V3894) Result))) #f))) (if (kl:shen.pvar? V3687) (let ((A (kl:shen.newpv V3894))) (begin (kl:shen.bindv V3687 (cons (quote vector) (cons A (quote ()))) V3894) (let ((Result (let ((V3699 (kl:shen.lazyderef (cdr V3686) V3894))) (if (null? V3699) (let ((Hyp (cdr V3677))) (begin (kl:shen.incinfs) (kl:bind V3893 (cons (cons (kl:shen.lazyderef X V3894) (cons (quote :) (cons (kl:shen.lazyderef A V3894) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3894) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V3894) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3894))) V3894 V3895))) (if (kl:shen.pvar? V3699) (begin (kl:shen.bindv V3699 (quote ()) V3894) (let ((Result (let ((Hyp (cdr V3677))) (begin (kl:shen.incinfs) (kl:bind V3893 (cons (cons (kl:shen.lazyderef X V3894) (cons (quote :) (cons (kl:shen.lazyderef A V3894) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3894) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V3894) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V3894))) V3894 V3895))))) (begin (kl:shen.unbindv V3699 V3894) Result))) #f))))) (begin (kl:shen.unbindv V3687 V3894) Result)))) #f))) #f)) #f)) #f)) #f))) #f))) #f)) #f)) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3700 (kl:shen.lazyderef V3892 V3894))) (if (pair? V3700) (let ((V3701 (kl:shen.lazyderef (car V3700) V3894))) (if (pair? V3701) (let ((V3702 (kl:shen.lazyderef (car V3701) V3894))) (if (pair? V3702) (let ((V3703 (kl:shen.lazyderef (car V3702) V3894))) (if (eq? (quote _waspvm_at_s) V3703) (let ((V3704 (kl:shen.lazyderef (cdr V3702) V3894))) (if (pair? V3704) (let ((X (car V3704))) (let ((V3705 (kl:shen.lazyderef (cdr V3704) V3894))) (if (pair? V3705) (let ((Y (car V3705))) (let ((V3706 (kl:shen.lazyderef (cdr V3705) V3894))) (if (null? V3706) (let ((V3707 (kl:shen.lazyderef (cdr V3701) V3894))) (if (pair? V3707) (let ((V3708 (kl:shen.lazyderef (car V3707) V3894))) (if (eq? (quote :) V3708) (let ((V3709 (kl:shen.lazyderef (cdr V3707) V3894))) (if (pair? V3709) (let ((V3710 (kl:shen.lazyderef (car V3709) V3894))) (if (eq? (quote string) V3710) (let ((V3711 (kl:shen.lazyderef (cdr V3709) V3894))) (if (null? V3711) (let ((Hyp (cdr V3700))) (begin (kl:shen.incinfs) (kl:bind V3893 (cons (cons (kl:shen.lazyderef X V3894) (cons (quote :) (cons (quote string) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3894) (cons (quote :) (cons (quote string) (quote ())))) (kl:shen.lazyderef Hyp V3894))) V3894 V3895))) (if (kl:shen.pvar? V3711) (begin (kl:shen.bindv V3711 (quote ()) V3894) (let ((Result (let ((Hyp (cdr V3700))) (begin (kl:shen.incinfs) (kl:bind V3893 (cons (cons (kl:shen.lazyderef X V3894) (cons (quote :) (cons (quote string) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3894) (cons (quote :) (cons (quote string) (quote ())))) (kl:shen.lazyderef Hyp V3894))) V3894 V3895))))) (begin (kl:shen.unbindv V3711 V3894) Result))) #f))) (if (kl:shen.pvar? V3710) (begin (kl:shen.bindv V3710 (quote string) V3894) (let ((Result (let ((V3712 (kl:shen.lazyderef (cdr V3709) V3894))) (if (null? V3712) (let ((Hyp (cdr V3700))) (begin (kl:shen.incinfs) (kl:bind V3893 (cons (cons (kl:shen.lazyderef X V3894) (cons (quote :) (cons (quote string) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3894) (cons (quote :) (cons (quote string) (quote ())))) (kl:shen.lazyderef Hyp V3894))) V3894 V3895))) (if (kl:shen.pvar? V3712) (begin (kl:shen.bindv V3712 (quote ()) V3894) (let ((Result (let ((Hyp (cdr V3700))) (begin (kl:shen.incinfs) (kl:bind V3893 (cons (cons (kl:shen.lazyderef X V3894) (cons (quote :) (cons (quote string) (quote ())))) (cons (cons (kl:shen.lazyderef Y V3894) (cons (quote :) (cons (quote string) (quote ())))) (kl:shen.lazyderef Hyp V3894))) V3894 V3895))))) (begin (kl:shen.unbindv V3712 V3894) Result))) #f))))) (begin (kl:shen.unbindv V3710 V3894) Result))) #f))) #f)) #f)) #f)) #f))) #f))) #f)) #f)) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((V3713 (kl:shen.lazyderef V3892 V3894))) (if (pair? V3713) (let ((X (car V3713))) (let ((Hyp (cdr V3713))) (let ((NewHyps (kl:shen.newpv V3894))) (begin (kl:shen.incinfs) (kl:bind V3893 (cons (kl:shen.lazyderef X V3894) (kl:shen.lazyderef NewHyps V3894)) V3894 (lambda () (kl:shen.t*-hyps Hyp NewHyps V3894 V3895))))))) #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 V3912 V3913 V3914 V3915) (cond ((assert-boolean (kl:value (quote shen.*spy*))) (begin (kl:shen.line) (begin (kl:shen.show-p (kl:shen.deref V3912 V3914)) (begin (kl:nl 1) (begin (kl:nl 1) (begin (kl:shen.show-assumptions (kl:shen.deref V3913 V3914) 1) (begin (kl:shen.prhush "\n> " (kl:stoutput)) (begin (kl:shen.pause-for-user) (kl:thaw V3915))))))))) (#t (kl:thaw V3915)))) (export shen.show) (quote shen.show)) +(begin (register-function-arity (quote shen.udefs*) 5) (define (kl:shen.udefs* V2712 V2713 V2714 V2715 V2716) (let ((Case (let ((V2661 (kl:shen.lazyderef V2714 V2715))) (if (pair? V2661) (let ((D (car V2661))) (begin (kl:shen.incinfs) (kl:call (cons D (cons V2712 (cons V2713 (quote ())))) V2715 V2716))) #f)))) (if (kl:= Case #f) (let ((V2662 (kl:shen.lazyderef V2714 V2715))) (if (pair? V2662) (let ((Ds (cdr V2662))) (begin (kl:shen.incinfs) (kl:shen.udefs* V2712 V2713 Ds V2715 V2716))) #f)) Case))) (export shen.udefs*) (quote shen.udefs*)) +(begin (register-function-arity (quote shen.th*) 5) (define (kl:shen.th* V2722 V2723 V2724 V2725 V2726) (let ((Throwcontrol (kl:shen.catchpoint))) (kl:shen.cutpoint Throwcontrol (let ((Case (begin (kl:shen.incinfs) (kl:shen.show (cons V2722 (cons (quote :) (cons V2723 (quote ())))) V2724 V2725 (lambda () (kl:fwhen #f V2725 V2726)))))) (if (kl:= Case #f) (let ((Case (let ((F (kl:shen.newpv V2725))) (begin (kl:shen.incinfs) (kl:fwhen (kl:shen.typedf? (kl:shen.lazyderef V2722 V2725)) V2725 (lambda () (kl:bind F (kl:shen.sigf (kl:shen.lazyderef V2722 V2725)) V2725 (lambda () (kl:call (cons F (cons V2723 (quote ()))) V2725 V2726))))))))) (if (kl:= Case #f) (let ((Case (begin (kl:shen.incinfs) (kl:shen.base V2722 V2723 V2725 V2726)))) (if (kl:= Case #f) (let ((Case (begin (kl:shen.incinfs) (kl:shen.by_hypothesis V2722 V2723 V2724 V2725 V2726)))) (if (kl:= Case #f) (let ((Case (let ((V2557 (kl:shen.lazyderef V2722 V2725))) (if (pair? V2557) (let ((F (car V2557))) (let ((V2558 (kl:shen.lazyderef (cdr V2557) V2725))) (if (null? V2558) (begin (kl:shen.incinfs) (kl:shen.th* F (cons (quote -->) (cons V2723 (quote ()))) V2724 V2725 V2726)) #f))) #f)))) (if (kl:= Case #f) (let ((Case (let ((V2559 (kl:shen.lazyderef V2722 V2725))) (if (pair? V2559) (let ((F (car V2559))) (let ((V2560 (kl:shen.lazyderef (cdr V2559) V2725))) (if (pair? V2560) (let ((X (car V2560))) (let ((V2561 (kl:shen.lazyderef (cdr V2560) V2725))) (if (null? V2561) (let ((B (kl:shen.newpv V2725))) (begin (kl:shen.incinfs) (kl:shen.th* F (cons B (cons (quote -->) (cons V2723 (quote ())))) V2724 V2725 (lambda () (kl:shen.th* X B V2724 V2725 V2726))))) #f))) #f))) #f)))) (if (kl:= Case #f) (let ((Case (let ((V2562 (kl:shen.lazyderef V2722 V2725))) (if (pair? V2562) (let ((V2563 (kl:shen.lazyderef (car V2562) V2725))) (if (eq? (quote cons) V2563) (let ((V2564 (kl:shen.lazyderef (cdr V2562) V2725))) (if (pair? V2564) (let ((X (car V2564))) (let ((V2565 (kl:shen.lazyderef (cdr V2564) V2725))) (if (pair? V2565) (let ((Y (car V2565))) (let ((V2566 (kl:shen.lazyderef (cdr V2565) V2725))) (if (null? V2566) (let ((V2567 (kl:shen.lazyderef V2723 V2725))) (if (pair? V2567) (let ((V2568 (kl:shen.lazyderef (car V2567) V2725))) (if (eq? (quote list) V2568) (let ((V2569 (kl:shen.lazyderef (cdr V2567) V2725))) (if (pair? V2569) (let ((A (car V2569))) (let ((V2570 (kl:shen.lazyderef (cdr V2569) V2725))) (if (null? V2570) (begin (kl:shen.incinfs) (kl:shen.th* X A V2724 V2725 (lambda () (kl:shen.th* Y (cons (quote list) (cons A (quote ()))) V2724 V2725 V2726)))) (if (kl:shen.pvar? V2570) (begin (kl:shen.bindv V2570 (quote ()) V2725) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V2724 V2725 (lambda () (kl:shen.th* Y (cons (quote list) (cons A (quote ()))) V2724 V2725 V2726)))))) (begin (kl:shen.unbindv V2570 V2725) Result))) #f)))) (if (kl:shen.pvar? V2569) (let ((A (kl:shen.newpv V2725))) (begin (kl:shen.bindv V2569 (cons A (quote ())) V2725) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V2724 V2725 (lambda () (kl:shen.th* Y (cons (quote list) (cons A (quote ()))) V2724 V2725 V2726)))))) (begin (kl:shen.unbindv V2569 V2725) Result)))) #f))) (if (kl:shen.pvar? V2568) (begin (kl:shen.bindv V2568 (quote list) V2725) (let ((Result (let ((V2571 (kl:shen.lazyderef (cdr V2567) V2725))) (if (pair? V2571) (let ((A (car V2571))) (let ((V2572 (kl:shen.lazyderef (cdr V2571) V2725))) (if (null? V2572) (begin (kl:shen.incinfs) (kl:shen.th* X A V2724 V2725 (lambda () (kl:shen.th* Y (cons (quote list) (cons A (quote ()))) V2724 V2725 V2726)))) (if (kl:shen.pvar? V2572) (begin (kl:shen.bindv V2572 (quote ()) V2725) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V2724 V2725 (lambda () (kl:shen.th* Y (cons (quote list) (cons A (quote ()))) V2724 V2725 V2726)))))) (begin (kl:shen.unbindv V2572 V2725) Result))) #f)))) (if (kl:shen.pvar? V2571) (let ((A (kl:shen.newpv V2725))) (begin (kl:shen.bindv V2571 (cons A (quote ())) V2725) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V2724 V2725 (lambda () (kl:shen.th* Y (cons (quote list) (cons A (quote ()))) V2724 V2725 V2726)))))) (begin (kl:shen.unbindv V2571 V2725) Result)))) #f))))) (begin (kl:shen.unbindv V2568 V2725) Result))) #f))) (if (kl:shen.pvar? V2567) (let ((A (kl:shen.newpv V2725))) (begin (kl:shen.bindv V2567 (cons (quote list) (cons A (quote ()))) V2725) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V2724 V2725 (lambda () (kl:shen.th* Y (cons (quote list) (cons A (quote ()))) V2724 V2725 V2726)))))) (begin (kl:shen.unbindv V2567 V2725) Result)))) #f))) #f))) #f))) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V2573 (kl:shen.lazyderef V2722 V2725))) (if (pair? V2573) (let ((V2574 (kl:shen.lazyderef (car V2573) V2725))) (if (eq? (quote _waspvm_at_p) V2574) (let ((V2575 (kl:shen.lazyderef (cdr V2573) V2725))) (if (pair? V2575) (let ((X (car V2575))) (let ((V2576 (kl:shen.lazyderef (cdr V2575) V2725))) (if (pair? V2576) (let ((Y (car V2576))) (let ((V2577 (kl:shen.lazyderef (cdr V2576) V2725))) (if (null? V2577) (let ((V2578 (kl:shen.lazyderef V2723 V2725))) (if (pair? V2578) (let ((A (car V2578))) (let ((V2579 (kl:shen.lazyderef (cdr V2578) V2725))) (if (pair? V2579) (let ((V2580 (kl:shen.lazyderef (car V2579) V2725))) (if (eq? (quote *) V2580) (let ((V2581 (kl:shen.lazyderef (cdr V2579) V2725))) (if (pair? V2581) (let ((B (car V2581))) (let ((V2582 (kl:shen.lazyderef (cdr V2581) V2725))) (if (null? V2582) (begin (kl:shen.incinfs) (kl:shen.th* X A V2724 V2725 (lambda () (kl:shen.th* Y B V2724 V2725 V2726)))) (if (kl:shen.pvar? V2582) (begin (kl:shen.bindv V2582 (quote ()) V2725) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V2724 V2725 (lambda () (kl:shen.th* Y B V2724 V2725 V2726)))))) (begin (kl:shen.unbindv V2582 V2725) Result))) #f)))) (if (kl:shen.pvar? V2581) (let ((B (kl:shen.newpv V2725))) (begin (kl:shen.bindv V2581 (cons B (quote ())) V2725) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V2724 V2725 (lambda () (kl:shen.th* Y B V2724 V2725 V2726)))))) (begin (kl:shen.unbindv V2581 V2725) Result)))) #f))) (if (kl:shen.pvar? V2580) (begin (kl:shen.bindv V2580 (quote *) V2725) (let ((Result (let ((V2583 (kl:shen.lazyderef (cdr V2579) V2725))) (if (pair? V2583) (let ((B (car V2583))) (let ((V2584 (kl:shen.lazyderef (cdr V2583) V2725))) (if (null? V2584) (begin (kl:shen.incinfs) (kl:shen.th* X A V2724 V2725 (lambda () (kl:shen.th* Y B V2724 V2725 V2726)))) (if (kl:shen.pvar? V2584) (begin (kl:shen.bindv V2584 (quote ()) V2725) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V2724 V2725 (lambda () (kl:shen.th* Y B V2724 V2725 V2726)))))) (begin (kl:shen.unbindv V2584 V2725) Result))) #f)))) (if (kl:shen.pvar? V2583) (let ((B (kl:shen.newpv V2725))) (begin (kl:shen.bindv V2583 (cons B (quote ())) V2725) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V2724 V2725 (lambda () (kl:shen.th* Y B V2724 V2725 V2726)))))) (begin (kl:shen.unbindv V2583 V2725) Result)))) #f))))) (begin (kl:shen.unbindv V2580 V2725) Result))) #f))) (if (kl:shen.pvar? V2579) (let ((B (kl:shen.newpv V2725))) (begin (kl:shen.bindv V2579 (cons (quote *) (cons B (quote ()))) V2725) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V2724 V2725 (lambda () (kl:shen.th* Y B V2724 V2725 V2726)))))) (begin (kl:shen.unbindv V2579 V2725) Result)))) #f)))) (if (kl:shen.pvar? V2578) (let ((A (kl:shen.newpv V2725))) (let ((B (kl:shen.newpv V2725))) (begin (kl:shen.bindv V2578 (cons A (cons (quote *) (cons B (quote ())))) V2725) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V2724 V2725 (lambda () (kl:shen.th* Y B V2724 V2725 V2726)))))) (begin (kl:shen.unbindv V2578 V2725) Result))))) #f))) #f))) #f))) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V2585 (kl:shen.lazyderef V2722 V2725))) (if (pair? V2585) (let ((V2586 (kl:shen.lazyderef (car V2585) V2725))) (if (eq? (quote _waspvm_at_v) V2586) (let ((V2587 (kl:shen.lazyderef (cdr V2585) V2725))) (if (pair? V2587) (let ((X (car V2587))) (let ((V2588 (kl:shen.lazyderef (cdr V2587) V2725))) (if (pair? V2588) (let ((Y (car V2588))) (let ((V2589 (kl:shen.lazyderef (cdr V2588) V2725))) (if (null? V2589) (let ((V2590 (kl:shen.lazyderef V2723 V2725))) (if (pair? V2590) (let ((V2591 (kl:shen.lazyderef (car V2590) V2725))) (if (eq? (quote vector) V2591) (let ((V2592 (kl:shen.lazyderef (cdr V2590) V2725))) (if (pair? V2592) (let ((A (car V2592))) (let ((V2593 (kl:shen.lazyderef (cdr V2592) V2725))) (if (null? V2593) (begin (kl:shen.incinfs) (kl:shen.th* X A V2724 V2725 (lambda () (kl:shen.th* Y (cons (quote vector) (cons A (quote ()))) V2724 V2725 V2726)))) (if (kl:shen.pvar? V2593) (begin (kl:shen.bindv V2593 (quote ()) V2725) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V2724 V2725 (lambda () (kl:shen.th* Y (cons (quote vector) (cons A (quote ()))) V2724 V2725 V2726)))))) (begin (kl:shen.unbindv V2593 V2725) Result))) #f)))) (if (kl:shen.pvar? V2592) (let ((A (kl:shen.newpv V2725))) (begin (kl:shen.bindv V2592 (cons A (quote ())) V2725) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V2724 V2725 (lambda () (kl:shen.th* Y (cons (quote vector) (cons A (quote ()))) V2724 V2725 V2726)))))) (begin (kl:shen.unbindv V2592 V2725) Result)))) #f))) (if (kl:shen.pvar? V2591) (begin (kl:shen.bindv V2591 (quote vector) V2725) (let ((Result (let ((V2594 (kl:shen.lazyderef (cdr V2590) V2725))) (if (pair? V2594) (let ((A (car V2594))) (let ((V2595 (kl:shen.lazyderef (cdr V2594) V2725))) (if (null? V2595) (begin (kl:shen.incinfs) (kl:shen.th* X A V2724 V2725 (lambda () (kl:shen.th* Y (cons (quote vector) (cons A (quote ()))) V2724 V2725 V2726)))) (if (kl:shen.pvar? V2595) (begin (kl:shen.bindv V2595 (quote ()) V2725) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V2724 V2725 (lambda () (kl:shen.th* Y (cons (quote vector) (cons A (quote ()))) V2724 V2725 V2726)))))) (begin (kl:shen.unbindv V2595 V2725) Result))) #f)))) (if (kl:shen.pvar? V2594) (let ((A (kl:shen.newpv V2725))) (begin (kl:shen.bindv V2594 (cons A (quote ())) V2725) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V2724 V2725 (lambda () (kl:shen.th* Y (cons (quote vector) (cons A (quote ()))) V2724 V2725 V2726)))))) (begin (kl:shen.unbindv V2594 V2725) Result)))) #f))))) (begin (kl:shen.unbindv V2591 V2725) Result))) #f))) (if (kl:shen.pvar? V2590) (let ((A (kl:shen.newpv V2725))) (begin (kl:shen.bindv V2590 (cons (quote vector) (cons A (quote ()))) V2725) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X A V2724 V2725 (lambda () (kl:shen.th* Y (cons (quote vector) (cons A (quote ()))) V2724 V2725 V2726)))))) (begin (kl:shen.unbindv V2590 V2725) Result)))) #f))) #f))) #f))) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V2596 (kl:shen.lazyderef V2722 V2725))) (if (pair? V2596) (let ((V2597 (kl:shen.lazyderef (car V2596) V2725))) (if (eq? (quote _waspvm_at_s) V2597) (let ((V2598 (kl:shen.lazyderef (cdr V2596) V2725))) (if (pair? V2598) (let ((X (car V2598))) (let ((V2599 (kl:shen.lazyderef (cdr V2598) V2725))) (if (pair? V2599) (let ((Y (car V2599))) (let ((V2600 (kl:shen.lazyderef (cdr V2599) V2725))) (if (null? V2600) (let ((V2601 (kl:shen.lazyderef V2723 V2725))) (if (eq? (quote string) V2601) (begin (kl:shen.incinfs) (kl:shen.th* X (quote string) V2724 V2725 (lambda () (kl:shen.th* Y (quote string) V2724 V2725 V2726)))) (if (kl:shen.pvar? V2601) (begin (kl:shen.bindv V2601 (quote string) V2725) (let ((Result (begin (kl:shen.incinfs) (kl:shen.th* X (quote string) V2724 V2725 (lambda () (kl:shen.th* Y (quote string) V2724 V2725 V2726)))))) (begin (kl:shen.unbindv V2601 V2725) Result))) #f))) #f))) #f))) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V2602 (kl:shen.lazyderef V2722 V2725))) (if (pair? V2602) (let ((V2603 (kl:shen.lazyderef (car V2602) V2725))) (if (eq? (quote lambda) V2603) (let ((V2604 (kl:shen.lazyderef (cdr V2602) V2725))) (if (pair? V2604) (let ((X (car V2604))) (let ((V2605 (kl:shen.lazyderef (cdr V2604) V2725))) (if (pair? V2605) (let ((Y (car V2605))) (let ((V2606 (kl:shen.lazyderef (cdr V2605) V2725))) (if (null? V2606) (let ((V2607 (kl:shen.lazyderef V2723 V2725))) (if (pair? V2607) (let ((A (car V2607))) (let ((V2608 (kl:shen.lazyderef (cdr V2607) V2725))) (if (pair? V2608) (let ((V2609 (kl:shen.lazyderef (car V2608) V2725))) (if (eq? (quote -->) V2609) (let ((V2610 (kl:shen.lazyderef (cdr V2608) V2725))) (if (pair? V2610) (let ((B (car V2610))) (let ((V2611 (kl:shen.lazyderef (cdr V2610) V2725))) (if (null? V2611) (let ((Z (kl:shen.newpv V2725))) (let ((X&& (kl:shen.newpv V2725))) (begin (kl:shen.incinfs) (kl:bind X&& (kl:shen.placeholder) V2725 (lambda () (kl:bind Z (kl:shen.ebr (kl:shen.lazyderef X&& V2725) (kl:shen.lazyderef X V2725) (kl:shen.lazyderef Y V2725)) V2725 (lambda () (kl:shen.th* Z B (cons (cons X&& (cons (quote :) (cons A (quote ())))) V2724) V2725 V2726)))))))) (if (kl:shen.pvar? V2611) (begin (kl:shen.bindv V2611 (quote ()) V2725) (let ((Result (let ((Z (kl:shen.newpv V2725))) (let ((X&& (kl:shen.newpv V2725))) (begin (kl:shen.incinfs) (kl:bind X&& (kl:shen.placeholder) V2725 (lambda () (kl:bind Z (kl:shen.ebr (kl:shen.lazyderef X&& V2725) (kl:shen.lazyderef X V2725) (kl:shen.lazyderef Y V2725)) V2725 (lambda () (kl:shen.th* Z B (cons (cons X&& (cons (quote :) (cons A (quote ())))) V2724) V2725 V2726)))))))))) (begin (kl:shen.unbindv V2611 V2725) Result))) #f)))) (if (kl:shen.pvar? V2610) (let ((B (kl:shen.newpv V2725))) (begin (kl:shen.bindv V2610 (cons B (quote ())) V2725) (let ((Result (let ((Z (kl:shen.newpv V2725))) (let ((X&& (kl:shen.newpv V2725))) (begin (kl:shen.incinfs) (kl:bind X&& (kl:shen.placeholder) V2725 (lambda () (kl:bind Z (kl:shen.ebr (kl:shen.lazyderef X&& V2725) (kl:shen.lazyderef X V2725) (kl:shen.lazyderef Y V2725)) V2725 (lambda () (kl:shen.th* Z B (cons (cons X&& (cons (quote :) (cons A (quote ())))) V2724) V2725 V2726)))))))))) (begin (kl:shen.unbindv V2610 V2725) Result)))) #f))) (if (kl:shen.pvar? V2609) (begin (kl:shen.bindv V2609 (quote -->) V2725) (let ((Result (let ((V2612 (kl:shen.lazyderef (cdr V2608) V2725))) (if (pair? V2612) (let ((B (car V2612))) (let ((V2613 (kl:shen.lazyderef (cdr V2612) V2725))) (if (null? V2613) (let ((Z (kl:shen.newpv V2725))) (let ((X&& (kl:shen.newpv V2725))) (begin (kl:shen.incinfs) (kl:bind X&& (kl:shen.placeholder) V2725 (lambda () (kl:bind Z (kl:shen.ebr (kl:shen.lazyderef X&& V2725) (kl:shen.lazyderef X V2725) (kl:shen.lazyderef Y V2725)) V2725 (lambda () (kl:shen.th* Z B (cons (cons X&& (cons (quote :) (cons A (quote ())))) V2724) V2725 V2726)))))))) (if (kl:shen.pvar? V2613) (begin (kl:shen.bindv V2613 (quote ()) V2725) (let ((Result (let ((Z (kl:shen.newpv V2725))) (let ((X&& (kl:shen.newpv V2725))) (begin (kl:shen.incinfs) (kl:bind X&& (kl:shen.placeholder) V2725 (lambda () (kl:bind Z (kl:shen.ebr (kl:shen.lazyderef X&& V2725) (kl:shen.lazyderef X V2725) (kl:shen.lazyderef Y V2725)) V2725 (lambda () (kl:shen.th* Z B (cons (cons X&& (cons (quote :) (cons A (quote ())))) V2724) V2725 V2726)))))))))) (begin (kl:shen.unbindv V2613 V2725) Result))) #f)))) (if (kl:shen.pvar? V2612) (let ((B (kl:shen.newpv V2725))) (begin (kl:shen.bindv V2612 (cons B (quote ())) V2725) (let ((Result (let ((Z (kl:shen.newpv V2725))) (let ((X&& (kl:shen.newpv V2725))) (begin (kl:shen.incinfs) (kl:bind X&& (kl:shen.placeholder) V2725 (lambda () (kl:bind Z (kl:shen.ebr (kl:shen.lazyderef X&& V2725) (kl:shen.lazyderef X V2725) (kl:shen.lazyderef Y V2725)) V2725 (lambda () (kl:shen.th* Z B (cons (cons X&& (cons (quote :) (cons A (quote ())))) V2724) V2725 V2726)))))))))) (begin (kl:shen.unbindv V2612 V2725) Result)))) #f))))) (begin (kl:shen.unbindv V2609 V2725) Result))) #f))) (if (kl:shen.pvar? V2608) (let ((B (kl:shen.newpv V2725))) (begin (kl:shen.bindv V2608 (cons (quote -->) (cons B (quote ()))) V2725) (let ((Result (let ((Z (kl:shen.newpv V2725))) (let ((X&& (kl:shen.newpv V2725))) (begin (kl:shen.incinfs) (kl:bind X&& (kl:shen.placeholder) V2725 (lambda () (kl:bind Z (kl:shen.ebr (kl:shen.lazyderef X&& V2725) (kl:shen.lazyderef X V2725) (kl:shen.lazyderef Y V2725)) V2725 (lambda () (kl:shen.th* Z B (cons (cons X&& (cons (quote :) (cons A (quote ())))) V2724) V2725 V2726)))))))))) (begin (kl:shen.unbindv V2608 V2725) Result)))) #f)))) (if (kl:shen.pvar? V2607) (let ((A (kl:shen.newpv V2725))) (let ((B (kl:shen.newpv V2725))) (begin (kl:shen.bindv V2607 (cons A (cons (quote -->) (cons B (quote ())))) V2725) (let ((Result (let ((Z (kl:shen.newpv V2725))) (let ((X&& (kl:shen.newpv V2725))) (begin (kl:shen.incinfs) (kl:bind X&& (kl:shen.placeholder) V2725 (lambda () (kl:bind Z (kl:shen.ebr (kl:shen.lazyderef X&& V2725) (kl:shen.lazyderef X V2725) (kl:shen.lazyderef Y V2725)) V2725 (lambda () (kl:shen.th* Z B (cons (cons X&& (cons (quote :) (cons A (quote ())))) V2724) V2725 V2726)))))))))) (begin (kl:shen.unbindv V2607 V2725) Result))))) #f))) #f))) #f))) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V2614 (kl:shen.lazyderef V2722 V2725))) (if (pair? V2614) (let ((V2615 (kl:shen.lazyderef (car V2614) V2725))) (if (eq? (quote let) V2615) (let ((V2616 (kl:shen.lazyderef (cdr V2614) V2725))) (if (pair? V2616) (let ((X (car V2616))) (let ((V2617 (kl:shen.lazyderef (cdr V2616) V2725))) (if (pair? V2617) (let ((Y (car V2617))) (let ((V2618 (kl:shen.lazyderef (cdr V2617) V2725))) (if (pair? V2618) (let ((Z (car V2618))) (let ((V2619 (kl:shen.lazyderef (cdr V2618) V2725))) (if (null? V2619) (let ((W (kl:shen.newpv V2725))) (let ((X&& (kl:shen.newpv V2725))) (let ((B (kl:shen.newpv V2725))) (begin (kl:shen.incinfs) (kl:shen.th* Y B V2724 V2725 (lambda () (kl:bind X&& (kl:shen.placeholder) V2725 (lambda () (kl:bind W (kl:shen.ebr (kl:shen.lazyderef X&& V2725) (kl:shen.lazyderef X V2725) (kl:shen.lazyderef Z V2725)) V2725 (lambda () (kl:shen.th* W V2723 (cons (cons X&& (cons (quote :) (cons B (quote ())))) V2724) V2725 V2726))))))))))) #f))) #f))) #f))) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V2620 (kl:shen.lazyderef V2722 V2725))) (if (pair? V2620) (let ((V2621 (kl:shen.lazyderef (car V2620) V2725))) (if (eq? (quote open) V2621) (let ((V2622 (kl:shen.lazyderef (cdr V2620) V2725))) (if (pair? V2622) (let ((FileName (car V2622))) (let ((V2623 (kl:shen.lazyderef (cdr V2622) V2725))) (if (pair? V2623) (let ((Direction2553 (car V2623))) (let ((V2624 (kl:shen.lazyderef (cdr V2623) V2725))) (if (null? V2624) (let ((V2625 (kl:shen.lazyderef V2723 V2725))) (if (pair? V2625) (let ((V2626 (kl:shen.lazyderef (car V2625) V2725))) (if (eq? (quote stream) V2626) (let ((V2627 (kl:shen.lazyderef (cdr V2625) V2725))) (if (pair? V2627) (let ((Direction (car V2627))) (let ((V2628 (kl:shen.lazyderef (cdr V2627) V2725))) (if (null? V2628) (begin (kl:shen.incinfs) (kl:unify! Direction Direction2553 V2725 (lambda () (kl:cut Throwcontrol V2725 (lambda () (kl:fwhen (kl:element? (kl:shen.lazyderef Direction V2725) (cons (quote in) (cons (quote out) (quote ())))) V2725 (lambda () (kl:shen.th* FileName (quote string) V2724 V2725 V2726)))))))) (if (kl:shen.pvar? V2628) (begin (kl:shen.bindv V2628 (quote ()) V2725) (let ((Result (begin (kl:shen.incinfs) (kl:unify! Direction Direction2553 V2725 (lambda () (kl:cut Throwcontrol V2725 (lambda () (kl:fwhen (kl:element? (kl:shen.lazyderef Direction V2725) (cons (quote in) (cons (quote out) (quote ())))) V2725 (lambda () (kl:shen.th* FileName (quote string) V2724 V2725 V2726)))))))))) (begin (kl:shen.unbindv V2628 V2725) Result))) #f)))) (if (kl:shen.pvar? V2627) (let ((Direction (kl:shen.newpv V2725))) (begin (kl:shen.bindv V2627 (cons Direction (quote ())) V2725) (let ((Result (begin (kl:shen.incinfs) (kl:unify! Direction Direction2553 V2725 (lambda () (kl:cut Throwcontrol V2725 (lambda () (kl:fwhen (kl:element? (kl:shen.lazyderef Direction V2725) (cons (quote in) (cons (quote out) (quote ())))) V2725 (lambda () (kl:shen.th* FileName (quote string) V2724 V2725 V2726)))))))))) (begin (kl:shen.unbindv V2627 V2725) Result)))) #f))) (if (kl:shen.pvar? V2626) (begin (kl:shen.bindv V2626 (quote stream) V2725) (let ((Result (let ((V2629 (kl:shen.lazyderef (cdr V2625) V2725))) (if (pair? V2629) (let ((Direction (car V2629))) (let ((V2630 (kl:shen.lazyderef (cdr V2629) V2725))) (if (null? V2630) (begin (kl:shen.incinfs) (kl:unify! Direction Direction2553 V2725 (lambda () (kl:cut Throwcontrol V2725 (lambda () (kl:fwhen (kl:element? (kl:shen.lazyderef Direction V2725) (cons (quote in) (cons (quote out) (quote ())))) V2725 (lambda () (kl:shen.th* FileName (quote string) V2724 V2725 V2726)))))))) (if (kl:shen.pvar? V2630) (begin (kl:shen.bindv V2630 (quote ()) V2725) (let ((Result (begin (kl:shen.incinfs) (kl:unify! Direction Direction2553 V2725 (lambda () (kl:cut Throwcontrol V2725 (lambda () (kl:fwhen (kl:element? (kl:shen.lazyderef Direction V2725) (cons (quote in) (cons (quote out) (quote ())))) V2725 (lambda () (kl:shen.th* FileName (quote string) V2724 V2725 V2726)))))))))) (begin (kl:shen.unbindv V2630 V2725) Result))) #f)))) (if (kl:shen.pvar? V2629) (let ((Direction (kl:shen.newpv V2725))) (begin (kl:shen.bindv V2629 (cons Direction (quote ())) V2725) (let ((Result (begin (kl:shen.incinfs) (kl:unify! Direction Direction2553 V2725 (lambda () (kl:cut Throwcontrol V2725 (lambda () (kl:fwhen (kl:element? (kl:shen.lazyderef Direction V2725) (cons (quote in) (cons (quote out) (quote ())))) V2725 (lambda () (kl:shen.th* FileName (quote string) V2724 V2725 V2726)))))))))) (begin (kl:shen.unbindv V2629 V2725) Result)))) #f))))) (begin (kl:shen.unbindv V2626 V2725) Result))) #f))) (if (kl:shen.pvar? V2625) (let ((Direction (kl:shen.newpv V2725))) (begin (kl:shen.bindv V2625 (cons (quote stream) (cons Direction (quote ()))) V2725) (let ((Result (begin (kl:shen.incinfs) (kl:unify! Direction Direction2553 V2725 (lambda () (kl:cut Throwcontrol V2725 (lambda () (kl:fwhen (kl:element? (kl:shen.lazyderef Direction V2725) (cons (quote in) (cons (quote out) (quote ())))) V2725 (lambda () (kl:shen.th* FileName (quote string) V2724 V2725 V2726)))))))))) (begin (kl:shen.unbindv V2625 V2725) Result)))) #f))) #f))) #f))) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V2631 (kl:shen.lazyderef V2722 V2725))) (if (pair? V2631) (let ((V2632 (kl:shen.lazyderef (car V2631) V2725))) (if (eq? (quote type) V2632) (let ((V2633 (kl:shen.lazyderef (cdr V2631) V2725))) (if (pair? V2633) (let ((X (car V2633))) (let ((V2634 (kl:shen.lazyderef (cdr V2633) V2725))) (if (pair? V2634) (let ((A (car V2634))) (let ((V2635 (kl:shen.lazyderef (cdr V2634) V2725))) (if (null? V2635) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V2725 (lambda () (kl:unify A V2723 V2725 (lambda () (kl:shen.th* X A V2724 V2725 V2726)))))) #f))) #f))) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V2636 (kl:shen.lazyderef V2722 V2725))) (if (pair? V2636) (let ((V2637 (kl:shen.lazyderef (car V2636) V2725))) (if (eq? (quote input+) V2637) (let ((V2638 (kl:shen.lazyderef (cdr V2636) V2725))) (if (pair? V2638) (let ((A (car V2638))) (let ((V2639 (kl:shen.lazyderef (cdr V2638) V2725))) (if (pair? V2639) (let ((Stream (car V2639))) (let ((V2640 (kl:shen.lazyderef (cdr V2639) V2725))) (if (null? V2640) (let ((C (kl:shen.newpv V2725))) (begin (kl:shen.incinfs) (kl:bind C (kl:shen.demodulate (kl:shen.lazyderef A V2725)) V2725 (lambda () (kl:unify V2723 C V2725 (lambda () (kl:shen.th* Stream (cons (quote stream) (cons (quote in) (quote ()))) V2724 V2725 V2726))))))) #f))) #f))) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V2641 (kl:shen.lazyderef V2722 V2725))) (if (pair? V2641) (let ((V2642 (kl:shen.lazyderef (car V2641) V2725))) (if (eq? (quote set) V2642) (let ((V2643 (kl:shen.lazyderef (cdr V2641) V2725))) (if (pair? V2643) (let ((Var (car V2643))) (let ((V2644 (kl:shen.lazyderef (cdr V2643) V2725))) (if (pair? V2644) (let ((Val (car V2644))) (let ((V2645 (kl:shen.lazyderef (cdr V2644) V2725))) (if (null? V2645) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V2725 (lambda () (kl:shen.th* Var (quote symbol) V2724 V2725 (lambda () (kl:cut Throwcontrol V2725 (lambda () (kl:shen.th* (cons (quote value) (cons Var (quote ()))) V2723 V2724 V2725 (lambda () (kl:shen.th* Val V2723 V2724 V2725 V2726)))))))))) #f))) #f))) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((NewHyp (kl:shen.newpv V2725))) (begin (kl:shen.incinfs) (kl:shen.t*-hyps V2724 NewHyp V2725 (lambda () (kl:shen.th* V2722 V2723 NewHyp V2725 V2726))))))) (if (kl:= Case #f) (let ((Case (let ((V2646 (kl:shen.lazyderef V2722 V2725))) (if (pair? V2646) (let ((V2647 (kl:shen.lazyderef (car V2646) V2725))) (if (eq? (quote define) V2647) (let ((V2648 (kl:shen.lazyderef (cdr V2646) V2725))) (if (pair? V2648) (let ((F (car V2648))) (let ((X (cdr V2648))) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V2725 (lambda () (kl:shen.t*-def (cons (quote define) (cons F X)) V2723 V2724 V2725 V2726)))))) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V2649 (kl:shen.lazyderef V2722 V2725))) (if (pair? V2649) (let ((V2650 (kl:shen.lazyderef (car V2649) V2725))) (if (eq? (quote defmacro) V2650) (let ((V2651 (kl:shen.lazyderef V2723 V2725))) (if (eq? (quote unit) V2651) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V2725 V2726)) (if (kl:shen.pvar? V2651) (begin (kl:shen.bindv V2651 (quote unit) V2725) (let ((Result (begin (kl:shen.incinfs) (kl:cut Throwcontrol V2725 V2726)))) (begin (kl:shen.unbindv V2651 V2725) Result))) #f))) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V2652 (kl:shen.lazyderef V2722 V2725))) (if (pair? V2652) (let ((V2653 (kl:shen.lazyderef (car V2652) V2725))) (if (eq? (quote shen.process-datatype) V2653) (let ((V2654 (kl:shen.lazyderef V2723 V2725))) (if (eq? (quote symbol) V2654) (begin (kl:shen.incinfs) (kl:thaw V2726)) (if (kl:shen.pvar? V2654) (begin (kl:shen.bindv V2654 (quote symbol) V2725) (let ((Result (begin (kl:shen.incinfs) (kl:thaw V2726)))) (begin (kl:shen.unbindv V2654 V2725) Result))) #f))) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V2655 (kl:shen.lazyderef V2722 V2725))) (if (pair? V2655) (let ((V2656 (kl:shen.lazyderef (car V2655) V2725))) (if (eq? (quote shen.synonyms-help) V2656) (let ((V2657 (kl:shen.lazyderef V2723 V2725))) (if (eq? (quote symbol) V2657) (begin (kl:shen.incinfs) (kl:thaw V2726)) (if (kl:shen.pvar? V2657) (begin (kl:shen.bindv V2657 (quote symbol) V2725) (let ((Result (begin (kl:shen.incinfs) (kl:thaw V2726)))) (begin (kl:shen.unbindv V2657 V2725) Result))) #f))) #f)) #f)))) (if (kl:= Case #f) (let ((Datatypes (kl:shen.newpv V2725))) (begin (kl:shen.incinfs) (kl:bind Datatypes (kl:value (quote shen.*datatypes*)) V2725 (lambda () (kl:shen.udefs* (cons V2722 (cons (quote :) (cons V2723 (quote ())))) V2724 Datatypes V2725 V2726))))) 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 V2731 V2732 V2733 V2734) (let ((Case (let ((V2468 (kl:shen.lazyderef V2731 V2733))) (if (pair? V2468) (let ((V2469 (kl:shen.lazyderef (car V2468) V2733))) (if (pair? V2469) (let ((V2470 (kl:shen.lazyderef (car V2469) V2733))) (if (pair? V2470) (let ((V2471 (kl:shen.lazyderef (car V2470) V2733))) (if (eq? (quote cons) V2471) (let ((V2472 (kl:shen.lazyderef (cdr V2470) V2733))) (if (pair? V2472) (let ((X (car V2472))) (let ((V2473 (kl:shen.lazyderef (cdr V2472) V2733))) (if (pair? V2473) (let ((Y (car V2473))) (let ((V2474 (kl:shen.lazyderef (cdr V2473) V2733))) (if (null? V2474) (let ((V2475 (kl:shen.lazyderef (cdr V2469) V2733))) (if (pair? V2475) (let ((V2476 (kl:shen.lazyderef (car V2475) V2733))) (if (eq? (quote :) V2476) (let ((V2477 (kl:shen.lazyderef (cdr V2475) V2733))) (if (pair? V2477) (let ((V2478 (kl:shen.lazyderef (car V2477) V2733))) (if (pair? V2478) (let ((V2479 (kl:shen.lazyderef (car V2478) V2733))) (if (eq? (quote list) V2479) (let ((V2480 (kl:shen.lazyderef (cdr V2478) V2733))) (if (pair? V2480) (let ((A (car V2480))) (let ((V2481 (kl:shen.lazyderef (cdr V2480) V2733))) (if (null? V2481) (let ((V2482 (kl:shen.lazyderef (cdr V2477) V2733))) (if (null? V2482) (let ((Hyp (cdr V2468))) (begin (kl:shen.incinfs) (kl:bind V2732 (cons (cons (kl:shen.lazyderef X V2733) (cons (quote :) (cons (kl:shen.lazyderef A V2733) (quote ())))) (cons (cons (kl:shen.lazyderef Y V2733) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V2733) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V2733))) V2733 V2734))) (if (kl:shen.pvar? V2482) (begin (kl:shen.bindv V2482 (quote ()) V2733) (let ((Result (let ((Hyp (cdr V2468))) (begin (kl:shen.incinfs) (kl:bind V2732 (cons (cons (kl:shen.lazyderef X V2733) (cons (quote :) (cons (kl:shen.lazyderef A V2733) (quote ())))) (cons (cons (kl:shen.lazyderef Y V2733) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V2733) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V2733))) V2733 V2734))))) (begin (kl:shen.unbindv V2482 V2733) Result))) #f))) (if (kl:shen.pvar? V2481) (begin (kl:shen.bindv V2481 (quote ()) V2733) (let ((Result (let ((V2483 (kl:shen.lazyderef (cdr V2477) V2733))) (if (null? V2483) (let ((Hyp (cdr V2468))) (begin (kl:shen.incinfs) (kl:bind V2732 (cons (cons (kl:shen.lazyderef X V2733) (cons (quote :) (cons (kl:shen.lazyderef A V2733) (quote ())))) (cons (cons (kl:shen.lazyderef Y V2733) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V2733) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V2733))) V2733 V2734))) (if (kl:shen.pvar? V2483) (begin (kl:shen.bindv V2483 (quote ()) V2733) (let ((Result (let ((Hyp (cdr V2468))) (begin (kl:shen.incinfs) (kl:bind V2732 (cons (cons (kl:shen.lazyderef X V2733) (cons (quote :) (cons (kl:shen.lazyderef A V2733) (quote ())))) (cons (cons (kl:shen.lazyderef Y V2733) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V2733) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V2733))) V2733 V2734))))) (begin (kl:shen.unbindv V2483 V2733) Result))) #f))))) (begin (kl:shen.unbindv V2481 V2733) Result))) #f)))) (if (kl:shen.pvar? V2480) (let ((A (kl:shen.newpv V2733))) (begin (kl:shen.bindv V2480 (cons A (quote ())) V2733) (let ((Result (let ((V2484 (kl:shen.lazyderef (cdr V2477) V2733))) (if (null? V2484) (let ((Hyp (cdr V2468))) (begin (kl:shen.incinfs) (kl:bind V2732 (cons (cons (kl:shen.lazyderef X V2733) (cons (quote :) (cons (kl:shen.lazyderef A V2733) (quote ())))) (cons (cons (kl:shen.lazyderef Y V2733) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V2733) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V2733))) V2733 V2734))) (if (kl:shen.pvar? V2484) (begin (kl:shen.bindv V2484 (quote ()) V2733) (let ((Result (let ((Hyp (cdr V2468))) (begin (kl:shen.incinfs) (kl:bind V2732 (cons (cons (kl:shen.lazyderef X V2733) (cons (quote :) (cons (kl:shen.lazyderef A V2733) (quote ())))) (cons (cons (kl:shen.lazyderef Y V2733) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V2733) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V2733))) V2733 V2734))))) (begin (kl:shen.unbindv V2484 V2733) Result))) #f))))) (begin (kl:shen.unbindv V2480 V2733) Result)))) #f))) (if (kl:shen.pvar? V2479) (begin (kl:shen.bindv V2479 (quote list) V2733) (let ((Result (let ((V2485 (kl:shen.lazyderef (cdr V2478) V2733))) (if (pair? V2485) (let ((A (car V2485))) (let ((V2486 (kl:shen.lazyderef (cdr V2485) V2733))) (if (null? V2486) (let ((V2487 (kl:shen.lazyderef (cdr V2477) V2733))) (if (null? V2487) (let ((Hyp (cdr V2468))) (begin (kl:shen.incinfs) (kl:bind V2732 (cons (cons (kl:shen.lazyderef X V2733) (cons (quote :) (cons (kl:shen.lazyderef A V2733) (quote ())))) (cons (cons (kl:shen.lazyderef Y V2733) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V2733) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V2733))) V2733 V2734))) (if (kl:shen.pvar? V2487) (begin (kl:shen.bindv V2487 (quote ()) V2733) (let ((Result (let ((Hyp (cdr V2468))) (begin (kl:shen.incinfs) (kl:bind V2732 (cons (cons (kl:shen.lazyderef X V2733) (cons (quote :) (cons (kl:shen.lazyderef A V2733) (quote ())))) (cons (cons (kl:shen.lazyderef Y V2733) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V2733) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V2733))) V2733 V2734))))) (begin (kl:shen.unbindv V2487 V2733) Result))) #f))) (if (kl:shen.pvar? V2486) (begin (kl:shen.bindv V2486 (quote ()) V2733) (let ((Result (let ((V2488 (kl:shen.lazyderef (cdr V2477) V2733))) (if (null? V2488) (let ((Hyp (cdr V2468))) (begin (kl:shen.incinfs) (kl:bind V2732 (cons (cons (kl:shen.lazyderef X V2733) (cons (quote :) (cons (kl:shen.lazyderef A V2733) (quote ())))) (cons (cons (kl:shen.lazyderef Y V2733) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V2733) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V2733))) V2733 V2734))) (if (kl:shen.pvar? V2488) (begin (kl:shen.bindv V2488 (quote ()) V2733) (let ((Result (let ((Hyp (cdr V2468))) (begin (kl:shen.incinfs) (kl:bind V2732 (cons (cons (kl:shen.lazyderef X V2733) (cons (quote :) (cons (kl:shen.lazyderef A V2733) (quote ())))) (cons (cons (kl:shen.lazyderef Y V2733) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V2733) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V2733))) V2733 V2734))))) (begin (kl:shen.unbindv V2488 V2733) Result))) #f))))) (begin (kl:shen.unbindv V2486 V2733) Result))) #f)))) (if (kl:shen.pvar? V2485) (let ((A (kl:shen.newpv V2733))) (begin (kl:shen.bindv V2485 (cons A (quote ())) V2733) (let ((Result (let ((V2489 (kl:shen.lazyderef (cdr V2477) V2733))) (if (null? V2489) (let ((Hyp (cdr V2468))) (begin (kl:shen.incinfs) (kl:bind V2732 (cons (cons (kl:shen.lazyderef X V2733) (cons (quote :) (cons (kl:shen.lazyderef A V2733) (quote ())))) (cons (cons (kl:shen.lazyderef Y V2733) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V2733) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V2733))) V2733 V2734))) (if (kl:shen.pvar? V2489) (begin (kl:shen.bindv V2489 (quote ()) V2733) (let ((Result (let ((Hyp (cdr V2468))) (begin (kl:shen.incinfs) (kl:bind V2732 (cons (cons (kl:shen.lazyderef X V2733) (cons (quote :) (cons (kl:shen.lazyderef A V2733) (quote ())))) (cons (cons (kl:shen.lazyderef Y V2733) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V2733) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V2733))) V2733 V2734))))) (begin (kl:shen.unbindv V2489 V2733) Result))) #f))))) (begin (kl:shen.unbindv V2485 V2733) Result)))) #f))))) (begin (kl:shen.unbindv V2479 V2733) Result))) #f))) (if (kl:shen.pvar? V2478) (let ((A (kl:shen.newpv V2733))) (begin (kl:shen.bindv V2478 (cons (quote list) (cons A (quote ()))) V2733) (let ((Result (let ((V2490 (kl:shen.lazyderef (cdr V2477) V2733))) (if (null? V2490) (let ((Hyp (cdr V2468))) (begin (kl:shen.incinfs) (kl:bind V2732 (cons (cons (kl:shen.lazyderef X V2733) (cons (quote :) (cons (kl:shen.lazyderef A V2733) (quote ())))) (cons (cons (kl:shen.lazyderef Y V2733) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V2733) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V2733))) V2733 V2734))) (if (kl:shen.pvar? V2490) (begin (kl:shen.bindv V2490 (quote ()) V2733) (let ((Result (let ((Hyp (cdr V2468))) (begin (kl:shen.incinfs) (kl:bind V2732 (cons (cons (kl:shen.lazyderef X V2733) (cons (quote :) (cons (kl:shen.lazyderef A V2733) (quote ())))) (cons (cons (kl:shen.lazyderef Y V2733) (cons (quote :) (cons (cons (quote list) (cons (kl:shen.lazyderef A V2733) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V2733))) V2733 V2734))))) (begin (kl:shen.unbindv V2490 V2733) Result))) #f))))) (begin (kl:shen.unbindv V2478 V2733) Result)))) #f))) #f)) #f)) #f)) #f))) #f))) #f)) #f)) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V2491 (kl:shen.lazyderef V2731 V2733))) (if (pair? V2491) (let ((V2492 (kl:shen.lazyderef (car V2491) V2733))) (if (pair? V2492) (let ((V2493 (kl:shen.lazyderef (car V2492) V2733))) (if (pair? V2493) (let ((V2494 (kl:shen.lazyderef (car V2493) V2733))) (if (eq? (quote _waspvm_at_p) V2494) (let ((V2495 (kl:shen.lazyderef (cdr V2493) V2733))) (if (pair? V2495) (let ((X (car V2495))) (let ((V2496 (kl:shen.lazyderef (cdr V2495) V2733))) (if (pair? V2496) (let ((Y (car V2496))) (let ((V2497 (kl:shen.lazyderef (cdr V2496) V2733))) (if (null? V2497) (let ((V2498 (kl:shen.lazyderef (cdr V2492) V2733))) (if (pair? V2498) (let ((V2499 (kl:shen.lazyderef (car V2498) V2733))) (if (eq? (quote :) V2499) (let ((V2500 (kl:shen.lazyderef (cdr V2498) V2733))) (if (pair? V2500) (let ((V2501 (kl:shen.lazyderef (car V2500) V2733))) (if (pair? V2501) (let ((A (car V2501))) (let ((V2502 (kl:shen.lazyderef (cdr V2501) V2733))) (if (pair? V2502) (let ((V2503 (kl:shen.lazyderef (car V2502) V2733))) (if (eq? (quote *) V2503) (let ((V2504 (kl:shen.lazyderef (cdr V2502) V2733))) (if (pair? V2504) (let ((B (car V2504))) (let ((V2505 (kl:shen.lazyderef (cdr V2504) V2733))) (if (null? V2505) (let ((V2506 (kl:shen.lazyderef (cdr V2500) V2733))) (if (null? V2506) (let ((Hyp (cdr V2491))) (begin (kl:shen.incinfs) (kl:bind V2732 (cons (cons (kl:shen.lazyderef X V2733) (cons (quote :) (cons (kl:shen.lazyderef A V2733) (quote ())))) (cons (cons (kl:shen.lazyderef Y V2733) (cons (quote :) (cons (kl:shen.lazyderef B V2733) (quote ())))) (kl:shen.lazyderef Hyp V2733))) V2733 V2734))) (if (kl:shen.pvar? V2506) (begin (kl:shen.bindv V2506 (quote ()) V2733) (let ((Result (let ((Hyp (cdr V2491))) (begin (kl:shen.incinfs) (kl:bind V2732 (cons (cons (kl:shen.lazyderef X V2733) (cons (quote :) (cons (kl:shen.lazyderef A V2733) (quote ())))) (cons (cons (kl:shen.lazyderef Y V2733) (cons (quote :) (cons (kl:shen.lazyderef B V2733) (quote ())))) (kl:shen.lazyderef Hyp V2733))) V2733 V2734))))) (begin (kl:shen.unbindv V2506 V2733) Result))) #f))) (if (kl:shen.pvar? V2505) (begin (kl:shen.bindv V2505 (quote ()) V2733) (let ((Result (let ((V2507 (kl:shen.lazyderef (cdr V2500) V2733))) (if (null? V2507) (let ((Hyp (cdr V2491))) (begin (kl:shen.incinfs) (kl:bind V2732 (cons (cons (kl:shen.lazyderef X V2733) (cons (quote :) (cons (kl:shen.lazyderef A V2733) (quote ())))) (cons (cons (kl:shen.lazyderef Y V2733) (cons (quote :) (cons (kl:shen.lazyderef B V2733) (quote ())))) (kl:shen.lazyderef Hyp V2733))) V2733 V2734))) (if (kl:shen.pvar? V2507) (begin (kl:shen.bindv V2507 (quote ()) V2733) (let ((Result (let ((Hyp (cdr V2491))) (begin (kl:shen.incinfs) (kl:bind V2732 (cons (cons (kl:shen.lazyderef X V2733) (cons (quote :) (cons (kl:shen.lazyderef A V2733) (quote ())))) (cons (cons (kl:shen.lazyderef Y V2733) (cons (quote :) (cons (kl:shen.lazyderef B V2733) (quote ())))) (kl:shen.lazyderef Hyp V2733))) V2733 V2734))))) (begin (kl:shen.unbindv V2507 V2733) Result))) #f))))) (begin (kl:shen.unbindv V2505 V2733) Result))) #f)))) (if (kl:shen.pvar? V2504) (let ((B (kl:shen.newpv V2733))) (begin (kl:shen.bindv V2504 (cons B (quote ())) V2733) (let ((Result (let ((V2508 (kl:shen.lazyderef (cdr V2500) V2733))) (if (null? V2508) (let ((Hyp (cdr V2491))) (begin (kl:shen.incinfs) (kl:bind V2732 (cons (cons (kl:shen.lazyderef X V2733) (cons (quote :) (cons (kl:shen.lazyderef A V2733) (quote ())))) (cons (cons (kl:shen.lazyderef Y V2733) (cons (quote :) (cons (kl:shen.lazyderef B V2733) (quote ())))) (kl:shen.lazyderef Hyp V2733))) V2733 V2734))) (if (kl:shen.pvar? V2508) (begin (kl:shen.bindv V2508 (quote ()) V2733) (let ((Result (let ((Hyp (cdr V2491))) (begin (kl:shen.incinfs) (kl:bind V2732 (cons (cons (kl:shen.lazyderef X V2733) (cons (quote :) (cons (kl:shen.lazyderef A V2733) (quote ())))) (cons (cons (kl:shen.lazyderef Y V2733) (cons (quote :) (cons (kl:shen.lazyderef B V2733) (quote ())))) (kl:shen.lazyderef Hyp V2733))) V2733 V2734))))) (begin (kl:shen.unbindv V2508 V2733) Result))) #f))))) (begin (kl:shen.unbindv V2504 V2733) Result)))) #f))) (if (kl:shen.pvar? V2503) (begin (kl:shen.bindv V2503 (quote *) V2733) (let ((Result (let ((V2509 (kl:shen.lazyderef (cdr V2502) V2733))) (if (pair? V2509) (let ((B (car V2509))) (let ((V2510 (kl:shen.lazyderef (cdr V2509) V2733))) (if (null? V2510) (let ((V2511 (kl:shen.lazyderef (cdr V2500) V2733))) (if (null? V2511) (let ((Hyp (cdr V2491))) (begin (kl:shen.incinfs) (kl:bind V2732 (cons (cons (kl:shen.lazyderef X V2733) (cons (quote :) (cons (kl:shen.lazyderef A V2733) (quote ())))) (cons (cons (kl:shen.lazyderef Y V2733) (cons (quote :) (cons (kl:shen.lazyderef B V2733) (quote ())))) (kl:shen.lazyderef Hyp V2733))) V2733 V2734))) (if (kl:shen.pvar? V2511) (begin (kl:shen.bindv V2511 (quote ()) V2733) (let ((Result (let ((Hyp (cdr V2491))) (begin (kl:shen.incinfs) (kl:bind V2732 (cons (cons (kl:shen.lazyderef X V2733) (cons (quote :) (cons (kl:shen.lazyderef A V2733) (quote ())))) (cons (cons (kl:shen.lazyderef Y V2733) (cons (quote :) (cons (kl:shen.lazyderef B V2733) (quote ())))) (kl:shen.lazyderef Hyp V2733))) V2733 V2734))))) (begin (kl:shen.unbindv V2511 V2733) Result))) #f))) (if (kl:shen.pvar? V2510) (begin (kl:shen.bindv V2510 (quote ()) V2733) (let ((Result (let ((V2512 (kl:shen.lazyderef (cdr V2500) V2733))) (if (null? V2512) (let ((Hyp (cdr V2491))) (begin (kl:shen.incinfs) (kl:bind V2732 (cons (cons (kl:shen.lazyderef X V2733) (cons (quote :) (cons (kl:shen.lazyderef A V2733) (quote ())))) (cons (cons (kl:shen.lazyderef Y V2733) (cons (quote :) (cons (kl:shen.lazyderef B V2733) (quote ())))) (kl:shen.lazyderef Hyp V2733))) V2733 V2734))) (if (kl:shen.pvar? V2512) (begin (kl:shen.bindv V2512 (quote ()) V2733) (let ((Result (let ((Hyp (cdr V2491))) (begin (kl:shen.incinfs) (kl:bind V2732 (cons (cons (kl:shen.lazyderef X V2733) (cons (quote :) (cons (kl:shen.lazyderef A V2733) (quote ())))) (cons (cons (kl:shen.lazyderef Y V2733) (cons (quote :) (cons (kl:shen.lazyderef B V2733) (quote ())))) (kl:shen.lazyderef Hyp V2733))) V2733 V2734))))) (begin (kl:shen.unbindv V2512 V2733) Result))) #f))))) (begin (kl:shen.unbindv V2510 V2733) Result))) #f)))) (if (kl:shen.pvar? V2509) (let ((B (kl:shen.newpv V2733))) (begin (kl:shen.bindv V2509 (cons B (quote ())) V2733) (let ((Result (let ((V2513 (kl:shen.lazyderef (cdr V2500) V2733))) (if (null? V2513) (let ((Hyp (cdr V2491))) (begin (kl:shen.incinfs) (kl:bind V2732 (cons (cons (kl:shen.lazyderef X V2733) (cons (quote :) (cons (kl:shen.lazyderef A V2733) (quote ())))) (cons (cons (kl:shen.lazyderef Y V2733) (cons (quote :) (cons (kl:shen.lazyderef B V2733) (quote ())))) (kl:shen.lazyderef Hyp V2733))) V2733 V2734))) (if (kl:shen.pvar? V2513) (begin (kl:shen.bindv V2513 (quote ()) V2733) (let ((Result (let ((Hyp (cdr V2491))) (begin (kl:shen.incinfs) (kl:bind V2732 (cons (cons (kl:shen.lazyderef X V2733) (cons (quote :) (cons (kl:shen.lazyderef A V2733) (quote ())))) (cons (cons (kl:shen.lazyderef Y V2733) (cons (quote :) (cons (kl:shen.lazyderef B V2733) (quote ())))) (kl:shen.lazyderef Hyp V2733))) V2733 V2734))))) (begin (kl:shen.unbindv V2513 V2733) Result))) #f))))) (begin (kl:shen.unbindv V2509 V2733) Result)))) #f))))) (begin (kl:shen.unbindv V2503 V2733) Result))) #f))) (if (kl:shen.pvar? V2502) (let ((B (kl:shen.newpv V2733))) (begin (kl:shen.bindv V2502 (cons (quote *) (cons B (quote ()))) V2733) (let ((Result (let ((V2514 (kl:shen.lazyderef (cdr V2500) V2733))) (if (null? V2514) (let ((Hyp (cdr V2491))) (begin (kl:shen.incinfs) (kl:bind V2732 (cons (cons (kl:shen.lazyderef X V2733) (cons (quote :) (cons (kl:shen.lazyderef A V2733) (quote ())))) (cons (cons (kl:shen.lazyderef Y V2733) (cons (quote :) (cons (kl:shen.lazyderef B V2733) (quote ())))) (kl:shen.lazyderef Hyp V2733))) V2733 V2734))) (if (kl:shen.pvar? V2514) (begin (kl:shen.bindv V2514 (quote ()) V2733) (let ((Result (let ((Hyp (cdr V2491))) (begin (kl:shen.incinfs) (kl:bind V2732 (cons (cons (kl:shen.lazyderef X V2733) (cons (quote :) (cons (kl:shen.lazyderef A V2733) (quote ())))) (cons (cons (kl:shen.lazyderef Y V2733) (cons (quote :) (cons (kl:shen.lazyderef B V2733) (quote ())))) (kl:shen.lazyderef Hyp V2733))) V2733 V2734))))) (begin (kl:shen.unbindv V2514 V2733) Result))) #f))))) (begin (kl:shen.unbindv V2502 V2733) Result)))) #f)))) (if (kl:shen.pvar? V2501) (let ((A (kl:shen.newpv V2733))) (let ((B (kl:shen.newpv V2733))) (begin (kl:shen.bindv V2501 (cons A (cons (quote *) (cons B (quote ())))) V2733) (let ((Result (let ((V2515 (kl:shen.lazyderef (cdr V2500) V2733))) (if (null? V2515) (let ((Hyp (cdr V2491))) (begin (kl:shen.incinfs) (kl:bind V2732 (cons (cons (kl:shen.lazyderef X V2733) (cons (quote :) (cons (kl:shen.lazyderef A V2733) (quote ())))) (cons (cons (kl:shen.lazyderef Y V2733) (cons (quote :) (cons (kl:shen.lazyderef B V2733) (quote ())))) (kl:shen.lazyderef Hyp V2733))) V2733 V2734))) (if (kl:shen.pvar? V2515) (begin (kl:shen.bindv V2515 (quote ()) V2733) (let ((Result (let ((Hyp (cdr V2491))) (begin (kl:shen.incinfs) (kl:bind V2732 (cons (cons (kl:shen.lazyderef X V2733) (cons (quote :) (cons (kl:shen.lazyderef A V2733) (quote ())))) (cons (cons (kl:shen.lazyderef Y V2733) (cons (quote :) (cons (kl:shen.lazyderef B V2733) (quote ())))) (kl:shen.lazyderef Hyp V2733))) V2733 V2734))))) (begin (kl:shen.unbindv V2515 V2733) Result))) #f))))) (begin (kl:shen.unbindv V2501 V2733) Result))))) #f))) #f)) #f)) #f)) #f))) #f))) #f)) #f)) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V2516 (kl:shen.lazyderef V2731 V2733))) (if (pair? V2516) (let ((V2517 (kl:shen.lazyderef (car V2516) V2733))) (if (pair? V2517) (let ((V2518 (kl:shen.lazyderef (car V2517) V2733))) (if (pair? V2518) (let ((V2519 (kl:shen.lazyderef (car V2518) V2733))) (if (eq? (quote _waspvm_at_v) V2519) (let ((V2520 (kl:shen.lazyderef (cdr V2518) V2733))) (if (pair? V2520) (let ((X (car V2520))) (let ((V2521 (kl:shen.lazyderef (cdr V2520) V2733))) (if (pair? V2521) (let ((Y (car V2521))) (let ((V2522 (kl:shen.lazyderef (cdr V2521) V2733))) (if (null? V2522) (let ((V2523 (kl:shen.lazyderef (cdr V2517) V2733))) (if (pair? V2523) (let ((V2524 (kl:shen.lazyderef (car V2523) V2733))) (if (eq? (quote :) V2524) (let ((V2525 (kl:shen.lazyderef (cdr V2523) V2733))) (if (pair? V2525) (let ((V2526 (kl:shen.lazyderef (car V2525) V2733))) (if (pair? V2526) (let ((V2527 (kl:shen.lazyderef (car V2526) V2733))) (if (eq? (quote vector) V2527) (let ((V2528 (kl:shen.lazyderef (cdr V2526) V2733))) (if (pair? V2528) (let ((A (car V2528))) (let ((V2529 (kl:shen.lazyderef (cdr V2528) V2733))) (if (null? V2529) (let ((V2530 (kl:shen.lazyderef (cdr V2525) V2733))) (if (null? V2530) (let ((Hyp (cdr V2516))) (begin (kl:shen.incinfs) (kl:bind V2732 (cons (cons (kl:shen.lazyderef X V2733) (cons (quote :) (cons (kl:shen.lazyderef A V2733) (quote ())))) (cons (cons (kl:shen.lazyderef Y V2733) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V2733) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V2733))) V2733 V2734))) (if (kl:shen.pvar? V2530) (begin (kl:shen.bindv V2530 (quote ()) V2733) (let ((Result (let ((Hyp (cdr V2516))) (begin (kl:shen.incinfs) (kl:bind V2732 (cons (cons (kl:shen.lazyderef X V2733) (cons (quote :) (cons (kl:shen.lazyderef A V2733) (quote ())))) (cons (cons (kl:shen.lazyderef Y V2733) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V2733) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V2733))) V2733 V2734))))) (begin (kl:shen.unbindv V2530 V2733) Result))) #f))) (if (kl:shen.pvar? V2529) (begin (kl:shen.bindv V2529 (quote ()) V2733) (let ((Result (let ((V2531 (kl:shen.lazyderef (cdr V2525) V2733))) (if (null? V2531) (let ((Hyp (cdr V2516))) (begin (kl:shen.incinfs) (kl:bind V2732 (cons (cons (kl:shen.lazyderef X V2733) (cons (quote :) (cons (kl:shen.lazyderef A V2733) (quote ())))) (cons (cons (kl:shen.lazyderef Y V2733) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V2733) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V2733))) V2733 V2734))) (if (kl:shen.pvar? V2531) (begin (kl:shen.bindv V2531 (quote ()) V2733) (let ((Result (let ((Hyp (cdr V2516))) (begin (kl:shen.incinfs) (kl:bind V2732 (cons (cons (kl:shen.lazyderef X V2733) (cons (quote :) (cons (kl:shen.lazyderef A V2733) (quote ())))) (cons (cons (kl:shen.lazyderef Y V2733) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V2733) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V2733))) V2733 V2734))))) (begin (kl:shen.unbindv V2531 V2733) Result))) #f))))) (begin (kl:shen.unbindv V2529 V2733) Result))) #f)))) (if (kl:shen.pvar? V2528) (let ((A (kl:shen.newpv V2733))) (begin (kl:shen.bindv V2528 (cons A (quote ())) V2733) (let ((Result (let ((V2532 (kl:shen.lazyderef (cdr V2525) V2733))) (if (null? V2532) (let ((Hyp (cdr V2516))) (begin (kl:shen.incinfs) (kl:bind V2732 (cons (cons (kl:shen.lazyderef X V2733) (cons (quote :) (cons (kl:shen.lazyderef A V2733) (quote ())))) (cons (cons (kl:shen.lazyderef Y V2733) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V2733) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V2733))) V2733 V2734))) (if (kl:shen.pvar? V2532) (begin (kl:shen.bindv V2532 (quote ()) V2733) (let ((Result (let ((Hyp (cdr V2516))) (begin (kl:shen.incinfs) (kl:bind V2732 (cons (cons (kl:shen.lazyderef X V2733) (cons (quote :) (cons (kl:shen.lazyderef A V2733) (quote ())))) (cons (cons (kl:shen.lazyderef Y V2733) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V2733) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V2733))) V2733 V2734))))) (begin (kl:shen.unbindv V2532 V2733) Result))) #f))))) (begin (kl:shen.unbindv V2528 V2733) Result)))) #f))) (if (kl:shen.pvar? V2527) (begin (kl:shen.bindv V2527 (quote vector) V2733) (let ((Result (let ((V2533 (kl:shen.lazyderef (cdr V2526) V2733))) (if (pair? V2533) (let ((A (car V2533))) (let ((V2534 (kl:shen.lazyderef (cdr V2533) V2733))) (if (null? V2534) (let ((V2535 (kl:shen.lazyderef (cdr V2525) V2733))) (if (null? V2535) (let ((Hyp (cdr V2516))) (begin (kl:shen.incinfs) (kl:bind V2732 (cons (cons (kl:shen.lazyderef X V2733) (cons (quote :) (cons (kl:shen.lazyderef A V2733) (quote ())))) (cons (cons (kl:shen.lazyderef Y V2733) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V2733) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V2733))) V2733 V2734))) (if (kl:shen.pvar? V2535) (begin (kl:shen.bindv V2535 (quote ()) V2733) (let ((Result (let ((Hyp (cdr V2516))) (begin (kl:shen.incinfs) (kl:bind V2732 (cons (cons (kl:shen.lazyderef X V2733) (cons (quote :) (cons (kl:shen.lazyderef A V2733) (quote ())))) (cons (cons (kl:shen.lazyderef Y V2733) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V2733) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V2733))) V2733 V2734))))) (begin (kl:shen.unbindv V2535 V2733) Result))) #f))) (if (kl:shen.pvar? V2534) (begin (kl:shen.bindv V2534 (quote ()) V2733) (let ((Result (let ((V2536 (kl:shen.lazyderef (cdr V2525) V2733))) (if (null? V2536) (let ((Hyp (cdr V2516))) (begin (kl:shen.incinfs) (kl:bind V2732 (cons (cons (kl:shen.lazyderef X V2733) (cons (quote :) (cons (kl:shen.lazyderef A V2733) (quote ())))) (cons (cons (kl:shen.lazyderef Y V2733) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V2733) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V2733))) V2733 V2734))) (if (kl:shen.pvar? V2536) (begin (kl:shen.bindv V2536 (quote ()) V2733) (let ((Result (let ((Hyp (cdr V2516))) (begin (kl:shen.incinfs) (kl:bind V2732 (cons (cons (kl:shen.lazyderef X V2733) (cons (quote :) (cons (kl:shen.lazyderef A V2733) (quote ())))) (cons (cons (kl:shen.lazyderef Y V2733) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V2733) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V2733))) V2733 V2734))))) (begin (kl:shen.unbindv V2536 V2733) Result))) #f))))) (begin (kl:shen.unbindv V2534 V2733) Result))) #f)))) (if (kl:shen.pvar? V2533) (let ((A (kl:shen.newpv V2733))) (begin (kl:shen.bindv V2533 (cons A (quote ())) V2733) (let ((Result (let ((V2537 (kl:shen.lazyderef (cdr V2525) V2733))) (if (null? V2537) (let ((Hyp (cdr V2516))) (begin (kl:shen.incinfs) (kl:bind V2732 (cons (cons (kl:shen.lazyderef X V2733) (cons (quote :) (cons (kl:shen.lazyderef A V2733) (quote ())))) (cons (cons (kl:shen.lazyderef Y V2733) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V2733) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V2733))) V2733 V2734))) (if (kl:shen.pvar? V2537) (begin (kl:shen.bindv V2537 (quote ()) V2733) (let ((Result (let ((Hyp (cdr V2516))) (begin (kl:shen.incinfs) (kl:bind V2732 (cons (cons (kl:shen.lazyderef X V2733) (cons (quote :) (cons (kl:shen.lazyderef A V2733) (quote ())))) (cons (cons (kl:shen.lazyderef Y V2733) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V2733) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V2733))) V2733 V2734))))) (begin (kl:shen.unbindv V2537 V2733) Result))) #f))))) (begin (kl:shen.unbindv V2533 V2733) Result)))) #f))))) (begin (kl:shen.unbindv V2527 V2733) Result))) #f))) (if (kl:shen.pvar? V2526) (let ((A (kl:shen.newpv V2733))) (begin (kl:shen.bindv V2526 (cons (quote vector) (cons A (quote ()))) V2733) (let ((Result (let ((V2538 (kl:shen.lazyderef (cdr V2525) V2733))) (if (null? V2538) (let ((Hyp (cdr V2516))) (begin (kl:shen.incinfs) (kl:bind V2732 (cons (cons (kl:shen.lazyderef X V2733) (cons (quote :) (cons (kl:shen.lazyderef A V2733) (quote ())))) (cons (cons (kl:shen.lazyderef Y V2733) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V2733) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V2733))) V2733 V2734))) (if (kl:shen.pvar? V2538) (begin (kl:shen.bindv V2538 (quote ()) V2733) (let ((Result (let ((Hyp (cdr V2516))) (begin (kl:shen.incinfs) (kl:bind V2732 (cons (cons (kl:shen.lazyderef X V2733) (cons (quote :) (cons (kl:shen.lazyderef A V2733) (quote ())))) (cons (cons (kl:shen.lazyderef Y V2733) (cons (quote :) (cons (cons (quote vector) (cons (kl:shen.lazyderef A V2733) (quote ()))) (quote ())))) (kl:shen.lazyderef Hyp V2733))) V2733 V2734))))) (begin (kl:shen.unbindv V2538 V2733) Result))) #f))))) (begin (kl:shen.unbindv V2526 V2733) Result)))) #f))) #f)) #f)) #f)) #f))) #f))) #f)) #f)) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V2539 (kl:shen.lazyderef V2731 V2733))) (if (pair? V2539) (let ((V2540 (kl:shen.lazyderef (car V2539) V2733))) (if (pair? V2540) (let ((V2541 (kl:shen.lazyderef (car V2540) V2733))) (if (pair? V2541) (let ((V2542 (kl:shen.lazyderef (car V2541) V2733))) (if (eq? (quote _waspvm_at_s) V2542) (let ((V2543 (kl:shen.lazyderef (cdr V2541) V2733))) (if (pair? V2543) (let ((X (car V2543))) (let ((V2544 (kl:shen.lazyderef (cdr V2543) V2733))) (if (pair? V2544) (let ((Y (car V2544))) (let ((V2545 (kl:shen.lazyderef (cdr V2544) V2733))) (if (null? V2545) (let ((V2546 (kl:shen.lazyderef (cdr V2540) V2733))) (if (pair? V2546) (let ((V2547 (kl:shen.lazyderef (car V2546) V2733))) (if (eq? (quote :) V2547) (let ((V2548 (kl:shen.lazyderef (cdr V2546) V2733))) (if (pair? V2548) (let ((V2549 (kl:shen.lazyderef (car V2548) V2733))) (if (eq? (quote string) V2549) (let ((V2550 (kl:shen.lazyderef (cdr V2548) V2733))) (if (null? V2550) (let ((Hyp (cdr V2539))) (begin (kl:shen.incinfs) (kl:bind V2732 (cons (cons (kl:shen.lazyderef X V2733) (cons (quote :) (cons (quote string) (quote ())))) (cons (cons (kl:shen.lazyderef Y V2733) (cons (quote :) (cons (quote string) (quote ())))) (kl:shen.lazyderef Hyp V2733))) V2733 V2734))) (if (kl:shen.pvar? V2550) (begin (kl:shen.bindv V2550 (quote ()) V2733) (let ((Result (let ((Hyp (cdr V2539))) (begin (kl:shen.incinfs) (kl:bind V2732 (cons (cons (kl:shen.lazyderef X V2733) (cons (quote :) (cons (quote string) (quote ())))) (cons (cons (kl:shen.lazyderef Y V2733) (cons (quote :) (cons (quote string) (quote ())))) (kl:shen.lazyderef Hyp V2733))) V2733 V2734))))) (begin (kl:shen.unbindv V2550 V2733) Result))) #f))) (if (kl:shen.pvar? V2549) (begin (kl:shen.bindv V2549 (quote string) V2733) (let ((Result (let ((V2551 (kl:shen.lazyderef (cdr V2548) V2733))) (if (null? V2551) (let ((Hyp (cdr V2539))) (begin (kl:shen.incinfs) (kl:bind V2732 (cons (cons (kl:shen.lazyderef X V2733) (cons (quote :) (cons (quote string) (quote ())))) (cons (cons (kl:shen.lazyderef Y V2733) (cons (quote :) (cons (quote string) (quote ())))) (kl:shen.lazyderef Hyp V2733))) V2733 V2734))) (if (kl:shen.pvar? V2551) (begin (kl:shen.bindv V2551 (quote ()) V2733) (let ((Result (let ((Hyp (cdr V2539))) (begin (kl:shen.incinfs) (kl:bind V2732 (cons (cons (kl:shen.lazyderef X V2733) (cons (quote :) (cons (quote string) (quote ())))) (cons (cons (kl:shen.lazyderef Y V2733) (cons (quote :) (cons (quote string) (quote ())))) (kl:shen.lazyderef Hyp V2733))) V2733 V2734))))) (begin (kl:shen.unbindv V2551 V2733) Result))) #f))))) (begin (kl:shen.unbindv V2549 V2733) Result))) #f))) #f)) #f)) #f)) #f))) #f))) #f)) #f)) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((V2552 (kl:shen.lazyderef V2731 V2733))) (if (pair? V2552) (let ((X (car V2552))) (let ((Hyp (cdr V2552))) (let ((NewHyps (kl:shen.newpv V2733))) (begin (kl:shen.incinfs) (kl:bind V2732 (cons (kl:shen.lazyderef X V2733) (kl:shen.lazyderef NewHyps V2733)) V2733 (lambda () (kl:shen.t*-hyps Hyp NewHyps V2733 V2734))))))) #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 V2751 V2752 V2753 V2754) (cond ((assert-boolean (kl:value (quote shen.*spy*))) (begin (kl:shen.line) (begin (kl:shen.show-p (kl:shen.deref V2751 V2753)) (begin (kl:nl 1) (begin (kl:nl 1) (begin (kl:shen.show-assumptions (kl:shen.deref V2752 V2753) 1) (begin (kl:shen.prhush "\n> " (kl:stoutput)) (begin (kl:shen.pause-for-user) (kl:thaw V2754))))))))) (#t (kl:thaw V2754)))) (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 V3917) (cond ((and (pair? V3917) (and (pair? (cdr V3917)) (and (eq? (quote :) (car (cdr V3917))) (and (pair? (cdr (cdr V3917))) (null? (cdr (cdr (cdr V3917)))))))) (kl:shen.prhush (kl:shen.app (car V3917) (string-append " : " (kl:shen.app (car (cdr (cdr V3917))) "" (quote shen.r))) (quote shen.r)) (kl:stoutput))) (#t (kl:shen.prhush (kl:shen.app V3917 "" (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 V3922 V3923) (cond ((null? V3922) (quote shen.skip)) ((pair? V3922) (begin (kl:shen.prhush (kl:shen.app V3923 ". " (quote shen.a)) (kl:stoutput)) (begin (kl:shen.show-p (car V3922)) (begin (kl:nl 1) (kl:shen.show-assumptions (cdr V3922) (+ V3923 1)))))) (#t (kl:shen.f_error (quote shen.show-assumptions))))) (export shen.show-assumptions) (quote shen.show-assumptions)) +(begin (register-function-arity (quote shen.show-p) 1) (define (kl:shen.show-p V2756) (cond ((and (pair? V2756) (and (pair? (cdr V2756)) (and (eq? (quote :) (car (cdr V2756))) (and (pair? (cdr (cdr V2756))) (null? (cdr (cdr (cdr V2756)))))))) (kl:shen.prhush (kl:shen.app (car V2756) (string-append " : " (kl:shen.app (car (cdr (cdr V2756))) "" (quote shen.r))) (quote shen.r)) (kl:stoutput))) (#t (kl:shen.prhush (kl:shen.app V2756 "" (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 V2761 V2762) (cond ((null? V2761) (quote shen.skip)) ((pair? V2761) (begin (kl:shen.prhush (kl:shen.app V2762 ". " (quote shen.a)) (kl:stoutput)) (begin (kl:shen.show-p (car V2761)) (begin (kl:nl 1) (kl:shen.show-assumptions (cdr V2761) (+ V2762 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? V3925) (pair? (kl:assoc V3925 (kl:value (quote shen.*signedfuncs*))))) (export shen.typedf?) (quote shen.typedf?)) -(begin (register-function-arity (quote shen.sigf) 1) (define (kl:shen.sigf V3927) (kl:concat (quote shen.type-signature-of-) V3927)) (export shen.sigf) (quote shen.sigf)) +(begin (register-function-arity (quote shen.typedf?) 1) (define (kl:shen.typedf? V2764) (pair? (kl:assoc V2764 (kl:value (quote shen.*signedfuncs*))))) (export shen.typedf?) (quote shen.typedf?)) +(begin (register-function-arity (quote shen.sigf) 1) (define (kl:shen.sigf V2766) (kl:concat (quote shen.type-signature-of-) V2766)) (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 V3932 V3933 V3934 V3935) (let ((Case (let ((V3616 (kl:shen.lazyderef V3933 V3934))) (if (eq? (quote number) V3616) (begin (kl:shen.incinfs) (kl:fwhen (number? (kl:shen.lazyderef V3932 V3934)) V3934 V3935)) (if (kl:shen.pvar? V3616) (begin (kl:shen.bindv V3616 (quote number) V3934) (let ((Result (begin (kl:shen.incinfs) (kl:fwhen (number? (kl:shen.lazyderef V3932 V3934)) V3934 V3935)))) (begin (kl:shen.unbindv V3616 V3934) Result))) #f))))) (if (kl:= Case #f) (let ((Case (let ((V3617 (kl:shen.lazyderef V3933 V3934))) (if (eq? (quote boolean) V3617) (begin (kl:shen.incinfs) (kl:fwhen (kl:boolean? (kl:shen.lazyderef V3932 V3934)) V3934 V3935)) (if (kl:shen.pvar? V3617) (begin (kl:shen.bindv V3617 (quote boolean) V3934) (let ((Result (begin (kl:shen.incinfs) (kl:fwhen (kl:boolean? (kl:shen.lazyderef V3932 V3934)) V3934 V3935)))) (begin (kl:shen.unbindv V3617 V3934) Result))) #f))))) (if (kl:= Case #f) (let ((Case (let ((V3618 (kl:shen.lazyderef V3933 V3934))) (if (eq? (quote string) V3618) (begin (kl:shen.incinfs) (kl:fwhen (string? (kl:shen.lazyderef V3932 V3934)) V3934 V3935)) (if (kl:shen.pvar? V3618) (begin (kl:shen.bindv V3618 (quote string) V3934) (let ((Result (begin (kl:shen.incinfs) (kl:fwhen (string? (kl:shen.lazyderef V3932 V3934)) V3934 V3935)))) (begin (kl:shen.unbindv V3618 V3934) Result))) #f))))) (if (kl:= Case #f) (let ((Case (let ((V3619 (kl:shen.lazyderef V3933 V3934))) (if (eq? (quote symbol) V3619) (begin (kl:shen.incinfs) (kl:fwhen (kl:symbol? (kl:shen.lazyderef V3932 V3934)) V3934 (lambda () (kl:fwhen (kl:not (kl:shen.ue? (kl:shen.lazyderef V3932 V3934))) V3934 V3935)))) (if (kl:shen.pvar? V3619) (begin (kl:shen.bindv V3619 (quote symbol) V3934) (let ((Result (begin (kl:shen.incinfs) (kl:fwhen (kl:symbol? (kl:shen.lazyderef V3932 V3934)) V3934 (lambda () (kl:fwhen (kl:not (kl:shen.ue? (kl:shen.lazyderef V3932 V3934))) V3934 V3935)))))) (begin (kl:shen.unbindv V3619 V3934) Result))) #f))))) (if (kl:= Case #f) (let ((V3620 (kl:shen.lazyderef V3932 V3934))) (if (null? V3620) (let ((V3621 (kl:shen.lazyderef V3933 V3934))) (if (pair? V3621) (let ((V3622 (kl:shen.lazyderef (car V3621) V3934))) (if (eq? (quote list) V3622) (let ((V3623 (kl:shen.lazyderef (cdr V3621) V3934))) (if (pair? V3623) (let ((A (car V3623))) (let ((V3624 (kl:shen.lazyderef (cdr V3623) V3934))) (if (null? V3624) (begin (kl:shen.incinfs) (kl:thaw V3935)) (if (kl:shen.pvar? V3624) (begin (kl:shen.bindv V3624 (quote ()) V3934) (let ((Result (begin (kl:shen.incinfs) (kl:thaw V3935)))) (begin (kl:shen.unbindv V3624 V3934) Result))) #f)))) (if (kl:shen.pvar? V3623) (let ((A (kl:shen.newpv V3934))) (begin (kl:shen.bindv V3623 (cons A (quote ())) V3934) (let ((Result (begin (kl:shen.incinfs) (kl:thaw V3935)))) (begin (kl:shen.unbindv V3623 V3934) Result)))) #f))) (if (kl:shen.pvar? V3622) (begin (kl:shen.bindv V3622 (quote list) V3934) (let ((Result (let ((V3625 (kl:shen.lazyderef (cdr V3621) V3934))) (if (pair? V3625) (let ((A (car V3625))) (let ((V3626 (kl:shen.lazyderef (cdr V3625) V3934))) (if (null? V3626) (begin (kl:shen.incinfs) (kl:thaw V3935)) (if (kl:shen.pvar? V3626) (begin (kl:shen.bindv V3626 (quote ()) V3934) (let ((Result (begin (kl:shen.incinfs) (kl:thaw V3935)))) (begin (kl:shen.unbindv V3626 V3934) Result))) #f)))) (if (kl:shen.pvar? V3625) (let ((A (kl:shen.newpv V3934))) (begin (kl:shen.bindv V3625 (cons A (quote ())) V3934) (let ((Result (begin (kl:shen.incinfs) (kl:thaw V3935)))) (begin (kl:shen.unbindv V3625 V3934) Result)))) #f))))) (begin (kl:shen.unbindv V3622 V3934) Result))) #f))) (if (kl:shen.pvar? V3621) (let ((A (kl:shen.newpv V3934))) (begin (kl:shen.bindv V3621 (cons (quote list) (cons A (quote ()))) V3934) (let ((Result (begin (kl:shen.incinfs) (kl:thaw V3935)))) (begin (kl:shen.unbindv V3621 V3934) 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 V3941 V3942 V3943 V3944 V3945) (let ((Case (let ((V3607 (kl:shen.lazyderef V3943 V3944))) (if (pair? V3607) (let ((V3608 (kl:shen.lazyderef (car V3607) V3944))) (if (pair? V3608) (let ((Y (car V3608))) (let ((V3609 (kl:shen.lazyderef (cdr V3608) V3944))) (if (pair? V3609) (let ((V3610 (kl:shen.lazyderef (car V3609) V3944))) (if (eq? (quote :) V3610) (let ((V3611 (kl:shen.lazyderef (cdr V3609) V3944))) (if (pair? V3611) (let ((B (car V3611))) (let ((V3612 (kl:shen.lazyderef (cdr V3611) V3944))) (if (null? V3612) (begin (kl:shen.incinfs) (kl:identical V3941 Y V3944 (lambda () (kl:unify! V3942 B V3944 V3945)))) #f))) #f)) #f)) #f))) #f)) #f)))) (if (kl:= Case #f) (let ((V3613 (kl:shen.lazyderef V3943 V3944))) (if (pair? V3613) (let ((Hyp (cdr V3613))) (begin (kl:shen.incinfs) (kl:shen.by_hypothesis V3941 V3942 Hyp V3944 V3945))) #f)) Case))) (export shen.by_hypothesis) (quote shen.by_hypothesis)) -(begin (register-function-arity (quote shen.t*-def) 5) (define (kl:shen.t*-def V3951 V3952 V3953 V3954 V3955) (let ((V3601 (kl:shen.lazyderef V3951 V3954))) (if (pair? V3601) (let ((V3602 (kl:shen.lazyderef (car V3601) V3954))) (if (eq? (quote define) V3602) (let ((V3603 (kl:shen.lazyderef (cdr V3601) V3954))) (if (pair? V3603) (let ((F (car V3603))) (let ((X (cdr V3603))) (let ((Y (kl:shen.newpv V3954))) (let ((E (kl:shen.newpv V3954))) (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 V3952 V3953 V3954 V3955)))))) #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 V3962 V3963 V3964 V3965 V3966 V3967) (let ((V3597 (kl:shen.lazyderef V3962 V3966))) (if (pair? V3597) (let ((Sig (car V3597))) (let ((Rules (cdr V3597))) (begin (kl:shen.incinfs) (kl:shen.t*-defhh Sig (kl:shen.ue-sig Sig) V3963 V3964 V3965 Rules V3966 V3967)))) #f))) (export shen.t*-defh) (quote shen.t*-defh)) -(begin (register-function-arity (quote shen.t*-defhh) 8) (define (kl:shen.t*-defhh V3976 V3977 V3978 V3979 V3980 V3981 V3982 V3983) (begin (kl:shen.incinfs) (kl:shen.t*-rules V3981 V3977 1 V3978 (cons (cons V3978 (cons (quote :) (cons V3977 (quote ())))) V3980) V3982 (lambda () (kl:shen.memo V3978 V3976 V3979 V3982 V3983))))) (export shen.t*-defhh) (quote shen.t*-defhh)) -(begin (register-function-arity (quote shen.memo) 5) (define (kl:shen.memo V3989 V3990 V3991 V3992 V3993) (let ((Jnk (kl:shen.newpv V3992))) (begin (kl:shen.incinfs) (kl:unify! V3991 V3990 V3992 (lambda () (kl:bind Jnk (kl:declare (kl:shen.lazyderef V3989 V3992) (kl:shen.lazyderef V3991 V3992)) V3992 V3993)))))) (export shen.memo) (quote shen.memo)) -(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V3995) (let ((Parse_shen. (kl:shen. V3995))) (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. V3997) (let ((YaccParse (let ((Parse_shen. (kl:shen. V3997))) (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. V3997))) (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 V3999) (cond ((and (pair? V3999) (and (pair? (cdr V3999)) (and (null? (cdr (cdr V3999))) (eq? (car V3999) (quote protect))))) V3999) ((pair? V3999) (kl:map (lambda (Z) (kl:shen.ue Z)) V3999)) ((kl:variable? V3999) (kl:concat (quote &&) V3999)) (#t V3999))) (export shen.ue) (quote shen.ue)) -(begin (register-function-arity (quote shen.ue-sig) 1) (define (kl:shen.ue-sig V4001) (cond ((pair? V4001) (kl:map (lambda (Z) (kl:shen.ue-sig Z)) V4001)) ((kl:variable? V4001) (kl:concat (quote &&&) V4001)) (#t V4001))) (export shen.ue-sig) (quote shen.ue-sig)) -(begin (register-function-arity (quote shen.ues) 1) (define (kl:shen.ues V4007) (cond ((assert-boolean (kl:shen.ue? V4007)) (cons V4007 (quote ()))) ((pair? V4007) (kl:union (kl:shen.ues (car V4007)) (kl:shen.ues (cdr V4007)))) (#t (quote ())))) (export shen.ues) (quote shen.ues)) -(begin (register-function-arity (quote shen.ue?) 1) (define (kl:shen.ue? V4009) (and (kl:symbol? V4009) (assert-boolean (kl:shen.ue-h? (kl:str V4009))))) (export shen.ue?) (quote shen.ue?)) -(begin (register-function-arity (quote shen.ue-h?) 1) (define (kl:shen.ue-h? V4017) (cond ((and (assert-boolean (kl:shen.+string? V4017)) (and (equal? "&" (make-string 1 (string-ref V4017 0))) (and (assert-boolean (kl:shen.+string? (string-tail V4017 1))) (equal? "&" (make-string 1 (string-ref (string-tail V4017 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 V4025 V4026 V4027 V4028 V4029 V4030 V4031) (let ((Throwcontrol (kl:shen.catchpoint))) (kl:shen.cutpoint Throwcontrol (let ((Case (let ((V3581 (kl:shen.lazyderef V4025 V4030))) (if (null? V3581) (begin (kl:shen.incinfs) (kl:thaw V4031)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3582 (kl:shen.lazyderef V4025 V4030))) (if (pair? V3582) (let ((Rule (car V3582))) (let ((Rules (cdr V3582))) (begin (kl:shen.incinfs) (kl:shen.t*-rule (kl:shen.ue Rule) V4026 V4029 V4030 (lambda () (kl:cut Throwcontrol V4030 (lambda () (kl:shen.t*-rules Rules V4026 (+ V4027 1) V4028 V4029 V4030 V4031)))))))) #f)))) (if (kl:= Case #f) (let ((Err (kl:shen.newpv V4030))) (begin (kl:shen.incinfs) (kl:bind Err (simple-error (string-append "type error in rule " (kl:shen.app (kl:shen.lazyderef V4027 V4030) (string-append " of " (kl:shen.app (kl:shen.lazyderef V4028 V4030) "" (quote shen.a))) (quote shen.a)))) V4030 V4031))) Case)) Case))))) (export shen.t*-rules) (quote shen.t*-rules)) -(begin (register-function-arity (quote shen.t*-rule) 5) (define (kl:shen.t*-rule V4037 V4038 V4039 V4040 V4041) (let ((Throwcontrol (kl:shen.catchpoint))) (kl:shen.cutpoint Throwcontrol (let ((V3573 (kl:shen.lazyderef V4037 V4040))) (if (pair? V3573) (let ((Patterns (car V3573))) (let ((V3574 (kl:shen.lazyderef (cdr V3573) V4040))) (if (pair? V3574) (let ((Action (car V3574))) (let ((V3575 (kl:shen.lazyderef (cdr V3574) V4040))) (if (null? V3575) (let ((NewHyps (kl:shen.newpv V4040))) (begin (kl:shen.incinfs) (kl:shen.newhyps (kl:shen.placeholders Patterns) V4039 NewHyps V4040 (lambda () (kl:shen.t*-patterns Patterns V4038 NewHyps V4040 (lambda () (kl:cut Throwcontrol V4040 (lambda () (kl:shen.t*-action (kl:shen.curry (kl:shen.ue Action)) (kl:shen.result-type Patterns V4038) (kl:shen.patthyps Patterns V4038 V4039) V4040 V4041))))))))) #f))) #f))) #f))))) (export shen.t*-rule) (quote shen.t*-rule)) -(begin (register-function-arity (quote shen.placeholders) 1) (define (kl:shen.placeholders V4047) (cond ((assert-boolean (kl:shen.ue? V4047)) (cons V4047 (quote ()))) ((pair? V4047) (kl:union (kl:shen.placeholders (car V4047)) (kl:shen.placeholders (cdr V4047)))) (#t (quote ())))) (export shen.placeholders) (quote shen.placeholders)) -(begin (register-function-arity (quote shen.newhyps) 5) (define (kl:shen.newhyps V4053 V4054 V4055 V4056 V4057) (let ((Case (let ((V3560 (kl:shen.lazyderef V4053 V4056))) (if (null? V3560) (begin (kl:shen.incinfs) (kl:unify! V4055 V4054 V4056 V4057)) #f)))) (if (kl:= Case #f) (let ((V3561 (kl:shen.lazyderef V4053 V4056))) (if (pair? V3561) (let ((V3556 (car V3561))) (let ((Vs (cdr V3561))) (let ((V3562 (kl:shen.lazyderef V4055 V4056))) (if (pair? V3562) (let ((V3563 (kl:shen.lazyderef (car V3562) V4056))) (if (pair? V3563) (let ((V (car V3563))) (let ((V3564 (kl:shen.lazyderef (cdr V3563) V4056))) (if (pair? V3564) (let ((V3565 (kl:shen.lazyderef (car V3564) V4056))) (if (eq? (quote :) V3565) (let ((V3566 (kl:shen.lazyderef (cdr V3564) V4056))) (if (pair? V3566) (let ((A (car V3566))) (let ((V3567 (kl:shen.lazyderef (cdr V3566) V4056))) (if (null? V3567) (let ((NewHyp (cdr V3562))) (begin (kl:shen.incinfs) (kl:unify! V V3556 V4056 (lambda () (kl:shen.newhyps Vs V4054 NewHyp V4056 V4057))))) (if (kl:shen.pvar? V3567) (begin (kl:shen.bindv V3567 (quote ()) V4056) (let ((Result (let ((NewHyp (cdr V3562))) (begin (kl:shen.incinfs) (kl:unify! V V3556 V4056 (lambda () (kl:shen.newhyps Vs V4054 NewHyp V4056 V4057))))))) (begin (kl:shen.unbindv V3567 V4056) Result))) #f)))) (if (kl:shen.pvar? V3566) (let ((A (kl:shen.newpv V4056))) (begin (kl:shen.bindv V3566 (cons A (quote ())) V4056) (let ((Result (let ((NewHyp (cdr V3562))) (begin (kl:shen.incinfs) (kl:unify! V V3556 V4056 (lambda () (kl:shen.newhyps Vs V4054 NewHyp V4056 V4057))))))) (begin (kl:shen.unbindv V3566 V4056) Result)))) #f))) (if (kl:shen.pvar? V3565) (begin (kl:shen.bindv V3565 (quote :) V4056) (let ((Result (let ((V3568 (kl:shen.lazyderef (cdr V3564) V4056))) (if (pair? V3568) (let ((A (car V3568))) (let ((V3569 (kl:shen.lazyderef (cdr V3568) V4056))) (if (null? V3569) (let ((NewHyp (cdr V3562))) (begin (kl:shen.incinfs) (kl:unify! V V3556 V4056 (lambda () (kl:shen.newhyps Vs V4054 NewHyp V4056 V4057))))) (if (kl:shen.pvar? V3569) (begin (kl:shen.bindv V3569 (quote ()) V4056) (let ((Result (let ((NewHyp (cdr V3562))) (begin (kl:shen.incinfs) (kl:unify! V V3556 V4056 (lambda () (kl:shen.newhyps Vs V4054 NewHyp V4056 V4057))))))) (begin (kl:shen.unbindv V3569 V4056) Result))) #f)))) (if (kl:shen.pvar? V3568) (let ((A (kl:shen.newpv V4056))) (begin (kl:shen.bindv V3568 (cons A (quote ())) V4056) (let ((Result (let ((NewHyp (cdr V3562))) (begin (kl:shen.incinfs) (kl:unify! V V3556 V4056 (lambda () (kl:shen.newhyps Vs V4054 NewHyp V4056 V4057))))))) (begin (kl:shen.unbindv V3568 V4056) Result)))) #f))))) (begin (kl:shen.unbindv V3565 V4056) Result))) #f))) (if (kl:shen.pvar? V3564) (let ((A (kl:shen.newpv V4056))) (begin (kl:shen.bindv V3564 (cons (quote :) (cons A (quote ()))) V4056) (let ((Result (let ((NewHyp (cdr V3562))) (begin (kl:shen.incinfs) (kl:unify! V V3556 V4056 (lambda () (kl:shen.newhyps Vs V4054 NewHyp V4056 V4057))))))) (begin (kl:shen.unbindv V3564 V4056) Result)))) #f)))) (if (kl:shen.pvar? V3563) (let ((V (kl:shen.newpv V4056))) (let ((A (kl:shen.newpv V4056))) (begin (kl:shen.bindv V3563 (cons V (cons (quote :) (cons A (quote ())))) V4056) (let ((Result (let ((NewHyp (cdr V3562))) (begin (kl:shen.incinfs) (kl:unify! V V3556 V4056 (lambda () (kl:shen.newhyps Vs V4054 NewHyp V4056 V4057))))))) (begin (kl:shen.unbindv V3563 V4056) Result))))) #f))) (if (kl:shen.pvar? V3562) (let ((V (kl:shen.newpv V4056))) (let ((A (kl:shen.newpv V4056))) (let ((NewHyp (kl:shen.newpv V4056))) (begin (kl:shen.bindv V3562 (cons (cons V (cons (quote :) (cons A (quote ())))) NewHyp) V4056) (let ((Result (begin (kl:shen.incinfs) (kl:unify! V V3556 V4056 (lambda () (kl:shen.newhyps Vs V4054 NewHyp V4056 V4057)))))) (begin (kl:shen.unbindv V3562 V4056) Result)))))) #f))))) #f)) Case))) (export shen.newhyps) (quote shen.newhyps)) -(begin (register-function-arity (quote shen.patthyps) 3) (define (kl:shen.patthyps V4063 V4064 V4065) (cond ((null? V4063) V4065) ((and (pair? V4063) (and (pair? V4064) (and (pair? (cdr V4064)) (and (eq? (quote -->) (car (cdr V4064))) (and (pair? (cdr (cdr V4064))) (null? (cdr (cdr (cdr V4064))))))))) (kl:adjoin (cons (car V4063) (cons (quote :) (cons (car V4064) (quote ())))) (kl:shen.patthyps (cdr V4063) (car (cdr (cdr V4064))) V4065))) (#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 V4072 V4073) (cond ((and (null? V4072) (and (pair? V4073) (and (eq? (quote -->) (car V4073)) (and (pair? (cdr V4073)) (null? (cdr (cdr V4073))))))) (car (cdr V4073))) ((null? V4072) V4073) ((and (pair? V4072) (and (pair? V4073) (and (pair? (cdr V4073)) (and (eq? (quote -->) (car (cdr V4073))) (and (pair? (cdr (cdr V4073))) (null? (cdr (cdr (cdr V4073))))))))) (kl:shen.result-type (cdr V4072) (car (cdr (cdr V4073))))) (#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 V4079 V4080 V4081 V4082 V4083) (let ((Case (let ((V3548 (kl:shen.lazyderef V4079 V4082))) (if (null? V3548) (begin (kl:shen.incinfs) (kl:thaw V4083)) #f)))) (if (kl:= Case #f) (let ((V3549 (kl:shen.lazyderef V4079 V4082))) (if (pair? V3549) (let ((Pattern (car V3549))) (let ((Patterns (cdr V3549))) (let ((V3550 (kl:shen.lazyderef V4080 V4082))) (if (pair? V3550) (let ((A (car V3550))) (let ((V3551 (kl:shen.lazyderef (cdr V3550) V4082))) (if (pair? V3551) (let ((V3552 (kl:shen.lazyderef (car V3551) V4082))) (if (eq? (quote -->) V3552) (let ((V3553 (kl:shen.lazyderef (cdr V3551) V4082))) (if (pair? V3553) (let ((B (car V3553))) (let ((V3554 (kl:shen.lazyderef (cdr V3553) V4082))) (if (null? V3554) (begin (kl:shen.incinfs) (kl:shen.t* (cons Pattern (cons (quote :) (cons A (quote ())))) V4081 V4082 (lambda () (kl:shen.t*-patterns Patterns B V4081 V4082 V4083)))) #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 V4089 V4090 V4091 V4092 V4093) (let ((Throwcontrol (kl:shen.catchpoint))) (kl:shen.cutpoint Throwcontrol (let ((Case (let ((V3525 (kl:shen.lazyderef V4089 V4092))) (if (pair? V3525) (let ((V3526 (kl:shen.lazyderef (car V3525) V4092))) (if (eq? (quote where) V3526) (let ((V3527 (kl:shen.lazyderef (cdr V3525) V4092))) (if (pair? V3527) (let ((P (car V3527))) (let ((V3528 (kl:shen.lazyderef (cdr V3527) V4092))) (if (pair? V3528) (let ((Action (car V3528))) (let ((V3529 (kl:shen.lazyderef (cdr V3528) V4092))) (if (null? V3529) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V4092 (lambda () (kl:shen.t* (cons P (cons (quote :) (cons (quote boolean) (quote ())))) V4091 V4092 (lambda () (kl:cut Throwcontrol V4092 (lambda () (kl:shen.t*-action Action V4090 (cons (cons P (cons (quote :) (cons (quote verified) (quote ())))) V4091) V4092 V4093)))))))) #f))) #f))) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3530 (kl:shen.lazyderef V4089 V4092))) (if (pair? V3530) (let ((V3531 (kl:shen.lazyderef (car V3530) V4092))) (if (eq? (quote shen.choicepoint!) V3531) (let ((V3532 (kl:shen.lazyderef (cdr V3530) V4092))) (if (pair? V3532) (let ((V3533 (kl:shen.lazyderef (car V3532) V4092))) (if (pair? V3533) (let ((V3534 (kl:shen.lazyderef (car V3533) V4092))) (if (pair? V3534) (let ((V3535 (kl:shen.lazyderef (car V3534) V4092))) (if (eq? (quote fail-if) V3535) (let ((V3536 (kl:shen.lazyderef (cdr V3534) V4092))) (if (pair? V3536) (let ((F (car V3536))) (let ((V3537 (kl:shen.lazyderef (cdr V3536) V4092))) (if (null? V3537) (let ((V3538 (kl:shen.lazyderef (cdr V3533) V4092))) (if (pair? V3538) (let ((Action (car V3538))) (let ((V3539 (kl:shen.lazyderef (cdr V3538) V4092))) (if (null? V3539) (let ((V3540 (kl:shen.lazyderef (cdr V3532) V4092))) (if (null? V3540) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V4092 (lambda () (kl:shen.t*-action (cons (quote where) (cons (cons (quote not) (cons (cons F (cons Action (quote ()))) (quote ()))) (cons Action (quote ())))) V4090 V4091 V4092 V4093)))) #f)) #f))) #f)) #f))) #f)) #f)) #f)) #f)) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V3541 (kl:shen.lazyderef V4089 V4092))) (if (pair? V3541) (let ((V3542 (kl:shen.lazyderef (car V3541) V4092))) (if (eq? (quote shen.choicepoint!) V3542) (let ((V3543 (kl:shen.lazyderef (cdr V3541) V4092))) (if (pair? V3543) (let ((Action (car V3543))) (let ((V3544 (kl:shen.lazyderef (cdr V3543) V4092))) (if (null? V3544) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V4092 (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 ())))) V4090 V4091 V4092 V4093)))) #f))) #f)) #f)) #f)))) (if (kl:= Case #f) (begin (kl:shen.incinfs) (kl:shen.t* (cons V4089 (cons (quote :) (cons V4090 (quote ())))) V4091 V4092 V4093)) Case)) Case)) Case))))) (export shen.t*-action) (quote shen.t*-action)) -(begin (register-function-arity (quote findall) 5) (define (kl:findall V4099 V4100 V4101 V4102 V4103) (let ((B (kl:shen.newpv V4102))) (let ((A (kl:shen.newpv V4102))) (begin (kl:shen.incinfs) (kl:bind A (kl:gensym (quote shen.a)) V4102 (lambda () (kl:bind B (kl:set (kl:shen.lazyderef A V4102) (quote ())) V4102 (lambda () (kl:shen.findallhelp V4099 V4100 V4101 A V4102 V4103))))))))) (export findall) (quote findall)) -(begin (register-function-arity (quote shen.findallhelp) 6) (define (kl:shen.findallhelp V4110 V4111 V4112 V4113 V4114 V4115) (let ((Case (begin (kl:shen.incinfs) (kl:call V4111 V4114 (lambda () (kl:shen.remember V4113 V4110 V4114 (lambda () (kl:fwhen #f V4114 V4115)))))))) (if (kl:= Case #f) (begin (kl:shen.incinfs) (kl:bind V4112 (kl:value (kl:shen.lazyderef V4113 V4114)) V4114 V4115)) Case))) (export shen.findallhelp) (quote shen.findallhelp)) -(begin (register-function-arity (quote shen.remember) 4) (define (kl:shen.remember V4120 V4121 V4122 V4123) (let ((B (kl:shen.newpv V4122))) (begin (kl:shen.incinfs) (kl:bind B (kl:set (kl:shen.deref V4120 V4122) (cons (kl:shen.deref V4121 V4122) (kl:value (kl:shen.deref V4120 V4122)))) V4122 V4123)))) (export shen.remember) (quote shen.remember)) +(begin (register-function-arity (quote shen.base) 4) (define (kl:shen.base V2771 V2772 V2773 V2774) (let ((Case (let ((V2455 (kl:shen.lazyderef V2772 V2773))) (if (eq? (quote number) V2455) (begin (kl:shen.incinfs) (kl:fwhen (number? (kl:shen.lazyderef V2771 V2773)) V2773 V2774)) (if (kl:shen.pvar? V2455) (begin (kl:shen.bindv V2455 (quote number) V2773) (let ((Result (begin (kl:shen.incinfs) (kl:fwhen (number? (kl:shen.lazyderef V2771 V2773)) V2773 V2774)))) (begin (kl:shen.unbindv V2455 V2773) Result))) #f))))) (if (kl:= Case #f) (let ((Case (let ((V2456 (kl:shen.lazyderef V2772 V2773))) (if (eq? (quote boolean) V2456) (begin (kl:shen.incinfs) (kl:fwhen (kl:boolean? (kl:shen.lazyderef V2771 V2773)) V2773 V2774)) (if (kl:shen.pvar? V2456) (begin (kl:shen.bindv V2456 (quote boolean) V2773) (let ((Result (begin (kl:shen.incinfs) (kl:fwhen (kl:boolean? (kl:shen.lazyderef V2771 V2773)) V2773 V2774)))) (begin (kl:shen.unbindv V2456 V2773) Result))) #f))))) (if (kl:= Case #f) (let ((Case (let ((V2457 (kl:shen.lazyderef V2772 V2773))) (if (eq? (quote string) V2457) (begin (kl:shen.incinfs) (kl:fwhen (string? (kl:shen.lazyderef V2771 V2773)) V2773 V2774)) (if (kl:shen.pvar? V2457) (begin (kl:shen.bindv V2457 (quote string) V2773) (let ((Result (begin (kl:shen.incinfs) (kl:fwhen (string? (kl:shen.lazyderef V2771 V2773)) V2773 V2774)))) (begin (kl:shen.unbindv V2457 V2773) Result))) #f))))) (if (kl:= Case #f) (let ((Case (let ((V2458 (kl:shen.lazyderef V2772 V2773))) (if (eq? (quote symbol) V2458) (begin (kl:shen.incinfs) (kl:fwhen (kl:symbol? (kl:shen.lazyderef V2771 V2773)) V2773 (lambda () (kl:fwhen (kl:not (kl:shen.ue? (kl:shen.lazyderef V2771 V2773))) V2773 V2774)))) (if (kl:shen.pvar? V2458) (begin (kl:shen.bindv V2458 (quote symbol) V2773) (let ((Result (begin (kl:shen.incinfs) (kl:fwhen (kl:symbol? (kl:shen.lazyderef V2771 V2773)) V2773 (lambda () (kl:fwhen (kl:not (kl:shen.ue? (kl:shen.lazyderef V2771 V2773))) V2773 V2774)))))) (begin (kl:shen.unbindv V2458 V2773) Result))) #f))))) (if (kl:= Case #f) (let ((V2459 (kl:shen.lazyderef V2771 V2773))) (if (null? V2459) (let ((V2460 (kl:shen.lazyderef V2772 V2773))) (if (pair? V2460) (let ((V2461 (kl:shen.lazyderef (car V2460) V2773))) (if (eq? (quote list) V2461) (let ((V2462 (kl:shen.lazyderef (cdr V2460) V2773))) (if (pair? V2462) (let ((A (car V2462))) (let ((V2463 (kl:shen.lazyderef (cdr V2462) V2773))) (if (null? V2463) (begin (kl:shen.incinfs) (kl:thaw V2774)) (if (kl:shen.pvar? V2463) (begin (kl:shen.bindv V2463 (quote ()) V2773) (let ((Result (begin (kl:shen.incinfs) (kl:thaw V2774)))) (begin (kl:shen.unbindv V2463 V2773) Result))) #f)))) (if (kl:shen.pvar? V2462) (let ((A (kl:shen.newpv V2773))) (begin (kl:shen.bindv V2462 (cons A (quote ())) V2773) (let ((Result (begin (kl:shen.incinfs) (kl:thaw V2774)))) (begin (kl:shen.unbindv V2462 V2773) Result)))) #f))) (if (kl:shen.pvar? V2461) (begin (kl:shen.bindv V2461 (quote list) V2773) (let ((Result (let ((V2464 (kl:shen.lazyderef (cdr V2460) V2773))) (if (pair? V2464) (let ((A (car V2464))) (let ((V2465 (kl:shen.lazyderef (cdr V2464) V2773))) (if (null? V2465) (begin (kl:shen.incinfs) (kl:thaw V2774)) (if (kl:shen.pvar? V2465) (begin (kl:shen.bindv V2465 (quote ()) V2773) (let ((Result (begin (kl:shen.incinfs) (kl:thaw V2774)))) (begin (kl:shen.unbindv V2465 V2773) Result))) #f)))) (if (kl:shen.pvar? V2464) (let ((A (kl:shen.newpv V2773))) (begin (kl:shen.bindv V2464 (cons A (quote ())) V2773) (let ((Result (begin (kl:shen.incinfs) (kl:thaw V2774)))) (begin (kl:shen.unbindv V2464 V2773) Result)))) #f))))) (begin (kl:shen.unbindv V2461 V2773) Result))) #f))) (if (kl:shen.pvar? V2460) (let ((A (kl:shen.newpv V2773))) (begin (kl:shen.bindv V2460 (cons (quote list) (cons A (quote ()))) V2773) (let ((Result (begin (kl:shen.incinfs) (kl:thaw V2774)))) (begin (kl:shen.unbindv V2460 V2773) 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 V2780 V2781 V2782 V2783 V2784) (let ((Case (let ((V2446 (kl:shen.lazyderef V2782 V2783))) (if (pair? V2446) (let ((V2447 (kl:shen.lazyderef (car V2446) V2783))) (if (pair? V2447) (let ((Y (car V2447))) (let ((V2448 (kl:shen.lazyderef (cdr V2447) V2783))) (if (pair? V2448) (let ((V2449 (kl:shen.lazyderef (car V2448) V2783))) (if (eq? (quote :) V2449) (let ((V2450 (kl:shen.lazyderef (cdr V2448) V2783))) (if (pair? V2450) (let ((B (car V2450))) (let ((V2451 (kl:shen.lazyderef (cdr V2450) V2783))) (if (null? V2451) (begin (kl:shen.incinfs) (kl:identical V2780 Y V2783 (lambda () (kl:unify! V2781 B V2783 V2784)))) #f))) #f)) #f)) #f))) #f)) #f)))) (if (kl:= Case #f) (let ((V2452 (kl:shen.lazyderef V2782 V2783))) (if (pair? V2452) (let ((Hyp (cdr V2452))) (begin (kl:shen.incinfs) (kl:shen.by_hypothesis V2780 V2781 Hyp V2783 V2784))) #f)) Case))) (export shen.by_hypothesis) (quote shen.by_hypothesis)) +(begin (register-function-arity (quote shen.t*-def) 5) (define (kl:shen.t*-def V2790 V2791 V2792 V2793 V2794) (let ((V2440 (kl:shen.lazyderef V2790 V2793))) (if (pair? V2440) (let ((V2441 (kl:shen.lazyderef (car V2440) V2793))) (if (eq? (quote define) V2441) (let ((V2442 (kl:shen.lazyderef (cdr V2440) V2793))) (if (pair? V2442) (let ((F (car V2442))) (let ((X (cdr V2442))) (let ((Y (kl:shen.newpv V2793))) (let ((E (kl:shen.newpv V2793))) (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 V2791 V2792 V2793 V2794)))))) #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 V2801 V2802 V2803 V2804 V2805 V2806) (let ((V2436 (kl:shen.lazyderef V2801 V2805))) (if (pair? V2436) (let ((Sig (car V2436))) (let ((Rules (cdr V2436))) (begin (kl:shen.incinfs) (kl:shen.t*-defhh Sig (kl:shen.ue-sig Sig) V2802 V2803 V2804 Rules V2805 V2806)))) #f))) (export shen.t*-defh) (quote shen.t*-defh)) +(begin (register-function-arity (quote shen.t*-defhh) 8) (define (kl:shen.t*-defhh V2815 V2816 V2817 V2818 V2819 V2820 V2821 V2822) (begin (kl:shen.incinfs) (kl:shen.t*-rules V2820 V2816 1 V2817 (cons (cons V2817 (cons (quote :) (cons V2816 (quote ())))) V2819) V2821 (lambda () (kl:shen.memo V2817 V2815 V2818 V2821 V2822))))) (export shen.t*-defhh) (quote shen.t*-defhh)) +(begin (register-function-arity (quote shen.memo) 5) (define (kl:shen.memo V2828 V2829 V2830 V2831 V2832) (let ((Jnk (kl:shen.newpv V2831))) (begin (kl:shen.incinfs) (kl:unify! V2830 V2829 V2831 (lambda () (kl:bind Jnk (kl:declare (kl:shen.lazyderef V2828 V2831) (kl:shen.lazyderef V2830 V2831)) V2831 V2832)))))) (export shen.memo) (quote shen.memo)) +(begin (register-function-arity (quote shen.) 1) (define (kl:shen. V2834) (let ((Parse_shen. (kl:shen. V2834))) (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. V2836) (let ((YaccParse (let ((Parse_shen. (kl:shen. V2836))) (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. V2836))) (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 V2838) (cond ((and (pair? V2838) (and (pair? (cdr V2838)) (and (null? (cdr (cdr V2838))) (eq? (car V2838) (quote protect))))) V2838) ((pair? V2838) (kl:map (lambda (Z) (kl:shen.ue Z)) V2838)) ((kl:variable? V2838) (kl:concat (quote &&) V2838)) (#t V2838))) (export shen.ue) (quote shen.ue)) +(begin (register-function-arity (quote shen.ue-sig) 1) (define (kl:shen.ue-sig V2840) (cond ((pair? V2840) (kl:map (lambda (Z) (kl:shen.ue-sig Z)) V2840)) ((kl:variable? V2840) (kl:concat (quote &&&) V2840)) (#t V2840))) (export shen.ue-sig) (quote shen.ue-sig)) +(begin (register-function-arity (quote shen.ues) 1) (define (kl:shen.ues V2846) (cond ((assert-boolean (kl:shen.ue? V2846)) (cons V2846 (quote ()))) ((pair? V2846) (kl:union (kl:shen.ues (car V2846)) (kl:shen.ues (cdr V2846)))) (#t (quote ())))) (export shen.ues) (quote shen.ues)) +(begin (register-function-arity (quote shen.ue?) 1) (define (kl:shen.ue? V2848) (and (kl:symbol? V2848) (assert-boolean (kl:shen.ue-h? (kl:str V2848))))) (export shen.ue?) (quote shen.ue?)) +(begin (register-function-arity (quote shen.ue-h?) 1) (define (kl:shen.ue-h? V2856) (cond ((and (assert-boolean (kl:shen.+string? V2856)) (and (equal? "&" (make-string 1 (string-ref V2856 0))) (and (assert-boolean (kl:shen.+string? (string-tail V2856 1))) (equal? "&" (make-string 1 (string-ref (string-tail V2856 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 V2864 V2865 V2866 V2867 V2868 V2869 V2870) (let ((Throwcontrol (kl:shen.catchpoint))) (kl:shen.cutpoint Throwcontrol (let ((Case (let ((V2420 (kl:shen.lazyderef V2864 V2869))) (if (null? V2420) (begin (kl:shen.incinfs) (kl:thaw V2870)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V2421 (kl:shen.lazyderef V2864 V2869))) (if (pair? V2421) (let ((Rule (car V2421))) (let ((Rules (cdr V2421))) (begin (kl:shen.incinfs) (kl:shen.t*-rule (kl:shen.ue Rule) V2865 V2868 V2869 (lambda () (kl:cut Throwcontrol V2869 (lambda () (kl:shen.t*-rules Rules V2865 (+ V2866 1) V2867 V2868 V2869 V2870)))))))) #f)))) (if (kl:= Case #f) (let ((Err (kl:shen.newpv V2869))) (begin (kl:shen.incinfs) (kl:bind Err (simple-error (string-append "type error in rule " (kl:shen.app (kl:shen.lazyderef V2866 V2869) (string-append " of " (kl:shen.app (kl:shen.lazyderef V2867 V2869) "" (quote shen.a))) (quote shen.a)))) V2869 V2870))) Case)) Case))))) (export shen.t*-rules) (quote shen.t*-rules)) +(begin (register-function-arity (quote shen.t*-rule) 5) (define (kl:shen.t*-rule V2876 V2877 V2878 V2879 V2880) (let ((Throwcontrol (kl:shen.catchpoint))) (kl:shen.cutpoint Throwcontrol (let ((V2412 (kl:shen.lazyderef V2876 V2879))) (if (pair? V2412) (let ((Patterns (car V2412))) (let ((V2413 (kl:shen.lazyderef (cdr V2412) V2879))) (if (pair? V2413) (let ((Action (car V2413))) (let ((V2414 (kl:shen.lazyderef (cdr V2413) V2879))) (if (null? V2414) (let ((NewHyps (kl:shen.newpv V2879))) (begin (kl:shen.incinfs) (kl:shen.newhyps (kl:shen.placeholders Patterns) V2878 NewHyps V2879 (lambda () (kl:shen.t*-patterns Patterns V2877 NewHyps V2879 (lambda () (kl:cut Throwcontrol V2879 (lambda () (kl:shen.t*-action (kl:shen.curry (kl:shen.ue Action)) (kl:shen.result-type Patterns V2877) (kl:shen.patthyps Patterns V2877 V2878) V2879 V2880))))))))) #f))) #f))) #f))))) (export shen.t*-rule) (quote shen.t*-rule)) +(begin (register-function-arity (quote shen.placeholders) 1) (define (kl:shen.placeholders V2886) (cond ((assert-boolean (kl:shen.ue? V2886)) (cons V2886 (quote ()))) ((pair? V2886) (kl:union (kl:shen.placeholders (car V2886)) (kl:shen.placeholders (cdr V2886)))) (#t (quote ())))) (export shen.placeholders) (quote shen.placeholders)) +(begin (register-function-arity (quote shen.newhyps) 5) (define (kl:shen.newhyps V2892 V2893 V2894 V2895 V2896) (let ((Case (let ((V2399 (kl:shen.lazyderef V2892 V2895))) (if (null? V2399) (begin (kl:shen.incinfs) (kl:unify! V2894 V2893 V2895 V2896)) #f)))) (if (kl:= Case #f) (let ((V2400 (kl:shen.lazyderef V2892 V2895))) (if (pair? V2400) (let ((V2395 (car V2400))) (let ((Vs (cdr V2400))) (let ((V2401 (kl:shen.lazyderef V2894 V2895))) (if (pair? V2401) (let ((V2402 (kl:shen.lazyderef (car V2401) V2895))) (if (pair? V2402) (let ((V (car V2402))) (let ((V2403 (kl:shen.lazyderef (cdr V2402) V2895))) (if (pair? V2403) (let ((V2404 (kl:shen.lazyderef (car V2403) V2895))) (if (eq? (quote :) V2404) (let ((V2405 (kl:shen.lazyderef (cdr V2403) V2895))) (if (pair? V2405) (let ((A (car V2405))) (let ((V2406 (kl:shen.lazyderef (cdr V2405) V2895))) (if (null? V2406) (let ((NewHyp (cdr V2401))) (begin (kl:shen.incinfs) (kl:unify! V V2395 V2895 (lambda () (kl:shen.newhyps Vs V2893 NewHyp V2895 V2896))))) (if (kl:shen.pvar? V2406) (begin (kl:shen.bindv V2406 (quote ()) V2895) (let ((Result (let ((NewHyp (cdr V2401))) (begin (kl:shen.incinfs) (kl:unify! V V2395 V2895 (lambda () (kl:shen.newhyps Vs V2893 NewHyp V2895 V2896))))))) (begin (kl:shen.unbindv V2406 V2895) Result))) #f)))) (if (kl:shen.pvar? V2405) (let ((A (kl:shen.newpv V2895))) (begin (kl:shen.bindv V2405 (cons A (quote ())) V2895) (let ((Result (let ((NewHyp (cdr V2401))) (begin (kl:shen.incinfs) (kl:unify! V V2395 V2895 (lambda () (kl:shen.newhyps Vs V2893 NewHyp V2895 V2896))))))) (begin (kl:shen.unbindv V2405 V2895) Result)))) #f))) (if (kl:shen.pvar? V2404) (begin (kl:shen.bindv V2404 (quote :) V2895) (let ((Result (let ((V2407 (kl:shen.lazyderef (cdr V2403) V2895))) (if (pair? V2407) (let ((A (car V2407))) (let ((V2408 (kl:shen.lazyderef (cdr V2407) V2895))) (if (null? V2408) (let ((NewHyp (cdr V2401))) (begin (kl:shen.incinfs) (kl:unify! V V2395 V2895 (lambda () (kl:shen.newhyps Vs V2893 NewHyp V2895 V2896))))) (if (kl:shen.pvar? V2408) (begin (kl:shen.bindv V2408 (quote ()) V2895) (let ((Result (let ((NewHyp (cdr V2401))) (begin (kl:shen.incinfs) (kl:unify! V V2395 V2895 (lambda () (kl:shen.newhyps Vs V2893 NewHyp V2895 V2896))))))) (begin (kl:shen.unbindv V2408 V2895) Result))) #f)))) (if (kl:shen.pvar? V2407) (let ((A (kl:shen.newpv V2895))) (begin (kl:shen.bindv V2407 (cons A (quote ())) V2895) (let ((Result (let ((NewHyp (cdr V2401))) (begin (kl:shen.incinfs) (kl:unify! V V2395 V2895 (lambda () (kl:shen.newhyps Vs V2893 NewHyp V2895 V2896))))))) (begin (kl:shen.unbindv V2407 V2895) Result)))) #f))))) (begin (kl:shen.unbindv V2404 V2895) Result))) #f))) (if (kl:shen.pvar? V2403) (let ((A (kl:shen.newpv V2895))) (begin (kl:shen.bindv V2403 (cons (quote :) (cons A (quote ()))) V2895) (let ((Result (let ((NewHyp (cdr V2401))) (begin (kl:shen.incinfs) (kl:unify! V V2395 V2895 (lambda () (kl:shen.newhyps Vs V2893 NewHyp V2895 V2896))))))) (begin (kl:shen.unbindv V2403 V2895) Result)))) #f)))) (if (kl:shen.pvar? V2402) (let ((V (kl:shen.newpv V2895))) (let ((A (kl:shen.newpv V2895))) (begin (kl:shen.bindv V2402 (cons V (cons (quote :) (cons A (quote ())))) V2895) (let ((Result (let ((NewHyp (cdr V2401))) (begin (kl:shen.incinfs) (kl:unify! V V2395 V2895 (lambda () (kl:shen.newhyps Vs V2893 NewHyp V2895 V2896))))))) (begin (kl:shen.unbindv V2402 V2895) Result))))) #f))) (if (kl:shen.pvar? V2401) (let ((V (kl:shen.newpv V2895))) (let ((A (kl:shen.newpv V2895))) (let ((NewHyp (kl:shen.newpv V2895))) (begin (kl:shen.bindv V2401 (cons (cons V (cons (quote :) (cons A (quote ())))) NewHyp) V2895) (let ((Result (begin (kl:shen.incinfs) (kl:unify! V V2395 V2895 (lambda () (kl:shen.newhyps Vs V2893 NewHyp V2895 V2896)))))) (begin (kl:shen.unbindv V2401 V2895) Result)))))) #f))))) #f)) Case))) (export shen.newhyps) (quote shen.newhyps)) +(begin (register-function-arity (quote shen.patthyps) 3) (define (kl:shen.patthyps V2902 V2903 V2904) (cond ((null? V2902) V2904) ((and (pair? V2902) (and (pair? V2903) (and (pair? (cdr V2903)) (and (eq? (quote -->) (car (cdr V2903))) (and (pair? (cdr (cdr V2903))) (null? (cdr (cdr (cdr V2903))))))))) (kl:adjoin (cons (kl:shen.curry (car V2902)) (cons (quote :) (cons (car V2903) (quote ())))) (kl:shen.patthyps (cdr V2902) (car (cdr (cdr V2903))) V2904))) (#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 V2911 V2912) (cond ((and (null? V2911) (and (pair? V2912) (and (eq? (quote -->) (car V2912)) (and (pair? (cdr V2912)) (null? (cdr (cdr V2912))))))) (car (cdr V2912))) ((null? V2911) V2912) ((and (pair? V2911) (and (pair? V2912) (and (pair? (cdr V2912)) (and (eq? (quote -->) (car (cdr V2912))) (and (pair? (cdr (cdr V2912))) (null? (cdr (cdr (cdr V2912))))))))) (kl:shen.result-type (cdr V2911) (car (cdr (cdr V2912))))) (#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 V2918 V2919 V2920 V2921 V2922) (let ((Case (let ((V2387 (kl:shen.lazyderef V2918 V2921))) (if (null? V2387) (begin (kl:shen.incinfs) (kl:thaw V2922)) #f)))) (if (kl:= Case #f) (let ((V2388 (kl:shen.lazyderef V2918 V2921))) (if (pair? V2388) (let ((Pattern (car V2388))) (let ((Patterns (cdr V2388))) (let ((V2389 (kl:shen.lazyderef V2919 V2921))) (if (pair? V2389) (let ((A (car V2389))) (let ((V2390 (kl:shen.lazyderef (cdr V2389) V2921))) (if (pair? V2390) (let ((V2391 (kl:shen.lazyderef (car V2390) V2921))) (if (eq? (quote -->) V2391) (let ((V2392 (kl:shen.lazyderef (cdr V2390) V2921))) (if (pair? V2392) (let ((B (car V2392))) (let ((V2393 (kl:shen.lazyderef (cdr V2392) V2921))) (if (null? V2393) (begin (kl:shen.incinfs) (kl:shen.t* (cons (kl:shen.curry Pattern) (cons (quote :) (cons A (quote ())))) V2920 V2921 (lambda () (kl:shen.t*-patterns Patterns B V2920 V2921 V2922)))) #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 V2928 V2929 V2930 V2931 V2932) (let ((Throwcontrol (kl:shen.catchpoint))) (kl:shen.cutpoint Throwcontrol (let ((Case (let ((V2364 (kl:shen.lazyderef V2928 V2931))) (if (pair? V2364) (let ((V2365 (kl:shen.lazyderef (car V2364) V2931))) (if (eq? (quote where) V2365) (let ((V2366 (kl:shen.lazyderef (cdr V2364) V2931))) (if (pair? V2366) (let ((P (car V2366))) (let ((V2367 (kl:shen.lazyderef (cdr V2366) V2931))) (if (pair? V2367) (let ((Action (car V2367))) (let ((V2368 (kl:shen.lazyderef (cdr V2367) V2931))) (if (null? V2368) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V2931 (lambda () (kl:shen.t* (cons P (cons (quote :) (cons (quote boolean) (quote ())))) V2930 V2931 (lambda () (kl:cut Throwcontrol V2931 (lambda () (kl:shen.t*-action Action V2929 (cons (cons P (cons (quote :) (cons (quote verified) (quote ())))) V2930) V2931 V2932)))))))) #f))) #f))) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V2369 (kl:shen.lazyderef V2928 V2931))) (if (pair? V2369) (let ((V2370 (kl:shen.lazyderef (car V2369) V2931))) (if (eq? (quote shen.choicepoint!) V2370) (let ((V2371 (kl:shen.lazyderef (cdr V2369) V2931))) (if (pair? V2371) (let ((V2372 (kl:shen.lazyderef (car V2371) V2931))) (if (pair? V2372) (let ((V2373 (kl:shen.lazyderef (car V2372) V2931))) (if (pair? V2373) (let ((V2374 (kl:shen.lazyderef (car V2373) V2931))) (if (eq? (quote fail-if) V2374) (let ((V2375 (kl:shen.lazyderef (cdr V2373) V2931))) (if (pair? V2375) (let ((F (car V2375))) (let ((V2376 (kl:shen.lazyderef (cdr V2375) V2931))) (if (null? V2376) (let ((V2377 (kl:shen.lazyderef (cdr V2372) V2931))) (if (pair? V2377) (let ((Action (car V2377))) (let ((V2378 (kl:shen.lazyderef (cdr V2377) V2931))) (if (null? V2378) (let ((V2379 (kl:shen.lazyderef (cdr V2371) V2931))) (if (null? V2379) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V2931 (lambda () (kl:shen.t*-action (cons (quote where) (cons (cons (quote not) (cons (cons F (cons Action (quote ()))) (quote ()))) (cons Action (quote ())))) V2929 V2930 V2931 V2932)))) #f)) #f))) #f)) #f))) #f)) #f)) #f)) #f)) #f)) #f)) #f)))) (if (kl:= Case #f) (let ((Case (let ((V2380 (kl:shen.lazyderef V2928 V2931))) (if (pair? V2380) (let ((V2381 (kl:shen.lazyderef (car V2380) V2931))) (if (eq? (quote shen.choicepoint!) V2381) (let ((V2382 (kl:shen.lazyderef (cdr V2380) V2931))) (if (pair? V2382) (let ((Action (car V2382))) (let ((V2383 (kl:shen.lazyderef (cdr V2382) V2931))) (if (null? V2383) (begin (kl:shen.incinfs) (kl:cut Throwcontrol V2931 (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 ())))) V2929 V2930 V2931 V2932)))) #f))) #f)) #f)) #f)))) (if (kl:= Case #f) (begin (kl:shen.incinfs) (kl:shen.t* (cons V2928 (cons (quote :) (cons V2929 (quote ())))) V2930 V2931 V2932)) Case)) Case)) Case))))) (export shen.t*-action) (quote shen.t*-action)) +(begin (register-function-arity (quote findall) 5) (define (kl:findall V2938 V2939 V2940 V2941 V2942) (let ((B (kl:shen.newpv V2941))) (let ((A (kl:shen.newpv V2941))) (begin (kl:shen.incinfs) (kl:bind A (kl:gensym (quote shen.a)) V2941 (lambda () (kl:bind B (kl:set (kl:shen.lazyderef A V2941) (quote ())) V2941 (lambda () (kl:shen.findallhelp V2938 V2939 V2940 A V2941 V2942))))))))) (export findall) (quote findall)) +(begin (register-function-arity (quote shen.findallhelp) 6) (define (kl:shen.findallhelp V2949 V2950 V2951 V2952 V2953 V2954) (let ((Case (begin (kl:shen.incinfs) (kl:call V2950 V2953 (lambda () (kl:shen.remember V2952 V2949 V2953 (lambda () (kl:fwhen #f V2953 V2954)))))))) (if (kl:= Case #f) (begin (kl:shen.incinfs) (kl:bind V2951 (kl:value (kl:shen.lazyderef V2952 V2953)) V2953 V2954)) Case))) (export shen.findallhelp) (quote shen.findallhelp)) +(begin (register-function-arity (quote shen.remember) 4) (define (kl:shen.remember V2959 V2960 V2961 V2962) (let ((B (kl:shen.newpv V2961))) (begin (kl:shen.incinfs) (kl:bind B (kl:set (kl:shen.deref V2959 V2961) (cons (kl:shen.deref V2960 V2961) (kl:value (kl:shen.deref V2959 V2961)))) V2961 V2962)))) (export shen.remember) (quote shen.remember)) diff --git a/compiled/toplevel.kl.ms b/compiled/toplevel.kl.ms index 9c89745..652bb8f 100644 --- a/compiled/toplevel.kl.ms +++ b/compiled/toplevel.kl.ms @@ -2,36 +2,36 @@ "Copyright (c) 2010-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:\n\n1. Redistributions of source code must retain the above copyright notice,\nthis list of conditions and the following disclaimer.\n\n2. Redistributions in binary form must reproduce the above copyright notice,\nthis list of conditions and the following disclaimer in the documentation\nand/or other materials provided with the distribution.\n\n3. Neither the name of the copyright holder nor the names of its contributors\nmay be used to endorse or promote products derived from this software without\nspecific prior written permission.\n\nTHIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ''AS IS'' AND\nANY EXPRESS 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 THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE\nFOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL\nDAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR\nSERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER\nCAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,\nOR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE\nOF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.\n" (begin (register-function-arity (quote shen.repl) 0) (define (kl:shen.repl) (begin (kl:shen.credits) (kl:shen.loop))) (export shen.repl) (quote shen.repl)) (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 V4125) (kl:pr (kl:error-to-string V4125) (kl:stoutput))) (export shen.toplevel-display-exception) (quote shen.toplevel-display-exception)) +(begin (register-function-arity (quote shen.toplevel-display-exception) 1) (define (kl:shen.toplevel-display-exception V2964) (kl:pr (kl:error-to-string V2964) (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 V4127) (cond ((null? V4127) (quote ())) ((and (pair? V4127) (pair? (cdr V4127))) (begin (kl:set (car V4127) (car (cdr V4127))) (kl:shen.multiple-set (cdr (cdr V4127))))) (#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 V4129) (kl:declare V4129 (quote symbol))) (export destroy) (quote destroy)) +(begin (register-function-arity (quote shen.multiple-set) 1) (define (kl:shen.multiple-set V2966) (cond ((null? V2966) (quote ())) ((and (pair? V2966) (pair? (cdr V2966))) (begin (kl:set (car V2966) (car (cdr V2966))) (kl:shen.multiple-set (cdr (cdr V2966))))) (#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 V2968) (kl:declare V2968 (quote symbol))) (export destroy) (quote destroy)) (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 V4141 V4142) (cond ((and (kl:tuple? V4141) (and (pair? (kl:snd V4141)) (kl:element? (car (kl:snd V4141)) (cons (kl:shen.space) (cons (kl:shen.newline) (quote ())))))) (kl:shen.retrieve-from-history-if-needed (kl:_waspvm_at_p (kl:fst V4141) (cdr (kl:snd V4141))) V4142)) ((and (kl:tuple? V4141) (and (pair? (kl:snd V4141)) (and (pair? (cdr (kl:snd V4141))) (and (null? (cdr (cdr (kl:snd V4141)))) (and (pair? V4142) (and (kl:= (car (kl:snd V4141)) (kl:shen.exclamation)) (kl:= (car (cdr (kl:snd V4141))) (kl:shen.exclamation)))))))) (let ((PastPrint (kl:shen.prbytes (kl:snd (car V4142))))) (car V4142))) ((and (kl:tuple? V4141) (and (pair? (kl:snd V4141)) (kl:= (car (kl:snd V4141)) (kl:shen.exclamation)))) (let ((Key? (kl:shen.make-key (cdr (kl:snd V4141)) V4142))) (let ((Find (kl:head (kl:shen.find-past-inputs Key? V4142)))) (let ((PastPrint (kl:shen.prbytes (kl:snd Find)))) Find)))) ((and (kl:tuple? V4141) (and (pair? (kl:snd V4141)) (and (null? (cdr (kl:snd V4141))) (kl:= (car (kl:snd V4141)) (kl:shen.percent))))) (begin (kl:shen.print-past-inputs (lambda (X) #t) (kl:reverse V4142) 0) (kl:abort))) ((and (kl:tuple? V4141) (and (pair? (kl:snd V4141)) (kl:= (car (kl:snd V4141)) (kl:shen.percent)))) (let ((Key? (kl:shen.make-key (cdr (kl:snd V4141)) V4142))) (let ((Pastprint (kl:shen.print-past-inputs Key? (kl:reverse V4142) 0))) (kl:abort)))) (#t V4141))) (export shen.retrieve-from-history-if-needed) (quote shen.retrieve-from-history-if-needed)) +(begin (register-function-arity (quote shen.retrieve-from-history-if-needed) 2) (define (kl:shen.retrieve-from-history-if-needed V2980 V2981) (cond ((and (kl:tuple? V2980) (and (pair? (kl:snd V2980)) (kl:element? (car (kl:snd V2980)) (cons (kl:shen.space) (cons (kl:shen.newline) (quote ())))))) (kl:shen.retrieve-from-history-if-needed (kl:_waspvm_at_p (kl:fst V2980) (cdr (kl:snd V2980))) V2981)) ((and (kl:tuple? V2980) (and (pair? (kl:snd V2980)) (and (pair? (cdr (kl:snd V2980))) (and (null? (cdr (cdr (kl:snd V2980)))) (and (pair? V2981) (and (kl:= (car (kl:snd V2980)) (kl:shen.exclamation)) (kl:= (car (cdr (kl:snd V2980))) (kl:shen.exclamation)))))))) (let ((PastPrint (kl:shen.prbytes (kl:snd (car V2981))))) (car V2981))) ((and (kl:tuple? V2980) (and (pair? (kl:snd V2980)) (kl:= (car (kl:snd V2980)) (kl:shen.exclamation)))) (let ((Key? (kl:shen.make-key (cdr (kl:snd V2980)) V2981))) (let ((Find (kl:head (kl:shen.find-past-inputs Key? V2981)))) (let ((PastPrint (kl:shen.prbytes (kl:snd Find)))) Find)))) ((and (kl:tuple? V2980) (and (pair? (kl:snd V2980)) (and (null? (cdr (kl:snd V2980))) (kl:= (car (kl:snd V2980)) (kl:shen.percent))))) (begin (kl:shen.print-past-inputs (lambda (X) #t) (kl:reverse V2981) 0) (kl:abort))) ((and (kl:tuple? V2980) (and (pair? (kl:snd V2980)) (kl:= (car (kl:snd V2980)) (kl:shen.percent)))) (let ((Key? (kl:shen.make-key (cdr (kl:snd V2980)) V2981))) (let ((Pastprint (kl:shen.print-past-inputs Key? (kl:reverse V2981) 0))) (kl:abort)))) (#t V2980))) (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 V4144) (begin (kl:shen.for-each (lambda (Byte) (kl:pr (make-string 1 Byte) (kl:stoutput))) V4144) (kl:nl 1))) (export shen.prbytes) (quote shen.prbytes)) -(begin (register-function-arity (quote shen.update_history) 2) (define (kl:shen.update_history V4147 V4148) (kl:set (quote shen.*history*) (cons V4147 V4148))) (export shen.update_history) (quote shen.update_history)) +(begin (register-function-arity (quote shen.prbytes) 1) (define (kl:shen.prbytes V2983) (begin (kl:shen.for-each (lambda (Byte) (kl:pr (make-string 1 Byte) (kl:stoutput))) V2983) (kl:nl 1))) (export shen.prbytes) (quote shen.prbytes)) +(begin (register-function-arity (quote shen.update_history) 2) (define (kl:shen.update_history V2986 V2987) (kl:set (quote shen.*history*) (cons V2986 V2987))) (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 V4152 V4153) (cond ((kl:= V4152 (kl:shen.hat)) (simple-error "line read aborted")) ((kl:element? V4152 (cons (kl:shen.newline) (cons (kl:shen.carriage-return) (quote ())))) (let ((Line (kl:compile (lambda (X) (kl:shen. X)) V4153 (lambda (E) (quote shen.nextline))))) (let ((It (kl:shen.record-it V4153))) (if (or (eq? Line (quote shen.nextline)) (kl:empty? Line)) (kl:shen.toplineread_loop (kl:shen.read-char-code (kl:stinput)) (kl:append V4153 (cons V4152 (quote ())))) (kl:_waspvm_at_p Line V4153))))) (#t (kl:shen.toplineread_loop (kl:shen.read-char-code (kl:stinput)) (if (kl:= V4152 -1) V4153 (kl:append V4153 (cons V4152 (quote ())))))))) (export shen.toplineread_loop) (quote shen.toplineread_loop)) +(begin (register-function-arity (quote shen.toplineread_loop) 2) (define (kl:shen.toplineread_loop V2991 V2992) (cond ((kl:= V2991 (kl:shen.hat)) (simple-error "line read aborted")) ((kl:element? V2991 (cons (kl:shen.newline) (cons (kl:shen.carriage-return) (quote ())))) (let ((Line (kl:compile (lambda (X) (kl:shen. X)) V2992 (lambda (E) (quote shen.nextline))))) (let ((It (kl:shen.record-it V2992))) (if (or (eq? Line (quote shen.nextline)) (kl:empty? Line)) (kl:shen.toplineread_loop (kl:shen.read-char-code (kl:stinput)) (kl:append V2992 (cons V2991 (quote ())))) (kl:_waspvm_at_p Line V2992))))) (#t (kl:shen.toplineread_loop (kl:shen.read-char-code (kl:stinput)) (if (kl:= V2991 -1) V2992 (kl:append V2992 (cons V2991 (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 V4159) (cond ((eq? (quote +) V4159) (kl:set (quote shen.*tc*) #t)) ((eq? (quote -) V4159) (kl:set (quote shen.*tc*) #f)) (#t (simple-error "tc expects a + or -")))) (export tc) (quote tc)) +(begin (register-function-arity (quote tc) 1) (define (kl:tc V2998) (cond ((eq? (quote +) V2998) (kl:set (quote shen.*tc*) #t)) ((eq? (quote -) V2998) (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 V4161) (kl:shen.toplevel_evaluate V4161 (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 V4164 V4165) (let ((F (kl:shen.find V4164 V4165))) (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 V4168 V4169) (let ((Atom (car (kl:compile (lambda (X) (kl:shen. X)) V4168 (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 V4169)))) (lambda (X) (kl:shen.prefix? V4168 (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 V4171) (cond ((and (pair? V4171) (kl:= (car V4171) (kl:shen.space))) (kl:shen.trim-gubbins (cdr V4171))) ((and (pair? V4171) (kl:= (car V4171) (kl:shen.newline))) (kl:shen.trim-gubbins (cdr V4171))) ((and (pair? V4171) (kl:= (car V4171) (kl:shen.carriage-return))) (kl:shen.trim-gubbins (cdr V4171))) ((and (pair? V4171) (kl:= (car V4171) (kl:shen.tab))) (kl:shen.trim-gubbins (cdr V4171))) ((and (pair? V4171) (kl:= (car V4171) (kl:shen.left-round))) (kl:shen.trim-gubbins (cdr V4171))) (#t V4171))) (export shen.trim-gubbins) (quote shen.trim-gubbins)) +(begin (register-function-arity (quote shen.toplevel) 1) (define (kl:shen.toplevel V3000) (kl:shen.toplevel_evaluate V3000 (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 V3003 V3004) (let ((F (kl:shen.find V3003 V3004))) (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 V3007 V3008) (let ((Atom (car (kl:compile (lambda (X) (kl:shen. X)) V3007 (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 V3008)))) (lambda (X) (kl:shen.prefix? V3007 (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 V3010) (cond ((and (pair? V3010) (kl:= (car V3010) (kl:shen.space))) (kl:shen.trim-gubbins (cdr V3010))) ((and (pair? V3010) (kl:= (car V3010) (kl:shen.newline))) (kl:shen.trim-gubbins (cdr V3010))) ((and (pair? V3010) (kl:= (car V3010) (kl:shen.carriage-return))) (kl:shen.trim-gubbins (cdr V3010))) ((and (pair? V3010) (kl:= (car V3010) (kl:shen.tab))) (kl:shen.trim-gubbins (cdr V3010))) ((and (pair? V3010) (kl:= (car V3010) (kl:shen.left-round))) (kl:shen.trim-gubbins (cdr V3010))) (#t V3010))) (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 V4180 V4181) (cond ((null? V4181) (quote ())) ((and (pair? V4181) (assert-boolean (V4180 (car V4181)))) (cons (car V4181) (kl:shen.find V4180 (cdr V4181)))) ((pair? V4181) (kl:shen.find V4180 (cdr V4181))) (#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? V4195 V4196) (cond ((null? V4195) #t) ((and (pair? V4195) (and (pair? V4196) (kl:= (car V4196) (car V4195)))) (kl:shen.prefix? (cdr V4195) (cdr V4196))) (#t #f))) (export shen.prefix?) (quote shen.prefix?)) -(begin (register-function-arity (quote shen.print-past-inputs) 3) (define (kl:shen.print-past-inputs V4208 V4209 V4210) (cond ((null? V4209) (quote _)) ((and (pair? V4209) (kl:not (V4208 (car V4209)))) (kl:shen.print-past-inputs V4208 (cdr V4209) (+ V4210 1))) ((and (pair? V4209) (kl:tuple? (car V4209))) (begin (kl:shen.prhush (kl:shen.app V4210 ". " (quote shen.a)) (kl:stoutput)) (begin (kl:shen.prbytes (kl:snd (car V4209))) (kl:shen.print-past-inputs V4208 (cdr V4209) (+ V4210 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 V4213 V4214) (cond ((and (pair? V4213) (and (pair? (cdr V4213)) (and (eq? (quote :) (car (cdr V4213))) (and (pair? (cdr (cdr V4213))) (and (null? (cdr (cdr (cdr V4213)))) (kl:= #t V4214)))))) (kl:shen.typecheck-and-evaluate (car V4213) (car (cdr (cdr V4213))))) ((and (pair? V4213) (pair? (cdr V4213))) (begin (kl:shen.toplevel_evaluate (cons (car V4213) (quote ())) V4214) (begin (kl:nl 1) (kl:shen.toplevel_evaluate (cdr V4213) V4214)))) ((and (pair? V4213) (and (null? (cdr V4213)) (kl:= #t V4214))) (kl:shen.typecheck-and-evaluate (car V4213) (kl:gensym (quote A)))) ((and (pair? V4213) (and (null? (cdr V4213)) (kl:= #f V4214))) (let ((Eval (kl:shen.eval-without-macros (car V4213)))) (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 V4217 V4218) (let ((Typecheck (kl:shen.typecheck V4217 V4218))) (if (kl:= Typecheck #f) (simple-error "type error\n") (let ((Eval (kl:shen.eval-without-macros V4217))) (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 V4220) (kl:shen.mult_subst (kl:value (quote shen.*alphabet*)) (kl:shen.extract-pvars V4220) V4220)) (export shen.pretty-type) (quote shen.pretty-type)) -(begin (register-function-arity (quote shen.extract-pvars) 1) (define (kl:shen.extract-pvars V4226) (cond ((kl:shen.pvar? V4226) (cons V4226 (quote ()))) ((pair? V4226) (kl:union (kl:shen.extract-pvars (car V4226)) (kl:shen.extract-pvars (cdr V4226)))) (#t (quote ())))) (export shen.extract-pvars) (quote shen.extract-pvars)) -(begin (register-function-arity (quote shen.mult_subst) 3) (define (kl:shen.mult_subst V4234 V4235 V4236) (cond ((null? V4234) V4236) ((null? V4235) V4236) ((and (pair? V4234) (pair? V4235)) (kl:shen.mult_subst (cdr V4234) (cdr V4235) (kl:subst (car V4234) (car V4235) V4236))) (#t (kl:shen.f_error (quote shen.mult_subst))))) (export shen.mult_subst) (quote shen.mult_subst)) +(begin (register-function-arity (quote shen.find) 2) (define (kl:shen.find V3019 V3020) (cond ((null? V3020) (quote ())) ((and (pair? V3020) (assert-boolean (V3019 (car V3020)))) (cons (car V3020) (kl:shen.find V3019 (cdr V3020)))) ((pair? V3020) (kl:shen.find V3019 (cdr V3020))) (#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? V3034 V3035) (cond ((null? V3034) #t) ((and (pair? V3034) (and (pair? V3035) (kl:= (car V3035) (car V3034)))) (kl:shen.prefix? (cdr V3034) (cdr V3035))) (#t #f))) (export shen.prefix?) (quote shen.prefix?)) +(begin (register-function-arity (quote shen.print-past-inputs) 3) (define (kl:shen.print-past-inputs V3047 V3048 V3049) (cond ((null? V3048) (quote _)) ((and (pair? V3048) (kl:not (V3047 (car V3048)))) (kl:shen.print-past-inputs V3047 (cdr V3048) (+ V3049 1))) ((and (pair? V3048) (kl:tuple? (car V3048))) (begin (kl:shen.prhush (kl:shen.app V3049 ". " (quote shen.a)) (kl:stoutput)) (begin (kl:shen.prbytes (kl:snd (car V3048))) (kl:shen.print-past-inputs V3047 (cdr V3048) (+ V3049 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 V3052 V3053) (cond ((and (pair? V3052) (and (pair? (cdr V3052)) (and (eq? (quote :) (car (cdr V3052))) (and (pair? (cdr (cdr V3052))) (and (null? (cdr (cdr (cdr V3052)))) (kl:= #t V3053)))))) (kl:shen.typecheck-and-evaluate (car V3052) (car (cdr (cdr V3052))))) ((and (pair? V3052) (pair? (cdr V3052))) (begin (kl:shen.toplevel_evaluate (cons (car V3052) (quote ())) V3053) (begin (kl:nl 1) (kl:shen.toplevel_evaluate (cdr V3052) V3053)))) ((and (pair? V3052) (and (null? (cdr V3052)) (kl:= #t V3053))) (kl:shen.typecheck-and-evaluate (car V3052) (kl:gensym (quote A)))) ((and (pair? V3052) (and (null? (cdr V3052)) (kl:= #f V3053))) (let ((Eval (kl:shen.eval-without-macros (car V3052)))) (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 V3056 V3057) (let ((Typecheck (kl:shen.typecheck V3056 V3057))) (if (kl:= Typecheck #f) (simple-error "type error\n") (let ((Eval (kl:shen.eval-without-macros V3056))) (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 V3059) (kl:shen.mult_subst (kl:value (quote shen.*alphabet*)) (kl:shen.extract-pvars V3059) V3059)) (export shen.pretty-type) (quote shen.pretty-type)) +(begin (register-function-arity (quote shen.extract-pvars) 1) (define (kl:shen.extract-pvars V3065) (cond ((kl:shen.pvar? V3065) (cons V3065 (quote ()))) ((pair? V3065) (kl:union (kl:shen.extract-pvars (car V3065)) (kl:shen.extract-pvars (cdr V3065)))) (#t (quote ())))) (export shen.extract-pvars) (quote shen.extract-pvars)) +(begin (register-function-arity (quote shen.mult_subst) 3) (define (kl:shen.mult_subst V3073 V3074 V3075) (cond ((null? V3073) V3075) ((null? V3074) V3075) ((and (pair? V3073) (pair? V3074)) (kl:shen.mult_subst (cdr V3073) (cdr V3074) (kl:subst (car V3073) (car V3074) V3075))) (#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 a787cc5..711e844 100644 --- a/compiled/track.kl.ms +++ b/compiled/track.kl.ms @@ -1,23 +1,23 @@ (module "compiled/track.kl") "Copyright (c) 2010-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:\n\n1. Redistributions of source code must retain the above copyright notice,\nthis list of conditions and the following disclaimer.\n\n2. Redistributions in binary form must reproduce the above copyright notice,\nthis list of conditions and the following disclaimer in the documentation\nand/or other materials provided with the distribution.\n\n3. Neither the name of the copyright holder nor the names of its contributors\nmay be used to endorse or promote products derived from this software without\nspecific prior written permission.\n\nTHIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ''AS IS'' AND\nANY EXPRESS 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 THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE\nFOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL\nDAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR\nSERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER\nCAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,\nOR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE\nOF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.\n" -(begin (register-function-arity (quote shen.f_error) 1) (define (kl:shen.f_error V4238) (begin (kl:shen.prhush (string-append "partial function " (kl:shen.app V4238 ";\n" (quote shen.a))) (kl:stoutput)) (begin (if (and (kl:not (kl:shen.tracked? V4238)) (assert-boolean (kl:y-or-n? (string-append "track " (kl:shen.app V4238 "? " (quote shen.a)))))) (kl:shen.track-function (kl:ps V4238)) (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? V4240) (kl:element? V4240 (kl:value (quote shen.*tracking*)))) (export shen.tracked?) (quote shen.tracked?)) -(begin (register-function-arity (quote track) 1) (define (kl:track V4242) (let ((Source (kl:ps V4242))) (kl:shen.track-function Source))) (export track) (quote track)) -(begin (register-function-arity (quote shen.track-function) 1) (define (kl:shen.track-function V4244) (cond ((and (pair? V4244) (and (eq? (quote defun) (car V4244)) (and (pair? (cdr V4244)) (and (pair? (cdr (cdr V4244))) (and (pair? (cdr (cdr (cdr V4244)))) (null? (cdr (cdr (cdr (cdr V4244)))))))))) (let ((KL (cons (quote defun) (cons (car (cdr V4244)) (cons (car (cdr (cdr V4244))) (cons (kl:shen.insert-tracking-code (car (cdr V4244)) (car (cdr (cdr V4244))) (car (cdr (cdr (cdr V4244))))) (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 V4248 V4249 V4250) (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 V4248 (cons (kl:shen.cons_form V4249) (quote ()))))) (cons (cons (quote do) (cons (cons (quote shen.terpri-or-read-char) (quote ())) (cons (cons (quote let) (cons (quote Result) (cons V4250 (cons (cons (quote do) (cons (cons (quote shen.output-track) (cons (cons (quote value) (cons (quote shen.*call*) (quote ()))) (cons V4248 (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)) -(begin (register-function-arity (quote step) 1) (define (kl:step V4256) (cond ((eq? (quote +) V4256) (kl:set (quote shen.*step*) #t)) ((eq? (quote -) V4256) (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 V4262) (cond ((eq? (quote +) V4262) (kl:set (quote shen.*spy*) #t)) ((eq? (quote -) V4262) (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.f_error) 1) (define (kl:shen.f_error V3077) (begin (kl:shen.prhush (string-append "partial function " (kl:shen.app V3077 ";\n" (quote shen.a))) (kl:stoutput)) (begin (if (and (kl:not (kl:shen.tracked? V3077)) (assert-boolean (kl:y-or-n? (string-append "track " (kl:shen.app V3077 "? " (quote shen.a)))))) (kl:shen.track-function (kl:ps V3077)) (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? V3079) (kl:element? V3079 (kl:value (quote shen.*tracking*)))) (export shen.tracked?) (quote shen.tracked?)) +(begin (register-function-arity (quote track) 1) (define (kl:track V3081) (let ((Source (kl:ps V3081))) (kl:shen.track-function Source))) (export track) (quote track)) +(begin (register-function-arity (quote shen.track-function) 1) (define (kl:shen.track-function V3083) (cond ((and (pair? V3083) (and (eq? (quote defun) (car V3083)) (and (pair? (cdr V3083)) (and (pair? (cdr (cdr V3083))) (and (pair? (cdr (cdr (cdr V3083)))) (null? (cdr (cdr (cdr (cdr V3083)))))))))) (let ((KL (cons (quote defun) (cons (car (cdr V3083)) (cons (car (cdr (cdr V3083))) (cons (kl:shen.insert-tracking-code (car (cdr V3083)) (car (cdr (cdr V3083))) (car (cdr (cdr (cdr V3083))))) (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 V3087 V3088 V3089) (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 V3087 (cons (kl:shen.cons_form V3088) (quote ()))))) (cons (cons (quote do) (cons (cons (quote shen.terpri-or-read-char) (quote ())) (cons (cons (quote let) (cons (quote Result) (cons V3089 (cons (cons (quote do) (cons (cons (quote shen.output-track) (cons (cons (quote value) (cons (quote shen.*call*) (quote ()))) (cons V3087 (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)) +(begin (register-function-arity (quote step) 1) (define (kl:step V3095) (cond ((eq? (quote +) V3095) (kl:set (quote shen.*step*) #t)) ((eq? (quote -) V3095) (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 V3101) (cond ((eq? (quote +) V3101) (kl:set (quote shen.*spy*) #t)) ((eq? (quote -) V3101) (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 V4268) (cond ((kl:= V4268 (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 V4272 V4273 V4274) (begin (kl:shen.prhush (string-append "\n" (kl:shen.app (kl:shen.spaces V4272) (string-append "<" (kl:shen.app V4272 (string-append "> Inputs to " (kl:shen.app V4273 (string-append " \n" (kl:shen.app (kl:shen.spaces V4272) "" (quote shen.a))) (quote shen.a))) (quote shen.a))) (quote shen.a))) (kl:stoutput)) (kl:shen.recursively-print V4274))) (export shen.input-track) (quote shen.input-track)) -(begin (register-function-arity (quote shen.recursively-print) 1) (define (kl:shen.recursively-print V4276) (cond ((null? V4276) (kl:shen.prhush " ==>" (kl:stoutput))) ((pair? V4276) (begin (kl:print (car V4276)) (begin (kl:shen.prhush ", " (kl:stoutput)) (kl:shen.recursively-print (cdr V4276))))) (#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 V4278) (cond ((kl:= 0 V4278) "") (#t (string-append " " (kl:shen.spaces (- V4278 1)))))) (export shen.spaces) (quote shen.spaces)) -(begin (register-function-arity (quote shen.output-track) 3) (define (kl:shen.output-track V4282 V4283 V4284) (kl:shen.prhush (string-append "\n" (kl:shen.app (kl:shen.spaces V4282) (string-append "<" (kl:shen.app V4282 (string-append "> Output from " (kl:shen.app V4283 (string-append " \n" (kl:shen.app (kl:shen.spaces V4282) (string-append "==> " (kl:shen.app V4284 "" (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 V4286) (let ((Tracking (kl:value (quote shen.*tracking*)))) (let ((Tracking (kl:set (quote shen.*tracking*) (kl:remove V4286 Tracking)))) (kl:eval (kl:ps V4286))))) (export untrack) (quote untrack)) -(begin (register-function-arity (quote profile) 1) (define (kl:profile V4288) (kl:shen.profile-help (kl:ps V4288))) (export profile) (quote profile)) -(begin (register-function-arity (quote shen.profile-help) 1) (define (kl:shen.profile-help V4294) (cond ((and (pair? V4294) (and (eq? (quote defun) (car V4294)) (and (pair? (cdr V4294)) (and (pair? (cdr (cdr V4294))) (and (pair? (cdr (cdr (cdr V4294)))) (null? (cdr (cdr (cdr (cdr V4294)))))))))) (let ((G (kl:gensym (quote shen.f)))) (let ((Profile (cons (quote defun) (cons (car (cdr V4294)) (cons (car (cdr (cdr V4294))) (cons (kl:shen.profile-func (car (cdr V4294)) (car (cdr (cdr V4294))) (cons G (car (cdr (cdr V4294))))) (quote ()))))))) (let ((Def (cons (quote defun) (cons G (cons (car (cdr (cdr V4294))) (cons (kl:subst G (car (cdr V4294)) (car (cdr (cdr (cdr V4294))))) (quote ()))))))) (let ((CompileProfile (kl:shen.eval-without-macros Profile))) (let ((CompileG (kl:shen.eval-without-macros Def))) (car (cdr V4294)))))))) (#t (simple-error "Cannot profile.\n")))) (export shen.profile-help) (quote shen.profile-help)) -(begin (register-function-arity (quote unprofile) 1) (define (kl:unprofile V4296) (kl:untrack V4296)) (export unprofile) (quote unprofile)) -(begin (register-function-arity (quote shen.profile-func) 3) (define (kl:shen.profile-func V4300 V4301 V4302) (cons (quote let) (cons (quote Start) (cons (cons (quote get-time) (cons (quote run) (quote ()))) (cons (cons (quote let) (cons (quote Result) (cons V4302 (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 V4300 (cons (cons (quote +) (cons (cons (quote shen.get-profile) (cons V4300 (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 V4304) (let ((Results (kl:shen.get-profile V4304))) (let ((Initialise (kl:shen.put-profile V4304 0))) (kl:_waspvm_at_p V4304 Results)))) (export profile-results) (quote profile-results)) -(begin (register-function-arity (quote shen.get-profile) 1) (define (kl:shen.get-profile V4306) (guard (lambda (E) 0) (kl:get V4306 (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 V4309 V4310) (kl:put V4309 (quote profile) V4310 (kl:value (quote *property-vector*)))) (export shen.put-profile) (quote shen.put-profile)) +(begin (register-function-arity (quote shen.check-byte) 1) (define (kl:shen.check-byte V3107) (cond ((kl:= V3107 (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 V3111 V3112 V3113) (begin (kl:shen.prhush (string-append "\n" (kl:shen.app (kl:shen.spaces V3111) (string-append "<" (kl:shen.app V3111 (string-append "> Inputs to " (kl:shen.app V3112 (string-append " \n" (kl:shen.app (kl:shen.spaces V3111) "" (quote shen.a))) (quote shen.a))) (quote shen.a))) (quote shen.a))) (kl:stoutput)) (kl:shen.recursively-print V3113))) (export shen.input-track) (quote shen.input-track)) +(begin (register-function-arity (quote shen.recursively-print) 1) (define (kl:shen.recursively-print V3115) (cond ((null? V3115) (kl:shen.prhush " ==>" (kl:stoutput))) ((pair? V3115) (begin (kl:print (car V3115)) (begin (kl:shen.prhush ", " (kl:stoutput)) (kl:shen.recursively-print (cdr V3115))))) (#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 V3117) (cond ((kl:= 0 V3117) "") (#t (string-append " " (kl:shen.spaces (- V3117 1)))))) (export shen.spaces) (quote shen.spaces)) +(begin (register-function-arity (quote shen.output-track) 3) (define (kl:shen.output-track V3121 V3122 V3123) (kl:shen.prhush (string-append "\n" (kl:shen.app (kl:shen.spaces V3121) (string-append "<" (kl:shen.app V3121 (string-append "> Output from " (kl:shen.app V3122 (string-append " \n" (kl:shen.app (kl:shen.spaces V3121) (string-append "==> " (kl:shen.app V3123 "" (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 V3125) (let ((Tracking (kl:value (quote shen.*tracking*)))) (let ((Tracking (kl:set (quote shen.*tracking*) (kl:remove V3125 Tracking)))) (kl:eval (kl:ps V3125))))) (export untrack) (quote untrack)) +(begin (register-function-arity (quote profile) 1) (define (kl:profile V3127) (kl:shen.profile-help (kl:ps V3127))) (export profile) (quote profile)) +(begin (register-function-arity (quote shen.profile-help) 1) (define (kl:shen.profile-help V3133) (cond ((and (pair? V3133) (and (eq? (quote defun) (car V3133)) (and (pair? (cdr V3133)) (and (pair? (cdr (cdr V3133))) (and (pair? (cdr (cdr (cdr V3133)))) (null? (cdr (cdr (cdr (cdr V3133)))))))))) (let ((G (kl:gensym (quote shen.f)))) (let ((Profile (cons (quote defun) (cons (car (cdr V3133)) (cons (car (cdr (cdr V3133))) (cons (kl:shen.profile-func (car (cdr V3133)) (car (cdr (cdr V3133))) (cons G (car (cdr (cdr V3133))))) (quote ()))))))) (let ((Def (cons (quote defun) (cons G (cons (car (cdr (cdr V3133))) (cons (kl:subst G (car (cdr V3133)) (car (cdr (cdr (cdr V3133))))) (quote ()))))))) (let ((CompileProfile (kl:shen.eval-without-macros Profile))) (let ((CompileG (kl:shen.eval-without-macros Def))) (car (cdr V3133)))))))) (#t (simple-error "Cannot profile.\n")))) (export shen.profile-help) (quote shen.profile-help)) +(begin (register-function-arity (quote unprofile) 1) (define (kl:unprofile V3135) (kl:untrack V3135)) (export unprofile) (quote unprofile)) +(begin (register-function-arity (quote shen.profile-func) 3) (define (kl:shen.profile-func V3139 V3140 V3141) (cons (quote let) (cons (quote Start) (cons (cons (quote get-time) (cons (quote run) (quote ()))) (cons (cons (quote let) (cons (quote Result) (cons V3141 (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 V3139 (cons (cons (quote +) (cons (cons (quote shen.get-profile) (cons V3139 (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 V3143) (let ((Results (kl:shen.get-profile V3143))) (let ((Initialise (kl:shen.put-profile V3143 0))) (kl:_waspvm_at_p V3143 Results)))) (export profile-results) (quote profile-results)) +(begin (register-function-arity (quote shen.get-profile) 1) (define (kl:shen.get-profile V3145) (guard (lambda (E) 0) (kl:get V3145 (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 V3148 V3149) (kl:put V3148 (quote profile) V3149 (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 f37edd3..095f60e 100644 --- a/compiled/types.kl.ms +++ b/compiled/types.kl.ms @@ -1,142 +1,142 @@ (module "compiled/types.kl") "Copyright (c) 2010-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:\n\n1. Redistributions of source code must retain the above copyright notice,\nthis list of conditions and the following disclaimer.\n\n2. Redistributions in binary form must reproduce the above copyright notice,\nthis list of conditions and the following disclaimer in the documentation\nand/or other materials provided with the distribution.\n\n3. Neither the name of the copyright holder nor the names of its contributors\nmay be used to endorse or promote products derived from this software without\nspecific prior written permission.\n\nTHIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ''AS IS'' AND\nANY EXPRESS 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 THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE\nFOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL\nDAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR\nSERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER\nCAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,\nOR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE\nOF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.\n" -(begin (register-function-arity (quote declare) 2) (define (kl:declare V4313 V4314) (let ((Record (kl:set (quote shen.*signedfuncs*) (cons (cons V4313 V4314) (kl:value (quote shen.*signedfuncs*)))))) (let ((Variancy (guard (lambda (E) (quote shen.skip)) (kl:shen.variancy-test V4313 V4314)))) (let ((Type (kl:shen.rcons_form (kl:shen.demodulate V4314)))) (let ((F* (kl:concat (quote shen.type-signature-of-) V4313))) (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))) V4313))))))))))) (export declare) (quote declare)) -(begin (register-function-arity (quote shen.demodulate) 1) (define (kl:shen.demodulate V4316) (let ((Demod (kl:shen.walk (kl:value (quote shen.*demodulation-function*)) V4316))) (if (kl:= Demod V4316) V4316 (kl:shen.demodulate Demod)))) (export shen.demodulate) (quote shen.demodulate)) -(begin (register-function-arity (quote shen.variancy-test) 2) (define (kl:shen.variancy-test V4319 V4320) (let ((TypeF (kl:shen.typecheck V4319 (quote B)))) (let ((Check (if (eq? (quote symbol) TypeF) (quote shen.skip) (if (assert-boolean (kl:shen.variant? TypeF V4320)) (quote shen.skip) (kl:shen.prhush (string-append "warning: changing the type of " (kl:shen.app V4319 " 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? V4333 V4334) (cond ((kl:= V4334 V4333) #t) ((and (pair? V4333) (and (pair? V4334) (kl:= (car V4334) (car V4333)))) (kl:shen.variant? (cdr V4333) (cdr V4334))) ((and (pair? V4333) (and (pair? V4334) (and (kl:shen.pvar? (car V4333)) (kl:variable? (car V4334))))) (kl:shen.variant? (kl:subst (quote shen.a) (car V4333) (cdr V4333)) (kl:subst (quote shen.a) (car V4334) (cdr V4334)))) ((and (pair? V4333) (and (pair? (car V4333)) (and (pair? V4334) (pair? (car V4334))))) (kl:shen.variant? (kl:append (car V4333) (cdr V4333)) (kl:append (car V4334) (cdr V4334)))) (#t #f))) (export shen.variant?) (quote shen.variant?)) -(begin (register-function-arity (quote shen.type-signature-of-absvector?) 3) (define (kl:shen.type-signature-of-absvector? V4339 V4340 V4341) (let ((A (kl:shen.newpv V4340))) (begin (kl:shen.incinfs) (kl:unify! V4339 (cons A (cons (quote -->) (cons (quote boolean) (quote ())))) V4340 V4341)))) (export shen.type-signature-of-absvector?) (quote shen.type-signature-of-absvector?)) -(begin (register-function-arity (quote shen.type-signature-of-adjoin) 3) (define (kl:shen.type-signature-of-adjoin V4349 V4350 V4351) (let ((A (kl:shen.newpv V4350))) (begin (kl:shen.incinfs) (kl:unify! V4349 (cons A (cons (quote -->) (cons (cons (cons (quote list) (cons A (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons A (quote ()))) (quote ())))) (quote ())))) V4350 V4351)))) (export shen.type-signature-of-adjoin) (quote shen.type-signature-of-adjoin)) -(begin (register-function-arity (quote shen.type-signature-of-and) 3) (define (kl:shen.type-signature-of-and V4359 V4360 V4361) (begin (kl:shen.incinfs) (kl:unify! V4359 (cons (quote boolean) (cons (quote -->) (cons (cons (quote boolean) (cons (quote -->) (cons (quote boolean) (quote ())))) (quote ())))) V4360 V4361))) (export shen.type-signature-of-and) (quote shen.type-signature-of-and)) -(begin (register-function-arity (quote shen.type-signature-of-shen.app) 3) (define (kl:shen.type-signature-of-shen.app V4369 V4370 V4371) (let ((A (kl:shen.newpv V4370))) (begin (kl:shen.incinfs) (kl:unify! V4369 (cons A (cons (quote -->) (cons (cons (quote string) (cons (quote -->) (cons (cons (quote symbol) (cons (quote -->) (cons (quote string) (quote ())))) (quote ())))) (quote ())))) V4370 V4371)))) (export shen.type-signature-of-shen.app) (quote shen.type-signature-of-shen.app)) -(begin (register-function-arity (quote shen.type-signature-of-append) 3) (define (kl:shen.type-signature-of-append V4379 V4380 V4381) (let ((A (kl:shen.newpv V4380))) (begin (kl:shen.incinfs) (kl:unify! V4379 (cons (cons (quote list) (cons A (quote ()))) (cons (quote -->) (cons (cons (cons (quote list) (cons A (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons A (quote ()))) (quote ())))) (quote ())))) V4380 V4381)))) (export shen.type-signature-of-append) (quote shen.type-signature-of-append)) -(begin (register-function-arity (quote shen.type-signature-of-arity) 3) (define (kl:shen.type-signature-of-arity V4389 V4390 V4391) (let ((A (kl:shen.newpv V4390))) (begin (kl:shen.incinfs) (kl:unify! V4389 (cons A (cons (quote -->) (cons (quote number) (quote ())))) V4390 V4391)))) (export shen.type-signature-of-arity) (quote shen.type-signature-of-arity)) -(begin (register-function-arity (quote shen.type-signature-of-assoc) 3) (define (kl:shen.type-signature-of-assoc V4399 V4400 V4401) (let ((A (kl:shen.newpv V4400))) (begin (kl:shen.incinfs) (kl:unify! V4399 (cons A (cons (quote -->) (cons (cons (cons (quote list) (cons (cons (quote list) (cons A (quote ()))) (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons A (quote ()))) (quote ())))) (quote ())))) V4400 V4401)))) (export shen.type-signature-of-assoc) (quote shen.type-signature-of-assoc)) -(begin (register-function-arity (quote shen.type-signature-of-boolean?) 3) (define (kl:shen.type-signature-of-boolean? V4409 V4410 V4411) (let ((A (kl:shen.newpv V4410))) (begin (kl:shen.incinfs) (kl:unify! V4409 (cons A (cons (quote -->) (cons (quote boolean) (quote ())))) V4410 V4411)))) (export shen.type-signature-of-boolean?) (quote shen.type-signature-of-boolean?)) -(begin (register-function-arity (quote shen.type-signature-of-bound?) 3) (define (kl:shen.type-signature-of-bound? V4419 V4420 V4421) (begin (kl:shen.incinfs) (kl:unify! V4419 (cons (quote symbol) (cons (quote -->) (cons (quote boolean) (quote ())))) V4420 V4421))) (export shen.type-signature-of-bound?) (quote shen.type-signature-of-bound?)) -(begin (register-function-arity (quote shen.type-signature-of-cd) 3) (define (kl:shen.type-signature-of-cd V4429 V4430 V4431) (begin (kl:shen.incinfs) (kl:unify! V4429 (cons (quote string) (cons (quote -->) (cons (quote string) (quote ())))) V4430 V4431))) (export shen.type-signature-of-cd) (quote shen.type-signature-of-cd)) -(begin (register-function-arity (quote shen.type-signature-of-close) 3) (define (kl:shen.type-signature-of-close V4439 V4440 V4441) (let ((A (kl:shen.newpv V4440))) (let ((B (kl:shen.newpv V4440))) (begin (kl:shen.incinfs) (kl:unify! V4439 (cons (cons (quote stream) (cons A (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons B (quote ()))) (quote ())))) V4440 V4441))))) (export shen.type-signature-of-close) (quote shen.type-signature-of-close)) -(begin (register-function-arity (quote shen.type-signature-of-cn) 3) (define (kl:shen.type-signature-of-cn V4449 V4450 V4451) (begin (kl:shen.incinfs) (kl:unify! V4449 (cons (quote string) (cons (quote -->) (cons (cons (quote string) (cons (quote -->) (cons (quote string) (quote ())))) (quote ())))) V4450 V4451))) (export shen.type-signature-of-cn) (quote shen.type-signature-of-cn)) -(begin (register-function-arity (quote shen.type-signature-of-compile) 3) (define (kl:shen.type-signature-of-compile V4459 V4460 V4461) (let ((A (kl:shen.newpv V4460))) (let ((B (kl:shen.newpv V4460))) (begin (kl:shen.incinfs) (kl:unify! V4459 (cons (cons A (cons (quote shen.==>) (cons B (quote ())))) (cons (quote -->) (cons (cons A (cons (quote -->) (cons (cons (cons A (cons (quote -->) (cons B (quote ())))) (cons (quote -->) (cons B (quote ())))) (quote ())))) (quote ())))) V4460 V4461))))) (export shen.type-signature-of-compile) (quote shen.type-signature-of-compile)) -(begin (register-function-arity (quote shen.type-signature-of-cons?) 3) (define (kl:shen.type-signature-of-cons? V4469 V4470 V4471) (let ((A (kl:shen.newpv V4470))) (begin (kl:shen.incinfs) (kl:unify! V4469 (cons A (cons (quote -->) (cons (quote boolean) (quote ())))) V4470 V4471)))) (export shen.type-signature-of-cons?) (quote shen.type-signature-of-cons?)) -(begin (register-function-arity (quote shen.type-signature-of-destroy) 3) (define (kl:shen.type-signature-of-destroy V4479 V4480 V4481) (let ((A (kl:shen.newpv V4480))) (let ((B (kl:shen.newpv V4480))) (begin (kl:shen.incinfs) (kl:unify! V4479 (cons (cons A (cons (quote -->) (cons B (quote ())))) (cons (quote -->) (cons (quote symbol) (quote ())))) V4480 V4481))))) (export shen.type-signature-of-destroy) (quote shen.type-signature-of-destroy)) -(begin (register-function-arity (quote shen.type-signature-of-difference) 3) (define (kl:shen.type-signature-of-difference V4489 V4490 V4491) (let ((A (kl:shen.newpv V4490))) (begin (kl:shen.incinfs) (kl:unify! V4489 (cons (cons (quote list) (cons A (quote ()))) (cons (quote -->) (cons (cons (cons (quote list) (cons A (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons A (quote ()))) (quote ())))) (quote ())))) V4490 V4491)))) (export shen.type-signature-of-difference) (quote shen.type-signature-of-difference)) -(begin (register-function-arity (quote shen.type-signature-of-do) 3) (define (kl:shen.type-signature-of-do V4499 V4500 V4501) (let ((A (kl:shen.newpv V4500))) (let ((B (kl:shen.newpv V4500))) (begin (kl:shen.incinfs) (kl:unify! V4499 (cons A (cons (quote -->) (cons (cons B (cons (quote -->) (cons B (quote ())))) (quote ())))) V4500 V4501))))) (export shen.type-signature-of-do) (quote shen.type-signature-of-do)) -(begin (register-function-arity (quote shen.type-signature-of-) 3) (define (kl:shen.type-signature-of- V4509 V4510 V4511) (let ((A (kl:shen.newpv V4510))) (let ((B (kl:shen.newpv V4510))) (begin (kl:shen.incinfs) (kl:unify! V4509 (cons (cons (quote list) (cons A (quote ()))) (cons (quote shen.==>) (cons (cons (quote list) (cons B (quote ()))) (quote ())))) V4510 V4511))))) (export shen.type-signature-of-) (quote shen.type-signature-of-)) -(begin (register-function-arity (quote shen.type-signature-of-) 3) (define (kl:shen.type-signature-of- V4519 V4520 V4521) (let ((A (kl:shen.newpv V4520))) (begin (kl:shen.incinfs) (kl:unify! V4519 (cons (cons (quote list) (cons A (quote ()))) (cons (quote shen.==>) (cons (cons (quote list) (cons A (quote ()))) (quote ())))) V4520 V4521)))) (export shen.type-signature-of-) (quote shen.type-signature-of-)) -(begin (register-function-arity (quote shen.type-signature-of-element?) 3) (define (kl:shen.type-signature-of-element? V4529 V4530 V4531) (let ((A (kl:shen.newpv V4530))) (begin (kl:shen.incinfs) (kl:unify! V4529 (cons A (cons (quote -->) (cons (cons (cons (quote list) (cons A (quote ()))) (cons (quote -->) (cons (quote boolean) (quote ())))) (quote ())))) V4530 V4531)))) (export shen.type-signature-of-element?) (quote shen.type-signature-of-element?)) -(begin (register-function-arity (quote shen.type-signature-of-empty?) 3) (define (kl:shen.type-signature-of-empty? V4539 V4540 V4541) (let ((A (kl:shen.newpv V4540))) (begin (kl:shen.incinfs) (kl:unify! V4539 (cons A (cons (quote -->) (cons (quote boolean) (quote ())))) V4540 V4541)))) (export shen.type-signature-of-empty?) (quote shen.type-signature-of-empty?)) -(begin (register-function-arity (quote shen.type-signature-of-enable-type-theory) 3) (define (kl:shen.type-signature-of-enable-type-theory V4549 V4550 V4551) (begin (kl:shen.incinfs) (kl:unify! V4549 (cons (quote symbol) (cons (quote -->) (cons (quote boolean) (quote ())))) V4550 V4551))) (export shen.type-signature-of-enable-type-theory) (quote shen.type-signature-of-enable-type-theory)) -(begin (register-function-arity (quote shen.type-signature-of-external) 3) (define (kl:shen.type-signature-of-external V4559 V4560 V4561) (begin (kl:shen.incinfs) (kl:unify! V4559 (cons (quote symbol) (cons (quote -->) (cons (cons (quote list) (cons (quote symbol) (quote ()))) (quote ())))) V4560 V4561))) (export shen.type-signature-of-external) (quote shen.type-signature-of-external)) -(begin (register-function-arity (quote shen.type-signature-of-error-to-string) 3) (define (kl:shen.type-signature-of-error-to-string V4569 V4570 V4571) (begin (kl:shen.incinfs) (kl:unify! V4569 (cons (quote exception) (cons (quote -->) (cons (quote string) (quote ())))) V4570 V4571))) (export shen.type-signature-of-error-to-string) (quote shen.type-signature-of-error-to-string)) -(begin (register-function-arity (quote shen.type-signature-of-explode) 3) (define (kl:shen.type-signature-of-explode V4579 V4580 V4581) (let ((A (kl:shen.newpv V4580))) (begin (kl:shen.incinfs) (kl:unify! V4579 (cons A (cons (quote -->) (cons (cons (quote list) (cons (quote string) (quote ()))) (quote ())))) V4580 V4581)))) (export shen.type-signature-of-explode) (quote shen.type-signature-of-explode)) -(begin (register-function-arity (quote shen.type-signature-of-fail) 3) (define (kl:shen.type-signature-of-fail V4589 V4590 V4591) (begin (kl:shen.incinfs) (kl:unify! V4589 (cons (quote -->) (cons (quote symbol) (quote ()))) V4590 V4591))) (export shen.type-signature-of-fail) (quote shen.type-signature-of-fail)) -(begin (register-function-arity (quote shen.type-signature-of-fail-if) 3) (define (kl:shen.type-signature-of-fail-if V4599 V4600 V4601) (begin (kl:shen.incinfs) (kl:unify! V4599 (cons (cons (quote symbol) (cons (quote -->) (cons (quote boolean) (quote ())))) (cons (quote -->) (cons (cons (quote symbol) (cons (quote -->) (cons (quote symbol) (quote ())))) (quote ())))) V4600 V4601))) (export shen.type-signature-of-fail-if) (quote shen.type-signature-of-fail-if)) -(begin (register-function-arity (quote shen.type-signature-of-fix) 3) (define (kl:shen.type-signature-of-fix V4609 V4610 V4611) (let ((A (kl:shen.newpv V4610))) (begin (kl:shen.incinfs) (kl:unify! V4609 (cons (cons A (cons (quote -->) (cons A (quote ())))) (cons (quote -->) (cons (cons A (cons (quote -->) (cons A (quote ())))) (quote ())))) V4610 V4611)))) (export shen.type-signature-of-fix) (quote shen.type-signature-of-fix)) -(begin (register-function-arity (quote shen.type-signature-of-freeze) 3) (define (kl:shen.type-signature-of-freeze V4619 V4620 V4621) (let ((A (kl:shen.newpv V4620))) (begin (kl:shen.incinfs) (kl:unify! V4619 (cons A (cons (quote -->) (cons (cons (quote lazy) (cons A (quote ()))) (quote ())))) V4620 V4621)))) (export shen.type-signature-of-freeze) (quote shen.type-signature-of-freeze)) -(begin (register-function-arity (quote shen.type-signature-of-fst) 3) (define (kl:shen.type-signature-of-fst V4629 V4630 V4631) (let ((B (kl:shen.newpv V4630))) (let ((A (kl:shen.newpv V4630))) (begin (kl:shen.incinfs) (kl:unify! V4629 (cons (cons A (cons (quote *) (cons B (quote ())))) (cons (quote -->) (cons A (quote ())))) V4630 V4631))))) (export shen.type-signature-of-fst) (quote shen.type-signature-of-fst)) -(begin (register-function-arity (quote shen.type-signature-of-function) 3) (define (kl:shen.type-signature-of-function V4639 V4640 V4641) (let ((A (kl:shen.newpv V4640))) (let ((B (kl:shen.newpv V4640))) (begin (kl:shen.incinfs) (kl:unify! V4639 (cons (cons A (cons (quote -->) (cons B (quote ())))) (cons (quote -->) (cons (cons A (cons (quote -->) (cons B (quote ())))) (quote ())))) V4640 V4641))))) (export shen.type-signature-of-function) (quote shen.type-signature-of-function)) -(begin (register-function-arity (quote shen.type-signature-of-gensym) 3) (define (kl:shen.type-signature-of-gensym V4649 V4650 V4651) (begin (kl:shen.incinfs) (kl:unify! V4649 (cons (quote symbol) (cons (quote -->) (cons (quote symbol) (quote ())))) V4650 V4651))) (export shen.type-signature-of-gensym) (quote shen.type-signature-of-gensym)) -(begin (register-function-arity (quote shen.type-signature-of-<-vector) 3) (define (kl:shen.type-signature-of-<-vector V4659 V4660 V4661) (let ((A (kl:shen.newpv V4660))) (begin (kl:shen.incinfs) (kl:unify! V4659 (cons (cons (quote vector) (cons A (quote ()))) (cons (quote -->) (cons (cons (quote number) (cons (quote -->) (cons A (quote ())))) (quote ())))) V4660 V4661)))) (export shen.type-signature-of-<-vector) (quote shen.type-signature-of-<-vector)) -(begin (register-function-arity (quote shen.type-signature-of-vector->) 3) (define (kl:shen.type-signature-of-vector-> V4669 V4670 V4671) (let ((A (kl:shen.newpv V4670))) (begin (kl:shen.incinfs) (kl:unify! V4669 (cons (cons (quote vector) (cons A (quote ()))) (cons (quote -->) (cons (cons (quote number) (cons (quote -->) (cons (cons A (cons (quote -->) (cons (cons (quote vector) (cons A (quote ()))) (quote ())))) (quote ())))) (quote ())))) V4670 V4671)))) (export shen.type-signature-of-vector->) (quote shen.type-signature-of-vector->)) -(begin (register-function-arity (quote shen.type-signature-of-vector) 3) (define (kl:shen.type-signature-of-vector V4679 V4680 V4681) (let ((A (kl:shen.newpv V4680))) (begin (kl:shen.incinfs) (kl:unify! V4679 (cons (quote number) (cons (quote -->) (cons (cons (quote vector) (cons A (quote ()))) (quote ())))) V4680 V4681)))) (export shen.type-signature-of-vector) (quote shen.type-signature-of-vector)) -(begin (register-function-arity (quote shen.type-signature-of-get-time) 3) (define (kl:shen.type-signature-of-get-time V4689 V4690 V4691) (begin (kl:shen.incinfs) (kl:unify! V4689 (cons (quote symbol) (cons (quote -->) (cons (quote number) (quote ())))) V4690 V4691))) (export shen.type-signature-of-get-time) (quote shen.type-signature-of-get-time)) -(begin (register-function-arity (quote shen.type-signature-of-hash) 3) (define (kl:shen.type-signature-of-hash V4699 V4700 V4701) (let ((A (kl:shen.newpv V4700))) (begin (kl:shen.incinfs) (kl:unify! V4699 (cons A (cons (quote -->) (cons (cons (quote number) (cons (quote -->) (cons (quote number) (quote ())))) (quote ())))) V4700 V4701)))) (export shen.type-signature-of-hash) (quote shen.type-signature-of-hash)) -(begin (register-function-arity (quote shen.type-signature-of-head) 3) (define (kl:shen.type-signature-of-head V4709 V4710 V4711) (let ((A (kl:shen.newpv V4710))) (begin (kl:shen.incinfs) (kl:unify! V4709 (cons (cons (quote list) (cons A (quote ()))) (cons (quote -->) (cons A (quote ())))) V4710 V4711)))) (export shen.type-signature-of-head) (quote shen.type-signature-of-head)) -(begin (register-function-arity (quote shen.type-signature-of-hdv) 3) (define (kl:shen.type-signature-of-hdv V4719 V4720 V4721) (let ((A (kl:shen.newpv V4720))) (begin (kl:shen.incinfs) (kl:unify! V4719 (cons (cons (quote vector) (cons A (quote ()))) (cons (quote -->) (cons A (quote ())))) V4720 V4721)))) (export shen.type-signature-of-hdv) (quote shen.type-signature-of-hdv)) -(begin (register-function-arity (quote shen.type-signature-of-hdstr) 3) (define (kl:shen.type-signature-of-hdstr V4729 V4730 V4731) (begin (kl:shen.incinfs) (kl:unify! V4729 (cons (quote string) (cons (quote -->) (cons (quote string) (quote ())))) V4730 V4731))) (export shen.type-signature-of-hdstr) (quote shen.type-signature-of-hdstr)) -(begin (register-function-arity (quote shen.type-signature-of-if) 3) (define (kl:shen.type-signature-of-if V4739 V4740 V4741) (let ((A (kl:shen.newpv V4740))) (begin (kl:shen.incinfs) (kl:unify! V4739 (cons (quote boolean) (cons (quote -->) (cons (cons A (cons (quote -->) (cons (cons A (cons (quote -->) (cons A (quote ())))) (quote ())))) (quote ())))) V4740 V4741)))) (export shen.type-signature-of-if) (quote shen.type-signature-of-if)) -(begin (register-function-arity (quote shen.type-signature-of-it) 3) (define (kl:shen.type-signature-of-it V4749 V4750 V4751) (begin (kl:shen.incinfs) (kl:unify! V4749 (cons (quote -->) (cons (quote string) (quote ()))) V4750 V4751))) (export shen.type-signature-of-it) (quote shen.type-signature-of-it)) -(begin (register-function-arity (quote shen.type-signature-of-implementation) 3) (define (kl:shen.type-signature-of-implementation V4759 V4760 V4761) (begin (kl:shen.incinfs) (kl:unify! V4759 (cons (quote -->) (cons (quote string) (quote ()))) V4760 V4761))) (export shen.type-signature-of-implementation) (quote shen.type-signature-of-implementation)) -(begin (register-function-arity (quote shen.type-signature-of-include) 3) (define (kl:shen.type-signature-of-include V4769 V4770 V4771) (begin (kl:shen.incinfs) (kl:unify! V4769 (cons (cons (quote list) (cons (quote symbol) (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons (quote symbol) (quote ()))) (quote ())))) V4770 V4771))) (export shen.type-signature-of-include) (quote shen.type-signature-of-include)) -(begin (register-function-arity (quote shen.type-signature-of-include-all-but) 3) (define (kl:shen.type-signature-of-include-all-but V4779 V4780 V4781) (begin (kl:shen.incinfs) (kl:unify! V4779 (cons (cons (quote list) (cons (quote symbol) (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons (quote symbol) (quote ()))) (quote ())))) V4780 V4781))) (export shen.type-signature-of-include-all-but) (quote shen.type-signature-of-include-all-but)) -(begin (register-function-arity (quote shen.type-signature-of-inferences) 3) (define (kl:shen.type-signature-of-inferences V4789 V4790 V4791) (begin (kl:shen.incinfs) (kl:unify! V4789 (cons (quote -->) (cons (quote number) (quote ()))) V4790 V4791))) (export shen.type-signature-of-inferences) (quote shen.type-signature-of-inferences)) -(begin (register-function-arity (quote shen.type-signature-of-shen.insert) 3) (define (kl:shen.type-signature-of-shen.insert V4799 V4800 V4801) (let ((A (kl:shen.newpv V4800))) (begin (kl:shen.incinfs) (kl:unify! V4799 (cons A (cons (quote -->) (cons (cons (quote string) (cons (quote -->) (cons (quote string) (quote ())))) (quote ())))) V4800 V4801)))) (export shen.type-signature-of-shen.insert) (quote shen.type-signature-of-shen.insert)) -(begin (register-function-arity (quote shen.type-signature-of-integer?) 3) (define (kl:shen.type-signature-of-integer? V4809 V4810 V4811) (let ((A (kl:shen.newpv V4810))) (begin (kl:shen.incinfs) (kl:unify! V4809 (cons A (cons (quote -->) (cons (quote boolean) (quote ())))) V4810 V4811)))) (export shen.type-signature-of-integer?) (quote shen.type-signature-of-integer?)) -(begin (register-function-arity (quote shen.type-signature-of-internal) 3) (define (kl:shen.type-signature-of-internal V4819 V4820 V4821) (begin (kl:shen.incinfs) (kl:unify! V4819 (cons (quote symbol) (cons (quote -->) (cons (cons (quote list) (cons (quote symbol) (quote ()))) (quote ())))) V4820 V4821))) (export shen.type-signature-of-internal) (quote shen.type-signature-of-internal)) -(begin (register-function-arity (quote shen.type-signature-of-intersection) 3) (define (kl:shen.type-signature-of-intersection V4829 V4830 V4831) (let ((A (kl:shen.newpv V4830))) (begin (kl:shen.incinfs) (kl:unify! V4829 (cons (cons (quote list) (cons A (quote ()))) (cons (quote -->) (cons (cons (cons (quote list) (cons A (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons A (quote ()))) (quote ())))) (quote ())))) V4830 V4831)))) (export shen.type-signature-of-intersection) (quote shen.type-signature-of-intersection)) -(begin (register-function-arity (quote shen.type-signature-of-kill) 3) (define (kl:shen.type-signature-of-kill V4839 V4840 V4841) (let ((A (kl:shen.newpv V4840))) (begin (kl:shen.incinfs) (kl:unify! V4839 (cons (quote -->) (cons A (quote ()))) V4840 V4841)))) (export shen.type-signature-of-kill) (quote shen.type-signature-of-kill)) -(begin (register-function-arity (quote shen.type-signature-of-language) 3) (define (kl:shen.type-signature-of-language V4849 V4850 V4851) (begin (kl:shen.incinfs) (kl:unify! V4849 (cons (quote -->) (cons (quote string) (quote ()))) V4850 V4851))) (export shen.type-signature-of-language) (quote shen.type-signature-of-language)) -(begin (register-function-arity (quote shen.type-signature-of-length) 3) (define (kl:shen.type-signature-of-length V4859 V4860 V4861) (let ((A (kl:shen.newpv V4860))) (begin (kl:shen.incinfs) (kl:unify! V4859 (cons (cons (quote list) (cons A (quote ()))) (cons (quote -->) (cons (quote number) (quote ())))) V4860 V4861)))) (export shen.type-signature-of-length) (quote shen.type-signature-of-length)) -(begin (register-function-arity (quote shen.type-signature-of-limit) 3) (define (kl:shen.type-signature-of-limit V4869 V4870 V4871) (let ((A (kl:shen.newpv V4870))) (begin (kl:shen.incinfs) (kl:unify! V4869 (cons (cons (quote vector) (cons A (quote ()))) (cons (quote -->) (cons (quote number) (quote ())))) V4870 V4871)))) (export shen.type-signature-of-limit) (quote shen.type-signature-of-limit)) -(begin (register-function-arity (quote shen.type-signature-of-load) 3) (define (kl:shen.type-signature-of-load V4879 V4880 V4881) (begin (kl:shen.incinfs) (kl:unify! V4879 (cons (quote string) (cons (quote -->) (cons (quote symbol) (quote ())))) V4880 V4881))) (export shen.type-signature-of-load) (quote shen.type-signature-of-load)) -(begin (register-function-arity (quote shen.type-signature-of-map) 3) (define (kl:shen.type-signature-of-map V4889 V4890 V4891) (let ((A (kl:shen.newpv V4890))) (let ((B (kl:shen.newpv V4890))) (begin (kl:shen.incinfs) (kl:unify! V4889 (cons (cons A (cons (quote -->) (cons B (quote ())))) (cons (quote -->) (cons (cons (cons (quote list) (cons A (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons B (quote ()))) (quote ())))) (quote ())))) V4890 V4891))))) (export shen.type-signature-of-map) (quote shen.type-signature-of-map)) -(begin (register-function-arity (quote shen.type-signature-of-mapcan) 3) (define (kl:shen.type-signature-of-mapcan V4899 V4900 V4901) (let ((A (kl:shen.newpv V4900))) (let ((B (kl:shen.newpv V4900))) (begin (kl:shen.incinfs) (kl:unify! V4899 (cons (cons A (cons (quote -->) (cons (cons (quote list) (cons B (quote ()))) (quote ())))) (cons (quote -->) (cons (cons (cons (quote list) (cons A (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons B (quote ()))) (quote ())))) (quote ())))) V4900 V4901))))) (export shen.type-signature-of-mapcan) (quote shen.type-signature-of-mapcan)) -(begin (register-function-arity (quote shen.type-signature-of-maxinferences) 3) (define (kl:shen.type-signature-of-maxinferences V4909 V4910 V4911) (begin (kl:shen.incinfs) (kl:unify! V4909 (cons (quote number) (cons (quote -->) (cons (quote number) (quote ())))) V4910 V4911))) (export shen.type-signature-of-maxinferences) (quote shen.type-signature-of-maxinferences)) -(begin (register-function-arity (quote shen.type-signature-of-n->string) 3) (define (kl:shen.type-signature-of-n->string V4919 V4920 V4921) (begin (kl:shen.incinfs) (kl:unify! V4919 (cons (quote number) (cons (quote -->) (cons (quote string) (quote ())))) V4920 V4921))) (export shen.type-signature-of-n->string) (quote shen.type-signature-of-n->string)) -(begin (register-function-arity (quote shen.type-signature-of-nl) 3) (define (kl:shen.type-signature-of-nl V4929 V4930 V4931) (begin (kl:shen.incinfs) (kl:unify! V4929 (cons (quote number) (cons (quote -->) (cons (quote number) (quote ())))) V4930 V4931))) (export shen.type-signature-of-nl) (quote shen.type-signature-of-nl)) -(begin (register-function-arity (quote shen.type-signature-of-not) 3) (define (kl:shen.type-signature-of-not V4939 V4940 V4941) (begin (kl:shen.incinfs) (kl:unify! V4939 (cons (quote boolean) (cons (quote -->) (cons (quote boolean) (quote ())))) V4940 V4941))) (export shen.type-signature-of-not) (quote shen.type-signature-of-not)) -(begin (register-function-arity (quote shen.type-signature-of-nth) 3) (define (kl:shen.type-signature-of-nth V4949 V4950 V4951) (let ((A (kl:shen.newpv V4950))) (begin (kl:shen.incinfs) (kl:unify! V4949 (cons (quote number) (cons (quote -->) (cons (cons (cons (quote list) (cons A (quote ()))) (cons (quote -->) (cons A (quote ())))) (quote ())))) V4950 V4951)))) (export shen.type-signature-of-nth) (quote shen.type-signature-of-nth)) -(begin (register-function-arity (quote shen.type-signature-of-number?) 3) (define (kl:shen.type-signature-of-number? V4959 V4960 V4961) (let ((A (kl:shen.newpv V4960))) (begin (kl:shen.incinfs) (kl:unify! V4959 (cons A (cons (quote -->) (cons (quote boolean) (quote ())))) V4960 V4961)))) (export shen.type-signature-of-number?) (quote shen.type-signature-of-number?)) -(begin (register-function-arity (quote shen.type-signature-of-occurrences) 3) (define (kl:shen.type-signature-of-occurrences V4969 V4970 V4971) (let ((A (kl:shen.newpv V4970))) (let ((B (kl:shen.newpv V4970))) (begin (kl:shen.incinfs) (kl:unify! V4969 (cons A (cons (quote -->) (cons (cons B (cons (quote -->) (cons (quote number) (quote ())))) (quote ())))) V4970 V4971))))) (export shen.type-signature-of-occurrences) (quote shen.type-signature-of-occurrences)) -(begin (register-function-arity (quote shen.type-signature-of-occurs-check) 3) (define (kl:shen.type-signature-of-occurs-check V4979 V4980 V4981) (begin (kl:shen.incinfs) (kl:unify! V4979 (cons (quote symbol) (cons (quote -->) (cons (quote boolean) (quote ())))) V4980 V4981))) (export shen.type-signature-of-occurs-check) (quote shen.type-signature-of-occurs-check)) -(begin (register-function-arity (quote shen.type-signature-of-optimise) 3) (define (kl:shen.type-signature-of-optimise V4989 V4990 V4991) (begin (kl:shen.incinfs) (kl:unify! V4989 (cons (quote symbol) (cons (quote -->) (cons (quote boolean) (quote ())))) V4990 V4991))) (export shen.type-signature-of-optimise) (quote shen.type-signature-of-optimise)) -(begin (register-function-arity (quote shen.type-signature-of-or) 3) (define (kl:shen.type-signature-of-or V4999 V5000 V5001) (begin (kl:shen.incinfs) (kl:unify! V4999 (cons (quote boolean) (cons (quote -->) (cons (cons (quote boolean) (cons (quote -->) (cons (quote boolean) (quote ())))) (quote ())))) V5000 V5001))) (export shen.type-signature-of-or) (quote shen.type-signature-of-or)) -(begin (register-function-arity (quote shen.type-signature-of-os) 3) (define (kl:shen.type-signature-of-os V5009 V5010 V5011) (begin (kl:shen.incinfs) (kl:unify! V5009 (cons (quote -->) (cons (quote string) (quote ()))) V5010 V5011))) (export shen.type-signature-of-os) (quote shen.type-signature-of-os)) -(begin (register-function-arity (quote shen.type-signature-of-package?) 3) (define (kl:shen.type-signature-of-package? V5019 V5020 V5021) (begin (kl:shen.incinfs) (kl:unify! V5019 (cons (quote symbol) (cons (quote -->) (cons (quote boolean) (quote ())))) V5020 V5021))) (export shen.type-signature-of-package?) (quote shen.type-signature-of-package?)) -(begin (register-function-arity (quote shen.type-signature-of-port) 3) (define (kl:shen.type-signature-of-port V5029 V5030 V5031) (begin (kl:shen.incinfs) (kl:unify! V5029 (cons (quote -->) (cons (quote string) (quote ()))) V5030 V5031))) (export shen.type-signature-of-port) (quote shen.type-signature-of-port)) -(begin (register-function-arity (quote shen.type-signature-of-porters) 3) (define (kl:shen.type-signature-of-porters V5039 V5040 V5041) (begin (kl:shen.incinfs) (kl:unify! V5039 (cons (quote -->) (cons (quote string) (quote ()))) V5040 V5041))) (export shen.type-signature-of-porters) (quote shen.type-signature-of-porters)) -(begin (register-function-arity (quote shen.type-signature-of-pos) 3) (define (kl:shen.type-signature-of-pos V5049 V5050 V5051) (begin (kl:shen.incinfs) (kl:unify! V5049 (cons (quote string) (cons (quote -->) (cons (cons (quote number) (cons (quote -->) (cons (quote string) (quote ())))) (quote ())))) V5050 V5051))) (export shen.type-signature-of-pos) (quote shen.type-signature-of-pos)) -(begin (register-function-arity (quote shen.type-signature-of-pr) 3) (define (kl:shen.type-signature-of-pr V5059 V5060 V5061) (begin (kl:shen.incinfs) (kl:unify! V5059 (cons (quote string) (cons (quote -->) (cons (cons (cons (quote stream) (cons (quote out) (quote ()))) (cons (quote -->) (cons (quote string) (quote ())))) (quote ())))) V5060 V5061))) (export shen.type-signature-of-pr) (quote shen.type-signature-of-pr)) -(begin (register-function-arity (quote shen.type-signature-of-print) 3) (define (kl:shen.type-signature-of-print V5069 V5070 V5071) (let ((A (kl:shen.newpv V5070))) (begin (kl:shen.incinfs) (kl:unify! V5069 (cons A (cons (quote -->) (cons A (quote ())))) V5070 V5071)))) (export shen.type-signature-of-print) (quote shen.type-signature-of-print)) -(begin (register-function-arity (quote shen.type-signature-of-profile) 3) (define (kl:shen.type-signature-of-profile V5079 V5080 V5081) (let ((A (kl:shen.newpv V5080))) (let ((B (kl:shen.newpv V5080))) (begin (kl:shen.incinfs) (kl:unify! V5079 (cons (cons A (cons (quote -->) (cons B (quote ())))) (cons (quote -->) (cons (cons A (cons (quote -->) (cons B (quote ())))) (quote ())))) V5080 V5081))))) (export shen.type-signature-of-profile) (quote shen.type-signature-of-profile)) -(begin (register-function-arity (quote shen.type-signature-of-preclude) 3) (define (kl:shen.type-signature-of-preclude V5089 V5090 V5091) (begin (kl:shen.incinfs) (kl:unify! V5089 (cons (cons (quote list) (cons (quote symbol) (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons (quote symbol) (quote ()))) (quote ())))) V5090 V5091))) (export shen.type-signature-of-preclude) (quote shen.type-signature-of-preclude)) -(begin (register-function-arity (quote shen.type-signature-of-shen.proc-nl) 3) (define (kl:shen.type-signature-of-shen.proc-nl V5099 V5100 V5101) (begin (kl:shen.incinfs) (kl:unify! V5099 (cons (quote string) (cons (quote -->) (cons (quote string) (quote ())))) V5100 V5101))) (export shen.type-signature-of-shen.proc-nl) (quote shen.type-signature-of-shen.proc-nl)) -(begin (register-function-arity (quote shen.type-signature-of-profile-results) 3) (define (kl:shen.type-signature-of-profile-results V5109 V5110 V5111) (let ((A (kl:shen.newpv V5110))) (let ((B (kl:shen.newpv V5110))) (begin (kl:shen.incinfs) (kl:unify! V5109 (cons (cons A (cons (quote -->) (cons B (quote ())))) (cons (quote -->) (cons (cons (cons A (cons (quote -->) (cons B (quote ())))) (cons (quote *) (cons (quote number) (quote ())))) (quote ())))) V5110 V5111))))) (export shen.type-signature-of-profile-results) (quote shen.type-signature-of-profile-results)) -(begin (register-function-arity (quote shen.type-signature-of-protect) 3) (define (kl:shen.type-signature-of-protect V5119 V5120 V5121) (begin (kl:shen.incinfs) (kl:unify! V5119 (cons (quote symbol) (cons (quote -->) (cons (quote symbol) (quote ())))) V5120 V5121))) (export shen.type-signature-of-protect) (quote shen.type-signature-of-protect)) -(begin (register-function-arity (quote shen.type-signature-of-preclude-all-but) 3) (define (kl:shen.type-signature-of-preclude-all-but V5129 V5130 V5131) (begin (kl:shen.incinfs) (kl:unify! V5129 (cons (cons (quote list) (cons (quote symbol) (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons (quote symbol) (quote ()))) (quote ())))) V5130 V5131))) (export shen.type-signature-of-preclude-all-but) (quote shen.type-signature-of-preclude-all-but)) -(begin (register-function-arity (quote shen.type-signature-of-shen.prhush) 3) (define (kl:shen.type-signature-of-shen.prhush V5139 V5140 V5141) (begin (kl:shen.incinfs) (kl:unify! V5139 (cons (quote string) (cons (quote -->) (cons (cons (cons (quote stream) (cons (quote out) (quote ()))) (cons (quote -->) (cons (quote string) (quote ())))) (quote ())))) V5140 V5141))) (export shen.type-signature-of-shen.prhush) (quote shen.type-signature-of-shen.prhush)) -(begin (register-function-arity (quote shen.type-signature-of-ps) 3) (define (kl:shen.type-signature-of-ps V5149 V5150 V5151) (begin (kl:shen.incinfs) (kl:unify! V5149 (cons (quote symbol) (cons (quote -->) (cons (cons (quote list) (cons (quote unit) (quote ()))) (quote ())))) V5150 V5151))) (export shen.type-signature-of-ps) (quote shen.type-signature-of-ps)) -(begin (register-function-arity (quote shen.type-signature-of-read) 3) (define (kl:shen.type-signature-of-read V5159 V5160 V5161) (begin (kl:shen.incinfs) (kl:unify! V5159 (cons (cons (quote stream) (cons (quote in) (quote ()))) (cons (quote -->) (cons (quote unit) (quote ())))) V5160 V5161))) (export shen.type-signature-of-read) (quote shen.type-signature-of-read)) -(begin (register-function-arity (quote shen.type-signature-of-read-byte) 3) (define (kl:shen.type-signature-of-read-byte V5169 V5170 V5171) (begin (kl:shen.incinfs) (kl:unify! V5169 (cons (cons (quote stream) (cons (quote in) (quote ()))) (cons (quote -->) (cons (quote number) (quote ())))) V5170 V5171))) (export shen.type-signature-of-read-byte) (quote shen.type-signature-of-read-byte)) -(begin (register-function-arity (quote shen.type-signature-of-read-file-as-bytelist) 3) (define (kl:shen.type-signature-of-read-file-as-bytelist V5179 V5180 V5181) (begin (kl:shen.incinfs) (kl:unify! V5179 (cons (quote string) (cons (quote -->) (cons (cons (quote list) (cons (quote number) (quote ()))) (quote ())))) V5180 V5181))) (export shen.type-signature-of-read-file-as-bytelist) (quote shen.type-signature-of-read-file-as-bytelist)) -(begin (register-function-arity (quote shen.type-signature-of-read-file-as-string) 3) (define (kl:shen.type-signature-of-read-file-as-string V5189 V5190 V5191) (begin (kl:shen.incinfs) (kl:unify! V5189 (cons (quote string) (cons (quote -->) (cons (quote string) (quote ())))) V5190 V5191))) (export shen.type-signature-of-read-file-as-string) (quote shen.type-signature-of-read-file-as-string)) -(begin (register-function-arity (quote shen.type-signature-of-read-file) 3) (define (kl:shen.type-signature-of-read-file V5199 V5200 V5201) (begin (kl:shen.incinfs) (kl:unify! V5199 (cons (quote string) (cons (quote -->) (cons (cons (quote list) (cons (quote unit) (quote ()))) (quote ())))) V5200 V5201))) (export shen.type-signature-of-read-file) (quote shen.type-signature-of-read-file)) -(begin (register-function-arity (quote shen.type-signature-of-read-from-string) 3) (define (kl:shen.type-signature-of-read-from-string V5209 V5210 V5211) (begin (kl:shen.incinfs) (kl:unify! V5209 (cons (quote string) (cons (quote -->) (cons (cons (quote list) (cons (quote unit) (quote ()))) (quote ())))) V5210 V5211))) (export shen.type-signature-of-read-from-string) (quote shen.type-signature-of-read-from-string)) -(begin (register-function-arity (quote shen.type-signature-of-release) 3) (define (kl:shen.type-signature-of-release V5219 V5220 V5221) (begin (kl:shen.incinfs) (kl:unify! V5219 (cons (quote -->) (cons (quote string) (quote ()))) V5220 V5221))) (export shen.type-signature-of-release) (quote shen.type-signature-of-release)) -(begin (register-function-arity (quote shen.type-signature-of-remove) 3) (define (kl:shen.type-signature-of-remove V5229 V5230 V5231) (let ((A (kl:shen.newpv V5230))) (begin (kl:shen.incinfs) (kl:unify! V5229 (cons A (cons (quote -->) (cons (cons (cons (quote list) (cons A (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons A (quote ()))) (quote ())))) (quote ())))) V5230 V5231)))) (export shen.type-signature-of-remove) (quote shen.type-signature-of-remove)) -(begin (register-function-arity (quote shen.type-signature-of-reverse) 3) (define (kl:shen.type-signature-of-reverse V5239 V5240 V5241) (let ((A (kl:shen.newpv V5240))) (begin (kl:shen.incinfs) (kl:unify! V5239 (cons (cons (quote list) (cons A (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons A (quote ()))) (quote ())))) V5240 V5241)))) (export shen.type-signature-of-reverse) (quote shen.type-signature-of-reverse)) -(begin (register-function-arity (quote shen.type-signature-of-simple-error) 3) (define (kl:shen.type-signature-of-simple-error V5249 V5250 V5251) (let ((A (kl:shen.newpv V5250))) (begin (kl:shen.incinfs) (kl:unify! V5249 (cons (quote string) (cons (quote -->) (cons A (quote ())))) V5250 V5251)))) (export shen.type-signature-of-simple-error) (quote shen.type-signature-of-simple-error)) -(begin (register-function-arity (quote shen.type-signature-of-snd) 3) (define (kl:shen.type-signature-of-snd V5259 V5260 V5261) (let ((A (kl:shen.newpv V5260))) (let ((B (kl:shen.newpv V5260))) (begin (kl:shen.incinfs) (kl:unify! V5259 (cons (cons A (cons (quote *) (cons B (quote ())))) (cons (quote -->) (cons B (quote ())))) V5260 V5261))))) (export shen.type-signature-of-snd) (quote shen.type-signature-of-snd)) -(begin (register-function-arity (quote shen.type-signature-of-specialise) 3) (define (kl:shen.type-signature-of-specialise V5269 V5270 V5271) (begin (kl:shen.incinfs) (kl:unify! V5269 (cons (quote symbol) (cons (quote -->) (cons (quote symbol) (quote ())))) V5270 V5271))) (export shen.type-signature-of-specialise) (quote shen.type-signature-of-specialise)) -(begin (register-function-arity (quote shen.type-signature-of-spy) 3) (define (kl:shen.type-signature-of-spy V5279 V5280 V5281) (begin (kl:shen.incinfs) (kl:unify! V5279 (cons (quote symbol) (cons (quote -->) (cons (quote boolean) (quote ())))) V5280 V5281))) (export shen.type-signature-of-spy) (quote shen.type-signature-of-spy)) -(begin (register-function-arity (quote shen.type-signature-of-step) 3) (define (kl:shen.type-signature-of-step V5289 V5290 V5291) (begin (kl:shen.incinfs) (kl:unify! V5289 (cons (quote symbol) (cons (quote -->) (cons (quote boolean) (quote ())))) V5290 V5291))) (export shen.type-signature-of-step) (quote shen.type-signature-of-step)) -(begin (register-function-arity (quote shen.type-signature-of-stinput) 3) (define (kl:shen.type-signature-of-stinput V5299 V5300 V5301) (begin (kl:shen.incinfs) (kl:unify! V5299 (cons (quote -->) (cons (cons (quote stream) (cons (quote in) (quote ()))) (quote ()))) V5300 V5301))) (export shen.type-signature-of-stinput) (quote shen.type-signature-of-stinput)) -(begin (register-function-arity (quote shen.type-signature-of-sterror) 3) (define (kl:shen.type-signature-of-sterror V5309 V5310 V5311) (begin (kl:shen.incinfs) (kl:unify! V5309 (cons (quote -->) (cons (cons (quote stream) (cons (quote out) (quote ()))) (quote ()))) V5310 V5311))) (export shen.type-signature-of-sterror) (quote shen.type-signature-of-sterror)) -(begin (register-function-arity (quote shen.type-signature-of-stoutput) 3) (define (kl:shen.type-signature-of-stoutput V5319 V5320 V5321) (begin (kl:shen.incinfs) (kl:unify! V5319 (cons (quote -->) (cons (cons (quote stream) (cons (quote out) (quote ()))) (quote ()))) V5320 V5321))) (export shen.type-signature-of-stoutput) (quote shen.type-signature-of-stoutput)) -(begin (register-function-arity (quote shen.type-signature-of-string?) 3) (define (kl:shen.type-signature-of-string? V5329 V5330 V5331) (let ((A (kl:shen.newpv V5330))) (begin (kl:shen.incinfs) (kl:unify! V5329 (cons A (cons (quote -->) (cons (quote boolean) (quote ())))) V5330 V5331)))) (export shen.type-signature-of-string?) (quote shen.type-signature-of-string?)) -(begin (register-function-arity (quote shen.type-signature-of-str) 3) (define (kl:shen.type-signature-of-str V5339 V5340 V5341) (let ((A (kl:shen.newpv V5340))) (begin (kl:shen.incinfs) (kl:unify! V5339 (cons A (cons (quote -->) (cons (quote string) (quote ())))) V5340 V5341)))) (export shen.type-signature-of-str) (quote shen.type-signature-of-str)) -(begin (register-function-arity (quote shen.type-signature-of-string->n) 3) (define (kl:shen.type-signature-of-string->n V5349 V5350 V5351) (begin (kl:shen.incinfs) (kl:unify! V5349 (cons (quote string) (cons (quote -->) (cons (quote number) (quote ())))) V5350 V5351))) (export shen.type-signature-of-string->n) (quote shen.type-signature-of-string->n)) -(begin (register-function-arity (quote shen.type-signature-of-string->symbol) 3) (define (kl:shen.type-signature-of-string->symbol V5359 V5360 V5361) (begin (kl:shen.incinfs) (kl:unify! V5359 (cons (quote string) (cons (quote -->) (cons (quote symbol) (quote ())))) V5360 V5361))) (export shen.type-signature-of-string->symbol) (quote shen.type-signature-of-string->symbol)) -(begin (register-function-arity (quote shen.type-signature-of-sum) 3) (define (kl:shen.type-signature-of-sum V5369 V5370 V5371) (begin (kl:shen.incinfs) (kl:unify! V5369 (cons (cons (quote list) (cons (quote number) (quote ()))) (cons (quote -->) (cons (quote number) (quote ())))) V5370 V5371))) (export shen.type-signature-of-sum) (quote shen.type-signature-of-sum)) -(begin (register-function-arity (quote shen.type-signature-of-symbol?) 3) (define (kl:shen.type-signature-of-symbol? V5379 V5380 V5381) (let ((A (kl:shen.newpv V5380))) (begin (kl:shen.incinfs) (kl:unify! V5379 (cons A (cons (quote -->) (cons (quote boolean) (quote ())))) V5380 V5381)))) (export shen.type-signature-of-symbol?) (quote shen.type-signature-of-symbol?)) -(begin (register-function-arity (quote shen.type-signature-of-systemf) 3) (define (kl:shen.type-signature-of-systemf V5389 V5390 V5391) (begin (kl:shen.incinfs) (kl:unify! V5389 (cons (quote symbol) (cons (quote -->) (cons (quote symbol) (quote ())))) V5390 V5391))) (export shen.type-signature-of-systemf) (quote shen.type-signature-of-systemf)) -(begin (register-function-arity (quote shen.type-signature-of-tail) 3) (define (kl:shen.type-signature-of-tail V5399 V5400 V5401) (let ((A (kl:shen.newpv V5400))) (begin (kl:shen.incinfs) (kl:unify! V5399 (cons (cons (quote list) (cons A (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons A (quote ()))) (quote ())))) V5400 V5401)))) (export shen.type-signature-of-tail) (quote shen.type-signature-of-tail)) -(begin (register-function-arity (quote shen.type-signature-of-tlstr) 3) (define (kl:shen.type-signature-of-tlstr V5409 V5410 V5411) (begin (kl:shen.incinfs) (kl:unify! V5409 (cons (quote string) (cons (quote -->) (cons (quote string) (quote ())))) V5410 V5411))) (export shen.type-signature-of-tlstr) (quote shen.type-signature-of-tlstr)) -(begin (register-function-arity (quote shen.type-signature-of-tlv) 3) (define (kl:shen.type-signature-of-tlv V5419 V5420 V5421) (let ((A (kl:shen.newpv V5420))) (begin (kl:shen.incinfs) (kl:unify! V5419 (cons (cons (quote vector) (cons A (quote ()))) (cons (quote -->) (cons (cons (quote vector) (cons A (quote ()))) (quote ())))) V5420 V5421)))) (export shen.type-signature-of-tlv) (quote shen.type-signature-of-tlv)) -(begin (register-function-arity (quote shen.type-signature-of-tc) 3) (define (kl:shen.type-signature-of-tc V5429 V5430 V5431) (begin (kl:shen.incinfs) (kl:unify! V5429 (cons (quote symbol) (cons (quote -->) (cons (quote boolean) (quote ())))) V5430 V5431))) (export shen.type-signature-of-tc) (quote shen.type-signature-of-tc)) -(begin (register-function-arity (quote shen.type-signature-of-tc?) 3) (define (kl:shen.type-signature-of-tc? V5439 V5440 V5441) (begin (kl:shen.incinfs) (kl:unify! V5439 (cons (quote -->) (cons (quote boolean) (quote ()))) V5440 V5441))) (export shen.type-signature-of-tc?) (quote shen.type-signature-of-tc?)) -(begin (register-function-arity (quote shen.type-signature-of-thaw) 3) (define (kl:shen.type-signature-of-thaw V5449 V5450 V5451) (let ((A (kl:shen.newpv V5450))) (begin (kl:shen.incinfs) (kl:unify! V5449 (cons (cons (quote lazy) (cons A (quote ()))) (cons (quote -->) (cons A (quote ())))) V5450 V5451)))) (export shen.type-signature-of-thaw) (quote shen.type-signature-of-thaw)) -(begin (register-function-arity (quote shen.type-signature-of-track) 3) (define (kl:shen.type-signature-of-track V5459 V5460 V5461) (begin (kl:shen.incinfs) (kl:unify! V5459 (cons (quote symbol) (cons (quote -->) (cons (quote symbol) (quote ())))) V5460 V5461))) (export shen.type-signature-of-track) (quote shen.type-signature-of-track)) -(begin (register-function-arity (quote shen.type-signature-of-trap-error) 3) (define (kl:shen.type-signature-of-trap-error V5469 V5470 V5471) (let ((A (kl:shen.newpv V5470))) (begin (kl:shen.incinfs) (kl:unify! V5469 (cons A (cons (quote -->) (cons (cons (cons (quote exception) (cons (quote -->) (cons A (quote ())))) (cons (quote -->) (cons A (quote ())))) (quote ())))) V5470 V5471)))) (export shen.type-signature-of-trap-error) (quote shen.type-signature-of-trap-error)) -(begin (register-function-arity (quote shen.type-signature-of-tuple?) 3) (define (kl:shen.type-signature-of-tuple? V5479 V5480 V5481) (let ((A (kl:shen.newpv V5480))) (begin (kl:shen.incinfs) (kl:unify! V5479 (cons A (cons (quote -->) (cons (quote boolean) (quote ())))) V5480 V5481)))) (export shen.type-signature-of-tuple?) (quote shen.type-signature-of-tuple?)) -(begin (register-function-arity (quote shen.type-signature-of-undefmacro) 3) (define (kl:shen.type-signature-of-undefmacro V5489 V5490 V5491) (begin (kl:shen.incinfs) (kl:unify! V5489 (cons (quote symbol) (cons (quote -->) (cons (quote symbol) (quote ())))) V5490 V5491))) (export shen.type-signature-of-undefmacro) (quote shen.type-signature-of-undefmacro)) -(begin (register-function-arity (quote shen.type-signature-of-union) 3) (define (kl:shen.type-signature-of-union V5499 V5500 V5501) (let ((A (kl:shen.newpv V5500))) (begin (kl:shen.incinfs) (kl:unify! V5499 (cons (cons (quote list) (cons A (quote ()))) (cons (quote -->) (cons (cons (cons (quote list) (cons A (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons A (quote ()))) (quote ())))) (quote ())))) V5500 V5501)))) (export shen.type-signature-of-union) (quote shen.type-signature-of-union)) -(begin (register-function-arity (quote shen.type-signature-of-unprofile) 3) (define (kl:shen.type-signature-of-unprofile V5509 V5510 V5511) (let ((A (kl:shen.newpv V5510))) (let ((B (kl:shen.newpv V5510))) (begin (kl:shen.incinfs) (kl:unify! V5509 (cons (cons A (cons (quote -->) (cons B (quote ())))) (cons (quote -->) (cons (cons A (cons (quote -->) (cons B (quote ())))) (quote ())))) V5510 V5511))))) (export shen.type-signature-of-unprofile) (quote shen.type-signature-of-unprofile)) -(begin (register-function-arity (quote shen.type-signature-of-untrack) 3) (define (kl:shen.type-signature-of-untrack V5519 V5520 V5521) (begin (kl:shen.incinfs) (kl:unify! V5519 (cons (quote symbol) (cons (quote -->) (cons (quote symbol) (quote ())))) V5520 V5521))) (export shen.type-signature-of-untrack) (quote shen.type-signature-of-untrack)) -(begin (register-function-arity (quote shen.type-signature-of-unspecialise) 3) (define (kl:shen.type-signature-of-unspecialise V5529 V5530 V5531) (begin (kl:shen.incinfs) (kl:unify! V5529 (cons (quote symbol) (cons (quote -->) (cons (quote symbol) (quote ())))) V5530 V5531))) (export shen.type-signature-of-unspecialise) (quote shen.type-signature-of-unspecialise)) -(begin (register-function-arity (quote shen.type-signature-of-variable?) 3) (define (kl:shen.type-signature-of-variable? V5539 V5540 V5541) (let ((A (kl:shen.newpv V5540))) (begin (kl:shen.incinfs) (kl:unify! V5539 (cons A (cons (quote -->) (cons (quote boolean) (quote ())))) V5540 V5541)))) (export shen.type-signature-of-variable?) (quote shen.type-signature-of-variable?)) -(begin (register-function-arity (quote shen.type-signature-of-vector?) 3) (define (kl:shen.type-signature-of-vector? V5549 V5550 V5551) (let ((A (kl:shen.newpv V5550))) (begin (kl:shen.incinfs) (kl:unify! V5549 (cons A (cons (quote -->) (cons (quote boolean) (quote ())))) V5550 V5551)))) (export shen.type-signature-of-vector?) (quote shen.type-signature-of-vector?)) -(begin (register-function-arity (quote shen.type-signature-of-version) 3) (define (kl:shen.type-signature-of-version V5559 V5560 V5561) (begin (kl:shen.incinfs) (kl:unify! V5559 (cons (quote -->) (cons (quote string) (quote ()))) V5560 V5561))) (export shen.type-signature-of-version) (quote shen.type-signature-of-version)) -(begin (register-function-arity (quote shen.type-signature-of-write-to-file) 3) (define (kl:shen.type-signature-of-write-to-file V5569 V5570 V5571) (let ((A (kl:shen.newpv V5570))) (begin (kl:shen.incinfs) (kl:unify! V5569 (cons (quote string) (cons (quote -->) (cons (cons A (cons (quote -->) (cons A (quote ())))) (quote ())))) V5570 V5571)))) (export shen.type-signature-of-write-to-file) (quote shen.type-signature-of-write-to-file)) -(begin (register-function-arity (quote shen.type-signature-of-write-byte) 3) (define (kl:shen.type-signature-of-write-byte V5579 V5580 V5581) (begin (kl:shen.incinfs) (kl:unify! V5579 (cons (quote number) (cons (quote -->) (cons (cons (cons (quote stream) (cons (quote out) (quote ()))) (cons (quote -->) (cons (quote number) (quote ())))) (quote ())))) V5580 V5581))) (export shen.type-signature-of-write-byte) (quote shen.type-signature-of-write-byte)) -(begin (register-function-arity (quote shen.type-signature-of-y-or-n?) 3) (define (kl:shen.type-signature-of-y-or-n? V5589 V5590 V5591) (begin (kl:shen.incinfs) (kl:unify! V5589 (cons (quote string) (cons (quote -->) (cons (quote boolean) (quote ())))) V5590 V5591))) (export shen.type-signature-of-y-or-n?) (quote shen.type-signature-of-y-or-n?)) -(begin (register-function-arity (quote shen.type-signature-of->) 3) (define (kl:shen.type-signature-of-> V5599 V5600 V5601) (begin (kl:shen.incinfs) (kl:unify! V5599 (cons (quote number) (cons (quote -->) (cons (cons (quote number) (cons (quote -->) (cons (quote boolean) (quote ())))) (quote ())))) V5600 V5601))) (export shen.type-signature-of->) (quote shen.type-signature-of->)) -(begin (register-function-arity (quote shen.type-signature-of-<) 3) (define (kl:shen.type-signature-of-< V5609 V5610 V5611) (begin (kl:shen.incinfs) (kl:unify! V5609 (cons (quote number) (cons (quote -->) (cons (cons (quote number) (cons (quote -->) (cons (quote boolean) (quote ())))) (quote ())))) V5610 V5611))) (export shen.type-signature-of-<) (quote shen.type-signature-of-<)) -(begin (register-function-arity (quote shen.type-signature-of->=) 3) (define (kl:shen.type-signature-of->= V5619 V5620 V5621) (begin (kl:shen.incinfs) (kl:unify! V5619 (cons (quote number) (cons (quote -->) (cons (cons (quote number) (cons (quote -->) (cons (quote boolean) (quote ())))) (quote ())))) V5620 V5621))) (export shen.type-signature-of->=) (quote shen.type-signature-of->=)) -(begin (register-function-arity (quote shen.type-signature-of-<=) 3) (define (kl:shen.type-signature-of-<= V5629 V5630 V5631) (begin (kl:shen.incinfs) (kl:unify! V5629 (cons (quote number) (cons (quote -->) (cons (cons (quote number) (cons (quote -->) (cons (quote boolean) (quote ())))) (quote ())))) V5630 V5631))) (export shen.type-signature-of-<=) (quote shen.type-signature-of-<=)) -(begin (register-function-arity (quote shen.type-signature-of-=) 3) (define (kl:shen.type-signature-of-= V5639 V5640 V5641) (let ((A (kl:shen.newpv V5640))) (begin (kl:shen.incinfs) (kl:unify! V5639 (cons A (cons (quote -->) (cons (cons A (cons (quote -->) (cons (quote boolean) (quote ())))) (quote ())))) V5640 V5641)))) (export shen.type-signature-of-=) (quote shen.type-signature-of-=)) -(begin (register-function-arity (quote shen.type-signature-of-+) 3) (define (kl:shen.type-signature-of-+ V5649 V5650 V5651) (begin (kl:shen.incinfs) (kl:unify! V5649 (cons (quote number) (cons (quote -->) (cons (cons (quote number) (cons (quote -->) (cons (quote number) (quote ())))) (quote ())))) V5650 V5651))) (export shen.type-signature-of-+) (quote shen.type-signature-of-+)) -(begin (register-function-arity (quote shen.type-signature-of-/) 3) (define (kl:shen.type-signature-of-/ V5659 V5660 V5661) (begin (kl:shen.incinfs) (kl:unify! V5659 (cons (quote number) (cons (quote -->) (cons (cons (quote number) (cons (quote -->) (cons (quote number) (quote ())))) (quote ())))) V5660 V5661))) (export shen.type-signature-of-/) (quote shen.type-signature-of-/)) -(begin (register-function-arity (quote shen.type-signature-of--) 3) (define (kl:shen.type-signature-of-- V5669 V5670 V5671) (begin (kl:shen.incinfs) (kl:unify! V5669 (cons (quote number) (cons (quote -->) (cons (cons (quote number) (cons (quote -->) (cons (quote number) (quote ())))) (quote ())))) V5670 V5671))) (export shen.type-signature-of--) (quote shen.type-signature-of--)) -(begin (register-function-arity (quote shen.type-signature-of-*) 3) (define (kl:shen.type-signature-of-* V5679 V5680 V5681) (begin (kl:shen.incinfs) (kl:unify! V5679 (cons (quote number) (cons (quote -->) (cons (cons (quote number) (cons (quote -->) (cons (quote number) (quote ())))) (quote ())))) V5680 V5681))) (export shen.type-signature-of-*) (quote shen.type-signature-of-*)) -(begin (register-function-arity (quote shen.type-signature-of-==) 3) (define (kl:shen.type-signature-of-== V5689 V5690 V5691) (let ((A (kl:shen.newpv V5690))) (let ((B (kl:shen.newpv V5690))) (begin (kl:shen.incinfs) (kl:unify! V5689 (cons A (cons (quote -->) (cons (cons B (cons (quote -->) (cons (quote boolean) (quote ())))) (quote ())))) V5690 V5691))))) (export shen.type-signature-of-==) (quote shen.type-signature-of-==)) +(begin (register-function-arity (quote declare) 2) (define (kl:declare V3152 V3153) (let ((Record (kl:set (quote shen.*signedfuncs*) (cons (cons V3152 V3153) (kl:value (quote shen.*signedfuncs*)))))) (let ((Variancy (guard (lambda (E) (quote shen.skip)) (kl:shen.variancy-test V3152 V3153)))) (let ((Type (kl:shen.rcons_form (kl:shen.demodulate V3153)))) (let ((F* (kl:concat (quote shen.type-signature-of-) V3152))) (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))) V3152))))))))))) (export declare) (quote declare)) +(begin (register-function-arity (quote shen.demodulate) 1) (define (kl:shen.demodulate V3155) (let ((Demod (kl:shen.walk (kl:value (quote shen.*demodulation-function*)) V3155))) (if (kl:= Demod V3155) V3155 (kl:shen.demodulate Demod)))) (export shen.demodulate) (quote shen.demodulate)) +(begin (register-function-arity (quote shen.variancy-test) 2) (define (kl:shen.variancy-test V3158 V3159) (let ((TypeF (kl:shen.typecheck V3158 (quote B)))) (let ((Check (if (eq? (quote symbol) TypeF) (quote shen.skip) (if (assert-boolean (kl:shen.variant? TypeF V3159)) (quote shen.skip) (kl:shen.prhush (string-append "warning: changing the type of " (kl:shen.app V3158 " 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? V3172 V3173) (cond ((kl:= V3173 V3172) #t) ((and (pair? V3172) (and (pair? V3173) (kl:= (car V3173) (car V3172)))) (kl:shen.variant? (cdr V3172) (cdr V3173))) ((and (pair? V3172) (and (pair? V3173) (and (kl:shen.pvar? (car V3172)) (kl:variable? (car V3173))))) (kl:shen.variant? (kl:subst (quote shen.a) (car V3172) (cdr V3172)) (kl:subst (quote shen.a) (car V3173) (cdr V3173)))) ((and (pair? V3172) (and (pair? (car V3172)) (and (pair? V3173) (pair? (car V3173))))) (kl:shen.variant? (kl:append (car V3172) (cdr V3172)) (kl:append (car V3173) (cdr V3173)))) (#t #f))) (export shen.variant?) (quote shen.variant?)) +(begin (register-function-arity (quote shen.type-signature-of-absvector?) 3) (define (kl:shen.type-signature-of-absvector? V3178 V3179 V3180) (let ((A (kl:shen.newpv V3179))) (begin (kl:shen.incinfs) (kl:unify! V3178 (cons A (cons (quote -->) (cons (quote boolean) (quote ())))) V3179 V3180)))) (export shen.type-signature-of-absvector?) (quote shen.type-signature-of-absvector?)) +(begin (register-function-arity (quote shen.type-signature-of-adjoin) 3) (define (kl:shen.type-signature-of-adjoin V3188 V3189 V3190) (let ((A (kl:shen.newpv V3189))) (begin (kl:shen.incinfs) (kl:unify! V3188 (cons A (cons (quote -->) (cons (cons (cons (quote list) (cons A (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons A (quote ()))) (quote ())))) (quote ())))) V3189 V3190)))) (export shen.type-signature-of-adjoin) (quote shen.type-signature-of-adjoin)) +(begin (register-function-arity (quote shen.type-signature-of-and) 3) (define (kl:shen.type-signature-of-and V3198 V3199 V3200) (begin (kl:shen.incinfs) (kl:unify! V3198 (cons (quote boolean) (cons (quote -->) (cons (cons (quote boolean) (cons (quote -->) (cons (quote boolean) (quote ())))) (quote ())))) V3199 V3200))) (export shen.type-signature-of-and) (quote shen.type-signature-of-and)) +(begin (register-function-arity (quote shen.type-signature-of-shen.app) 3) (define (kl:shen.type-signature-of-shen.app V3208 V3209 V3210) (let ((A (kl:shen.newpv V3209))) (begin (kl:shen.incinfs) (kl:unify! V3208 (cons A (cons (quote -->) (cons (cons (quote string) (cons (quote -->) (cons (cons (quote symbol) (cons (quote -->) (cons (quote string) (quote ())))) (quote ())))) (quote ())))) V3209 V3210)))) (export shen.type-signature-of-shen.app) (quote shen.type-signature-of-shen.app)) +(begin (register-function-arity (quote shen.type-signature-of-append) 3) (define (kl:shen.type-signature-of-append V3218 V3219 V3220) (let ((A (kl:shen.newpv V3219))) (begin (kl:shen.incinfs) (kl:unify! V3218 (cons (cons (quote list) (cons A (quote ()))) (cons (quote -->) (cons (cons (cons (quote list) (cons A (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons A (quote ()))) (quote ())))) (quote ())))) V3219 V3220)))) (export shen.type-signature-of-append) (quote shen.type-signature-of-append)) +(begin (register-function-arity (quote shen.type-signature-of-arity) 3) (define (kl:shen.type-signature-of-arity V3228 V3229 V3230) (let ((A (kl:shen.newpv V3229))) (begin (kl:shen.incinfs) (kl:unify! V3228 (cons A (cons (quote -->) (cons (quote number) (quote ())))) V3229 V3230)))) (export shen.type-signature-of-arity) (quote shen.type-signature-of-arity)) +(begin (register-function-arity (quote shen.type-signature-of-assoc) 3) (define (kl:shen.type-signature-of-assoc V3238 V3239 V3240) (let ((A (kl:shen.newpv V3239))) (begin (kl:shen.incinfs) (kl:unify! V3238 (cons A (cons (quote -->) (cons (cons (cons (quote list) (cons (cons (quote list) (cons A (quote ()))) (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons A (quote ()))) (quote ())))) (quote ())))) V3239 V3240)))) (export shen.type-signature-of-assoc) (quote shen.type-signature-of-assoc)) +(begin (register-function-arity (quote shen.type-signature-of-boolean?) 3) (define (kl:shen.type-signature-of-boolean? V3248 V3249 V3250) (let ((A (kl:shen.newpv V3249))) (begin (kl:shen.incinfs) (kl:unify! V3248 (cons A (cons (quote -->) (cons (quote boolean) (quote ())))) V3249 V3250)))) (export shen.type-signature-of-boolean?) (quote shen.type-signature-of-boolean?)) +(begin (register-function-arity (quote shen.type-signature-of-bound?) 3) (define (kl:shen.type-signature-of-bound? V3258 V3259 V3260) (begin (kl:shen.incinfs) (kl:unify! V3258 (cons (quote symbol) (cons (quote -->) (cons (quote boolean) (quote ())))) V3259 V3260))) (export shen.type-signature-of-bound?) (quote shen.type-signature-of-bound?)) +(begin (register-function-arity (quote shen.type-signature-of-cd) 3) (define (kl:shen.type-signature-of-cd V3268 V3269 V3270) (begin (kl:shen.incinfs) (kl:unify! V3268 (cons (quote string) (cons (quote -->) (cons (quote string) (quote ())))) V3269 V3270))) (export shen.type-signature-of-cd) (quote shen.type-signature-of-cd)) +(begin (register-function-arity (quote shen.type-signature-of-close) 3) (define (kl:shen.type-signature-of-close V3278 V3279 V3280) (let ((A (kl:shen.newpv V3279))) (let ((B (kl:shen.newpv V3279))) (begin (kl:shen.incinfs) (kl:unify! V3278 (cons (cons (quote stream) (cons A (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons B (quote ()))) (quote ())))) V3279 V3280))))) (export shen.type-signature-of-close) (quote shen.type-signature-of-close)) +(begin (register-function-arity (quote shen.type-signature-of-cn) 3) (define (kl:shen.type-signature-of-cn V3288 V3289 V3290) (begin (kl:shen.incinfs) (kl:unify! V3288 (cons (quote string) (cons (quote -->) (cons (cons (quote string) (cons (quote -->) (cons (quote string) (quote ())))) (quote ())))) V3289 V3290))) (export shen.type-signature-of-cn) (quote shen.type-signature-of-cn)) +(begin (register-function-arity (quote shen.type-signature-of-compile) 3) (define (kl:shen.type-signature-of-compile V3298 V3299 V3300) (let ((A (kl:shen.newpv V3299))) (let ((B (kl:shen.newpv V3299))) (begin (kl:shen.incinfs) (kl:unify! V3298 (cons (cons A (cons (quote shen.==>) (cons B (quote ())))) (cons (quote -->) (cons (cons A (cons (quote -->) (cons (cons (cons A (cons (quote -->) (cons B (quote ())))) (cons (quote -->) (cons B (quote ())))) (quote ())))) (quote ())))) V3299 V3300))))) (export shen.type-signature-of-compile) (quote shen.type-signature-of-compile)) +(begin (register-function-arity (quote shen.type-signature-of-cons?) 3) (define (kl:shen.type-signature-of-cons? V3308 V3309 V3310) (let ((A (kl:shen.newpv V3309))) (begin (kl:shen.incinfs) (kl:unify! V3308 (cons A (cons (quote -->) (cons (quote boolean) (quote ())))) V3309 V3310)))) (export shen.type-signature-of-cons?) (quote shen.type-signature-of-cons?)) +(begin (register-function-arity (quote shen.type-signature-of-destroy) 3) (define (kl:shen.type-signature-of-destroy V3318 V3319 V3320) (let ((A (kl:shen.newpv V3319))) (let ((B (kl:shen.newpv V3319))) (begin (kl:shen.incinfs) (kl:unify! V3318 (cons (cons A (cons (quote -->) (cons B (quote ())))) (cons (quote -->) (cons (quote symbol) (quote ())))) V3319 V3320))))) (export shen.type-signature-of-destroy) (quote shen.type-signature-of-destroy)) +(begin (register-function-arity (quote shen.type-signature-of-difference) 3) (define (kl:shen.type-signature-of-difference V3328 V3329 V3330) (let ((A (kl:shen.newpv V3329))) (begin (kl:shen.incinfs) (kl:unify! V3328 (cons (cons (quote list) (cons A (quote ()))) (cons (quote -->) (cons (cons (cons (quote list) (cons A (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons A (quote ()))) (quote ())))) (quote ())))) V3329 V3330)))) (export shen.type-signature-of-difference) (quote shen.type-signature-of-difference)) +(begin (register-function-arity (quote shen.type-signature-of-do) 3) (define (kl:shen.type-signature-of-do V3338 V3339 V3340) (let ((A (kl:shen.newpv V3339))) (let ((B (kl:shen.newpv V3339))) (begin (kl:shen.incinfs) (kl:unify! V3338 (cons A (cons (quote -->) (cons (cons B (cons (quote -->) (cons B (quote ())))) (quote ())))) V3339 V3340))))) (export shen.type-signature-of-do) (quote shen.type-signature-of-do)) +(begin (register-function-arity (quote shen.type-signature-of-) 3) (define (kl:shen.type-signature-of- V3348 V3349 V3350) (let ((A (kl:shen.newpv V3349))) (let ((B (kl:shen.newpv V3349))) (begin (kl:shen.incinfs) (kl:unify! V3348 (cons (cons (quote list) (cons A (quote ()))) (cons (quote shen.==>) (cons (cons (quote list) (cons B (quote ()))) (quote ())))) V3349 V3350))))) (export shen.type-signature-of-) (quote shen.type-signature-of-)) +(begin (register-function-arity (quote shen.type-signature-of-) 3) (define (kl:shen.type-signature-of- V3358 V3359 V3360) (let ((A (kl:shen.newpv V3359))) (begin (kl:shen.incinfs) (kl:unify! V3358 (cons (cons (quote list) (cons A (quote ()))) (cons (quote shen.==>) (cons (cons (quote list) (cons A (quote ()))) (quote ())))) V3359 V3360)))) (export shen.type-signature-of-) (quote shen.type-signature-of-)) +(begin (register-function-arity (quote shen.type-signature-of-element?) 3) (define (kl:shen.type-signature-of-element? V3368 V3369 V3370) (let ((A (kl:shen.newpv V3369))) (begin (kl:shen.incinfs) (kl:unify! V3368 (cons A (cons (quote -->) (cons (cons (cons (quote list) (cons A (quote ()))) (cons (quote -->) (cons (quote boolean) (quote ())))) (quote ())))) V3369 V3370)))) (export shen.type-signature-of-element?) (quote shen.type-signature-of-element?)) +(begin (register-function-arity (quote shen.type-signature-of-empty?) 3) (define (kl:shen.type-signature-of-empty? V3378 V3379 V3380) (let ((A (kl:shen.newpv V3379))) (begin (kl:shen.incinfs) (kl:unify! V3378 (cons A (cons (quote -->) (cons (quote boolean) (quote ())))) V3379 V3380)))) (export shen.type-signature-of-empty?) (quote shen.type-signature-of-empty?)) +(begin (register-function-arity (quote shen.type-signature-of-enable-type-theory) 3) (define (kl:shen.type-signature-of-enable-type-theory V3388 V3389 V3390) (begin (kl:shen.incinfs) (kl:unify! V3388 (cons (quote symbol) (cons (quote -->) (cons (quote boolean) (quote ())))) V3389 V3390))) (export shen.type-signature-of-enable-type-theory) (quote shen.type-signature-of-enable-type-theory)) +(begin (register-function-arity (quote shen.type-signature-of-external) 3) (define (kl:shen.type-signature-of-external V3398 V3399 V3400) (begin (kl:shen.incinfs) (kl:unify! V3398 (cons (quote symbol) (cons (quote -->) (cons (cons (quote list) (cons (quote symbol) (quote ()))) (quote ())))) V3399 V3400))) (export shen.type-signature-of-external) (quote shen.type-signature-of-external)) +(begin (register-function-arity (quote shen.type-signature-of-error-to-string) 3) (define (kl:shen.type-signature-of-error-to-string V3408 V3409 V3410) (begin (kl:shen.incinfs) (kl:unify! V3408 (cons (quote exception) (cons (quote -->) (cons (quote string) (quote ())))) V3409 V3410))) (export shen.type-signature-of-error-to-string) (quote shen.type-signature-of-error-to-string)) +(begin (register-function-arity (quote shen.type-signature-of-explode) 3) (define (kl:shen.type-signature-of-explode V3418 V3419 V3420) (let ((A (kl:shen.newpv V3419))) (begin (kl:shen.incinfs) (kl:unify! V3418 (cons A (cons (quote -->) (cons (cons (quote list) (cons (quote string) (quote ()))) (quote ())))) V3419 V3420)))) (export shen.type-signature-of-explode) (quote shen.type-signature-of-explode)) +(begin (register-function-arity (quote shen.type-signature-of-fail) 3) (define (kl:shen.type-signature-of-fail V3428 V3429 V3430) (begin (kl:shen.incinfs) (kl:unify! V3428 (cons (quote -->) (cons (quote symbol) (quote ()))) V3429 V3430))) (export shen.type-signature-of-fail) (quote shen.type-signature-of-fail)) +(begin (register-function-arity (quote shen.type-signature-of-fail-if) 3) (define (kl:shen.type-signature-of-fail-if V3438 V3439 V3440) (begin (kl:shen.incinfs) (kl:unify! V3438 (cons (cons (quote symbol) (cons (quote -->) (cons (quote boolean) (quote ())))) (cons (quote -->) (cons (cons (quote symbol) (cons (quote -->) (cons (quote symbol) (quote ())))) (quote ())))) V3439 V3440))) (export shen.type-signature-of-fail-if) (quote shen.type-signature-of-fail-if)) +(begin (register-function-arity (quote shen.type-signature-of-fix) 3) (define (kl:shen.type-signature-of-fix V3448 V3449 V3450) (let ((A (kl:shen.newpv V3449))) (begin (kl:shen.incinfs) (kl:unify! V3448 (cons (cons A (cons (quote -->) (cons A (quote ())))) (cons (quote -->) (cons (cons A (cons (quote -->) (cons A (quote ())))) (quote ())))) V3449 V3450)))) (export shen.type-signature-of-fix) (quote shen.type-signature-of-fix)) +(begin (register-function-arity (quote shen.type-signature-of-freeze) 3) (define (kl:shen.type-signature-of-freeze V3458 V3459 V3460) (let ((A (kl:shen.newpv V3459))) (begin (kl:shen.incinfs) (kl:unify! V3458 (cons A (cons (quote -->) (cons (cons (quote lazy) (cons A (quote ()))) (quote ())))) V3459 V3460)))) (export shen.type-signature-of-freeze) (quote shen.type-signature-of-freeze)) +(begin (register-function-arity (quote shen.type-signature-of-fst) 3) (define (kl:shen.type-signature-of-fst V3468 V3469 V3470) (let ((B (kl:shen.newpv V3469))) (let ((A (kl:shen.newpv V3469))) (begin (kl:shen.incinfs) (kl:unify! V3468 (cons (cons A (cons (quote *) (cons B (quote ())))) (cons (quote -->) (cons A (quote ())))) V3469 V3470))))) (export shen.type-signature-of-fst) (quote shen.type-signature-of-fst)) +(begin (register-function-arity (quote shen.type-signature-of-function) 3) (define (kl:shen.type-signature-of-function V3478 V3479 V3480) (let ((A (kl:shen.newpv V3479))) (let ((B (kl:shen.newpv V3479))) (begin (kl:shen.incinfs) (kl:unify! V3478 (cons (cons A (cons (quote -->) (cons B (quote ())))) (cons (quote -->) (cons (cons A (cons (quote -->) (cons B (quote ())))) (quote ())))) V3479 V3480))))) (export shen.type-signature-of-function) (quote shen.type-signature-of-function)) +(begin (register-function-arity (quote shen.type-signature-of-gensym) 3) (define (kl:shen.type-signature-of-gensym V3488 V3489 V3490) (begin (kl:shen.incinfs) (kl:unify! V3488 (cons (quote symbol) (cons (quote -->) (cons (quote symbol) (quote ())))) V3489 V3490))) (export shen.type-signature-of-gensym) (quote shen.type-signature-of-gensym)) +(begin (register-function-arity (quote shen.type-signature-of-<-vector) 3) (define (kl:shen.type-signature-of-<-vector V3498 V3499 V3500) (let ((A (kl:shen.newpv V3499))) (begin (kl:shen.incinfs) (kl:unify! V3498 (cons (cons (quote vector) (cons A (quote ()))) (cons (quote -->) (cons (cons (quote number) (cons (quote -->) (cons A (quote ())))) (quote ())))) V3499 V3500)))) (export shen.type-signature-of-<-vector) (quote shen.type-signature-of-<-vector)) +(begin (register-function-arity (quote shen.type-signature-of-vector->) 3) (define (kl:shen.type-signature-of-vector-> V3508 V3509 V3510) (let ((A (kl:shen.newpv V3509))) (begin (kl:shen.incinfs) (kl:unify! V3508 (cons (cons (quote vector) (cons A (quote ()))) (cons (quote -->) (cons (cons (quote number) (cons (quote -->) (cons (cons A (cons (quote -->) (cons (cons (quote vector) (cons A (quote ()))) (quote ())))) (quote ())))) (quote ())))) V3509 V3510)))) (export shen.type-signature-of-vector->) (quote shen.type-signature-of-vector->)) +(begin (register-function-arity (quote shen.type-signature-of-vector) 3) (define (kl:shen.type-signature-of-vector V3518 V3519 V3520) (let ((A (kl:shen.newpv V3519))) (begin (kl:shen.incinfs) (kl:unify! V3518 (cons (quote number) (cons (quote -->) (cons (cons (quote vector) (cons A (quote ()))) (quote ())))) V3519 V3520)))) (export shen.type-signature-of-vector) (quote shen.type-signature-of-vector)) +(begin (register-function-arity (quote shen.type-signature-of-get-time) 3) (define (kl:shen.type-signature-of-get-time V3528 V3529 V3530) (begin (kl:shen.incinfs) (kl:unify! V3528 (cons (quote symbol) (cons (quote -->) (cons (quote number) (quote ())))) V3529 V3530))) (export shen.type-signature-of-get-time) (quote shen.type-signature-of-get-time)) +(begin (register-function-arity (quote shen.type-signature-of-hash) 3) (define (kl:shen.type-signature-of-hash V3538 V3539 V3540) (let ((A (kl:shen.newpv V3539))) (begin (kl:shen.incinfs) (kl:unify! V3538 (cons A (cons (quote -->) (cons (cons (quote number) (cons (quote -->) (cons (quote number) (quote ())))) (quote ())))) V3539 V3540)))) (export shen.type-signature-of-hash) (quote shen.type-signature-of-hash)) +(begin (register-function-arity (quote shen.type-signature-of-head) 3) (define (kl:shen.type-signature-of-head V3548 V3549 V3550) (let ((A (kl:shen.newpv V3549))) (begin (kl:shen.incinfs) (kl:unify! V3548 (cons (cons (quote list) (cons A (quote ()))) (cons (quote -->) (cons A (quote ())))) V3549 V3550)))) (export shen.type-signature-of-head) (quote shen.type-signature-of-head)) +(begin (register-function-arity (quote shen.type-signature-of-hdv) 3) (define (kl:shen.type-signature-of-hdv V3558 V3559 V3560) (let ((A (kl:shen.newpv V3559))) (begin (kl:shen.incinfs) (kl:unify! V3558 (cons (cons (quote vector) (cons A (quote ()))) (cons (quote -->) (cons A (quote ())))) V3559 V3560)))) (export shen.type-signature-of-hdv) (quote shen.type-signature-of-hdv)) +(begin (register-function-arity (quote shen.type-signature-of-hdstr) 3) (define (kl:shen.type-signature-of-hdstr V3568 V3569 V3570) (begin (kl:shen.incinfs) (kl:unify! V3568 (cons (quote string) (cons (quote -->) (cons (quote string) (quote ())))) V3569 V3570))) (export shen.type-signature-of-hdstr) (quote shen.type-signature-of-hdstr)) +(begin (register-function-arity (quote shen.type-signature-of-if) 3) (define (kl:shen.type-signature-of-if V3578 V3579 V3580) (let ((A (kl:shen.newpv V3579))) (begin (kl:shen.incinfs) (kl:unify! V3578 (cons (quote boolean) (cons (quote -->) (cons (cons A (cons (quote -->) (cons (cons A (cons (quote -->) (cons A (quote ())))) (quote ())))) (quote ())))) V3579 V3580)))) (export shen.type-signature-of-if) (quote shen.type-signature-of-if)) +(begin (register-function-arity (quote shen.type-signature-of-it) 3) (define (kl:shen.type-signature-of-it V3588 V3589 V3590) (begin (kl:shen.incinfs) (kl:unify! V3588 (cons (quote -->) (cons (quote string) (quote ()))) V3589 V3590))) (export shen.type-signature-of-it) (quote shen.type-signature-of-it)) +(begin (register-function-arity (quote shen.type-signature-of-implementation) 3) (define (kl:shen.type-signature-of-implementation V3598 V3599 V3600) (begin (kl:shen.incinfs) (kl:unify! V3598 (cons (quote -->) (cons (quote string) (quote ()))) V3599 V3600))) (export shen.type-signature-of-implementation) (quote shen.type-signature-of-implementation)) +(begin (register-function-arity (quote shen.type-signature-of-include) 3) (define (kl:shen.type-signature-of-include V3608 V3609 V3610) (begin (kl:shen.incinfs) (kl:unify! V3608 (cons (cons (quote list) (cons (quote symbol) (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons (quote symbol) (quote ()))) (quote ())))) V3609 V3610))) (export shen.type-signature-of-include) (quote shen.type-signature-of-include)) +(begin (register-function-arity (quote shen.type-signature-of-include-all-but) 3) (define (kl:shen.type-signature-of-include-all-but V3618 V3619 V3620) (begin (kl:shen.incinfs) (kl:unify! V3618 (cons (cons (quote list) (cons (quote symbol) (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons (quote symbol) (quote ()))) (quote ())))) V3619 V3620))) (export shen.type-signature-of-include-all-but) (quote shen.type-signature-of-include-all-but)) +(begin (register-function-arity (quote shen.type-signature-of-inferences) 3) (define (kl:shen.type-signature-of-inferences V3628 V3629 V3630) (begin (kl:shen.incinfs) (kl:unify! V3628 (cons (quote -->) (cons (quote number) (quote ()))) V3629 V3630))) (export shen.type-signature-of-inferences) (quote shen.type-signature-of-inferences)) +(begin (register-function-arity (quote shen.type-signature-of-shen.insert) 3) (define (kl:shen.type-signature-of-shen.insert V3638 V3639 V3640) (let ((A (kl:shen.newpv V3639))) (begin (kl:shen.incinfs) (kl:unify! V3638 (cons A (cons (quote -->) (cons (cons (quote string) (cons (quote -->) (cons (quote string) (quote ())))) (quote ())))) V3639 V3640)))) (export shen.type-signature-of-shen.insert) (quote shen.type-signature-of-shen.insert)) +(begin (register-function-arity (quote shen.type-signature-of-integer?) 3) (define (kl:shen.type-signature-of-integer? V3648 V3649 V3650) (let ((A (kl:shen.newpv V3649))) (begin (kl:shen.incinfs) (kl:unify! V3648 (cons A (cons (quote -->) (cons (quote boolean) (quote ())))) V3649 V3650)))) (export shen.type-signature-of-integer?) (quote shen.type-signature-of-integer?)) +(begin (register-function-arity (quote shen.type-signature-of-internal) 3) (define (kl:shen.type-signature-of-internal V3658 V3659 V3660) (begin (kl:shen.incinfs) (kl:unify! V3658 (cons (quote symbol) (cons (quote -->) (cons (cons (quote list) (cons (quote symbol) (quote ()))) (quote ())))) V3659 V3660))) (export shen.type-signature-of-internal) (quote shen.type-signature-of-internal)) +(begin (register-function-arity (quote shen.type-signature-of-intersection) 3) (define (kl:shen.type-signature-of-intersection V3668 V3669 V3670) (let ((A (kl:shen.newpv V3669))) (begin (kl:shen.incinfs) (kl:unify! V3668 (cons (cons (quote list) (cons A (quote ()))) (cons (quote -->) (cons (cons (cons (quote list) (cons A (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons A (quote ()))) (quote ())))) (quote ())))) V3669 V3670)))) (export shen.type-signature-of-intersection) (quote shen.type-signature-of-intersection)) +(begin (register-function-arity (quote shen.type-signature-of-kill) 3) (define (kl:shen.type-signature-of-kill V3678 V3679 V3680) (let ((A (kl:shen.newpv V3679))) (begin (kl:shen.incinfs) (kl:unify! V3678 (cons (quote -->) (cons A (quote ()))) V3679 V3680)))) (export shen.type-signature-of-kill) (quote shen.type-signature-of-kill)) +(begin (register-function-arity (quote shen.type-signature-of-language) 3) (define (kl:shen.type-signature-of-language V3688 V3689 V3690) (begin (kl:shen.incinfs) (kl:unify! V3688 (cons (quote -->) (cons (quote string) (quote ()))) V3689 V3690))) (export shen.type-signature-of-language) (quote shen.type-signature-of-language)) +(begin (register-function-arity (quote shen.type-signature-of-length) 3) (define (kl:shen.type-signature-of-length V3698 V3699 V3700) (let ((A (kl:shen.newpv V3699))) (begin (kl:shen.incinfs) (kl:unify! V3698 (cons (cons (quote list) (cons A (quote ()))) (cons (quote -->) (cons (quote number) (quote ())))) V3699 V3700)))) (export shen.type-signature-of-length) (quote shen.type-signature-of-length)) +(begin (register-function-arity (quote shen.type-signature-of-limit) 3) (define (kl:shen.type-signature-of-limit V3708 V3709 V3710) (let ((A (kl:shen.newpv V3709))) (begin (kl:shen.incinfs) (kl:unify! V3708 (cons (cons (quote vector) (cons A (quote ()))) (cons (quote -->) (cons (quote number) (quote ())))) V3709 V3710)))) (export shen.type-signature-of-limit) (quote shen.type-signature-of-limit)) +(begin (register-function-arity (quote shen.type-signature-of-load) 3) (define (kl:shen.type-signature-of-load V3718 V3719 V3720) (begin (kl:shen.incinfs) (kl:unify! V3718 (cons (quote string) (cons (quote -->) (cons (quote symbol) (quote ())))) V3719 V3720))) (export shen.type-signature-of-load) (quote shen.type-signature-of-load)) +(begin (register-function-arity (quote shen.type-signature-of-map) 3) (define (kl:shen.type-signature-of-map V3728 V3729 V3730) (let ((A (kl:shen.newpv V3729))) (let ((B (kl:shen.newpv V3729))) (begin (kl:shen.incinfs) (kl:unify! V3728 (cons (cons A (cons (quote -->) (cons B (quote ())))) (cons (quote -->) (cons (cons (cons (quote list) (cons A (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons B (quote ()))) (quote ())))) (quote ())))) V3729 V3730))))) (export shen.type-signature-of-map) (quote shen.type-signature-of-map)) +(begin (register-function-arity (quote shen.type-signature-of-mapcan) 3) (define (kl:shen.type-signature-of-mapcan V3738 V3739 V3740) (let ((A (kl:shen.newpv V3739))) (let ((B (kl:shen.newpv V3739))) (begin (kl:shen.incinfs) (kl:unify! V3738 (cons (cons A (cons (quote -->) (cons (cons (quote list) (cons B (quote ()))) (quote ())))) (cons (quote -->) (cons (cons (cons (quote list) (cons A (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons B (quote ()))) (quote ())))) (quote ())))) V3739 V3740))))) (export shen.type-signature-of-mapcan) (quote shen.type-signature-of-mapcan)) +(begin (register-function-arity (quote shen.type-signature-of-maxinferences) 3) (define (kl:shen.type-signature-of-maxinferences V3748 V3749 V3750) (begin (kl:shen.incinfs) (kl:unify! V3748 (cons (quote number) (cons (quote -->) (cons (quote number) (quote ())))) V3749 V3750))) (export shen.type-signature-of-maxinferences) (quote shen.type-signature-of-maxinferences)) +(begin (register-function-arity (quote shen.type-signature-of-n->string) 3) (define (kl:shen.type-signature-of-n->string V3758 V3759 V3760) (begin (kl:shen.incinfs) (kl:unify! V3758 (cons (quote number) (cons (quote -->) (cons (quote string) (quote ())))) V3759 V3760))) (export shen.type-signature-of-n->string) (quote shen.type-signature-of-n->string)) +(begin (register-function-arity (quote shen.type-signature-of-nl) 3) (define (kl:shen.type-signature-of-nl V3768 V3769 V3770) (begin (kl:shen.incinfs) (kl:unify! V3768 (cons (quote number) (cons (quote -->) (cons (quote number) (quote ())))) V3769 V3770))) (export shen.type-signature-of-nl) (quote shen.type-signature-of-nl)) +(begin (register-function-arity (quote shen.type-signature-of-not) 3) (define (kl:shen.type-signature-of-not V3778 V3779 V3780) (begin (kl:shen.incinfs) (kl:unify! V3778 (cons (quote boolean) (cons (quote -->) (cons (quote boolean) (quote ())))) V3779 V3780))) (export shen.type-signature-of-not) (quote shen.type-signature-of-not)) +(begin (register-function-arity (quote shen.type-signature-of-nth) 3) (define (kl:shen.type-signature-of-nth V3788 V3789 V3790) (let ((A (kl:shen.newpv V3789))) (begin (kl:shen.incinfs) (kl:unify! V3788 (cons (quote number) (cons (quote -->) (cons (cons (cons (quote list) (cons A (quote ()))) (cons (quote -->) (cons A (quote ())))) (quote ())))) V3789 V3790)))) (export shen.type-signature-of-nth) (quote shen.type-signature-of-nth)) +(begin (register-function-arity (quote shen.type-signature-of-number?) 3) (define (kl:shen.type-signature-of-number? V3798 V3799 V3800) (let ((A (kl:shen.newpv V3799))) (begin (kl:shen.incinfs) (kl:unify! V3798 (cons A (cons (quote -->) (cons (quote boolean) (quote ())))) V3799 V3800)))) (export shen.type-signature-of-number?) (quote shen.type-signature-of-number?)) +(begin (register-function-arity (quote shen.type-signature-of-occurrences) 3) (define (kl:shen.type-signature-of-occurrences V3808 V3809 V3810) (let ((A (kl:shen.newpv V3809))) (let ((B (kl:shen.newpv V3809))) (begin (kl:shen.incinfs) (kl:unify! V3808 (cons A (cons (quote -->) (cons (cons B (cons (quote -->) (cons (quote number) (quote ())))) (quote ())))) V3809 V3810))))) (export shen.type-signature-of-occurrences) (quote shen.type-signature-of-occurrences)) +(begin (register-function-arity (quote shen.type-signature-of-occurs-check) 3) (define (kl:shen.type-signature-of-occurs-check V3818 V3819 V3820) (begin (kl:shen.incinfs) (kl:unify! V3818 (cons (quote symbol) (cons (quote -->) (cons (quote boolean) (quote ())))) V3819 V3820))) (export shen.type-signature-of-occurs-check) (quote shen.type-signature-of-occurs-check)) +(begin (register-function-arity (quote shen.type-signature-of-optimise) 3) (define (kl:shen.type-signature-of-optimise V3828 V3829 V3830) (begin (kl:shen.incinfs) (kl:unify! V3828 (cons (quote symbol) (cons (quote -->) (cons (quote boolean) (quote ())))) V3829 V3830))) (export shen.type-signature-of-optimise) (quote shen.type-signature-of-optimise)) +(begin (register-function-arity (quote shen.type-signature-of-or) 3) (define (kl:shen.type-signature-of-or V3838 V3839 V3840) (begin (kl:shen.incinfs) (kl:unify! V3838 (cons (quote boolean) (cons (quote -->) (cons (cons (quote boolean) (cons (quote -->) (cons (quote boolean) (quote ())))) (quote ())))) V3839 V3840))) (export shen.type-signature-of-or) (quote shen.type-signature-of-or)) +(begin (register-function-arity (quote shen.type-signature-of-os) 3) (define (kl:shen.type-signature-of-os V3848 V3849 V3850) (begin (kl:shen.incinfs) (kl:unify! V3848 (cons (quote -->) (cons (quote string) (quote ()))) V3849 V3850))) (export shen.type-signature-of-os) (quote shen.type-signature-of-os)) +(begin (register-function-arity (quote shen.type-signature-of-package?) 3) (define (kl:shen.type-signature-of-package? V3858 V3859 V3860) (begin (kl:shen.incinfs) (kl:unify! V3858 (cons (quote symbol) (cons (quote -->) (cons (quote boolean) (quote ())))) V3859 V3860))) (export shen.type-signature-of-package?) (quote shen.type-signature-of-package?)) +(begin (register-function-arity (quote shen.type-signature-of-port) 3) (define (kl:shen.type-signature-of-port V3868 V3869 V3870) (begin (kl:shen.incinfs) (kl:unify! V3868 (cons (quote -->) (cons (quote string) (quote ()))) V3869 V3870))) (export shen.type-signature-of-port) (quote shen.type-signature-of-port)) +(begin (register-function-arity (quote shen.type-signature-of-porters) 3) (define (kl:shen.type-signature-of-porters V3878 V3879 V3880) (begin (kl:shen.incinfs) (kl:unify! V3878 (cons (quote -->) (cons (quote string) (quote ()))) V3879 V3880))) (export shen.type-signature-of-porters) (quote shen.type-signature-of-porters)) +(begin (register-function-arity (quote shen.type-signature-of-pos) 3) (define (kl:shen.type-signature-of-pos V3888 V3889 V3890) (begin (kl:shen.incinfs) (kl:unify! V3888 (cons (quote string) (cons (quote -->) (cons (cons (quote number) (cons (quote -->) (cons (quote string) (quote ())))) (quote ())))) V3889 V3890))) (export shen.type-signature-of-pos) (quote shen.type-signature-of-pos)) +(begin (register-function-arity (quote shen.type-signature-of-pr) 3) (define (kl:shen.type-signature-of-pr V3898 V3899 V3900) (begin (kl:shen.incinfs) (kl:unify! V3898 (cons (quote string) (cons (quote -->) (cons (cons (cons (quote stream) (cons (quote out) (quote ()))) (cons (quote -->) (cons (quote string) (quote ())))) (quote ())))) V3899 V3900))) (export shen.type-signature-of-pr) (quote shen.type-signature-of-pr)) +(begin (register-function-arity (quote shen.type-signature-of-print) 3) (define (kl:shen.type-signature-of-print V3908 V3909 V3910) (let ((A (kl:shen.newpv V3909))) (begin (kl:shen.incinfs) (kl:unify! V3908 (cons A (cons (quote -->) (cons A (quote ())))) V3909 V3910)))) (export shen.type-signature-of-print) (quote shen.type-signature-of-print)) +(begin (register-function-arity (quote shen.type-signature-of-profile) 3) (define (kl:shen.type-signature-of-profile V3918 V3919 V3920) (let ((A (kl:shen.newpv V3919))) (let ((B (kl:shen.newpv V3919))) (begin (kl:shen.incinfs) (kl:unify! V3918 (cons (cons A (cons (quote -->) (cons B (quote ())))) (cons (quote -->) (cons (cons A (cons (quote -->) (cons B (quote ())))) (quote ())))) V3919 V3920))))) (export shen.type-signature-of-profile) (quote shen.type-signature-of-profile)) +(begin (register-function-arity (quote shen.type-signature-of-preclude) 3) (define (kl:shen.type-signature-of-preclude V3928 V3929 V3930) (begin (kl:shen.incinfs) (kl:unify! V3928 (cons (cons (quote list) (cons (quote symbol) (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons (quote symbol) (quote ()))) (quote ())))) V3929 V3930))) (export shen.type-signature-of-preclude) (quote shen.type-signature-of-preclude)) +(begin (register-function-arity (quote shen.type-signature-of-shen.proc-nl) 3) (define (kl:shen.type-signature-of-shen.proc-nl V3938 V3939 V3940) (begin (kl:shen.incinfs) (kl:unify! V3938 (cons (quote string) (cons (quote -->) (cons (quote string) (quote ())))) V3939 V3940))) (export shen.type-signature-of-shen.proc-nl) (quote shen.type-signature-of-shen.proc-nl)) +(begin (register-function-arity (quote shen.type-signature-of-profile-results) 3) (define (kl:shen.type-signature-of-profile-results V3948 V3949 V3950) (let ((A (kl:shen.newpv V3949))) (let ((B (kl:shen.newpv V3949))) (begin (kl:shen.incinfs) (kl:unify! V3948 (cons (cons A (cons (quote -->) (cons B (quote ())))) (cons (quote -->) (cons (cons (cons A (cons (quote -->) (cons B (quote ())))) (cons (quote *) (cons (quote number) (quote ())))) (quote ())))) V3949 V3950))))) (export shen.type-signature-of-profile-results) (quote shen.type-signature-of-profile-results)) +(begin (register-function-arity (quote shen.type-signature-of-protect) 3) (define (kl:shen.type-signature-of-protect V3958 V3959 V3960) (begin (kl:shen.incinfs) (kl:unify! V3958 (cons (quote symbol) (cons (quote -->) (cons (quote symbol) (quote ())))) V3959 V3960))) (export shen.type-signature-of-protect) (quote shen.type-signature-of-protect)) +(begin (register-function-arity (quote shen.type-signature-of-preclude-all-but) 3) (define (kl:shen.type-signature-of-preclude-all-but V3968 V3969 V3970) (begin (kl:shen.incinfs) (kl:unify! V3968 (cons (cons (quote list) (cons (quote symbol) (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons (quote symbol) (quote ()))) (quote ())))) V3969 V3970))) (export shen.type-signature-of-preclude-all-but) (quote shen.type-signature-of-preclude-all-but)) +(begin (register-function-arity (quote shen.type-signature-of-shen.prhush) 3) (define (kl:shen.type-signature-of-shen.prhush V3978 V3979 V3980) (begin (kl:shen.incinfs) (kl:unify! V3978 (cons (quote string) (cons (quote -->) (cons (cons (cons (quote stream) (cons (quote out) (quote ()))) (cons (quote -->) (cons (quote string) (quote ())))) (quote ())))) V3979 V3980))) (export shen.type-signature-of-shen.prhush) (quote shen.type-signature-of-shen.prhush)) +(begin (register-function-arity (quote shen.type-signature-of-ps) 3) (define (kl:shen.type-signature-of-ps V3988 V3989 V3990) (begin (kl:shen.incinfs) (kl:unify! V3988 (cons (quote symbol) (cons (quote -->) (cons (cons (quote list) (cons (quote unit) (quote ()))) (quote ())))) V3989 V3990))) (export shen.type-signature-of-ps) (quote shen.type-signature-of-ps)) +(begin (register-function-arity (quote shen.type-signature-of-read) 3) (define (kl:shen.type-signature-of-read V3998 V3999 V4000) (begin (kl:shen.incinfs) (kl:unify! V3998 (cons (cons (quote stream) (cons (quote in) (quote ()))) (cons (quote -->) (cons (quote unit) (quote ())))) V3999 V4000))) (export shen.type-signature-of-read) (quote shen.type-signature-of-read)) +(begin (register-function-arity (quote shen.type-signature-of-read-byte) 3) (define (kl:shen.type-signature-of-read-byte V4008 V4009 V4010) (begin (kl:shen.incinfs) (kl:unify! V4008 (cons (cons (quote stream) (cons (quote in) (quote ()))) (cons (quote -->) (cons (quote number) (quote ())))) V4009 V4010))) (export shen.type-signature-of-read-byte) (quote shen.type-signature-of-read-byte)) +(begin (register-function-arity (quote shen.type-signature-of-read-file-as-bytelist) 3) (define (kl:shen.type-signature-of-read-file-as-bytelist V4018 V4019 V4020) (begin (kl:shen.incinfs) (kl:unify! V4018 (cons (quote string) (cons (quote -->) (cons (cons (quote list) (cons (quote number) (quote ()))) (quote ())))) V4019 V4020))) (export shen.type-signature-of-read-file-as-bytelist) (quote shen.type-signature-of-read-file-as-bytelist)) +(begin (register-function-arity (quote shen.type-signature-of-read-file-as-string) 3) (define (kl:shen.type-signature-of-read-file-as-string V4028 V4029 V4030) (begin (kl:shen.incinfs) (kl:unify! V4028 (cons (quote string) (cons (quote -->) (cons (quote string) (quote ())))) V4029 V4030))) (export shen.type-signature-of-read-file-as-string) (quote shen.type-signature-of-read-file-as-string)) +(begin (register-function-arity (quote shen.type-signature-of-read-file) 3) (define (kl:shen.type-signature-of-read-file V4038 V4039 V4040) (begin (kl:shen.incinfs) (kl:unify! V4038 (cons (quote string) (cons (quote -->) (cons (cons (quote list) (cons (quote unit) (quote ()))) (quote ())))) V4039 V4040))) (export shen.type-signature-of-read-file) (quote shen.type-signature-of-read-file)) +(begin (register-function-arity (quote shen.type-signature-of-read-from-string) 3) (define (kl:shen.type-signature-of-read-from-string V4048 V4049 V4050) (begin (kl:shen.incinfs) (kl:unify! V4048 (cons (quote string) (cons (quote -->) (cons (cons (quote list) (cons (quote unit) (quote ()))) (quote ())))) V4049 V4050))) (export shen.type-signature-of-read-from-string) (quote shen.type-signature-of-read-from-string)) +(begin (register-function-arity (quote shen.type-signature-of-release) 3) (define (kl:shen.type-signature-of-release V4058 V4059 V4060) (begin (kl:shen.incinfs) (kl:unify! V4058 (cons (quote -->) (cons (quote string) (quote ()))) V4059 V4060))) (export shen.type-signature-of-release) (quote shen.type-signature-of-release)) +(begin (register-function-arity (quote shen.type-signature-of-remove) 3) (define (kl:shen.type-signature-of-remove V4068 V4069 V4070) (let ((A (kl:shen.newpv V4069))) (begin (kl:shen.incinfs) (kl:unify! V4068 (cons A (cons (quote -->) (cons (cons (cons (quote list) (cons A (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons A (quote ()))) (quote ())))) (quote ())))) V4069 V4070)))) (export shen.type-signature-of-remove) (quote shen.type-signature-of-remove)) +(begin (register-function-arity (quote shen.type-signature-of-reverse) 3) (define (kl:shen.type-signature-of-reverse V4078 V4079 V4080) (let ((A (kl:shen.newpv V4079))) (begin (kl:shen.incinfs) (kl:unify! V4078 (cons (cons (quote list) (cons A (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons A (quote ()))) (quote ())))) V4079 V4080)))) (export shen.type-signature-of-reverse) (quote shen.type-signature-of-reverse)) +(begin (register-function-arity (quote shen.type-signature-of-simple-error) 3) (define (kl:shen.type-signature-of-simple-error V4088 V4089 V4090) (let ((A (kl:shen.newpv V4089))) (begin (kl:shen.incinfs) (kl:unify! V4088 (cons (quote string) (cons (quote -->) (cons A (quote ())))) V4089 V4090)))) (export shen.type-signature-of-simple-error) (quote shen.type-signature-of-simple-error)) +(begin (register-function-arity (quote shen.type-signature-of-snd) 3) (define (kl:shen.type-signature-of-snd V4098 V4099 V4100) (let ((A (kl:shen.newpv V4099))) (let ((B (kl:shen.newpv V4099))) (begin (kl:shen.incinfs) (kl:unify! V4098 (cons (cons A (cons (quote *) (cons B (quote ())))) (cons (quote -->) (cons B (quote ())))) V4099 V4100))))) (export shen.type-signature-of-snd) (quote shen.type-signature-of-snd)) +(begin (register-function-arity (quote shen.type-signature-of-specialise) 3) (define (kl:shen.type-signature-of-specialise V4108 V4109 V4110) (begin (kl:shen.incinfs) (kl:unify! V4108 (cons (quote symbol) (cons (quote -->) (cons (quote symbol) (quote ())))) V4109 V4110))) (export shen.type-signature-of-specialise) (quote shen.type-signature-of-specialise)) +(begin (register-function-arity (quote shen.type-signature-of-spy) 3) (define (kl:shen.type-signature-of-spy V4118 V4119 V4120) (begin (kl:shen.incinfs) (kl:unify! V4118 (cons (quote symbol) (cons (quote -->) (cons (quote boolean) (quote ())))) V4119 V4120))) (export shen.type-signature-of-spy) (quote shen.type-signature-of-spy)) +(begin (register-function-arity (quote shen.type-signature-of-step) 3) (define (kl:shen.type-signature-of-step V4128 V4129 V4130) (begin (kl:shen.incinfs) (kl:unify! V4128 (cons (quote symbol) (cons (quote -->) (cons (quote boolean) (quote ())))) V4129 V4130))) (export shen.type-signature-of-step) (quote shen.type-signature-of-step)) +(begin (register-function-arity (quote shen.type-signature-of-stinput) 3) (define (kl:shen.type-signature-of-stinput V4138 V4139 V4140) (begin (kl:shen.incinfs) (kl:unify! V4138 (cons (quote -->) (cons (cons (quote stream) (cons (quote in) (quote ()))) (quote ()))) V4139 V4140))) (export shen.type-signature-of-stinput) (quote shen.type-signature-of-stinput)) +(begin (register-function-arity (quote shen.type-signature-of-sterror) 3) (define (kl:shen.type-signature-of-sterror V4148 V4149 V4150) (begin (kl:shen.incinfs) (kl:unify! V4148 (cons (quote -->) (cons (cons (quote stream) (cons (quote out) (quote ()))) (quote ()))) V4149 V4150))) (export shen.type-signature-of-sterror) (quote shen.type-signature-of-sterror)) +(begin (register-function-arity (quote shen.type-signature-of-stoutput) 3) (define (kl:shen.type-signature-of-stoutput V4158 V4159 V4160) (begin (kl:shen.incinfs) (kl:unify! V4158 (cons (quote -->) (cons (cons (quote stream) (cons (quote out) (quote ()))) (quote ()))) V4159 V4160))) (export shen.type-signature-of-stoutput) (quote shen.type-signature-of-stoutput)) +(begin (register-function-arity (quote shen.type-signature-of-string?) 3) (define (kl:shen.type-signature-of-string? V4168 V4169 V4170) (let ((A (kl:shen.newpv V4169))) (begin (kl:shen.incinfs) (kl:unify! V4168 (cons A (cons (quote -->) (cons (quote boolean) (quote ())))) V4169 V4170)))) (export shen.type-signature-of-string?) (quote shen.type-signature-of-string?)) +(begin (register-function-arity (quote shen.type-signature-of-str) 3) (define (kl:shen.type-signature-of-str V4178 V4179 V4180) (let ((A (kl:shen.newpv V4179))) (begin (kl:shen.incinfs) (kl:unify! V4178 (cons A (cons (quote -->) (cons (quote string) (quote ())))) V4179 V4180)))) (export shen.type-signature-of-str) (quote shen.type-signature-of-str)) +(begin (register-function-arity (quote shen.type-signature-of-string->n) 3) (define (kl:shen.type-signature-of-string->n V4188 V4189 V4190) (begin (kl:shen.incinfs) (kl:unify! V4188 (cons (quote string) (cons (quote -->) (cons (quote number) (quote ())))) V4189 V4190))) (export shen.type-signature-of-string->n) (quote shen.type-signature-of-string->n)) +(begin (register-function-arity (quote shen.type-signature-of-string->symbol) 3) (define (kl:shen.type-signature-of-string->symbol V4198 V4199 V4200) (begin (kl:shen.incinfs) (kl:unify! V4198 (cons (quote string) (cons (quote -->) (cons (quote symbol) (quote ())))) V4199 V4200))) (export shen.type-signature-of-string->symbol) (quote shen.type-signature-of-string->symbol)) +(begin (register-function-arity (quote shen.type-signature-of-sum) 3) (define (kl:shen.type-signature-of-sum V4208 V4209 V4210) (begin (kl:shen.incinfs) (kl:unify! V4208 (cons (cons (quote list) (cons (quote number) (quote ()))) (cons (quote -->) (cons (quote number) (quote ())))) V4209 V4210))) (export shen.type-signature-of-sum) (quote shen.type-signature-of-sum)) +(begin (register-function-arity (quote shen.type-signature-of-symbol?) 3) (define (kl:shen.type-signature-of-symbol? V4218 V4219 V4220) (let ((A (kl:shen.newpv V4219))) (begin (kl:shen.incinfs) (kl:unify! V4218 (cons A (cons (quote -->) (cons (quote boolean) (quote ())))) V4219 V4220)))) (export shen.type-signature-of-symbol?) (quote shen.type-signature-of-symbol?)) +(begin (register-function-arity (quote shen.type-signature-of-systemf) 3) (define (kl:shen.type-signature-of-systemf V4228 V4229 V4230) (begin (kl:shen.incinfs) (kl:unify! V4228 (cons (quote symbol) (cons (quote -->) (cons (quote symbol) (quote ())))) V4229 V4230))) (export shen.type-signature-of-systemf) (quote shen.type-signature-of-systemf)) +(begin (register-function-arity (quote shen.type-signature-of-tail) 3) (define (kl:shen.type-signature-of-tail V4238 V4239 V4240) (let ((A (kl:shen.newpv V4239))) (begin (kl:shen.incinfs) (kl:unify! V4238 (cons (cons (quote list) (cons A (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons A (quote ()))) (quote ())))) V4239 V4240)))) (export shen.type-signature-of-tail) (quote shen.type-signature-of-tail)) +(begin (register-function-arity (quote shen.type-signature-of-tlstr) 3) (define (kl:shen.type-signature-of-tlstr V4248 V4249 V4250) (begin (kl:shen.incinfs) (kl:unify! V4248 (cons (quote string) (cons (quote -->) (cons (quote string) (quote ())))) V4249 V4250))) (export shen.type-signature-of-tlstr) (quote shen.type-signature-of-tlstr)) +(begin (register-function-arity (quote shen.type-signature-of-tlv) 3) (define (kl:shen.type-signature-of-tlv V4258 V4259 V4260) (let ((A (kl:shen.newpv V4259))) (begin (kl:shen.incinfs) (kl:unify! V4258 (cons (cons (quote vector) (cons A (quote ()))) (cons (quote -->) (cons (cons (quote vector) (cons A (quote ()))) (quote ())))) V4259 V4260)))) (export shen.type-signature-of-tlv) (quote shen.type-signature-of-tlv)) +(begin (register-function-arity (quote shen.type-signature-of-tc) 3) (define (kl:shen.type-signature-of-tc V4268 V4269 V4270) (begin (kl:shen.incinfs) (kl:unify! V4268 (cons (quote symbol) (cons (quote -->) (cons (quote boolean) (quote ())))) V4269 V4270))) (export shen.type-signature-of-tc) (quote shen.type-signature-of-tc)) +(begin (register-function-arity (quote shen.type-signature-of-tc?) 3) (define (kl:shen.type-signature-of-tc? V4278 V4279 V4280) (begin (kl:shen.incinfs) (kl:unify! V4278 (cons (quote -->) (cons (quote boolean) (quote ()))) V4279 V4280))) (export shen.type-signature-of-tc?) (quote shen.type-signature-of-tc?)) +(begin (register-function-arity (quote shen.type-signature-of-thaw) 3) (define (kl:shen.type-signature-of-thaw V4288 V4289 V4290) (let ((A (kl:shen.newpv V4289))) (begin (kl:shen.incinfs) (kl:unify! V4288 (cons (cons (quote lazy) (cons A (quote ()))) (cons (quote -->) (cons A (quote ())))) V4289 V4290)))) (export shen.type-signature-of-thaw) (quote shen.type-signature-of-thaw)) +(begin (register-function-arity (quote shen.type-signature-of-track) 3) (define (kl:shen.type-signature-of-track V4298 V4299 V4300) (begin (kl:shen.incinfs) (kl:unify! V4298 (cons (quote symbol) (cons (quote -->) (cons (quote symbol) (quote ())))) V4299 V4300))) (export shen.type-signature-of-track) (quote shen.type-signature-of-track)) +(begin (register-function-arity (quote shen.type-signature-of-trap-error) 3) (define (kl:shen.type-signature-of-trap-error V4308 V4309 V4310) (let ((A (kl:shen.newpv V4309))) (begin (kl:shen.incinfs) (kl:unify! V4308 (cons A (cons (quote -->) (cons (cons (cons (quote exception) (cons (quote -->) (cons A (quote ())))) (cons (quote -->) (cons A (quote ())))) (quote ())))) V4309 V4310)))) (export shen.type-signature-of-trap-error) (quote shen.type-signature-of-trap-error)) +(begin (register-function-arity (quote shen.type-signature-of-tuple?) 3) (define (kl:shen.type-signature-of-tuple? V4318 V4319 V4320) (let ((A (kl:shen.newpv V4319))) (begin (kl:shen.incinfs) (kl:unify! V4318 (cons A (cons (quote -->) (cons (quote boolean) (quote ())))) V4319 V4320)))) (export shen.type-signature-of-tuple?) (quote shen.type-signature-of-tuple?)) +(begin (register-function-arity (quote shen.type-signature-of-undefmacro) 3) (define (kl:shen.type-signature-of-undefmacro V4328 V4329 V4330) (begin (kl:shen.incinfs) (kl:unify! V4328 (cons (quote symbol) (cons (quote -->) (cons (quote symbol) (quote ())))) V4329 V4330))) (export shen.type-signature-of-undefmacro) (quote shen.type-signature-of-undefmacro)) +(begin (register-function-arity (quote shen.type-signature-of-union) 3) (define (kl:shen.type-signature-of-union V4338 V4339 V4340) (let ((A (kl:shen.newpv V4339))) (begin (kl:shen.incinfs) (kl:unify! V4338 (cons (cons (quote list) (cons A (quote ()))) (cons (quote -->) (cons (cons (cons (quote list) (cons A (quote ()))) (cons (quote -->) (cons (cons (quote list) (cons A (quote ()))) (quote ())))) (quote ())))) V4339 V4340)))) (export shen.type-signature-of-union) (quote shen.type-signature-of-union)) +(begin (register-function-arity (quote shen.type-signature-of-unprofile) 3) (define (kl:shen.type-signature-of-unprofile V4348 V4349 V4350) (let ((A (kl:shen.newpv V4349))) (let ((B (kl:shen.newpv V4349))) (begin (kl:shen.incinfs) (kl:unify! V4348 (cons (cons A (cons (quote -->) (cons B (quote ())))) (cons (quote -->) (cons (cons A (cons (quote -->) (cons B (quote ())))) (quote ())))) V4349 V4350))))) (export shen.type-signature-of-unprofile) (quote shen.type-signature-of-unprofile)) +(begin (register-function-arity (quote shen.type-signature-of-untrack) 3) (define (kl:shen.type-signature-of-untrack V4358 V4359 V4360) (begin (kl:shen.incinfs) (kl:unify! V4358 (cons (quote symbol) (cons (quote -->) (cons (quote symbol) (quote ())))) V4359 V4360))) (export shen.type-signature-of-untrack) (quote shen.type-signature-of-untrack)) +(begin (register-function-arity (quote shen.type-signature-of-unspecialise) 3) (define (kl:shen.type-signature-of-unspecialise V4368 V4369 V4370) (begin (kl:shen.incinfs) (kl:unify! V4368 (cons (quote symbol) (cons (quote -->) (cons (quote symbol) (quote ())))) V4369 V4370))) (export shen.type-signature-of-unspecialise) (quote shen.type-signature-of-unspecialise)) +(begin (register-function-arity (quote shen.type-signature-of-variable?) 3) (define (kl:shen.type-signature-of-variable? V4378 V4379 V4380) (let ((A (kl:shen.newpv V4379))) (begin (kl:shen.incinfs) (kl:unify! V4378 (cons A (cons (quote -->) (cons (quote boolean) (quote ())))) V4379 V4380)))) (export shen.type-signature-of-variable?) (quote shen.type-signature-of-variable?)) +(begin (register-function-arity (quote shen.type-signature-of-vector?) 3) (define (kl:shen.type-signature-of-vector? V4388 V4389 V4390) (let ((A (kl:shen.newpv V4389))) (begin (kl:shen.incinfs) (kl:unify! V4388 (cons A (cons (quote -->) (cons (quote boolean) (quote ())))) V4389 V4390)))) (export shen.type-signature-of-vector?) (quote shen.type-signature-of-vector?)) +(begin (register-function-arity (quote shen.type-signature-of-version) 3) (define (kl:shen.type-signature-of-version V4398 V4399 V4400) (begin (kl:shen.incinfs) (kl:unify! V4398 (cons (quote -->) (cons (quote string) (quote ()))) V4399 V4400))) (export shen.type-signature-of-version) (quote shen.type-signature-of-version)) +(begin (register-function-arity (quote shen.type-signature-of-write-to-file) 3) (define (kl:shen.type-signature-of-write-to-file V4408 V4409 V4410) (let ((A (kl:shen.newpv V4409))) (begin (kl:shen.incinfs) (kl:unify! V4408 (cons (quote string) (cons (quote -->) (cons (cons A (cons (quote -->) (cons A (quote ())))) (quote ())))) V4409 V4410)))) (export shen.type-signature-of-write-to-file) (quote shen.type-signature-of-write-to-file)) +(begin (register-function-arity (quote shen.type-signature-of-write-byte) 3) (define (kl:shen.type-signature-of-write-byte V4418 V4419 V4420) (begin (kl:shen.incinfs) (kl:unify! V4418 (cons (quote number) (cons (quote -->) (cons (cons (cons (quote stream) (cons (quote out) (quote ()))) (cons (quote -->) (cons (quote number) (quote ())))) (quote ())))) V4419 V4420))) (export shen.type-signature-of-write-byte) (quote shen.type-signature-of-write-byte)) +(begin (register-function-arity (quote shen.type-signature-of-y-or-n?) 3) (define (kl:shen.type-signature-of-y-or-n? V4428 V4429 V4430) (begin (kl:shen.incinfs) (kl:unify! V4428 (cons (quote string) (cons (quote -->) (cons (quote boolean) (quote ())))) V4429 V4430))) (export shen.type-signature-of-y-or-n?) (quote shen.type-signature-of-y-or-n?)) +(begin (register-function-arity (quote shen.type-signature-of->) 3) (define (kl:shen.type-signature-of-> V4438 V4439 V4440) (begin (kl:shen.incinfs) (kl:unify! V4438 (cons (quote number) (cons (quote -->) (cons (cons (quote number) (cons (quote -->) (cons (quote boolean) (quote ())))) (quote ())))) V4439 V4440))) (export shen.type-signature-of->) (quote shen.type-signature-of->)) +(begin (register-function-arity (quote shen.type-signature-of-<) 3) (define (kl:shen.type-signature-of-< V4448 V4449 V4450) (begin (kl:shen.incinfs) (kl:unify! V4448 (cons (quote number) (cons (quote -->) (cons (cons (quote number) (cons (quote -->) (cons (quote boolean) (quote ())))) (quote ())))) V4449 V4450))) (export shen.type-signature-of-<) (quote shen.type-signature-of-<)) +(begin (register-function-arity (quote shen.type-signature-of->=) 3) (define (kl:shen.type-signature-of->= V4458 V4459 V4460) (begin (kl:shen.incinfs) (kl:unify! V4458 (cons (quote number) (cons (quote -->) (cons (cons (quote number) (cons (quote -->) (cons (quote boolean) (quote ())))) (quote ())))) V4459 V4460))) (export shen.type-signature-of->=) (quote shen.type-signature-of->=)) +(begin (register-function-arity (quote shen.type-signature-of-<=) 3) (define (kl:shen.type-signature-of-<= V4468 V4469 V4470) (begin (kl:shen.incinfs) (kl:unify! V4468 (cons (quote number) (cons (quote -->) (cons (cons (quote number) (cons (quote -->) (cons (quote boolean) (quote ())))) (quote ())))) V4469 V4470))) (export shen.type-signature-of-<=) (quote shen.type-signature-of-<=)) +(begin (register-function-arity (quote shen.type-signature-of-=) 3) (define (kl:shen.type-signature-of-= V4478 V4479 V4480) (let ((A (kl:shen.newpv V4479))) (begin (kl:shen.incinfs) (kl:unify! V4478 (cons A (cons (quote -->) (cons (cons A (cons (quote -->) (cons (quote boolean) (quote ())))) (quote ())))) V4479 V4480)))) (export shen.type-signature-of-=) (quote shen.type-signature-of-=)) +(begin (register-function-arity (quote shen.type-signature-of-+) 3) (define (kl:shen.type-signature-of-+ V4488 V4489 V4490) (begin (kl:shen.incinfs) (kl:unify! V4488 (cons (quote number) (cons (quote -->) (cons (cons (quote number) (cons (quote -->) (cons (quote number) (quote ())))) (quote ())))) V4489 V4490))) (export shen.type-signature-of-+) (quote shen.type-signature-of-+)) +(begin (register-function-arity (quote shen.type-signature-of-/) 3) (define (kl:shen.type-signature-of-/ V4498 V4499 V4500) (begin (kl:shen.incinfs) (kl:unify! V4498 (cons (quote number) (cons (quote -->) (cons (cons (quote number) (cons (quote -->) (cons (quote number) (quote ())))) (quote ())))) V4499 V4500))) (export shen.type-signature-of-/) (quote shen.type-signature-of-/)) +(begin (register-function-arity (quote shen.type-signature-of--) 3) (define (kl:shen.type-signature-of-- V4508 V4509 V4510) (begin (kl:shen.incinfs) (kl:unify! V4508 (cons (quote number) (cons (quote -->) (cons (cons (quote number) (cons (quote -->) (cons (quote number) (quote ())))) (quote ())))) V4509 V4510))) (export shen.type-signature-of--) (quote shen.type-signature-of--)) +(begin (register-function-arity (quote shen.type-signature-of-*) 3) (define (kl:shen.type-signature-of-* V4518 V4519 V4520) (begin (kl:shen.incinfs) (kl:unify! V4518 (cons (quote number) (cons (quote -->) (cons (cons (quote number) (cons (quote -->) (cons (quote number) (quote ())))) (quote ())))) V4519 V4520))) (export shen.type-signature-of-*) (quote shen.type-signature-of-*)) +(begin (register-function-arity (quote shen.type-signature-of-==) 3) (define (kl:shen.type-signature-of-== V4528 V4529 V4530) (let ((A (kl:shen.newpv V4529))) (let ((B (kl:shen.newpv V4529))) (begin (kl:shen.incinfs) (kl:unify! V4528 (cons A (cons (quote -->) (cons (cons B (cons (quote -->) (cons (quote boolean) (quote ())))) (quote ())))) V4529 V4530))))) (export shen.type-signature-of-==) (quote shen.type-signature-of-==)) diff --git a/compiled/writer.kl.ms b/compiled/writer.kl.ms index b5d8846..466e4d4 100644 --- a/compiled/writer.kl.ms +++ b/compiled/writer.kl.ms @@ -1,31 +1,31 @@ (module "compiled/writer.kl") "Copyright (c) 2010-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:\n\n1. Redistributions of source code must retain the above copyright notice,\nthis list of conditions and the following disclaimer.\n\n2. Redistributions in binary form must reproduce the above copyright notice,\nthis list of conditions and the following disclaimer in the documentation\nand/or other materials provided with the distribution.\n\n3. Neither the name of the copyright holder nor the names of its contributors\nmay be used to endorse or promote products derived from this software without\nspecific prior written permission.\n\nTHIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ''AS IS'' AND\nANY EXPRESS 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 THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE\nFOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL\nDAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR\nSERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER\nCAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,\nOR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE\nOF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.\n" -(begin (register-function-arity (quote pr) 2) (define (kl:pr V5697 V5698) (guard (lambda (E) V5697) (kl:shen.prh V5697 V5698 0))) (export pr) (quote pr)) -(begin (register-function-arity (quote shen.prh) 3) (define (kl:shen.prh V5702 V5703 V5704) (kl:shen.prh V5702 V5703 (kl:shen.write-char-and-inc V5702 V5703 V5704))) (export shen.prh) (quote shen.prh)) -(begin (register-function-arity (quote shen.write-char-and-inc) 3) (define (kl:shen.write-char-and-inc V5708 V5709 V5710) (begin (write-u8 (string-ref (make-string 1 (string-ref V5708 V5710)) 0) V5709) (+ V5710 1))) (export shen.write-char-and-inc) (quote shen.write-char-and-inc)) -(begin (register-function-arity (quote print) 1) (define (kl:print V5712) (let ((String (kl:shen.insert V5712 "~S"))) (let ((Print (kl:shen.prhush String (kl:stoutput)))) V5712))) (export print) (quote print)) -(begin (register-function-arity (quote shen.prhush) 2) (define (kl:shen.prhush V5715 V5716) (if (assert-boolean (kl:value (quote *hush*))) V5715 (kl:pr V5715 V5716))) (export shen.prhush) (quote shen.prhush)) -(begin (register-function-arity (quote shen.mkstr) 2) (define (kl:shen.mkstr V5719 V5720) (cond ((string? V5719) (kl:shen.mkstr-l (kl:shen.proc-nl V5719) V5720)) (#t (kl:shen.mkstr-r (cons (quote shen.proc-nl) (cons V5719 (quote ()))) V5720)))) (export shen.mkstr) (quote shen.mkstr)) -(begin (register-function-arity (quote shen.mkstr-l) 2) (define (kl:shen.mkstr-l V5723 V5724) (cond ((null? V5724) V5723) ((pair? V5724) (kl:shen.mkstr-l (kl:shen.insert-l (car V5724) V5723) (cdr V5724))) (#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 V5729 V5730) (cond ((equal? "" V5730) "") ((and (assert-boolean (kl:shen.+string? V5730)) (and (equal? "~" (make-string 1 (string-ref V5730 0))) (and (assert-boolean (kl:shen.+string? (string-tail V5730 1))) (equal? "A" (make-string 1 (string-ref (string-tail V5730 1) 0)))))) (cons (quote shen.app) (cons V5729 (cons (string-tail (string-tail V5730 1) 1) (cons (quote shen.a) (quote ())))))) ((and (assert-boolean (kl:shen.+string? V5730)) (and (equal? "~" (make-string 1 (string-ref V5730 0))) (and (assert-boolean (kl:shen.+string? (string-tail V5730 1))) (equal? "R" (make-string 1 (string-ref (string-tail V5730 1) 0)))))) (cons (quote shen.app) (cons V5729 (cons (string-tail (string-tail V5730 1) 1) (cons (quote shen.r) (quote ())))))) ((and (assert-boolean (kl:shen.+string? V5730)) (and (equal? "~" (make-string 1 (string-ref V5730 0))) (and (assert-boolean (kl:shen.+string? (string-tail V5730 1))) (equal? "S" (make-string 1 (string-ref (string-tail V5730 1) 0)))))) (cons (quote shen.app) (cons V5729 (cons (string-tail (string-tail V5730 1) 1) (cons (quote shen.s) (quote ())))))) ((assert-boolean (kl:shen.+string? V5730)) (kl:shen.factor-cn (cons (quote cn) (cons (make-string 1 (string-ref V5730 0)) (cons (kl:shen.insert-l V5729 (string-tail V5730 1)) (quote ())))))) ((and (pair? V5730) (and (eq? (quote cn) (car V5730)) (and (pair? (cdr V5730)) (and (pair? (cdr (cdr V5730))) (null? (cdr (cdr (cdr V5730)))))))) (cons (quote cn) (cons (car (cdr V5730)) (cons (kl:shen.insert-l V5729 (car (cdr (cdr V5730)))) (quote ()))))) ((and (pair? V5730) (and (eq? (quote shen.app) (car V5730)) (and (pair? (cdr V5730)) (and (pair? (cdr (cdr V5730))) (and (pair? (cdr (cdr (cdr V5730)))) (null? (cdr (cdr (cdr (cdr V5730)))))))))) (cons (quote shen.app) (cons (car (cdr V5730)) (cons (kl:shen.insert-l V5729 (car (cdr (cdr V5730)))) (cdr (cdr (cdr V5730))))))) (#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 V5732) (cond ((and (pair? V5732) (and (eq? (quote cn) (car V5732)) (and (pair? (cdr V5732)) (and (pair? (cdr (cdr V5732))) (and (pair? (car (cdr (cdr V5732)))) (and (eq? (quote cn) (car (car (cdr (cdr V5732))))) (and (pair? (cdr (car (cdr (cdr V5732))))) (and (pair? (cdr (cdr (car (cdr (cdr V5732)))))) (and (null? (cdr (cdr (cdr (car (cdr (cdr V5732))))))) (and (null? (cdr (cdr (cdr V5732)))) (and (string? (car (cdr V5732))) (string? (car (cdr (car (cdr (cdr V5732))))))))))))))))) (cons (quote cn) (cons (string-append (car (cdr V5732)) (car (cdr (car (cdr (cdr V5732)))))) (cdr (cdr (car (cdr (cdr V5732)))))))) (#t V5732))) (export shen.factor-cn) (quote shen.factor-cn)) -(begin (register-function-arity (quote shen.proc-nl) 1) (define (kl:shen.proc-nl V5734) (cond ((equal? "" V5734) "") ((and (assert-boolean (kl:shen.+string? V5734)) (and (equal? "~" (make-string 1 (string-ref V5734 0))) (and (assert-boolean (kl:shen.+string? (string-tail V5734 1))) (equal? "%" (make-string 1 (string-ref (string-tail V5734 1) 0)))))) (string-append (make-string 1 10) (kl:shen.proc-nl (string-tail (string-tail V5734 1) 1)))) ((assert-boolean (kl:shen.+string? V5734)) (string-append (make-string 1 (string-ref V5734 0)) (kl:shen.proc-nl (string-tail V5734 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 V5737 V5738) (cond ((null? V5738) V5737) ((pair? V5738) (kl:shen.mkstr-r (cons (quote shen.insert) (cons (car V5738) (cons V5737 (quote ())))) (cdr V5738))) (#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 V5741 V5742) (kl:shen.insert-h V5741 V5742 "")) (export shen.insert) (quote shen.insert)) -(begin (register-function-arity (quote shen.insert-h) 3) (define (kl:shen.insert-h V5748 V5749 V5750) (cond ((equal? "" V5749) V5750) ((and (assert-boolean (kl:shen.+string? V5749)) (and (equal? "~" (make-string 1 (string-ref V5749 0))) (and (assert-boolean (kl:shen.+string? (string-tail V5749 1))) (equal? "A" (make-string 1 (string-ref (string-tail V5749 1) 0)))))) (string-append V5750 (kl:shen.app V5748 (string-tail (string-tail V5749 1) 1) (quote shen.a)))) ((and (assert-boolean (kl:shen.+string? V5749)) (and (equal? "~" (make-string 1 (string-ref V5749 0))) (and (assert-boolean (kl:shen.+string? (string-tail V5749 1))) (equal? "R" (make-string 1 (string-ref (string-tail V5749 1) 0)))))) (string-append V5750 (kl:shen.app V5748 (string-tail (string-tail V5749 1) 1) (quote shen.r)))) ((and (assert-boolean (kl:shen.+string? V5749)) (and (equal? "~" (make-string 1 (string-ref V5749 0))) (and (assert-boolean (kl:shen.+string? (string-tail V5749 1))) (equal? "S" (make-string 1 (string-ref (string-tail V5749 1) 0)))))) (string-append V5750 (kl:shen.app V5748 (string-tail (string-tail V5749 1) 1) (quote shen.s)))) ((assert-boolean (kl:shen.+string? V5749)) (kl:shen.insert-h V5748 (string-tail V5749 1) (string-append V5750 (make-string 1 (string-ref V5749 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 V5754 V5755 V5756) (string-append (kl:shen.arg->str V5754 V5756) V5755)) (export shen.app) (quote shen.app)) -(begin (register-function-arity (quote shen.arg->str) 2) (define (kl:shen.arg->str V5764 V5765) (cond ((kl:= V5764 (kl:fail)) "...") ((assert-boolean (kl:shen.list? V5764)) (kl:shen.list->str V5764 V5765)) ((string? V5764) (kl:shen.str->str V5764 V5765)) ((vector? V5764) (kl:shen.vector->str V5764 V5765)) (#t (kl:shen.atom->str V5764)))) (export shen.arg->str) (quote shen.arg->str)) -(begin (register-function-arity (quote shen.list->str) 2) (define (kl:shen.list->str V5768 V5769) (cond ((eq? (quote shen.r) V5769) (kl:_waspvm_at_s "(" (kl:_waspvm_at_s (kl:shen.iter-list V5768 (quote shen.r) (kl:shen.maxseq)) ")"))) (#t (kl:_waspvm_at_s "[" (kl:_waspvm_at_s (kl:shen.iter-list V5768 V5769 (kl:shen.maxseq)) "]"))))) (export shen.list->str) (quote shen.list->str)) +(begin (register-function-arity (quote pr) 2) (define (kl:pr V4536 V4537) (guard (lambda (E) V4536) (kl:shen.prh V4536 V4537 0))) (export pr) (quote pr)) +(begin (register-function-arity (quote shen.prh) 3) (define (kl:shen.prh V4541 V4542 V4543) (kl:shen.prh V4541 V4542 (kl:shen.write-char-and-inc V4541 V4542 V4543))) (export shen.prh) (quote shen.prh)) +(begin (register-function-arity (quote shen.write-char-and-inc) 3) (define (kl:shen.write-char-and-inc V4547 V4548 V4549) (begin (write-u8 (string-ref (make-string 1 (string-ref V4547 V4549)) 0) V4548) (+ V4549 1))) (export shen.write-char-and-inc) (quote shen.write-char-and-inc)) +(begin (register-function-arity (quote print) 1) (define (kl:print V4551) (let ((String (kl:shen.insert V4551 "~S"))) (let ((Print (kl:shen.prhush String (kl:stoutput)))) V4551))) (export print) (quote print)) +(begin (register-function-arity (quote shen.prhush) 2) (define (kl:shen.prhush V4554 V4555) (if (assert-boolean (kl:value (quote *hush*))) V4554 (kl:pr V4554 V4555))) (export shen.prhush) (quote shen.prhush)) +(begin (register-function-arity (quote shen.mkstr) 2) (define (kl:shen.mkstr V4558 V4559) (cond ((string? V4558) (kl:shen.mkstr-l (kl:shen.proc-nl V4558) V4559)) (#t (kl:shen.mkstr-r (cons (quote shen.proc-nl) (cons V4558 (quote ()))) V4559)))) (export shen.mkstr) (quote shen.mkstr)) +(begin (register-function-arity (quote shen.mkstr-l) 2) (define (kl:shen.mkstr-l V4562 V4563) (cond ((null? V4563) V4562) ((pair? V4563) (kl:shen.mkstr-l (kl:shen.insert-l (car V4563) V4562) (cdr V4563))) (#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 V4568 V4569) (cond ((equal? "" V4569) "") ((and (assert-boolean (kl:shen.+string? V4569)) (and (equal? "~" (make-string 1 (string-ref V4569 0))) (and (assert-boolean (kl:shen.+string? (string-tail V4569 1))) (equal? "A" (make-string 1 (string-ref (string-tail V4569 1) 0)))))) (cons (quote shen.app) (cons V4568 (cons (string-tail (string-tail V4569 1) 1) (cons (quote shen.a) (quote ())))))) ((and (assert-boolean (kl:shen.+string? V4569)) (and (equal? "~" (make-string 1 (string-ref V4569 0))) (and (assert-boolean (kl:shen.+string? (string-tail V4569 1))) (equal? "R" (make-string 1 (string-ref (string-tail V4569 1) 0)))))) (cons (quote shen.app) (cons V4568 (cons (string-tail (string-tail V4569 1) 1) (cons (quote shen.r) (quote ())))))) ((and (assert-boolean (kl:shen.+string? V4569)) (and (equal? "~" (make-string 1 (string-ref V4569 0))) (and (assert-boolean (kl:shen.+string? (string-tail V4569 1))) (equal? "S" (make-string 1 (string-ref (string-tail V4569 1) 0)))))) (cons (quote shen.app) (cons V4568 (cons (string-tail (string-tail V4569 1) 1) (cons (quote shen.s) (quote ())))))) ((assert-boolean (kl:shen.+string? V4569)) (kl:shen.factor-cn (cons (quote cn) (cons (make-string 1 (string-ref V4569 0)) (cons (kl:shen.insert-l V4568 (string-tail V4569 1)) (quote ())))))) ((and (pair? V4569) (and (eq? (quote cn) (car V4569)) (and (pair? (cdr V4569)) (and (pair? (cdr (cdr V4569))) (null? (cdr (cdr (cdr V4569)))))))) (cons (quote cn) (cons (car (cdr V4569)) (cons (kl:shen.insert-l V4568 (car (cdr (cdr V4569)))) (quote ()))))) ((and (pair? V4569) (and (eq? (quote shen.app) (car V4569)) (and (pair? (cdr V4569)) (and (pair? (cdr (cdr V4569))) (and (pair? (cdr (cdr (cdr V4569)))) (null? (cdr (cdr (cdr (cdr V4569)))))))))) (cons (quote shen.app) (cons (car (cdr V4569)) (cons (kl:shen.insert-l V4568 (car (cdr (cdr V4569)))) (cdr (cdr (cdr V4569))))))) (#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 V4571) (cond ((and (pair? V4571) (and (eq? (quote cn) (car V4571)) (and (pair? (cdr V4571)) (and (pair? (cdr (cdr V4571))) (and (pair? (car (cdr (cdr V4571)))) (and (eq? (quote cn) (car (car (cdr (cdr V4571))))) (and (pair? (cdr (car (cdr (cdr V4571))))) (and (pair? (cdr (cdr (car (cdr (cdr V4571)))))) (and (null? (cdr (cdr (cdr (car (cdr (cdr V4571))))))) (and (null? (cdr (cdr (cdr V4571)))) (and (string? (car (cdr V4571))) (string? (car (cdr (car (cdr (cdr V4571))))))))))))))))) (cons (quote cn) (cons (string-append (car (cdr V4571)) (car (cdr (car (cdr (cdr V4571)))))) (cdr (cdr (car (cdr (cdr V4571)))))))) (#t V4571))) (export shen.factor-cn) (quote shen.factor-cn)) +(begin (register-function-arity (quote shen.proc-nl) 1) (define (kl:shen.proc-nl V4573) (cond ((equal? "" V4573) "") ((and (assert-boolean (kl:shen.+string? V4573)) (and (equal? "~" (make-string 1 (string-ref V4573 0))) (and (assert-boolean (kl:shen.+string? (string-tail V4573 1))) (equal? "%" (make-string 1 (string-ref (string-tail V4573 1) 0)))))) (string-append (make-string 1 10) (kl:shen.proc-nl (string-tail (string-tail V4573 1) 1)))) ((assert-boolean (kl:shen.+string? V4573)) (string-append (make-string 1 (string-ref V4573 0)) (kl:shen.proc-nl (string-tail V4573 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 V4576 V4577) (cond ((null? V4577) V4576) ((pair? V4577) (kl:shen.mkstr-r (cons (quote shen.insert) (cons (car V4577) (cons V4576 (quote ())))) (cdr V4577))) (#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 V4580 V4581) (kl:shen.insert-h V4580 V4581 "")) (export shen.insert) (quote shen.insert)) +(begin (register-function-arity (quote shen.insert-h) 3) (define (kl:shen.insert-h V4587 V4588 V4589) (cond ((equal? "" V4588) V4589) ((and (assert-boolean (kl:shen.+string? V4588)) (and (equal? "~" (make-string 1 (string-ref V4588 0))) (and (assert-boolean (kl:shen.+string? (string-tail V4588 1))) (equal? "A" (make-string 1 (string-ref (string-tail V4588 1) 0)))))) (string-append V4589 (kl:shen.app V4587 (string-tail (string-tail V4588 1) 1) (quote shen.a)))) ((and (assert-boolean (kl:shen.+string? V4588)) (and (equal? "~" (make-string 1 (string-ref V4588 0))) (and (assert-boolean (kl:shen.+string? (string-tail V4588 1))) (equal? "R" (make-string 1 (string-ref (string-tail V4588 1) 0)))))) (string-append V4589 (kl:shen.app V4587 (string-tail (string-tail V4588 1) 1) (quote shen.r)))) ((and (assert-boolean (kl:shen.+string? V4588)) (and (equal? "~" (make-string 1 (string-ref V4588 0))) (and (assert-boolean (kl:shen.+string? (string-tail V4588 1))) (equal? "S" (make-string 1 (string-ref (string-tail V4588 1) 0)))))) (string-append V4589 (kl:shen.app V4587 (string-tail (string-tail V4588 1) 1) (quote shen.s)))) ((assert-boolean (kl:shen.+string? V4588)) (kl:shen.insert-h V4587 (string-tail V4588 1) (string-append V4589 (make-string 1 (string-ref V4588 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 V4593 V4594 V4595) (string-append (kl:shen.arg->str V4593 V4595) V4594)) (export shen.app) (quote shen.app)) +(begin (register-function-arity (quote shen.arg->str) 2) (define (kl:shen.arg->str V4603 V4604) (cond ((kl:= V4603 (kl:fail)) "...") ((assert-boolean (kl:shen.list? V4603)) (kl:shen.list->str V4603 V4604)) ((string? V4603) (kl:shen.str->str V4603 V4604)) ((vector? V4603) (kl:shen.vector->str V4603 V4604)) (#t (kl:shen.atom->str V4603)))) (export shen.arg->str) (quote shen.arg->str)) +(begin (register-function-arity (quote shen.list->str) 2) (define (kl:shen.list->str V4607 V4608) (cond ((eq? (quote shen.r) V4608) (kl:_waspvm_at_s "(" (kl:_waspvm_at_s (kl:shen.iter-list V4607 (quote shen.r) (kl:shen.maxseq)) ")"))) (#t (kl:_waspvm_at_s "[" (kl:_waspvm_at_s (kl:shen.iter-list V4607 V4608 (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 V5783 V5784 V5785) (cond ((null? V5783) "") ((kl:= 0 V5785) "... etc") ((and (pair? V5783) (null? (cdr V5783))) (kl:shen.arg->str (car V5783) V5784)) ((pair? V5783) (kl:_waspvm_at_s (kl:shen.arg->str (car V5783) V5784) (kl:_waspvm_at_s " " (kl:shen.iter-list (cdr V5783) V5784 (- V5785 1))))) (#t (kl:_waspvm_at_s "|" (kl:_waspvm_at_s " " (kl:shen.arg->str V5783 V5784)))))) (export shen.iter-list) (quote shen.iter-list)) -(begin (register-function-arity (quote shen.str->str) 2) (define (kl:shen.str->str V5792 V5793) (cond ((eq? (quote shen.a) V5793) V5792) (#t (kl:_waspvm_at_s (make-string 1 34) (kl:_waspvm_at_s V5792 (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 V5796 V5797) (if (assert-boolean (kl:shen.print-vector? V5796)) ((kl:function (vector-ref V5796 0)) V5796) (if (assert-boolean (kl:vector? V5796)) (kl:_waspvm_at_s "<" (kl:_waspvm_at_s (kl:shen.iter-vector V5796 1 V5797 (kl:shen.maxseq)) ">")) (kl:_waspvm_at_s "<" (kl:_waspvm_at_s "<" (kl:_waspvm_at_s (kl:shen.iter-vector V5796 0 V5797 (kl:shen.maxseq)) ">>")))))) (export shen.vector->str) (quote shen.vector->str)) -(begin (register-function-arity (quote shen.empty-absvector?) 1) (define (kl:shen.empty-absvector? V5799) (kl:= V5799 (kl:value (quote shen.*empty-absvector*)))) (export shen.empty-absvector?) (quote shen.empty-absvector?)) -(begin (register-function-arity (quote shen.print-vector?) 1) (define (kl:shen.print-vector? V5801) (and (kl:not (kl:shen.empty-absvector? V5801)) (assert-boolean (let ((First (vector-ref V5801 0))) (or (eq? First (quote shen.tuple)) (or (eq? First (quote shen.pvar)) (or (eq? First (quote shen.dictionary)) (and (kl:not (number? First)) (assert-boolean (kl:shen.fbound? First)))))))))) (export shen.print-vector?) (quote shen.print-vector?)) -(begin (register-function-arity (quote shen.fbound?) 1) (define (kl:shen.fbound? V5803) (guard (lambda (E) #f) (begin (kl:shen.lookup-func V5803) #t))) (export shen.fbound?) (quote shen.fbound?)) -(begin (register-function-arity (quote shen.tuple) 1) (define (kl:shen.tuple V5805) (string-append "(@p " (kl:shen.app (vector-ref V5805 1) (string-append " " (kl:shen.app (vector-ref V5805 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 V5807) "(dict ...)") (export shen.dictionary) (quote shen.dictionary)) -(begin (register-function-arity (quote shen.iter-vector) 4) (define (kl:shen.iter-vector V5818 V5819 V5820 V5821) (cond ((kl:= 0 V5821) "... etc") (#t (let ((Item (guard (lambda (E) (quote shen.out-of-bounds)) (vector-ref V5818 V5819)))) (let ((Next (guard (lambda (E) (quote shen.out-of-bounds)) (vector-ref V5818 (+ V5819 1))))) (if (eq? Item (quote shen.out-of-bounds)) "" (if (eq? Next (quote shen.out-of-bounds)) (kl:shen.arg->str Item V5820) (kl:_waspvm_at_s (kl:shen.arg->str Item V5820) (kl:_waspvm_at_s " " (kl:shen.iter-vector V5818 (+ V5819 1) V5820 (- V5821 1))))))))))) (export shen.iter-vector) (quote shen.iter-vector)) -(begin (register-function-arity (quote shen.atom->str) 1) (define (kl:shen.atom->str V5823) (guard (lambda (E) (kl:shen.funexstring)) (kl:str V5823))) (export shen.atom->str) (quote shen.atom->str)) +(begin (register-function-arity (quote shen.iter-list) 3) (define (kl:shen.iter-list V4622 V4623 V4624) (cond ((null? V4622) "") ((kl:= 0 V4624) "... etc") ((and (pair? V4622) (null? (cdr V4622))) (kl:shen.arg->str (car V4622) V4623)) ((pair? V4622) (kl:_waspvm_at_s (kl:shen.arg->str (car V4622) V4623) (kl:_waspvm_at_s " " (kl:shen.iter-list (cdr V4622) V4623 (- V4624 1))))) (#t (kl:_waspvm_at_s "|" (kl:_waspvm_at_s " " (kl:shen.arg->str V4622 V4623)))))) (export shen.iter-list) (quote shen.iter-list)) +(begin (register-function-arity (quote shen.str->str) 2) (define (kl:shen.str->str V4631 V4632) (cond ((eq? (quote shen.a) V4632) V4631) (#t (kl:_waspvm_at_s (make-string 1 34) (kl:_waspvm_at_s V4631 (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 V4635 V4636) (if (assert-boolean (kl:shen.print-vector? V4635)) ((kl:function (vector-ref V4635 0)) V4635) (if (assert-boolean (kl:vector? V4635)) (kl:_waspvm_at_s "<" (kl:_waspvm_at_s (kl:shen.iter-vector V4635 1 V4636 (kl:shen.maxseq)) ">")) (kl:_waspvm_at_s "<" (kl:_waspvm_at_s "<" (kl:_waspvm_at_s (kl:shen.iter-vector V4635 0 V4636 (kl:shen.maxseq)) ">>")))))) (export shen.vector->str) (quote shen.vector->str)) +(begin (register-function-arity (quote shen.empty-absvector?) 1) (define (kl:shen.empty-absvector? V4638) (kl:= V4638 (kl:value (quote shen.*empty-absvector*)))) (export shen.empty-absvector?) (quote shen.empty-absvector?)) +(begin (register-function-arity (quote shen.print-vector?) 1) (define (kl:shen.print-vector? V4640) (and (kl:not (kl:shen.empty-absvector? V4640)) (assert-boolean (let ((First (vector-ref V4640 0))) (or (eq? First (quote shen.tuple)) (or (eq? First (quote shen.pvar)) (or (eq? First (quote shen.dictionary)) (and (kl:not (number? First)) (assert-boolean (kl:shen.fbound? First)))))))))) (export shen.print-vector?) (quote shen.print-vector?)) +(begin (register-function-arity (quote shen.fbound?) 1) (define (kl:shen.fbound? V4642) (guard (lambda (E) #f) (begin (kl:shen.lookup-func V4642) #t))) (export shen.fbound?) (quote shen.fbound?)) +(begin (register-function-arity (quote shen.tuple) 1) (define (kl:shen.tuple V4644) (string-append "(@p " (kl:shen.app (vector-ref V4644 1) (string-append " " (kl:shen.app (vector-ref V4644 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 V4646) "(dict ...)") (export shen.dictionary) (quote shen.dictionary)) +(begin (register-function-arity (quote shen.iter-vector) 4) (define (kl:shen.iter-vector V4657 V4658 V4659 V4660) (cond ((kl:= 0 V4660) "... etc") (#t (let ((Item (guard (lambda (E) (quote shen.out-of-bounds)) (vector-ref V4657 V4658)))) (let ((Next (guard (lambda (E) (quote shen.out-of-bounds)) (vector-ref V4657 (+ V4658 1))))) (if (eq? Item (quote shen.out-of-bounds)) "" (if (eq? Next (quote shen.out-of-bounds)) (kl:shen.arg->str Item V4659) (kl:_waspvm_at_s (kl:shen.arg->str Item V4659) (kl:_waspvm_at_s " " (kl:shen.iter-vector V4657 (+ V4658 1) V4659 (- V4660 1))))))))))) (export shen.iter-vector) (quote shen.iter-vector)) +(begin (register-function-arity (quote shen.atom->str) 1) (define (kl:shen.atom->str V4662) (guard (lambda (E) (kl:shen.funexstring)) (kl:str V4662))) (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? V5825) (or (kl:empty? V5825) (pair? V5825))) (export shen.list?) (quote shen.list?)) +(begin (register-function-arity (quote shen.list?) 1) (define (kl:shen.list? V4664) (or (kl:empty? V4664) (pair? V4664))) (export shen.list?) (quote shen.list?)) diff --git a/compiled/yacc.kl.ms b/compiled/yacc.kl.ms index eaca03e..355f6cc 100644 --- a/compiled/yacc.kl.ms +++ b/compiled/yacc.kl.ms @@ -1,34 +1,34 @@ (module "compiled/yacc.kl") "Copyright (c) 2010-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:\n\n1. Redistributions of source code must retain the above copyright notice,\nthis list of conditions and the following disclaimer.\n\n2. Redistributions in binary form must reproduce the above copyright notice,\nthis list of conditions and the following disclaimer in the documentation\nand/or other materials provided with the distribution.\n\n3. Neither the name of the copyright holder nor the names of its contributors\nmay be used to endorse or promote products derived from this software without\nspecific prior written permission.\n\nTHIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ''AS IS'' AND\nANY EXPRESS 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 THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE\nFOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL\nDAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR\nSERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER\nCAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,\nOR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE\nOF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.\n" -(begin (register-function-arity (quote shen.yacc) 1) (define (kl:shen.yacc V5827) (cond ((and (pair? V5827) (and (eq? (quote defcc) (car V5827)) (pair? (cdr V5827)))) (kl:shen.yacc->shen (car (cdr V5827)) (cdr (cdr V5827)))) (#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 V5830 V5831) (let ((CCRules (kl:shen.split_cc_rules #t V5831 (quote ())))) (let ((CCBody (kl:map (lambda (X) (kl:shen.cc_body X)) CCRules))) (let ((YaccCases (kl:shen.yacc_cases CCBody))) (cons (quote define) (cons V5830 (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 V5833) (cond ((> (kl:occurrences (quote kill) V5833) 0) (cons (quote trap-error) (cons V5833 (cons (cons (quote lambda) (cons (quote E) (cons (cons (quote shen.analyse-kill) (cons (quote E) (quote ()))) (quote ())))) (quote ()))))) (#t V5833))) (export shen.kill-code) (quote shen.kill-code)) +(begin (register-function-arity (quote shen.yacc) 1) (define (kl:shen.yacc V4666) (cond ((and (pair? V4666) (and (eq? (quote defcc) (car V4666)) (pair? (cdr V4666)))) (kl:shen.yacc->shen (car (cdr V4666)) (cdr (cdr V4666)))) (#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 V4669 V4670) (let ((CCRules (kl:shen.split_cc_rules #t V4670 (quote ())))) (let ((CCBody (kl:map (lambda (X) (kl:shen.cc_body X)) CCRules))) (let ((YaccCases (kl:shen.yacc_cases CCBody))) (cons (quote define) (cons V4669 (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 V4672) (cond ((> (kl:occurrences (quote kill) V4672) 0) (cons (quote trap-error) (cons V4672 (cons (cons (quote lambda) (cons (quote E) (cons (cons (quote shen.analyse-kill) (cons (quote E) (quote ()))) (quote ())))) (quote ()))))) (#t V4672))) (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 V5835) (let ((String (kl:error-to-string V5835))) (if (equal? String "yacc kill") (kl:fail) V5835))) (export shen.analyse-kill) (quote shen.analyse-kill)) -(begin (register-function-arity (quote shen.split_cc_rules) 3) (define (kl:shen.split_cc_rules V5841 V5842 V5843) (cond ((and (null? V5842) (null? V5843)) (quote ())) ((null? V5842) (cons (kl:shen.split_cc_rule V5841 (kl:reverse V5843) (quote ())) (quote ()))) ((and (pair? V5842) (eq? (quote _waspvm_sc_) (car V5842))) (cons (kl:shen.split_cc_rule V5841 (kl:reverse V5843) (quote ())) (kl:shen.split_cc_rules V5841 (cdr V5842) (quote ())))) ((pair? V5842) (kl:shen.split_cc_rules V5841 (cdr V5842) (cons (car V5842) V5843))) (#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 V5851 V5852 V5853) (cond ((and (pair? V5852) (and (eq? (quote :=) (car V5852)) (and (pair? (cdr V5852)) (null? (cdr (cdr V5852)))))) (cons (kl:reverse V5853) (cdr V5852))) ((and (pair? V5852) (and (eq? (quote :=) (car V5852)) (and (pair? (cdr V5852)) (and (pair? (cdr (cdr V5852))) (and (eq? (quote where) (car (cdr (cdr V5852)))) (and (pair? (cdr (cdr (cdr V5852)))) (null? (cdr (cdr (cdr (cdr V5852))))))))))) (cons (kl:reverse V5853) (cons (cons (quote where) (cons (car (cdr (cdr (cdr V5852)))) (cons (car (cdr V5852)) (quote ())))) (quote ())))) ((null? V5852) (begin (kl:shen.semantic-completion-warning V5851 V5853) (kl:shen.split_cc_rule V5851 (cons (quote :=) (cons (kl:shen.default_semantics (kl:reverse V5853)) (quote ()))) V5853))) ((pair? V5852) (kl:shen.split_cc_rule V5851 (cdr V5852) (cons (car V5852) V5853))) (#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 V5864 V5865) (cond ((kl:= #t V5864) (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 V5865)) (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 V5867) (cond ((null? V5867) (quote ())) ((and (pair? V5867) (and (null? (cdr V5867)) (assert-boolean (kl:shen.grammar_symbol? (car V5867))))) (car V5867)) ((and (pair? V5867) (assert-boolean (kl:shen.grammar_symbol? (car V5867)))) (cons (quote append) (cons (car V5867) (cons (kl:shen.default_semantics (cdr V5867)) (quote ()))))) ((pair? V5867) (cons (quote cons) (cons (car V5867) (cons (kl:shen.default_semantics (cdr V5867)) (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? V5869) (and (kl:symbol? V5869) (assert-boolean (let ((Cs (kl:shen.strip-pathname (kl:explode V5869)))) (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 V5871) (cond ((and (pair? V5871) (null? (cdr V5871))) (car V5871)) ((pair? V5871) (let ((P (quote YaccParse))) (cons (quote let) (cons P (cons (car V5871) (cons (cons (quote if) (cons (cons (quote =) (cons P (cons (cons (quote fail) (quote ())) (quote ())))) (cons (kl:shen.yacc_cases (cdr V5871)) (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 V5873) (cond ((and (pair? V5873) (and (pair? (cdr V5873)) (null? (cdr (cdr V5873))))) (kl:shen.syntax (car V5873) (quote Stream) (car (cdr V5873)))) (#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 V5877 V5878 V5879) (cond ((and (null? V5877) (and (pair? V5879) (and (eq? (quote where) (car V5879)) (and (pair? (cdr V5879)) (and (pair? (cdr (cdr V5879))) (null? (cdr (cdr (cdr V5879))))))))) (cons (quote if) (cons (kl:shen.semantics (car (cdr V5879))) (cons (cons (quote shen.pair) (cons (cons (quote hd) (cons V5878 (quote ()))) (cons (kl:shen.semantics (car (cdr (cdr V5879)))) (quote ())))) (cons (cons (quote fail) (quote ())) (quote ())))))) ((null? V5877) (cons (quote shen.pair) (cons (cons (quote hd) (cons V5878 (quote ()))) (cons (kl:shen.semantics V5879) (quote ()))))) ((pair? V5877) (if (assert-boolean (kl:shen.grammar_symbol? (car V5877))) (kl:shen.recursive_descent V5877 V5878 V5879) (if (kl:variable? (car V5877)) (kl:shen.variable-match V5877 V5878 V5879) (if (assert-boolean (kl:shen.jump_stream? (car V5877))) (kl:shen.jump_stream V5877 V5878 V5879) (if (assert-boolean (kl:shen.terminal? (car V5877))) (kl:shen.check_stream V5877 V5878 V5879) (if (pair? (car V5877)) (kl:shen.list-stream (kl:shen.decons (car V5877)) (cdr V5877) V5878 V5879) (simple-error (kl:shen.app (car V5877) " 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 V5884 V5885 V5886 V5887) (let ((Test (cons (quote and) (cons (cons (quote cons?) (cons (cons (quote hd) (cons V5886 (quote ()))) (quote ()))) (cons (cons (quote cons?) (cons (cons (quote shen.hdhd) (cons V5886 (quote ()))) (quote ()))) (quote ())))))) (let ((Placeholder (kl:gensym (quote shen.place)))) (let ((RunOn (kl:shen.syntax V5885 (cons (quote shen.pair) (cons (cons (quote shen.tlhd) (cons V5886 (quote ()))) (cons (cons (quote shen.hdtl) (cons V5886 (quote ()))) (quote ())))) V5887))) (let ((Action (kl:shen.insert-runon RunOn Placeholder (kl:shen.syntax V5884 (cons (quote shen.pair) (cons (cons (quote shen.hdhd) (cons V5886 (quote ()))) (cons (cons (quote shen.hdtl) (cons V5886 (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 V5889) (cond ((and (pair? V5889) (and (eq? (quote cons) (car V5889)) (and (pair? (cdr V5889)) (and (pair? (cdr (cdr V5889))) (and (null? (car (cdr (cdr V5889)))) (null? (cdr (cdr (cdr V5889))))))))) (cons (car (cdr V5889)) (quote ()))) ((and (pair? V5889) (and (eq? (quote cons) (car V5889)) (and (pair? (cdr V5889)) (and (pair? (cdr (cdr V5889))) (null? (cdr (cdr (cdr V5889)))))))) (cons (car (cdr V5889)) (kl:shen.decons (car (cdr (cdr V5889)))))) (#t V5889))) (export shen.decons) (quote shen.decons)) -(begin (register-function-arity (quote shen.insert-runon) 3) (define (kl:shen.insert-runon V5904 V5905 V5906) (cond ((and (pair? V5906) (and (eq? (quote shen.pair) (car V5906)) (and (pair? (cdr V5906)) (and (pair? (cdr (cdr V5906))) (and (null? (cdr (cdr (cdr V5906)))) (kl:= (car (cdr (cdr V5906))) V5905)))))) V5904) ((pair? V5906) (kl:map (lambda (Z) (kl:shen.insert-runon V5904 V5905 Z)) V5906)) (#t V5906))) (export shen.insert-runon) (quote shen.insert-runon)) -(begin (register-function-arity (quote shen.strip-pathname) 1) (define (kl:shen.strip-pathname V5912) (cond ((kl:not (kl:element? "." V5912)) V5912) ((pair? V5912) (kl:shen.strip-pathname (cdr V5912))) (#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 V5916 V5917 V5918) (cond ((pair? V5916) (let ((Test (cons (car V5916) (cons V5917 (quote ()))))) (let ((Action (kl:shen.syntax (cdr V5916) (kl:concat (quote Parse_) (car V5916)) V5918))) (let ((Else (cons (quote fail) (quote ())))) (cons (quote let) (cons (kl:concat (quote Parse_) (car V5916)) (cons Test (cons (cons (quote if) (cons (cons (quote not) (cons (cons (quote =) (cons (cons (quote fail) (quote ())) (cons (kl:concat (quote Parse_) (car V5916)) (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 V5922 V5923 V5924) (cond ((pair? V5922) (let ((Test (cons (quote cons?) (cons (cons (quote hd) (cons V5923 (quote ()))) (quote ()))))) (let ((Action (cons (quote let) (cons (kl:concat (quote Parse_) (car V5922)) (cons (cons (quote shen.hdhd) (cons V5923 (quote ()))) (cons (kl:shen.syntax (cdr V5922) (cons (quote shen.pair) (cons (cons (quote shen.tlhd) (cons V5923 (quote ()))) (cons (cons (quote shen.hdtl) (cons V5923 (quote ()))) (quote ())))) V5924) (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? V5934) (cond ((pair? V5934) #f) ((kl:variable? V5934) #f) (#t #t))) (export shen.terminal?) (quote shen.terminal?)) -(begin (register-function-arity (quote shen.jump_stream?) 1) (define (kl:shen.jump_stream? V5940) (cond ((eq? V5940 (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 V5944 V5945 V5946) (cond ((pair? V5944) (let ((Test (cons (quote and) (cons (cons (quote cons?) (cons (cons (quote hd) (cons V5945 (quote ()))) (quote ()))) (cons (cons (quote =) (cons (car V5944) (cons (cons (quote shen.hdhd) (cons V5945 (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 V5945 (quote ()))) (cons (cons (quote shen.hdtl) (cons V5945 (quote ()))) (quote ())))) (cons (kl:shen.syntax (cdr V5944) NewStr V5946) (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 V5950 V5951 V5952) (cond ((pair? V5950) (let ((Test (cons (quote cons?) (cons (cons (quote hd) (cons V5951 (quote ()))) (quote ()))))) (let ((Action (kl:shen.syntax (cdr V5950) (cons (quote shen.pair) (cons (cons (quote shen.tlhd) (cons V5951 (quote ()))) (cons (cons (quote shen.hdtl) (cons V5951 (quote ()))) (quote ())))) V5952))) (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 V5954) (cond ((null? V5954) (quote ())) ((assert-boolean (kl:shen.grammar_symbol? V5954)) (cons (quote shen.hdtl) (cons (kl:concat (quote Parse_) V5954) (quote ())))) ((kl:variable? V5954) (kl:concat (quote Parse_) V5954)) ((pair? V5954) (kl:map (lambda (Z) (kl:shen.semantics Z)) V5954)) (#t V5954))) (export shen.semantics) (quote shen.semantics)) -(begin (register-function-arity (quote shen.pair) 2) (define (kl:shen.pair V5957 V5958) (cons V5957 (cons V5958 (quote ())))) (export shen.pair) (quote shen.pair)) -(begin (register-function-arity (quote shen.hdtl) 1) (define (kl:shen.hdtl V5960) (car (cdr V5960))) (export shen.hdtl) (quote shen.hdtl)) -(begin (register-function-arity (quote shen.hdhd) 1) (define (kl:shen.hdhd V5962) (car (car V5962))) (export shen.hdhd) (quote shen.hdhd)) -(begin (register-function-arity (quote shen.tlhd) 1) (define (kl:shen.tlhd V5964) (cdr (car V5964))) (export shen.tlhd) (quote shen.tlhd)) -(begin (register-function-arity (quote shen.snd-or-fail) 1) (define (kl:shen.snd-or-fail V5972) (cond ((and (pair? V5972) (and (pair? (cdr V5972)) (null? (cdr (cdr V5972))))) (car (cdr V5972))) (#t (kl:fail)))) (export shen.snd-or-fail) (quote shen.snd-or-fail)) +(begin (register-function-arity (quote shen.analyse-kill) 1) (define (kl:shen.analyse-kill V4674) (let ((String (kl:error-to-string V4674))) (if (equal? String "yacc kill") (kl:fail) V4674))) (export shen.analyse-kill) (quote shen.analyse-kill)) +(begin (register-function-arity (quote shen.split_cc_rules) 3) (define (kl:shen.split_cc_rules V4680 V4681 V4682) (cond ((and (null? V4681) (null? V4682)) (quote ())) ((null? V4681) (cons (kl:shen.split_cc_rule V4680 (kl:reverse V4682) (quote ())) (quote ()))) ((and (pair? V4681) (eq? (quote _waspvm_sc_) (car V4681))) (cons (kl:shen.split_cc_rule V4680 (kl:reverse V4682) (quote ())) (kl:shen.split_cc_rules V4680 (cdr V4681) (quote ())))) ((pair? V4681) (kl:shen.split_cc_rules V4680 (cdr V4681) (cons (car V4681) V4682))) (#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 V4690 V4691 V4692) (cond ((and (pair? V4691) (and (eq? (quote :=) (car V4691)) (and (pair? (cdr V4691)) (null? (cdr (cdr V4691)))))) (cons (kl:reverse V4692) (cdr V4691))) ((and (pair? V4691) (and (eq? (quote :=) (car V4691)) (and (pair? (cdr V4691)) (and (pair? (cdr (cdr V4691))) (and (eq? (quote where) (car (cdr (cdr V4691)))) (and (pair? (cdr (cdr (cdr V4691)))) (null? (cdr (cdr (cdr (cdr V4691))))))))))) (cons (kl:reverse V4692) (cons (cons (quote where) (cons (car (cdr (cdr (cdr V4691)))) (cons (car (cdr V4691)) (quote ())))) (quote ())))) ((null? V4691) (begin (kl:shen.semantic-completion-warning V4690 V4692) (kl:shen.split_cc_rule V4690 (cons (quote :=) (cons (kl:shen.default_semantics (kl:reverse V4692)) (quote ()))) V4692))) ((pair? V4691) (kl:shen.split_cc_rule V4690 (cdr V4691) (cons (car V4691) V4692))) (#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 V4703 V4704) (cond ((kl:= #t V4703) (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 V4704)) (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 V4706) (cond ((null? V4706) (quote ())) ((and (pair? V4706) (and (null? (cdr V4706)) (assert-boolean (kl:shen.grammar_symbol? (car V4706))))) (car V4706)) ((and (pair? V4706) (assert-boolean (kl:shen.grammar_symbol? (car V4706)))) (cons (quote append) (cons (car V4706) (cons (kl:shen.default_semantics (cdr V4706)) (quote ()))))) ((pair? V4706) (cons (quote cons) (cons (car V4706) (cons (kl:shen.default_semantics (cdr V4706)) (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? V4708) (and (kl:symbol? V4708) (assert-boolean (let ((Cs (kl:shen.strip-pathname (kl:explode V4708)))) (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 V4710) (cond ((and (pair? V4710) (null? (cdr V4710))) (car V4710)) ((pair? V4710) (let ((P (quote YaccParse))) (cons (quote let) (cons P (cons (car V4710) (cons (cons (quote if) (cons (cons (quote =) (cons P (cons (cons (quote fail) (quote ())) (quote ())))) (cons (kl:shen.yacc_cases (cdr V4710)) (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 V4712) (cond ((and (pair? V4712) (and (pair? (cdr V4712)) (null? (cdr (cdr V4712))))) (kl:shen.syntax (car V4712) (quote Stream) (car (cdr V4712)))) (#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 V4716 V4717 V4718) (cond ((and (null? V4716) (and (pair? V4718) (and (eq? (quote where) (car V4718)) (and (pair? (cdr V4718)) (and (pair? (cdr (cdr V4718))) (null? (cdr (cdr (cdr V4718))))))))) (cons (quote if) (cons (kl:shen.semantics (car (cdr V4718))) (cons (cons (quote shen.pair) (cons (cons (quote hd) (cons V4717 (quote ()))) (cons (kl:shen.semantics (car (cdr (cdr V4718)))) (quote ())))) (cons (cons (quote fail) (quote ())) (quote ())))))) ((null? V4716) (cons (quote shen.pair) (cons (cons (quote hd) (cons V4717 (quote ()))) (cons (kl:shen.semantics V4718) (quote ()))))) ((pair? V4716) (if (assert-boolean (kl:shen.grammar_symbol? (car V4716))) (kl:shen.recursive_descent V4716 V4717 V4718) (if (kl:variable? (car V4716)) (kl:shen.variable-match V4716 V4717 V4718) (if (assert-boolean (kl:shen.jump_stream? (car V4716))) (kl:shen.jump_stream V4716 V4717 V4718) (if (assert-boolean (kl:shen.terminal? (car V4716))) (kl:shen.check_stream V4716 V4717 V4718) (if (pair? (car V4716)) (kl:shen.list-stream (kl:shen.decons (car V4716)) (cdr V4716) V4717 V4718) (simple-error (kl:shen.app (car V4716) " 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 V4723 V4724 V4725 V4726) (let ((Test (cons (quote and) (cons (cons (quote cons?) (cons (cons (quote hd) (cons V4725 (quote ()))) (quote ()))) (cons (cons (quote cons?) (cons (cons (quote shen.hdhd) (cons V4725 (quote ()))) (quote ()))) (quote ())))))) (let ((Placeholder (kl:gensym (quote shen.place)))) (let ((RunOn (kl:shen.syntax V4724 (cons (quote shen.pair) (cons (cons (quote shen.tlhd) (cons V4725 (quote ()))) (cons (cons (quote shen.hdtl) (cons V4725 (quote ()))) (quote ())))) V4726))) (let ((Action (kl:shen.insert-runon RunOn Placeholder (kl:shen.syntax V4723 (cons (quote shen.pair) (cons (cons (quote shen.hdhd) (cons V4725 (quote ()))) (cons (cons (quote shen.hdtl) (cons V4725 (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 V4728) (cond ((and (pair? V4728) (and (eq? (quote cons) (car V4728)) (and (pair? (cdr V4728)) (and (pair? (cdr (cdr V4728))) (and (null? (car (cdr (cdr V4728)))) (null? (cdr (cdr (cdr V4728))))))))) (cons (car (cdr V4728)) (quote ()))) ((and (pair? V4728) (and (eq? (quote cons) (car V4728)) (and (pair? (cdr V4728)) (and (pair? (cdr (cdr V4728))) (null? (cdr (cdr (cdr V4728)))))))) (cons (car (cdr V4728)) (kl:shen.decons (car (cdr (cdr V4728)))))) (#t V4728))) (export shen.decons) (quote shen.decons)) +(begin (register-function-arity (quote shen.insert-runon) 3) (define (kl:shen.insert-runon V4743 V4744 V4745) (cond ((and (pair? V4745) (and (eq? (quote shen.pair) (car V4745)) (and (pair? (cdr V4745)) (and (pair? (cdr (cdr V4745))) (and (null? (cdr (cdr (cdr V4745)))) (kl:= (car (cdr (cdr V4745))) V4744)))))) V4743) ((pair? V4745) (kl:map (lambda (Z) (kl:shen.insert-runon V4743 V4744 Z)) V4745)) (#t V4745))) (export shen.insert-runon) (quote shen.insert-runon)) +(begin (register-function-arity (quote shen.strip-pathname) 1) (define (kl:shen.strip-pathname V4751) (cond ((kl:not (kl:element? "." V4751)) V4751) ((pair? V4751) (kl:shen.strip-pathname (cdr V4751))) (#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 V4755 V4756 V4757) (cond ((pair? V4755) (let ((Test (cons (car V4755) (cons V4756 (quote ()))))) (let ((Action (kl:shen.syntax (cdr V4755) (kl:concat (quote Parse_) (car V4755)) V4757))) (let ((Else (cons (quote fail) (quote ())))) (cons (quote let) (cons (kl:concat (quote Parse_) (car V4755)) (cons Test (cons (cons (quote if) (cons (cons (quote not) (cons (cons (quote =) (cons (cons (quote fail) (quote ())) (cons (kl:concat (quote Parse_) (car V4755)) (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 V4761 V4762 V4763) (cond ((pair? V4761) (let ((Test (cons (quote cons?) (cons (cons (quote hd) (cons V4762 (quote ()))) (quote ()))))) (let ((Action (cons (quote let) (cons (kl:concat (quote Parse_) (car V4761)) (cons (cons (quote shen.hdhd) (cons V4762 (quote ()))) (cons (kl:shen.syntax (cdr V4761) (cons (quote shen.pair) (cons (cons (quote shen.tlhd) (cons V4762 (quote ()))) (cons (cons (quote shen.hdtl) (cons V4762 (quote ()))) (quote ())))) V4763) (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? V4773) (cond ((pair? V4773) #f) ((kl:variable? V4773) #f) (#t #t))) (export shen.terminal?) (quote shen.terminal?)) +(begin (register-function-arity (quote shen.jump_stream?) 1) (define (kl:shen.jump_stream? V4779) (cond ((eq? V4779 (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 V4783 V4784 V4785) (cond ((pair? V4783) (let ((Test (cons (quote and) (cons (cons (quote cons?) (cons (cons (quote hd) (cons V4784 (quote ()))) (quote ()))) (cons (cons (quote =) (cons (car V4783) (cons (cons (quote shen.hdhd) (cons V4784 (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 V4784 (quote ()))) (cons (cons (quote shen.hdtl) (cons V4784 (quote ()))) (quote ())))) (cons (kl:shen.syntax (cdr V4783) NewStr V4785) (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 V4789 V4790 V4791) (cond ((pair? V4789) (let ((Test (cons (quote cons?) (cons (cons (quote hd) (cons V4790 (quote ()))) (quote ()))))) (let ((Action (kl:shen.syntax (cdr V4789) (cons (quote shen.pair) (cons (cons (quote shen.tlhd) (cons V4790 (quote ()))) (cons (cons (quote shen.hdtl) (cons V4790 (quote ()))) (quote ())))) V4791))) (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 V4793) (cond ((null? V4793) (quote ())) ((assert-boolean (kl:shen.grammar_symbol? V4793)) (cons (quote shen.hdtl) (cons (kl:concat (quote Parse_) V4793) (quote ())))) ((kl:variable? V4793) (kl:concat (quote Parse_) V4793)) ((pair? V4793) (kl:map (lambda (Z) (kl:shen.semantics Z)) V4793)) (#t V4793))) (export shen.semantics) (quote shen.semantics)) +(begin (register-function-arity (quote shen.pair) 2) (define (kl:shen.pair V4796 V4797) (cons V4796 (cons V4797 (quote ())))) (export shen.pair) (quote shen.pair)) +(begin (register-function-arity (quote shen.hdtl) 1) (define (kl:shen.hdtl V4799) (car (cdr V4799))) (export shen.hdtl) (quote shen.hdtl)) +(begin (register-function-arity (quote shen.hdhd) 1) (define (kl:shen.hdhd V4801) (car (car V4801))) (export shen.hdhd) (quote shen.hdhd)) +(begin (register-function-arity (quote shen.tlhd) 1) (define (kl:shen.tlhd V4803) (cdr (car V4803))) (export shen.tlhd) (quote shen.tlhd)) +(begin (register-function-arity (quote shen.snd-or-fail) 1) (define (kl:shen.snd-or-fail V4811) (cond ((and (pair? V4811) (and (pair? (cdr V4811)) (null? (cdr (cdr V4811))))) (car (cdr V4811))) (#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: V5980) (cond ((and (pair? V5980) (and (pair? (cdr V5980)) (null? (cdr (cdr V5980))))) (cons (quote ()) (cons (car V5980) (quote ())))) (#t (kl:fail)))) (export ) (quote )) -(begin (register-function-arity (quote ) 1) (define (kl: V5986) (cond ((and (pair? V5986) (and (pair? (cdr V5986)) (null? (cdr (cdr V5986))))) (cons (car V5986) (cons (quote ()) (quote ())))) (#t (kl:shen.f_error (quote ))))) (export ) (quote )) +(begin (register-function-arity (quote ) 1) (define (kl: V4819) (cond ((and (pair? V4819) (and (pair? (cdr V4819)) (null? (cdr (cdr V4819))))) (cons (quote ()) (cons (car V4819) (quote ())))) (#t (kl:fail)))) (export ) (quote )) +(begin (register-function-arity (quote ) 1) (define (kl: V4825) (cond ((and (pair? V4825) (and (pair? (cdr V4825)) (null? (cdr (cdr V4825))))) (cons (car V4825) (cons (quote ()) (quote ())))) (#t (kl:shen.f_error (quote ))))) (export ) (quote )) diff --git a/driver.ms b/driver.ms index 147c68b..f9ed995 100644 --- a/driver.ms +++ b/driver.ms @@ -107,6 +107,8 @@ "init.kl" "extension-features.kl" "extension-launcher.kl" + "extension-factorise-defun.kl" + "extension-programmable-pattern-matching.kl" )) (for-each (lambda (file) @@ -136,6 +138,8 @@ "init.kl" "extension-features.kl" "extension-launcher.kl" + "extension-factorise-defun.kl" + "extension-programmable-pattern-matching.kl" )) (for-each (lambda (file) @@ -164,6 +168,8 @@ "init.kl" "extension-features.kl" "extension-launcher.kl" + "extension-factorise-defun.kl" + "extension-programmable-pattern-matching.kl" )) (for-each (lambda (file) @@ -174,8 +180,8 @@ (kl:set (quote *language*) "Wasp Lisp") (kl:set (quote *implementation*) "WaspVM") -(kl:set (quote *port*) "0.11") -(kl:set (quote *release*) "0.11") +(kl:set (quote *port*) "0.12") +(kl:set (quote *release*) "0.12") (kl:set (quote *porters*) "Chris Double") (kl:set (quote *sterror*) (cons (current-output) #f)) (kl:set (quote *stinput*) (cons (current-input) (make-string))) diff --git a/kl/core.kl b/kl/core.kl index 2dd7704..e8ca385 100644 --- a/kl/core.kl +++ b/kl/core.kl @@ -28,143 +28,147 @@ OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. " -(defun shen.shen->kl (V1261 V1262) (compile (lambda X (shen. X)) (cons V1261 V1262) (lambda X (shen.shen-syntax-error V1261 X)))) +(defun shen.shen->kl (V94 V95) (compile (lambda X (shen. X)) (cons V94 V95) (lambda X (shen.shen-syntax-error V94 X)))) -(defun shen.shen-syntax-error (V1269 V1270) (cond ((cons? V1270) (simple-error (cn "syntax error in " (shen.app V1269 (cn " here: +(defun shen.shen-syntax-error (V102 V103) (cond ((cons? V103) (simple-error (cn "syntax error in " (shen.app V102 (cn " here: - " (shen.app (shen.next-50 50 (hd V1270)) " -" shen.a)) shen.a)))) (true (simple-error (cn "syntax error in " (shen.app V1269 " + " (shen.app (shen.next-50 50 (hd V103)) " +" shen.a)) shen.a)))) (true (simple-error (cn "syntax error in " (shen.app V102 " " shen.a)))))) -(defun shen. (V1272) (let YaccParse (let Parse_shen. (shen. V1272) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.compile_to_machine_code (shen.hdtl Parse_shen.) (shen.hdtl Parse_shen.))) (fail))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_shen. (shen. V1272) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.compile_to_machine_code (shen.hdtl Parse_shen.) (shen.hdtl Parse_shen.))) (fail))) (fail))) YaccParse))) +(defun shen. (V105) (let YaccParse (let Parse_shen. (shen. V105) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.compile_to_machine_code (shen.hdtl Parse_shen.) (shen.hdtl Parse_shen.))) (fail))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_shen. (shen. V105) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.compile_to_machine_code (shen.hdtl Parse_shen.) (shen.hdtl Parse_shen.))) (fail))) (fail))) YaccParse))) -(defun shen. (V1274) (if (cons? (hd V1274)) (let Parse_X (shen.hdhd V1274) (shen.pair (hd (shen.pair (shen.tlhd V1274) (shen.hdtl V1274))) (if (and (symbol? Parse_X) (not (shen.sysfunc? Parse_X))) Parse_X (simple-error (shen.app Parse_X " is not a legitimate function name. +(defun shen. (V107) (if (cons? (hd V107)) (let Parse_X (shen.hdhd V107) (shen.pair (hd (shen.pair (shen.tlhd V107) (shen.hdtl V107))) (if (and (symbol? Parse_X) (not (shen.sysfunc? Parse_X))) Parse_X (simple-error (shen.app Parse_X " is not a legitimate function name. " shen.a))))) (fail))) -(defun shen.sysfunc? (V1276) (element? V1276 (get (intern "shen") shen.external-symbols (value *property-vector*)))) +(defun shen.sysfunc? (V109) (element? V109 (get (intern "shen") shen.external-symbols (value *property-vector*)))) -(defun shen. (V1280) (if (and (cons? (hd V1280)) (= { (shen.hdhd V1280))) (let NewStream1277 (shen.pair (shen.tlhd V1280) (shen.hdtl V1280)) (let Parse_shen. (shen. NewStream1277) (if (not (= (fail) Parse_shen.)) (if (and (cons? (hd Parse_shen.)) (= } (shen.hdhd Parse_shen.))) (let NewStream1278 (shen.pair (shen.tlhd Parse_shen.) (shen.hdtl Parse_shen.)) (shen.pair (hd NewStream1278) (shen.demodulate (shen.curry-type (shen.hdtl Parse_shen.))))) (fail)) (fail)))) (fail))) +(defun shen. (V113) (if (and (cons? (hd V113)) (= { (shen.hdhd V113))) (let NewStream110 (shen.pair (shen.tlhd V113) (shen.hdtl V113)) (let Parse_shen. (shen. NewStream110) (if (not (= (fail) Parse_shen.)) (if (and (cons? (hd Parse_shen.)) (= } (shen.hdhd Parse_shen.))) (let NewStream111 (shen.pair (shen.tlhd Parse_shen.) (shen.hdtl Parse_shen.)) (shen.pair (hd NewStream111) (shen.demodulate (shen.curry-type (shen.hdtl Parse_shen.))))) (fail)) (fail)))) (fail))) -(defun shen.curry-type (V1282) (shen.active-cons (shen.curry-type-h V1282))) +(defun shen.curry-type (V115) (shen.active-cons (shen.curry-type-h V115))) -(defun shen.active-cons (V1284) (cond ((and (cons? V1284) (and (cons? (tl V1284)) (and (cons? (tl (tl V1284))) (and (= () (tl (tl (tl V1284)))) (= (hd (tl V1284)) bar!))))) (cons (shen.active-cons (hd V1284)) (shen.active-cons (hd (tl (tl V1284)))))) ((cons? V1284) (cons (shen.active-cons (hd V1284)) (shen.active-cons (tl V1284)))) (true V1284))) +(defun shen.active-cons (V117) (cond ((and (cons? V117) (and (cons? (tl V117)) (and (cons? (tl (tl V117))) (and (= () (tl (tl (tl V117)))) (= (hd (tl V117)) bar!))))) (cons (shen.active-cons (hd V117)) (shen.active-cons (hd (tl (tl V117)))))) ((cons? V117) (cons (shen.active-cons (hd V117)) (shen.active-cons (tl V117)))) (true V117))) -(defun shen.curry-type-h (V1286) (cond ((and (cons? V1286) (and (cons? (tl V1286)) (and (= --> (hd (tl V1286))) (and (cons? (tl (tl V1286))) (and (cons? (tl (tl (tl V1286)))) (= --> (hd (tl (tl (tl V1286)))))))))) (shen.curry-type-h (cons (hd V1286) (cons --> (cons (tl (tl V1286)) ()))))) ((and (cons? V1286) (and (cons? (tl V1286)) (and (= * (hd (tl V1286))) (and (cons? (tl (tl V1286))) (and (cons? (tl (tl (tl V1286)))) (= * (hd (tl (tl (tl V1286)))))))))) (shen.curry-type-h (cons (hd V1286) (cons * (cons (tl (tl V1286)) ()))))) ((cons? V1286) (map (lambda Z (shen.curry-type-h Z)) V1286)) (true V1286))) +(defun shen.curry-type-h (V119) (cond ((and (cons? V119) (and (cons? (tl V119)) (and (= --> (hd (tl V119))) (and (cons? (tl (tl V119))) (and (cons? (tl (tl (tl V119)))) (= --> (hd (tl (tl (tl V119)))))))))) (shen.curry-type-h (cons (hd V119) (cons --> (cons (tl (tl V119)) ()))))) ((and (cons? V119) (and (cons? (tl V119)) (and (= * (hd (tl V119))) (and (cons? (tl (tl V119))) (and (cons? (tl (tl (tl V119)))) (= * (hd (tl (tl (tl V119)))))))))) (shen.curry-type-h (cons (hd V119) (cons * (cons (tl (tl V119)) ()))))) ((cons? V119) (map (lambda Z (shen.curry-type-h Z)) V119)) (true V119))) -(defun shen. (V1288) (let YaccParse (if (cons? (hd V1288)) (let Parse_X (shen.hdhd V1288) (let Parse_shen. (shen. (shen.pair (shen.tlhd V1288) (shen.hdtl V1288))) (if (not (= (fail) Parse_shen.)) (if (not (element? Parse_X (cons { (cons } ())))) (shen.pair (hd Parse_shen.) (cons Parse_X (shen.hdtl Parse_shen.))) (fail)) (fail)))) (fail)) (if (= YaccParse (fail)) (let Parse_ ( V1288) (if (not (= (fail) Parse_)) (shen.pair (hd Parse_) ()) (fail))) YaccParse))) +(defun shen. (V121) (let YaccParse (if (cons? (hd V121)) (let Parse_X (shen.hdhd V121) (let Parse_shen. (shen. (shen.pair (shen.tlhd V121) (shen.hdtl V121))) (if (not (= (fail) Parse_shen.)) (if (not (element? Parse_X (cons { (cons } ())))) (shen.pair (hd Parse_shen.) (cons Parse_X (shen.hdtl Parse_shen.))) (fail)) (fail)))) (fail)) (if (= YaccParse (fail)) (let Parse_ ( V121) (if (not (= (fail) Parse_)) (shen.pair (hd Parse_) ()) (fail))) YaccParse))) -(defun shen. (V1290) (let YaccParse (let Parse_shen. (shen. V1290) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (shen.linearise (shen.hdtl Parse_shen.)) (shen.hdtl Parse_shen.))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_shen. (shen. V1290) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (shen.linearise (shen.hdtl Parse_shen.)) ())) (fail))) YaccParse))) +(defun shen. (V123) (let YaccParse (let Parse_shen. (shen. V123) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (shen.linearise (shen.hdtl Parse_shen.)) (shen.hdtl Parse_shen.))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_shen. (shen. V123) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (shen.linearise (shen.hdtl Parse_shen.)) ())) (fail))) YaccParse))) -(defun shen. (V1298) (let YaccParse (let Parse_shen. (shen. V1298) (if (not (= (fail) Parse_shen.)) (if (and (cons? (hd Parse_shen.)) (= -> (shen.hdhd Parse_shen.))) (let NewStream1291 (shen.pair (shen.tlhd Parse_shen.) (shen.hdtl Parse_shen.)) (let Parse_shen. (shen. NewStream1291) (if (not (= (fail) Parse_shen.)) (if (and (cons? (hd Parse_shen.)) (= where (shen.hdhd Parse_shen.))) (let NewStream1292 (shen.pair (shen.tlhd Parse_shen.) (shen.hdtl Parse_shen.)) (let Parse_shen. (shen. NewStream1292) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (shen.hdtl Parse_shen.) (cons (cons where (cons (shen.hdtl Parse_shen.) (cons (shen.hdtl Parse_shen.) ()))) ()))) (fail)))) (fail)) (fail)))) (fail)) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V1298) (if (not (= (fail) Parse_shen.)) (if (and (cons? (hd Parse_shen.)) (= -> (shen.hdhd Parse_shen.))) (let NewStream1293 (shen.pair (shen.tlhd Parse_shen.) (shen.hdtl Parse_shen.)) (let Parse_shen. (shen. NewStream1293) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (shen.hdtl Parse_shen.) (cons (shen.hdtl Parse_shen.) ()))) (fail)))) (fail)) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V1298) (if (not (= (fail) Parse_shen.)) (if (and (cons? (hd Parse_shen.)) (= <- (shen.hdhd Parse_shen.))) (let NewStream1294 (shen.pair (shen.tlhd Parse_shen.) (shen.hdtl Parse_shen.)) (let Parse_shen. (shen. NewStream1294) (if (not (= (fail) Parse_shen.)) (if (and (cons? (hd Parse_shen.)) (= where (shen.hdhd Parse_shen.))) (let NewStream1295 (shen.pair (shen.tlhd Parse_shen.) (shen.hdtl Parse_shen.)) (let Parse_shen. (shen. NewStream1295) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (shen.hdtl Parse_shen.) (cons (cons where (cons (shen.hdtl Parse_shen.) (cons (cons shen.choicepoint! (cons (shen.hdtl Parse_shen.) ())) ()))) ()))) (fail)))) (fail)) (fail)))) (fail)) (fail))) (if (= YaccParse (fail)) (let Parse_shen. (shen. V1298) (if (not (= (fail) Parse_shen.)) (if (and (cons? (hd Parse_shen.)) (= <- (shen.hdhd Parse_shen.))) (let NewStream1296 (shen.pair (shen.tlhd Parse_shen.) (shen.hdtl Parse_shen.)) (let Parse_shen. (shen. NewStream1296) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (shen.hdtl Parse_shen.) (cons (cons shen.choicepoint! (cons (shen.hdtl Parse_shen.) ())) ()))) (fail)))) (fail)) (fail))) YaccParse)) YaccParse)) YaccParse))) +(defun shen. (V131) (let YaccParse (let Parse_shen. (shen. V131) (if (not (= (fail) Parse_shen.)) (if (and (cons? (hd Parse_shen.)) (= -> (shen.hdhd Parse_shen.))) (let NewStream124 (shen.pair (shen.tlhd Parse_shen.) (shen.hdtl Parse_shen.)) (let Parse_shen. (shen. NewStream124) (if (not (= (fail) Parse_shen.)) (if (and (cons? (hd Parse_shen.)) (= where (shen.hdhd Parse_shen.))) (let NewStream125 (shen.pair (shen.tlhd Parse_shen.) (shen.hdtl Parse_shen.)) (let Parse_shen. (shen. NewStream125) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (shen.hdtl Parse_shen.) (cons (cons where (cons (shen.hdtl Parse_shen.) (cons (shen.hdtl Parse_shen.) ()))) ()))) (fail)))) (fail)) (fail)))) (fail)) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V131) (if (not (= (fail) Parse_shen.)) (if (and (cons? (hd Parse_shen.)) (= -> (shen.hdhd Parse_shen.))) (let NewStream126 (shen.pair (shen.tlhd Parse_shen.) (shen.hdtl Parse_shen.)) (let Parse_shen. (shen. NewStream126) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (shen.hdtl Parse_shen.) (cons (shen.hdtl Parse_shen.) ()))) (fail)))) (fail)) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V131) (if (not (= (fail) Parse_shen.)) (if (and (cons? (hd Parse_shen.)) (= <- (shen.hdhd Parse_shen.))) (let NewStream127 (shen.pair (shen.tlhd Parse_shen.) (shen.hdtl Parse_shen.)) (let Parse_shen. (shen. NewStream127) (if (not (= (fail) Parse_shen.)) (if (and (cons? (hd Parse_shen.)) (= where (shen.hdhd Parse_shen.))) (let NewStream128 (shen.pair (shen.tlhd Parse_shen.) (shen.hdtl Parse_shen.)) (let Parse_shen. (shen. NewStream128) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (shen.hdtl Parse_shen.) (cons (cons where (cons (shen.hdtl Parse_shen.) (cons (cons shen.choicepoint! (cons (shen.hdtl Parse_shen.) ())) ()))) ()))) (fail)))) (fail)) (fail)))) (fail)) (fail))) (if (= YaccParse (fail)) (let Parse_shen. (shen. V131) (if (not (= (fail) Parse_shen.)) (if (and (cons? (hd Parse_shen.)) (= <- (shen.hdhd Parse_shen.))) (let NewStream129 (shen.pair (shen.tlhd Parse_shen.) (shen.hdtl Parse_shen.)) (let Parse_shen. (shen. NewStream129) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (shen.hdtl Parse_shen.) (cons (cons shen.choicepoint! (cons (shen.hdtl Parse_shen.) ())) ()))) (fail)))) (fail)) (fail))) YaccParse)) YaccParse)) YaccParse))) -(defun shen.fail_if (V1301 V1302) (if (V1301 V1302) (fail) V1302)) +(defun shen.fail_if (V134 V135) (if (V134 V135) (fail) V135)) -(defun shen.succeeds? (V1308) (cond ((= V1308 (fail)) false) (true true))) +(defun shen.succeeds? (V141) (cond ((= V141 (fail)) false) (true true))) -(defun shen. (V1310) (let YaccParse (let Parse_shen. (shen. V1310) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (shen.hdtl Parse_shen.) (shen.hdtl Parse_shen.))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_ ( V1310) (if (not (= (fail) Parse_)) (shen.pair (hd Parse_) ()) (fail))) YaccParse))) +(defun shen.custom-pattern-compiler (V144 V145) ((value shen.*custom-pattern-compiler*) V144 V145)) -(defun shen. (V1323) (let YaccParse (if (and (cons? (hd V1323)) (cons? (shen.hdhd V1323))) (if (and (cons? (hd (shen.pair (shen.hdhd V1323) (shen.hdtl V1323)))) (= @p (shen.hdhd (shen.pair (shen.hdhd V1323) (shen.hdtl V1323))))) (let NewStream1312 (shen.pair (shen.tlhd (shen.pair (shen.hdhd V1323) (shen.hdtl V1323))) (shen.hdtl (shen.pair (shen.hdhd V1323) (shen.hdtl V1323)))) (let Parse_shen. (shen. NewStream1312) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd (shen.pair (shen.tlhd V1323) (shen.hdtl V1323))) (cons @p (cons (shen.hdtl Parse_shen.) (cons (shen.hdtl Parse_shen.) ())))) (fail))) (fail)))) (fail)) (fail)) (if (= YaccParse (fail)) (let YaccParse (if (and (cons? (hd V1323)) (cons? (shen.hdhd V1323))) (if (and (cons? (hd (shen.pair (shen.hdhd V1323) (shen.hdtl V1323)))) (= cons (shen.hdhd (shen.pair (shen.hdhd V1323) (shen.hdtl V1323))))) (let NewStream1314 (shen.pair (shen.tlhd (shen.pair (shen.hdhd V1323) (shen.hdtl V1323))) (shen.hdtl (shen.pair (shen.hdhd V1323) (shen.hdtl V1323)))) (let Parse_shen. (shen. NewStream1314) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd (shen.pair (shen.tlhd V1323) (shen.hdtl V1323))) (cons cons (cons (shen.hdtl Parse_shen.) (cons (shen.hdtl Parse_shen.) ())))) (fail))) (fail)))) (fail)) (fail)) (if (= YaccParse (fail)) (let YaccParse (if (and (cons? (hd V1323)) (cons? (shen.hdhd V1323))) (if (and (cons? (hd (shen.pair (shen.hdhd V1323) (shen.hdtl V1323)))) (= @v (shen.hdhd (shen.pair (shen.hdhd V1323) (shen.hdtl V1323))))) (let NewStream1316 (shen.pair (shen.tlhd (shen.pair (shen.hdhd V1323) (shen.hdtl V1323))) (shen.hdtl (shen.pair (shen.hdhd V1323) (shen.hdtl V1323)))) (let Parse_shen. (shen. NewStream1316) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd (shen.pair (shen.tlhd V1323) (shen.hdtl V1323))) (cons @v (cons (shen.hdtl Parse_shen.) (cons (shen.hdtl Parse_shen.) ())))) (fail))) (fail)))) (fail)) (fail)) (if (= YaccParse (fail)) (let YaccParse (if (and (cons? (hd V1323)) (cons? (shen.hdhd V1323))) (if (and (cons? (hd (shen.pair (shen.hdhd V1323) (shen.hdtl V1323)))) (= @s (shen.hdhd (shen.pair (shen.hdhd V1323) (shen.hdtl V1323))))) (let NewStream1318 (shen.pair (shen.tlhd (shen.pair (shen.hdhd V1323) (shen.hdtl V1323))) (shen.hdtl (shen.pair (shen.hdhd V1323) (shen.hdtl V1323)))) (let Parse_shen. (shen. NewStream1318) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd (shen.pair (shen.tlhd V1323) (shen.hdtl V1323))) (cons @s (cons (shen.hdtl Parse_shen.) (cons (shen.hdtl Parse_shen.) ())))) (fail))) (fail)))) (fail)) (fail)) (if (= YaccParse (fail)) (let YaccParse (if (and (cons? (hd V1323)) (cons? (shen.hdhd V1323))) (if (and (cons? (hd (shen.pair (shen.hdhd V1323) (shen.hdtl V1323)))) (= vector (shen.hdhd (shen.pair (shen.hdhd V1323) (shen.hdtl V1323))))) (let NewStream1320 (shen.pair (shen.tlhd (shen.pair (shen.hdhd V1323) (shen.hdtl V1323))) (shen.hdtl (shen.pair (shen.hdhd V1323) (shen.hdtl V1323)))) (if (and (cons? (hd NewStream1320)) (= 0 (shen.hdhd NewStream1320))) (let NewStream1321 (shen.pair (shen.tlhd NewStream1320) (shen.hdtl NewStream1320)) (shen.pair (hd (shen.pair (shen.tlhd V1323) (shen.hdtl V1323))) (cons vector (cons 0 ())))) (fail))) (fail)) (fail)) (if (= YaccParse (fail)) (let YaccParse (if (cons? (hd V1323)) (let Parse_X (shen.hdhd V1323) (if (cons? Parse_X) (shen.pair (hd (shen.pair (shen.tlhd V1323) (shen.hdtl V1323))) (shen.constructor-error Parse_X)) (fail))) (fail)) (if (= YaccParse (fail)) (let Parse_shen. (shen. V1323) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.hdtl Parse_shen.)) (fail))) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse))) +(defun shen.custom-pattern-reducer (V147) ((value shen.*custom-pattern-reducer*) V147)) -(defun shen.constructor-error (V1325) (simple-error (shen.app V1325 " is not a legitimate constructor +(defun shen. (V149) (let YaccParse (let Parse_shen. (shen. V149) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (shen.hdtl Parse_shen.) (shen.hdtl Parse_shen.))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_ ( V149) (if (not (= (fail) Parse_)) (shen.pair (hd Parse_) ()) (fail))) YaccParse))) + +(defun shen. (V162) (let YaccParse (if (and (cons? (hd V162)) (cons? (shen.hdhd V162))) (if (and (cons? (hd (shen.pair (shen.hdhd V162) (shen.hdtl V162)))) (= @p (shen.hdhd (shen.pair (shen.hdhd V162) (shen.hdtl V162))))) (let NewStream151 (shen.pair (shen.tlhd (shen.pair (shen.hdhd V162) (shen.hdtl V162))) (shen.hdtl (shen.pair (shen.hdhd V162) (shen.hdtl V162)))) (let Parse_shen. (shen. NewStream151) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd (shen.pair (shen.tlhd V162) (shen.hdtl V162))) (cons @p (cons (shen.hdtl Parse_shen.) (cons (shen.hdtl Parse_shen.) ())))) (fail))) (fail)))) (fail)) (fail)) (if (= YaccParse (fail)) (let YaccParse (if (and (cons? (hd V162)) (cons? (shen.hdhd V162))) (if (and (cons? (hd (shen.pair (shen.hdhd V162) (shen.hdtl V162)))) (= cons (shen.hdhd (shen.pair (shen.hdhd V162) (shen.hdtl V162))))) (let NewStream153 (shen.pair (shen.tlhd (shen.pair (shen.hdhd V162) (shen.hdtl V162))) (shen.hdtl (shen.pair (shen.hdhd V162) (shen.hdtl V162)))) (let Parse_shen. (shen. NewStream153) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd (shen.pair (shen.tlhd V162) (shen.hdtl V162))) (cons cons (cons (shen.hdtl Parse_shen.) (cons (shen.hdtl Parse_shen.) ())))) (fail))) (fail)))) (fail)) (fail)) (if (= YaccParse (fail)) (let YaccParse (if (and (cons? (hd V162)) (cons? (shen.hdhd V162))) (if (and (cons? (hd (shen.pair (shen.hdhd V162) (shen.hdtl V162)))) (= @v (shen.hdhd (shen.pair (shen.hdhd V162) (shen.hdtl V162))))) (let NewStream155 (shen.pair (shen.tlhd (shen.pair (shen.hdhd V162) (shen.hdtl V162))) (shen.hdtl (shen.pair (shen.hdhd V162) (shen.hdtl V162)))) (let Parse_shen. (shen. NewStream155) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd (shen.pair (shen.tlhd V162) (shen.hdtl V162))) (cons @v (cons (shen.hdtl Parse_shen.) (cons (shen.hdtl Parse_shen.) ())))) (fail))) (fail)))) (fail)) (fail)) (if (= YaccParse (fail)) (let YaccParse (if (and (cons? (hd V162)) (cons? (shen.hdhd V162))) (if (and (cons? (hd (shen.pair (shen.hdhd V162) (shen.hdtl V162)))) (= @s (shen.hdhd (shen.pair (shen.hdhd V162) (shen.hdtl V162))))) (let NewStream157 (shen.pair (shen.tlhd (shen.pair (shen.hdhd V162) (shen.hdtl V162))) (shen.hdtl (shen.pair (shen.hdhd V162) (shen.hdtl V162)))) (let Parse_shen. (shen. NewStream157) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd (shen.pair (shen.tlhd V162) (shen.hdtl V162))) (cons @s (cons (shen.hdtl Parse_shen.) (cons (shen.hdtl Parse_shen.) ())))) (fail))) (fail)))) (fail)) (fail)) (if (= YaccParse (fail)) (let YaccParse (if (and (cons? (hd V162)) (cons? (shen.hdhd V162))) (if (and (cons? (hd (shen.pair (shen.hdhd V162) (shen.hdtl V162)))) (= vector (shen.hdhd (shen.pair (shen.hdhd V162) (shen.hdtl V162))))) (let NewStream159 (shen.pair (shen.tlhd (shen.pair (shen.hdhd V162) (shen.hdtl V162))) (shen.hdtl (shen.pair (shen.hdhd V162) (shen.hdtl V162)))) (if (and (cons? (hd NewStream159)) (= 0 (shen.hdhd NewStream159))) (let NewStream160 (shen.pair (shen.tlhd NewStream159) (shen.hdtl NewStream159)) (shen.pair (hd (shen.pair (shen.tlhd V162) (shen.hdtl V162))) (cons vector (cons 0 ())))) (fail))) (fail)) (fail)) (if (= YaccParse (fail)) (let YaccParse (if (cons? (hd V162)) (let Parse_X (shen.hdhd V162) (if (cons? Parse_X) (shen.pair (hd (shen.pair (shen.tlhd V162) (shen.hdtl V162))) (shen.custom-pattern-compiler Parse_X (freeze (shen.constructor-error Parse_X)))) (fail))) (fail)) (if (= YaccParse (fail)) (let Parse_shen. (shen. V162) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.hdtl Parse_shen.)) (fail))) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse))) + +(defun shen.constructor-error (V164) (simple-error (shen.app V164 " is not a legitimate constructor " shen.a))) -(defun shen. (V1327) (let YaccParse (if (cons? (hd V1327)) (let Parse_X (shen.hdhd V1327) (if (= Parse_X _) (shen.pair (hd (shen.pair (shen.tlhd V1327) (shen.hdtl V1327))) (gensym Parse_Y)) (fail))) (fail)) (if (= YaccParse (fail)) (if (cons? (hd V1327)) (let Parse_X (shen.hdhd V1327) (if (not (element? Parse_X (cons -> (cons <- ())))) (shen.pair (hd (shen.pair (shen.tlhd V1327) (shen.hdtl V1327))) Parse_X) (fail))) (fail)) YaccParse))) +(defun shen. (V166) (let YaccParse (if (cons? (hd V166)) (let Parse_X (shen.hdhd V166) (if (= Parse_X _) (shen.pair (hd (shen.pair (shen.tlhd V166) (shen.hdtl V166))) (gensym Parse_Y)) (fail))) (fail)) (if (= YaccParse (fail)) (if (cons? (hd V166)) (let Parse_X (shen.hdhd V166) (if (not (element? Parse_X (cons -> (cons <- ())))) (shen.pair (hd (shen.pair (shen.tlhd V166) (shen.hdtl V166))) Parse_X) (fail))) (fail)) YaccParse))) -(defun shen. (V1329) (let Parse_shen. (shen. V1329) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.hdtl Parse_shen.)) (fail)))) +(defun shen. (V168) (let Parse_shen. (shen. V168) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.hdtl Parse_shen.)) (fail)))) -(defun shen. (V1331) (let Parse_shen. (shen. V1331) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.hdtl Parse_shen.)) (fail)))) +(defun shen. (V170) (let Parse_shen. (shen. V170) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.hdtl Parse_shen.)) (fail)))) -(defun shen. (V1333) (if (cons? (hd V1333)) (let Parse_X (shen.hdhd V1333) (shen.pair (hd (shen.pair (shen.tlhd V1333) (shen.hdtl V1333))) Parse_X)) (fail))) +(defun shen. (V172) (if (cons? (hd V172)) (let Parse_X (shen.hdhd V172) (shen.pair (hd (shen.pair (shen.tlhd V172) (shen.hdtl V172))) Parse_X)) (fail))) -(defun shen. (V1335) (if (cons? (hd V1335)) (let Parse_X (shen.hdhd V1335) (shen.pair (hd (shen.pair (shen.tlhd V1335) (shen.hdtl V1335))) Parse_X)) (fail))) +(defun shen. (V174) (if (cons? (hd V174)) (let Parse_X (shen.hdhd V174) (shen.pair (hd (shen.pair (shen.tlhd V174) (shen.hdtl V174))) Parse_X)) (fail))) -(defun shen.compile_to_machine_code (V1338 V1339) (let Lambda+ (shen.compile_to_lambda+ V1338 V1339) (let KL (shen.compile_to_kl V1338 Lambda+) (let Record (shen.record-source V1338 KL) KL)))) +(defun shen.compile_to_machine_code (V177 V178) (let Lambda+ (shen.compile_to_lambda+ V177 V178) (let KL (shen.compile_to_kl V177 Lambda+) (let Record (shen.record-source V177 KL) KL)))) -(defun shen.record-source (V1344 V1345) (cond ((value shen.*installing-kl*) shen.skip) (true (put V1344 shen.source V1345 (value *property-vector*))))) +(defun shen.record-source (V183 V184) (cond ((value shen.*installing-kl*) shen.skip) (true (put V183 shen.source V184 (value *property-vector*))))) -(defun shen.compile_to_lambda+ (V1348 V1349) (let Arity (shen.aritycheck V1348 V1349) (let UpDateSymbolTable (shen.update-symbol-table V1348 Arity) (let Free (shen.for-each (lambda Rule (shen.free_variable_check V1348 Rule)) V1349) (let Variables (shen.parameters Arity) (let Strip (map (lambda X (shen.strip-protect X)) V1349) (let Abstractions (map (lambda X (shen.abstract_rule X)) Strip) (let Applications (map (lambda X (shen.application_build Variables X)) Abstractions) (cons Variables (cons Applications ())))))))))) +(defun shen.compile_to_lambda+ (V187 V188) (let Arity (shen.aritycheck V187 V188) (let UpDateSymbolTable (shen.update-symbol-table V187 Arity) (let Free (shen.for-each (lambda Rule (shen.free_variable_check V187 Rule)) V188) (let Variables (shen.parameters Arity) (let Strip (map (lambda X (shen.strip-protect X)) V188) (let Abstractions (map (lambda X (shen.abstract_rule X)) Strip) (let Applications (map (lambda X (shen.application_build Variables X)) Abstractions) (cons Variables (cons Applications ())))))))))) -(defun shen.update-symbol-table (V1352 V1353) (cond ((= 0 V1353) shen.skip) (true (put V1352 shen.lambda-form (eval-kl (shen.lambda-form V1352 V1353)) (value *property-vector*))))) +(defun shen.update-symbol-table (V191 V192) (cond ((= 0 V192) shen.skip) (true (put V191 shen.lambda-form (eval-kl (shen.lambda-form V191 V192)) (value *property-vector*))))) -(defun shen.free_variable_check (V1356 V1357) (cond ((and (cons? V1357) (and (cons? (tl V1357)) (= () (tl (tl V1357))))) (let Bound (shen.extract_vars (hd V1357)) (let Free (shen.extract_free_vars Bound (hd (tl V1357))) (shen.free_variable_warnings V1356 Free)))) (true (shen.f_error shen.free_variable_check)))) +(defun shen.free_variable_check (V195 V196) (cond ((and (cons? V196) (and (cons? (tl V196)) (= () (tl (tl V196))))) (let Bound (shen.extract_vars (hd V196)) (let Free (shen.extract_free_vars Bound (hd (tl V196))) (shen.free_variable_warnings V195 Free)))) (true (shen.f_error shen.free_variable_check)))) -(defun shen.extract_vars (V1359) (cond ((variable? V1359) (cons V1359 ())) ((cons? V1359) (union (shen.extract_vars (hd V1359)) (shen.extract_vars (tl V1359)))) (true ()))) +(defun shen.extract_vars (V198) (cond ((variable? V198) (cons V198 ())) ((cons? V198) (union (shen.extract_vars (hd V198)) (shen.extract_vars (tl V198)))) (true ()))) -(defun shen.extract_free_vars (V1371 V1372) (cond ((and (cons? V1372) (and (cons? (tl V1372)) (and (= () (tl (tl V1372))) (= (hd V1372) protect)))) ()) ((and (variable? V1372) (not (element? V1372 V1371))) (cons V1372 ())) ((and (cons? V1372) (and (= lambda (hd V1372)) (and (cons? (tl V1372)) (and (cons? (tl (tl V1372))) (= () (tl (tl (tl V1372)))))))) (shen.extract_free_vars (cons (hd (tl V1372)) V1371) (hd (tl (tl V1372))))) ((and (cons? V1372) (and (= let (hd V1372)) (and (cons? (tl V1372)) (and (cons? (tl (tl V1372))) (and (cons? (tl (tl (tl V1372)))) (= () (tl (tl (tl (tl V1372)))))))))) (union (shen.extract_free_vars V1371 (hd (tl (tl V1372)))) (shen.extract_free_vars (cons (hd (tl V1372)) V1371) (hd (tl (tl (tl V1372))))))) ((cons? V1372) (union (shen.extract_free_vars V1371 (hd V1372)) (shen.extract_free_vars V1371 (tl V1372)))) (true ()))) +(defun shen.extract_free_vars (V210 V211) (cond ((and (cons? V211) (and (cons? (tl V211)) (and (= () (tl (tl V211))) (= (hd V211) protect)))) ()) ((and (variable? V211) (not (element? V211 V210))) (cons V211 ())) ((and (cons? V211) (and (= lambda (hd V211)) (and (cons? (tl V211)) (and (cons? (tl (tl V211))) (= () (tl (tl (tl V211)))))))) (shen.extract_free_vars (cons (hd (tl V211)) V210) (hd (tl (tl V211))))) ((and (cons? V211) (and (= let (hd V211)) (and (cons? (tl V211)) (and (cons? (tl (tl V211))) (and (cons? (tl (tl (tl V211)))) (= () (tl (tl (tl (tl V211)))))))))) (union (shen.extract_free_vars V210 (hd (tl (tl V211)))) (shen.extract_free_vars (cons (hd (tl V211)) V210) (hd (tl (tl (tl V211))))))) ((cons? V211) (union (shen.extract_free_vars V210 (hd V211)) (shen.extract_free_vars V210 (tl V211)))) (true ()))) -(defun shen.free_variable_warnings (V1377 V1378) (cond ((= () V1378) _) (true (simple-error (cn "error: the following variables are free in " (shen.app V1377 (cn ": " (shen.app (shen.list_variables V1378) "" shen.a)) shen.a)))))) +(defun shen.free_variable_warnings (V216 V217) (cond ((= () V217) _) (true (simple-error (cn "error: the following variables are free in " (shen.app V216 (cn ": " (shen.app (shen.list_variables V217) "" shen.a)) shen.a)))))) -(defun shen.list_variables (V1380) (cond ((and (cons? V1380) (= () (tl V1380))) (cn (str (hd V1380)) ".")) ((cons? V1380) (cn (str (hd V1380)) (cn ", " (shen.list_variables (tl V1380))))) (true (shen.f_error shen.list_variables)))) +(defun shen.list_variables (V219) (cond ((and (cons? V219) (= () (tl V219))) (cn (str (hd V219)) ".")) ((cons? V219) (cn (str (hd V219)) (cn ", " (shen.list_variables (tl V219))))) (true (shen.f_error shen.list_variables)))) -(defun shen.strip-protect (V1382) (cond ((and (cons? V1382) (and (cons? (tl V1382)) (and (= () (tl (tl V1382))) (= (hd V1382) protect)))) (shen.strip-protect (hd (tl V1382)))) ((cons? V1382) (map (lambda Z (shen.strip-protect Z)) V1382)) (true V1382))) +(defun shen.strip-protect (V221) (cond ((and (cons? V221) (and (cons? (tl V221)) (and (= () (tl (tl V221))) (= (hd V221) protect)))) (shen.strip-protect (hd (tl V221)))) ((cons? V221) (map (lambda Z (shen.strip-protect Z)) V221)) (true V221))) -(defun shen.linearise (V1384) (cond ((and (cons? V1384) (and (cons? (tl V1384)) (= () (tl (tl V1384))))) (shen.linearise_help (shen.flatten (hd V1384)) (hd V1384) (hd (tl V1384)))) (true (shen.f_error shen.linearise)))) +(defun shen.linearise (V223) (cond ((and (cons? V223) (and (cons? (tl V223)) (= () (tl (tl V223))))) (shen.linearise_help (shen.flatten (hd V223)) (hd V223) (hd (tl V223)))) (true (shen.f_error shen.linearise)))) -(defun shen.flatten (V1386) (cond ((= () V1386) ()) ((cons? V1386) (append (shen.flatten (hd V1386)) (shen.flatten (tl V1386)))) (true (cons V1386 ())))) +(defun shen.flatten (V225) (cond ((= () V225) ()) ((cons? V225) (append (shen.flatten (hd V225)) (shen.flatten (tl V225)))) (true (cons V225 ())))) -(defun shen.linearise_help (V1390 V1391 V1392) (cond ((= () V1390) (cons V1391 (cons V1392 ()))) ((cons? V1390) (if (and (variable? (hd V1390)) (element? (hd V1390) (tl V1390))) (let Var (gensym (hd V1390)) (let NewAction (cons where (cons (cons = (cons (hd V1390) (cons Var ()))) (cons V1392 ()))) (let NewPatts (shen.linearise_X (hd V1390) Var V1391) (shen.linearise_help (tl V1390) NewPatts NewAction)))) (shen.linearise_help (tl V1390) V1391 V1392))) (true (shen.f_error shen.linearise_help)))) +(defun shen.linearise_help (V229 V230 V231) (cond ((= () V229) (cons V230 (cons V231 ()))) ((cons? V229) (if (and (variable? (hd V229)) (element? (hd V229) (tl V229))) (let Var (gensym (hd V229)) (let NewAction (cons where (cons (cons = (cons (hd V229) (cons Var ()))) (cons V231 ()))) (let NewPatts (shen.linearise_X (hd V229) Var V230) (shen.linearise_help (tl V229) NewPatts NewAction)))) (shen.linearise_help (tl V229) V230 V231))) (true (shen.f_error shen.linearise_help)))) -(defun shen.linearise_X (V1405 V1406 V1407) (cond ((= V1407 V1405) V1406) ((cons? V1407) (let L (shen.linearise_X V1405 V1406 (hd V1407)) (if (= L (hd V1407)) (cons (hd V1407) (shen.linearise_X V1405 V1406 (tl V1407))) (cons L (tl V1407))))) (true V1407))) +(defun shen.linearise_X (V244 V245 V246) (cond ((= V246 V244) V245) ((cons? V246) (let L (shen.linearise_X V244 V245 (hd V246)) (if (= L (hd V246)) (cons (hd V246) (shen.linearise_X V244 V245 (tl V246))) (cons L (tl V246))))) (true V246))) -(defun shen.aritycheck (V1410 V1411) (cond ((and (cons? V1411) (and (cons? (hd V1411)) (and (cons? (tl (hd V1411))) (and (= () (tl (tl (hd V1411)))) (= () (tl V1411)))))) (do (shen.aritycheck-action (hd (tl (hd V1411)))) (shen.aritycheck-name V1410 (arity V1410) (length (hd (hd V1411)))))) ((and (cons? V1411) (and (cons? (hd V1411)) (and (cons? (tl (hd V1411))) (and (= () (tl (tl (hd V1411)))) (and (cons? (tl V1411)) (and (cons? (hd (tl V1411))) (and (cons? (tl (hd (tl V1411)))) (= () (tl (tl (hd (tl V1411)))))))))))) (if (= (length (hd (hd V1411))) (length (hd (hd (tl V1411))))) (do (shen.aritycheck-action (hd (tl (hd V1411)))) (shen.aritycheck V1410 (tl V1411))) (simple-error (cn "arity error in " (shen.app V1410 " +(defun shen.aritycheck (V249 V250) (cond ((and (cons? V250) (and (cons? (hd V250)) (and (cons? (tl (hd V250))) (and (= () (tl (tl (hd V250)))) (= () (tl V250)))))) (do (shen.aritycheck-action (hd (tl (hd V250)))) (shen.aritycheck-name V249 (arity V249) (length (hd (hd V250)))))) ((and (cons? V250) (and (cons? (hd V250)) (and (cons? (tl (hd V250))) (and (= () (tl (tl (hd V250)))) (and (cons? (tl V250)) (and (cons? (hd (tl V250))) (and (cons? (tl (hd (tl V250)))) (= () (tl (tl (hd (tl V250)))))))))))) (if (= (length (hd (hd V250))) (length (hd (hd (tl V250))))) (do (shen.aritycheck-action (hd (tl (hd V250)))) (shen.aritycheck V249 (tl V250))) (simple-error (cn "arity error in " (shen.app V249 " " shen.a))))) (true (shen.f_error shen.aritycheck)))) -(defun shen.aritycheck-name (V1424 V1425 V1426) (cond ((= -1 V1425) V1426) ((= V1426 V1425) V1426) (true (do (shen.prhush (cn " -warning: changing the arity of " (shen.app V1424 " can cause errors. -" shen.a)) (stoutput)) V1426)))) +(defun shen.aritycheck-name (V263 V264 V265) (cond ((= -1 V264) V265) ((= V265 V264) V265) (true (do (shen.prhush (cn " +warning: changing the arity of " (shen.app V263 " can cause errors. +" shen.a)) (stoutput)) V265)))) -(defun shen.aritycheck-action (V1432) (cond ((cons? V1432) (do (shen.aah (hd V1432) (tl V1432)) (shen.for-each (lambda Y (shen.aritycheck-action Y)) V1432))) (true shen.skip))) +(defun shen.aritycheck-action (V271) (cond ((cons? V271) (do (shen.aah (hd V271) (tl V271)) (shen.for-each (lambda Y (shen.aritycheck-action Y)) V271))) (true shen.skip))) -(defun shen.aah (V1435 V1436) (let Arity (arity V1435) (let Len (length V1436) (if (and (> Arity -1) (> Len Arity)) (shen.prhush (cn "warning: " (shen.app V1435 (cn " might not like " (shen.app Len (cn " argument" (shen.app (if (> Len 1) "s" "") ". +(defun shen.aah (V274 V275) (let Arity (arity V274) (let Len (length V275) (if (and (> Arity -1) (> Len Arity)) (shen.prhush (cn "warning: " (shen.app V274 (cn " might not like " (shen.app Len (cn " argument" (shen.app (if (> Len 1) "s" "") ". " shen.a)) shen.a)) shen.a)) (stoutput)) shen.skip)))) -(defun shen.abstract_rule (V1438) (cond ((and (cons? V1438) (and (cons? (tl V1438)) (= () (tl (tl V1438))))) (shen.abstraction_build (hd V1438) (hd (tl V1438)))) (true (shen.f_error shen.abstract_rule)))) +(defun shen.abstract_rule (V277) (cond ((and (cons? V277) (and (cons? (tl V277)) (= () (tl (tl V277))))) (shen.abstraction_build (hd V277) (hd (tl V277)))) (true (shen.f_error shen.abstract_rule)))) -(defun shen.abstraction_build (V1441 V1442) (cond ((= () V1441) V1442) ((cons? V1441) (cons /. (cons (hd V1441) (cons (shen.abstraction_build (tl V1441) V1442) ())))) (true (shen.f_error shen.abstraction_build)))) +(defun shen.abstraction_build (V280 V281) (cond ((= () V280) V281) ((cons? V280) (cons /. (cons (hd V280) (cons (shen.abstraction_build (tl V280) V281) ())))) (true (shen.f_error shen.abstraction_build)))) -(defun shen.parameters (V1444) (cond ((= 0 V1444) ()) (true (cons (gensym V) (shen.parameters (- V1444 1)))))) +(defun shen.parameters (V283) (cond ((= 0 V283) ()) (true (cons (gensym V) (shen.parameters (- V283 1)))))) -(defun shen.application_build (V1447 V1448) (cond ((= () V1447) V1448) ((cons? V1447) (shen.application_build (tl V1447) (cons V1448 (cons (hd V1447) ())))) (true (shen.f_error shen.application_build)))) +(defun shen.application_build (V286 V287) (cond ((= () V286) V287) ((cons? V286) (shen.application_build (tl V286) (cons V287 (cons (hd V286) ())))) (true (shen.f_error shen.application_build)))) -(defun shen.compile_to_kl (V1451 V1452) (cond ((and (cons? V1452) (and (cons? (tl V1452)) (= () (tl (tl V1452))))) (let Arity (shen.store-arity V1451 (length (hd V1452))) (let Reduce (map (lambda X (shen.reduce X)) (hd (tl V1452))) (let CondExpression (shen.cond-expression V1451 (hd V1452) Reduce) (let TypeTable (if (value shen.*optimise*) (shen.typextable (shen.get-type V1451) (hd V1452)) shen.skip) (let TypedCondExpression (if (value shen.*optimise*) (shen.assign-types (hd V1452) TypeTable CondExpression) CondExpression) (cons defun (cons V1451 (cons (hd V1452) (cons TypedCondExpression ())))))))))) (true (shen.f_error shen.compile_to_kl)))) +(defun shen.compile_to_kl (V290 V291) (cond ((and (cons? V291) (and (cons? (tl V291)) (= () (tl (tl V291))))) (let Arity (shen.store-arity V290 (length (hd V291))) (let Reduce (map (lambda X (shen.reduce X)) (hd (tl V291))) (let CondExpression (shen.cond-expression V290 (hd V291) Reduce) (let TypeTable (if (value shen.*optimise*) (shen.typextable (shen.get-type V290) (hd V291)) shen.skip) (let TypedCondExpression (if (value shen.*optimise*) (shen.assign-types (hd V291) TypeTable CondExpression) CondExpression) (cons defun (cons V290 (cons (hd V291) (cons TypedCondExpression ())))))))))) (true (shen.f_error shen.compile_to_kl)))) -(defun shen.get-type (V1458) (cond ((cons? V1458) shen.skip) (true (let FType (assoc V1458 (value shen.*signedfuncs*)) (if (empty? FType) shen.skip (tl FType)))))) +(defun shen.get-type (V297) (cond ((cons? V297) shen.skip) (true (let FType (assoc V297 (value shen.*signedfuncs*)) (if (empty? FType) shen.skip (tl FType)))))) -(defun shen.typextable (V1469 V1470) (cond ((and (cons? V1469) (and (cons? (tl V1469)) (and (= --> (hd (tl V1469))) (and (cons? (tl (tl V1469))) (and (= () (tl (tl (tl V1469)))) (cons? V1470)))))) (if (variable? (hd V1469)) (shen.typextable (hd (tl (tl V1469))) (tl V1470)) (cons (cons (hd V1470) (hd V1469)) (shen.typextable (hd (tl (tl V1469))) (tl V1470))))) (true ()))) +(defun shen.typextable (V308 V309) (cond ((and (cons? V308) (and (cons? (tl V308)) (and (= --> (hd (tl V308))) (and (cons? (tl (tl V308))) (and (= () (tl (tl (tl V308)))) (cons? V309)))))) (if (variable? (hd V308)) (shen.typextable (hd (tl (tl V308))) (tl V309)) (cons (cons (hd V309) (hd V308)) (shen.typextable (hd (tl (tl V308))) (tl V309))))) (true ()))) -(defun shen.assign-types (V1474 V1475 V1476) (cond ((and (cons? V1476) (and (= let (hd V1476)) (and (cons? (tl V1476)) (and (cons? (tl (tl V1476))) (and (cons? (tl (tl (tl V1476)))) (= () (tl (tl (tl (tl V1476)))))))))) (cons let (cons (hd (tl V1476)) (cons (shen.assign-types V1474 V1475 (hd (tl (tl V1476)))) (cons (shen.assign-types (cons (hd (tl V1476)) V1474) V1475 (hd (tl (tl (tl V1476))))) ()))))) ((and (cons? V1476) (and (= lambda (hd V1476)) (and (cons? (tl V1476)) (and (cons? (tl (tl V1476))) (= () (tl (tl (tl V1476)))))))) (cons lambda (cons (hd (tl V1476)) (cons (shen.assign-types (cons (hd (tl V1476)) V1474) V1475 (hd (tl (tl V1476)))) ())))) ((and (cons? V1476) (= cond (hd V1476))) (cons cond (map (lambda Y (cons (shen.assign-types V1474 V1475 (hd Y)) (cons (shen.assign-types V1474 V1475 (hd (tl Y))) ()))) (tl V1476)))) ((cons? V1476) (let NewTable (shen.typextable (shen.get-type (hd V1476)) (tl V1476)) (cons (hd V1476) (map (lambda Y (shen.assign-types V1474 (append V1475 NewTable) Y)) (tl V1476))))) (true (let AtomType (assoc V1476 V1475) (if (cons? AtomType) (cons type (cons V1476 (cons (tl AtomType) ()))) (if (element? V1476 V1474) V1476 (shen.atom-type V1476))))))) +(defun shen.assign-types (V313 V314 V315) (cond ((and (cons? V315) (and (= let (hd V315)) (and (cons? (tl V315)) (and (cons? (tl (tl V315))) (and (cons? (tl (tl (tl V315)))) (= () (tl (tl (tl (tl V315)))))))))) (cons let (cons (hd (tl V315)) (cons (shen.assign-types V313 V314 (hd (tl (tl V315)))) (cons (shen.assign-types (cons (hd (tl V315)) V313) V314 (hd (tl (tl (tl V315))))) ()))))) ((and (cons? V315) (and (= lambda (hd V315)) (and (cons? (tl V315)) (and (cons? (tl (tl V315))) (= () (tl (tl (tl V315)))))))) (cons lambda (cons (hd (tl V315)) (cons (shen.assign-types (cons (hd (tl V315)) V313) V314 (hd (tl (tl V315)))) ())))) ((and (cons? V315) (= cond (hd V315))) (cons cond (map (lambda Y (cons (shen.assign-types V313 V314 (hd Y)) (cons (shen.assign-types V313 V314 (hd (tl Y))) ()))) (tl V315)))) ((cons? V315) (let NewTable (shen.typextable (shen.get-type (hd V315)) (tl V315)) (cons (hd V315) (map (lambda Y (shen.assign-types V313 (append V314 NewTable) Y)) (tl V315))))) (true (let AtomType (assoc V315 V314) (if (cons? AtomType) (cons type (cons V315 (cons (tl AtomType) ()))) (if (element? V315 V313) V315 (shen.atom-type V315))))))) -(defun shen.atom-type (V1478) (if (string? V1478) (cons type (cons V1478 (cons string ()))) (if (number? V1478) (cons type (cons V1478 (cons number ()))) (if (boolean? V1478) (cons type (cons V1478 (cons boolean ()))) (if (symbol? V1478) (cons type (cons V1478 (cons symbol ()))) V1478))))) +(defun shen.atom-type (V317) (if (string? V317) (cons type (cons V317 (cons string ()))) (if (number? V317) (cons type (cons V317 (cons number ()))) (if (boolean? V317) (cons type (cons V317 (cons boolean ()))) (if (symbol? V317) (cons type (cons V317 (cons symbol ()))) V317))))) -(defun shen.store-arity (V1483 V1484) (cond ((value shen.*installing-kl*) shen.skip) (true (put V1483 arity V1484 (value *property-vector*))))) +(defun shen.store-arity (V322 V323) (cond ((value shen.*installing-kl*) shen.skip) (true (put V322 arity V323 (value *property-vector*))))) -(defun shen.reduce (V1486) (do (set shen.*teststack* ()) (let Result (shen.reduce_help V1486) (cons (cons : (cons shen.tests (reverse (value shen.*teststack*)))) (cons Result ()))))) +(defun shen.reduce (V325) (do (set shen.*teststack* ()) (let Result (shen.reduce_help V325) (cons (cons : (cons shen.tests (reverse (value shen.*teststack*)))) (cons Result ()))))) -(defun shen.reduce_help (V1488) (cond ((and (cons? V1488) (and (cons? (hd V1488)) (and (= /. (hd (hd V1488))) (and (cons? (tl (hd V1488))) (and (cons? (hd (tl (hd V1488)))) (and (= cons (hd (hd (tl (hd V1488))))) (and (cons? (tl (hd (tl (hd V1488))))) (and (cons? (tl (tl (hd (tl (hd V1488)))))) (and (= () (tl (tl (tl (hd (tl (hd V1488))))))) (and (cons? (tl (tl (hd V1488)))) (and (= () (tl (tl (tl (hd V1488))))) (and (cons? (tl V1488)) (= () (tl (tl V1488))))))))))))))) (do (shen.add_test (cons cons? (tl V1488))) (let Abstraction (cons /. (cons (hd (tl (hd (tl (hd V1488))))) (cons (cons /. (cons (hd (tl (tl (hd (tl (hd V1488)))))) (cons (shen.ebr (hd (tl V1488)) (hd (tl (hd V1488))) (hd (tl (tl (hd V1488))))) ()))) ()))) (let Application (cons (cons Abstraction (cons (cons hd (tl V1488)) ())) (cons (cons tl (tl V1488)) ())) (shen.reduce_help Application))))) ((and (cons? V1488) (and (cons? (hd V1488)) (and (= /. (hd (hd V1488))) (and (cons? (tl (hd V1488))) (and (cons? (hd (tl (hd V1488)))) (and (= @p (hd (hd (tl (hd V1488))))) (and (cons? (tl (hd (tl (hd V1488))))) (and (cons? (tl (tl (hd (tl (hd V1488)))))) (and (= () (tl (tl (tl (hd (tl (hd V1488))))))) (and (cons? (tl (tl (hd V1488)))) (and (= () (tl (tl (tl (hd V1488))))) (and (cons? (tl V1488)) (= () (tl (tl V1488))))))))))))))) (do (shen.add_test (cons tuple? (tl V1488))) (let Abstraction (cons /. (cons (hd (tl (hd (tl (hd V1488))))) (cons (cons /. (cons (hd (tl (tl (hd (tl (hd V1488)))))) (cons (shen.ebr (hd (tl V1488)) (hd (tl (hd V1488))) (hd (tl (tl (hd V1488))))) ()))) ()))) (let Application (cons (cons Abstraction (cons (cons fst (tl V1488)) ())) (cons (cons snd (tl V1488)) ())) (shen.reduce_help Application))))) ((and (cons? V1488) (and (cons? (hd V1488)) (and (= /. (hd (hd V1488))) (and (cons? (tl (hd V1488))) (and (cons? (hd (tl (hd V1488)))) (and (= @v (hd (hd (tl (hd V1488))))) (and (cons? (tl (hd (tl (hd V1488))))) (and (cons? (tl (tl (hd (tl (hd V1488)))))) (and (= () (tl (tl (tl (hd (tl (hd V1488))))))) (and (cons? (tl (tl (hd V1488)))) (and (= () (tl (tl (tl (hd V1488))))) (and (cons? (tl V1488)) (= () (tl (tl V1488))))))))))))))) (do (shen.add_test (cons shen.+vector? (tl V1488))) (let Abstraction (cons /. (cons (hd (tl (hd (tl (hd V1488))))) (cons (cons /. (cons (hd (tl (tl (hd (tl (hd V1488)))))) (cons (shen.ebr (hd (tl V1488)) (hd (tl (hd V1488))) (hd (tl (tl (hd V1488))))) ()))) ()))) (let Application (cons (cons Abstraction (cons (cons hdv (tl V1488)) ())) (cons (cons tlv (tl V1488)) ())) (shen.reduce_help Application))))) ((and (cons? V1488) (and (cons? (hd V1488)) (and (= /. (hd (hd V1488))) (and (cons? (tl (hd V1488))) (and (cons? (hd (tl (hd V1488)))) (and (= @s (hd (hd (tl (hd V1488))))) (and (cons? (tl (hd (tl (hd V1488))))) (and (cons? (tl (tl (hd (tl (hd V1488)))))) (and (= () (tl (tl (tl (hd (tl (hd V1488))))))) (and (cons? (tl (tl (hd V1488)))) (and (= () (tl (tl (tl (hd V1488))))) (and (cons? (tl V1488)) (= () (tl (tl V1488))))))))))))))) (do (shen.add_test (cons shen.+string? (tl V1488))) (let Abstraction (cons /. (cons (hd (tl (hd (tl (hd V1488))))) (cons (cons /. (cons (hd (tl (tl (hd (tl (hd V1488)))))) (cons (shen.ebr (hd (tl V1488)) (hd (tl (hd V1488))) (hd (tl (tl (hd V1488))))) ()))) ()))) (let Application (cons (cons Abstraction (cons (cons pos (cons (hd (tl V1488)) (cons 0 ()))) ())) (cons (cons tlstr (tl V1488)) ())) (shen.reduce_help Application))))) ((and (cons? V1488) (and (cons? (hd V1488)) (and (= /. (hd (hd V1488))) (and (cons? (tl (hd V1488))) (and (cons? (tl (tl (hd V1488)))) (and (= () (tl (tl (tl (hd V1488))))) (and (cons? (tl V1488)) (and (= () (tl (tl V1488))) (not (variable? (hd (tl (hd V1488))))))))))))) (do (shen.add_test (cons = (cons (hd (tl (hd V1488))) (tl V1488)))) (shen.reduce_help (hd (tl (tl (hd V1488))))))) ((and (cons? V1488) (and (cons? (hd V1488)) (and (= /. (hd (hd V1488))) (and (cons? (tl (hd V1488))) (and (cons? (tl (tl (hd V1488)))) (and (= () (tl (tl (tl (hd V1488))))) (and (cons? (tl V1488)) (= () (tl (tl V1488)))))))))) (shen.reduce_help (shen.ebr (hd (tl V1488)) (hd (tl (hd V1488))) (hd (tl (tl (hd V1488))))))) ((and (cons? V1488) (and (= where (hd V1488)) (and (cons? (tl V1488)) (and (cons? (tl (tl V1488))) (= () (tl (tl (tl V1488)))))))) (do (shen.add_test (hd (tl V1488))) (shen.reduce_help (hd (tl (tl V1488)))))) ((and (cons? V1488) (and (cons? (tl V1488)) (= () (tl (tl V1488))))) (let Z (shen.reduce_help (hd V1488)) (if (= (hd V1488) Z) V1488 (shen.reduce_help (cons Z (tl V1488)))))) (true V1488))) +(defun shen.reduce_help (V327) (cond ((and (cons? V327) (and (cons? (hd V327)) (and (= /. (hd (hd V327))) (and (cons? (tl (hd V327))) (and (cons? (hd (tl (hd V327)))) (and (= cons (hd (hd (tl (hd V327))))) (and (cons? (tl (hd (tl (hd V327))))) (and (cons? (tl (tl (hd (tl (hd V327)))))) (and (= () (tl (tl (tl (hd (tl (hd V327))))))) (and (cons? (tl (tl (hd V327)))) (and (= () (tl (tl (tl (hd V327))))) (and (cons? (tl V327)) (= () (tl (tl V327))))))))))))))) (do (shen.add_test (cons cons? (tl V327))) (let Abstraction (cons /. (cons (hd (tl (hd (tl (hd V327))))) (cons (cons /. (cons (hd (tl (tl (hd (tl (hd V327)))))) (cons (shen.ebr (hd (tl V327)) (hd (tl (hd V327))) (hd (tl (tl (hd V327))))) ()))) ()))) (let Application (cons (cons Abstraction (cons (cons hd (tl V327)) ())) (cons (cons tl (tl V327)) ())) (shen.reduce_help Application))))) ((and (cons? V327) (and (cons? (hd V327)) (and (= /. (hd (hd V327))) (and (cons? (tl (hd V327))) (and (cons? (hd (tl (hd V327)))) (and (= @p (hd (hd (tl (hd V327))))) (and (cons? (tl (hd (tl (hd V327))))) (and (cons? (tl (tl (hd (tl (hd V327)))))) (and (= () (tl (tl (tl (hd (tl (hd V327))))))) (and (cons? (tl (tl (hd V327)))) (and (= () (tl (tl (tl (hd V327))))) (and (cons? (tl V327)) (= () (tl (tl V327))))))))))))))) (do (shen.add_test (cons tuple? (tl V327))) (let Abstraction (cons /. (cons (hd (tl (hd (tl (hd V327))))) (cons (cons /. (cons (hd (tl (tl (hd (tl (hd V327)))))) (cons (shen.ebr (hd (tl V327)) (hd (tl (hd V327))) (hd (tl (tl (hd V327))))) ()))) ()))) (let Application (cons (cons Abstraction (cons (cons fst (tl V327)) ())) (cons (cons snd (tl V327)) ())) (shen.reduce_help Application))))) ((and (cons? V327) (and (cons? (hd V327)) (and (= /. (hd (hd V327))) (and (cons? (tl (hd V327))) (and (cons? (hd (tl (hd V327)))) (and (= @v (hd (hd (tl (hd V327))))) (and (cons? (tl (hd (tl (hd V327))))) (and (cons? (tl (tl (hd (tl (hd V327)))))) (and (= () (tl (tl (tl (hd (tl (hd V327))))))) (and (cons? (tl (tl (hd V327)))) (and (= () (tl (tl (tl (hd V327))))) (and (cons? (tl V327)) (= () (tl (tl V327))))))))))))))) (do (shen.add_test (cons shen.+vector? (tl V327))) (let Abstraction (cons /. (cons (hd (tl (hd (tl (hd V327))))) (cons (cons /. (cons (hd (tl (tl (hd (tl (hd V327)))))) (cons (shen.ebr (hd (tl V327)) (hd (tl (hd V327))) (hd (tl (tl (hd V327))))) ()))) ()))) (let Application (cons (cons Abstraction (cons (cons hdv (tl V327)) ())) (cons (cons tlv (tl V327)) ())) (shen.reduce_help Application))))) ((and (cons? V327) (and (cons? (hd V327)) (and (= /. (hd (hd V327))) (and (cons? (tl (hd V327))) (and (cons? (hd (tl (hd V327)))) (and (= @s (hd (hd (tl (hd V327))))) (and (cons? (tl (hd (tl (hd V327))))) (and (cons? (tl (tl (hd (tl (hd V327)))))) (and (= () (tl (tl (tl (hd (tl (hd V327))))))) (and (cons? (tl (tl (hd V327)))) (and (= () (tl (tl (tl (hd V327))))) (and (cons? (tl V327)) (= () (tl (tl V327))))))))))))))) (do (shen.add_test (cons shen.+string? (tl V327))) (let Abstraction (cons /. (cons (hd (tl (hd (tl (hd V327))))) (cons (cons /. (cons (hd (tl (tl (hd (tl (hd V327)))))) (cons (shen.ebr (hd (tl V327)) (hd (tl (hd V327))) (hd (tl (tl (hd V327))))) ()))) ()))) (let Application (cons (cons Abstraction (cons (cons pos (cons (hd (tl V327)) (cons 0 ()))) ())) (cons (cons tlstr (tl V327)) ())) (shen.reduce_help Application))))) ((and (cons? V327) (and (cons? (hd V327)) (and (= /. (hd (hd V327))) (and (cons? (tl (hd V327))) (and (cons? (hd (tl (hd V327)))) (and (= vector (hd (hd (tl (hd V327))))) (and (cons? (tl (hd (tl (hd V327))))) (and (= 0 (hd (tl (hd (tl (hd V327)))))) (and (= () (tl (tl (hd (tl (hd V327)))))) (and (cons? (tl (tl (hd V327)))) (and (= () (tl (tl (tl (hd V327))))) (and (cons? (tl V327)) (= () (tl (tl V327))))))))))))))) (do (shen.add_test (cons vector? (tl V327))) (do (shen.add_test (cons = (cons 0 (cons (cons limit (tl V327)) ())))) (shen.reduce_help (shen.ebr (hd (tl V327)) (hd (tl (hd V327))) (hd (tl (tl (hd V327))))))))) ((and (cons? V327) (and (cons? (hd V327)) (and (= /. (hd (hd V327))) (and (cons? (tl (hd V327))) (and (cons? (hd (tl (hd V327)))) (and (cons? (tl (tl (hd V327)))) (and (= () (tl (tl (tl (hd V327))))) (and (cons? (tl V327)) (= () (tl (tl V327))))))))))) (shen.custom-pattern-reducer V327)) ((and (cons? V327) (and (cons? (hd V327)) (and (= /. (hd (hd V327))) (and (cons? (tl (hd V327))) (and (cons? (tl (tl (hd V327)))) (and (= () (tl (tl (tl (hd V327))))) (and (cons? (tl V327)) (and (= () (tl (tl V327))) (not (variable? (hd (tl (hd V327))))))))))))) (do (shen.add_test (cons = (cons (hd (tl (hd V327))) (tl V327)))) (shen.reduce_help (hd (tl (tl (hd V327))))))) ((and (cons? V327) (and (cons? (hd V327)) (and (= /. (hd (hd V327))) (and (cons? (tl (hd V327))) (and (cons? (tl (tl (hd V327)))) (and (= () (tl (tl (tl (hd V327))))) (and (cons? (tl V327)) (= () (tl (tl V327)))))))))) (shen.reduce_help (shen.ebr (hd (tl V327)) (hd (tl (hd V327))) (hd (tl (tl (hd V327))))))) ((and (cons? V327) (and (= where (hd V327)) (and (cons? (tl V327)) (and (cons? (tl (tl V327))) (= () (tl (tl (tl V327)))))))) (do (shen.add_test (hd (tl V327))) (shen.reduce_help (hd (tl (tl V327)))))) ((and (cons? V327) (and (cons? (tl V327)) (= () (tl (tl V327))))) (let Z (shen.reduce_help (hd V327)) (if (= (hd V327) Z) V327 (shen.reduce_help (cons Z (tl V327)))))) (true V327))) -(defun shen.+string? (V1490) (cond ((= "" V1490) false) (true (string? V1490)))) +(defun shen.+string? (V329) (cond ((= "" V329) false) (true (string? V329)))) -(defun shen.+vector? (V1492) (and (absvector? V1492) (> (<-address V1492 0) 0))) +(defun shen.+vector? (V331) (and (absvector? V331) (> (<-address V331 0) 0))) -(defun shen.ebr (V1505 V1506 V1507) (cond ((= V1507 V1506) V1505) ((and (cons? V1507) (and (= lambda (hd V1507)) (and (cons? (tl V1507)) (and (cons? (tl (tl V1507))) (and (= () (tl (tl (tl V1507)))) (shen.clash? (hd (tl V1507)) V1506)))))) V1507) ((and (cons? V1507) (and (= let (hd V1507)) (and (cons? (tl V1507)) (and (cons? (tl (tl V1507))) (and (cons? (tl (tl (tl V1507)))) (and (= () (tl (tl (tl (tl V1507))))) (shen.clash? (hd (tl V1507)) V1506))))))) (cons let (cons (hd (tl V1507)) (cons (shen.ebr V1505 V1506 (hd (tl (tl V1507)))) (tl (tl (tl V1507))))))) ((cons? V1507) (cons (shen.ebr V1505 V1506 (hd V1507)) (shen.ebr V1505 V1506 (tl V1507)))) (true V1507))) +(defun shen.ebr (V344 V345 V346) (cond ((= V346 V345) V344) ((and (cons? V346) (and (= lambda (hd V346)) (and (cons? (tl V346)) (and (cons? (tl (tl V346))) (and (= () (tl (tl (tl V346)))) (shen.clash? (hd (tl V346)) V345)))))) V346) ((and (cons? V346) (and (= let (hd V346)) (and (cons? (tl V346)) (and (cons? (tl (tl V346))) (and (cons? (tl (tl (tl V346)))) (and (= () (tl (tl (tl (tl V346))))) (shen.clash? (hd (tl V346)) V345))))))) (cons let (cons (hd (tl V346)) (cons (shen.ebr V344 V345 (hd (tl (tl V346)))) (tl (tl (tl V346))))))) ((cons? V346) (cons (shen.ebr V344 V345 (hd V346)) (shen.ebr V344 V345 (tl V346)))) (true V346))) -(defun shen.clash? (V1519 V1520) (cond ((= V1520 V1519) true) ((cons? V1520) (or (shen.clash? V1519 (hd V1520)) (shen.clash? V1519 (tl V1520)))) (true false))) +(defun shen.clash? (V358 V359) (cond ((= V359 V358) true) ((cons? V359) (or (shen.clash? V358 (hd V359)) (shen.clash? V358 (tl V359)))) (true false))) -(defun shen.add_test (V1522) (set shen.*teststack* (cons V1522 (value shen.*teststack*)))) +(defun shen.add_test (V361) (set shen.*teststack* (cons V361 (value shen.*teststack*)))) -(defun shen.cond-expression (V1526 V1527 V1528) (let Err (shen.err-condition V1526) (let Cases (shen.case-form V1528 Err) (let EncodeChoices (shen.encode-choices Cases V1526) (shen.cond-form EncodeChoices))))) +(defun shen.cond-expression (V365 V366 V367) (let Err (shen.err-condition V365) (let Cases (shen.case-form V367 Err) (let EncodeChoices (shen.encode-choices Cases V365) (shen.cond-form EncodeChoices))))) -(defun shen.cond-form (V1532) (cond ((and (cons? V1532) (and (cons? (hd V1532)) (and (= true (hd (hd V1532))) (and (cons? (tl (hd V1532))) (= () (tl (tl (hd V1532)))))))) (hd (tl (hd V1532)))) (true (cons cond V1532)))) +(defun shen.cond-form (V371) (cond ((and (cons? V371) (and (cons? (hd V371)) (and (= true (hd (hd V371))) (and (cons? (tl (hd V371))) (= () (tl (tl (hd V371)))))))) (hd (tl (hd V371)))) (true (cons cond V371)))) -(defun shen.encode-choices (V1537 V1538) (cond ((= () V1537) ()) ((and (cons? V1537) (and (cons? (hd V1537)) (and (= true (hd (hd V1537))) (and (cons? (tl (hd V1537))) (and (cons? (hd (tl (hd V1537)))) (and (= shen.choicepoint! (hd (hd (tl (hd V1537))))) (and (cons? (tl (hd (tl (hd V1537))))) (and (= () (tl (tl (hd (tl (hd V1537)))))) (and (= () (tl (tl (hd V1537)))) (= () (tl V1537))))))))))) (cons (cons true (cons (cons let (cons Result (cons (hd (tl (hd (tl (hd V1537))))) (cons (cons if (cons (cons = (cons Result (cons (cons fail ()) ()))) (cons (if (value shen.*installing-kl*) (cons shen.sys-error (cons V1538 ())) (cons shen.f_error (cons V1538 ()))) (cons Result ())))) ())))) ())) ())) ((and (cons? V1537) (and (cons? (hd V1537)) (and (= true (hd (hd V1537))) (and (cons? (tl (hd V1537))) (and (cons? (hd (tl (hd V1537)))) (and (= shen.choicepoint! (hd (hd (tl (hd V1537))))) (and (cons? (tl (hd (tl (hd V1537))))) (and (= () (tl (tl (hd (tl (hd V1537)))))) (= () (tl (tl (hd V1537)))))))))))) (cons (cons true (cons (cons let (cons Result (cons (hd (tl (hd (tl (hd V1537))))) (cons (cons if (cons (cons = (cons Result (cons (cons fail ()) ()))) (cons (shen.cond-form (shen.encode-choices (tl V1537) V1538)) (cons Result ())))) ())))) ())) ())) ((and (cons? V1537) (and (cons? (hd V1537)) (and (cons? (tl (hd V1537))) (and (cons? (hd (tl (hd V1537)))) (and (= shen.choicepoint! (hd (hd (tl (hd V1537))))) (and (cons? (tl (hd (tl (hd V1537))))) (and (= () (tl (tl (hd (tl (hd V1537)))))) (= () (tl (tl (hd V1537))))))))))) (cons (cons true (cons (cons let (cons Freeze (cons (cons freeze (cons (shen.cond-form (shen.encode-choices (tl V1537) V1538)) ())) (cons (cons if (cons (hd (hd V1537)) (cons (cons let (cons Result (cons (hd (tl (hd (tl (hd V1537))))) (cons (cons if (cons (cons = (cons Result (cons (cons fail ()) ()))) (cons (cons thaw (cons Freeze ())) (cons Result ())))) ())))) (cons (cons thaw (cons Freeze ())) ())))) ())))) ())) ())) ((and (cons? V1537) (and (cons? (hd V1537)) (and (cons? (tl (hd V1537))) (= () (tl (tl (hd V1537))))))) (cons (hd V1537) (shen.encode-choices (tl V1537) V1538))) (true (shen.f_error shen.encode-choices)))) +(defun shen.encode-choices (V376 V377) (cond ((= () V376) ()) ((and (cons? V376) (and (cons? (hd V376)) (and (= true (hd (hd V376))) (and (cons? (tl (hd V376))) (and (cons? (hd (tl (hd V376)))) (and (= shen.choicepoint! (hd (hd (tl (hd V376))))) (and (cons? (tl (hd (tl (hd V376))))) (and (= () (tl (tl (hd (tl (hd V376)))))) (and (= () (tl (tl (hd V376)))) (= () (tl V376))))))))))) (cons (cons true (cons (cons let (cons Result (cons (hd (tl (hd (tl (hd V376))))) (cons (cons if (cons (cons = (cons Result (cons (cons fail ()) ()))) (cons (if (value shen.*installing-kl*) (cons shen.sys-error (cons V377 ())) (cons shen.f_error (cons V377 ()))) (cons Result ())))) ())))) ())) ())) ((and (cons? V376) (and (cons? (hd V376)) (and (= true (hd (hd V376))) (and (cons? (tl (hd V376))) (and (cons? (hd (tl (hd V376)))) (and (= shen.choicepoint! (hd (hd (tl (hd V376))))) (and (cons? (tl (hd (tl (hd V376))))) (and (= () (tl (tl (hd (tl (hd V376)))))) (= () (tl (tl (hd V376)))))))))))) (cons (cons true (cons (cons let (cons Result (cons (hd (tl (hd (tl (hd V376))))) (cons (cons if (cons (cons = (cons Result (cons (cons fail ()) ()))) (cons (shen.cond-form (shen.encode-choices (tl V376) V377)) (cons Result ())))) ())))) ())) ())) ((and (cons? V376) (and (cons? (hd V376)) (and (cons? (tl (hd V376))) (and (cons? (hd (tl (hd V376)))) (and (= shen.choicepoint! (hd (hd (tl (hd V376))))) (and (cons? (tl (hd (tl (hd V376))))) (and (= () (tl (tl (hd (tl (hd V376)))))) (= () (tl (tl (hd V376))))))))))) (cons (cons true (cons (cons let (cons Freeze (cons (cons freeze (cons (shen.cond-form (shen.encode-choices (tl V376) V377)) ())) (cons (cons if (cons (hd (hd V376)) (cons (cons let (cons Result (cons (hd (tl (hd (tl (hd V376))))) (cons (cons if (cons (cons = (cons Result (cons (cons fail ()) ()))) (cons (cons thaw (cons Freeze ())) (cons Result ())))) ())))) (cons (cons thaw (cons Freeze ())) ())))) ())))) ())) ())) ((and (cons? V376) (and (cons? (hd V376)) (and (cons? (tl (hd V376))) (= () (tl (tl (hd V376))))))) (cons (hd V376) (shen.encode-choices (tl V376) V377))) (true (shen.f_error shen.encode-choices)))) -(defun shen.case-form (V1545 V1546) (cond ((= () V1545) (cons V1546 ())) ((and (cons? V1545) (and (cons? (hd V1545)) (and (cons? (hd (hd V1545))) (and (= : (hd (hd (hd V1545)))) (and (cons? (tl (hd (hd V1545)))) (and (= shen.tests (hd (tl (hd (hd V1545))))) (and (= () (tl (tl (hd (hd V1545))))) (and (cons? (tl (hd V1545))) (and (cons? (hd (tl (hd V1545)))) (and (= shen.choicepoint! (hd (hd (tl (hd V1545))))) (and (cons? (tl (hd (tl (hd V1545))))) (and (= () (tl (tl (hd (tl (hd V1545)))))) (= () (tl (tl (hd V1545)))))))))))))))) (cons (cons true (tl (hd V1545))) (shen.case-form (tl V1545) V1546))) ((and (cons? V1545) (and (cons? (hd V1545)) (and (cons? (hd (hd V1545))) (and (= : (hd (hd (hd V1545)))) (and (cons? (tl (hd (hd V1545)))) (and (= shen.tests (hd (tl (hd (hd V1545))))) (and (= () (tl (tl (hd (hd V1545))))) (and (cons? (tl (hd V1545))) (= () (tl (tl (hd V1545)))))))))))) (cons (cons true (tl (hd V1545))) ())) ((and (cons? V1545) (and (cons? (hd V1545)) (and (cons? (hd (hd V1545))) (and (= : (hd (hd (hd V1545)))) (and (cons? (tl (hd (hd V1545)))) (and (= shen.tests (hd (tl (hd (hd V1545))))) (and (cons? (tl (hd V1545))) (= () (tl (tl (hd V1545))))))))))) (cons (cons (shen.embed-and (tl (tl (hd (hd V1545))))) (tl (hd V1545))) (shen.case-form (tl V1545) V1546))) (true (shen.f_error shen.case-form)))) +(defun shen.case-form (V384 V385) (cond ((= () V384) (cons V385 ())) ((and (cons? V384) (and (cons? (hd V384)) (and (cons? (hd (hd V384))) (and (= : (hd (hd (hd V384)))) (and (cons? (tl (hd (hd V384)))) (and (= shen.tests (hd (tl (hd (hd V384))))) (and (= () (tl (tl (hd (hd V384))))) (and (cons? (tl (hd V384))) (and (cons? (hd (tl (hd V384)))) (and (= shen.choicepoint! (hd (hd (tl (hd V384))))) (and (cons? (tl (hd (tl (hd V384))))) (and (= () (tl (tl (hd (tl (hd V384)))))) (= () (tl (tl (hd V384)))))))))))))))) (cons (cons true (tl (hd V384))) (shen.case-form (tl V384) V385))) ((and (cons? V384) (and (cons? (hd V384)) (and (cons? (hd (hd V384))) (and (= : (hd (hd (hd V384)))) (and (cons? (tl (hd (hd V384)))) (and (= shen.tests (hd (tl (hd (hd V384))))) (and (= () (tl (tl (hd (hd V384))))) (and (cons? (tl (hd V384))) (= () (tl (tl (hd V384)))))))))))) (cons (cons true (tl (hd V384))) ())) ((and (cons? V384) (and (cons? (hd V384)) (and (cons? (hd (hd V384))) (and (= : (hd (hd (hd V384)))) (and (cons? (tl (hd (hd V384)))) (and (= shen.tests (hd (tl (hd (hd V384))))) (and (cons? (tl (hd V384))) (= () (tl (tl (hd V384))))))))))) (cons (cons (shen.embed-and (tl (tl (hd (hd V384))))) (tl (hd V384))) (shen.case-form (tl V384) V385))) (true (shen.f_error shen.case-form)))) -(defun shen.embed-and (V1548) (cond ((and (cons? V1548) (= () (tl V1548))) (hd V1548)) ((cons? V1548) (cons and (cons (hd V1548) (cons (shen.embed-and (tl V1548)) ())))) (true (shen.f_error shen.embed-and)))) +(defun shen.embed-and (V387) (cond ((and (cons? V387) (= () (tl V387))) (hd V387)) ((cons? V387) (cons and (cons (hd V387) (cons (shen.embed-and (tl V387)) ())))) (true (shen.f_error shen.embed-and)))) -(defun shen.err-condition (V1550) (cons true (cons (cons shen.f_error (cons V1550 ())) ()))) +(defun shen.err-condition (V389) (cons true (cons (cons shen.f_error (cons V389 ())) ()))) -(defun shen.sys-error (V1552) (simple-error (cn "system function " (shen.app V1552 ": unexpected argument +(defun shen.sys-error (V391) (simple-error (cn "system function " (shen.app V391 ": unexpected argument " shen.a)))) diff --git a/kl/declarations.kl b/kl/declarations.kl index 46b8442..c0eb18e 100644 --- a/kl/declarations.kl +++ b/kl/declarations.kl @@ -28,25 +28,25 @@ OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. " -(defun shen.initialise_arity_table (V1554) (cond ((= () V1554) ()) ((and (cons? V1554) (cons? (tl V1554))) (let DecArity (put (hd V1554) arity (hd (tl V1554)) (value *property-vector*)) (shen.initialise_arity_table (tl (tl V1554))))) (true (shen.f_error shen.initialise_arity_table)))) +(defun shen.initialise_arity_table (V393) (cond ((= () V393) ()) ((and (cons? V393) (cons? (tl V393))) (let DecArity (put (hd V393) arity (hd (tl V393)) (value *property-vector*)) (shen.initialise_arity_table (tl (tl V393))))) (true (shen.f_error shen.initialise_arity_table)))) -(defun arity (V1556) (trap-error (get V1556 arity (value *property-vector*)) (lambda E -1))) +(defun arity (V395) (trap-error (get V395 arity (value *property-vector*)) (lambda E -1))) -(defun systemf (V1558) (let Shen (intern "shen") (let External (get Shen shen.external-symbols (value *property-vector*)) (let Place (put Shen shen.external-symbols (adjoin V1558 External) (value *property-vector*)) V1558)))) +(defun systemf (V397) (let Shen (intern "shen") (let External (get Shen shen.external-symbols (value *property-vector*)) (let Place (put Shen shen.external-symbols (adjoin V397 External) (value *property-vector*)) V397)))) -(defun adjoin (V1561 V1562) (if (element? V1561 V1562) V1562 (cons V1561 V1562))) +(defun adjoin (V400 V401) (if (element? V400 V401) V401 (cons V400 V401))) -(defun shen.lambda-form-entry (V1564) (cond ((= package V1564) ()) ((= receive V1564) ()) (true (let ArityF (arity V1564) (if (= ArityF -1) () (if (= ArityF 0) () (cons (cons V1564 (eval-kl (shen.lambda-form V1564 ArityF))) ()))))))) +(defun shen.lambda-form-entry (V403) (cond ((= package V403) ()) ((= receive V403) ()) (true (let ArityF (arity V403) (if (= ArityF -1) () (if (= ArityF 0) () (cons (cons V403 (eval-kl (shen.lambda-form V403 ArityF))) ()))))))) -(defun shen.lambda-form (V1567 V1568) (cond ((= 0 V1568) V1567) (true (let X (gensym V) (cons lambda (cons X (cons (shen.lambda-form (shen.add-end V1567 X) (- V1568 1)) ()))))))) +(defun shen.lambda-form (V406 V407) (cond ((= 0 V407) V406) (true (let X (gensym V) (cons lambda (cons X (cons (shen.lambda-form (shen.add-end V406 X) (- V407 1)) ()))))))) -(defun shen.add-end (V1571 V1572) (cond ((cons? V1571) (append V1571 (cons V1572 ()))) (true (cons V1571 (cons V1572 ()))))) +(defun shen.add-end (V410 V411) (cond ((cons? V410) (append V410 (cons V411 ()))) (true (cons V410 (cons V411 ()))))) -(defun shen.set-lambda-form-entry (V1574) (cond ((cons? V1574) (put (hd V1574) shen.lambda-form (tl V1574) (value *property-vector*))) (true (shen.f_error shen.set-lambda-form-entry)))) +(defun shen.set-lambda-form-entry (V413) (cond ((cons? V413) (put (hd V413) shen.lambda-form (tl V413) (value *property-vector*))) (true (shen.f_error shen.set-lambda-form-entry)))) -(defun specialise (V1576) (do (set shen.*special* (cons V1576 (value shen.*special*))) V1576)) +(defun specialise (V415) (do (set shen.*special* (cons V415 (value shen.*special*))) V415)) -(defun unspecialise (V1578) (do (set shen.*special* (remove V1578 (value shen.*special*))) V1578)) +(defun unspecialise (V417) (do (set shen.*special* (remove V417 (value shen.*special*))) V417)) diff --git a/kl/dict.kl b/kl/dict.kl index e9de4b9..4165c77 100644 --- a/kl/dict.kl +++ b/kl/dict.kl @@ -28,38 +28,38 @@ OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. " -(defun shen.dict (V3445) (cond ((< V3445 1) (simple-error (cn "invalid initial dict size: " (shen.app V3445 "" shen.s)))) (true (let D (absvector (+ 3 V3445)) (let Tag (address-> D 0 shen.dictionary) (let Capacity (address-> D 1 V3445) (let Count (address-> D 2 0) (let Fill (shen.fillvector D 3 (+ 2 V3445) ()) D)))))))) +(defun shen.dict (V2284) (cond ((< V2284 1) (simple-error (cn "invalid initial dict size: " (shen.app V2284 "" shen.s)))) (true (let D (absvector (+ 3 V2284)) (let Tag (address-> D 0 shen.dictionary) (let Capacity (address-> D 1 V2284) (let Count (address-> D 2 0) (let Fill (shen.fillvector D 3 (+ 2 V2284) ()) D)))))))) -(defun shen.dict? (V3447) (and (absvector? V3447) (= (trap-error (<-address V3447 0) (lambda E shen.not-dictionary)) shen.dictionary))) +(defun shen.dict? (V2286) (and (absvector? V2286) (= (trap-error (<-address V2286 0) (lambda E shen.not-dictionary)) shen.dictionary))) -(defun shen.dict-capacity (V3449) (<-address V3449 1)) +(defun shen.dict-capacity (V2288) (<-address V2288 1)) -(defun shen.dict-count (V3451) (<-address V3451 2)) +(defun shen.dict-count (V2290) (<-address V2290 2)) -(defun shen.dict-count-> (V3454 V3455) (address-> V3454 2 V3455)) +(defun shen.dict-count-> (V2293 V2294) (address-> V2293 2 V2294)) -(defun shen.<-dict-bucket (V3458 V3459) (<-address V3458 (+ 3 V3459))) +(defun shen.<-dict-bucket (V2297 V2298) (<-address V2297 (+ 3 V2298))) -(defun shen.dict-bucket-> (V3463 V3464 V3465) (address-> V3463 (+ 3 V3464) V3465)) +(defun shen.dict-bucket-> (V2302 V2303 V2304) (address-> V2302 (+ 3 V2303) V2304)) -(defun shen.dict-update-count (V3469 V3470 V3471) (let Diff (- (length V3471) (length V3470)) (shen.dict-count-> V3469 (+ Diff (shen.dict-count V3469))))) +(defun shen.dict-update-count (V2308 V2309 V2310) (let Diff (- (length V2310) (length V2309)) (shen.dict-count-> V2308 (+ Diff (shen.dict-count V2308))))) -(defun shen.dict-> (V3475 V3476 V3477) (let N (hash V3476 (shen.dict-capacity V3475)) (let Bucket (shen.<-dict-bucket V3475 N) (let NewBucket (shen.assoc-set V3476 V3477 Bucket) (let Change (shen.dict-bucket-> V3475 N NewBucket) (let Count (shen.dict-update-count V3475 Bucket NewBucket) V3477)))))) +(defun shen.dict-> (V2314 V2315 V2316) (let N (hash V2315 (shen.dict-capacity V2314)) (let Bucket (shen.<-dict-bucket V2314 N) (let NewBucket (shen.assoc-set V2315 V2316 Bucket) (let Change (shen.dict-bucket-> V2314 N NewBucket) (let Count (shen.dict-update-count V2314 Bucket NewBucket) V2316)))))) -(defun shen.<-dict (V3480 V3481) (let N (hash V3481 (shen.dict-capacity V3480)) (let Bucket (shen.<-dict-bucket V3480 N) (let Result (assoc V3481 Bucket) (if (empty? Result) (simple-error (cn "value " (shen.app V3481 " not found in dict +(defun shen.<-dict (V2319 V2320) (let N (hash V2320 (shen.dict-capacity V2319)) (let Bucket (shen.<-dict-bucket V2319 N) (let Result (assoc V2320 Bucket) (if (empty? Result) (simple-error (cn "value " (shen.app V2320 " not found in dict " shen.a))) (tl Result)))))) -(defun shen.dict-rm (V3484 V3485) (let N (hash V3485 (shen.dict-capacity V3484)) (let Bucket (shen.<-dict-bucket V3484 N) (let NewBucket (shen.assoc-rm V3485 Bucket) (let Change (shen.dict-bucket-> V3484 N NewBucket) (let Count (shen.dict-update-count V3484 Bucket NewBucket) V3485)))))) +(defun shen.dict-rm (V2323 V2324) (let N (hash V2324 (shen.dict-capacity V2323)) (let Bucket (shen.<-dict-bucket V2323 N) (let NewBucket (shen.assoc-rm V2324 Bucket) (let Change (shen.dict-bucket-> V2323 N NewBucket) (let Count (shen.dict-update-count V2323 Bucket NewBucket) V2324)))))) -(defun shen.dict-fold (V3489 V3490 V3491) (let Limit (shen.dict-capacity V3490) (shen.dict-fold-h V3489 V3490 V3491 0 Limit))) +(defun shen.dict-fold (V2328 V2329 V2330) (let Limit (shen.dict-capacity V2329) (shen.dict-fold-h V2328 V2329 V2330 0 Limit))) -(defun shen.dict-fold-h (V3498 V3499 V3500 V3501 V3502) (cond ((= V3502 V3501) V3500) (true (let B (shen.<-dict-bucket V3499 V3501) (let Acc (shen.bucket-fold V3498 B V3500) (shen.dict-fold-h V3498 V3499 Acc (+ 1 V3501) V3502)))))) +(defun shen.dict-fold-h (V2337 V2338 V2339 V2340 V2341) (cond ((= V2341 V2340) V2339) (true (let B (shen.<-dict-bucket V2338 V2340) (let Acc (shen.bucket-fold V2337 B V2339) (shen.dict-fold-h V2337 V2338 Acc (+ 1 V2340) V2341)))))) -(defun shen.bucket-fold (V3506 V3507 V3508) (cond ((= () V3507) V3508) ((and (cons? V3507) (cons? (hd V3507))) (V3506 (hd (hd V3507)) (tl (hd V3507)) (shen.bucket-fold V3506 (tl V3507) V3508))) (true (shen.f_error shen.bucket-fold)))) +(defun shen.bucket-fold (V2345 V2346 V2347) (cond ((= () V2346) V2347) ((and (cons? V2346) (cons? (hd V2346))) (V2345 (hd (hd V2346)) (tl (hd V2346)) (shen.bucket-fold V2345 (tl V2346) V2347))) (true (shen.f_error shen.bucket-fold)))) -(defun shen.dict-keys (V3510) (shen.dict-fold (lambda K (lambda _ (lambda Acc (cons K Acc)))) V3510 ())) +(defun shen.dict-keys (V2349) (shen.dict-fold (lambda K (lambda _ (lambda Acc (cons K Acc)))) V2349 ())) -(defun shen.dict-values (V3512) (shen.dict-fold (lambda _ (lambda V (lambda Acc (cons V Acc)))) V3512 ())) +(defun shen.dict-values (V2351) (shen.dict-fold (lambda _ (lambda V (lambda Acc (cons V Acc)))) V2351 ())) diff --git a/kl/extension-expand-dynamic.kl b/kl/extension-expand-dynamic.kl index cfec6ce..d0fff33 100644 --- a/kl/extension-expand-dynamic.kl +++ b/kl/extension-expand-dynamic.kl @@ -3,23 +3,23 @@ BSD 3-Clause License: http://opensource.org/licenses/BSD-3-Clause" (defun shen.x.expand-dynamic.initialise () (do (set shen.x.expand-dynamic.*external-symbols* ()) (set shen.x.expand-dynamic.*arities* ()))) -(defun shen.x.expand-dynamic.expand-dynamic (V6035) (cond ((= () V6035) ()) ((and (cons? V6035) (and (cons? (hd V6035)) (and (= declare (hd (hd V6035))) (and (cons? (tl (hd V6035))) (and (cons? (tl (tl (hd V6035)))) (= () (tl (tl (tl (hd V6035)))))))))) (append (shen.x.expand-dynamic.expand-declare (hd V6035)) (shen.x.expand-dynamic.expand-dynamic (tl V6035)))) ((and (cons? V6035) (and (cons? (hd V6035)) (and (= put (hd (hd V6035))) (and (cons? (tl (hd V6035))) (and (cons? (hd (tl (hd V6035)))) (and (= intern (hd (hd (tl (hd V6035))))) (and (cons? (tl (hd (tl (hd V6035))))) (and (= "shen" (hd (tl (hd (tl (hd V6035)))))) (and (= () (tl (tl (hd (tl (hd V6035)))))) (and (cons? (tl (tl (hd V6035)))) (and (= shen.external-symbols (hd (tl (tl (hd V6035))))) (and (cons? (tl (tl (tl (hd V6035))))) (and (cons? (tl (tl (tl (tl (hd V6035)))))) (= () (tl (tl (tl (tl (tl (hd V6035)))))))))))))))))))) (do (set shen.x.expand-dynamic.*external-symbols* (eval-kl (hd (tl (tl (tl (hd V6035))))))) (cons (hd V6035) (shen.x.expand-dynamic.expand-dynamic (tl V6035))))) ((and (cons? V6035) (and (cons? (hd V6035)) (and (= shen.initialise_arity_table (hd (hd V6035))) (and (cons? (tl (hd V6035))) (= () (tl (tl (hd V6035)))))))) (do (set shen.x.expand-dynamic.*arities* (eval-kl (hd (tl (hd V6035))))) (cons (hd V6035) (shen.x.expand-dynamic.expand-dynamic (tl V6035))))) ((and (cons? V6035) (and (cons? (hd V6035)) (and (= shen.for-each (hd (hd V6035))) (and (cons? (tl (hd V6035))) (and (cons? (hd (tl (hd V6035)))) (and (= lambda (hd (hd (tl (hd V6035))))) (and (cons? (tl (hd (tl (hd V6035))))) (and (cons? (tl (tl (hd (tl (hd V6035)))))) (and (cons? (hd (tl (tl (hd (tl (hd V6035))))))) (and (= shen.set-lambda-form-entry (hd (hd (tl (tl (hd (tl (hd V6035)))))))) (and (cons? (tl (hd (tl (tl (hd (tl (hd V6035)))))))) (and (= () (tl (tl (hd (tl (tl (hd (tl (hd V6035))))))))) (and (= () (tl (tl (tl (hd (tl (hd V6035))))))) (and (cons? (tl (tl (hd V6035)))) (and (= () (tl (tl (tl (hd V6035))))) (= (hd (tl (hd (tl (tl (hd (tl (hd V6035)))))))) (hd (tl (hd (tl (hd V6035))))))))))))))))))))) (append (shen.x.expand-dynamic.expand-lambda-entries (hd (tl (tl (hd V6035))))) (shen.x.expand-dynamic.expand-dynamic (tl V6035)))) ((cons? V6035) (cons (hd V6035) (shen.x.expand-dynamic.expand-dynamic (tl V6035)))) (true (shen.f_error shen.x.expand-dynamic.expand-dynamic)))) +(defun shen.x.expand-dynamic.expand-dynamic (V5077) (cond ((= () V5077) ()) ((and (cons? V5077) (and (cons? (hd V5077)) (and (= declare (hd (hd V5077))) (and (cons? (tl (hd V5077))) (and (cons? (tl (tl (hd V5077)))) (= () (tl (tl (tl (hd V5077)))))))))) (append (shen.x.expand-dynamic.expand-declare (hd V5077)) (shen.x.expand-dynamic.expand-dynamic (tl V5077)))) ((and (cons? V5077) (and (cons? (hd V5077)) (and (= put (hd (hd V5077))) (and (cons? (tl (hd V5077))) (and (cons? (hd (tl (hd V5077)))) (and (= intern (hd (hd (tl (hd V5077))))) (and (cons? (tl (hd (tl (hd V5077))))) (and (= "shen" (hd (tl (hd (tl (hd V5077)))))) (and (= () (tl (tl (hd (tl (hd V5077)))))) (and (cons? (tl (tl (hd V5077)))) (and (= shen.external-symbols (hd (tl (tl (hd V5077))))) (and (cons? (tl (tl (tl (hd V5077))))) (and (cons? (tl (tl (tl (tl (hd V5077)))))) (= () (tl (tl (tl (tl (tl (hd V5077)))))))))))))))))))) (do (set shen.x.expand-dynamic.*external-symbols* (eval-kl (hd (tl (tl (tl (hd V5077))))))) (cons (hd V5077) (shen.x.expand-dynamic.expand-dynamic (tl V5077))))) ((and (cons? V5077) (and (cons? (hd V5077)) (and (= shen.initialise_arity_table (hd (hd V5077))) (and (cons? (tl (hd V5077))) (= () (tl (tl (hd V5077)))))))) (do (set shen.x.expand-dynamic.*arities* (eval-kl (hd (tl (hd V5077))))) (cons (hd V5077) (shen.x.expand-dynamic.expand-dynamic (tl V5077))))) ((and (cons? V5077) (and (cons? (hd V5077)) (and (= shen.for-each (hd (hd V5077))) (and (cons? (tl (hd V5077))) (and (cons? (hd (tl (hd V5077)))) (and (= lambda (hd (hd (tl (hd V5077))))) (and (cons? (tl (hd (tl (hd V5077))))) (and (cons? (tl (tl (hd (tl (hd V5077)))))) (and (cons? (hd (tl (tl (hd (tl (hd V5077))))))) (and (= shen.set-lambda-form-entry (hd (hd (tl (tl (hd (tl (hd V5077)))))))) (and (cons? (tl (hd (tl (tl (hd (tl (hd V5077)))))))) (and (= () (tl (tl (hd (tl (tl (hd (tl (hd V5077))))))))) (and (= () (tl (tl (tl (hd (tl (hd V5077))))))) (and (cons? (tl (tl (hd V5077)))) (and (= () (tl (tl (tl (hd V5077))))) (= (hd (tl (hd (tl (tl (hd (tl (hd V5077)))))))) (hd (tl (hd (tl (hd V5077))))))))))))))))))))) (append (shen.x.expand-dynamic.expand-lambda-entries (hd (tl (tl (hd V5077))))) (shen.x.expand-dynamic.expand-dynamic (tl V5077)))) ((cons? V5077) (cons (hd V5077) (shen.x.expand-dynamic.expand-dynamic (tl V5077)))) (true (shen.f_error shen.x.expand-dynamic.expand-dynamic)))) -(defun shen.x.expand-dynamic.expand-declare (V6037) (cond ((and (cons? V6037) (and (= declare (hd V6037)) (and (cons? (tl V6037)) (and (cons? (tl (tl V6037))) (= () (tl (tl (tl V6037)))))))) (let Eval (eval-kl V6037) (let F* (concat shen.type-signature-of- (hd (tl V6037))) (let KlDef (ps F*) (let RecordSig (cons set (cons shen.*signedfuncs* (cons (cons cons (cons (cons cons (tl V6037)) (cons (cons value (cons shen.*signedfuncs* ())) ()))) ()))) (let RecordLambda (cons shen.set-lambda-form-entry (cons (cons cons (cons F* (cons (shen.lambda-form F* 3) ()))) ())) (cons KlDef (cons RecordSig (cons RecordLambda ()))))))))) (true (shen.f_error shen.x.expand-dynamic.expand-declare)))) +(defun shen.x.expand-dynamic.expand-declare (V5079) (cond ((and (cons? V5079) (and (= declare (hd V5079)) (and (cons? (tl V5079)) (and (cons? (tl (tl V5079))) (= () (tl (tl (tl V5079)))))))) (let Eval (eval-kl V5079) (let F* (concat shen.type-signature-of- (hd (tl V5079))) (let KlDef (ps F*) (let RecordSig (cons set (cons shen.*signedfuncs* (cons (cons cons (cons (cons cons (tl V5079)) (cons (cons value (cons shen.*signedfuncs* ())) ()))) ()))) (let RecordLambda (cons shen.set-lambda-form-entry (cons (cons cons (cons F* (cons (shen.lambda-form F* 3) ()))) ())) (cons KlDef (cons RecordSig (cons RecordLambda ()))))))))) (true (shen.f_error shen.x.expand-dynamic.expand-declare)))) -(defun shen.x.expand-dynamic.expand-lambda-entries (V6040) (cond ((= () V6040) ()) ((and (cons? V6040) (and (= mapcan (hd V6040)) (and (cons? (tl V6040)) (and (cons? (hd (tl V6040))) (and (= lambda (hd (hd (tl V6040)))) (and (cons? (tl (hd (tl V6040)))) (and (cons? (tl (tl (hd (tl V6040))))) (and (cons? (hd (tl (tl (hd (tl V6040)))))) (and (= shen.lambda-form-entry (hd (hd (tl (tl (hd (tl V6040))))))) (and (cons? (tl (hd (tl (tl (hd (tl V6040))))))) (and (= () (tl (tl (hd (tl (tl (hd (tl V6040)))))))) (and (= () (tl (tl (tl (hd (tl V6040)))))) (and (cons? (tl (tl V6040))) (and (cons? (hd (tl (tl V6040)))) (and (= external (hd (hd (tl (tl V6040))))) (and (cons? (tl (hd (tl (tl V6040))))) (and (cons? (hd (tl (hd (tl (tl V6040)))))) (and (= intern (hd (hd (tl (hd (tl (tl V6040))))))) (and (cons? (tl (hd (tl (hd (tl (tl V6040))))))) (and (= "shen" (hd (tl (hd (tl (hd (tl (tl V6040)))))))) (and (= () (tl (tl (hd (tl (hd (tl (tl V6040)))))))) (and (= () (tl (tl (hd (tl (tl V6040)))))) (and (= () (tl (tl (tl V6040)))) (= (hd (tl (hd (tl (tl (hd (tl V6040))))))) (hd (tl (hd (tl V6040)))))))))))))))))))))))))))) (mapcan (lambda F (shen.x.expand-dynamic.expand-lambda-form-entry F)) (value shen.x.expand-dynamic.*external-symbols*))) ((and (cons? V6040) (and (= cons (hd V6040)) (and (cons? (tl V6040)) (and (cons? (hd (tl V6040))) (and (= cons (hd (hd (tl V6040)))) (and (cons? (tl (hd (tl V6040)))) (and (cons? (tl (tl (hd (tl V6040))))) (and (= () (tl (tl (tl (hd (tl V6040)))))) (and (cons? (tl (tl V6040))) (= () (tl (tl (tl V6040))))))))))))) (cons (cons shen.set-lambda-form-entry (cons (hd (tl V6040)) ())) (shen.x.expand-dynamic.expand-lambda-entries (hd (tl (tl V6040)))))) (true (shen.f_error shen.x.expand-dynamic.expand-lambda-entries)))) +(defun shen.x.expand-dynamic.expand-lambda-entries (V5082) (cond ((= () V5082) ()) ((and (cons? V5082) (and (= mapcan (hd V5082)) (and (cons? (tl V5082)) (and (cons? (hd (tl V5082))) (and (= lambda (hd (hd (tl V5082)))) (and (cons? (tl (hd (tl V5082)))) (and (cons? (tl (tl (hd (tl V5082))))) (and (cons? (hd (tl (tl (hd (tl V5082)))))) (and (= shen.lambda-form-entry (hd (hd (tl (tl (hd (tl V5082))))))) (and (cons? (tl (hd (tl (tl (hd (tl V5082))))))) (and (= () (tl (tl (hd (tl (tl (hd (tl V5082)))))))) (and (= () (tl (tl (tl (hd (tl V5082)))))) (and (cons? (tl (tl V5082))) (and (cons? (hd (tl (tl V5082)))) (and (= external (hd (hd (tl (tl V5082))))) (and (cons? (tl (hd (tl (tl V5082))))) (and (cons? (hd (tl (hd (tl (tl V5082)))))) (and (= intern (hd (hd (tl (hd (tl (tl V5082))))))) (and (cons? (tl (hd (tl (hd (tl (tl V5082))))))) (and (= "shen" (hd (tl (hd (tl (hd (tl (tl V5082)))))))) (and (= () (tl (tl (hd (tl (hd (tl (tl V5082)))))))) (and (= () (tl (tl (hd (tl (tl V5082)))))) (and (= () (tl (tl (tl V5082)))) (= (hd (tl (hd (tl (tl (hd (tl V5082))))))) (hd (tl (hd (tl V5082)))))))))))))))))))))))))))) (mapcan (lambda F (shen.x.expand-dynamic.expand-lambda-form-entry F)) (value shen.x.expand-dynamic.*external-symbols*))) ((and (cons? V5082) (and (= cons (hd V5082)) (and (cons? (tl V5082)) (and (cons? (hd (tl V5082))) (and (= cons (hd (hd (tl V5082)))) (and (cons? (tl (hd (tl V5082)))) (and (cons? (tl (tl (hd (tl V5082))))) (and (= () (tl (tl (tl (hd (tl V5082)))))) (and (cons? (tl (tl V5082))) (= () (tl (tl (tl V5082))))))))))))) (cons (cons shen.set-lambda-form-entry (cons (hd (tl V5082)) ())) (shen.x.expand-dynamic.expand-lambda-entries (hd (tl (tl V5082)))))) (true (shen.f_error shen.x.expand-dynamic.expand-lambda-entries)))) -(defun shen.x.expand-dynamic.get-arity (V6052 V6053) (cond ((= () V6053) -1) ((and (cons? V6053) (and (cons? (tl V6053)) (= (hd V6053) V6052))) (hd (tl V6053))) ((and (cons? V6053) (cons? (tl V6053))) (shen.x.expand-dynamic.get-arity V6052 (tl (tl V6053)))) (true (shen.f_error shen.x.expand-dynamic.get-arity)))) +(defun shen.x.expand-dynamic.get-arity (V5094 V5095) (cond ((= () V5095) -1) ((and (cons? V5095) (and (cons? (tl V5095)) (= (hd V5095) V5094))) (hd (tl V5095))) ((and (cons? V5095) (cons? (tl V5095))) (shen.x.expand-dynamic.get-arity V5094 (tl (tl V5095)))) (true (shen.f_error shen.x.expand-dynamic.get-arity)))) -(defun shen.x.expand-dynamic.expand-lambda-form-entry (V6055) (cond ((= package V6055) ()) ((= receive V6055) ()) (true (let ArityF (shen.x.expand-dynamic.get-arity V6055 (value shen.x.expand-dynamic.*arities*)) (if (= ArityF -1) () (if (= ArityF 0) () (cons (cons shen.set-lambda-form-entry (cons (cons cons (cons V6055 (cons (shen.lambda-form V6055 ArityF) ()))) ())) ()))))))) +(defun shen.x.expand-dynamic.expand-lambda-form-entry (V5097) (cond ((= package V5097) ()) ((= receive V5097) ()) (true (let ArityF (shen.x.expand-dynamic.get-arity V5097 (value shen.x.expand-dynamic.*arities*)) (if (= ArityF -1) () (if (= ArityF 0) () (cons (cons shen.set-lambda-form-entry (cons (cons cons (cons V5097 (cons (shen.lambda-form V5097 ArityF) ()))) ())) ()))))))) -(defun shen.x.expand-dynamic.split-defuns-h (V6058 V6059) (cond ((and (cons? V6058) (and (cons? (hd V6058)) (and (= defun (hd (hd V6058))) (tuple? V6059)))) (shen.x.expand-dynamic.split-defuns-h (tl V6058) (@p (cons (hd V6058) (fst V6059)) (snd V6059)))) ((and (cons? V6058) (tuple? V6059)) (shen.x.expand-dynamic.split-defuns-h (tl V6058) (@p (fst V6059) (cons (hd V6058) (snd V6059))))) ((and (= () V6058) (tuple? V6059)) (@p (reverse (fst V6059)) (reverse (snd V6059)))) (true (shen.f_error shen.x.expand-dynamic.split-defuns-h)))) +(defun shen.x.expand-dynamic.split-defuns-h (V5100 V5101) (cond ((and (cons? V5100) (and (cons? (hd V5100)) (and (= defun (hd (hd V5100))) (tuple? V5101)))) (shen.x.expand-dynamic.split-defuns-h (tl V5100) (@p (cons (hd V5100) (fst V5101)) (snd V5101)))) ((and (cons? V5100) (tuple? V5101)) (shen.x.expand-dynamic.split-defuns-h (tl V5100) (@p (fst V5101) (cons (hd V5100) (snd V5101))))) ((and (= () V5100) (tuple? V5101)) (@p (reverse (fst V5101)) (reverse (snd V5101)))) (true (shen.f_error shen.x.expand-dynamic.split-defuns-h)))) -(defun shen.x.expand-dynamic.split-defuns (V6061) (shen.x.expand-dynamic.split-defuns-h V6061 (@p () ()))) +(defun shen.x.expand-dynamic.split-defuns (V5103) (shen.x.expand-dynamic.split-defuns-h V5103 (@p () ()))) -(defun shen.x.expand-dynamic.wrap-in-defun (V6065 V6066 V6067) (cons defun (cons V6065 (cons V6066 (cons (shen.x.expand-dynamic.to-single-expression V6067) ()))))) +(defun shen.x.expand-dynamic.wrap-in-defun (V5107 V5108 V5109) (cons defun (cons V5107 (cons V5108 (cons (shen.x.expand-dynamic.to-single-expression V5109) ()))))) -(defun shen.x.expand-dynamic.to-single-expression (V6069) (cond ((and (cons? V6069) (= () (tl V6069))) (hd V6069)) ((cons? V6069) (cons do (cons (hd V6069) (cons (shen.x.expand-dynamic.to-single-expression (tl V6069)) ())))) (true (shen.f_error shen.x.expand-dynamic.to-single-expression)))) +(defun shen.x.expand-dynamic.to-single-expression (V5111) (cond ((and (cons? V5111) (= () (tl V5111))) (hd V5111)) ((cons? V5111) (cons do (cons (hd V5111) (cons (shen.x.expand-dynamic.to-single-expression (tl V5111)) ())))) (true (shen.f_error shen.x.expand-dynamic.to-single-expression)))) diff --git a/kl/extension-factorise-defun.kl b/kl/extension-factorise-defun.kl new file mode 100644 index 0000000..9845cf9 --- /dev/null +++ b/kl/extension-factorise-defun.kl @@ -0,0 +1,56 @@ +"Copyright (c) 2012-2019 Bruno Deferrari. All rights reserved. +BSD 3-Clause License: http://opensource.org/licenses/BSD-3-Clause" + +(defun shen.x.factorise-defun.factorise-defun (V4873) (cond ((and (cons? V4873) (and (= defun (hd V4873)) (and (cons? (tl V4873)) (and (cons? (tl (tl V4873))) (and (cons? (tl (tl (tl V4873)))) (and (cons? (hd (tl (tl (tl V4873))))) (and (= cond (hd (hd (tl (tl (tl V4873)))))) (= () (tl (tl (tl (tl V4873)))))))))))) (cons defun (cons (hd (tl V4873)) (cons (hd (tl (tl V4873))) (cons (shen.x.factorise-defun.factorise-cond (hd (tl (tl (tl V4873)))) (cons shen.f_error (cons (hd (tl V4873)) ())) (hd (tl (tl V4873)))) ()))))) (true V4873))) + +(defun shen.x.factorise-defun.factorise-cond (V4885 V4886 V4887) (cond ((and (cons? V4885) (= cond (hd V4885))) (shen.x.factorise-defun.inline-mono-labels (shen.x.factorise-defun.rebranch (shen.x.factorise-defun.add-returns (tl V4885)) V4886) V4887)) (true V4885))) + +(defun shen.x.factorise-defun.add-returns (V4889) (cond ((= () V4889) ()) ((and (cons? V4889) (and (cons? (hd V4889)) (and (cons? (tl (hd V4889))) (= () (tl (tl (hd V4889))))))) (cons (cons (hd (hd V4889)) (cons (cons %%return (tl (hd V4889))) ())) (shen.x.factorise-defun.add-returns (tl V4889)))) (true (shen.f_error shen.x.factorise-defun.add-returns)))) + +(defun shen.x.factorise-defun.generate-label () (gensym %%label)) + +(defun shen.x.factorise-defun.free-variables (V4892 V4893) (reverse (shen.x.factorise-defun.free-variables-h V4892 V4893 ()))) + +(defun shen.x.factorise-defun.free-variables-h (V4905 V4906 V4907) (cond ((and (cons? V4905) (and (= let (hd V4905)) (and (cons? (tl V4905)) (and (cons? (tl (tl V4905))) (and (cons? (tl (tl (tl V4905)))) (= () (tl (tl (tl (tl V4905)))))))))) (shen.x.factorise-defun.free-variables-h (hd (tl (tl (tl V4905)))) (remove (hd (tl V4905)) V4906) (shen.x.factorise-defun.free-variables-h (hd (tl (tl V4905))) V4906 V4907))) ((and (cons? V4905) (and (= lambda (hd V4905)) (and (cons? (tl V4905)) (and (cons? (tl (tl V4905))) (= () (tl (tl (tl V4905)))))))) (shen.x.factorise-defun.free-variables-h (hd (tl (tl V4905))) (remove (hd (tl V4905)) V4906) V4907)) ((cons? V4905) (shen.x.factorise-defun.free-variables-h (tl V4905) V4906 (shen.x.factorise-defun.free-variables-h (hd V4905) V4906 V4907))) ((element? V4905 V4906) (adjoin V4905 V4907)) (true V4907))) + +(defun shen.x.factorise-defun.attach-free-variables (V4910 V4911) (cond ((and (cons? V4910) (and (= %%let-label (hd V4910)) (and (cons? (tl V4910)) (and (cons? (tl (tl V4910))) (and (cons? (tl (tl (tl V4910)))) (= () (tl (tl (tl (tl V4910)))))))))) (let FreeVars (shen.x.factorise-defun.free-variables (hd (tl (tl V4910))) V4911) (let NewBody (if (= () FreeVars) (hd (tl (tl (tl V4910)))) (subst (cons %%goto-label (cons (hd (tl V4910)) FreeVars)) (cons %%goto-label (cons (hd (tl V4910)) ())) (hd (tl (tl (tl V4910)))))) (cons %%let-label (cons (cons (hd (tl V4910)) FreeVars) (cons (hd (tl (tl V4910))) (cons (shen.x.factorise-defun.inline-mono-labels NewBody V4911) ()))))))) (true (shen.f_error shen.x.factorise-defun.attach-free-variables)))) + +(defun shen.x.factorise-defun.inline-mono-labels (V4918 V4919) (cond ((and (cons? V4918) (and (= %%let-label (hd V4918)) (and (cons? (tl V4918)) (and (cons? (tl (tl V4918))) (and (cons? (tl (tl (tl V4918)))) (and (= () (tl (tl (tl (tl V4918))))) (> (occurrences (cons %%goto-label (cons (hd (tl V4918)) ())) (hd (tl (tl (tl V4918))))) 1))))))) (shen.x.factorise-defun.attach-free-variables (cons %%let-label (cons (hd (tl V4918)) (cons (shen.x.factorise-defun.inline-mono-labels (hd (tl (tl V4918))) V4919) (tl (tl (tl V4918)))))) V4919)) ((and (cons? V4918) (and (= %%let-label (hd V4918)) (and (cons? (tl V4918)) (and (cons? (tl (tl V4918))) (and (cons? (tl (tl (tl V4918)))) (= () (tl (tl (tl (tl V4918)))))))))) (subst (shen.x.factorise-defun.inline-mono-labels (hd (tl (tl V4918))) V4919) (cons %%goto-label (cons (hd (tl V4918)) ())) (shen.x.factorise-defun.inline-mono-labels (hd (tl (tl (tl V4918)))) V4919))) ((and (cons? V4918) (and (= if (hd V4918)) (and (cons? (tl V4918)) (and (cons? (tl (tl V4918))) (and (cons? (tl (tl (tl V4918)))) (= () (tl (tl (tl (tl V4918)))))))))) (cons if (cons (hd (tl V4918)) (cons (shen.x.factorise-defun.inline-mono-labels (hd (tl (tl V4918))) V4919) (cons (shen.x.factorise-defun.inline-mono-labels (hd (tl (tl (tl V4918)))) V4919) ()))))) ((and (cons? V4918) (and (= let (hd V4918)) (and (cons? (tl V4918)) (and (cons? (tl (tl V4918))) (and (cons? (tl (tl (tl V4918)))) (= () (tl (tl (tl (tl V4918)))))))))) (cons let (cons (hd (tl V4918)) (cons (hd (tl (tl V4918))) (cons (shen.x.factorise-defun.inline-mono-labels (hd (tl (tl (tl V4918)))) (cons (hd (tl V4918)) V4919)) ()))))) (true V4918))) + +(defun shen.x.factorise-defun.rebranch (V4926 V4927) (cond ((= () V4926) V4927) ((and (cons? V4926) (and (cons? (hd V4926)) (and (= true (hd (hd V4926))) (and (cons? (tl (hd V4926))) (= () (tl (tl (hd V4926)))))))) (hd (tl (hd V4926)))) ((and (cons? V4926) (and (cons? (hd V4926)) (and (cons? (hd (hd V4926))) (and (= and (hd (hd (hd V4926)))) (and (cons? (tl (hd (hd V4926)))) (and (cons? (tl (tl (hd (hd V4926))))) (and (= () (tl (tl (tl (hd (hd V4926)))))) (and (cons? (tl (hd V4926))) (= () (tl (tl (hd V4926)))))))))))) (let TrueBranch (shen.x.factorise-defun.true-branch (hd (tl (hd (hd V4926)))) V4926) (let FalseBranch (shen.x.factorise-defun.false-branch (hd (tl (hd (hd V4926)))) V4926) (shen.x.factorise-defun.rebranch-h (hd (tl (hd (hd V4926)))) TrueBranch FalseBranch V4927)))) ((and (cons? V4926) (and (cons? (hd V4926)) (and (cons? (tl (hd V4926))) (= () (tl (tl (hd V4926))))))) (let TrueBranch (shen.x.factorise-defun.true-branch (hd (hd V4926)) V4926) (let FalseBranch (shen.x.factorise-defun.false-branch (hd (hd V4926)) V4926) (shen.x.factorise-defun.rebranch-h (hd (hd V4926)) TrueBranch FalseBranch V4927)))) (true (shen.f_error shen.x.factorise-defun.rebranch)))) + +(defun shen.x.factorise-defun.rebranch-h (V4932 V4933 V4934 V4935) (let NewElse (shen.x.factorise-defun.rebranch V4934 V4935) (shen.x.factorise-defun.with-labelled-else NewElse (lambda GotoElse (shen.x.factorise-defun.merge-same-else-ifs (cons if (cons V4932 (cons (shen.x.factorise-defun.optimize-selectors V4932 (shen.x.factorise-defun.rebranch V4933 GotoElse)) (cons GotoElse ()))))))))) + +(defun shen.x.factorise-defun.true-branch (V4948 V4949) (cond ((and (cons? V4949) (and (cons? (hd V4949)) (and (cons? (hd (hd V4949))) (and (= and (hd (hd (hd V4949)))) (and (cons? (tl (hd (hd V4949)))) (and (cons? (tl (tl (hd (hd V4949))))) (and (= () (tl (tl (tl (hd (hd V4949)))))) (and (cons? (tl (hd V4949))) (and (= () (tl (tl (hd V4949)))) (= (hd (tl (hd (hd V4949)))) V4948)))))))))) (cons (cons (hd (tl (tl (hd (hd V4949))))) (tl (hd V4949))) (shen.x.factorise-defun.true-branch (hd (tl (hd (hd V4949)))) (tl V4949)))) ((and (cons? V4949) (and (cons? (hd V4949)) (and (cons? (tl (hd V4949))) (and (= () (tl (tl (hd V4949)))) (= (hd (hd V4949)) V4948))))) (cons (cons true (tl (hd V4949))) ())) (true ()))) + +(defun shen.x.factorise-defun.false-branch (V4958 V4959) (cond ((and (cons? V4959) (and (cons? (hd V4959)) (and (cons? (hd (hd V4959))) (and (= and (hd (hd (hd V4959)))) (and (cons? (tl (hd (hd V4959)))) (and (cons? (tl (tl (hd (hd V4959))))) (and (= () (tl (tl (tl (hd (hd V4959)))))) (and (cons? (tl (hd V4959))) (and (= () (tl (tl (hd V4959)))) (= (hd (tl (hd (hd V4959)))) V4958)))))))))) (shen.x.factorise-defun.false-branch (hd (tl (hd (hd V4959)))) (tl V4959))) ((and (cons? V4959) (and (cons? (hd V4959)) (and (cons? (tl (hd V4959))) (and (= () (tl (tl (hd V4959)))) (= (hd (hd V4959)) V4958))))) (shen.x.factorise-defun.false-branch (hd (hd V4959)) (tl V4959))) (true V4959))) + +(defun shen.x.factorise-defun.with-labelled-else (V4962 V4963) (cond ((and (cons? V4962) (and (= %%return (hd V4962)) (and (cons? (tl V4962)) (and (= () (tl (tl V4962))) (not (cons? (hd (tl V4962)))))))) (V4963 V4962)) ((and (cons? V4962) (and (= fail (hd V4962)) (= () (tl V4962)))) (V4963 V4962)) ((and (cons? V4962) (and (= %%goto-label (hd V4962)) (and (cons? (tl V4962)) (= () (tl (tl V4962)))))) (V4963 V4962)) (true (let Label (shen.x.factorise-defun.generate-label) (cons %%let-label (cons Label (cons V4962 (cons (V4963 (cons %%goto-label (cons Label ()))) ())))))))) + +(defun shen.x.factorise-defun.merge-same-else-ifs (V4966) (cond ((and (cons? V4966) (and (= if (hd V4966)) (and (cons? (tl V4966)) (and (cons? (tl (tl V4966))) (and (cons? (hd (tl (tl V4966)))) (and (= if (hd (hd (tl (tl V4966))))) (and (cons? (tl (hd (tl (tl V4966))))) (and (cons? (tl (tl (hd (tl (tl V4966)))))) (and (cons? (tl (tl (tl (hd (tl (tl V4966))))))) (and (= () (tl (tl (tl (tl (hd (tl (tl V4966)))))))) (and (cons? (tl (tl (tl V4966)))) (and (= () (tl (tl (tl (tl V4966))))) (= (hd (tl (tl (tl V4966)))) (hd (tl (tl (tl (hd (tl (tl V4966)))))))))))))))))))) (cons if (cons (cons and (cons (hd (tl V4966)) (cons (hd (tl (hd (tl (tl V4966))))) ()))) (cons (hd (tl (tl (hd (tl (tl V4966)))))) (tl (tl (tl V4966))))))) (true V4966))) + +(defun shen.x.factorise-defun.concat/ (V4969 V4970) (concat V4969 (concat / V4970))) + +(defun shen.x.factorise-defun.exp-var (V4974) (cond ((and (cons? V4974) (and (cons? (tl V4974)) (and (= () (tl (tl V4974))) (symbol? (hd V4974))))) (shen.x.factorise-defun.concat/ (shen.x.factorise-defun.exp-var (hd (tl V4974))) (hd V4974))) ((cons? V4974) (gensym (hd V4974))) (true V4974))) + +(defun shen.x.factorise-defun.optimize-selectors (V4977 V4978) (shen.x.factorise-defun.bind-repeating-selectors (shen.x.factorise-defun.test->selectors V4977) V4978)) + +(defun shen.x.factorise-defun.test->selectors (V4984) (cond ((and (cons? V4984) (and (= cons? (hd V4984)) (and (cons? (tl V4984)) (= () (tl (tl V4984)))))) (cons (cons hd (tl V4984)) (cons (cons tl (tl V4984)) ()))) ((and (cons? V4984) (and (= tuple? (hd V4984)) (and (cons? (tl V4984)) (= () (tl (tl V4984)))))) (cons (cons fst (tl V4984)) (cons (cons snd (tl V4984)) ()))) ((and (cons? V4984) (and (= shen.+string? (hd V4984)) (and (cons? (tl V4984)) (= () (tl (tl V4984)))))) (cons (cons hdstr (tl V4984)) (cons (cons tlstr (tl V4984)) ()))) ((and (cons? V4984) (and (= shen.+vector? (hd V4984)) (and (cons? (tl V4984)) (= () (tl (tl V4984)))))) (cons (cons hdv (tl V4984)) (cons (cons tlv (tl V4984)) ()))) (true (let Result (shen.x.factorise-defun.apply-selector-handlers (value shen.x.factorise-defun.*selector-handlers*) V4984) (if (= Result (fail)) () Result))))) + +(defun shen.x.factorise-defun.bind-repeating-selectors (V4987 V4988) (cond ((cons? V4987) (shen.x.factorise-defun.bind-selector (hd V4987) (shen.x.factorise-defun.bind-repeating-selectors (tl V4987) V4988))) ((= () V4987) V4988) (true (shen.f_error shen.x.factorise-defun.bind-repeating-selectors)))) + +(defun shen.x.factorise-defun.bind-selector (V4995 V4996) (cond ((> (occurrences V4995 V4996) 1) (let Var (shen.x.factorise-defun.exp-var V4995) (cons let (cons Var (cons V4995 (cons (subst Var V4995 V4996) ())))))) (true V4996))) + +(defun shen.x.factorise-defun.apply-selector-handlers (V5009 V5010) (cond ((= () V5009) (fail)) (true (let Freeze (freeze (cond ((cons? V5009) (shen.x.factorise-defun.apply-selector-handlers (tl V5009) V5010)) (true (shen.f_error shen.x.factorise-defun.apply-selector-handlers)))) (if (cons? V5009) (let Result ((hd V5009) V5010) (if (= Result (fail)) (thaw Freeze) Result)) (thaw Freeze)))))) + +(defun shen.x.factorise-defun.initialise () (do (set shen.x.factorise-defun.*selector-handlers* ()) (do (set shen.x.factorise-defun.*selector-handlers-reg* ()) shen.x.factorise-defun.done))) + +(defun shen.x.factorise-defun.register-selector-handler (V5012) (cond ((element? V5012 (value shen.x.factorise-defun.*selector-handlers*)) V5012) (true (do (set shen.x.factorise-defun.*selector-handlers-reg* (cons V5012 (value shen.x.factorise-defun.*selector-handlers*))) (do (set shen.x.factorise-defun.*selector-handlers* (cons (function V5012) (value shen.x.factorise-defun.*selector-handlers*))) V5012))))) + +(defun shen.x.factorise-defun.findpos (V5015 V5016) (trap-error (shen.findpos V5015 V5016) (lambda _ (simple-error (shen.app V5015 " is not a selector handler +" shen.a))))) + +(defun shen.x.factorise-defun.unregister-selector-handler (V5018) (let Reg (value shen.x.factorise-defun.*selector-handlers-reg*) (let Pos (shen.x.factorise-defun.findpos V5018 Reg) (let RemoveReg (set shen.x.factorise-defun.*selector-handlers-reg* (remove V5018 Reg)) (let RemoveFun (set shen.x.factorise-defun.*selector-handlers* (shen.remove-nth Pos (value shen.x.factorise-defun.*selector-handlers*))) V5018))))) + + + diff --git a/kl/extension-features.kl b/kl/extension-features.kl index 1758b3c..17946c5 100644 --- a/kl/extension-features.kl +++ b/kl/extension-features.kl @@ -1,13 +1,13 @@ "Copyright (c) 2019 Bruno Deferrari. BSD 3-Clause License: http://opensource.org/licenses/BSD-3-Clause" -(defun shen.x.features.cond-expand-macro (V5988) (cond ((and (cons? V5988) (and (= shen.x.features.cond-expand (hd V5988)) (= () (tl V5988)))) (simple-error "Unfulfilled shen.x.features.cond-expand clause.")) ((and (cons? V5988) (and (= shen.x.features.cond-expand (hd V5988)) (and (cons? (tl V5988)) (and (= true (hd (tl V5988))) (and (cons? (tl (tl V5988))) (= () (tl (tl (tl V5988))))))))) (hd (tl (tl V5988)))) ((and (cons? V5988) (and (= shen.x.features.cond-expand (hd V5988)) (and (cons? (tl V5988)) (and (cons? (hd (tl V5988))) (and (= and (hd (hd (tl V5988)))) (and (= () (tl (hd (tl V5988)))) (cons? (tl (tl V5988))))))))) (hd (tl (tl V5988)))) ((and (cons? V5988) (and (= shen.x.features.cond-expand (hd V5988)) (and (cons? (tl V5988)) (and (cons? (hd (tl V5988))) (and (= and (hd (hd (tl V5988)))) (and (cons? (tl (hd (tl V5988)))) (cons? (tl (tl V5988))))))))) (cons shen.x.features.cond-expand (cons (hd (tl (hd (tl V5988)))) (cons (cons shen.x.features.cond-expand (cons (cons and (tl (tl (hd (tl V5988))))) (tl (tl V5988)))) (tl (tl (tl V5988))))))) ((and (cons? V5988) (and (= shen.x.features.cond-expand (hd V5988)) (and (cons? (tl V5988)) (and (cons? (hd (tl V5988))) (and (= or (hd (hd (tl V5988)))) (and (= () (tl (hd (tl V5988)))) (cons? (tl (tl V5988))))))))) (cons shen.x.features.cond-expand (tl (tl (tl V5988))))) ((and (cons? V5988) (and (= shen.x.features.cond-expand (hd V5988)) (and (cons? (tl V5988)) (and (cons? (hd (tl V5988))) (and (= or (hd (hd (tl V5988)))) (and (cons? (tl (hd (tl V5988)))) (cons? (tl (tl V5988))))))))) (cons shen.x.features.cond-expand (cons (hd (tl (hd (tl V5988)))) (cons (hd (tl (tl V5988))) (cons true (cons (cons shen.x.features.cond-expand (cons (cons or (tl (tl (hd (tl V5988))))) (tl (tl V5988)))) ())))))) ((and (cons? V5988) (and (= shen.x.features.cond-expand (hd V5988)) (and (cons? (tl V5988)) (and (cons? (hd (tl V5988))) (and (= not (hd (hd (tl V5988)))) (and (cons? (tl (hd (tl V5988)))) (and (= () (tl (tl (hd (tl V5988))))) (cons? (tl (tl V5988)))))))))) (cons shen.x.features.cond-expand (cons (hd (tl (hd (tl V5988)))) (cons (cons shen.x.features.cond-expand (tl (tl (tl V5988)))) (cons true (cons (hd (tl (tl V5988))) ())))))) ((and (cons? V5988) (and (= shen.x.features.cond-expand (hd V5988)) (and (cons? (tl V5988)) (and (cons? (tl (tl V5988))) (element? (hd (tl V5988)) (value shen.x.features.*features*)))))) (hd (tl (tl V5988)))) ((and (cons? V5988) (and (= shen.x.features.cond-expand (hd V5988)) (and (cons? (tl V5988)) (cons? (tl (tl V5988)))))) (cons shen.x.features.cond-expand (tl (tl (tl V5988))))) (true V5988))) +(defun shen.x.features.cond-expand-macro (V4827) (cond ((and (cons? V4827) (and (= shen.x.features.cond-expand (hd V4827)) (= () (tl V4827)))) (simple-error "Unfulfilled shen.x.features.cond-expand clause.")) ((and (cons? V4827) (and (= shen.x.features.cond-expand (hd V4827)) (and (cons? (tl V4827)) (and (= true (hd (tl V4827))) (and (cons? (tl (tl V4827))) (= () (tl (tl (tl V4827))))))))) (hd (tl (tl V4827)))) ((and (cons? V4827) (and (= shen.x.features.cond-expand (hd V4827)) (and (cons? (tl V4827)) (and (cons? (hd (tl V4827))) (and (= and (hd (hd (tl V4827)))) (and (= () (tl (hd (tl V4827)))) (cons? (tl (tl V4827))))))))) (hd (tl (tl V4827)))) ((and (cons? V4827) (and (= shen.x.features.cond-expand (hd V4827)) (and (cons? (tl V4827)) (and (cons? (hd (tl V4827))) (and (= and (hd (hd (tl V4827)))) (and (cons? (tl (hd (tl V4827)))) (cons? (tl (tl V4827))))))))) (cons shen.x.features.cond-expand (cons (hd (tl (hd (tl V4827)))) (cons (cons shen.x.features.cond-expand (cons (cons and (tl (tl (hd (tl V4827))))) (tl (tl V4827)))) (tl (tl (tl V4827))))))) ((and (cons? V4827) (and (= shen.x.features.cond-expand (hd V4827)) (and (cons? (tl V4827)) (and (cons? (hd (tl V4827))) (and (= or (hd (hd (tl V4827)))) (and (= () (tl (hd (tl V4827)))) (cons? (tl (tl V4827))))))))) (cons shen.x.features.cond-expand (tl (tl (tl V4827))))) ((and (cons? V4827) (and (= shen.x.features.cond-expand (hd V4827)) (and (cons? (tl V4827)) (and (cons? (hd (tl V4827))) (and (= or (hd (hd (tl V4827)))) (and (cons? (tl (hd (tl V4827)))) (cons? (tl (tl V4827))))))))) (cons shen.x.features.cond-expand (cons (hd (tl (hd (tl V4827)))) (cons (hd (tl (tl V4827))) (cons true (cons (cons shen.x.features.cond-expand (cons (cons or (tl (tl (hd (tl V4827))))) (tl (tl V4827)))) ())))))) ((and (cons? V4827) (and (= shen.x.features.cond-expand (hd V4827)) (and (cons? (tl V4827)) (and (cons? (hd (tl V4827))) (and (= not (hd (hd (tl V4827)))) (and (cons? (tl (hd (tl V4827)))) (and (= () (tl (tl (hd (tl V4827))))) (cons? (tl (tl V4827)))))))))) (cons shen.x.features.cond-expand (cons (hd (tl (hd (tl V4827)))) (cons (cons shen.x.features.cond-expand (tl (tl (tl V4827)))) (cons true (cons (hd (tl (tl V4827))) ())))))) ((and (cons? V4827) (and (= shen.x.features.cond-expand (hd V4827)) (and (cons? (tl V4827)) (and (cons? (tl (tl V4827))) (element? (hd (tl V4827)) (value shen.x.features.*features*)))))) (hd (tl (tl V4827)))) ((and (cons? V4827) (and (= shen.x.features.cond-expand (hd V4827)) (and (cons? (tl V4827)) (cons? (tl (tl V4827)))))) (cons shen.x.features.cond-expand (tl (tl (tl V4827))))) (true V4827))) (defun shen.x.features.current () (value shen.x.features.*features*)) -(defun shen.x.features.initialise (V5990) (let _ (trap-error (value shen.x.features.*features*) (lambda E (do (set shen.x.features.*features* ()) (do (shen.set-lambda-form-entry (cons shen.x.features.cond-expand-macro (lambda X (shen.x.features.cond-expand-macro X)))) (shen.add-macro shen.x.features.cond-expand-macro))))) (let Old (shen.x.features.current) (let _ (set shen.x.features.*features* V5990) Old)))) +(defun shen.x.features.initialise (V4829) (let _ (trap-error (value shen.x.features.*features*) (lambda E (do (set shen.x.features.*features* ()) (do (shen.set-lambda-form-entry (cons shen.x.features.cond-expand-macro (lambda X (shen.x.features.cond-expand-macro X)))) (shen.add-macro shen.x.features.cond-expand-macro))))) (let Old (shen.x.features.current) (let _ (set shen.x.features.*features* V4829) Old)))) -(defun shen.x.features.add (V5992) (let Old (shen.x.features.current) (let _ (set shen.x.features.*features* (adjoin V5992 Old)) Old))) +(defun shen.x.features.add (V4831) (let Old (shen.x.features.current) (let _ (set shen.x.features.*features* (adjoin V4831 Old)) Old))) diff --git a/kl/extension-launcher.kl b/kl/extension-launcher.kl index 3f6a612..7eb3c80 100644 --- a/kl/extension-launcher.kl +++ b/kl/extension-launcher.kl @@ -1,12 +1,12 @@ "Copyright (c) 2019 Bruno Deferrari. BSD 3-Clause License: http://opensource.org/licenses/BSD-3-Clause" -(defun shen.x.launcher.quiet-load (V5994) (let Contents (read-file V5994) (map (lambda X (shen.eval-without-macros X)) Contents))) +(defun shen.x.launcher.quiet-load (V4833) (let Contents (read-file V4833) (map (lambda X (shen.eval-without-macros X)) Contents))) (defun shen.x.launcher.version-string () (shen.app (version) (cn " " (shen.app (cons port (cons (cons (language) (cons (port) ())) (cons implementation (cons (cons (implementation) (cons (release) ())) ())))) " " shen.r)) shen.a)) -(defun shen.x.launcher.help-text (V5996) (cn "Usage: " (shen.app V5996 " [--version] [--help] [] +(defun shen.x.launcher.help-text (V4835) (cn "Usage: " (shen.app V4835 " [--version] [--help] [] commands: repl @@ -31,29 +31,29 @@ commands: Launches the interactive REPL after evaluating all the previous expresions." shen.a))) -(defun shen.x.launcher.execute-all (V5998) (cond ((= () V5998) (cons success ())) ((cons? V5998) (do (thaw (hd V5998)) (shen.x.launcher.execute-all (tl V5998)))) (true (shen.f_error shen.x.launcher.execute-all)))) +(defun shen.x.launcher.execute-all (V4837) (cond ((= () V4837) (cons success ())) ((cons? V4837) (do (thaw (hd V4837)) (shen.x.launcher.execute-all (tl V4837)))) (true (shen.f_error shen.x.launcher.execute-all)))) -(defun shen.x.launcher.eval-string (V6000) (eval (head (read-from-string V6000)))) +(defun shen.x.launcher.eval-string (V4839) (eval (head (read-from-string V4839)))) -(defun shen.x.launcher.eval-flag-map (V6006) (cond ((= "-e" V6006) "--eval") ((= "-l" V6006) "--load") ((= "-q" V6006) "--quiet") ((= "-s" V6006) "--set") ((= "-r" V6006) "--repl") (true false))) +(defun shen.x.launcher.eval-flag-map (V4845) (cond ((= "-e" V4845) "--eval") ((= "-l" V4845) "--load") ((= "-q" V4845) "--quiet") ((= "-s" V4845) "--set") ((= "-r" V4845) "--repl") (true false))) -(defun shen.x.launcher.eval-command-h (V6017 V6018) (cond ((= () V6017) (shen.x.launcher.execute-all (reverse V6018))) ((and (cons? V6017) (and (= "--eval" (hd V6017)) (cons? (tl V6017)))) (shen.x.launcher.eval-command-h (tl (tl V6017)) (cons (freeze (shen.prhush (shen.app (shen.x.launcher.eval-string (hd (tl V6017))) " -" shen.a) (stoutput))) V6018))) ((and (cons? V6017) (and (= "--load" (hd V6017)) (cons? (tl V6017)))) (shen.x.launcher.eval-command-h (tl (tl V6017)) (cons (freeze (load (hd (tl V6017)))) V6018))) ((and (cons? V6017) (= "--quiet" (hd V6017))) (shen.x.launcher.eval-command-h (tl V6017) (cons (freeze (set *hush* true)) V6018))) ((and (cons? V6017) (and (= "--set" (hd V6017)) (and (cons? (tl V6017)) (cons? (tl (tl V6017)))))) (shen.x.launcher.eval-command-h (tl (tl (tl V6017))) (cons (freeze (set (shen.x.launcher.eval-string (hd (tl V6017))) (shen.x.launcher.eval-string (hd (tl (tl V6017)))))) V6018))) ((and (cons? V6017) (= "--repl" (hd V6017))) (do (shen.x.launcher.eval-command-h () V6018) (cons launch-repl (tl V6017)))) (true (let Freeze (freeze (cond ((cons? V6017) (cons error (cons (cn "Invalid eval argument: " (shen.app (hd V6017) "" shen.a)) ()))) (true (shen.f_error shen.x.launcher.eval-command-h)))) (if (cons? V6017) (let Result (let Long (shen.x.launcher.eval-flag-map (hd V6017)) (if (= false Long) (fail) (shen.x.launcher.eval-command-h (cons Long (tl V6017)) V6018))) (if (= Result (fail)) (thaw Freeze) Result)) (thaw Freeze)))))) +(defun shen.x.launcher.eval-command-h (V4856 V4857) (cond ((= () V4856) (shen.x.launcher.execute-all (reverse V4857))) ((and (cons? V4856) (and (= "--eval" (hd V4856)) (cons? (tl V4856)))) (shen.x.launcher.eval-command-h (tl (tl V4856)) (cons (freeze (shen.prhush (shen.app (shen.x.launcher.eval-string (hd (tl V4856))) " +" shen.a) (stoutput))) V4857))) ((and (cons? V4856) (and (= "--load" (hd V4856)) (cons? (tl V4856)))) (shen.x.launcher.eval-command-h (tl (tl V4856)) (cons (freeze (load (hd (tl V4856)))) V4857))) ((and (cons? V4856) (= "--quiet" (hd V4856))) (shen.x.launcher.eval-command-h (tl V4856) (cons (freeze (set *hush* true)) V4857))) ((and (cons? V4856) (and (= "--set" (hd V4856)) (and (cons? (tl V4856)) (cons? (tl (tl V4856)))))) (shen.x.launcher.eval-command-h (tl (tl (tl V4856))) (cons (freeze (set (shen.x.launcher.eval-string (hd (tl V4856))) (shen.x.launcher.eval-string (hd (tl (tl V4856)))))) V4857))) ((and (cons? V4856) (= "--repl" (hd V4856))) (do (shen.x.launcher.eval-command-h () V4857) (cons launch-repl (tl V4856)))) (true (let Freeze (freeze (cond ((cons? V4856) (cons error (cons (cn "Invalid eval argument: " (shen.app (hd V4856) "" shen.a)) ()))) (true (shen.f_error shen.x.launcher.eval-command-h)))) (if (cons? V4856) (let Result (let Long (shen.x.launcher.eval-flag-map (hd V4856)) (if (= false Long) (fail) (shen.x.launcher.eval-command-h (cons Long (tl V4856)) V4857))) (if (= Result (fail)) (thaw Freeze) Result)) (thaw Freeze)))))) -(defun shen.x.launcher.eval-command (V6020) (shen.x.launcher.eval-command-h V6020 ())) +(defun shen.x.launcher.eval-command (V4859) (shen.x.launcher.eval-command-h V4859 ())) -(defun shen.x.launcher.script-command (V6023 V6024) (do (set *argv* (cons V6023 V6024)) (do (shen.x.launcher.quiet-load V6023) (cons success ())))) +(defun shen.x.launcher.script-command (V4862 V4863) (do (set *argv* (cons V4862 V4863)) (do (shen.x.launcher.quiet-load V4862) (cons success ())))) -(defun shen.x.launcher.launch-shen (V6026) (cond ((and (cons? V6026) (= () (tl V6026))) (cons launch-repl ())) ((and (cons? V6026) (and (cons? (tl V6026)) (= "--help" (hd (tl V6026))))) (cons show-help (cons (shen.x.launcher.help-text (hd V6026)) ()))) ((and (cons? V6026) (and (cons? (tl V6026)) (= "--version" (hd (tl V6026))))) (cons success (cons (shen.x.launcher.version-string) ()))) ((and (cons? V6026) (and (cons? (tl V6026)) (= "repl" (hd (tl V6026))))) (cons launch-repl (tl (tl V6026)))) ((and (cons? V6026) (and (cons? (tl V6026)) (and (= "script" (hd (tl V6026))) (cons? (tl (tl V6026)))))) (shen.x.launcher.script-command (hd (tl (tl V6026))) (tl (tl (tl V6026))))) ((and (cons? V6026) (and (cons? (tl V6026)) (= "eval" (hd (tl V6026))))) (shen.x.launcher.eval-command (tl (tl V6026)))) ((and (cons? V6026) (cons? (tl V6026))) (cons unknown-arguments V6026)) (true (shen.f_error shen.x.launcher.launch-shen)))) +(defun shen.x.launcher.launch-shen (V4865) (cond ((and (cons? V4865) (= () (tl V4865))) (cons launch-repl ())) ((and (cons? V4865) (and (cons? (tl V4865)) (= "--help" (hd (tl V4865))))) (cons show-help (cons (shen.x.launcher.help-text (hd V4865)) ()))) ((and (cons? V4865) (and (cons? (tl V4865)) (= "--version" (hd (tl V4865))))) (cons success (cons (shen.x.launcher.version-string) ()))) ((and (cons? V4865) (and (cons? (tl V4865)) (= "repl" (hd (tl V4865))))) (cons launch-repl (tl (tl V4865)))) ((and (cons? V4865) (and (cons? (tl V4865)) (and (= "script" (hd (tl V4865))) (cons? (tl (tl V4865)))))) (shen.x.launcher.script-command (hd (tl (tl V4865))) (tl (tl (tl V4865))))) ((and (cons? V4865) (and (cons? (tl V4865)) (= "eval" (hd (tl V4865))))) (shen.x.launcher.eval-command (tl (tl V4865)))) ((and (cons? V4865) (cons? (tl V4865))) (cons unknown-arguments V4865)) (true (shen.f_error shen.x.launcher.launch-shen)))) -(defun shen.x.launcher.default-handle-result (V6030) (cond ((and (cons? V6030) (and (= success (hd V6030)) (= () (tl V6030)))) shen.x.launcher.done) ((and (cons? V6030) (and (= success (hd V6030)) (and (cons? (tl V6030)) (= () (tl (tl V6030)))))) (shen.prhush (shen.app (hd (tl V6030)) " -" shen.a) (stoutput))) ((and (cons? V6030) (and (= error (hd V6030)) (and (cons? (tl V6030)) (= () (tl (tl V6030)))))) (shen.prhush (cn "ERROR: " (shen.app (hd (tl V6030)) " -" shen.a)) (stoutput))) ((and (cons? V6030) (= launch-repl (hd V6030))) (shen.repl)) ((and (cons? V6030) (and (= show-help (hd V6030)) (and (cons? (tl V6030)) (= () (tl (tl V6030)))))) (shen.prhush (shen.app (hd (tl V6030)) " -" shen.a) (stoutput))) ((and (cons? V6030) (and (= unknown-arguments (hd V6030)) (and (cons? (tl V6030)) (cons? (tl (tl V6030)))))) (shen.prhush (cn "ERROR: Invalid argument: " (shen.app (hd (tl (tl V6030))) (cn " -Try `" (shen.app (hd (tl V6030)) " --help' for more information. +(defun shen.x.launcher.default-handle-result (V4869) (cond ((and (cons? V4869) (and (= success (hd V4869)) (= () (tl V4869)))) shen.x.launcher.done) ((and (cons? V4869) (and (= success (hd V4869)) (and (cons? (tl V4869)) (= () (tl (tl V4869)))))) (shen.prhush (shen.app (hd (tl V4869)) " +" shen.a) (stoutput))) ((and (cons? V4869) (and (= error (hd V4869)) (and (cons? (tl V4869)) (= () (tl (tl V4869)))))) (shen.prhush (cn "ERROR: " (shen.app (hd (tl V4869)) " +" shen.a)) (stoutput))) ((and (cons? V4869) (= launch-repl (hd V4869))) (shen.repl)) ((and (cons? V4869) (and (= show-help (hd V4869)) (and (cons? (tl V4869)) (= () (tl (tl V4869)))))) (shen.prhush (shen.app (hd (tl V4869)) " +" shen.a) (stoutput))) ((and (cons? V4869) (and (= unknown-arguments (hd V4869)) (and (cons? (tl V4869)) (cons? (tl (tl V4869)))))) (shen.prhush (cn "ERROR: Invalid argument: " (shen.app (hd (tl (tl V4869))) (cn " +Try `" (shen.app (hd (tl V4869)) " --help' for more information. " shen.a)) shen.a)) (stoutput))) (true (shen.f_error shen.x.launcher.default-handle-result)))) -(defun shen.x.launcher.main (V6032) (shen.x.launcher.default-handle-result (shen.x.launcher.launch-shen V6032))) +(defun shen.x.launcher.main (V4871) (shen.x.launcher.default-handle-result (shen.x.launcher.launch-shen V4871))) diff --git a/kl/extension-programmable-pattern-matching.kl b/kl/extension-programmable-pattern-matching.kl new file mode 100644 index 0000000..c81ceef --- /dev/null +++ b/kl/extension-programmable-pattern-matching.kl @@ -0,0 +1,28 @@ +"Copyright (c) 2019 Bruno Deferrari. All rights reserved. +BSD 3-Clause License: http://opensource.org/licenses/BSD-3-Clause" + +(defun shen.x.programmable-pattern-matching.apply-pattern-handlers (V5042 V5043 V5044 V5045 V5046) (cond ((= () V5042) (fail)) (true (let Freeze (freeze (cond ((cons? V5042) (shen.x.programmable-pattern-matching.apply-pattern-handlers (tl V5042) V5043 V5044 V5045 V5046)) (true (shen.f_error shen.x.programmable-pattern-matching.apply-pattern-handlers)))) (if (cons? V5042) (let Result ((hd V5042) V5043 V5044 V5045 V5046) (if (= Result (fail)) (thaw Freeze) Result)) (thaw Freeze)))))) + +(defun shen.x.programmable-pattern-matching.make-stack () (address-> (absvector 1) 0 ())) + +(defun shen.x.programmable-pattern-matching.push (V5049 V5050) (address-> V5049 0 (cons V5050 (<-address V5049 0)))) + +(defun shen.x.programmable-pattern-matching.pop-all (V5052) (let Res (<-address V5052 0) (let _ (address-> V5052 0 ()) Res))) + +(defun shen.x.programmable-pattern-matching.compile-pattern (V5056 V5057 V5058) (let VarsStack (shen.x.programmable-pattern-matching.make-stack) (let Self Self$$7907$$ (let AddTest (lambda _ shen.x.programmable-pattern-matching.ignored) (let Bind (lambda Var (lambda _ (shen.x.programmable-pattern-matching.push VarsStack Var))) (let Result (shen.x.programmable-pattern-matching.apply-pattern-handlers V5057 Self AddTest Bind V5056) (if (= Result (fail)) (thaw V5058) (shen.x.programmable-pattern-matching.compile-pattern-h V5056 (reverse (shen.x.programmable-pattern-matching.pop-all VarsStack)))))))))) + +(defun shen.x.programmable-pattern-matching.compile-pattern-h (V5061 V5062) (cond ((cons? V5061) (let Compile (lambda X (shen. X)) (let Handler (lambda E (simple-error (cn "failed to compile " (shen.app E "" shen.a)))) (let NewArgs (map (lambda Arg (if (element? Arg V5062) (compile Compile (cons Arg ()) Handler) Arg)) (tl V5061)) (cons (hd V5061) NewArgs))))) (true (shen.f_error shen.x.programmable-pattern-matching.compile-pattern-h)))) + +(defun shen.x.programmable-pattern-matching.reduce (V5065 V5066) (cond ((and (cons? V5065) (and (cons? (hd V5065)) (and (= /. (hd (hd V5065))) (and (cons? (tl (hd V5065))) (and (cons? (hd (tl (hd V5065)))) (and (cons? (tl (tl (hd V5065)))) (and (= () (tl (tl (tl (hd V5065))))) (and (cons? (tl V5065)) (= () (tl (tl V5065))))))))))) (let SelectorStack (shen.x.programmable-pattern-matching.make-stack) (let AddTest (lambda Expr (shen.add_test Expr)) (let Bind (lambda Var (lambda Expr (shen.x.programmable-pattern-matching.push SelectorStack (@p Var Expr)))) (let Result (shen.x.programmable-pattern-matching.apply-pattern-handlers V5066 (hd (tl V5065)) AddTest Bind (hd (tl (hd V5065)))) (let Vars+Sels (reverse (shen.x.programmable-pattern-matching.pop-all SelectorStack)) (let Vars (map (lambda V5019 (fst V5019)) Vars+Sels) (let Selectors (map (lambda V5020 (snd V5020)) Vars+Sels) (let Abstraction (shen.abstraction_build Vars (shen.ebr (hd (tl V5065)) (hd (tl (hd V5065))) (hd (tl (tl (hd V5065)))))) (let Application (shen.application_build Selectors Abstraction) (shen.reduce_help Application))))))))))) (true (shen.f_error shen.x.programmable-pattern-matching.reduce)))) + +(defun shen.x.programmable-pattern-matching.initialise () (do (set shen.*custom-pattern-compiler* (lambda Arg (lambda OnFail (shen.x.programmable-pattern-matching.compile-pattern Arg (value shen.x.programmable-pattern-matching.*pattern-handlers*) OnFail)))) (do (set shen.*custom-pattern-reducer* (lambda Arg (shen.x.programmable-pattern-matching.reduce Arg (value shen.x.programmable-pattern-matching.*pattern-handlers*)))) (do (set shen.x.programmable-pattern-matching.*pattern-handlers* ()) (do (set shen.x.programmable-pattern-matching.*pattern-handlers-reg* ()) shen.x.programmable-pattern-matching.done))))) + +(defun shen.x.programmable-pattern-matching.register-handler (V5068) (cond ((element? V5068 (value shen.x.programmable-pattern-matching.*pattern-handlers-reg*)) V5068) (true (do (set shen.x.programmable-pattern-matching.*pattern-handlers-reg* (cons V5068 (value shen.x.programmable-pattern-matching.*pattern-handlers-reg*))) (do (set shen.x.programmable-pattern-matching.*pattern-handlers* (cons (function V5068) (value shen.x.programmable-pattern-matching.*pattern-handlers*))) V5068))))) + +(defun shen.x.programmable-pattern-matching.findpos (V5071 V5072) (trap-error (shen.findpos V5071 V5072) (lambda _ (simple-error (shen.app V5071 " is not a pattern handler +" shen.a))))) + +(defun shen.x.programmable-pattern-matching.unregister-handler (V5074) (let Reg (value shen.x.programmable-pattern-matching.*pattern-handlers-reg*) (let Pos (shen.x.programmable-pattern-matching.findpos V5074 Reg) (let RemoveReg (set shen.x.programmable-pattern-matching.*pattern-handlers-reg* (remove V5074 Reg)) (let RemoveFun (set shen.x.programmable-pattern-matching.*pattern-handlers* (shen.remove-nth Pos (value shen.x.programmable-pattern-matching.*pattern-handlers*))) V5074))))) + + + diff --git a/kl/init.kl b/kl/init.kl index 2d7b19b..b8be8e2 100644 --- a/kl/init.kl +++ b/kl/init.kl @@ -28,7 +28,15 @@ OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. " -(defun shen.initialise () (do (set shen.*installing-kl* false) (do (set shen.*history* ()) (do (set shen.*tc* false) (do (set *property-vector* (shen.dict 20000)) (do (set shen.*process-counter* 0) (do (set shen.*varcounter* (vector 10000)) (do (set shen.*prologvectors* (vector 10000)) (do (set shen.*demodulation-function* (lambda X X)) (do (set shen.*macroreg* (cons shen.timer-macro (cons shen.cases-macro (cons shen.abs-macro (cons shen.put/get-macro (cons shen.compile-macro (cons shen.datatype-macro (cons shen.let-macro (cons shen.assoc-macro (cons shen.make-string-macro (cons shen.output-macro (cons shen.input-macro (cons shen.error-macro (cons shen.prolog-macro (cons shen.synonyms-macro (cons shen.nl-macro (cons shen.@s-macro (cons shen.defprolog-macro (cons shen.function-macro ()))))))))))))))))))) (do (set *macros* (cons (lambda X (shen.timer-macro X)) (cons (lambda X (shen.cases-macro X)) (cons (lambda X (shen.abs-macro X)) (cons (lambda X (shen.put/get-macro X)) (cons (lambda X (shen.compile-macro X)) (cons (lambda X (shen.datatype-macro X)) (cons (lambda X (shen.let-macro X)) (cons (lambda X (shen.assoc-macro X)) (cons (lambda X (shen.make-string-macro X)) (cons (lambda X (shen.output-macro X)) (cons (lambda X (shen.input-macro X)) (cons (lambda X (shen.error-macro X)) (cons (lambda X (shen.prolog-macro X)) (cons (lambda X (shen.synonyms-macro X)) (cons (lambda X (shen.nl-macro X)) (cons (lambda X (shen.@s-macro X)) (cons (lambda X (shen.defprolog-macro X)) (cons (lambda X (shen.function-macro X)) ()))))))))))))))))))) (do (set shen.*gensym* 0) (do (set shen.*tracking* ()) (do (set shen.*alphabet* (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 ()))))))))))))))))))))))))))) (do (set shen.*special* (cons @p (cons @s (cons @v (cons cons (cons lambda (cons let (cons where (cons set (cons open ())))))))))) (do (set shen.*extraspecial* (cons define (cons shen.process-datatype (cons input+ (cons defcc (cons shen.read+ (cons defmacro ()))))))) (do (set shen.*spy* false) (do (set shen.*datatypes* ()) (do (set shen.*alldatatypes* ()) (do (set shen.*shen-type-theory-enabled?* true) (do (set shen.*synonyms* ()) (do (set shen.*system* ()) (do (set shen.*signedfuncs* ()) (do (set shen.*maxcomplexity* 128) (do (set shen.*occurs* true) (do (set shen.*maxinferences* 1000000) (do (set *maximum-print-sequence-size* 20) (do (set shen.*catch* 0) (do (set shen.*call* 0) (do (set shen.*infs* 0) (do (set *hush* false) (do (set shen.*optimise* false) (do (set *version* "Shen 22.0") (do (if (not (bound? *home-directory*)) (set *home-directory* "") shen.skip) (do (if (not (bound? *sterror*)) (set *sterror* (value *stoutput*)) shen.skip) (do (shen.initialise_arity_table (cons abort (cons 0 (cons absvector? (cons 1 (cons absvector (cons 1 (cons adjoin (cons 2 (cons and (cons 2 (cons append (cons 2 (cons arity (cons 1 (cons assoc (cons 2 (cons boolean? (cons 1 (cons bound? (cons 1 (cons cd (cons 1 (cons close (cons 1 (cons compile (cons 3 (cons concat (cons 2 (cons cons (cons 2 (cons cons? (cons 1 (cons cn (cons 2 (cons declare (cons 2 (cons destroy (cons 1 (cons difference (cons 2 (cons do (cons 2 (cons element? (cons 2 (cons empty? (cons 1 (cons enable-type-theory (cons 1 (cons error-to-string (cons 1 (cons shen.interror (cons 2 (cons eval (cons 1 (cons eval-kl (cons 1 (cons explode (cons 1 (cons external (cons 1 (cons fail-if (cons 2 (cons fail (cons 0 (cons fix (cons 2 (cons findall (cons 5 (cons freeze (cons 1 (cons fst (cons 1 (cons gensym (cons 1 (cons get (cons 3 (cons get-time (cons 1 (cons address-> (cons 3 (cons <-address (cons 2 (cons <-vector (cons 2 (cons > (cons 2 (cons >= (cons 2 (cons = (cons 2 (cons hash (cons 2 (cons hd (cons 1 (cons hdv (cons 1 (cons hdstr (cons 1 (cons head (cons 1 (cons if (cons 3 (cons integer? (cons 1 (cons intern (cons 1 (cons identical (cons 4 (cons inferences (cons 0 (cons input (cons 1 (cons input+ (cons 2 (cons implementation (cons 0 (cons intersection (cons 2 (cons internal (cons 1 (cons it (cons 0 (cons kill (cons 0 (cons language (cons 0 (cons length (cons 1 (cons limit (cons 1 (cons lineread (cons 1 (cons load (cons 1 (cons < (cons 2 (cons <= (cons 2 (cons vector (cons 1 (cons macroexpand (cons 1 (cons map (cons 2 (cons mapcan (cons 2 (cons maxinferences (cons 1 (cons nl (cons 1 (cons not (cons 1 (cons nth (cons 2 (cons n->string (cons 1 (cons number? (cons 1 (cons occurs-check (cons 1 (cons occurrences (cons 2 (cons occurs-check (cons 1 (cons open (cons 2 (cons optimise (cons 1 (cons or (cons 2 (cons os (cons 0 (cons package (cons 3 (cons package? (cons 1 (cons port (cons 0 (cons porters (cons 0 (cons pos (cons 2 (cons print (cons 1 (cons profile (cons 1 (cons profile-results (cons 1 (cons pr (cons 2 (cons ps (cons 1 (cons preclude (cons 1 (cons preclude-all-but (cons 1 (cons protect (cons 1 (cons address-> (cons 3 (cons put (cons 4 (cons shen.reassemble (cons 2 (cons read-file-as-string (cons 1 (cons read-file (cons 1 (cons read-file-as-bytelist (cons 1 (cons read (cons 1 (cons read-byte (cons 1 (cons read-from-string (cons 1 (cons receive (cons 1 (cons release (cons 0 (cons remove (cons 2 (cons shen.require (cons 3 (cons reverse (cons 1 (cons set (cons 2 (cons simple-error (cons 1 (cons snd (cons 1 (cons specialise (cons 1 (cons spy (cons 1 (cons step (cons 1 (cons stinput (cons 0 (cons stoutput (cons 0 (cons sterror (cons 0 (cons string->n (cons 1 (cons string->symbol (cons 1 (cons string? (cons 1 (cons str (cons 1 (cons subst (cons 3 (cons sum (cons 1 (cons symbol? (cons 1 (cons systemf (cons 1 (cons tail (cons 1 (cons tl (cons 1 (cons tc (cons 1 (cons tc? (cons 0 (cons thaw (cons 1 (cons tlstr (cons 1 (cons track (cons 1 (cons trap-error (cons 2 (cons tuple? (cons 1 (cons type (cons 2 (cons return (cons 3 (cons undefmacro (cons 1 (cons unput (cons 3 (cons unprofile (cons 1 (cons unify (cons 4 (cons unify! (cons 4 (cons union (cons 2 (cons untrack (cons 1 (cons unspecialise (cons 1 (cons undefmacro (cons 1 (cons vector (cons 1 (cons vector? (cons 1 (cons vector-> (cons 3 (cons value (cons 1 (cons variable? (cons 1 (cons version (cons 0 (cons write-byte (cons 2 (cons write-to-file (cons 2 (cons y-or-n? (cons 1 (cons + (cons 2 (cons * (cons 2 (cons / (cons 2 (cons - (cons 2 (cons == (cons 2 (cons (cons 1 (cons (cons 1 (cons @p (cons 2 (cons @v (cons 2 (cons @s (cons 2 (cons preclude (cons 1 (cons include (cons 1 (cons preclude-all-but (cons 1 (cons include-all-but (cons 1 ()))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) (do (put (intern "shen") shen.external-symbols (cons ! (cons } (cons { (cons --> (cons <-- (cons && (cons : (cons ; (cons :- (cons := (cons _ (cons , (cons *language* (cons *implementation* (cons *stinput* (cons *stoutput* (cons *sterror* (cons *home-directory* (cons *version* (cons *maximum-print-sequence-size* (cons *macros* (cons *os* (cons *release* (cons *property-vector* (cons *port* (cons *porters* (cons *hush* (cons @v (cons @p (cons @s (cons <- (cons -> (cons (cons (cons == (cons = (cons >= (cons > (cons /. (cons =! (cons $ (cons - (cons / (cons * (cons + (cons <= (cons < (cons >> (cons y-or-n? (cons write-to-file (cons write-byte (cons where (cons when (cons warn (cons version (cons verified (cons variable? (cons value (cons vector-> (cons <-vector (cons vector (cons vector? (cons unspecialise (cons untrack (cons unit (cons shen.unix (cons union (cons unify (cons unify! (cons unput (cons unprofile (cons undefmacro (cons return (cons type (cons tuple? (cons true (cons trap-error (cons track (cons time (cons thaw (cons tc? (cons tc (cons tl (cons tlstr (cons tlv (cons tail (cons systemf (cons synonyms (cons symbol (cons symbol? (cons string->symbol (cons sum (cons subst (cons string? (cons string->n (cons stream (cons string (cons stinput (cons sterror (cons stoutput (cons step (cons spy (cons specialise (cons snd (cons simple-error (cons set (cons save (cons str (cons run (cons reverse (cons remove (cons release (cons read (cons receive (cons read-file (cons read-file-as-bytelist (cons read-file-as-string (cons read-byte (cons read-from-string (cons package? (cons put (cons preclude (cons preclude-all-but (cons ps (cons prolog? (cons protect (cons profile-results (cons profile (cons print (cons pr (cons pos (cons porters (cons port (cons package (cons output (cons out (cons os (cons or (cons optimise (cons open (cons occurrences (cons occurs-check (cons n->string (cons number? (cons number (cons null (cons nth (cons not (cons nl (cons mode (cons macroexpand (cons maxinferences (cons mapcan (cons map (cons make-string (cons load (cons loaded (cons list (cons lineread (cons limit (cons length (cons let (cons lazy (cons lambda (cons language (cons kill (cons is (cons intersection (cons inferences (cons intern (cons integer? (cons input (cons input+ (cons include (cons include-all-but (cons it (cons in (cons internal (cons implementation (cons if (cons identical (cons head (cons hd (cons hdv (cons hdstr (cons hash (cons get (cons get-time (cons gensym (cons function (cons fst (cons freeze (cons fix (cons file (cons fail (cons fail-if (cons fwhen (cons findall (cons false (cons enable-type-theory (cons explode (cons external (cons exception (cons eval-kl (cons eval (cons error-to-string (cons error (cons empty? (cons element? (cons do (cons difference (cons destroy (cons defun (cons define (cons defmacro (cons defcc (cons defprolog (cons declare (cons datatype (cons cut (cons cn (cons cons? (cons cons (cons cond (cons concat (cons compile (cons cd (cons cases (cons call (cons close (cons bind (cons bound? (cons boolean? (cons boolean (cons bar! (cons assoc (cons arity (cons abort (cons append (cons and (cons adjoin (cons <-address (cons address-> (cons absvector? (cons absvector ()))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) (value *property-vector*)) (do (shen.set-lambda-form-entry (cons shen.datatype-error (lambda X (shen.datatype-error X)))) (do (shen.set-lambda-form-entry (cons shen.tuple (lambda X (shen.tuple X)))) (do (shen.set-lambda-form-entry (cons shen.pvar (lambda X (shen.pvar X)))) (do (shen.set-lambda-form-entry (cons shen.dictionary (lambda X (shen.dictionary X)))) (do (shen.set-lambda-form-entry (cons @v (lambda V1579 (lambda V1580 (@v V1579 V1580))))) (do (shen.set-lambda-form-entry (cons @p (lambda V1581 (lambda V1582 (@p V1581 V1582))))) (do (shen.set-lambda-form-entry (cons @s (lambda V1583 (lambda V1584 (@s V1583 V1584))))) (do (shen.set-lambda-form-entry (cons (lambda V1585 ( V1585)))) (do (shen.set-lambda-form-entry (cons (lambda V1586 ( V1586)))) (do (shen.set-lambda-form-entry (cons == (lambda V1587 (lambda V1588 (== V1587 V1588))))) (do (shen.set-lambda-form-entry (cons = (lambda V1589 (lambda V1590 (= V1589 V1590))))) (do (shen.set-lambda-form-entry (cons >= (lambda V1591 (lambda V1592 (>= V1591 V1592))))) (do (shen.set-lambda-form-entry (cons > (lambda V1593 (lambda V1594 (> V1593 V1594))))) (do (shen.set-lambda-form-entry (cons - (lambda V1595 (lambda V1596 (- V1595 V1596))))) (do (shen.set-lambda-form-entry (cons / (lambda V1597 (lambda V1598 (/ V1597 V1598))))) (do (shen.set-lambda-form-entry (cons * (lambda V1599 (lambda V1600 (* V1599 V1600))))) (do (shen.set-lambda-form-entry (cons + (lambda V1601 (lambda V1602 (+ V1601 V1602))))) (do (shen.set-lambda-form-entry (cons <= (lambda V1603 (lambda V1604 (<= V1603 V1604))))) (do (shen.set-lambda-form-entry (cons < (lambda V1605 (lambda V1606 (< V1605 V1606))))) (do (shen.set-lambda-form-entry (cons y-or-n? (lambda V1607 (y-or-n? V1607)))) (do (shen.set-lambda-form-entry (cons write-to-file (lambda V1608 (lambda V1609 (write-to-file V1608 V1609))))) (do (shen.set-lambda-form-entry (cons write-byte (lambda V1610 (lambda V1611 (write-byte V1610 V1611))))) (do (shen.set-lambda-form-entry (cons variable? (lambda V1612 (variable? V1612)))) (do (shen.set-lambda-form-entry (cons value (lambda V1613 (value V1613)))) (do (shen.set-lambda-form-entry (cons vector-> (lambda V1614 (lambda V1615 (lambda V1616 (vector-> V1614 V1615 V1616)))))) (do (shen.set-lambda-form-entry (cons <-vector (lambda V1617 (lambda V1618 (<-vector V1617 V1618))))) (do (shen.set-lambda-form-entry (cons vector (lambda V1619 (vector V1619)))) (do (shen.set-lambda-form-entry (cons vector? (lambda V1620 (vector? V1620)))) (do (shen.set-lambda-form-entry (cons unspecialise (lambda V1621 (unspecialise V1621)))) (do (shen.set-lambda-form-entry (cons untrack (lambda V1622 (untrack V1622)))) (do (shen.set-lambda-form-entry (cons union (lambda V1623 (lambda V1624 (union V1623 V1624))))) (do (shen.set-lambda-form-entry (cons unify (lambda V1625 (lambda V1626 (lambda V1627 (lambda V1628 (unify V1625 V1626 V1627 V1628))))))) (do (shen.set-lambda-form-entry (cons unify! (lambda V1629 (lambda V1630 (lambda V1631 (lambda V1632 (unify! V1629 V1630 V1631 V1632))))))) (do (shen.set-lambda-form-entry (cons unput (lambda V1633 (lambda V1634 (lambda V1635 (unput V1633 V1634 V1635)))))) (do (shen.set-lambda-form-entry (cons unprofile (lambda V1636 (unprofile V1636)))) (do (shen.set-lambda-form-entry (cons undefmacro (lambda V1637 (undefmacro V1637)))) (do (shen.set-lambda-form-entry (cons return (lambda V1638 (lambda V1639 (lambda V1640 (return V1638 V1639 V1640)))))) (do (shen.set-lambda-form-entry (cons type (lambda V1641 (lambda V1642 (type V1641 V1642))))) (do (shen.set-lambda-form-entry (cons tuple? (lambda V1643 (tuple? V1643)))) (do (shen.set-lambda-form-entry (cons trap-error (lambda V1644 (lambda V1645 (trap-error V1644 V1645))))) (do (shen.set-lambda-form-entry (cons track (lambda V1646 (track V1646)))) (do (shen.set-lambda-form-entry (cons thaw (lambda V1647 (thaw V1647)))) (do (shen.set-lambda-form-entry (cons tc (lambda V1648 (tc V1648)))) (do (shen.set-lambda-form-entry (cons tl (lambda V1649 (tl V1649)))) (do (shen.set-lambda-form-entry (cons tlstr (lambda V1650 (tlstr V1650)))) (do (shen.set-lambda-form-entry (cons tail (lambda V1651 (tail V1651)))) (do (shen.set-lambda-form-entry (cons systemf (lambda V1652 (systemf V1652)))) (do (shen.set-lambda-form-entry (cons symbol? (lambda V1653 (symbol? V1653)))) (do (shen.set-lambda-form-entry (cons string->symbol (lambda V1654 (string->symbol V1654)))) (do (shen.set-lambda-form-entry (cons sum (lambda V1655 (sum V1655)))) (do (shen.set-lambda-form-entry (cons subst (lambda V1656 (lambda V1657 (lambda V1658 (subst V1656 V1657 V1658)))))) (do (shen.set-lambda-form-entry (cons string? (lambda V1659 (string? V1659)))) (do (shen.set-lambda-form-entry (cons string->n (lambda V1660 (string->n V1660)))) (do (shen.set-lambda-form-entry (cons step (lambda V1661 (step V1661)))) (do (shen.set-lambda-form-entry (cons spy (lambda V1662 (spy V1662)))) (do (shen.set-lambda-form-entry (cons specialise (lambda V1663 (specialise V1663)))) (do (shen.set-lambda-form-entry (cons snd (lambda V1664 (snd V1664)))) (do (shen.set-lambda-form-entry (cons simple-error (lambda V1665 (simple-error V1665)))) (do (shen.set-lambda-form-entry (cons set (lambda V1666 (lambda V1667 (set V1666 V1667))))) (do (shen.set-lambda-form-entry (cons str (lambda V1668 (str V1668)))) (do (shen.set-lambda-form-entry (cons reverse (lambda V1669 (reverse V1669)))) (do (shen.set-lambda-form-entry (cons remove (lambda V1670 (lambda V1671 (remove V1670 V1671))))) (do (shen.set-lambda-form-entry (cons read (lambda V1672 (read V1672)))) (do (shen.set-lambda-form-entry (cons read-file (lambda V1673 (read-file V1673)))) (do (shen.set-lambda-form-entry (cons read-file-as-bytelist (lambda V1674 (read-file-as-bytelist V1674)))) (do (shen.set-lambda-form-entry (cons read-file-as-string (lambda V1675 (read-file-as-string V1675)))) (do (shen.set-lambda-form-entry (cons read-byte (lambda V1676 (read-byte V1676)))) (do (shen.set-lambda-form-entry (cons read-from-string (lambda V1677 (read-from-string V1677)))) (do (shen.set-lambda-form-entry (cons package? (lambda V1678 (package? V1678)))) (do (shen.set-lambda-form-entry (cons put (lambda V1679 (lambda V1680 (lambda V1681 (lambda V1682 (put V1679 V1680 V1681 V1682))))))) (do (shen.set-lambda-form-entry (cons preclude (lambda V1683 (preclude V1683)))) (do (shen.set-lambda-form-entry (cons preclude-all-but (lambda V1684 (preclude-all-but V1684)))) (do (shen.set-lambda-form-entry (cons ps (lambda V1685 (ps V1685)))) (do (shen.set-lambda-form-entry (cons protect (lambda V1686 (protect V1686)))) (do (shen.set-lambda-form-entry (cons profile-results (lambda V1687 (profile-results V1687)))) (do (shen.set-lambda-form-entry (cons profile (lambda V1688 (profile V1688)))) (do (shen.set-lambda-form-entry (cons print (lambda V1689 (print V1689)))) (do (shen.set-lambda-form-entry (cons pr (lambda V1690 (lambda V1691 (pr V1690 V1691))))) (do (shen.set-lambda-form-entry (cons pos (lambda V1692 (lambda V1693 (pos V1692 V1693))))) (do (shen.set-lambda-form-entry (cons or (lambda V1694 (lambda V1695 (or V1694 V1695))))) (do (shen.set-lambda-form-entry (cons optimise (lambda V1696 (optimise V1696)))) (do (shen.set-lambda-form-entry (cons open (lambda V1697 (lambda V1698 (open V1697 V1698))))) (do (shen.set-lambda-form-entry (cons occurrences (lambda V1699 (lambda V1700 (occurrences V1699 V1700))))) (do (shen.set-lambda-form-entry (cons occurs-check (lambda V1701 (occurs-check V1701)))) (do (shen.set-lambda-form-entry (cons n->string (lambda V1702 (n->string V1702)))) (do (shen.set-lambda-form-entry (cons number? (lambda V1703 (number? V1703)))) (do (shen.set-lambda-form-entry (cons nth (lambda V1704 (lambda V1705 (nth V1704 V1705))))) (do (shen.set-lambda-form-entry (cons not (lambda V1706 (not V1706)))) (do (shen.set-lambda-form-entry (cons nl (lambda V1707 (nl V1707)))) (do (shen.set-lambda-form-entry (cons macroexpand (lambda V1708 (macroexpand V1708)))) (do (shen.set-lambda-form-entry (cons maxinferences (lambda V1709 (maxinferences V1709)))) (do (shen.set-lambda-form-entry (cons mapcan (lambda V1710 (lambda V1711 (mapcan V1710 V1711))))) (do (shen.set-lambda-form-entry (cons map (lambda V1712 (lambda V1713 (map V1712 V1713))))) (do (shen.set-lambda-form-entry (cons load (lambda V1714 (load V1714)))) (do (shen.set-lambda-form-entry (cons lineread (lambda V1715 (lineread V1715)))) (do (shen.set-lambda-form-entry (cons limit (lambda V1716 (limit V1716)))) (do (shen.set-lambda-form-entry (cons length (lambda V1717 (length V1717)))) (do (shen.set-lambda-form-entry (cons intersection (lambda V1718 (lambda V1719 (intersection V1718 V1719))))) (do (shen.set-lambda-form-entry (cons intern (lambda V1720 (intern V1720)))) (do (shen.set-lambda-form-entry (cons integer? (lambda V1721 (integer? V1721)))) (do (shen.set-lambda-form-entry (cons input (lambda V1722 (input V1722)))) (do (shen.set-lambda-form-entry (cons input+ (lambda V1723 (lambda V1724 (input+ V1723 V1724))))) (do (shen.set-lambda-form-entry (cons include (lambda V1725 (include V1725)))) (do (shen.set-lambda-form-entry (cons include-all-but (lambda V1726 (include-all-but V1726)))) (do (shen.set-lambda-form-entry (cons internal (lambda V1727 (internal V1727)))) (do (shen.set-lambda-form-entry (cons if (lambda V1728 (lambda V1729 (lambda V1730 (if V1728 V1729 V1730)))))) (do (shen.set-lambda-form-entry (cons identical (lambda V1731 (lambda V1732 (lambda V1733 (lambda V1734 (identical V1731 V1732 V1733 V1734))))))) (do (shen.set-lambda-form-entry (cons head (lambda V1735 (head V1735)))) (do (shen.set-lambda-form-entry (cons hd (lambda V1736 (hd V1736)))) (do (shen.set-lambda-form-entry (cons hdv (lambda V1737 (hdv V1737)))) (do (shen.set-lambda-form-entry (cons hdstr (lambda V1738 (hdstr V1738)))) (do (shen.set-lambda-form-entry (cons hash (lambda V1739 (lambda V1740 (hash V1739 V1740))))) (do (shen.set-lambda-form-entry (cons get (lambda V1741 (lambda V1742 (lambda V1743 (get V1741 V1742 V1743)))))) (do (shen.set-lambda-form-entry (cons get-time (lambda V1744 (get-time V1744)))) (do (shen.set-lambda-form-entry (cons gensym (lambda V1745 (gensym V1745)))) (do (shen.set-lambda-form-entry (cons fst (lambda V1746 (fst V1746)))) (do (shen.set-lambda-form-entry (cons freeze (lambda V1747 (freeze V1747)))) (do (shen.set-lambda-form-entry (cons fix (lambda V1748 (lambda V1749 (fix V1748 V1749))))) (do (shen.set-lambda-form-entry (cons fail-if (lambda V1750 (lambda V1751 (fail-if V1750 V1751))))) (do (shen.set-lambda-form-entry (cons findall (lambda V1752 (lambda V1753 (lambda V1754 (lambda V1755 (lambda V1756 (findall V1752 V1753 V1754 V1755 V1756)))))))) (do (shen.set-lambda-form-entry (cons enable-type-theory (lambda V1757 (enable-type-theory V1757)))) (do (shen.set-lambda-form-entry (cons explode (lambda V1758 (explode V1758)))) (do (shen.set-lambda-form-entry (cons external (lambda V1759 (external V1759)))) (do (shen.set-lambda-form-entry (cons eval-kl (lambda V1760 (eval-kl V1760)))) (do (shen.set-lambda-form-entry (cons eval (lambda V1761 (eval V1761)))) (do (shen.set-lambda-form-entry (cons error-to-string (lambda V1762 (error-to-string V1762)))) (do (shen.set-lambda-form-entry (cons empty? (lambda V1763 (empty? V1763)))) (do (shen.set-lambda-form-entry (cons element? (lambda V1764 (lambda V1765 (element? V1764 V1765))))) (do (shen.set-lambda-form-entry (cons do (lambda V1766 (lambda V1767 (do V1766 V1767))))) (do (shen.set-lambda-form-entry (cons difference (lambda V1768 (lambda V1769 (difference V1768 V1769))))) (do (shen.set-lambda-form-entry (cons destroy (lambda V1770 (destroy V1770)))) (do (shen.set-lambda-form-entry (cons declare (lambda V1771 (lambda V1772 (declare V1771 V1772))))) (do (shen.set-lambda-form-entry (cons cn (lambda V1773 (lambda V1774 (cn V1773 V1774))))) (do (shen.set-lambda-form-entry (cons cons? (lambda V1775 (cons? V1775)))) (do (shen.set-lambda-form-entry (cons cons (lambda V1776 (lambda V1777 (cons V1776 V1777))))) (do (shen.set-lambda-form-entry (cons concat (lambda V1778 (lambda V1779 (concat V1778 V1779))))) (do (shen.set-lambda-form-entry (cons compile (lambda V1780 (lambda V1781 (lambda V1782 (compile V1780 V1781 V1782)))))) (do (shen.set-lambda-form-entry (cons cd (lambda V1783 (cd V1783)))) (do (shen.set-lambda-form-entry (cons close (lambda V1784 (close V1784)))) (do (shen.set-lambda-form-entry (cons bound? (lambda V1785 (bound? V1785)))) (do (shen.set-lambda-form-entry (cons boolean? (lambda V1786 (boolean? V1786)))) (do (shen.set-lambda-form-entry (cons assoc (lambda V1787 (lambda V1788 (assoc V1787 V1788))))) (do (shen.set-lambda-form-entry (cons arity (lambda V1789 (arity V1789)))) (do (shen.set-lambda-form-entry (cons append (lambda V1790 (lambda V1791 (append V1790 V1791))))) (do (shen.set-lambda-form-entry (cons and (lambda V1792 (lambda V1793 (and V1792 V1793))))) (do (shen.set-lambda-form-entry (cons adjoin (lambda V1794 (lambda V1795 (adjoin V1794 V1795))))) (do (shen.set-lambda-form-entry (cons <-address (lambda V1796 (lambda V1797 (<-address V1796 V1797))))) (do (shen.set-lambda-form-entry (cons address-> (lambda V1798 (lambda V1799 (lambda V1800 (address-> V1798 V1799 V1800)))))) (do (shen.set-lambda-form-entry (cons absvector? (lambda V1801 (absvector? V1801)))) (do (shen.set-lambda-form-entry (cons absvector (lambda V1802 (absvector V1802)))) (do (set shen.*history* ()) (do (set shen.*step* false) (do (set shen.*signedfuncs* (cons (cons absvector? (cons A (cons --> (cons boolean ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-absvector? (lambda V4342 (lambda V4343 (lambda V4344 (shen.type-signature-of-absvector? V4342 V4343 V4344)))))) (do (set shen.*signedfuncs* (cons (cons adjoin (cons A (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-adjoin (lambda V4352 (lambda V4353 (lambda V4354 (shen.type-signature-of-adjoin V4352 V4353 V4354)))))) (do (set shen.*signedfuncs* (cons (cons and (cons boolean (cons --> (cons (cons boolean (cons --> (cons boolean ()))) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-and (lambda V4362 (lambda V4363 (lambda V4364 (shen.type-signature-of-and V4362 V4363 V4364)))))) (do (set shen.*signedfuncs* (cons (cons shen.app (cons A (cons --> (cons (cons string (cons --> (cons (cons symbol (cons --> (cons string ()))) ()))) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-shen.app (lambda V4372 (lambda V4373 (lambda V4374 (shen.type-signature-of-shen.app V4372 V4373 V4374)))))) (do (set shen.*signedfuncs* (cons (cons append (cons (cons list (cons A ())) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-append (lambda V4382 (lambda V4383 (lambda V4384 (shen.type-signature-of-append V4382 V4383 V4384)))))) (do (set shen.*signedfuncs* (cons (cons arity (cons A (cons --> (cons number ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-arity (lambda V4392 (lambda V4393 (lambda V4394 (shen.type-signature-of-arity V4392 V4393 V4394)))))) (do (set shen.*signedfuncs* (cons (cons assoc (cons A (cons --> (cons (cons (cons list (cons (cons list (cons A ())) ())) (cons --> (cons (cons list (cons A ())) ()))) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-assoc (lambda V4402 (lambda V4403 (lambda V4404 (shen.type-signature-of-assoc V4402 V4403 V4404)))))) (do (set shen.*signedfuncs* (cons (cons boolean? (cons A (cons --> (cons boolean ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-boolean? (lambda V4412 (lambda V4413 (lambda V4414 (shen.type-signature-of-boolean? V4412 V4413 V4414)))))) (do (set shen.*signedfuncs* (cons (cons bound? (cons symbol (cons --> (cons boolean ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-bound? (lambda V4422 (lambda V4423 (lambda V4424 (shen.type-signature-of-bound? V4422 V4423 V4424)))))) (do (set shen.*signedfuncs* (cons (cons cd (cons string (cons --> (cons string ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-cd (lambda V4432 (lambda V4433 (lambda V4434 (shen.type-signature-of-cd V4432 V4433 V4434)))))) (do (set shen.*signedfuncs* (cons (cons close (cons (cons stream (cons A ())) (cons --> (cons (cons list (cons B ())) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-close (lambda V4442 (lambda V4443 (lambda V4444 (shen.type-signature-of-close V4442 V4443 V4444)))))) (do (set shen.*signedfuncs* (cons (cons cn (cons string (cons --> (cons (cons string (cons --> (cons string ()))) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-cn (lambda V4452 (lambda V4453 (lambda V4454 (shen.type-signature-of-cn V4452 V4453 V4454)))))) (do (set shen.*signedfuncs* (cons (cons compile (cons (cons A (cons shen.==> (cons B ()))) (cons --> (cons (cons A (cons --> (cons (cons (cons A (cons --> (cons B ()))) (cons --> (cons B ()))) ()))) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-compile (lambda V4462 (lambda V4463 (lambda V4464 (shen.type-signature-of-compile V4462 V4463 V4464)))))) (do (set shen.*signedfuncs* (cons (cons cons? (cons A (cons --> (cons boolean ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-cons? (lambda V4472 (lambda V4473 (lambda V4474 (shen.type-signature-of-cons? V4472 V4473 V4474)))))) (do (set shen.*signedfuncs* (cons (cons destroy (cons (cons A (cons --> (cons B ()))) (cons --> (cons symbol ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-destroy (lambda V4482 (lambda V4483 (lambda V4484 (shen.type-signature-of-destroy V4482 V4483 V4484)))))) (do (set shen.*signedfuncs* (cons (cons difference (cons (cons list (cons A ())) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-difference (lambda V4492 (lambda V4493 (lambda V4494 (shen.type-signature-of-difference V4492 V4493 V4494)))))) (do (set shen.*signedfuncs* (cons (cons do (cons A (cons --> (cons (cons B (cons --> (cons B ()))) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-do (lambda V4502 (lambda V4503 (lambda V4504 (shen.type-signature-of-do V4502 V4503 V4504)))))) (do (set shen.*signedfuncs* (cons (cons (cons (cons list (cons A ())) (cons shen.==> (cons (cons list (cons B ())) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of- (lambda V4512 (lambda V4513 (lambda V4514 (shen.type-signature-of- V4512 V4513 V4514)))))) (do (set shen.*signedfuncs* (cons (cons (cons (cons list (cons A ())) (cons shen.==> (cons (cons list (cons A ())) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of- (lambda V4522 (lambda V4523 (lambda V4524 (shen.type-signature-of- V4522 V4523 V4524)))))) (do (set shen.*signedfuncs* (cons (cons element? (cons A (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons boolean ()))) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-element? (lambda V4532 (lambda V4533 (lambda V4534 (shen.type-signature-of-element? V4532 V4533 V4534)))))) (do (set shen.*signedfuncs* (cons (cons empty? (cons A (cons --> (cons boolean ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-empty? (lambda V4542 (lambda V4543 (lambda V4544 (shen.type-signature-of-empty? V4542 V4543 V4544)))))) (do (set shen.*signedfuncs* (cons (cons enable-type-theory (cons symbol (cons --> (cons boolean ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-enable-type-theory (lambda V4552 (lambda V4553 (lambda V4554 (shen.type-signature-of-enable-type-theory V4552 V4553 V4554)))))) (do (set shen.*signedfuncs* (cons (cons external (cons symbol (cons --> (cons (cons list (cons symbol ())) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-external (lambda V4562 (lambda V4563 (lambda V4564 (shen.type-signature-of-external V4562 V4563 V4564)))))) (do (set shen.*signedfuncs* (cons (cons error-to-string (cons exception (cons --> (cons string ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-error-to-string (lambda V4572 (lambda V4573 (lambda V4574 (shen.type-signature-of-error-to-string V4572 V4573 V4574)))))) (do (set shen.*signedfuncs* (cons (cons explode (cons A (cons --> (cons (cons list (cons string ())) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-explode (lambda V4582 (lambda V4583 (lambda V4584 (shen.type-signature-of-explode V4582 V4583 V4584)))))) (do (set shen.*signedfuncs* (cons (cons fail (cons --> (cons symbol ()))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-fail (lambda V4592 (lambda V4593 (lambda V4594 (shen.type-signature-of-fail V4592 V4593 V4594)))))) (do (set shen.*signedfuncs* (cons (cons fail-if (cons (cons symbol (cons --> (cons boolean ()))) (cons --> (cons (cons symbol (cons --> (cons symbol ()))) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-fail-if (lambda V4602 (lambda V4603 (lambda V4604 (shen.type-signature-of-fail-if V4602 V4603 V4604)))))) (do (set shen.*signedfuncs* (cons (cons fix (cons (cons A (cons --> (cons A ()))) (cons --> (cons (cons A (cons --> (cons A ()))) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-fix (lambda V4612 (lambda V4613 (lambda V4614 (shen.type-signature-of-fix V4612 V4613 V4614)))))) (do (set shen.*signedfuncs* (cons (cons freeze (cons A (cons --> (cons (cons lazy (cons A ())) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-freeze (lambda V4622 (lambda V4623 (lambda V4624 (shen.type-signature-of-freeze V4622 V4623 V4624)))))) (do (set shen.*signedfuncs* (cons (cons fst (cons (cons A (cons * (cons B ()))) (cons --> (cons A ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-fst (lambda V4632 (lambda V4633 (lambda V4634 (shen.type-signature-of-fst V4632 V4633 V4634)))))) (do (set shen.*signedfuncs* (cons (cons function (cons (cons A (cons --> (cons B ()))) (cons --> (cons (cons A (cons --> (cons B ()))) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-function (lambda V4642 (lambda V4643 (lambda V4644 (shen.type-signature-of-function V4642 V4643 V4644)))))) (do (set shen.*signedfuncs* (cons (cons gensym (cons symbol (cons --> (cons symbol ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-gensym (lambda V4652 (lambda V4653 (lambda V4654 (shen.type-signature-of-gensym V4652 V4653 V4654)))))) (do (set shen.*signedfuncs* (cons (cons <-vector (cons (cons vector (cons A ())) (cons --> (cons (cons number (cons --> (cons A ()))) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-<-vector (lambda V4662 (lambda V4663 (lambda V4664 (shen.type-signature-of-<-vector V4662 V4663 V4664)))))) (do (set shen.*signedfuncs* (cons (cons vector-> (cons (cons vector (cons A ())) (cons --> (cons (cons number (cons --> (cons (cons A (cons --> (cons (cons vector (cons A ())) ()))) ()))) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-vector-> (lambda V4672 (lambda V4673 (lambda V4674 (shen.type-signature-of-vector-> V4672 V4673 V4674)))))) (do (set shen.*signedfuncs* (cons (cons vector (cons number (cons --> (cons (cons vector (cons A ())) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-vector (lambda V4682 (lambda V4683 (lambda V4684 (shen.type-signature-of-vector V4682 V4683 V4684)))))) (do (set shen.*signedfuncs* (cons (cons get-time (cons symbol (cons --> (cons number ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-get-time (lambda V4692 (lambda V4693 (lambda V4694 (shen.type-signature-of-get-time V4692 V4693 V4694)))))) (do (set shen.*signedfuncs* (cons (cons hash (cons A (cons --> (cons (cons number (cons --> (cons number ()))) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-hash (lambda V4702 (lambda V4703 (lambda V4704 (shen.type-signature-of-hash V4702 V4703 V4704)))))) (do (set shen.*signedfuncs* (cons (cons head (cons (cons list (cons A ())) (cons --> (cons A ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-head (lambda V4712 (lambda V4713 (lambda V4714 (shen.type-signature-of-head V4712 V4713 V4714)))))) (do (set shen.*signedfuncs* (cons (cons hdv (cons (cons vector (cons A ())) (cons --> (cons A ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-hdv (lambda V4722 (lambda V4723 (lambda V4724 (shen.type-signature-of-hdv V4722 V4723 V4724)))))) (do (set shen.*signedfuncs* (cons (cons hdstr (cons string (cons --> (cons string ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-hdstr (lambda V4732 (lambda V4733 (lambda V4734 (shen.type-signature-of-hdstr V4732 V4733 V4734)))))) (do (set shen.*signedfuncs* (cons (cons if (cons boolean (cons --> (cons (cons A (cons --> (cons (cons A (cons --> (cons A ()))) ()))) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-if (lambda V4742 (lambda V4743 (lambda V4744 (shen.type-signature-of-if V4742 V4743 V4744)))))) (do (set shen.*signedfuncs* (cons (cons it (cons --> (cons string ()))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-it (lambda V4752 (lambda V4753 (lambda V4754 (shen.type-signature-of-it V4752 V4753 V4754)))))) (do (set shen.*signedfuncs* (cons (cons implementation (cons --> (cons string ()))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-implementation (lambda V4762 (lambda V4763 (lambda V4764 (shen.type-signature-of-implementation V4762 V4763 V4764)))))) (do (set shen.*signedfuncs* (cons (cons include (cons (cons list (cons symbol ())) (cons --> (cons (cons list (cons symbol ())) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-include (lambda V4772 (lambda V4773 (lambda V4774 (shen.type-signature-of-include V4772 V4773 V4774)))))) (do (set shen.*signedfuncs* (cons (cons include-all-but (cons (cons list (cons symbol ())) (cons --> (cons (cons list (cons symbol ())) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-include-all-but (lambda V4782 (lambda V4783 (lambda V4784 (shen.type-signature-of-include-all-but V4782 V4783 V4784)))))) (do (set shen.*signedfuncs* (cons (cons inferences (cons --> (cons number ()))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-inferences (lambda V4792 (lambda V4793 (lambda V4794 (shen.type-signature-of-inferences V4792 V4793 V4794)))))) (do (set shen.*signedfuncs* (cons (cons shen.insert (cons A (cons --> (cons (cons string (cons --> (cons string ()))) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-shen.insert (lambda V4802 (lambda V4803 (lambda V4804 (shen.type-signature-of-shen.insert V4802 V4803 V4804)))))) (do (set shen.*signedfuncs* (cons (cons integer? (cons A (cons --> (cons boolean ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-integer? (lambda V4812 (lambda V4813 (lambda V4814 (shen.type-signature-of-integer? V4812 V4813 V4814)))))) (do (set shen.*signedfuncs* (cons (cons internal (cons symbol (cons --> (cons (cons list (cons symbol ())) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-internal (lambda V4822 (lambda V4823 (lambda V4824 (shen.type-signature-of-internal V4822 V4823 V4824)))))) (do (set shen.*signedfuncs* (cons (cons intersection (cons (cons list (cons A ())) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-intersection (lambda V4832 (lambda V4833 (lambda V4834 (shen.type-signature-of-intersection V4832 V4833 V4834)))))) (do (set shen.*signedfuncs* (cons (cons kill (cons --> (cons A ()))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-kill (lambda V4842 (lambda V4843 (lambda V4844 (shen.type-signature-of-kill V4842 V4843 V4844)))))) (do (set shen.*signedfuncs* (cons (cons language (cons --> (cons string ()))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-language (lambda V4852 (lambda V4853 (lambda V4854 (shen.type-signature-of-language V4852 V4853 V4854)))))) (do (set shen.*signedfuncs* (cons (cons length (cons (cons list (cons A ())) (cons --> (cons number ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-length (lambda V4862 (lambda V4863 (lambda V4864 (shen.type-signature-of-length V4862 V4863 V4864)))))) (do (set shen.*signedfuncs* (cons (cons limit (cons (cons vector (cons A ())) (cons --> (cons number ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-limit (lambda V4872 (lambda V4873 (lambda V4874 (shen.type-signature-of-limit V4872 V4873 V4874)))))) (do (set shen.*signedfuncs* (cons (cons load (cons string (cons --> (cons symbol ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-load (lambda V4882 (lambda V4883 (lambda V4884 (shen.type-signature-of-load V4882 V4883 V4884)))))) (do (set shen.*signedfuncs* (cons (cons map (cons (cons A (cons --> (cons B ()))) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons B ())) ()))) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-map (lambda V4892 (lambda V4893 (lambda V4894 (shen.type-signature-of-map V4892 V4893 V4894)))))) (do (set shen.*signedfuncs* (cons (cons mapcan (cons (cons A (cons --> (cons (cons list (cons B ())) ()))) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons B ())) ()))) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-mapcan (lambda V4902 (lambda V4903 (lambda V4904 (shen.type-signature-of-mapcan V4902 V4903 V4904)))))) (do (set shen.*signedfuncs* (cons (cons maxinferences (cons number (cons --> (cons number ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-maxinferences (lambda V4912 (lambda V4913 (lambda V4914 (shen.type-signature-of-maxinferences V4912 V4913 V4914)))))) (do (set shen.*signedfuncs* (cons (cons n->string (cons number (cons --> (cons string ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-n->string (lambda V4922 (lambda V4923 (lambda V4924 (shen.type-signature-of-n->string V4922 V4923 V4924)))))) (do (set shen.*signedfuncs* (cons (cons nl (cons number (cons --> (cons number ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-nl (lambda V4932 (lambda V4933 (lambda V4934 (shen.type-signature-of-nl V4932 V4933 V4934)))))) (do (set shen.*signedfuncs* (cons (cons not (cons boolean (cons --> (cons boolean ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-not (lambda V4942 (lambda V4943 (lambda V4944 (shen.type-signature-of-not V4942 V4943 V4944)))))) (do (set shen.*signedfuncs* (cons (cons nth (cons number (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons A ()))) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-nth (lambda V4952 (lambda V4953 (lambda V4954 (shen.type-signature-of-nth V4952 V4953 V4954)))))) (do (set shen.*signedfuncs* (cons (cons number? (cons A (cons --> (cons boolean ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-number? (lambda V4962 (lambda V4963 (lambda V4964 (shen.type-signature-of-number? V4962 V4963 V4964)))))) (do (set shen.*signedfuncs* (cons (cons occurrences (cons A (cons --> (cons (cons B (cons --> (cons number ()))) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-occurrences (lambda V4972 (lambda V4973 (lambda V4974 (shen.type-signature-of-occurrences V4972 V4973 V4974)))))) (do (set shen.*signedfuncs* (cons (cons occurs-check (cons symbol (cons --> (cons boolean ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-occurs-check (lambda V4982 (lambda V4983 (lambda V4984 (shen.type-signature-of-occurs-check V4982 V4983 V4984)))))) (do (set shen.*signedfuncs* (cons (cons optimise (cons symbol (cons --> (cons boolean ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-optimise (lambda V4992 (lambda V4993 (lambda V4994 (shen.type-signature-of-optimise V4992 V4993 V4994)))))) (do (set shen.*signedfuncs* (cons (cons or (cons boolean (cons --> (cons (cons boolean (cons --> (cons boolean ()))) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-or (lambda V5002 (lambda V5003 (lambda V5004 (shen.type-signature-of-or V5002 V5003 V5004)))))) (do (set shen.*signedfuncs* (cons (cons os (cons --> (cons string ()))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-os (lambda V5012 (lambda V5013 (lambda V5014 (shen.type-signature-of-os V5012 V5013 V5014)))))) (do (set shen.*signedfuncs* (cons (cons package? (cons symbol (cons --> (cons boolean ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-package? (lambda V5022 (lambda V5023 (lambda V5024 (shen.type-signature-of-package? V5022 V5023 V5024)))))) (do (set shen.*signedfuncs* (cons (cons port (cons --> (cons string ()))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-port (lambda V5032 (lambda V5033 (lambda V5034 (shen.type-signature-of-port V5032 V5033 V5034)))))) (do (set shen.*signedfuncs* (cons (cons porters (cons --> (cons string ()))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-porters (lambda V5042 (lambda V5043 (lambda V5044 (shen.type-signature-of-porters V5042 V5043 V5044)))))) (do (set shen.*signedfuncs* (cons (cons pos (cons string (cons --> (cons (cons number (cons --> (cons string ()))) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-pos (lambda V5052 (lambda V5053 (lambda V5054 (shen.type-signature-of-pos V5052 V5053 V5054)))))) (do (set shen.*signedfuncs* (cons (cons pr (cons string (cons --> (cons (cons (cons stream (cons out ())) (cons --> (cons string ()))) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-pr (lambda V5062 (lambda V5063 (lambda V5064 (shen.type-signature-of-pr V5062 V5063 V5064)))))) (do (set shen.*signedfuncs* (cons (cons print (cons A (cons --> (cons A ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-print (lambda V5072 (lambda V5073 (lambda V5074 (shen.type-signature-of-print V5072 V5073 V5074)))))) (do (set shen.*signedfuncs* (cons (cons profile (cons (cons A (cons --> (cons B ()))) (cons --> (cons (cons A (cons --> (cons B ()))) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-profile (lambda V5082 (lambda V5083 (lambda V5084 (shen.type-signature-of-profile V5082 V5083 V5084)))))) (do (set shen.*signedfuncs* (cons (cons preclude (cons (cons list (cons symbol ())) (cons --> (cons (cons list (cons symbol ())) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-preclude (lambda V5092 (lambda V5093 (lambda V5094 (shen.type-signature-of-preclude V5092 V5093 V5094)))))) (do (set shen.*signedfuncs* (cons (cons shen.proc-nl (cons string (cons --> (cons string ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-shen.proc-nl (lambda V5102 (lambda V5103 (lambda V5104 (shen.type-signature-of-shen.proc-nl V5102 V5103 V5104)))))) (do (set shen.*signedfuncs* (cons (cons profile-results (cons (cons A (cons --> (cons B ()))) (cons --> (cons (cons (cons A (cons --> (cons B ()))) (cons * (cons number ()))) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-profile-results (lambda V5112 (lambda V5113 (lambda V5114 (shen.type-signature-of-profile-results V5112 V5113 V5114)))))) (do (set shen.*signedfuncs* (cons (cons protect (cons symbol (cons --> (cons symbol ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-protect (lambda V5122 (lambda V5123 (lambda V5124 (shen.type-signature-of-protect V5122 V5123 V5124)))))) (do (set shen.*signedfuncs* (cons (cons preclude-all-but (cons (cons list (cons symbol ())) (cons --> (cons (cons list (cons symbol ())) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-preclude-all-but (lambda V5132 (lambda V5133 (lambda V5134 (shen.type-signature-of-preclude-all-but V5132 V5133 V5134)))))) (do (set shen.*signedfuncs* (cons (cons shen.prhush (cons string (cons --> (cons (cons (cons stream (cons out ())) (cons --> (cons string ()))) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-shen.prhush (lambda V5142 (lambda V5143 (lambda V5144 (shen.type-signature-of-shen.prhush V5142 V5143 V5144)))))) (do (set shen.*signedfuncs* (cons (cons ps (cons symbol (cons --> (cons (cons list (cons unit ())) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-ps (lambda V5152 (lambda V5153 (lambda V5154 (shen.type-signature-of-ps V5152 V5153 V5154)))))) (do (set shen.*signedfuncs* (cons (cons read (cons (cons stream (cons in ())) (cons --> (cons unit ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-read (lambda V5162 (lambda V5163 (lambda V5164 (shen.type-signature-of-read V5162 V5163 V5164)))))) (do (set shen.*signedfuncs* (cons (cons read-byte (cons (cons stream (cons in ())) (cons --> (cons number ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-read-byte (lambda V5172 (lambda V5173 (lambda V5174 (shen.type-signature-of-read-byte V5172 V5173 V5174)))))) (do (set shen.*signedfuncs* (cons (cons read-file-as-bytelist (cons string (cons --> (cons (cons list (cons number ())) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-read-file-as-bytelist (lambda V5182 (lambda V5183 (lambda V5184 (shen.type-signature-of-read-file-as-bytelist V5182 V5183 V5184)))))) (do (set shen.*signedfuncs* (cons (cons read-file-as-string (cons string (cons --> (cons string ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-read-file-as-string (lambda V5192 (lambda V5193 (lambda V5194 (shen.type-signature-of-read-file-as-string V5192 V5193 V5194)))))) (do (set shen.*signedfuncs* (cons (cons read-file (cons string (cons --> (cons (cons list (cons unit ())) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-read-file (lambda V5202 (lambda V5203 (lambda V5204 (shen.type-signature-of-read-file V5202 V5203 V5204)))))) (do (set shen.*signedfuncs* (cons (cons read-from-string (cons string (cons --> (cons (cons list (cons unit ())) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-read-from-string (lambda V5212 (lambda V5213 (lambda V5214 (shen.type-signature-of-read-from-string V5212 V5213 V5214)))))) (do (set shen.*signedfuncs* (cons (cons release (cons --> (cons string ()))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-release (lambda V5222 (lambda V5223 (lambda V5224 (shen.type-signature-of-release V5222 V5223 V5224)))))) (do (set shen.*signedfuncs* (cons (cons remove (cons A (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-remove (lambda V5232 (lambda V5233 (lambda V5234 (shen.type-signature-of-remove V5232 V5233 V5234)))))) (do (set shen.*signedfuncs* (cons (cons reverse (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-reverse (lambda V5242 (lambda V5243 (lambda V5244 (shen.type-signature-of-reverse V5242 V5243 V5244)))))) (do (set shen.*signedfuncs* (cons (cons simple-error (cons string (cons --> (cons A ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-simple-error (lambda V5252 (lambda V5253 (lambda V5254 (shen.type-signature-of-simple-error V5252 V5253 V5254)))))) (do (set shen.*signedfuncs* (cons (cons snd (cons (cons A (cons * (cons B ()))) (cons --> (cons B ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-snd (lambda V5262 (lambda V5263 (lambda V5264 (shen.type-signature-of-snd V5262 V5263 V5264)))))) (do (set shen.*signedfuncs* (cons (cons specialise (cons symbol (cons --> (cons symbol ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-specialise (lambda V5272 (lambda V5273 (lambda V5274 (shen.type-signature-of-specialise V5272 V5273 V5274)))))) (do (set shen.*signedfuncs* (cons (cons spy (cons symbol (cons --> (cons boolean ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-spy (lambda V5282 (lambda V5283 (lambda V5284 (shen.type-signature-of-spy V5282 V5283 V5284)))))) (do (set shen.*signedfuncs* (cons (cons step (cons symbol (cons --> (cons boolean ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-step (lambda V5292 (lambda V5293 (lambda V5294 (shen.type-signature-of-step V5292 V5293 V5294)))))) (do (set shen.*signedfuncs* (cons (cons stinput (cons --> (cons (cons stream (cons in ())) ()))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-stinput (lambda V5302 (lambda V5303 (lambda V5304 (shen.type-signature-of-stinput V5302 V5303 V5304)))))) (do (set shen.*signedfuncs* (cons (cons sterror (cons --> (cons (cons stream (cons out ())) ()))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-sterror (lambda V5312 (lambda V5313 (lambda V5314 (shen.type-signature-of-sterror V5312 V5313 V5314)))))) (do (set shen.*signedfuncs* (cons (cons stoutput (cons --> (cons (cons stream (cons out ())) ()))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-stoutput (lambda V5322 (lambda V5323 (lambda V5324 (shen.type-signature-of-stoutput V5322 V5323 V5324)))))) (do (set shen.*signedfuncs* (cons (cons string? (cons A (cons --> (cons boolean ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-string? (lambda V5332 (lambda V5333 (lambda V5334 (shen.type-signature-of-string? V5332 V5333 V5334)))))) (do (set shen.*signedfuncs* (cons (cons str (cons A (cons --> (cons string ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-str (lambda V5342 (lambda V5343 (lambda V5344 (shen.type-signature-of-str V5342 V5343 V5344)))))) (do (set shen.*signedfuncs* (cons (cons string->n (cons string (cons --> (cons number ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-string->n (lambda V5352 (lambda V5353 (lambda V5354 (shen.type-signature-of-string->n V5352 V5353 V5354)))))) (do (set shen.*signedfuncs* (cons (cons string->symbol (cons string (cons --> (cons symbol ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-string->symbol (lambda V5362 (lambda V5363 (lambda V5364 (shen.type-signature-of-string->symbol V5362 V5363 V5364)))))) (do (set shen.*signedfuncs* (cons (cons sum (cons (cons list (cons number ())) (cons --> (cons number ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-sum (lambda V5372 (lambda V5373 (lambda V5374 (shen.type-signature-of-sum V5372 V5373 V5374)))))) (do (set shen.*signedfuncs* (cons (cons symbol? (cons A (cons --> (cons boolean ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-symbol? (lambda V5382 (lambda V5383 (lambda V5384 (shen.type-signature-of-symbol? V5382 V5383 V5384)))))) (do (set shen.*signedfuncs* (cons (cons systemf (cons symbol (cons --> (cons symbol ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-systemf (lambda V5392 (lambda V5393 (lambda V5394 (shen.type-signature-of-systemf V5392 V5393 V5394)))))) (do (set shen.*signedfuncs* (cons (cons tail (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-tail (lambda V5402 (lambda V5403 (lambda V5404 (shen.type-signature-of-tail V5402 V5403 V5404)))))) (do (set shen.*signedfuncs* (cons (cons tlstr (cons string (cons --> (cons string ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-tlstr (lambda V5412 (lambda V5413 (lambda V5414 (shen.type-signature-of-tlstr V5412 V5413 V5414)))))) (do (set shen.*signedfuncs* (cons (cons tlv (cons (cons vector (cons A ())) (cons --> (cons (cons vector (cons A ())) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-tlv (lambda V5422 (lambda V5423 (lambda V5424 (shen.type-signature-of-tlv V5422 V5423 V5424)))))) (do (set shen.*signedfuncs* (cons (cons tc (cons symbol (cons --> (cons boolean ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-tc (lambda V5432 (lambda V5433 (lambda V5434 (shen.type-signature-of-tc V5432 V5433 V5434)))))) (do (set shen.*signedfuncs* (cons (cons tc? (cons --> (cons boolean ()))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-tc? (lambda V5442 (lambda V5443 (lambda V5444 (shen.type-signature-of-tc? V5442 V5443 V5444)))))) (do (set shen.*signedfuncs* (cons (cons thaw (cons (cons lazy (cons A ())) (cons --> (cons A ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-thaw (lambda V5452 (lambda V5453 (lambda V5454 (shen.type-signature-of-thaw V5452 V5453 V5454)))))) (do (set shen.*signedfuncs* (cons (cons track (cons symbol (cons --> (cons symbol ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-track (lambda V5462 (lambda V5463 (lambda V5464 (shen.type-signature-of-track V5462 V5463 V5464)))))) (do (set shen.*signedfuncs* (cons (cons trap-error (cons A (cons --> (cons (cons (cons exception (cons --> (cons A ()))) (cons --> (cons A ()))) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-trap-error (lambda V5472 (lambda V5473 (lambda V5474 (shen.type-signature-of-trap-error V5472 V5473 V5474)))))) (do (set shen.*signedfuncs* (cons (cons tuple? (cons A (cons --> (cons boolean ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-tuple? (lambda V5482 (lambda V5483 (lambda V5484 (shen.type-signature-of-tuple? V5482 V5483 V5484)))))) (do (set shen.*signedfuncs* (cons (cons undefmacro (cons symbol (cons --> (cons symbol ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-undefmacro (lambda V5492 (lambda V5493 (lambda V5494 (shen.type-signature-of-undefmacro V5492 V5493 V5494)))))) (do (set shen.*signedfuncs* (cons (cons union (cons (cons list (cons A ())) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-union (lambda V5502 (lambda V5503 (lambda V5504 (shen.type-signature-of-union V5502 V5503 V5504)))))) (do (set shen.*signedfuncs* (cons (cons unprofile (cons (cons A (cons --> (cons B ()))) (cons --> (cons (cons A (cons --> (cons B ()))) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-unprofile (lambda V5512 (lambda V5513 (lambda V5514 (shen.type-signature-of-unprofile V5512 V5513 V5514)))))) (do (set shen.*signedfuncs* (cons (cons untrack (cons symbol (cons --> (cons symbol ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-untrack (lambda V5522 (lambda V5523 (lambda V5524 (shen.type-signature-of-untrack V5522 V5523 V5524)))))) (do (set shen.*signedfuncs* (cons (cons unspecialise (cons symbol (cons --> (cons symbol ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-unspecialise (lambda V5532 (lambda V5533 (lambda V5534 (shen.type-signature-of-unspecialise V5532 V5533 V5534)))))) (do (set shen.*signedfuncs* (cons (cons variable? (cons A (cons --> (cons boolean ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-variable? (lambda V5542 (lambda V5543 (lambda V5544 (shen.type-signature-of-variable? V5542 V5543 V5544)))))) (do (set shen.*signedfuncs* (cons (cons vector? (cons A (cons --> (cons boolean ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-vector? (lambda V5552 (lambda V5553 (lambda V5554 (shen.type-signature-of-vector? V5552 V5553 V5554)))))) (do (set shen.*signedfuncs* (cons (cons version (cons --> (cons string ()))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-version (lambda V5562 (lambda V5563 (lambda V5564 (shen.type-signature-of-version V5562 V5563 V5564)))))) (do (set shen.*signedfuncs* (cons (cons write-to-file (cons string (cons --> (cons (cons A (cons --> (cons A ()))) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-write-to-file (lambda V5572 (lambda V5573 (lambda V5574 (shen.type-signature-of-write-to-file V5572 V5573 V5574)))))) (do (set shen.*signedfuncs* (cons (cons write-byte (cons number (cons --> (cons (cons (cons stream (cons out ())) (cons --> (cons number ()))) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-write-byte (lambda V5582 (lambda V5583 (lambda V5584 (shen.type-signature-of-write-byte V5582 V5583 V5584)))))) (do (set shen.*signedfuncs* (cons (cons y-or-n? (cons string (cons --> (cons boolean ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-y-or-n? (lambda V5592 (lambda V5593 (lambda V5594 (shen.type-signature-of-y-or-n? V5592 V5593 V5594)))))) (do (set shen.*signedfuncs* (cons (cons > (cons number (cons --> (cons (cons number (cons --> (cons boolean ()))) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-> (lambda V5602 (lambda V5603 (lambda V5604 (shen.type-signature-of-> V5602 V5603 V5604)))))) (do (set shen.*signedfuncs* (cons (cons < (cons number (cons --> (cons (cons number (cons --> (cons boolean ()))) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-< (lambda V5612 (lambda V5613 (lambda V5614 (shen.type-signature-of-< V5612 V5613 V5614)))))) (do (set shen.*signedfuncs* (cons (cons >= (cons number (cons --> (cons (cons number (cons --> (cons boolean ()))) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of->= (lambda V5622 (lambda V5623 (lambda V5624 (shen.type-signature-of->= V5622 V5623 V5624)))))) (do (set shen.*signedfuncs* (cons (cons <= (cons number (cons --> (cons (cons number (cons --> (cons boolean ()))) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-<= (lambda V5632 (lambda V5633 (lambda V5634 (shen.type-signature-of-<= V5632 V5633 V5634)))))) (do (set shen.*signedfuncs* (cons (cons = (cons A (cons --> (cons (cons A (cons --> (cons boolean ()))) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-= (lambda V5642 (lambda V5643 (lambda V5644 (shen.type-signature-of-= V5642 V5643 V5644)))))) (do (set shen.*signedfuncs* (cons (cons + (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-+ (lambda V5652 (lambda V5653 (lambda V5654 (shen.type-signature-of-+ V5652 V5653 V5654)))))) (do (set shen.*signedfuncs* (cons (cons / (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-/ (lambda V5662 (lambda V5663 (lambda V5664 (shen.type-signature-of-/ V5662 V5663 V5664)))))) (do (set shen.*signedfuncs* (cons (cons - (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-- (lambda V5672 (lambda V5673 (lambda V5674 (shen.type-signature-of-- V5672 V5673 V5674)))))) (do (set shen.*signedfuncs* (cons (cons * (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-* (lambda V5682 (lambda V5683 (lambda V5684 (shen.type-signature-of-* V5682 V5683 V5684)))))) (do (set shen.*signedfuncs* (cons (cons == (cons A (cons --> (cons (cons B (cons --> (cons boolean ()))) ())))) (value shen.*signedfuncs*))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-== (lambda V5692 (lambda V5693 (lambda V5694 (shen.type-signature-of-== V5692 V5693 V5694)))))) (set shen.*empty-absvector* (absvector 0))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) +(defun shen.initialise-environment () (do (set shen.*installing-kl* false) (do (set shen.*history* ()) (do (set shen.*tc* false) (do (set *property-vector* (shen.dict 20000)) (do (set shen.*process-counter* 0) (do (set shen.*varcounter* (vector 10000)) (do (set shen.*prologvectors* (vector 10000)) (do (set shen.*demodulation-function* (lambda X X)) (do (set shen.*custom-pattern-compiler* (lambda Arg (lambda OnFail (thaw OnFail)))) (do (set shen.*custom-pattern-reducer* (lambda Arg Arg)) (do (set shen.*macroreg* (cons shen.timer-macro (cons shen.cases-macro (cons shen.abs-macro (cons shen.put/get-macro (cons shen.compile-macro (cons shen.datatype-macro (cons shen.let-macro (cons shen.assoc-macro (cons shen.make-string-macro (cons shen.output-macro (cons shen.input-macro (cons shen.error-macro (cons shen.prolog-macro (cons shen.synonyms-macro (cons shen.nl-macro (cons shen.@s-macro (cons shen.defprolog-macro (cons shen.function-macro ()))))))))))))))))))) (do (set *macros* (cons (lambda X (shen.timer-macro X)) (cons (lambda X (shen.cases-macro X)) (cons (lambda X (shen.abs-macro X)) (cons (lambda X (shen.put/get-macro X)) (cons (lambda X (shen.compile-macro X)) (cons (lambda X (shen.datatype-macro X)) (cons (lambda X (shen.let-macro X)) (cons (lambda X (shen.assoc-macro X)) (cons (lambda X (shen.make-string-macro X)) (cons (lambda X (shen.output-macro X)) (cons (lambda X (shen.input-macro X)) (cons (lambda X (shen.error-macro X)) (cons (lambda X (shen.prolog-macro X)) (cons (lambda X (shen.synonyms-macro X)) (cons (lambda X (shen.nl-macro X)) (cons (lambda X (shen.@s-macro X)) (cons (lambda X (shen.defprolog-macro X)) (cons (lambda X (shen.function-macro X)) ()))))))))))))))))))) (do (set shen.*gensym* 0) (do (set shen.*tracking* ()) (do (set shen.*alphabet* (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 ()))))))))))))))))))))))))))) (do (set shen.*special* (cons @p (cons @s (cons @v (cons cons (cons lambda (cons let (cons where (cons set (cons open ())))))))))) (do (set shen.*extraspecial* (cons define (cons shen.process-datatype (cons input+ (cons defcc (cons shen.read+ (cons defmacro ()))))))) (do (set shen.*spy* false) (do (set shen.*datatypes* ()) (do (set shen.*alldatatypes* ()) (do (set shen.*shen-type-theory-enabled?* true) (do (set shen.*synonyms* ()) (do (set shen.*system* ()) (do (set shen.*maxcomplexity* 128) (do (set shen.*occurs* true) (do (set shen.*maxinferences* 1000000) (do (set *maximum-print-sequence-size* 20) (do (set shen.*catch* 0) (do (set shen.*call* 0) (do (set shen.*infs* 0) (do (set *hush* false) (do (set shen.*optimise* false) (do (set *version* "Shen 22.4") (do (if (not (bound? *home-directory*)) (set *home-directory* "") shen.skip) (do (if (not (bound? *sterror*)) (set *sterror* (value *stoutput*)) shen.skip) (do (shen.initialise_arity_table (cons abort (cons 0 (cons absvector? (cons 1 (cons absvector (cons 1 (cons adjoin (cons 2 (cons and (cons 2 (cons append (cons 2 (cons arity (cons 1 (cons assoc (cons 2 (cons boolean? (cons 1 (cons bound? (cons 1 (cons cd (cons 1 (cons close (cons 1 (cons compile (cons 3 (cons concat (cons 2 (cons cons (cons 2 (cons cons? (cons 1 (cons cn (cons 2 (cons declare (cons 2 (cons destroy (cons 1 (cons difference (cons 2 (cons do (cons 2 (cons element? (cons 2 (cons empty? (cons 1 (cons enable-type-theory (cons 1 (cons error-to-string (cons 1 (cons shen.interror (cons 2 (cons eval (cons 1 (cons eval-kl (cons 1 (cons explode (cons 1 (cons external (cons 1 (cons fail-if (cons 2 (cons fail (cons 0 (cons fix (cons 2 (cons findall (cons 5 (cons freeze (cons 1 (cons fst (cons 1 (cons gensym (cons 1 (cons get (cons 3 (cons get-time (cons 1 (cons address-> (cons 3 (cons <-address (cons 2 (cons <-vector (cons 2 (cons > (cons 2 (cons >= (cons 2 (cons = (cons 2 (cons hash (cons 2 (cons hd (cons 1 (cons hdv (cons 1 (cons hdstr (cons 1 (cons head (cons 1 (cons if (cons 3 (cons integer? (cons 1 (cons intern (cons 1 (cons identical (cons 4 (cons inferences (cons 0 (cons input (cons 1 (cons input+ (cons 2 (cons implementation (cons 0 (cons intersection (cons 2 (cons internal (cons 1 (cons it (cons 0 (cons kill (cons 0 (cons language (cons 0 (cons length (cons 1 (cons limit (cons 1 (cons lineread (cons 1 (cons load (cons 1 (cons < (cons 2 (cons <= (cons 2 (cons vector (cons 1 (cons macroexpand (cons 1 (cons map (cons 2 (cons mapcan (cons 2 (cons maxinferences (cons 1 (cons nl (cons 1 (cons not (cons 1 (cons nth (cons 2 (cons n->string (cons 1 (cons number? (cons 1 (cons occurs-check (cons 1 (cons occurrences (cons 2 (cons occurs-check (cons 1 (cons open (cons 2 (cons optimise (cons 1 (cons or (cons 2 (cons os (cons 0 (cons package (cons 3 (cons package? (cons 1 (cons port (cons 0 (cons porters (cons 0 (cons pos (cons 2 (cons print (cons 1 (cons profile (cons 1 (cons profile-results (cons 1 (cons pr (cons 2 (cons ps (cons 1 (cons preclude (cons 1 (cons preclude-all-but (cons 1 (cons protect (cons 1 (cons address-> (cons 3 (cons put (cons 4 (cons shen.reassemble (cons 2 (cons read-file-as-string (cons 1 (cons read-file (cons 1 (cons read-file-as-bytelist (cons 1 (cons read (cons 1 (cons read-byte (cons 1 (cons read-from-string (cons 1 (cons receive (cons 1 (cons release (cons 0 (cons remove (cons 2 (cons shen.require (cons 3 (cons reverse (cons 1 (cons set (cons 2 (cons simple-error (cons 1 (cons snd (cons 1 (cons specialise (cons 1 (cons spy (cons 1 (cons step (cons 1 (cons stinput (cons 0 (cons stoutput (cons 0 (cons sterror (cons 0 (cons string->n (cons 1 (cons string->symbol (cons 1 (cons string? (cons 1 (cons str (cons 1 (cons subst (cons 3 (cons sum (cons 1 (cons symbol? (cons 1 (cons systemf (cons 1 (cons tail (cons 1 (cons tl (cons 1 (cons tc (cons 1 (cons tc? (cons 0 (cons thaw (cons 1 (cons tlstr (cons 1 (cons track (cons 1 (cons trap-error (cons 2 (cons tuple? (cons 1 (cons type (cons 2 (cons return (cons 3 (cons undefmacro (cons 1 (cons unput (cons 3 (cons unprofile (cons 1 (cons unify (cons 4 (cons unify! (cons 4 (cons union (cons 2 (cons untrack (cons 1 (cons unspecialise (cons 1 (cons undefmacro (cons 1 (cons vector (cons 1 (cons vector? (cons 1 (cons vector-> (cons 3 (cons value (cons 1 (cons variable? (cons 1 (cons version (cons 0 (cons write-byte (cons 2 (cons write-to-file (cons 2 (cons y-or-n? (cons 1 (cons + (cons 2 (cons * (cons 2 (cons / (cons 2 (cons - (cons 2 (cons == (cons 2 (cons (cons 1 (cons (cons 1 (cons @p (cons 2 (cons @v (cons 2 (cons @s (cons 2 (cons preclude (cons 1 (cons include (cons 1 (cons preclude-all-but (cons 1 (cons include-all-but (cons 1 ()))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) (do (put (intern "shen") shen.external-symbols (cons ! (cons } (cons { (cons --> (cons <-- (cons && (cons : (cons ; (cons :- (cons := (cons _ (cons , (cons *language* (cons *implementation* (cons *stinput* (cons *stoutput* (cons *sterror* (cons *home-directory* (cons *version* (cons *maximum-print-sequence-size* (cons *macros* (cons *os* (cons *release* (cons *property-vector* (cons *port* (cons *porters* (cons *hush* (cons @v (cons @p (cons @s (cons <- (cons -> (cons (cons (cons == (cons = (cons >= (cons > (cons /. (cons =! (cons $ (cons - (cons / (cons * (cons + (cons <= (cons < (cons >> (cons y-or-n? (cons write-to-file (cons write-byte (cons where (cons when (cons warn (cons version (cons verified (cons variable? (cons value (cons vector-> (cons <-vector (cons vector (cons vector? (cons unspecialise (cons untrack (cons unit (cons shen.unix (cons union (cons unify (cons unify! (cons unput (cons unprofile (cons undefmacro (cons return (cons type (cons tuple? (cons true (cons trap-error (cons track (cons time (cons thaw (cons tc? (cons tc (cons tl (cons tlstr (cons tlv (cons tail (cons systemf (cons synonyms (cons symbol (cons symbol? (cons string->symbol (cons sum (cons subst (cons string? (cons string->n (cons stream (cons string (cons stinput (cons sterror (cons stoutput (cons step (cons spy (cons specialise (cons snd (cons simple-error (cons set (cons save (cons str (cons run (cons reverse (cons remove (cons release (cons read (cons receive (cons read-file (cons read-file-as-bytelist (cons read-file-as-string (cons read-byte (cons read-from-string (cons package? (cons put (cons preclude (cons preclude-all-but (cons ps (cons prolog? (cons protect (cons profile-results (cons profile (cons print (cons pr (cons pos (cons porters (cons port (cons package (cons output (cons out (cons os (cons or (cons optimise (cons open (cons occurrences (cons occurs-check (cons n->string (cons number? (cons number (cons null (cons nth (cons not (cons nl (cons mode (cons macroexpand (cons maxinferences (cons mapcan (cons map (cons make-string (cons load (cons loaded (cons list (cons lineread (cons limit (cons length (cons let (cons lazy (cons lambda (cons language (cons kill (cons is (cons intersection (cons inferences (cons intern (cons integer? (cons input (cons input+ (cons include (cons include-all-but (cons it (cons in (cons internal (cons implementation (cons if (cons identical (cons head (cons hd (cons hdv (cons hdstr (cons hash (cons get (cons get-time (cons gensym (cons function (cons fst (cons freeze (cons fix (cons file (cons fail (cons fail-if (cons fwhen (cons findall (cons false (cons enable-type-theory (cons explode (cons external (cons exception (cons eval-kl (cons eval (cons error-to-string (cons error (cons empty? (cons element? (cons do (cons difference (cons destroy (cons defun (cons define (cons defmacro (cons defcc (cons defprolog (cons declare (cons datatype (cons cut (cons cn (cons cons? (cons cons (cons cond (cons concat (cons compile (cons cd (cons cases (cons call (cons close (cons bind (cons bound? (cons boolean? (cons boolean (cons bar! (cons assoc (cons arity (cons abort (cons append (cons and (cons adjoin (cons <-address (cons address-> (cons absvector? (cons absvector ()))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) (value *property-vector*)) (do (set shen.*history* ()) (do (set shen.*step* false) (set shen.*empty-absvector* (absvector 0)))))))))))))))))))))))))))))))))))))))))) + +(defun shen.initialise-signedfuncs () (do (set shen.*signedfuncs* ()) (do (set shen.*signedfuncs* (cons (cons absvector? (cons A (cons --> (cons boolean ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons adjoin (cons A (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons and (cons boolean (cons --> (cons (cons boolean (cons --> (cons boolean ()))) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons shen.app (cons A (cons --> (cons (cons string (cons --> (cons (cons symbol (cons --> (cons string ()))) ()))) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons append (cons (cons list (cons A ())) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons arity (cons A (cons --> (cons number ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons assoc (cons A (cons --> (cons (cons (cons list (cons (cons list (cons A ())) ())) (cons --> (cons (cons list (cons A ())) ()))) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons boolean? (cons A (cons --> (cons boolean ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons bound? (cons symbol (cons --> (cons boolean ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons cd (cons string (cons --> (cons string ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons close (cons (cons stream (cons A ())) (cons --> (cons (cons list (cons B ())) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons cn (cons string (cons --> (cons (cons string (cons --> (cons string ()))) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons compile (cons (cons A (cons shen.==> (cons B ()))) (cons --> (cons (cons A (cons --> (cons (cons (cons A (cons --> (cons B ()))) (cons --> (cons B ()))) ()))) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons cons? (cons A (cons --> (cons boolean ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons destroy (cons (cons A (cons --> (cons B ()))) (cons --> (cons symbol ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons difference (cons (cons list (cons A ())) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons do (cons A (cons --> (cons (cons B (cons --> (cons B ()))) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons (cons (cons list (cons A ())) (cons shen.==> (cons (cons list (cons B ())) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons (cons (cons list (cons A ())) (cons shen.==> (cons (cons list (cons A ())) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons element? (cons A (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons boolean ()))) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons empty? (cons A (cons --> (cons boolean ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons enable-type-theory (cons symbol (cons --> (cons boolean ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons external (cons symbol (cons --> (cons (cons list (cons symbol ())) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons error-to-string (cons exception (cons --> (cons string ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons explode (cons A (cons --> (cons (cons list (cons string ())) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons fail (cons --> (cons symbol ()))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons fail-if (cons (cons symbol (cons --> (cons boolean ()))) (cons --> (cons (cons symbol (cons --> (cons symbol ()))) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons fix (cons (cons A (cons --> (cons A ()))) (cons --> (cons (cons A (cons --> (cons A ()))) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons freeze (cons A (cons --> (cons (cons lazy (cons A ())) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons fst (cons (cons A (cons * (cons B ()))) (cons --> (cons A ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons function (cons (cons A (cons --> (cons B ()))) (cons --> (cons (cons A (cons --> (cons B ()))) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons gensym (cons symbol (cons --> (cons symbol ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons <-vector (cons (cons vector (cons A ())) (cons --> (cons (cons number (cons --> (cons A ()))) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons vector-> (cons (cons vector (cons A ())) (cons --> (cons (cons number (cons --> (cons (cons A (cons --> (cons (cons vector (cons A ())) ()))) ()))) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons vector (cons number (cons --> (cons (cons vector (cons A ())) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons get-time (cons symbol (cons --> (cons number ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons hash (cons A (cons --> (cons (cons number (cons --> (cons number ()))) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons head (cons (cons list (cons A ())) (cons --> (cons A ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons hdv (cons (cons vector (cons A ())) (cons --> (cons A ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons hdstr (cons string (cons --> (cons string ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons if (cons boolean (cons --> (cons (cons A (cons --> (cons (cons A (cons --> (cons A ()))) ()))) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons it (cons --> (cons string ()))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons implementation (cons --> (cons string ()))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons include (cons (cons list (cons symbol ())) (cons --> (cons (cons list (cons symbol ())) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons include-all-but (cons (cons list (cons symbol ())) (cons --> (cons (cons list (cons symbol ())) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons inferences (cons --> (cons number ()))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons shen.insert (cons A (cons --> (cons (cons string (cons --> (cons string ()))) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons integer? (cons A (cons --> (cons boolean ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons internal (cons symbol (cons --> (cons (cons list (cons symbol ())) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons intersection (cons (cons list (cons A ())) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons kill (cons --> (cons A ()))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons language (cons --> (cons string ()))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons length (cons (cons list (cons A ())) (cons --> (cons number ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons limit (cons (cons vector (cons A ())) (cons --> (cons number ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons load (cons string (cons --> (cons symbol ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons map (cons (cons A (cons --> (cons B ()))) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons B ())) ()))) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons mapcan (cons (cons A (cons --> (cons (cons list (cons B ())) ()))) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons B ())) ()))) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons maxinferences (cons number (cons --> (cons number ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons n->string (cons number (cons --> (cons string ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons nl (cons number (cons --> (cons number ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons not (cons boolean (cons --> (cons boolean ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons nth (cons number (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons A ()))) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons number? (cons A (cons --> (cons boolean ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons occurrences (cons A (cons --> (cons (cons B (cons --> (cons number ()))) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons occurs-check (cons symbol (cons --> (cons boolean ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons optimise (cons symbol (cons --> (cons boolean ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons or (cons boolean (cons --> (cons (cons boolean (cons --> (cons boolean ()))) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons os (cons --> (cons string ()))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons package? (cons symbol (cons --> (cons boolean ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons port (cons --> (cons string ()))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons porters (cons --> (cons string ()))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons pos (cons string (cons --> (cons (cons number (cons --> (cons string ()))) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons pr (cons string (cons --> (cons (cons (cons stream (cons out ())) (cons --> (cons string ()))) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons print (cons A (cons --> (cons A ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons profile (cons (cons A (cons --> (cons B ()))) (cons --> (cons (cons A (cons --> (cons B ()))) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons preclude (cons (cons list (cons symbol ())) (cons --> (cons (cons list (cons symbol ())) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons shen.proc-nl (cons string (cons --> (cons string ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons profile-results (cons (cons A (cons --> (cons B ()))) (cons --> (cons (cons (cons A (cons --> (cons B ()))) (cons * (cons number ()))) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons protect (cons symbol (cons --> (cons symbol ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons preclude-all-but (cons (cons list (cons symbol ())) (cons --> (cons (cons list (cons symbol ())) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons shen.prhush (cons string (cons --> (cons (cons (cons stream (cons out ())) (cons --> (cons string ()))) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons ps (cons symbol (cons --> (cons (cons list (cons unit ())) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons read (cons (cons stream (cons in ())) (cons --> (cons unit ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons read-byte (cons (cons stream (cons in ())) (cons --> (cons number ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons read-file-as-bytelist (cons string (cons --> (cons (cons list (cons number ())) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons read-file-as-string (cons string (cons --> (cons string ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons read-file (cons string (cons --> (cons (cons list (cons unit ())) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons read-from-string (cons string (cons --> (cons (cons list (cons unit ())) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons release (cons --> (cons string ()))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons remove (cons A (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons reverse (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons simple-error (cons string (cons --> (cons A ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons snd (cons (cons A (cons * (cons B ()))) (cons --> (cons B ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons specialise (cons symbol (cons --> (cons symbol ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons spy (cons symbol (cons --> (cons boolean ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons step (cons symbol (cons --> (cons boolean ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons stinput (cons --> (cons (cons stream (cons in ())) ()))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons sterror (cons --> (cons (cons stream (cons out ())) ()))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons stoutput (cons --> (cons (cons stream (cons out ())) ()))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons string? (cons A (cons --> (cons boolean ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons str (cons A (cons --> (cons string ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons string->n (cons string (cons --> (cons number ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons string->symbol (cons string (cons --> (cons symbol ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons sum (cons (cons list (cons number ())) (cons --> (cons number ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons symbol? (cons A (cons --> (cons boolean ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons systemf (cons symbol (cons --> (cons symbol ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons tail (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons tlstr (cons string (cons --> (cons string ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons tlv (cons (cons vector (cons A ())) (cons --> (cons (cons vector (cons A ())) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons tc (cons symbol (cons --> (cons boolean ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons tc? (cons --> (cons boolean ()))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons thaw (cons (cons lazy (cons A ())) (cons --> (cons A ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons track (cons symbol (cons --> (cons symbol ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons trap-error (cons A (cons --> (cons (cons (cons exception (cons --> (cons A ()))) (cons --> (cons A ()))) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons tuple? (cons A (cons --> (cons boolean ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons undefmacro (cons symbol (cons --> (cons symbol ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons union (cons (cons list (cons A ())) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons unprofile (cons (cons A (cons --> (cons B ()))) (cons --> (cons (cons A (cons --> (cons B ()))) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons untrack (cons symbol (cons --> (cons symbol ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons unspecialise (cons symbol (cons --> (cons symbol ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons variable? (cons A (cons --> (cons boolean ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons vector? (cons A (cons --> (cons boolean ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons version (cons --> (cons string ()))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons write-to-file (cons string (cons --> (cons (cons A (cons --> (cons A ()))) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons write-byte (cons number (cons --> (cons (cons (cons stream (cons out ())) (cons --> (cons number ()))) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons y-or-n? (cons string (cons --> (cons boolean ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons > (cons number (cons --> (cons (cons number (cons --> (cons boolean ()))) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons < (cons number (cons --> (cons (cons number (cons --> (cons boolean ()))) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons >= (cons number (cons --> (cons (cons number (cons --> (cons boolean ()))) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons <= (cons number (cons --> (cons (cons number (cons --> (cons boolean ()))) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons = (cons A (cons --> (cons (cons A (cons --> (cons boolean ()))) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons + (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons / (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons - (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ())))) (value shen.*signedfuncs*))) (do (set shen.*signedfuncs* (cons (cons * (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ())))) (value shen.*signedfuncs*))) (set shen.*signedfuncs* (cons (cons == (cons A (cons --> (cons (cons B (cons --> (cons boolean ()))) ())))) (value shen.*signedfuncs*)))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) + +(defun shen.initialise-signedfunc-lambda-forms () (do (shen.set-lambda-form-entry (cons shen.type-signature-of-absvector? (lambda V3181 (lambda V3182 (lambda V3183 (shen.type-signature-of-absvector? V3181 V3182 V3183)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-adjoin (lambda V3191 (lambda V3192 (lambda V3193 (shen.type-signature-of-adjoin V3191 V3192 V3193)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-and (lambda V3201 (lambda V3202 (lambda V3203 (shen.type-signature-of-and V3201 V3202 V3203)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-shen.app (lambda V3211 (lambda V3212 (lambda V3213 (shen.type-signature-of-shen.app V3211 V3212 V3213)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-append (lambda V3221 (lambda V3222 (lambda V3223 (shen.type-signature-of-append V3221 V3222 V3223)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-arity (lambda V3231 (lambda V3232 (lambda V3233 (shen.type-signature-of-arity V3231 V3232 V3233)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-assoc (lambda V3241 (lambda V3242 (lambda V3243 (shen.type-signature-of-assoc V3241 V3242 V3243)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-boolean? (lambda V3251 (lambda V3252 (lambda V3253 (shen.type-signature-of-boolean? V3251 V3252 V3253)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-bound? (lambda V3261 (lambda V3262 (lambda V3263 (shen.type-signature-of-bound? V3261 V3262 V3263)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-cd (lambda V3271 (lambda V3272 (lambda V3273 (shen.type-signature-of-cd V3271 V3272 V3273)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-close (lambda V3281 (lambda V3282 (lambda V3283 (shen.type-signature-of-close V3281 V3282 V3283)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-cn (lambda V3291 (lambda V3292 (lambda V3293 (shen.type-signature-of-cn V3291 V3292 V3293)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-compile (lambda V3301 (lambda V3302 (lambda V3303 (shen.type-signature-of-compile V3301 V3302 V3303)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-cons? (lambda V3311 (lambda V3312 (lambda V3313 (shen.type-signature-of-cons? V3311 V3312 V3313)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-destroy (lambda V3321 (lambda V3322 (lambda V3323 (shen.type-signature-of-destroy V3321 V3322 V3323)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-difference (lambda V3331 (lambda V3332 (lambda V3333 (shen.type-signature-of-difference V3331 V3332 V3333)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-do (lambda V3341 (lambda V3342 (lambda V3343 (shen.type-signature-of-do V3341 V3342 V3343)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of- (lambda V3351 (lambda V3352 (lambda V3353 (shen.type-signature-of- V3351 V3352 V3353)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of- (lambda V3361 (lambda V3362 (lambda V3363 (shen.type-signature-of- V3361 V3362 V3363)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-element? (lambda V3371 (lambda V3372 (lambda V3373 (shen.type-signature-of-element? V3371 V3372 V3373)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-empty? (lambda V3381 (lambda V3382 (lambda V3383 (shen.type-signature-of-empty? V3381 V3382 V3383)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-enable-type-theory (lambda V3391 (lambda V3392 (lambda V3393 (shen.type-signature-of-enable-type-theory V3391 V3392 V3393)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-external (lambda V3401 (lambda V3402 (lambda V3403 (shen.type-signature-of-external V3401 V3402 V3403)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-error-to-string (lambda V3411 (lambda V3412 (lambda V3413 (shen.type-signature-of-error-to-string V3411 V3412 V3413)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-explode (lambda V3421 (lambda V3422 (lambda V3423 (shen.type-signature-of-explode V3421 V3422 V3423)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-fail (lambda V3431 (lambda V3432 (lambda V3433 (shen.type-signature-of-fail V3431 V3432 V3433)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-fail-if (lambda V3441 (lambda V3442 (lambda V3443 (shen.type-signature-of-fail-if V3441 V3442 V3443)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-fix (lambda V3451 (lambda V3452 (lambda V3453 (shen.type-signature-of-fix V3451 V3452 V3453)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-freeze (lambda V3461 (lambda V3462 (lambda V3463 (shen.type-signature-of-freeze V3461 V3462 V3463)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-fst (lambda V3471 (lambda V3472 (lambda V3473 (shen.type-signature-of-fst V3471 V3472 V3473)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-function (lambda V3481 (lambda V3482 (lambda V3483 (shen.type-signature-of-function V3481 V3482 V3483)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-gensym (lambda V3491 (lambda V3492 (lambda V3493 (shen.type-signature-of-gensym V3491 V3492 V3493)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-<-vector (lambda V3501 (lambda V3502 (lambda V3503 (shen.type-signature-of-<-vector V3501 V3502 V3503)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-vector-> (lambda V3511 (lambda V3512 (lambda V3513 (shen.type-signature-of-vector-> V3511 V3512 V3513)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-vector (lambda V3521 (lambda V3522 (lambda V3523 (shen.type-signature-of-vector V3521 V3522 V3523)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-get-time (lambda V3531 (lambda V3532 (lambda V3533 (shen.type-signature-of-get-time V3531 V3532 V3533)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-hash (lambda V3541 (lambda V3542 (lambda V3543 (shen.type-signature-of-hash V3541 V3542 V3543)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-head (lambda V3551 (lambda V3552 (lambda V3553 (shen.type-signature-of-head V3551 V3552 V3553)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-hdv (lambda V3561 (lambda V3562 (lambda V3563 (shen.type-signature-of-hdv V3561 V3562 V3563)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-hdstr (lambda V3571 (lambda V3572 (lambda V3573 (shen.type-signature-of-hdstr V3571 V3572 V3573)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-if (lambda V3581 (lambda V3582 (lambda V3583 (shen.type-signature-of-if V3581 V3582 V3583)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-it (lambda V3591 (lambda V3592 (lambda V3593 (shen.type-signature-of-it V3591 V3592 V3593)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-implementation (lambda V3601 (lambda V3602 (lambda V3603 (shen.type-signature-of-implementation V3601 V3602 V3603)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-include (lambda V3611 (lambda V3612 (lambda V3613 (shen.type-signature-of-include V3611 V3612 V3613)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-include-all-but (lambda V3621 (lambda V3622 (lambda V3623 (shen.type-signature-of-include-all-but V3621 V3622 V3623)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-inferences (lambda V3631 (lambda V3632 (lambda V3633 (shen.type-signature-of-inferences V3631 V3632 V3633)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-shen.insert (lambda V3641 (lambda V3642 (lambda V3643 (shen.type-signature-of-shen.insert V3641 V3642 V3643)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-integer? (lambda V3651 (lambda V3652 (lambda V3653 (shen.type-signature-of-integer? V3651 V3652 V3653)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-internal (lambda V3661 (lambda V3662 (lambda V3663 (shen.type-signature-of-internal V3661 V3662 V3663)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-intersection (lambda V3671 (lambda V3672 (lambda V3673 (shen.type-signature-of-intersection V3671 V3672 V3673)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-kill (lambda V3681 (lambda V3682 (lambda V3683 (shen.type-signature-of-kill V3681 V3682 V3683)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-language (lambda V3691 (lambda V3692 (lambda V3693 (shen.type-signature-of-language V3691 V3692 V3693)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-length (lambda V3701 (lambda V3702 (lambda V3703 (shen.type-signature-of-length V3701 V3702 V3703)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-limit (lambda V3711 (lambda V3712 (lambda V3713 (shen.type-signature-of-limit V3711 V3712 V3713)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-load (lambda V3721 (lambda V3722 (lambda V3723 (shen.type-signature-of-load V3721 V3722 V3723)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-map (lambda V3731 (lambda V3732 (lambda V3733 (shen.type-signature-of-map V3731 V3732 V3733)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-mapcan (lambda V3741 (lambda V3742 (lambda V3743 (shen.type-signature-of-mapcan V3741 V3742 V3743)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-maxinferences (lambda V3751 (lambda V3752 (lambda V3753 (shen.type-signature-of-maxinferences V3751 V3752 V3753)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-n->string (lambda V3761 (lambda V3762 (lambda V3763 (shen.type-signature-of-n->string V3761 V3762 V3763)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-nl (lambda V3771 (lambda V3772 (lambda V3773 (shen.type-signature-of-nl V3771 V3772 V3773)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-not (lambda V3781 (lambda V3782 (lambda V3783 (shen.type-signature-of-not V3781 V3782 V3783)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-nth (lambda V3791 (lambda V3792 (lambda V3793 (shen.type-signature-of-nth V3791 V3792 V3793)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-number? (lambda V3801 (lambda V3802 (lambda V3803 (shen.type-signature-of-number? V3801 V3802 V3803)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-occurrences (lambda V3811 (lambda V3812 (lambda V3813 (shen.type-signature-of-occurrences V3811 V3812 V3813)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-occurs-check (lambda V3821 (lambda V3822 (lambda V3823 (shen.type-signature-of-occurs-check V3821 V3822 V3823)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-optimise (lambda V3831 (lambda V3832 (lambda V3833 (shen.type-signature-of-optimise V3831 V3832 V3833)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-or (lambda V3841 (lambda V3842 (lambda V3843 (shen.type-signature-of-or V3841 V3842 V3843)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-os (lambda V3851 (lambda V3852 (lambda V3853 (shen.type-signature-of-os V3851 V3852 V3853)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-package? (lambda V3861 (lambda V3862 (lambda V3863 (shen.type-signature-of-package? V3861 V3862 V3863)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-port (lambda V3871 (lambda V3872 (lambda V3873 (shen.type-signature-of-port V3871 V3872 V3873)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-porters (lambda V3881 (lambda V3882 (lambda V3883 (shen.type-signature-of-porters V3881 V3882 V3883)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-pos (lambda V3891 (lambda V3892 (lambda V3893 (shen.type-signature-of-pos V3891 V3892 V3893)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-pr (lambda V3901 (lambda V3902 (lambda V3903 (shen.type-signature-of-pr V3901 V3902 V3903)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-print (lambda V3911 (lambda V3912 (lambda V3913 (shen.type-signature-of-print V3911 V3912 V3913)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-profile (lambda V3921 (lambda V3922 (lambda V3923 (shen.type-signature-of-profile V3921 V3922 V3923)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-preclude (lambda V3931 (lambda V3932 (lambda V3933 (shen.type-signature-of-preclude V3931 V3932 V3933)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-shen.proc-nl (lambda V3941 (lambda V3942 (lambda V3943 (shen.type-signature-of-shen.proc-nl V3941 V3942 V3943)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-profile-results (lambda V3951 (lambda V3952 (lambda V3953 (shen.type-signature-of-profile-results V3951 V3952 V3953)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-protect (lambda V3961 (lambda V3962 (lambda V3963 (shen.type-signature-of-protect V3961 V3962 V3963)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-preclude-all-but (lambda V3971 (lambda V3972 (lambda V3973 (shen.type-signature-of-preclude-all-but V3971 V3972 V3973)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-shen.prhush (lambda V3981 (lambda V3982 (lambda V3983 (shen.type-signature-of-shen.prhush V3981 V3982 V3983)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-ps (lambda V3991 (lambda V3992 (lambda V3993 (shen.type-signature-of-ps V3991 V3992 V3993)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-read (lambda V4001 (lambda V4002 (lambda V4003 (shen.type-signature-of-read V4001 V4002 V4003)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-read-byte (lambda V4011 (lambda V4012 (lambda V4013 (shen.type-signature-of-read-byte V4011 V4012 V4013)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-read-file-as-bytelist (lambda V4021 (lambda V4022 (lambda V4023 (shen.type-signature-of-read-file-as-bytelist V4021 V4022 V4023)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-read-file-as-string (lambda V4031 (lambda V4032 (lambda V4033 (shen.type-signature-of-read-file-as-string V4031 V4032 V4033)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-read-file (lambda V4041 (lambda V4042 (lambda V4043 (shen.type-signature-of-read-file V4041 V4042 V4043)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-read-from-string (lambda V4051 (lambda V4052 (lambda V4053 (shen.type-signature-of-read-from-string V4051 V4052 V4053)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-release (lambda V4061 (lambda V4062 (lambda V4063 (shen.type-signature-of-release V4061 V4062 V4063)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-remove (lambda V4071 (lambda V4072 (lambda V4073 (shen.type-signature-of-remove V4071 V4072 V4073)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-reverse (lambda V4081 (lambda V4082 (lambda V4083 (shen.type-signature-of-reverse V4081 V4082 V4083)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-simple-error (lambda V4091 (lambda V4092 (lambda V4093 (shen.type-signature-of-simple-error V4091 V4092 V4093)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-snd (lambda V4101 (lambda V4102 (lambda V4103 (shen.type-signature-of-snd V4101 V4102 V4103)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-specialise (lambda V4111 (lambda V4112 (lambda V4113 (shen.type-signature-of-specialise V4111 V4112 V4113)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-spy (lambda V4121 (lambda V4122 (lambda V4123 (shen.type-signature-of-spy V4121 V4122 V4123)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-step (lambda V4131 (lambda V4132 (lambda V4133 (shen.type-signature-of-step V4131 V4132 V4133)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-stinput (lambda V4141 (lambda V4142 (lambda V4143 (shen.type-signature-of-stinput V4141 V4142 V4143)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-sterror (lambda V4151 (lambda V4152 (lambda V4153 (shen.type-signature-of-sterror V4151 V4152 V4153)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-stoutput (lambda V4161 (lambda V4162 (lambda V4163 (shen.type-signature-of-stoutput V4161 V4162 V4163)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-string? (lambda V4171 (lambda V4172 (lambda V4173 (shen.type-signature-of-string? V4171 V4172 V4173)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-str (lambda V4181 (lambda V4182 (lambda V4183 (shen.type-signature-of-str V4181 V4182 V4183)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-string->n (lambda V4191 (lambda V4192 (lambda V4193 (shen.type-signature-of-string->n V4191 V4192 V4193)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-string->symbol (lambda V4201 (lambda V4202 (lambda V4203 (shen.type-signature-of-string->symbol V4201 V4202 V4203)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-sum (lambda V4211 (lambda V4212 (lambda V4213 (shen.type-signature-of-sum V4211 V4212 V4213)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-symbol? (lambda V4221 (lambda V4222 (lambda V4223 (shen.type-signature-of-symbol? V4221 V4222 V4223)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-systemf (lambda V4231 (lambda V4232 (lambda V4233 (shen.type-signature-of-systemf V4231 V4232 V4233)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-tail (lambda V4241 (lambda V4242 (lambda V4243 (shen.type-signature-of-tail V4241 V4242 V4243)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-tlstr (lambda V4251 (lambda V4252 (lambda V4253 (shen.type-signature-of-tlstr V4251 V4252 V4253)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-tlv (lambda V4261 (lambda V4262 (lambda V4263 (shen.type-signature-of-tlv V4261 V4262 V4263)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-tc (lambda V4271 (lambda V4272 (lambda V4273 (shen.type-signature-of-tc V4271 V4272 V4273)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-tc? (lambda V4281 (lambda V4282 (lambda V4283 (shen.type-signature-of-tc? V4281 V4282 V4283)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-thaw (lambda V4291 (lambda V4292 (lambda V4293 (shen.type-signature-of-thaw V4291 V4292 V4293)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-track (lambda V4301 (lambda V4302 (lambda V4303 (shen.type-signature-of-track V4301 V4302 V4303)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-trap-error (lambda V4311 (lambda V4312 (lambda V4313 (shen.type-signature-of-trap-error V4311 V4312 V4313)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-tuple? (lambda V4321 (lambda V4322 (lambda V4323 (shen.type-signature-of-tuple? V4321 V4322 V4323)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-undefmacro (lambda V4331 (lambda V4332 (lambda V4333 (shen.type-signature-of-undefmacro V4331 V4332 V4333)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-union (lambda V4341 (lambda V4342 (lambda V4343 (shen.type-signature-of-union V4341 V4342 V4343)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-unprofile (lambda V4351 (lambda V4352 (lambda V4353 (shen.type-signature-of-unprofile V4351 V4352 V4353)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-untrack (lambda V4361 (lambda V4362 (lambda V4363 (shen.type-signature-of-untrack V4361 V4362 V4363)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-unspecialise (lambda V4371 (lambda V4372 (lambda V4373 (shen.type-signature-of-unspecialise V4371 V4372 V4373)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-variable? (lambda V4381 (lambda V4382 (lambda V4383 (shen.type-signature-of-variable? V4381 V4382 V4383)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-vector? (lambda V4391 (lambda V4392 (lambda V4393 (shen.type-signature-of-vector? V4391 V4392 V4393)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-version (lambda V4401 (lambda V4402 (lambda V4403 (shen.type-signature-of-version V4401 V4402 V4403)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-write-to-file (lambda V4411 (lambda V4412 (lambda V4413 (shen.type-signature-of-write-to-file V4411 V4412 V4413)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-write-byte (lambda V4421 (lambda V4422 (lambda V4423 (shen.type-signature-of-write-byte V4421 V4422 V4423)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-y-or-n? (lambda V4431 (lambda V4432 (lambda V4433 (shen.type-signature-of-y-or-n? V4431 V4432 V4433)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-> (lambda V4441 (lambda V4442 (lambda V4443 (shen.type-signature-of-> V4441 V4442 V4443)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-< (lambda V4451 (lambda V4452 (lambda V4453 (shen.type-signature-of-< V4451 V4452 V4453)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of->= (lambda V4461 (lambda V4462 (lambda V4463 (shen.type-signature-of->= V4461 V4462 V4463)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-<= (lambda V4471 (lambda V4472 (lambda V4473 (shen.type-signature-of-<= V4471 V4472 V4473)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-= (lambda V4481 (lambda V4482 (lambda V4483 (shen.type-signature-of-= V4481 V4482 V4483)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-+ (lambda V4491 (lambda V4492 (lambda V4493 (shen.type-signature-of-+ V4491 V4492 V4493)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-/ (lambda V4501 (lambda V4502 (lambda V4503 (shen.type-signature-of-/ V4501 V4502 V4503)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-- (lambda V4511 (lambda V4512 (lambda V4513 (shen.type-signature-of-- V4511 V4512 V4513)))))) (do (shen.set-lambda-form-entry (cons shen.type-signature-of-* (lambda V4521 (lambda V4522 (lambda V4523 (shen.type-signature-of-* V4521 V4522 V4523)))))) (shen.set-lambda-form-entry (cons shen.type-signature-of-== (lambda V4531 (lambda V4532 (lambda V4533 (shen.type-signature-of-== V4531 V4532 V4533)))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) + +(defun shen.initialise-lambda-forms () (do (shen.set-lambda-form-entry (cons shen.datatype-error (lambda X (shen.datatype-error X)))) (do (shen.set-lambda-form-entry (cons shen.tuple (lambda X (shen.tuple X)))) (do (shen.set-lambda-form-entry (cons shen.pvar (lambda X (shen.pvar X)))) (do (shen.set-lambda-form-entry (cons shen.dictionary (lambda X (shen.dictionary X)))) (do (shen.set-lambda-form-entry (cons @v (lambda V418 (lambda V419 (@v V418 V419))))) (do (shen.set-lambda-form-entry (cons @p (lambda V420 (lambda V421 (@p V420 V421))))) (do (shen.set-lambda-form-entry (cons @s (lambda V422 (lambda V423 (@s V422 V423))))) (do (shen.set-lambda-form-entry (cons (lambda V424 ( V424)))) (do (shen.set-lambda-form-entry (cons (lambda V425 ( V425)))) (do (shen.set-lambda-form-entry (cons == (lambda V426 (lambda V427 (== V426 V427))))) (do (shen.set-lambda-form-entry (cons = (lambda V428 (lambda V429 (= V428 V429))))) (do (shen.set-lambda-form-entry (cons >= (lambda V430 (lambda V431 (>= V430 V431))))) (do (shen.set-lambda-form-entry (cons > (lambda V432 (lambda V433 (> V432 V433))))) (do (shen.set-lambda-form-entry (cons - (lambda V434 (lambda V435 (- V434 V435))))) (do (shen.set-lambda-form-entry (cons / (lambda V436 (lambda V437 (/ V436 V437))))) (do (shen.set-lambda-form-entry (cons * (lambda V438 (lambda V439 (* V438 V439))))) (do (shen.set-lambda-form-entry (cons + (lambda V440 (lambda V441 (+ V440 V441))))) (do (shen.set-lambda-form-entry (cons <= (lambda V442 (lambda V443 (<= V442 V443))))) (do (shen.set-lambda-form-entry (cons < (lambda V444 (lambda V445 (< V444 V445))))) (do (shen.set-lambda-form-entry (cons y-or-n? (lambda V446 (y-or-n? V446)))) (do (shen.set-lambda-form-entry (cons write-to-file (lambda V447 (lambda V448 (write-to-file V447 V448))))) (do (shen.set-lambda-form-entry (cons write-byte (lambda V449 (lambda V450 (write-byte V449 V450))))) (do (shen.set-lambda-form-entry (cons variable? (lambda V451 (variable? V451)))) (do (shen.set-lambda-form-entry (cons value (lambda V452 (value V452)))) (do (shen.set-lambda-form-entry (cons vector-> (lambda V453 (lambda V454 (lambda V455 (vector-> V453 V454 V455)))))) (do (shen.set-lambda-form-entry (cons <-vector (lambda V456 (lambda V457 (<-vector V456 V457))))) (do (shen.set-lambda-form-entry (cons vector (lambda V458 (vector V458)))) (do (shen.set-lambda-form-entry (cons vector? (lambda V459 (vector? V459)))) (do (shen.set-lambda-form-entry (cons unspecialise (lambda V460 (unspecialise V460)))) (do (shen.set-lambda-form-entry (cons untrack (lambda V461 (untrack V461)))) (do (shen.set-lambda-form-entry (cons union (lambda V462 (lambda V463 (union V462 V463))))) (do (shen.set-lambda-form-entry (cons unify (lambda V464 (lambda V465 (lambda V466 (lambda V467 (unify V464 V465 V466 V467))))))) (do (shen.set-lambda-form-entry (cons unify! (lambda V468 (lambda V469 (lambda V470 (lambda V471 (unify! V468 V469 V470 V471))))))) (do (shen.set-lambda-form-entry (cons unput (lambda V472 (lambda V473 (lambda V474 (unput V472 V473 V474)))))) (do (shen.set-lambda-form-entry (cons unprofile (lambda V475 (unprofile V475)))) (do (shen.set-lambda-form-entry (cons undefmacro (lambda V476 (undefmacro V476)))) (do (shen.set-lambda-form-entry (cons return (lambda V477 (lambda V478 (lambda V479 (return V477 V478 V479)))))) (do (shen.set-lambda-form-entry (cons type (lambda V480 (lambda V481 (type V480 V481))))) (do (shen.set-lambda-form-entry (cons tuple? (lambda V482 (tuple? V482)))) (do (shen.set-lambda-form-entry (cons trap-error (lambda V483 (lambda V484 (trap-error V483 V484))))) (do (shen.set-lambda-form-entry (cons track (lambda V485 (track V485)))) (do (shen.set-lambda-form-entry (cons thaw (lambda V486 (thaw V486)))) (do (shen.set-lambda-form-entry (cons tc (lambda V487 (tc V487)))) (do (shen.set-lambda-form-entry (cons tl (lambda V488 (tl V488)))) (do (shen.set-lambda-form-entry (cons tlstr (lambda V489 (tlstr V489)))) (do (shen.set-lambda-form-entry (cons tail (lambda V490 (tail V490)))) (do (shen.set-lambda-form-entry (cons systemf (lambda V491 (systemf V491)))) (do (shen.set-lambda-form-entry (cons symbol? (lambda V492 (symbol? V492)))) (do (shen.set-lambda-form-entry (cons string->symbol (lambda V493 (string->symbol V493)))) (do (shen.set-lambda-form-entry (cons sum (lambda V494 (sum V494)))) (do (shen.set-lambda-form-entry (cons subst (lambda V495 (lambda V496 (lambda V497 (subst V495 V496 V497)))))) (do (shen.set-lambda-form-entry (cons string? (lambda V498 (string? V498)))) (do (shen.set-lambda-form-entry (cons string->n (lambda V499 (string->n V499)))) (do (shen.set-lambda-form-entry (cons step (lambda V500 (step V500)))) (do (shen.set-lambda-form-entry (cons spy (lambda V501 (spy V501)))) (do (shen.set-lambda-form-entry (cons specialise (lambda V502 (specialise V502)))) (do (shen.set-lambda-form-entry (cons snd (lambda V503 (snd V503)))) (do (shen.set-lambda-form-entry (cons simple-error (lambda V504 (simple-error V504)))) (do (shen.set-lambda-form-entry (cons set (lambda V505 (lambda V506 (set V505 V506))))) (do (shen.set-lambda-form-entry (cons str (lambda V507 (str V507)))) (do (shen.set-lambda-form-entry (cons reverse (lambda V508 (reverse V508)))) (do (shen.set-lambda-form-entry (cons remove (lambda V509 (lambda V510 (remove V509 V510))))) (do (shen.set-lambda-form-entry (cons read (lambda V511 (read V511)))) (do (shen.set-lambda-form-entry (cons read-file (lambda V512 (read-file V512)))) (do (shen.set-lambda-form-entry (cons read-file-as-bytelist (lambda V513 (read-file-as-bytelist V513)))) (do (shen.set-lambda-form-entry (cons read-file-as-string (lambda V514 (read-file-as-string V514)))) (do (shen.set-lambda-form-entry (cons read-byte (lambda V515 (read-byte V515)))) (do (shen.set-lambda-form-entry (cons read-from-string (lambda V516 (read-from-string V516)))) (do (shen.set-lambda-form-entry (cons package? (lambda V517 (package? V517)))) (do (shen.set-lambda-form-entry (cons put (lambda V518 (lambda V519 (lambda V520 (lambda V521 (put V518 V519 V520 V521))))))) (do (shen.set-lambda-form-entry (cons preclude (lambda V522 (preclude V522)))) (do (shen.set-lambda-form-entry (cons preclude-all-but (lambda V523 (preclude-all-but V523)))) (do (shen.set-lambda-form-entry (cons ps (lambda V524 (ps V524)))) (do (shen.set-lambda-form-entry (cons protect (lambda V525 (protect V525)))) (do (shen.set-lambda-form-entry (cons profile-results (lambda V526 (profile-results V526)))) (do (shen.set-lambda-form-entry (cons profile (lambda V527 (profile V527)))) (do (shen.set-lambda-form-entry (cons print (lambda V528 (print V528)))) (do (shen.set-lambda-form-entry (cons pr (lambda V529 (lambda V530 (pr V529 V530))))) (do (shen.set-lambda-form-entry (cons pos (lambda V531 (lambda V532 (pos V531 V532))))) (do (shen.set-lambda-form-entry (cons or (lambda V533 (lambda V534 (or V533 V534))))) (do (shen.set-lambda-form-entry (cons optimise (lambda V535 (optimise V535)))) (do (shen.set-lambda-form-entry (cons open (lambda V536 (lambda V537 (open V536 V537))))) (do (shen.set-lambda-form-entry (cons occurrences (lambda V538 (lambda V539 (occurrences V538 V539))))) (do (shen.set-lambda-form-entry (cons occurs-check (lambda V540 (occurs-check V540)))) (do (shen.set-lambda-form-entry (cons n->string (lambda V541 (n->string V541)))) (do (shen.set-lambda-form-entry (cons number? (lambda V542 (number? V542)))) (do (shen.set-lambda-form-entry (cons nth (lambda V543 (lambda V544 (nth V543 V544))))) (do (shen.set-lambda-form-entry (cons not (lambda V545 (not V545)))) (do (shen.set-lambda-form-entry (cons nl (lambda V546 (nl V546)))) (do (shen.set-lambda-form-entry (cons macroexpand (lambda V547 (macroexpand V547)))) (do (shen.set-lambda-form-entry (cons maxinferences (lambda V548 (maxinferences V548)))) (do (shen.set-lambda-form-entry (cons mapcan (lambda V549 (lambda V550 (mapcan V549 V550))))) (do (shen.set-lambda-form-entry (cons map (lambda V551 (lambda V552 (map V551 V552))))) (do (shen.set-lambda-form-entry (cons load (lambda V553 (load V553)))) (do (shen.set-lambda-form-entry (cons lineread (lambda V554 (lineread V554)))) (do (shen.set-lambda-form-entry (cons limit (lambda V555 (limit V555)))) (do (shen.set-lambda-form-entry (cons length (lambda V556 (length V556)))) (do (shen.set-lambda-form-entry (cons intersection (lambda V557 (lambda V558 (intersection V557 V558))))) (do (shen.set-lambda-form-entry (cons intern (lambda V559 (intern V559)))) (do (shen.set-lambda-form-entry (cons integer? (lambda V560 (integer? V560)))) (do (shen.set-lambda-form-entry (cons input (lambda V561 (input V561)))) (do (shen.set-lambda-form-entry (cons input+ (lambda V562 (lambda V563 (input+ V562 V563))))) (do (shen.set-lambda-form-entry (cons include (lambda V564 (include V564)))) (do (shen.set-lambda-form-entry (cons include-all-but (lambda V565 (include-all-but V565)))) (do (shen.set-lambda-form-entry (cons internal (lambda V566 (internal V566)))) (do (shen.set-lambda-form-entry (cons if (lambda V567 (lambda V568 (lambda V569 (if V567 V568 V569)))))) (do (shen.set-lambda-form-entry (cons identical (lambda V570 (lambda V571 (lambda V572 (lambda V573 (identical V570 V571 V572 V573))))))) (do (shen.set-lambda-form-entry (cons head (lambda V574 (head V574)))) (do (shen.set-lambda-form-entry (cons hd (lambda V575 (hd V575)))) (do (shen.set-lambda-form-entry (cons hdv (lambda V576 (hdv V576)))) (do (shen.set-lambda-form-entry (cons hdstr (lambda V577 (hdstr V577)))) (do (shen.set-lambda-form-entry (cons hash (lambda V578 (lambda V579 (hash V578 V579))))) (do (shen.set-lambda-form-entry (cons get (lambda V580 (lambda V581 (lambda V582 (get V580 V581 V582)))))) (do (shen.set-lambda-form-entry (cons get-time (lambda V583 (get-time V583)))) (do (shen.set-lambda-form-entry (cons gensym (lambda V584 (gensym V584)))) (do (shen.set-lambda-form-entry (cons fst (lambda V585 (fst V585)))) (do (shen.set-lambda-form-entry (cons freeze (lambda V586 (freeze V586)))) (do (shen.set-lambda-form-entry (cons fix (lambda V587 (lambda V588 (fix V587 V588))))) (do (shen.set-lambda-form-entry (cons fail-if (lambda V589 (lambda V590 (fail-if V589 V590))))) (do (shen.set-lambda-form-entry (cons findall (lambda V591 (lambda V592 (lambda V593 (lambda V594 (lambda V595 (findall V591 V592 V593 V594 V595)))))))) (do (shen.set-lambda-form-entry (cons enable-type-theory (lambda V596 (enable-type-theory V596)))) (do (shen.set-lambda-form-entry (cons explode (lambda V597 (explode V597)))) (do (shen.set-lambda-form-entry (cons external (lambda V598 (external V598)))) (do (shen.set-lambda-form-entry (cons eval-kl (lambda V599 (eval-kl V599)))) (do (shen.set-lambda-form-entry (cons eval (lambda V600 (eval V600)))) (do (shen.set-lambda-form-entry (cons error-to-string (lambda V601 (error-to-string V601)))) (do (shen.set-lambda-form-entry (cons empty? (lambda V602 (empty? V602)))) (do (shen.set-lambda-form-entry (cons element? (lambda V603 (lambda V604 (element? V603 V604))))) (do (shen.set-lambda-form-entry (cons do (lambda V605 (lambda V606 (do V605 V606))))) (do (shen.set-lambda-form-entry (cons difference (lambda V607 (lambda V608 (difference V607 V608))))) (do (shen.set-lambda-form-entry (cons destroy (lambda V609 (destroy V609)))) (do (shen.set-lambda-form-entry (cons declare (lambda V610 (lambda V611 (declare V610 V611))))) (do (shen.set-lambda-form-entry (cons cn (lambda V612 (lambda V613 (cn V612 V613))))) (do (shen.set-lambda-form-entry (cons cons? (lambda V614 (cons? V614)))) (do (shen.set-lambda-form-entry (cons cons (lambda V615 (lambda V616 (cons V615 V616))))) (do (shen.set-lambda-form-entry (cons concat (lambda V617 (lambda V618 (concat V617 V618))))) (do (shen.set-lambda-form-entry (cons compile (lambda V619 (lambda V620 (lambda V621 (compile V619 V620 V621)))))) (do (shen.set-lambda-form-entry (cons cd (lambda V622 (cd V622)))) (do (shen.set-lambda-form-entry (cons close (lambda V623 (close V623)))) (do (shen.set-lambda-form-entry (cons bound? (lambda V624 (bound? V624)))) (do (shen.set-lambda-form-entry (cons boolean? (lambda V625 (boolean? V625)))) (do (shen.set-lambda-form-entry (cons assoc (lambda V626 (lambda V627 (assoc V626 V627))))) (do (shen.set-lambda-form-entry (cons arity (lambda V628 (arity V628)))) (do (shen.set-lambda-form-entry (cons append (lambda V629 (lambda V630 (append V629 V630))))) (do (shen.set-lambda-form-entry (cons and (lambda V631 (lambda V632 (and V631 V632))))) (do (shen.set-lambda-form-entry (cons adjoin (lambda V633 (lambda V634 (adjoin V633 V634))))) (do (shen.set-lambda-form-entry (cons <-address (lambda V635 (lambda V636 (<-address V635 V636))))) (do (shen.set-lambda-form-entry (cons address-> (lambda V637 (lambda V638 (lambda V639 (address-> V637 V638 V639)))))) (do (shen.set-lambda-form-entry (cons absvector? (lambda V640 (absvector? V640)))) (shen.set-lambda-form-entry (cons absvector (lambda V641 (absvector V641)))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) + +(defun shen.initialise () (do (shen.initialise-environment) (do (shen.initialise-lambda-forms) (do (shen.initialise-signedfunc-lambda-forms) (shen.initialise-signedfuncs))))) diff --git a/kl/license.txt b/kl/license.txt deleted file mode 100644 index ab463d3..0000000 --- a/kl/license.txt +++ /dev/null @@ -1,24 +0,0 @@ -Copyright (c) 2010-2015, Mark Tarver - -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: -1. Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. -2. Redistributions in binary form must reproduce the above copyright - notice, this list of conditions and the following disclaimer in the - documentation and/or other materials provided with the distribution. -3. The name of Mark Tarver may not be used to endorse or promote products - derived from this software without specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY Mark Tarver ''AS IS'' AND ANY -EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED -WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE -DISCLAIMED. IN NO EVENT SHALL Mark Tarver BE LIABLE FOR ANY -DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES -(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; -LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND -ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/kl/load.kl b/kl/load.kl index b91a9d7..ae77352 100644 --- a/kl/load.kl +++ b/kl/load.kl @@ -28,37 +28,37 @@ OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. " -(defun load (V1804) (let Load (let Start (get-time run) (let Result (shen.load-help (value shen.*tc*) (read-file V1804)) (let Finish (get-time run) (let Time (- Finish Start) (let Message (shen.prhush (cn " +(defun load (V643) (let Load (let Start (get-time run) (let Result (shen.load-help (value shen.*tc*) (read-file V643)) (let Finish (get-time run) (let Time (- Finish Start) (let Message (shen.prhush (cn " run time: " (cn (str Time) " secs ")) (stoutput)) Result))))) (let Infs (if (value shen.*tc*) (shen.prhush (cn " typechecked in " (shen.app (inferences) " inferences " shen.a)) (stoutput)) shen.skip) loaded))) -(defun shen.load-help (V1811 V1812) (cond ((= false V1811) (shen.for-each (lambda X (shen.prhush (shen.app (shen.eval-without-macros X) " -" shen.s) (stoutput))) V1812)) (true (let RemoveSynonyms (mapcan (lambda X (shen.remove-synonyms X)) V1812) (let Table (mapcan (lambda X (shen.typetable X)) RemoveSynonyms) (let Assume (shen.for-each (lambda X (shen.assumetype X)) Table) (trap-error (shen.for-each (lambda X (shen.typecheck-and-load X)) RemoveSynonyms) (lambda E (shen.unwind-types E Table))))))))) +(defun shen.load-help (V650 V651) (cond ((= false V650) (shen.for-each (lambda X (shen.prhush (shen.app (shen.eval-without-macros X) " +" shen.s) (stoutput))) V651)) (true (let RemoveSynonyms (mapcan (lambda X (shen.remove-synonyms X)) V651) (let Table (mapcan (lambda X (shen.typetable X)) RemoveSynonyms) (let Assume (shen.for-each (lambda X (shen.assumetype X)) Table) (trap-error (shen.for-each (lambda X (shen.typecheck-and-load X)) RemoveSynonyms) (lambda E (shen.unwind-types E Table))))))))) -(defun shen.remove-synonyms (V1814) (cond ((and (cons? V1814) (= shen.synonyms-help (hd V1814))) (do (eval V1814) ())) (true (cons V1814 ())))) +(defun shen.remove-synonyms (V653) (cond ((and (cons? V653) (= shen.synonyms-help (hd V653))) (do (eval V653) ())) (true (cons V653 ())))) -(defun shen.typecheck-and-load (V1816) (do (nl 1) (shen.typecheck-and-evaluate V1816 (gensym A)))) +(defun shen.typecheck-and-load (V655) (do (nl 1) (shen.typecheck-and-evaluate V655 (gensym A)))) -(defun shen.typetable (V1822) (cond ((and (cons? V1822) (and (= define (hd V1822)) (cons? (tl V1822)))) (let Sig (compile (lambda Y (shen. Y)) (tl (tl V1822)) (lambda E (simple-error (shen.app (hd (tl V1822)) " lacks a proper signature. -" shen.a)))) (cons (cons (hd (tl V1822)) Sig) ()))) (true ()))) +(defun shen.typetable (V661) (cond ((and (cons? V661) (and (= define (hd V661)) (cons? (tl V661)))) (let Sig (compile (lambda Y (shen. Y)) (tl (tl V661)) (lambda E (simple-error (shen.app (hd (tl V661)) " lacks a proper signature. +" shen.a)))) (cons (cons (hd (tl V661)) Sig) ()))) (true ()))) -(defun shen.assumetype (V1824) (cond ((cons? V1824) (declare (hd V1824) (tl V1824))) (true (shen.f_error shen.assumetype)))) +(defun shen.assumetype (V663) (cond ((cons? V663) (declare (hd V663) (tl V663))) (true (shen.f_error shen.assumetype)))) -(defun shen.unwind-types (V1831 V1832) (cond ((= () V1832) (simple-error (error-to-string V1831))) ((and (cons? V1832) (cons? (hd V1832))) (do (shen.remtype (hd (hd V1832))) (shen.unwind-types V1831 (tl V1832)))) (true (shen.f_error shen.unwind-types)))) +(defun shen.unwind-types (V670 V671) (cond ((= () V671) (simple-error (error-to-string V670))) ((and (cons? V671) (cons? (hd V671))) (do (shen.remtype (hd (hd V671))) (shen.unwind-types V670 (tl V671)))) (true (shen.f_error shen.unwind-types)))) -(defun shen.remtype (V1834) (set shen.*signedfuncs* (shen.removetype V1834 (value shen.*signedfuncs*)))) +(defun shen.remtype (V673) (set shen.*signedfuncs* (shen.removetype V673 (value shen.*signedfuncs*)))) -(defun shen.removetype (V1842 V1843) (cond ((= () V1843) ()) ((and (cons? V1843) (and (cons? (hd V1843)) (= (hd (hd V1843)) V1842))) (shen.removetype (hd (hd V1843)) (tl V1843))) ((cons? V1843) (cons (hd V1843) (shen.removetype V1842 (tl V1843)))) (true (shen.f_error shen.removetype)))) +(defun shen.removetype (V681 V682) (cond ((= () V682) ()) ((and (cons? V682) (and (cons? (hd V682)) (= (hd (hd V682)) V681))) (shen.removetype (hd (hd V682)) (tl V682))) ((cons? V682) (cons (hd V682) (shen.removetype V681 (tl V682)))) (true (shen.f_error shen.removetype)))) -(defun shen. (V1845) (let Parse_shen. (shen. V1845) (if (not (= (fail) Parse_shen.)) (let Parse_ ( Parse_shen.) (if (not (= (fail) Parse_)) (shen.pair (hd Parse_) (shen.hdtl Parse_shen.)) (fail))) (fail)))) +(defun shen. (V684) (let Parse_shen. (shen. V684) (if (not (= (fail) Parse_shen.)) (let Parse_ ( Parse_shen.) (if (not (= (fail) Parse_)) (shen.pair (hd Parse_) (shen.hdtl Parse_shen.)) (fail))) (fail)))) -(defun write-to-file (V1848 V1849) (let Stream (open V1848 out) (let String (if (string? V1849) (shen.app V1849 " +(defun write-to-file (V687 V688) (let Stream (open V687 out) (let String (if (string? V688) (shen.app V688 " -" shen.a) (shen.app V1849 " +" shen.a) (shen.app V688 " -" shen.s)) (let Write (pr String Stream) (let Close (close Stream) V1849))))) +" shen.s)) (let Write (pr String Stream) (let Close (close Stream) V688))))) diff --git a/kl/macros.kl b/kl/macros.kl index a579c7c..60b32cf 100644 --- a/kl/macros.kl +++ b/kl/macros.kl @@ -28,72 +28,72 @@ OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. " -(defun macroexpand (V1851) (let Y (shen.compose (value *macros*) V1851) (if (= V1851 Y) V1851 (shen.walk (lambda Z (macroexpand Z)) Y)))) +(defun macroexpand (V690) (let Y (shen.compose (value *macros*) V690) (if (= V690 Y) V690 (shen.walk (lambda Z (macroexpand Z)) Y)))) -(defun shen.error-macro (V1853) (cond ((and (cons? V1853) (and (= error (hd V1853)) (cons? (tl V1853)))) (cons simple-error (cons (shen.mkstr (hd (tl V1853)) (tl (tl V1853))) ()))) (true V1853))) +(defun shen.error-macro (V692) (cond ((and (cons? V692) (and (= error (hd V692)) (cons? (tl V692)))) (cons simple-error (cons (shen.mkstr (hd (tl V692)) (tl (tl V692))) ()))) (true V692))) -(defun shen.output-macro (V1855) (cond ((and (cons? V1855) (and (= output (hd V1855)) (cons? (tl V1855)))) (cons shen.prhush (cons (shen.mkstr (hd (tl V1855)) (tl (tl V1855))) (cons (cons stoutput ()) ())))) ((and (cons? V1855) (and (= pr (hd V1855)) (and (cons? (tl V1855)) (= () (tl (tl V1855)))))) (cons pr (cons (hd (tl V1855)) (cons (cons stoutput ()) ())))) (true V1855))) +(defun shen.output-macro (V694) (cond ((and (cons? V694) (and (= output (hd V694)) (cons? (tl V694)))) (cons shen.prhush (cons (shen.mkstr (hd (tl V694)) (tl (tl V694))) (cons (cons stoutput ()) ())))) ((and (cons? V694) (and (= pr (hd V694)) (and (cons? (tl V694)) (= () (tl (tl V694)))))) (cons pr (cons (hd (tl V694)) (cons (cons stoutput ()) ())))) (true V694))) -(defun shen.make-string-macro (V1857) (cond ((and (cons? V1857) (and (= make-string (hd V1857)) (cons? (tl V1857)))) (shen.mkstr (hd (tl V1857)) (tl (tl V1857)))) (true V1857))) +(defun shen.make-string-macro (V696) (cond ((and (cons? V696) (and (= make-string (hd V696)) (cons? (tl V696)))) (shen.mkstr (hd (tl V696)) (tl (tl V696)))) (true V696))) -(defun shen.input-macro (V1859) (cond ((and (cons? V1859) (and (= lineread (hd V1859)) (= () (tl V1859)))) (cons lineread (cons (cons stinput ()) ()))) ((and (cons? V1859) (and (= input (hd V1859)) (= () (tl V1859)))) (cons input (cons (cons stinput ()) ()))) ((and (cons? V1859) (and (= read (hd V1859)) (= () (tl V1859)))) (cons read (cons (cons stinput ()) ()))) ((and (cons? V1859) (and (= input+ (hd V1859)) (and (cons? (tl V1859)) (= () (tl (tl V1859)))))) (cons input+ (cons (hd (tl V1859)) (cons (cons stinput ()) ())))) ((and (cons? V1859) (and (= read-byte (hd V1859)) (= () (tl V1859)))) (cons read-byte (cons (cons stinput ()) ()))) (true V1859))) +(defun shen.input-macro (V698) (cond ((and (cons? V698) (and (= lineread (hd V698)) (= () (tl V698)))) (cons lineread (cons (cons stinput ()) ()))) ((and (cons? V698) (and (= input (hd V698)) (= () (tl V698)))) (cons input (cons (cons stinput ()) ()))) ((and (cons? V698) (and (= read (hd V698)) (= () (tl V698)))) (cons read (cons (cons stinput ()) ()))) ((and (cons? V698) (and (= input+ (hd V698)) (and (cons? (tl V698)) (= () (tl (tl V698)))))) (cons input+ (cons (hd (tl V698)) (cons (cons stinput ()) ())))) ((and (cons? V698) (and (= read-byte (hd V698)) (= () (tl V698)))) (cons read-byte (cons (cons stinput ()) ()))) (true V698))) -(defun shen.compose (V1862 V1863) (cond ((= () V1862) V1863) ((cons? V1862) (shen.compose (tl V1862) ((hd V1862) V1863))) (true (shen.f_error shen.compose)))) +(defun shen.compose (V701 V702) (cond ((= () V701) V702) ((cons? V701) (shen.compose (tl V701) ((hd V701) V702))) (true (shen.f_error shen.compose)))) -(defun shen.compile-macro (V1865) (cond ((and (cons? V1865) (and (= compile (hd V1865)) (and (cons? (tl V1865)) (and (cons? (tl (tl V1865))) (= () (tl (tl (tl V1865)))))))) (cons compile (cons (hd (tl V1865)) (cons (hd (tl (tl V1865))) (cons (cons lambda (cons E (cons (cons if (cons (cons cons? (cons E ())) (cons (cons error (cons "parse error here: ~S~%" (cons E ()))) (cons (cons error (cons "parse error~%" ())) ())))) ()))) ()))))) (true V1865))) +(defun shen.compile-macro (V704) (cond ((and (cons? V704) (and (= compile (hd V704)) (and (cons? (tl V704)) (and (cons? (tl (tl V704))) (= () (tl (tl (tl V704)))))))) (cons compile (cons (hd (tl V704)) (cons (hd (tl (tl V704))) (cons (cons lambda (cons E (cons (cons if (cons (cons cons? (cons E ())) (cons (cons error (cons "parse error here: ~S~%" (cons E ()))) (cons (cons error (cons "parse error~%" ())) ())))) ()))) ()))))) (true V704))) -(defun shen.prolog-macro (V1867) (cond ((and (cons? V1867) (= prolog? (hd V1867))) (cons let (cons NPP (cons (cons shen.start-new-prolog-process ()) (cons (let Calls (shen.bld-prolog-call NPP (tl V1867)) (let Vs (shen.extract_vars (tl V1867)) (let External (shen.externally-bound (tl V1867)) (let PrologVs (difference Vs External) (shen.locally-bind-prolog-vs NPP PrologVs Calls))))) ()))))) (true V1867))) +(defun shen.prolog-macro (V706) (cond ((and (cons? V706) (= prolog? (hd V706))) (cons let (cons NPP (cons (cons shen.start-new-prolog-process ()) (cons (let Calls (shen.bld-prolog-call NPP (tl V706)) (let Vs (shen.extract_vars (tl V706)) (let External (shen.externally-bound (tl V706)) (let PrologVs (difference Vs External) (shen.locally-bind-prolog-vs NPP PrologVs Calls))))) ()))))) (true V706))) -(defun shen.externally-bound (V1873) (cond ((and (cons? V1873) (and (= receive (hd V1873)) (and (cons? (tl V1873)) (= () (tl (tl V1873)))))) (tl V1873)) ((cons? V1873) (union (shen.externally-bound (hd V1873)) (shen.externally-bound (tl V1873)))) (true ()))) +(defun shen.externally-bound (V712) (cond ((and (cons? V712) (and (= receive (hd V712)) (and (cons? (tl V712)) (= () (tl (tl V712)))))) (tl V712)) ((cons? V712) (union (shen.externally-bound (hd V712)) (shen.externally-bound (tl V712)))) (true ()))) -(defun shen.locally-bind-prolog-vs (V1891 V1892 V1893) (cond ((= () V1892) V1893) ((cons? V1892) (cons let (cons (hd V1892) (cons (cons shen.newpv (cons V1891 ())) (cons (shen.locally-bind-prolog-vs V1891 (tl V1892) V1893) ()))))) (true (simple-error "implementation error inp locally-bind-prolog-vs")))) +(defun shen.locally-bind-prolog-vs (V730 V731 V732) (cond ((= () V731) V732) ((cons? V731) (cons let (cons (hd V731) (cons (cons shen.newpv (cons V730 ())) (cons (shen.locally-bind-prolog-vs V730 (tl V731) V732) ()))))) (true (simple-error "implementation error inp locally-bind-prolog-vs")))) -(defun shen.bld-prolog-call (V1906 V1907) (cond ((= () V1907) true) ((and (cons? V1907) (= ! (hd V1907))) (cons cut (cons false (cons V1906 (cons (cons freeze (cons (shen.bld-prolog-call V1906 (tl V1907)) ())) ()))))) ((and (cons? V1907) (and (cons? (hd V1907)) (and (= when (hd (hd V1907))) (and (cons? (tl (hd V1907))) (= () (tl (tl (hd V1907)))))))) (cons fwhen (cons (shen.insert-deref (hd (tl (hd V1907))) V1906) (cons V1906 (cons (cons freeze (cons (shen.bld-prolog-call V1906 (tl V1907)) ())) ()))))) ((and (cons? V1907) (and (cons? (hd V1907)) (and (= is (hd (hd V1907))) (and (cons? (tl (hd V1907))) (and (cons? (tl (tl (hd V1907)))) (= () (tl (tl (tl (hd V1907)))))))))) (cons bind (cons (hd (tl (hd V1907))) (cons (shen.insert-deref (hd (tl (tl (hd V1907)))) V1906) (cons V1906 (cons (cons freeze (cons (shen.bld-prolog-call V1906 (tl V1907)) ())) ())))))) ((and (cons? V1907) (and (cons? (hd V1907)) (and (= receive (hd (hd V1907))) (and (cons? (tl (hd V1907))) (= () (tl (tl (hd V1907)))))))) (shen.bld-prolog-call V1906 (tl V1907))) ((and (cons? V1907) (and (cons? (hd V1907)) (and (= bind (hd (hd V1907))) (and (cons? (tl (hd V1907))) (and (cons? (tl (tl (hd V1907)))) (= () (tl (tl (tl (hd V1907)))))))))) (cons bind (cons (hd (tl (hd V1907))) (cons (shen.insert-lazyderef (hd (tl (tl (hd V1907)))) V1906) (cons V1906 (cons (cons freeze (cons (shen.bld-prolog-call V1906 (tl V1907)) ())) ())))))) ((and (cons? V1907) (and (cons? (hd V1907)) (and (= fwhen (hd (hd V1907))) (and (cons? (tl (hd V1907))) (= () (tl (tl (hd V1907)))))))) (cons fwhen (cons (shen.insert-lazyderef (hd (tl (hd V1907))) V1906) (cons V1906 (cons (cons freeze (cons (shen.bld-prolog-call V1906 (tl V1907)) ())) ()))))) ((cons? V1907) (append (hd V1907) (cons V1906 (cons (cons freeze (cons (shen.bld-prolog-call V1906 (tl V1907)) ())) ())))) (true (simple-error "implementation error in bld-prolog-call")))) +(defun shen.bld-prolog-call (V745 V746) (cond ((= () V746) true) ((and (cons? V746) (= ! (hd V746))) (cons cut (cons false (cons V745 (cons (cons freeze (cons (shen.bld-prolog-call V745 (tl V746)) ())) ()))))) ((and (cons? V746) (and (cons? (hd V746)) (and (= when (hd (hd V746))) (and (cons? (tl (hd V746))) (= () (tl (tl (hd V746)))))))) (cons fwhen (cons (shen.insert-deref (hd (tl (hd V746))) V745) (cons V745 (cons (cons freeze (cons (shen.bld-prolog-call V745 (tl V746)) ())) ()))))) ((and (cons? V746) (and (cons? (hd V746)) (and (= is (hd (hd V746))) (and (cons? (tl (hd V746))) (and (cons? (tl (tl (hd V746)))) (= () (tl (tl (tl (hd V746)))))))))) (cons bind (cons (hd (tl (hd V746))) (cons (shen.insert-deref (hd (tl (tl (hd V746)))) V745) (cons V745 (cons (cons freeze (cons (shen.bld-prolog-call V745 (tl V746)) ())) ())))))) ((and (cons? V746) (and (cons? (hd V746)) (and (= receive (hd (hd V746))) (and (cons? (tl (hd V746))) (= () (tl (tl (hd V746)))))))) (shen.bld-prolog-call V745 (tl V746))) ((and (cons? V746) (and (cons? (hd V746)) (and (= bind (hd (hd V746))) (and (cons? (tl (hd V746))) (and (cons? (tl (tl (hd V746)))) (= () (tl (tl (tl (hd V746)))))))))) (cons bind (cons (hd (tl (hd V746))) (cons (shen.insert-lazyderef (hd (tl (tl (hd V746)))) V745) (cons V745 (cons (cons freeze (cons (shen.bld-prolog-call V745 (tl V746)) ())) ())))))) ((and (cons? V746) (and (cons? (hd V746)) (and (= fwhen (hd (hd V746))) (and (cons? (tl (hd V746))) (= () (tl (tl (hd V746)))))))) (cons fwhen (cons (shen.insert-lazyderef (hd (tl (hd V746))) V745) (cons V745 (cons (cons freeze (cons (shen.bld-prolog-call V745 (tl V746)) ())) ()))))) ((cons? V746) (append (hd V746) (cons V745 (cons (cons freeze (cons (shen.bld-prolog-call V745 (tl V746)) ())) ())))) (true (simple-error "implementation error in bld-prolog-call")))) -(defun shen.defprolog-macro (V1909) (cond ((and (cons? V1909) (and (= defprolog (hd V1909)) (cons? (tl V1909)))) (compile (lambda Y (shen. Y)) (tl V1909) (lambda Y (shen.prolog-error (hd (tl V1909)) Y)))) (true V1909))) +(defun shen.defprolog-macro (V748) (cond ((and (cons? V748) (and (= defprolog (hd V748)) (cons? (tl V748)))) (compile (lambda Y (shen. Y)) (tl V748) (lambda Y (shen.prolog-error (hd (tl V748)) Y)))) (true V748))) -(defun shen.datatype-macro (V1911) (cond ((and (cons? V1911) (and (= datatype (hd V1911)) (cons? (tl V1911)))) (cons shen.process-datatype (cons (shen.intern-type (hd (tl V1911))) (cons (cons compile (cons (cons lambda (cons X (cons (cons shen. (cons X ())) ()))) (cons (shen.rcons_form (tl (tl V1911))) (cons (cons function (cons shen.datatype-error ())) ())))) ())))) (true V1911))) +(defun shen.datatype-macro (V750) (cond ((and (cons? V750) (and (= datatype (hd V750)) (cons? (tl V750)))) (cons shen.process-datatype (cons (shen.intern-type (hd (tl V750))) (cons (cons compile (cons (cons lambda (cons X (cons (cons shen. (cons X ())) ()))) (cons (shen.rcons_form (tl (tl V750))) (cons (cons function (cons shen.datatype-error ())) ())))) ())))) (true V750))) -(defun shen.intern-type (V1913) (intern (cn (str V1913) "#type"))) +(defun shen.intern-type (V752) (intern (cn (str V752) "#type"))) -(defun shen.@s-macro (V1915) (cond ((and (cons? V1915) (and (= @s (hd V1915)) (and (cons? (tl V1915)) (and (cons? (tl (tl V1915))) (cons? (tl (tl (tl V1915)))))))) (cons @s (cons (hd (tl V1915)) (cons (shen.@s-macro (cons @s (tl (tl V1915)))) ())))) ((and (cons? V1915) (and (= @s (hd V1915)) (and (cons? (tl V1915)) (and (cons? (tl (tl V1915))) (and (= () (tl (tl (tl V1915)))) (string? (hd (tl V1915)))))))) (let E (explode (hd (tl V1915))) (if (> (length E) 1) (shen.@s-macro (cons @s (append E (tl (tl V1915))))) V1915))) (true V1915))) +(defun shen.@s-macro (V754) (cond ((and (cons? V754) (and (= @s (hd V754)) (and (cons? (tl V754)) (and (cons? (tl (tl V754))) (cons? (tl (tl (tl V754)))))))) (cons @s (cons (hd (tl V754)) (cons (shen.@s-macro (cons @s (tl (tl V754)))) ())))) ((and (cons? V754) (and (= @s (hd V754)) (and (cons? (tl V754)) (and (cons? (tl (tl V754))) (and (= () (tl (tl (tl V754)))) (string? (hd (tl V754)))))))) (let E (explode (hd (tl V754))) (if (> (length E) 1) (shen.@s-macro (cons @s (append E (tl (tl V754))))) V754))) (true V754))) -(defun shen.synonyms-macro (V1917) (cond ((and (cons? V1917) (= synonyms (hd V1917))) (cons shen.synonyms-help (cons (shen.rcons_form (shen.curry-synonyms (tl V1917))) ()))) (true V1917))) +(defun shen.synonyms-macro (V756) (cond ((and (cons? V756) (= synonyms (hd V756))) (cons shen.synonyms-help (cons (shen.rcons_form (shen.curry-synonyms (tl V756))) ()))) (true V756))) -(defun shen.curry-synonyms (V1919) (map (lambda X (shen.curry-type X)) V1919)) +(defun shen.curry-synonyms (V758) (map (lambda X (shen.curry-type X)) V758)) -(defun shen.nl-macro (V1921) (cond ((and (cons? V1921) (and (= nl (hd V1921)) (= () (tl V1921)))) (cons nl (cons 1 ()))) (true V1921))) +(defun shen.nl-macro (V760) (cond ((and (cons? V760) (and (= nl (hd V760)) (= () (tl V760)))) (cons nl (cons 1 ()))) (true V760))) -(defun shen.assoc-macro (V1923) (cond ((and (cons? V1923) (and (cons? (tl V1923)) (and (cons? (tl (tl V1923))) (and (cons? (tl (tl (tl V1923)))) (element? (hd V1923) (cons @p (cons @v (cons append (cons and (cons or (cons + (cons * (cons do ()))))))))))))) (cons (hd V1923) (cons (hd (tl V1923)) (cons (shen.assoc-macro (cons (hd V1923) (tl (tl V1923)))) ())))) (true V1923))) +(defun shen.assoc-macro (V762) (cond ((and (cons? V762) (and (cons? (tl V762)) (and (cons? (tl (tl V762))) (and (cons? (tl (tl (tl V762)))) (element? (hd V762) (cons @p (cons @v (cons append (cons and (cons or (cons + (cons * (cons do ()))))))))))))) (cons (hd V762) (cons (hd (tl V762)) (cons (shen.assoc-macro (cons (hd V762) (tl (tl V762)))) ())))) (true V762))) -(defun shen.let-macro (V1925) (cond ((and (cons? V1925) (and (= let (hd V1925)) (and (cons? (tl V1925)) (and (cons? (tl (tl V1925))) (and (cons? (tl (tl (tl V1925)))) (cons? (tl (tl (tl (tl V1925)))))))))) (cons let (cons (hd (tl V1925)) (cons (hd (tl (tl V1925))) (cons (shen.let-macro (cons let (tl (tl (tl V1925))))) ()))))) (true V1925))) +(defun shen.let-macro (V764) (cond ((and (cons? V764) (and (= let (hd V764)) (and (cons? (tl V764)) (and (cons? (tl (tl V764))) (and (cons? (tl (tl (tl V764)))) (cons? (tl (tl (tl (tl V764)))))))))) (cons let (cons (hd (tl V764)) (cons (hd (tl (tl V764))) (cons (shen.let-macro (cons let (tl (tl (tl V764))))) ()))))) (true V764))) -(defun shen.abs-macro (V1927) (cond ((and (cons? V1927) (and (= /. (hd V1927)) (and (cons? (tl V1927)) (and (cons? (tl (tl V1927))) (cons? (tl (tl (tl V1927)))))))) (cons lambda (cons (hd (tl V1927)) (cons (shen.abs-macro (cons /. (tl (tl V1927)))) ())))) ((and (cons? V1927) (and (= /. (hd V1927)) (and (cons? (tl V1927)) (and (cons? (tl (tl V1927))) (= () (tl (tl (tl V1927)))))))) (cons lambda (tl V1927))) (true V1927))) +(defun shen.abs-macro (V766) (cond ((and (cons? V766) (and (= /. (hd V766)) (and (cons? (tl V766)) (and (cons? (tl (tl V766))) (cons? (tl (tl (tl V766)))))))) (cons lambda (cons (hd (tl V766)) (cons (shen.abs-macro (cons /. (tl (tl V766)))) ())))) ((and (cons? V766) (and (= /. (hd V766)) (and (cons? (tl V766)) (and (cons? (tl (tl V766))) (= () (tl (tl (tl V766)))))))) (cons lambda (tl V766))) (true V766))) -(defun shen.cases-macro (V1931) (cond ((and (cons? V1931) (and (= cases (hd V1931)) (and (cons? (tl V1931)) (and (= true (hd (tl V1931))) (cons? (tl (tl V1931))))))) (hd (tl (tl V1931)))) ((and (cons? V1931) (and (= cases (hd V1931)) (and (cons? (tl V1931)) (and (cons? (tl (tl V1931))) (= () (tl (tl (tl V1931)))))))) (cons if (cons (hd (tl V1931)) (cons (hd (tl (tl V1931))) (cons (cons simple-error (cons "error: cases exhausted" ())) ()))))) ((and (cons? V1931) (and (= cases (hd V1931)) (and (cons? (tl V1931)) (cons? (tl (tl V1931)))))) (cons if (cons (hd (tl V1931)) (cons (hd (tl (tl V1931))) (cons (shen.cases-macro (cons cases (tl (tl (tl V1931))))) ()))))) ((and (cons? V1931) (and (= cases (hd V1931)) (and (cons? (tl V1931)) (= () (tl (tl V1931)))))) (simple-error "error: odd number of case elements -")) (true V1931))) +(defun shen.cases-macro (V770) (cond ((and (cons? V770) (and (= cases (hd V770)) (and (cons? (tl V770)) (and (= true (hd (tl V770))) (cons? (tl (tl V770))))))) (hd (tl (tl V770)))) ((and (cons? V770) (and (= cases (hd V770)) (and (cons? (tl V770)) (and (cons? (tl (tl V770))) (= () (tl (tl (tl V770)))))))) (cons if (cons (hd (tl V770)) (cons (hd (tl (tl V770))) (cons (cons simple-error (cons "error: cases exhausted" ())) ()))))) ((and (cons? V770) (and (= cases (hd V770)) (and (cons? (tl V770)) (cons? (tl (tl V770)))))) (cons if (cons (hd (tl V770)) (cons (hd (tl (tl V770))) (cons (shen.cases-macro (cons cases (tl (tl (tl V770))))) ()))))) ((and (cons? V770) (and (= cases (hd V770)) (and (cons? (tl V770)) (= () (tl (tl V770)))))) (simple-error "error: odd number of case elements +")) (true V770))) -(defun shen.timer-macro (V1933) (cond ((and (cons? V1933) (and (= time (hd V1933)) (and (cons? (tl V1933)) (= () (tl (tl V1933)))))) (shen.let-macro (cons let (cons Start (cons (cons get-time (cons run ())) (cons Result (cons (hd (tl V1933)) (cons Finish (cons (cons get-time (cons run ())) (cons Time (cons (cons - (cons Finish (cons Start ()))) (cons Message (cons (cons shen.prhush (cons (cons cn (cons " +(defun shen.timer-macro (V772) (cond ((and (cons? V772) (and (= time (hd V772)) (and (cons? (tl V772)) (= () (tl (tl V772)))))) (shen.let-macro (cons let (cons Start (cons (cons get-time (cons run ())) (cons Result (cons (hd (tl V772)) (cons Finish (cons (cons get-time (cons run ())) (cons Time (cons (cons - (cons Finish (cons Start ()))) (cons Message (cons (cons shen.prhush (cons (cons cn (cons " run time: " (cons (cons cn (cons (cons str (cons Time ())) (cons " secs -" ()))) ()))) (cons (cons stoutput ()) ()))) (cons Result ())))))))))))))) (true V1933))) +" ()))) ()))) (cons (cons stoutput ()) ()))) (cons Result ())))))))))))))) (true V772))) -(defun shen.tuple-up (V1935) (cond ((cons? V1935) (cons @p (cons (hd V1935) (cons (shen.tuple-up (tl V1935)) ())))) (true V1935))) +(defun shen.tuple-up (V774) (cond ((cons? V774) (cons @p (cons (hd V774) (cons (shen.tuple-up (tl V774)) ())))) (true V774))) -(defun shen.put/get-macro (V1937) (cond ((and (cons? V1937) (and (= put (hd V1937)) (and (cons? (tl V1937)) (and (cons? (tl (tl V1937))) (and (cons? (tl (tl (tl V1937)))) (= () (tl (tl (tl (tl V1937)))))))))) (cons put (cons (hd (tl V1937)) (cons (hd (tl (tl V1937))) (cons (hd (tl (tl (tl V1937)))) (cons (cons value (cons *property-vector* ())) ())))))) ((and (cons? V1937) (and (= get (hd V1937)) (and (cons? (tl V1937)) (and (cons? (tl (tl V1937))) (= () (tl (tl (tl V1937)))))))) (cons get (cons (hd (tl V1937)) (cons (hd (tl (tl V1937))) (cons (cons value (cons *property-vector* ())) ()))))) ((and (cons? V1937) (and (= unput (hd V1937)) (and (cons? (tl V1937)) (and (cons? (tl (tl V1937))) (= () (tl (tl (tl V1937)))))))) (cons unput (cons (hd (tl V1937)) (cons (hd (tl (tl V1937))) (cons (cons value (cons *property-vector* ())) ()))))) (true V1937))) +(defun shen.put/get-macro (V776) (cond ((and (cons? V776) (and (= put (hd V776)) (and (cons? (tl V776)) (and (cons? (tl (tl V776))) (and (cons? (tl (tl (tl V776)))) (= () (tl (tl (tl (tl V776)))))))))) (cons put (cons (hd (tl V776)) (cons (hd (tl (tl V776))) (cons (hd (tl (tl (tl V776)))) (cons (cons value (cons *property-vector* ())) ())))))) ((and (cons? V776) (and (= get (hd V776)) (and (cons? (tl V776)) (and (cons? (tl (tl V776))) (= () (tl (tl (tl V776)))))))) (cons get (cons (hd (tl V776)) (cons (hd (tl (tl V776))) (cons (cons value (cons *property-vector* ())) ()))))) ((and (cons? V776) (and (= unput (hd V776)) (and (cons? (tl V776)) (and (cons? (tl (tl V776))) (= () (tl (tl (tl V776)))))))) (cons unput (cons (hd (tl V776)) (cons (hd (tl (tl V776))) (cons (cons value (cons *property-vector* ())) ()))))) (true V776))) -(defun shen.function-macro (V1939) (cond ((and (cons? V1939) (and (= function (hd V1939)) (and (cons? (tl V1939)) (= () (tl (tl V1939)))))) (shen.function-abstraction (hd (tl V1939)) (arity (hd (tl V1939))))) (true V1939))) +(defun shen.function-macro (V778) (cond ((and (cons? V778) (and (= function (hd V778)) (and (cons? (tl V778)) (= () (tl (tl V778)))))) (shen.function-abstraction (hd (tl V778)) (arity (hd (tl V778))))) (true V778))) -(defun shen.function-abstraction (V1942 V1943) (cond ((= 0 V1943) (simple-error (shen.app V1942 " has no lambda form -" shen.a))) ((= -1 V1943) (cons function (cons V1942 ()))) (true (shen.function-abstraction-help V1942 V1943 ())))) +(defun shen.function-abstraction (V781 V782) (cond ((= 0 V782) (simple-error (shen.app V781 " has no lambda form +" shen.a))) ((= -1 V782) (cons function (cons V781 ()))) (true (shen.function-abstraction-help V781 V782 ())))) -(defun shen.function-abstraction-help (V1947 V1948 V1949) (cond ((= 0 V1948) (cons V1947 V1949)) (true (let X (gensym V) (cons /. (cons X (cons (shen.function-abstraction-help V1947 (- V1948 1) (append V1949 (cons X ()))) ()))))))) +(defun shen.function-abstraction-help (V786 V787 V788) (cond ((= 0 V787) (cons V786 V788)) (true (let X (gensym V) (cons /. (cons X (cons (shen.function-abstraction-help V786 (- V787 1) (append V788 (cons X ()))) ()))))))) -(defun undefmacro (V1951) (let MacroReg (value shen.*macroreg*) (let Pos (shen.findpos V1951 MacroReg) (let Remove1 (set shen.*macroreg* (remove V1951 MacroReg)) (let Remove2 (set *macros* (shen.remove-nth Pos (value *macros*))) V1951))))) +(defun undefmacro (V790) (let MacroReg (value shen.*macroreg*) (let Pos (shen.findpos V790 MacroReg) (let Remove1 (set shen.*macroreg* (remove V790 MacroReg)) (let Remove2 (set *macros* (shen.remove-nth Pos (value *macros*))) V790))))) -(defun shen.findpos (V1961 V1962) (cond ((= () V1962) (simple-error (shen.app V1961 " is not a macro -" shen.a))) ((and (cons? V1962) (= (hd V1962) V1961)) 1) ((cons? V1962) (+ 1 (shen.findpos V1961 (tl V1962)))) (true (shen.f_error shen.findpos)))) +(defun shen.findpos (V800 V801) (cond ((= () V801) (simple-error (shen.app V800 " is not a macro +" shen.a))) ((and (cons? V801) (= (hd V801) V800)) 1) ((cons? V801) (+ 1 (shen.findpos V800 (tl V801)))) (true (shen.f_error shen.findpos)))) -(defun shen.remove-nth (V1967 V1968) (cond ((and (= 1 V1967) (cons? V1968)) (tl V1968)) ((cons? V1968) (cons (hd V1968) (shen.remove-nth (- V1967 1) (tl V1968)))) (true (shen.f_error shen.remove-nth)))) +(defun shen.remove-nth (V806 V807) (cond ((and (= 1 V806) (cons? V807)) (tl V807)) ((cons? V807) (cons (hd V807) (shen.remove-nth (- V806 1) (tl V807)))) (true (shen.f_error shen.remove-nth)))) diff --git a/kl/prolog.kl b/kl/prolog.kl index 895c93b..c537ca6 100644 --- a/kl/prolog.kl +++ b/kl/prolog.kl @@ -28,206 +28,206 @@ OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. " -(defun shen. (V1970) (let Parse_shen. (shen. V1970) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (hd (shen.prolog->shen (map (lambda Parse_X (shen.insert-predicate (shen.hdtl Parse_shen.) Parse_X)) (shen.hdtl Parse_shen.))))) (fail))) (fail)))) +(defun shen. (V809) (let Parse_shen. (shen. V809) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (hd (shen.prolog->shen (map (lambda Parse_X (shen.insert-predicate (shen.hdtl Parse_shen.) Parse_X)) (shen.hdtl Parse_shen.))))) (fail))) (fail)))) -(defun shen.prolog-error (V1979 V1980) (cond ((and (cons? V1980) (and (cons? (tl V1980)) (= () (tl (tl V1980))))) (simple-error (cn "prolog syntax error in " (shen.app V1979 (cn " here: +(defun shen.prolog-error (V818 V819) (cond ((and (cons? V819) (and (cons? (tl V819)) (= () (tl (tl V819))))) (simple-error (cn "prolog syntax error in " (shen.app V818 (cn " here: - " (shen.app (shen.next-50 50 (hd V1980)) " -" shen.a)) shen.a)))) (true (simple-error (cn "prolog syntax error in " (shen.app V1979 " + " (shen.app (shen.next-50 50 (hd V819)) " +" shen.a)) shen.a)))) (true (simple-error (cn "prolog syntax error in " (shen.app V818 " " shen.a)))))) -(defun shen.next-50 (V1987 V1988) (cond ((= () V1988) "") ((= 0 V1987) "") ((cons? V1988) (cn (shen.decons-string (hd V1988)) (shen.next-50 (- V1987 1) (tl V1988)))) (true (shen.f_error shen.next-50)))) +(defun shen.next-50 (V826 V827) (cond ((= () V827) "") ((= 0 V826) "") ((cons? V827) (cn (shen.decons-string (hd V827)) (shen.next-50 (- V826 1) (tl V827)))) (true (shen.f_error shen.next-50)))) -(defun shen.decons-string (V1990) (cond ((and (cons? V1990) (and (= cons (hd V1990)) (and (cons? (tl V1990)) (and (cons? (tl (tl V1990))) (= () (tl (tl (tl V1990)))))))) (shen.app (shen.eval-cons V1990) " " shen.s)) (true (shen.app V1990 " " shen.r)))) +(defun shen.decons-string (V829) (cond ((and (cons? V829) (and (= cons (hd V829)) (and (cons? (tl V829)) (and (cons? (tl (tl V829))) (= () (tl (tl (tl V829)))))))) (shen.app (shen.eval-cons V829) " " shen.s)) (true (shen.app V829 " " shen.r)))) -(defun shen.insert-predicate (V1993 V1994) (cond ((and (cons? V1994) (and (cons? (tl V1994)) (= () (tl (tl V1994))))) (cons (cons V1993 (hd V1994)) (cons :- (tl V1994)))) (true (shen.f_error shen.insert-predicate)))) +(defun shen.insert-predicate (V832 V833) (cond ((and (cons? V833) (and (cons? (tl V833)) (= () (tl (tl V833))))) (cons (cons V832 (hd V833)) (cons :- (tl V833)))) (true (shen.f_error shen.insert-predicate)))) -(defun shen. (V1996) (if (cons? (hd V1996)) (let Parse_X (shen.hdhd V1996) (shen.pair (hd (shen.pair (shen.tlhd V1996) (shen.hdtl V1996))) Parse_X)) (fail))) +(defun shen. (V835) (if (cons? (hd V835)) (let Parse_X (shen.hdhd V835) (shen.pair (hd (shen.pair (shen.tlhd V835) (shen.hdtl V835))) Parse_X)) (fail))) -(defun shen. (V1998) (let YaccParse (let Parse_shen. (shen. V1998) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (shen.hdtl Parse_shen.) (shen.hdtl Parse_shen.))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_ ( V1998) (if (not (= (fail) Parse_)) (shen.pair (hd Parse_) ()) (fail))) YaccParse))) +(defun shen. (V837) (let YaccParse (let Parse_shen. (shen. V837) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (shen.hdtl Parse_shen.) (shen.hdtl Parse_shen.))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_ ( V837) (if (not (= (fail) Parse_)) (shen.pair (hd Parse_) ()) (fail))) YaccParse))) -(defun shen. (V2001) (let Parse_shen. (shen. V2001) (if (not (= (fail) Parse_shen.)) (if (and (cons? (hd Parse_shen.)) (= <-- (shen.hdhd Parse_shen.))) (let NewStream1999 (shen.pair (shen.tlhd Parse_shen.) (shen.hdtl Parse_shen.)) (let Parse_shen. (shen. NewStream1999) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (shen.hdtl Parse_shen.) (cons (shen.hdtl Parse_shen.) ()))) (fail))) (fail)))) (fail)) (fail)))) +(defun shen. (V840) (let Parse_shen. (shen. V840) (if (not (= (fail) Parse_shen.)) (if (and (cons? (hd Parse_shen.)) (= <-- (shen.hdhd Parse_shen.))) (let NewStream838 (shen.pair (shen.tlhd Parse_shen.) (shen.hdtl Parse_shen.)) (let Parse_shen. (shen. NewStream838) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (shen.hdtl Parse_shen.) (cons (shen.hdtl Parse_shen.) ()))) (fail))) (fail)))) (fail)) (fail)))) -(defun shen. (V2003) (let YaccParse (let Parse_shen. (shen. V2003) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (shen.hdtl Parse_shen.) (shen.hdtl Parse_shen.))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_ ( V2003) (if (not (= (fail) Parse_)) (shen.pair (hd Parse_) ()) (fail))) YaccParse))) +(defun shen. (V842) (let YaccParse (let Parse_shen. (shen. V842) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (shen.hdtl Parse_shen.) (shen.hdtl Parse_shen.))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_ ( V842) (if (not (= (fail) Parse_)) (shen.pair (hd Parse_) ()) (fail))) YaccParse))) -(defun shen. (V2005) (if (cons? (hd V2005)) (let Parse_X (shen.hdhd V2005) (if (and (not (= <-- Parse_X)) (shen.legitimate-term? Parse_X)) (shen.pair (hd (shen.pair (shen.tlhd V2005) (shen.hdtl V2005))) (shen.eval-cons Parse_X)) (fail))) (fail))) +(defun shen. (V844) (if (cons? (hd V844)) (let Parse_X (shen.hdhd V844) (if (and (not (= <-- Parse_X)) (shen.legitimate-term? Parse_X)) (shen.pair (hd (shen.pair (shen.tlhd V844) (shen.hdtl V844))) (shen.eval-cons Parse_X)) (fail))) (fail))) -(defun shen.legitimate-term? (V2011) (cond ((and (cons? V2011) (and (= cons (hd V2011)) (and (cons? (tl V2011)) (and (cons? (tl (tl V2011))) (= () (tl (tl (tl V2011)))))))) (and (shen.legitimate-term? (hd (tl V2011))) (shen.legitimate-term? (hd (tl (tl V2011)))))) ((and (cons? V2011) (and (= mode (hd V2011)) (and (cons? (tl V2011)) (and (cons? (tl (tl V2011))) (and (= + (hd (tl (tl V2011)))) (= () (tl (tl (tl V2011))))))))) (shen.legitimate-term? (hd (tl V2011)))) ((and (cons? V2011) (and (= mode (hd V2011)) (and (cons? (tl V2011)) (and (cons? (tl (tl V2011))) (and (= - (hd (tl (tl V2011)))) (= () (tl (tl (tl V2011))))))))) (shen.legitimate-term? (hd (tl V2011)))) ((cons? V2011) false) (true true))) +(defun shen.legitimate-term? (V850) (cond ((and (cons? V850) (and (= cons (hd V850)) (and (cons? (tl V850)) (and (cons? (tl (tl V850))) (= () (tl (tl (tl V850)))))))) (and (shen.legitimate-term? (hd (tl V850))) (shen.legitimate-term? (hd (tl (tl V850)))))) ((and (cons? V850) (and (= mode (hd V850)) (and (cons? (tl V850)) (and (cons? (tl (tl V850))) (and (= + (hd (tl (tl V850)))) (= () (tl (tl (tl V850))))))))) (shen.legitimate-term? (hd (tl V850)))) ((and (cons? V850) (and (= mode (hd V850)) (and (cons? (tl V850)) (and (cons? (tl (tl V850))) (and (= - (hd (tl (tl V850)))) (= () (tl (tl (tl V850))))))))) (shen.legitimate-term? (hd (tl V850)))) ((cons? V850) false) (true true))) -(defun shen.eval-cons (V2013) (cond ((and (cons? V2013) (and (= cons (hd V2013)) (and (cons? (tl V2013)) (and (cons? (tl (tl V2013))) (= () (tl (tl (tl V2013)))))))) (cons (shen.eval-cons (hd (tl V2013))) (shen.eval-cons (hd (tl (tl V2013)))))) ((and (cons? V2013) (and (= mode (hd V2013)) (and (cons? (tl V2013)) (and (cons? (tl (tl V2013))) (= () (tl (tl (tl V2013)))))))) (cons mode (cons (shen.eval-cons (hd (tl V2013))) (tl (tl V2013))))) (true V2013))) +(defun shen.eval-cons (V852) (cond ((and (cons? V852) (and (= cons (hd V852)) (and (cons? (tl V852)) (and (cons? (tl (tl V852))) (= () (tl (tl (tl V852)))))))) (cons (shen.eval-cons (hd (tl V852))) (shen.eval-cons (hd (tl (tl V852)))))) ((and (cons? V852) (and (= mode (hd V852)) (and (cons? (tl V852)) (and (cons? (tl (tl V852))) (= () (tl (tl (tl V852)))))))) (cons mode (cons (shen.eval-cons (hd (tl V852))) (tl (tl V852))))) (true V852))) -(defun shen. (V2015) (let YaccParse (let Parse_shen. (shen. V2015) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (shen.hdtl Parse_shen.) (shen.hdtl Parse_shen.))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_ ( V2015) (if (not (= (fail) Parse_)) (shen.pair (hd Parse_) ()) (fail))) YaccParse))) +(defun shen. (V854) (let YaccParse (let Parse_shen. (shen. V854) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (shen.hdtl Parse_shen.) (shen.hdtl Parse_shen.))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_ ( V854) (if (not (= (fail) Parse_)) (shen.pair (hd Parse_) ()) (fail))) YaccParse))) -(defun shen. (V2018) (let YaccParse (if (and (cons? (hd V2018)) (= ! (shen.hdhd V2018))) (let NewStream2016 (shen.pair (shen.tlhd V2018) (shen.hdtl V2018)) (shen.pair (hd NewStream2016) (cons cut (cons (intern "Throwcontrol") ())))) (fail)) (if (= YaccParse (fail)) (if (cons? (hd V2018)) (let Parse_X (shen.hdhd V2018) (if (cons? Parse_X) (shen.pair (hd (shen.pair (shen.tlhd V2018) (shen.hdtl V2018))) Parse_X) (fail))) (fail)) YaccParse))) +(defun shen. (V857) (let YaccParse (if (and (cons? (hd V857)) (= ! (shen.hdhd V857))) (let NewStream855 (shen.pair (shen.tlhd V857) (shen.hdtl V857)) (shen.pair (hd NewStream855) (cons cut (cons (intern "Throwcontrol") ())))) (fail)) (if (= YaccParse (fail)) (if (cons? (hd V857)) (let Parse_X (shen.hdhd V857) (if (cons? Parse_X) (shen.pair (hd (shen.pair (shen.tlhd V857) (shen.hdtl V857))) Parse_X) (fail))) (fail)) YaccParse))) -(defun shen. (V2020) (if (cons? (hd V2020)) (let Parse_X (shen.hdhd V2020) (if (= Parse_X ;) (shen.pair (hd (shen.pair (shen.tlhd V2020) (shen.hdtl V2020))) Parse_X) (fail))) (fail))) +(defun shen. (V859) (if (cons? (hd V859)) (let Parse_X (shen.hdhd V859) (if (= Parse_X ;) (shen.pair (hd (shen.pair (shen.tlhd V859) (shen.hdtl V859))) Parse_X) (fail))) (fail))) -(defun cut (V2024 V2025 V2026) (let Result (thaw V2026) (if (= Result false) V2024 Result))) +(defun cut (V863 V864 V865) (let Result (thaw V865) (if (= Result false) V863 Result))) -(defun shen.insert_modes (V2028) (cond ((and (cons? V2028) (and (= mode (hd V2028)) (and (cons? (tl V2028)) (and (cons? (tl (tl V2028))) (= () (tl (tl (tl V2028)))))))) V2028) ((= () V2028) ()) ((cons? V2028) (cons (cons mode (cons (hd V2028) (cons + ()))) (cons mode (cons (shen.insert_modes (tl V2028)) (cons - ()))))) (true V2028))) +(defun shen.insert_modes (V867) (cond ((and (cons? V867) (and (= mode (hd V867)) (and (cons? (tl V867)) (and (cons? (tl (tl V867))) (= () (tl (tl (tl V867)))))))) V867) ((= () V867) ()) ((cons? V867) (cons (cons mode (cons (hd V867) (cons + ()))) (cons mode (cons (shen.insert_modes (tl V867)) (cons - ()))))) (true V867))) -(defun shen.s-prolog (V2030) (map (lambda X (eval X)) (shen.prolog->shen V2030))) +(defun shen.s-prolog (V869) (map (lambda X (eval X)) (shen.prolog->shen V869))) -(defun shen.prolog->shen (V2032) (map (lambda X (shen.compile_prolog_procedure X)) (shen.group_clauses (map (lambda X (shen.s-prolog_clause X)) (mapcan (lambda X (shen.head_abstraction X)) V2032))))) +(defun shen.prolog->shen (V871) (map (lambda X (shen.compile_prolog_procedure X)) (shen.group_clauses (map (lambda X (shen.s-prolog_clause X)) (mapcan (lambda X (shen.head_abstraction X)) V871))))) -(defun shen.s-prolog_clause (V2034) (cond ((and (cons? V2034) (and (cons? (tl V2034)) (and (= :- (hd (tl V2034))) (and (cons? (tl (tl V2034))) (= () (tl (tl (tl V2034)))))))) (cons (hd V2034) (cons :- (cons (map (lambda X (shen.s-prolog_literal X)) (hd (tl (tl V2034)))) ())))) (true (shen.f_error shen.s-prolog_clause)))) +(defun shen.s-prolog_clause (V873) (cond ((and (cons? V873) (and (cons? (tl V873)) (and (= :- (hd (tl V873))) (and (cons? (tl (tl V873))) (= () (tl (tl (tl V873)))))))) (cons (hd V873) (cons :- (cons (map (lambda X (shen.s-prolog_literal X)) (hd (tl (tl V873)))) ())))) (true (shen.f_error shen.s-prolog_clause)))) -(defun shen.head_abstraction (V2036) (cond ((and (cons? V2036) (and (cons? (tl V2036)) (and (= :- (hd (tl V2036))) (and (cons? (tl (tl V2036))) (and (= () (tl (tl (tl V2036)))) (trap-error (< (shen.complexity_head (hd V2036)) (value shen.*maxcomplexity*)) (lambda _ false))))))) (cons V2036 ())) ((and (cons? V2036) (and (cons? (hd V2036)) (and (cons? (tl V2036)) (and (= :- (hd (tl V2036))) (and (cons? (tl (tl V2036))) (= () (tl (tl (tl V2036))))))))) (let Terms (map (lambda Y (gensym V)) (tl (hd V2036))) (let XTerms (shen.rcons_form (shen.remove_modes (tl (hd V2036)))) (let Literal (cons unify (cons (shen.cons_form Terms) (cons XTerms ()))) (let Clause (cons (cons (hd (hd V2036)) Terms) (cons :- (cons (cons Literal (hd (tl (tl V2036)))) ()))) (cons Clause ())))))) (true (shen.f_error shen.head_abstraction)))) +(defun shen.head_abstraction (V875) (cond ((and (cons? V875) (and (cons? (tl V875)) (and (= :- (hd (tl V875))) (and (cons? (tl (tl V875))) (and (= () (tl (tl (tl V875)))) (trap-error (< (shen.complexity_head (hd V875)) (value shen.*maxcomplexity*)) (lambda _ false))))))) (cons V875 ())) ((and (cons? V875) (and (cons? (hd V875)) (and (cons? (tl V875)) (and (= :- (hd (tl V875))) (and (cons? (tl (tl V875))) (= () (tl (tl (tl V875))))))))) (let Terms (map (lambda Y (gensym V)) (tl (hd V875))) (let XTerms (shen.rcons_form (shen.remove_modes (tl (hd V875)))) (let Literal (cons unify (cons (shen.cons_form Terms) (cons XTerms ()))) (let Clause (cons (cons (hd (hd V875)) Terms) (cons :- (cons (cons Literal (hd (tl (tl V875)))) ()))) (cons Clause ())))))) (true (shen.f_error shen.head_abstraction)))) -(defun shen.complexity_head (V2042) (cond ((cons? V2042) (shen.safe-product (map (lambda X (shen.complexity X)) (tl V2042)))) (true (shen.f_error shen.complexity_head)))) +(defun shen.complexity_head (V881) (cond ((cons? V881) (shen.safe-product (map (lambda X (shen.complexity X)) (tl V881)))) (true (shen.f_error shen.complexity_head)))) -(defun shen.safe-multiply (V2045 V2046) (* V2045 V2046)) +(defun shen.safe-multiply (V884 V885) (* V884 V885)) -(defun shen.complexity (V2055) (cond ((and (cons? V2055) (and (= mode (hd V2055)) (and (cons? (tl V2055)) (and (cons? (hd (tl V2055))) (and (= mode (hd (hd (tl V2055)))) (and (cons? (tl (hd (tl V2055)))) (and (cons? (tl (tl (hd (tl V2055))))) (and (= () (tl (tl (tl (hd (tl V2055)))))) (and (cons? (tl (tl V2055))) (= () (tl (tl (tl V2055))))))))))))) (shen.complexity (hd (tl V2055)))) ((and (cons? V2055) (and (= mode (hd V2055)) (and (cons? (tl V2055)) (and (cons? (hd (tl V2055))) (and (cons? (tl (tl V2055))) (and (= + (hd (tl (tl V2055)))) (= () (tl (tl (tl V2055)))))))))) (shen.safe-multiply 2 (shen.safe-multiply (shen.complexity (cons mode (cons (hd (hd (tl V2055))) (tl (tl V2055))))) (shen.complexity (cons mode (cons (tl (hd (tl V2055))) (tl (tl V2055)))))))) ((and (cons? V2055) (and (= mode (hd V2055)) (and (cons? (tl V2055)) (and (cons? (hd (tl V2055))) (and (cons? (tl (tl V2055))) (and (= - (hd (tl (tl V2055)))) (= () (tl (tl (tl V2055)))))))))) (shen.safe-multiply (shen.complexity (cons mode (cons (hd (hd (tl V2055))) (tl (tl V2055))))) (shen.complexity (cons mode (cons (tl (hd (tl V2055))) (tl (tl V2055))))))) ((and (cons? V2055) (and (= mode (hd V2055)) (and (cons? (tl V2055)) (and (cons? (tl (tl V2055))) (and (= () (tl (tl (tl V2055)))) (variable? (hd (tl V2055)))))))) 1) ((and (cons? V2055) (and (= mode (hd V2055)) (and (cons? (tl V2055)) (and (cons? (tl (tl V2055))) (and (= + (hd (tl (tl V2055)))) (= () (tl (tl (tl V2055))))))))) 2) ((and (cons? V2055) (and (= mode (hd V2055)) (and (cons? (tl V2055)) (and (cons? (tl (tl V2055))) (and (= - (hd (tl (tl V2055)))) (= () (tl (tl (tl V2055))))))))) 1) (true (shen.complexity (cons mode (cons V2055 (cons + ()))))))) +(defun shen.complexity (V894) (cond ((and (cons? V894) (and (= mode (hd V894)) (and (cons? (tl V894)) (and (cons? (hd (tl V894))) (and (= mode (hd (hd (tl V894)))) (and (cons? (tl (hd (tl V894)))) (and (cons? (tl (tl (hd (tl V894))))) (and (= () (tl (tl (tl (hd (tl V894)))))) (and (cons? (tl (tl V894))) (= () (tl (tl (tl V894))))))))))))) (shen.complexity (hd (tl V894)))) ((and (cons? V894) (and (= mode (hd V894)) (and (cons? (tl V894)) (and (cons? (hd (tl V894))) (and (cons? (tl (tl V894))) (and (= + (hd (tl (tl V894)))) (= () (tl (tl (tl V894)))))))))) (shen.safe-multiply 2 (shen.safe-multiply (shen.complexity (cons mode (cons (hd (hd (tl V894))) (tl (tl V894))))) (shen.complexity (cons mode (cons (tl (hd (tl V894))) (tl (tl V894)))))))) ((and (cons? V894) (and (= mode (hd V894)) (and (cons? (tl V894)) (and (cons? (hd (tl V894))) (and (cons? (tl (tl V894))) (and (= - (hd (tl (tl V894)))) (= () (tl (tl (tl V894)))))))))) (shen.safe-multiply (shen.complexity (cons mode (cons (hd (hd (tl V894))) (tl (tl V894))))) (shen.complexity (cons mode (cons (tl (hd (tl V894))) (tl (tl V894))))))) ((and (cons? V894) (and (= mode (hd V894)) (and (cons? (tl V894)) (and (cons? (tl (tl V894))) (and (= () (tl (tl (tl V894)))) (variable? (hd (tl V894)))))))) 1) ((and (cons? V894) (and (= mode (hd V894)) (and (cons? (tl V894)) (and (cons? (tl (tl V894))) (and (= + (hd (tl (tl V894)))) (= () (tl (tl (tl V894))))))))) 2) ((and (cons? V894) (and (= mode (hd V894)) (and (cons? (tl V894)) (and (cons? (tl (tl V894))) (and (= - (hd (tl (tl V894)))) (= () (tl (tl (tl V894))))))))) 1) (true (shen.complexity (cons mode (cons V894 (cons + ()))))))) -(defun shen.safe-product (V2057) (cond ((= () V2057) 1) ((cons? V2057) (shen.safe-multiply (hd V2057) (shen.safe-product (tl V2057)))) (true (shen.f_error shen.safe-product)))) +(defun shen.safe-product (V896) (cond ((= () V896) 1) ((cons? V896) (shen.safe-multiply (hd V896) (shen.safe-product (tl V896)))) (true (shen.f_error shen.safe-product)))) -(defun shen.s-prolog_literal (V2059) (cond ((and (cons? V2059) (and (= is (hd V2059)) (and (cons? (tl V2059)) (and (cons? (tl (tl V2059))) (= () (tl (tl (tl V2059)))))))) (cons bind (cons (hd (tl V2059)) (cons (shen.insert-deref (hd (tl (tl V2059))) ProcessN) ())))) ((and (cons? V2059) (and (= when (hd V2059)) (and (cons? (tl V2059)) (= () (tl (tl V2059)))))) (cons fwhen (cons (shen.insert-deref (hd (tl V2059)) ProcessN) ()))) ((and (cons? V2059) (and (= bind (hd V2059)) (and (cons? (tl V2059)) (and (cons? (tl (tl V2059))) (= () (tl (tl (tl V2059)))))))) (cons bind (cons (hd (tl V2059)) (cons (shen.insert-lazyderef (hd (tl (tl V2059))) ProcessN) ())))) ((and (cons? V2059) (and (= fwhen (hd V2059)) (and (cons? (tl V2059)) (= () (tl (tl V2059)))))) (cons fwhen (cons (shen.insert-lazyderef (hd (tl V2059)) ProcessN) ()))) ((cons? V2059) V2059) (true (shen.f_error shen.s-prolog_literal)))) +(defun shen.s-prolog_literal (V898) (cond ((and (cons? V898) (and (= is (hd V898)) (and (cons? (tl V898)) (and (cons? (tl (tl V898))) (= () (tl (tl (tl V898)))))))) (cons bind (cons (hd (tl V898)) (cons (shen.insert-deref (hd (tl (tl V898))) ProcessN) ())))) ((and (cons? V898) (and (= when (hd V898)) (and (cons? (tl V898)) (= () (tl (tl V898)))))) (cons fwhen (cons (shen.insert-deref (hd (tl V898)) ProcessN) ()))) ((and (cons? V898) (and (= bind (hd V898)) (and (cons? (tl V898)) (and (cons? (tl (tl V898))) (= () (tl (tl (tl V898)))))))) (cons bind (cons (hd (tl V898)) (cons (shen.insert-lazyderef (hd (tl (tl V898))) ProcessN) ())))) ((and (cons? V898) (and (= fwhen (hd V898)) (and (cons? (tl V898)) (= () (tl (tl V898)))))) (cons fwhen (cons (shen.insert-lazyderef (hd (tl V898)) ProcessN) ()))) ((cons? V898) V898) (true (shen.f_error shen.s-prolog_literal)))) -(defun shen.insert-deref (V2066 V2067) (cond ((variable? V2066) (cons shen.deref (cons V2066 (cons V2067 ())))) ((and (cons? V2066) (and (= lambda (hd V2066)) (and (cons? (tl V2066)) (and (cons? (tl (tl V2066))) (= () (tl (tl (tl V2066)))))))) (cons lambda (cons (hd (tl V2066)) (cons (shen.insert-deref (hd (tl (tl V2066))) V2067) ())))) ((and (cons? V2066) (and (= let (hd V2066)) (and (cons? (tl V2066)) (and (cons? (tl (tl V2066))) (and (cons? (tl (tl (tl V2066)))) (= () (tl (tl (tl (tl V2066)))))))))) (cons let (cons (hd (tl V2066)) (cons (shen.insert-deref (hd (tl (tl V2066))) V2067) (cons (shen.insert-deref (hd (tl (tl (tl V2066)))) V2067) ()))))) ((cons? V2066) (cons (shen.insert-deref (hd V2066) V2067) (shen.insert-deref (tl V2066) V2067))) (true V2066))) +(defun shen.insert-deref (V905 V906) (cond ((variable? V905) (cons shen.deref (cons V905 (cons V906 ())))) ((and (cons? V905) (and (= lambda (hd V905)) (and (cons? (tl V905)) (and (cons? (tl (tl V905))) (= () (tl (tl (tl V905)))))))) (cons lambda (cons (hd (tl V905)) (cons (shen.insert-deref (hd (tl (tl V905))) V906) ())))) ((and (cons? V905) (and (= let (hd V905)) (and (cons? (tl V905)) (and (cons? (tl (tl V905))) (and (cons? (tl (tl (tl V905)))) (= () (tl (tl (tl (tl V905)))))))))) (cons let (cons (hd (tl V905)) (cons (shen.insert-deref (hd (tl (tl V905))) V906) (cons (shen.insert-deref (hd (tl (tl (tl V905)))) V906) ()))))) ((cons? V905) (cons (shen.insert-deref (hd V905) V906) (shen.insert-deref (tl V905) V906))) (true V905))) -(defun shen.insert-lazyderef (V2074 V2075) (cond ((variable? V2074) (cons shen.lazyderef (cons V2074 (cons V2075 ())))) ((and (cons? V2074) (and (= lambda (hd V2074)) (and (cons? (tl V2074)) (and (cons? (tl (tl V2074))) (= () (tl (tl (tl V2074)))))))) (cons lambda (cons (hd (tl V2074)) (cons (shen.insert-lazyderef (hd (tl (tl V2074))) V2075) ())))) ((and (cons? V2074) (and (= let (hd V2074)) (and (cons? (tl V2074)) (and (cons? (tl (tl V2074))) (and (cons? (tl (tl (tl V2074)))) (= () (tl (tl (tl (tl V2074)))))))))) (cons let (cons (hd (tl V2074)) (cons (shen.insert-lazyderef (hd (tl (tl V2074))) V2075) (cons (shen.insert-lazyderef (hd (tl (tl (tl V2074)))) V2075) ()))))) ((cons? V2074) (cons (shen.insert-lazyderef (hd V2074) V2075) (shen.insert-lazyderef (tl V2074) V2075))) (true V2074))) +(defun shen.insert-lazyderef (V913 V914) (cond ((variable? V913) (cons shen.lazyderef (cons V913 (cons V914 ())))) ((and (cons? V913) (and (= lambda (hd V913)) (and (cons? (tl V913)) (and (cons? (tl (tl V913))) (= () (tl (tl (tl V913)))))))) (cons lambda (cons (hd (tl V913)) (cons (shen.insert-lazyderef (hd (tl (tl V913))) V914) ())))) ((and (cons? V913) (and (= let (hd V913)) (and (cons? (tl V913)) (and (cons? (tl (tl V913))) (and (cons? (tl (tl (tl V913)))) (= () (tl (tl (tl (tl V913)))))))))) (cons let (cons (hd (tl V913)) (cons (shen.insert-lazyderef (hd (tl (tl V913))) V914) (cons (shen.insert-lazyderef (hd (tl (tl (tl V913)))) V914) ()))))) ((cons? V913) (cons (shen.insert-lazyderef (hd V913) V914) (shen.insert-lazyderef (tl V913) V914))) (true V913))) -(defun shen.group_clauses (V2077) (cond ((= () V2077) ()) ((cons? V2077) (let Group (shen.collect (lambda X (shen.same_predicate? (hd V2077) X)) V2077) (let Rest (difference V2077 Group) (cons Group (shen.group_clauses Rest))))) (true (shen.f_error shen.group_clauses)))) +(defun shen.group_clauses (V916) (cond ((= () V916) ()) ((cons? V916) (let Group (shen.collect (lambda X (shen.same_predicate? (hd V916) X)) V916) (let Rest (difference V916 Group) (cons Group (shen.group_clauses Rest))))) (true (shen.f_error shen.group_clauses)))) -(defun shen.collect (V2082 V2083) (cond ((= () V2083) ()) ((cons? V2083) (if (V2082 (hd V2083)) (cons (hd V2083) (shen.collect V2082 (tl V2083))) (shen.collect V2082 (tl V2083)))) (true (shen.f_error shen.collect)))) +(defun shen.collect (V921 V922) (cond ((= () V922) ()) ((cons? V922) (if (V921 (hd V922)) (cons (hd V922) (shen.collect V921 (tl V922))) (shen.collect V921 (tl V922)))) (true (shen.f_error shen.collect)))) -(defun shen.same_predicate? (V2102 V2103) (cond ((and (cons? V2102) (and (cons? (hd V2102)) (and (cons? V2103) (cons? (hd V2103))))) (= (hd (hd V2102)) (hd (hd V2103)))) (true (shen.f_error shen.same_predicate?)))) +(defun shen.same_predicate? (V941 V942) (cond ((and (cons? V941) (and (cons? (hd V941)) (and (cons? V942) (cons? (hd V942))))) (= (hd (hd V941)) (hd (hd V942)))) (true (shen.f_error shen.same_predicate?)))) -(defun shen.compile_prolog_procedure (V2105) (let F (shen.procedure_name V2105) (let Shen (shen.clauses-to-shen F V2105) Shen))) +(defun shen.compile_prolog_procedure (V944) (let F (shen.procedure_name V944) (let Shen (shen.clauses-to-shen F V944) Shen))) -(defun shen.procedure_name (V2119) (cond ((and (cons? V2119) (and (cons? (hd V2119)) (cons? (hd (hd V2119))))) (hd (hd (hd V2119)))) (true (shen.f_error shen.procedure_name)))) +(defun shen.procedure_name (V958) (cond ((and (cons? V958) (and (cons? (hd V958)) (cons? (hd (hd V958))))) (hd (hd (hd V958)))) (true (shen.f_error shen.procedure_name)))) -(defun shen.clauses-to-shen (V2122 V2123) (let Linear (map (lambda X (shen.linearise-clause X)) V2123) (let Arity (shen.prolog-aritycheck V2122 (map (lambda X (head X)) V2123)) (let Parameters (shen.parameters Arity) (let AUM_instructions (map (lambda X (shen.aum X Parameters)) Linear) (let Code (shen.catch-cut (shen.nest-disjunct (map (lambda X (shen.aum_to_shen X)) AUM_instructions))) (let ShenDef (cons define (cons V2122 (append Parameters (append (cons ProcessN (cons Continuation ())) (cons -> (cons Code ())))))) ShenDef))))))) +(defun shen.clauses-to-shen (V961 V962) (let Linear (map (lambda X (shen.linearise-clause X)) V962) (let Arity (shen.prolog-aritycheck V961 (map (lambda X (head X)) V962)) (let Parameters (shen.parameters Arity) (let AUM_instructions (map (lambda X (shen.aum X Parameters)) Linear) (let Code (shen.catch-cut (shen.nest-disjunct (map (lambda X (shen.aum_to_shen X)) AUM_instructions))) (let ShenDef (cons define (cons V961 (append Parameters (append (cons ProcessN (cons Continuation ())) (cons -> (cons Code ())))))) ShenDef))))))) -(defun shen.catch-cut (V2125) (cond ((not (shen.occurs? cut V2125)) V2125) (true (cons let (cons Throwcontrol (cons (cons shen.catchpoint ()) (cons (cons shen.cutpoint (cons Throwcontrol (cons V2125 ()))) ()))))))) +(defun shen.catch-cut (V964) (cond ((not (shen.occurs? cut V964)) V964) (true (cons let (cons Throwcontrol (cons (cons shen.catchpoint ()) (cons (cons shen.cutpoint (cons Throwcontrol (cons V964 ()))) ()))))))) -(defun shen.catchpoint () (set shen.*catch* (+ 1 (value shen.*catch*)))) +(defun shen.catchpoint () (cons shen.catchpoint! (set shen.*catch* (+ 1 (value shen.*catch*))))) -(defun shen.cutpoint (V2133 V2134) (cond ((= V2134 V2133) false) (true V2134))) +(defun shen.cutpoint (V972 V973) (cond ((= V973 V972) false) (true V973))) -(defun shen.nest-disjunct (V2136) (cond ((and (cons? V2136) (= () (tl V2136))) (hd V2136)) ((cons? V2136) (shen.lisp-or (hd V2136) (shen.nest-disjunct (tl V2136)))) (true (shen.f_error shen.nest-disjunct)))) +(defun shen.nest-disjunct (V975) (cond ((and (cons? V975) (= () (tl V975))) (hd V975)) ((cons? V975) (shen.lisp-or (hd V975) (shen.nest-disjunct (tl V975)))) (true (shen.f_error shen.nest-disjunct)))) -(defun shen.lisp-or (V2139 V2140) (cons let (cons Case (cons V2139 (cons (cons if (cons (cons = (cons Case (cons false ()))) (cons V2140 (cons Case ())))) ()))))) +(defun shen.lisp-or (V978 V979) (cons let (cons Case (cons V978 (cons (cons if (cons (cons = (cons Case (cons false ()))) (cons V979 (cons Case ())))) ()))))) -(defun shen.prolog-aritycheck (V2145 V2146) (cond ((and (cons? V2146) (= () (tl V2146))) (- (length (hd V2146)) 1)) ((and (cons? V2146) (cons? (tl V2146))) (if (= (length (hd V2146)) (length (hd (tl V2146)))) (shen.prolog-aritycheck V2145 (tl V2146)) (simple-error (cn "arity error in prolog procedure " (shen.app (cons V2145 ()) " +(defun shen.prolog-aritycheck (V984 V985) (cond ((and (cons? V985) (= () (tl V985))) (- (length (hd V985)) 1)) ((and (cons? V985) (cons? (tl V985))) (if (= (length (hd V985)) (length (hd (tl V985)))) (shen.prolog-aritycheck V984 (tl V985)) (simple-error (cn "arity error in prolog procedure " (shen.app (cons V984 ()) " " shen.a))))) (true (shen.f_error shen.prolog-aritycheck)))) -(defun shen.linearise-clause (V2148) (cond ((and (cons? V2148) (and (cons? (tl V2148)) (and (= :- (hd (tl V2148))) (and (cons? (tl (tl V2148))) (= () (tl (tl (tl V2148)))))))) (let Linear (shen.linearise (cons (hd V2148) (tl (tl V2148)))) (shen.clause_form Linear))) (true (shen.f_error shen.linearise-clause)))) +(defun shen.linearise-clause (V987) (cond ((and (cons? V987) (and (cons? (tl V987)) (and (= :- (hd (tl V987))) (and (cons? (tl (tl V987))) (= () (tl (tl (tl V987)))))))) (let Linear (shen.linearise (cons (hd V987) (tl (tl V987)))) (shen.clause_form Linear))) (true (shen.f_error shen.linearise-clause)))) -(defun shen.clause_form (V2150) (cond ((and (cons? V2150) (and (cons? (tl V2150)) (= () (tl (tl V2150))))) (cons (shen.explicit_modes (hd V2150)) (cons :- (cons (shen.cf_help (hd (tl V2150))) ())))) (true (shen.f_error shen.clause_form)))) +(defun shen.clause_form (V989) (cond ((and (cons? V989) (and (cons? (tl V989)) (= () (tl (tl V989))))) (cons (shen.explicit_modes (hd V989)) (cons :- (cons (shen.cf_help (hd (tl V989))) ())))) (true (shen.f_error shen.clause_form)))) -(defun shen.explicit_modes (V2152) (cond ((cons? V2152) (cons (hd V2152) (map (lambda X (shen.em_help X)) (tl V2152)))) (true (shen.f_error shen.explicit_modes)))) +(defun shen.explicit_modes (V991) (cond ((cons? V991) (cons (hd V991) (map (lambda X (shen.em_help X)) (tl V991)))) (true (shen.f_error shen.explicit_modes)))) -(defun shen.em_help (V2154) (cond ((and (cons? V2154) (and (= mode (hd V2154)) (and (cons? (tl V2154)) (and (cons? (tl (tl V2154))) (= () (tl (tl (tl V2154)))))))) V2154) (true (cons mode (cons V2154 (cons + ())))))) +(defun shen.em_help (V993) (cond ((and (cons? V993) (and (= mode (hd V993)) (and (cons? (tl V993)) (and (cons? (tl (tl V993))) (= () (tl (tl (tl V993)))))))) V993) (true (cons mode (cons V993 (cons + ())))))) -(defun shen.cf_help (V2156) (cond ((and (cons? V2156) (and (= where (hd V2156)) (and (cons? (tl V2156)) (and (cons? (hd (tl V2156))) (and (= = (hd (hd (tl V2156)))) (and (cons? (tl (hd (tl V2156)))) (and (cons? (tl (tl (hd (tl V2156))))) (and (= () (tl (tl (tl (hd (tl V2156)))))) (and (cons? (tl (tl V2156))) (= () (tl (tl (tl V2156))))))))))))) (cons (cons (if (value shen.*occurs*) unify! unify) (tl (hd (tl V2156)))) (shen.cf_help (hd (tl (tl V2156)))))) (true V2156))) +(defun shen.cf_help (V995) (cond ((and (cons? V995) (and (= where (hd V995)) (and (cons? (tl V995)) (and (cons? (hd (tl V995))) (and (= = (hd (hd (tl V995)))) (and (cons? (tl (hd (tl V995)))) (and (cons? (tl (tl (hd (tl V995))))) (and (= () (tl (tl (tl (hd (tl V995)))))) (and (cons? (tl (tl V995))) (= () (tl (tl (tl V995))))))))))))) (cons (cons (if (value shen.*occurs*) unify! unify) (tl (hd (tl V995)))) (shen.cf_help (hd (tl (tl V995)))))) (true V995))) -(defun occurs-check (V2162) (cond ((= + V2162) (set shen.*occurs* true)) ((= - V2162) (set shen.*occurs* false)) (true (simple-error "occurs-check expects + or - +(defun occurs-check (V1001) (cond ((= + V1001) (set shen.*occurs* true)) ((= - V1001) (set shen.*occurs* false)) (true (simple-error "occurs-check expects + or - ")))) -(defun shen.aum (V2165 V2166) (cond ((and (cons? V2165) (and (cons? (hd V2165)) (and (cons? (tl V2165)) (and (= :- (hd (tl V2165))) (and (cons? (tl (tl V2165))) (= () (tl (tl (tl V2165))))))))) (let MuApplication (shen.make_mu_application (cons shen.mu (cons (tl (hd V2165)) (cons (shen.continuation_call (tl (hd V2165)) (hd (tl (tl V2165)))) ()))) V2166) (shen.mu_reduction MuApplication +))) (true (shen.f_error shen.aum)))) +(defun shen.aum (V1004 V1005) (cond ((and (cons? V1004) (and (cons? (hd V1004)) (and (cons? (tl V1004)) (and (= :- (hd (tl V1004))) (and (cons? (tl (tl V1004))) (= () (tl (tl (tl V1004))))))))) (let MuApplication (shen.make_mu_application (cons shen.mu (cons (tl (hd V1004)) (cons (shen.continuation_call (tl (hd V1004)) (hd (tl (tl V1004)))) ()))) V1005) (shen.mu_reduction MuApplication +))) (true (shen.f_error shen.aum)))) -(defun shen.continuation_call (V2169 V2170) (let VTerms (cons ProcessN (shen.extract_vars V2169)) (let VBody (shen.extract_vars V2170) (let Free (remove Throwcontrol (difference VBody VTerms)) (shen.cc_help Free V2170))))) +(defun shen.continuation_call (V1008 V1009) (let VTerms (cons ProcessN (shen.extract_vars V1008)) (let VBody (shen.extract_vars V1009) (let Free (remove Throwcontrol (difference VBody VTerms)) (shen.cc_help Free V1009))))) -(defun remove (V2173 V2174) (shen.remove-h V2173 V2174 ())) +(defun remove (V1012 V1013) (shen.remove-h V1012 V1013 ())) -(defun shen.remove-h (V2181 V2182 V2183) (cond ((= () V2182) (reverse V2183)) ((and (cons? V2182) (= (hd V2182) V2181)) (shen.remove-h (hd V2182) (tl V2182) V2183)) ((cons? V2182) (shen.remove-h V2181 (tl V2182) (cons (hd V2182) V2183))) (true (shen.f_error shen.remove-h)))) +(defun shen.remove-h (V1020 V1021 V1022) (cond ((= () V1021) (reverse V1022)) ((and (cons? V1021) (= (hd V1021) V1020)) (shen.remove-h (hd V1021) (tl V1021) V1022)) ((cons? V1021) (shen.remove-h V1020 (tl V1021) (cons (hd V1021) V1022))) (true (shen.f_error shen.remove-h)))) -(defun shen.cc_help (V2186 V2187) (cond ((and (= () V2186) (= () V2187)) (cons shen.pop (cons shen.the (cons shen.stack ())))) ((= () V2187) (cons shen.rename (cons shen.the (cons shen.variables (cons in (cons V2186 (cons and (cons shen.then (cons (cons shen.pop (cons shen.the (cons shen.stack ()))) ()))))))))) ((= () V2186) (cons call (cons shen.the (cons shen.continuation (cons V2187 ()))))) (true (cons shen.rename (cons shen.the (cons shen.variables (cons in (cons V2186 (cons and (cons shen.then (cons (cons call (cons shen.the (cons shen.continuation (cons V2187 ())))) ()))))))))))) +(defun shen.cc_help (V1025 V1026) (cond ((and (= () V1025) (= () V1026)) (cons shen.pop (cons shen.the (cons shen.stack ())))) ((= () V1026) (cons shen.rename (cons shen.the (cons shen.variables (cons in (cons V1025 (cons and (cons shen.then (cons (cons shen.pop (cons shen.the (cons shen.stack ()))) ()))))))))) ((= () V1025) (cons call (cons shen.the (cons shen.continuation (cons V1026 ()))))) (true (cons shen.rename (cons shen.the (cons shen.variables (cons in (cons V1025 (cons and (cons shen.then (cons (cons call (cons shen.the (cons shen.continuation (cons V1026 ())))) ()))))))))))) -(defun shen.make_mu_application (V2190 V2191) (cond ((and (cons? V2190) (and (= shen.mu (hd V2190)) (and (cons? (tl V2190)) (and (= () (hd (tl V2190))) (and (cons? (tl (tl V2190))) (and (= () (tl (tl (tl V2190)))) (= () V2191))))))) (hd (tl (tl V2190)))) ((and (cons? V2190) (and (= shen.mu (hd V2190)) (and (cons? (tl V2190)) (and (cons? (hd (tl V2190))) (and (cons? (tl (tl V2190))) (and (= () (tl (tl (tl V2190)))) (cons? V2191))))))) (cons (cons shen.mu (cons (hd (hd (tl V2190))) (cons (shen.make_mu_application (cons shen.mu (cons (tl (hd (tl V2190))) (tl (tl V2190)))) (tl V2191)) ()))) (cons (hd V2191) ()))) (true (shen.f_error shen.make_mu_application)))) +(defun shen.make_mu_application (V1029 V1030) (cond ((and (cons? V1029) (and (= shen.mu (hd V1029)) (and (cons? (tl V1029)) (and (= () (hd (tl V1029))) (and (cons? (tl (tl V1029))) (and (= () (tl (tl (tl V1029)))) (= () V1030))))))) (hd (tl (tl V1029)))) ((and (cons? V1029) (and (= shen.mu (hd V1029)) (and (cons? (tl V1029)) (and (cons? (hd (tl V1029))) (and (cons? (tl (tl V1029))) (and (= () (tl (tl (tl V1029)))) (cons? V1030))))))) (cons (cons shen.mu (cons (hd (hd (tl V1029))) (cons (shen.make_mu_application (cons shen.mu (cons (tl (hd (tl V1029))) (tl (tl V1029)))) (tl V1030)) ()))) (cons (hd V1030) ()))) (true (shen.f_error shen.make_mu_application)))) -(defun shen.mu_reduction (V2200 V2201) (cond ((and (cons? V2200) (and (cons? (hd V2200)) (and (= shen.mu (hd (hd V2200))) (and (cons? (tl (hd V2200))) (and (cons? (hd (tl (hd V2200)))) (and (= mode (hd (hd (tl (hd V2200))))) (and (cons? (tl (hd (tl (hd V2200))))) (and (cons? (tl (tl (hd (tl (hd V2200)))))) (and (= () (tl (tl (tl (hd (tl (hd V2200))))))) (and (cons? (tl (tl (hd V2200)))) (and (= () (tl (tl (tl (hd V2200))))) (and (cons? (tl V2200)) (= () (tl (tl V2200))))))))))))))) (shen.mu_reduction (cons (cons shen.mu (cons (hd (tl (hd (tl (hd V2200))))) (tl (tl (hd V2200))))) (tl V2200)) (hd (tl (tl (hd (tl (hd V2200)))))))) ((and (cons? V2200) (and (cons? (hd V2200)) (and (= shen.mu (hd (hd V2200))) (and (cons? (tl (hd V2200))) (and (cons? (tl (tl (hd V2200)))) (and (= () (tl (tl (tl (hd V2200))))) (and (cons? (tl V2200)) (and (= () (tl (tl V2200))) (= _ (hd (tl (hd V2200)))))))))))) (shen.mu_reduction (hd (tl (tl (hd V2200)))) V2201)) ((and (cons? V2200) (and (cons? (hd V2200)) (and (= shen.mu (hd (hd V2200))) (and (cons? (tl (hd V2200))) (and (cons? (tl (tl (hd V2200)))) (and (= () (tl (tl (tl (hd V2200))))) (and (cons? (tl V2200)) (and (= () (tl (tl V2200))) (shen.ephemeral_variable? (hd (tl (hd V2200))) (hd (tl V2200))))))))))) (subst (hd (tl V2200)) (hd (tl (hd V2200))) (shen.mu_reduction (hd (tl (tl (hd V2200)))) V2201))) ((and (cons? V2200) (and (cons? (hd V2200)) (and (= shen.mu (hd (hd V2200))) (and (cons? (tl (hd V2200))) (and (cons? (tl (tl (hd V2200)))) (and (= () (tl (tl (tl (hd V2200))))) (and (cons? (tl V2200)) (and (= () (tl (tl V2200))) (variable? (hd (tl (hd V2200)))))))))))) (cons let (cons (hd (tl (hd V2200))) (cons shen.be (cons (hd (tl V2200)) (cons in (cons (shen.mu_reduction (hd (tl (tl (hd V2200)))) V2201) ()))))))) ((and (cons? V2200) (and (cons? (hd V2200)) (and (= shen.mu (hd (hd V2200))) (and (cons? (tl (hd V2200))) (and (cons? (tl (tl (hd V2200)))) (and (= () (tl (tl (tl (hd V2200))))) (and (cons? (tl V2200)) (and (= () (tl (tl V2200))) (and (= - V2201) (shen.prolog_constant? (hd (tl (hd V2200))))))))))))) (let Z (gensym V) (cons let (cons Z (cons shen.be (cons (cons shen.the (cons shen.result (cons shen.of (cons shen.dereferencing (tl V2200))))) (cons in (cons (cons if (cons (cons Z (cons is (cons identical (cons shen.to (cons (hd (tl (hd V2200))) ()))))) (cons shen.then (cons (shen.mu_reduction (hd (tl (tl (hd V2200)))) -) (cons shen.else (cons shen.failed! ())))))) ())))))))) ((and (cons? V2200) (and (cons? (hd V2200)) (and (= shen.mu (hd (hd V2200))) (and (cons? (tl (hd V2200))) (and (cons? (tl (tl (hd V2200)))) (and (= () (tl (tl (tl (hd V2200))))) (and (cons? (tl V2200)) (and (= () (tl (tl V2200))) (and (= + V2201) (shen.prolog_constant? (hd (tl (hd V2200))))))))))))) (let Z (gensym V) (cons let (cons Z (cons shen.be (cons (cons shen.the (cons shen.result (cons shen.of (cons shen.dereferencing (tl V2200))))) (cons in (cons (cons if (cons (cons Z (cons is (cons identical (cons shen.to (cons (hd (tl (hd V2200))) ()))))) (cons shen.then (cons (shen.mu_reduction (hd (tl (tl (hd V2200)))) +) (cons shen.else (cons (cons if (cons (cons Z (cons is (cons shen.a (cons shen.variable ())))) (cons shen.then (cons (cons bind (cons Z (cons shen.to (cons (hd (tl (hd V2200))) (cons in (cons (shen.mu_reduction (hd (tl (tl (hd V2200)))) +) ())))))) (cons shen.else (cons shen.failed! ())))))) ())))))) ())))))))) ((and (cons? V2200) (and (cons? (hd V2200)) (and (= shen.mu (hd (hd V2200))) (and (cons? (tl (hd V2200))) (and (cons? (hd (tl (hd V2200)))) (and (cons? (tl (tl (hd V2200)))) (and (= () (tl (tl (tl (hd V2200))))) (and (cons? (tl V2200)) (and (= () (tl (tl V2200))) (= - V2201)))))))))) (let Z (gensym V) (cons let (cons Z (cons shen.be (cons (cons shen.the (cons shen.result (cons shen.of (cons shen.dereferencing (tl V2200))))) (cons in (cons (cons if (cons (cons Z (cons is (cons shen.a (cons shen.non-empty (cons list ()))))) (cons shen.then (cons (shen.mu_reduction (cons (cons shen.mu (cons (hd (hd (tl (hd V2200)))) (cons (cons (cons shen.mu (cons (tl (hd (tl (hd V2200)))) (tl (tl (hd V2200))))) (cons (cons shen.the (cons tail (cons shen.of (cons Z ())))) ())) ()))) (cons (cons shen.the (cons head (cons shen.of (cons Z ())))) ())) -) (cons shen.else (cons shen.failed! ())))))) ())))))))) ((and (cons? V2200) (and (cons? (hd V2200)) (and (= shen.mu (hd (hd V2200))) (and (cons? (tl (hd V2200))) (and (cons? (hd (tl (hd V2200)))) (and (cons? (tl (tl (hd V2200)))) (and (= () (tl (tl (tl (hd V2200))))) (and (cons? (tl V2200)) (and (= () (tl (tl V2200))) (= + V2201)))))))))) (let Z (gensym V) (cons let (cons Z (cons shen.be (cons (cons shen.the (cons shen.result (cons shen.of (cons shen.dereferencing (tl V2200))))) (cons in (cons (cons if (cons (cons Z (cons is (cons shen.a (cons shen.non-empty (cons list ()))))) (cons shen.then (cons (shen.mu_reduction (cons (cons shen.mu (cons (hd (hd (tl (hd V2200)))) (cons (cons (cons shen.mu (cons (tl (hd (tl (hd V2200)))) (tl (tl (hd V2200))))) (cons (cons shen.the (cons tail (cons shen.of (cons Z ())))) ())) ()))) (cons (cons shen.the (cons head (cons shen.of (cons Z ())))) ())) +) (cons shen.else (cons (cons if (cons (cons Z (cons is (cons shen.a (cons shen.variable ())))) (cons shen.then (cons (cons shen.rename (cons shen.the (cons shen.variables (cons in (cons (shen.extract_vars (hd (tl (hd V2200)))) (cons and (cons shen.then (cons (cons bind (cons Z (cons shen.to (cons (shen.rcons_form (shen.remove_modes (hd (tl (hd V2200))))) (cons in (cons (shen.mu_reduction (hd (tl (tl (hd V2200)))) +) ())))))) ())))))))) (cons shen.else (cons shen.failed! ())))))) ())))))) ())))))))) (true V2200))) +(defun shen.mu_reduction (V1039 V1040) (cond ((and (cons? V1039) (and (cons? (hd V1039)) (and (= shen.mu (hd (hd V1039))) (and (cons? (tl (hd V1039))) (and (cons? (hd (tl (hd V1039)))) (and (= mode (hd (hd (tl (hd V1039))))) (and (cons? (tl (hd (tl (hd V1039))))) (and (cons? (tl (tl (hd (tl (hd V1039)))))) (and (= () (tl (tl (tl (hd (tl (hd V1039))))))) (and (cons? (tl (tl (hd V1039)))) (and (= () (tl (tl (tl (hd V1039))))) (and (cons? (tl V1039)) (= () (tl (tl V1039))))))))))))))) (shen.mu_reduction (cons (cons shen.mu (cons (hd (tl (hd (tl (hd V1039))))) (tl (tl (hd V1039))))) (tl V1039)) (hd (tl (tl (hd (tl (hd V1039)))))))) ((and (cons? V1039) (and (cons? (hd V1039)) (and (= shen.mu (hd (hd V1039))) (and (cons? (tl (hd V1039))) (and (cons? (tl (tl (hd V1039)))) (and (= () (tl (tl (tl (hd V1039))))) (and (cons? (tl V1039)) (and (= () (tl (tl V1039))) (= _ (hd (tl (hd V1039)))))))))))) (shen.mu_reduction (hd (tl (tl (hd V1039)))) V1040)) ((and (cons? V1039) (and (cons? (hd V1039)) (and (= shen.mu (hd (hd V1039))) (and (cons? (tl (hd V1039))) (and (cons? (tl (tl (hd V1039)))) (and (= () (tl (tl (tl (hd V1039))))) (and (cons? (tl V1039)) (and (= () (tl (tl V1039))) (shen.ephemeral_variable? (hd (tl (hd V1039))) (hd (tl V1039))))))))))) (subst (hd (tl V1039)) (hd (tl (hd V1039))) (shen.mu_reduction (hd (tl (tl (hd V1039)))) V1040))) ((and (cons? V1039) (and (cons? (hd V1039)) (and (= shen.mu (hd (hd V1039))) (and (cons? (tl (hd V1039))) (and (cons? (tl (tl (hd V1039)))) (and (= () (tl (tl (tl (hd V1039))))) (and (cons? (tl V1039)) (and (= () (tl (tl V1039))) (variable? (hd (tl (hd V1039)))))))))))) (cons let (cons (hd (tl (hd V1039))) (cons shen.be (cons (hd (tl V1039)) (cons in (cons (shen.mu_reduction (hd (tl (tl (hd V1039)))) V1040) ()))))))) ((and (cons? V1039) (and (cons? (hd V1039)) (and (= shen.mu (hd (hd V1039))) (and (cons? (tl (hd V1039))) (and (cons? (tl (tl (hd V1039)))) (and (= () (tl (tl (tl (hd V1039))))) (and (cons? (tl V1039)) (and (= () (tl (tl V1039))) (and (= - V1040) (shen.prolog_constant? (hd (tl (hd V1039))))))))))))) (let Z (gensym V) (cons let (cons Z (cons shen.be (cons (cons shen.the (cons shen.result (cons shen.of (cons shen.dereferencing (tl V1039))))) (cons in (cons (cons if (cons (cons Z (cons is (cons identical (cons shen.to (cons (hd (tl (hd V1039))) ()))))) (cons shen.then (cons (shen.mu_reduction (hd (tl (tl (hd V1039)))) -) (cons shen.else (cons shen.failed! ())))))) ())))))))) ((and (cons? V1039) (and (cons? (hd V1039)) (and (= shen.mu (hd (hd V1039))) (and (cons? (tl (hd V1039))) (and (cons? (tl (tl (hd V1039)))) (and (= () (tl (tl (tl (hd V1039))))) (and (cons? (tl V1039)) (and (= () (tl (tl V1039))) (and (= + V1040) (shen.prolog_constant? (hd (tl (hd V1039))))))))))))) (let Z (gensym V) (cons let (cons Z (cons shen.be (cons (cons shen.the (cons shen.result (cons shen.of (cons shen.dereferencing (tl V1039))))) (cons in (cons (cons if (cons (cons Z (cons is (cons identical (cons shen.to (cons (hd (tl (hd V1039))) ()))))) (cons shen.then (cons (shen.mu_reduction (hd (tl (tl (hd V1039)))) +) (cons shen.else (cons (cons if (cons (cons Z (cons is (cons shen.a (cons shen.variable ())))) (cons shen.then (cons (cons bind (cons Z (cons shen.to (cons (hd (tl (hd V1039))) (cons in (cons (shen.mu_reduction (hd (tl (tl (hd V1039)))) +) ())))))) (cons shen.else (cons shen.failed! ())))))) ())))))) ())))))))) ((and (cons? V1039) (and (cons? (hd V1039)) (and (= shen.mu (hd (hd V1039))) (and (cons? (tl (hd V1039))) (and (cons? (hd (tl (hd V1039)))) (and (cons? (tl (tl (hd V1039)))) (and (= () (tl (tl (tl (hd V1039))))) (and (cons? (tl V1039)) (and (= () (tl (tl V1039))) (= - V1040)))))))))) (let Z (gensym V) (cons let (cons Z (cons shen.be (cons (cons shen.the (cons shen.result (cons shen.of (cons shen.dereferencing (tl V1039))))) (cons in (cons (cons if (cons (cons Z (cons is (cons shen.a (cons shen.non-empty (cons list ()))))) (cons shen.then (cons (shen.mu_reduction (cons (cons shen.mu (cons (hd (hd (tl (hd V1039)))) (cons (cons (cons shen.mu (cons (tl (hd (tl (hd V1039)))) (tl (tl (hd V1039))))) (cons (cons shen.the (cons tail (cons shen.of (cons Z ())))) ())) ()))) (cons (cons shen.the (cons head (cons shen.of (cons Z ())))) ())) -) (cons shen.else (cons shen.failed! ())))))) ())))))))) ((and (cons? V1039) (and (cons? (hd V1039)) (and (= shen.mu (hd (hd V1039))) (and (cons? (tl (hd V1039))) (and (cons? (hd (tl (hd V1039)))) (and (cons? (tl (tl (hd V1039)))) (and (= () (tl (tl (tl (hd V1039))))) (and (cons? (tl V1039)) (and (= () (tl (tl V1039))) (= + V1040)))))))))) (let Z (gensym V) (cons let (cons Z (cons shen.be (cons (cons shen.the (cons shen.result (cons shen.of (cons shen.dereferencing (tl V1039))))) (cons in (cons (cons if (cons (cons Z (cons is (cons shen.a (cons shen.non-empty (cons list ()))))) (cons shen.then (cons (shen.mu_reduction (cons (cons shen.mu (cons (hd (hd (tl (hd V1039)))) (cons (cons (cons shen.mu (cons (tl (hd (tl (hd V1039)))) (tl (tl (hd V1039))))) (cons (cons shen.the (cons tail (cons shen.of (cons Z ())))) ())) ()))) (cons (cons shen.the (cons head (cons shen.of (cons Z ())))) ())) +) (cons shen.else (cons (cons if (cons (cons Z (cons is (cons shen.a (cons shen.variable ())))) (cons shen.then (cons (cons shen.rename (cons shen.the (cons shen.variables (cons in (cons (shen.extract_vars (hd (tl (hd V1039)))) (cons and (cons shen.then (cons (cons bind (cons Z (cons shen.to (cons (shen.rcons_form (shen.remove_modes (hd (tl (hd V1039))))) (cons in (cons (shen.mu_reduction (hd (tl (tl (hd V1039)))) +) ())))))) ())))))))) (cons shen.else (cons shen.failed! ())))))) ())))))) ())))))))) (true V1039))) -(defun shen.rcons_form (V2203) (cond ((cons? V2203) (cons cons (cons (shen.rcons_form (hd V2203)) (cons (shen.rcons_form (tl V2203)) ())))) (true V2203))) +(defun shen.rcons_form (V1042) (cond ((cons? V1042) (cons cons (cons (shen.rcons_form (hd V1042)) (cons (shen.rcons_form (tl V1042)) ())))) (true V1042))) -(defun shen.remove_modes (V2205) (cond ((and (cons? V2205) (and (= mode (hd V2205)) (and (cons? (tl V2205)) (and (cons? (tl (tl V2205))) (and (= + (hd (tl (tl V2205)))) (= () (tl (tl (tl V2205))))))))) (shen.remove_modes (hd (tl V2205)))) ((and (cons? V2205) (and (= mode (hd V2205)) (and (cons? (tl V2205)) (and (cons? (tl (tl V2205))) (and (= - (hd (tl (tl V2205)))) (= () (tl (tl (tl V2205))))))))) (shen.remove_modes (hd (tl V2205)))) ((cons? V2205) (cons (shen.remove_modes (hd V2205)) (shen.remove_modes (tl V2205)))) (true V2205))) +(defun shen.remove_modes (V1044) (cond ((and (cons? V1044) (and (= mode (hd V1044)) (and (cons? (tl V1044)) (and (cons? (tl (tl V1044))) (and (= + (hd (tl (tl V1044)))) (= () (tl (tl (tl V1044))))))))) (shen.remove_modes (hd (tl V1044)))) ((and (cons? V1044) (and (= mode (hd V1044)) (and (cons? (tl V1044)) (and (cons? (tl (tl V1044))) (and (= - (hd (tl (tl V1044)))) (= () (tl (tl (tl V1044))))))))) (shen.remove_modes (hd (tl V1044)))) ((cons? V1044) (cons (shen.remove_modes (hd V1044)) (shen.remove_modes (tl V1044)))) (true V1044))) -(defun shen.ephemeral_variable? (V2208 V2209) (and (variable? V2208) (variable? V2209))) +(defun shen.ephemeral_variable? (V1047 V1048) (and (variable? V1047) (variable? V1048))) -(defun shen.prolog_constant? (V2219) (cond ((cons? V2219) false) (true true))) +(defun shen.prolog_constant? (V1058) (cond ((cons? V1058) false) (true true))) -(defun shen.aum_to_shen (V2221) (cond ((and (cons? V2221) (and (= let (hd V2221)) (and (cons? (tl V2221)) (and (cons? (tl (tl V2221))) (and (= shen.be (hd (tl (tl V2221)))) (and (cons? (tl (tl (tl V2221)))) (and (cons? (tl (tl (tl (tl V2221))))) (and (= in (hd (tl (tl (tl (tl V2221)))))) (and (cons? (tl (tl (tl (tl (tl V2221)))))) (= () (tl (tl (tl (tl (tl (tl V2221)))))))))))))))) (cons let (cons (hd (tl V2221)) (cons (shen.aum_to_shen (hd (tl (tl (tl V2221))))) (cons (shen.aum_to_shen (hd (tl (tl (tl (tl (tl V2221))))))) ()))))) ((and (cons? V2221) (and (= shen.the (hd V2221)) (and (cons? (tl V2221)) (and (= shen.result (hd (tl V2221))) (and (cons? (tl (tl V2221))) (and (= shen.of (hd (tl (tl V2221)))) (and (cons? (tl (tl (tl V2221)))) (and (= shen.dereferencing (hd (tl (tl (tl V2221))))) (and (cons? (tl (tl (tl (tl V2221))))) (= () (tl (tl (tl (tl (tl V2221))))))))))))))) (cons shen.lazyderef (cons (shen.aum_to_shen (hd (tl (tl (tl (tl V2221)))))) (cons ProcessN ())))) ((and (cons? V2221) (and (= if (hd V2221)) (and (cons? (tl V2221)) (and (cons? (tl (tl V2221))) (and (= shen.then (hd (tl (tl V2221)))) (and (cons? (tl (tl (tl V2221)))) (and (cons? (tl (tl (tl (tl V2221))))) (and (= shen.else (hd (tl (tl (tl (tl V2221)))))) (and (cons? (tl (tl (tl (tl (tl V2221)))))) (= () (tl (tl (tl (tl (tl (tl V2221)))))))))))))))) (cons if (cons (shen.aum_to_shen (hd (tl V2221))) (cons (shen.aum_to_shen (hd (tl (tl (tl V2221))))) (cons (shen.aum_to_shen (hd (tl (tl (tl (tl (tl V2221))))))) ()))))) ((and (cons? V2221) (and (cons? (tl V2221)) (and (= is (hd (tl V2221))) (and (cons? (tl (tl V2221))) (and (= shen.a (hd (tl (tl V2221)))) (and (cons? (tl (tl (tl V2221)))) (and (= shen.variable (hd (tl (tl (tl V2221))))) (= () (tl (tl (tl (tl V2221)))))))))))) (cons shen.pvar? (cons (hd V2221) ()))) ((and (cons? V2221) (and (cons? (tl V2221)) (and (= is (hd (tl V2221))) (and (cons? (tl (tl V2221))) (and (= shen.a (hd (tl (tl V2221)))) (and (cons? (tl (tl (tl V2221)))) (and (= shen.non-empty (hd (tl (tl (tl V2221))))) (and (cons? (tl (tl (tl (tl V2221))))) (and (= list (hd (tl (tl (tl (tl V2221)))))) (= () (tl (tl (tl (tl (tl V2221))))))))))))))) (cons cons? (cons (hd V2221) ()))) ((and (cons? V2221) (and (= shen.rename (hd V2221)) (and (cons? (tl V2221)) (and (= shen.the (hd (tl V2221))) (and (cons? (tl (tl V2221))) (and (= shen.variables (hd (tl (tl V2221)))) (and (cons? (tl (tl (tl V2221)))) (and (= in (hd (tl (tl (tl V2221))))) (and (cons? (tl (tl (tl (tl V2221))))) (and (= () (hd (tl (tl (tl (tl V2221)))))) (and (cons? (tl (tl (tl (tl (tl V2221)))))) (and (= and (hd (tl (tl (tl (tl (tl V2221))))))) (and (cons? (tl (tl (tl (tl (tl (tl V2221))))))) (and (= shen.then (hd (tl (tl (tl (tl (tl (tl V2221)))))))) (and (cons? (tl (tl (tl (tl (tl (tl (tl V2221)))))))) (= () (tl (tl (tl (tl (tl (tl (tl (tl V2221)))))))))))))))))))))))) (shen.aum_to_shen (hd (tl (tl (tl (tl (tl (tl (tl V2221)))))))))) ((and (cons? V2221) (and (= shen.rename (hd V2221)) (and (cons? (tl V2221)) (and (= shen.the (hd (tl V2221))) (and (cons? (tl (tl V2221))) (and (= shen.variables (hd (tl (tl V2221)))) (and (cons? (tl (tl (tl V2221)))) (and (= in (hd (tl (tl (tl V2221))))) (and (cons? (tl (tl (tl (tl V2221))))) (and (cons? (hd (tl (tl (tl (tl V2221)))))) (and (cons? (tl (tl (tl (tl (tl V2221)))))) (and (= and (hd (tl (tl (tl (tl (tl V2221))))))) (and (cons? (tl (tl (tl (tl (tl (tl V2221))))))) (and (= shen.then (hd (tl (tl (tl (tl (tl (tl V2221)))))))) (and (cons? (tl (tl (tl (tl (tl (tl (tl V2221)))))))) (= () (tl (tl (tl (tl (tl (tl (tl (tl V2221)))))))))))))))))))))))) (cons let (cons (hd (hd (tl (tl (tl (tl V2221)))))) (cons (cons shen.newpv (cons ProcessN ())) (cons (shen.aum_to_shen (cons shen.rename (cons shen.the (cons shen.variables (cons in (cons (tl (hd (tl (tl (tl (tl V2221)))))) (tl (tl (tl (tl (tl V2221))))))))))) ()))))) ((and (cons? V2221) (and (= bind (hd V2221)) (and (cons? (tl V2221)) (and (cons? (tl (tl V2221))) (and (= shen.to (hd (tl (tl V2221)))) (and (cons? (tl (tl (tl V2221)))) (and (cons? (tl (tl (tl (tl V2221))))) (and (= in (hd (tl (tl (tl (tl V2221)))))) (and (cons? (tl (tl (tl (tl (tl V2221)))))) (= () (tl (tl (tl (tl (tl (tl V2221)))))))))))))))) (cons do (cons (cons shen.bindv (cons (hd (tl V2221)) (cons (shen.chwild (hd (tl (tl (tl V2221))))) (cons ProcessN ())))) (cons (cons let (cons Result (cons (shen.aum_to_shen (hd (tl (tl (tl (tl (tl V2221))))))) (cons (cons do (cons (cons shen.unbindv (cons (hd (tl V2221)) (cons ProcessN ()))) (cons Result ()))) ())))) ())))) ((and (cons? V2221) (and (cons? (tl V2221)) (and (= is (hd (tl V2221))) (and (cons? (tl (tl V2221))) (and (= identical (hd (tl (tl V2221)))) (and (cons? (tl (tl (tl V2221)))) (and (= shen.to (hd (tl (tl (tl V2221))))) (and (cons? (tl (tl (tl (tl V2221))))) (= () (tl (tl (tl (tl (tl V2221)))))))))))))) (cons = (cons (hd (tl (tl (tl (tl V2221))))) (cons (hd V2221) ())))) ((= shen.failed! V2221) false) ((and (cons? V2221) (and (= shen.the (hd V2221)) (and (cons? (tl V2221)) (and (= head (hd (tl V2221))) (and (cons? (tl (tl V2221))) (and (= shen.of (hd (tl (tl V2221)))) (and (cons? (tl (tl (tl V2221)))) (= () (tl (tl (tl (tl V2221)))))))))))) (cons hd (tl (tl (tl V2221))))) ((and (cons? V2221) (and (= shen.the (hd V2221)) (and (cons? (tl V2221)) (and (= tail (hd (tl V2221))) (and (cons? (tl (tl V2221))) (and (= shen.of (hd (tl (tl V2221)))) (and (cons? (tl (tl (tl V2221)))) (= () (tl (tl (tl (tl V2221)))))))))))) (cons tl (tl (tl (tl V2221))))) ((and (cons? V2221) (and (= shen.pop (hd V2221)) (and (cons? (tl V2221)) (and (= shen.the (hd (tl V2221))) (and (cons? (tl (tl V2221))) (and (= shen.stack (hd (tl (tl V2221)))) (= () (tl (tl (tl V2221)))))))))) (cons do (cons (cons shen.incinfs ()) (cons (cons thaw (cons Continuation ())) ())))) ((and (cons? V2221) (and (= call (hd V2221)) (and (cons? (tl V2221)) (and (= shen.the (hd (tl V2221))) (and (cons? (tl (tl V2221))) (and (= shen.continuation (hd (tl (tl V2221)))) (and (cons? (tl (tl (tl V2221)))) (= () (tl (tl (tl (tl V2221)))))))))))) (cons do (cons (cons shen.incinfs ()) (cons (shen.call_the_continuation (shen.chwild (hd (tl (tl (tl V2221))))) ProcessN Continuation) ())))) (true V2221))) +(defun shen.aum_to_shen (V1060) (cond ((and (cons? V1060) (and (= let (hd V1060)) (and (cons? (tl V1060)) (and (cons? (tl (tl V1060))) (and (= shen.be (hd (tl (tl V1060)))) (and (cons? (tl (tl (tl V1060)))) (and (cons? (tl (tl (tl (tl V1060))))) (and (= in (hd (tl (tl (tl (tl V1060)))))) (and (cons? (tl (tl (tl (tl (tl V1060)))))) (= () (tl (tl (tl (tl (tl (tl V1060)))))))))))))))) (cons let (cons (hd (tl V1060)) (cons (shen.aum_to_shen (hd (tl (tl (tl V1060))))) (cons (shen.aum_to_shen (hd (tl (tl (tl (tl (tl V1060))))))) ()))))) ((and (cons? V1060) (and (= shen.the (hd V1060)) (and (cons? (tl V1060)) (and (= shen.result (hd (tl V1060))) (and (cons? (tl (tl V1060))) (and (= shen.of (hd (tl (tl V1060)))) (and (cons? (tl (tl (tl V1060)))) (and (= shen.dereferencing (hd (tl (tl (tl V1060))))) (and (cons? (tl (tl (tl (tl V1060))))) (= () (tl (tl (tl (tl (tl V1060))))))))))))))) (cons shen.lazyderef (cons (shen.aum_to_shen (hd (tl (tl (tl (tl V1060)))))) (cons ProcessN ())))) ((and (cons? V1060) (and (= if (hd V1060)) (and (cons? (tl V1060)) (and (cons? (tl (tl V1060))) (and (= shen.then (hd (tl (tl V1060)))) (and (cons? (tl (tl (tl V1060)))) (and (cons? (tl (tl (tl (tl V1060))))) (and (= shen.else (hd (tl (tl (tl (tl V1060)))))) (and (cons? (tl (tl (tl (tl (tl V1060)))))) (= () (tl (tl (tl (tl (tl (tl V1060)))))))))))))))) (cons if (cons (shen.aum_to_shen (hd (tl V1060))) (cons (shen.aum_to_shen (hd (tl (tl (tl V1060))))) (cons (shen.aum_to_shen (hd (tl (tl (tl (tl (tl V1060))))))) ()))))) ((and (cons? V1060) (and (cons? (tl V1060)) (and (= is (hd (tl V1060))) (and (cons? (tl (tl V1060))) (and (= shen.a (hd (tl (tl V1060)))) (and (cons? (tl (tl (tl V1060)))) (and (= shen.variable (hd (tl (tl (tl V1060))))) (= () (tl (tl (tl (tl V1060)))))))))))) (cons shen.pvar? (cons (hd V1060) ()))) ((and (cons? V1060) (and (cons? (tl V1060)) (and (= is (hd (tl V1060))) (and (cons? (tl (tl V1060))) (and (= shen.a (hd (tl (tl V1060)))) (and (cons? (tl (tl (tl V1060)))) (and (= shen.non-empty (hd (tl (tl (tl V1060))))) (and (cons? (tl (tl (tl (tl V1060))))) (and (= list (hd (tl (tl (tl (tl V1060)))))) (= () (tl (tl (tl (tl (tl V1060))))))))))))))) (cons cons? (cons (hd V1060) ()))) ((and (cons? V1060) (and (= shen.rename (hd V1060)) (and (cons? (tl V1060)) (and (= shen.the (hd (tl V1060))) (and (cons? (tl (tl V1060))) (and (= shen.variables (hd (tl (tl V1060)))) (and (cons? (tl (tl (tl V1060)))) (and (= in (hd (tl (tl (tl V1060))))) (and (cons? (tl (tl (tl (tl V1060))))) (and (= () (hd (tl (tl (tl (tl V1060)))))) (and (cons? (tl (tl (tl (tl (tl V1060)))))) (and (= and (hd (tl (tl (tl (tl (tl V1060))))))) (and (cons? (tl (tl (tl (tl (tl (tl V1060))))))) (and (= shen.then (hd (tl (tl (tl (tl (tl (tl V1060)))))))) (and (cons? (tl (tl (tl (tl (tl (tl (tl V1060)))))))) (= () (tl (tl (tl (tl (tl (tl (tl (tl V1060)))))))))))))))))))))))) (shen.aum_to_shen (hd (tl (tl (tl (tl (tl (tl (tl V1060)))))))))) ((and (cons? V1060) (and (= shen.rename (hd V1060)) (and (cons? (tl V1060)) (and (= shen.the (hd (tl V1060))) (and (cons? (tl (tl V1060))) (and (= shen.variables (hd (tl (tl V1060)))) (and (cons? (tl (tl (tl V1060)))) (and (= in (hd (tl (tl (tl V1060))))) (and (cons? (tl (tl (tl (tl V1060))))) (and (cons? (hd (tl (tl (tl (tl V1060)))))) (and (cons? (tl (tl (tl (tl (tl V1060)))))) (and (= and (hd (tl (tl (tl (tl (tl V1060))))))) (and (cons? (tl (tl (tl (tl (tl (tl V1060))))))) (and (= shen.then (hd (tl (tl (tl (tl (tl (tl V1060)))))))) (and (cons? (tl (tl (tl (tl (tl (tl (tl V1060)))))))) (= () (tl (tl (tl (tl (tl (tl (tl (tl V1060)))))))))))))))))))))))) (cons let (cons (hd (hd (tl (tl (tl (tl V1060)))))) (cons (cons shen.newpv (cons ProcessN ())) (cons (shen.aum_to_shen (cons shen.rename (cons shen.the (cons shen.variables (cons in (cons (tl (hd (tl (tl (tl (tl V1060)))))) (tl (tl (tl (tl (tl V1060))))))))))) ()))))) ((and (cons? V1060) (and (= bind (hd V1060)) (and (cons? (tl V1060)) (and (cons? (tl (tl V1060))) (and (= shen.to (hd (tl (tl V1060)))) (and (cons? (tl (tl (tl V1060)))) (and (cons? (tl (tl (tl (tl V1060))))) (and (= in (hd (tl (tl (tl (tl V1060)))))) (and (cons? (tl (tl (tl (tl (tl V1060)))))) (= () (tl (tl (tl (tl (tl (tl V1060)))))))))))))))) (cons do (cons (cons shen.bindv (cons (hd (tl V1060)) (cons (shen.chwild (hd (tl (tl (tl V1060))))) (cons ProcessN ())))) (cons (cons let (cons Result (cons (shen.aum_to_shen (hd (tl (tl (tl (tl (tl V1060))))))) (cons (cons do (cons (cons shen.unbindv (cons (hd (tl V1060)) (cons ProcessN ()))) (cons Result ()))) ())))) ())))) ((and (cons? V1060) (and (cons? (tl V1060)) (and (= is (hd (tl V1060))) (and (cons? (tl (tl V1060))) (and (= identical (hd (tl (tl V1060)))) (and (cons? (tl (tl (tl V1060)))) (and (= shen.to (hd (tl (tl (tl V1060))))) (and (cons? (tl (tl (tl (tl V1060))))) (= () (tl (tl (tl (tl (tl V1060)))))))))))))) (cons = (cons (hd (tl (tl (tl (tl V1060))))) (cons (hd V1060) ())))) ((= shen.failed! V1060) false) ((and (cons? V1060) (and (= shen.the (hd V1060)) (and (cons? (tl V1060)) (and (= head (hd (tl V1060))) (and (cons? (tl (tl V1060))) (and (= shen.of (hd (tl (tl V1060)))) (and (cons? (tl (tl (tl V1060)))) (= () (tl (tl (tl (tl V1060)))))))))))) (cons hd (tl (tl (tl V1060))))) ((and (cons? V1060) (and (= shen.the (hd V1060)) (and (cons? (tl V1060)) (and (= tail (hd (tl V1060))) (and (cons? (tl (tl V1060))) (and (= shen.of (hd (tl (tl V1060)))) (and (cons? (tl (tl (tl V1060)))) (= () (tl (tl (tl (tl V1060)))))))))))) (cons tl (tl (tl (tl V1060))))) ((and (cons? V1060) (and (= shen.pop (hd V1060)) (and (cons? (tl V1060)) (and (= shen.the (hd (tl V1060))) (and (cons? (tl (tl V1060))) (and (= shen.stack (hd (tl (tl V1060)))) (= () (tl (tl (tl V1060)))))))))) (cons do (cons (cons shen.incinfs ()) (cons (cons thaw (cons Continuation ())) ())))) ((and (cons? V1060) (and (= call (hd V1060)) (and (cons? (tl V1060)) (and (= shen.the (hd (tl V1060))) (and (cons? (tl (tl V1060))) (and (= shen.continuation (hd (tl (tl V1060)))) (and (cons? (tl (tl (tl V1060)))) (= () (tl (tl (tl (tl V1060)))))))))))) (cons do (cons (cons shen.incinfs ()) (cons (shen.call_the_continuation (shen.chwild (hd (tl (tl (tl V1060))))) ProcessN Continuation) ())))) (true V1060))) -(defun shen.chwild (V2223) (cond ((= V2223 _) (cons shen.newpv (cons ProcessN ()))) ((cons? V2223) (map (lambda Z (shen.chwild Z)) V2223)) (true V2223))) +(defun shen.chwild (V1062) (cond ((= V1062 _) (cons shen.newpv (cons ProcessN ()))) ((cons? V1062) (map (lambda Z (shen.chwild Z)) V1062)) (true V1062))) -(defun shen.newpv (V2225) (let Count+1 (+ (<-address (value shen.*varcounter*) V2225) 1) (let IncVar (address-> (value shen.*varcounter*) V2225 Count+1) (let Vector (<-address (value shen.*prologvectors*) V2225) (let ResizeVectorIfNeeded (if (= Count+1 (limit Vector)) (shen.resizeprocessvector V2225 Count+1) shen.skip) (shen.mk-pvar Count+1)))))) +(defun shen.newpv (V1064) (let Count+1 (+ (<-address (value shen.*varcounter*) V1064) 1) (let IncVar (address-> (value shen.*varcounter*) V1064 Count+1) (let Vector (<-address (value shen.*prologvectors*) V1064) (let ResizeVectorIfNeeded (if (= Count+1 (limit Vector)) (shen.resizeprocessvector V1064 Count+1) shen.skip) (shen.mk-pvar Count+1)))))) -(defun shen.resizeprocessvector (V2228 V2229) (let Vector (<-address (value shen.*prologvectors*) V2228) (let BigVector (shen.resize-vector Vector (+ V2229 V2229) shen.-null-) (address-> (value shen.*prologvectors*) V2228 BigVector)))) +(defun shen.resizeprocessvector (V1067 V1068) (let Vector (<-address (value shen.*prologvectors*) V1067) (let BigVector (shen.resize-vector Vector (+ V1068 V1068) shen.-null-) (address-> (value shen.*prologvectors*) V1067 BigVector)))) -(defun shen.resize-vector (V2233 V2234 V2235) (let BigVector (address-> (absvector (+ 1 V2234)) 0 V2234) (shen.copy-vector V2233 BigVector (limit V2233) V2234 V2235))) +(defun shen.resize-vector (V1072 V1073 V1074) (let BigVector (address-> (absvector (+ 1 V1073)) 0 V1073) (shen.copy-vector V1072 BigVector (limit V1072) V1073 V1074))) -(defun shen.copy-vector (V2241 V2242 V2243 V2244 V2245) (shen.copy-vector-stage-2 (+ 1 V2243) (+ V2244 1) V2245 (shen.copy-vector-stage-1 1 V2241 V2242 (+ 1 V2243)))) +(defun shen.copy-vector (V1080 V1081 V1082 V1083 V1084) (shen.copy-vector-stage-2 (+ 1 V1082) (+ V1083 1) V1084 (shen.copy-vector-stage-1 1 V1080 V1081 (+ 1 V1082)))) -(defun shen.copy-vector-stage-1 (V2253 V2254 V2255 V2256) (cond ((= V2256 V2253) V2255) (true (shen.copy-vector-stage-1 (+ 1 V2253) V2254 (address-> V2255 V2253 (<-address V2254 V2253)) V2256)))) +(defun shen.copy-vector-stage-1 (V1092 V1093 V1094 V1095) (cond ((= V1095 V1092) V1094) (true (shen.copy-vector-stage-1 (+ 1 V1092) V1093 (address-> V1094 V1092 (<-address V1093 V1092)) V1095)))) -(defun shen.copy-vector-stage-2 (V2264 V2265 V2266 V2267) (cond ((= V2265 V2264) V2267) (true (shen.copy-vector-stage-2 (+ V2264 1) V2265 V2266 (address-> V2267 V2264 V2266))))) +(defun shen.copy-vector-stage-2 (V1103 V1104 V1105 V1106) (cond ((= V1104 V1103) V1106) (true (shen.copy-vector-stage-2 (+ V1103 1) V1104 V1105 (address-> V1106 V1103 V1105))))) -(defun shen.mk-pvar (V2269) (address-> (address-> (absvector 2) 0 shen.pvar) 1 V2269)) +(defun shen.mk-pvar (V1108) (address-> (address-> (absvector 2) 0 shen.pvar) 1 V1108)) -(defun shen.pvar? (V2271) (and (absvector? V2271) (= (trap-error (<-address V2271 0) (lambda E shen.not-pvar)) shen.pvar))) +(defun shen.pvar? (V1110) (and (absvector? V1110) (= (trap-error (<-address V1110 0) (lambda E shen.not-pvar)) shen.pvar))) -(defun shen.bindv (V2275 V2276 V2277) (let Vector (<-address (value shen.*prologvectors*) V2277) (address-> Vector (<-address V2275 1) V2276))) +(defun shen.bindv (V1114 V1115 V1116) (let Vector (<-address (value shen.*prologvectors*) V1116) (address-> Vector (<-address V1114 1) V1115))) -(defun shen.unbindv (V2280 V2281) (let Vector (<-address (value shen.*prologvectors*) V2281) (address-> Vector (<-address V2280 1) shen.-null-))) +(defun shen.unbindv (V1119 V1120) (let Vector (<-address (value shen.*prologvectors*) V1120) (address-> Vector (<-address V1119 1) shen.-null-))) (defun shen.incinfs () (set shen.*infs* (+ 1 (value shen.*infs*)))) -(defun shen.call_the_continuation (V2285 V2286 V2287) (cond ((and (cons? V2285) (and (cons? (hd V2285)) (= () (tl V2285)))) (cons (hd (hd V2285)) (append (tl (hd V2285)) (cons V2286 (cons V2287 ()))))) ((and (cons? V2285) (cons? (hd V2285))) (let NewContinuation (shen.newcontinuation (tl V2285) V2286 V2287) (cons (hd (hd V2285)) (append (tl (hd V2285)) (cons V2286 (cons NewContinuation ())))))) (true (shen.f_error shen.call_the_continuation)))) +(defun shen.call_the_continuation (V1124 V1125 V1126) (cond ((and (cons? V1124) (and (cons? (hd V1124)) (= () (tl V1124)))) (cons (hd (hd V1124)) (append (tl (hd V1124)) (cons V1125 (cons V1126 ()))))) ((and (cons? V1124) (cons? (hd V1124))) (let NewContinuation (shen.newcontinuation (tl V1124) V1125 V1126) (cons (hd (hd V1124)) (append (tl (hd V1124)) (cons V1125 (cons NewContinuation ())))))) (true (shen.f_error shen.call_the_continuation)))) -(defun shen.newcontinuation (V2291 V2292 V2293) (cond ((= () V2291) V2293) ((and (cons? V2291) (cons? (hd V2291))) (cons freeze (cons (cons (hd (hd V2291)) (append (tl (hd V2291)) (cons V2292 (cons (shen.newcontinuation (tl V2291) V2292 V2293) ())))) ()))) (true (shen.f_error shen.newcontinuation)))) +(defun shen.newcontinuation (V1130 V1131 V1132) (cond ((= () V1130) V1132) ((and (cons? V1130) (cons? (hd V1130))) (cons freeze (cons (cons (hd (hd V1130)) (append (tl (hd V1130)) (cons V1131 (cons (shen.newcontinuation (tl V1130) V1131 V1132) ())))) ()))) (true (shen.f_error shen.newcontinuation)))) -(defun return (V2301 V2302 V2303) (shen.deref V2301 V2302)) +(defun return (V1140 V1141 V1142) (shen.deref V1140 V1141)) -(defun shen.measure&return (V2311 V2312 V2313) (do (shen.prhush (shen.app (value shen.*infs*) " inferences -" shen.a) (stoutput)) (shen.deref V2311 V2312))) +(defun shen.measure&return (V1150 V1151 V1152) (do (shen.prhush (shen.app (value shen.*infs*) " inferences +" shen.a) (stoutput)) (shen.deref V1150 V1151))) -(defun unify (V2318 V2319 V2320 V2321) (shen.lzy= (shen.lazyderef V2318 V2320) (shen.lazyderef V2319 V2320) V2320 V2321)) +(defun unify (V1157 V1158 V1159 V1160) (shen.lzy= (shen.lazyderef V1157 V1159) (shen.lazyderef V1158 V1159) V1159 V1160)) -(defun shen.lzy= (V2343 V2344 V2345 V2346) (cond ((= V2344 V2343) (thaw V2346)) ((shen.pvar? V2343) (bind V2343 V2344 V2345 V2346)) ((shen.pvar? V2344) (bind V2344 V2343 V2345 V2346)) ((and (cons? V2343) (cons? V2344)) (shen.lzy= (shen.lazyderef (hd V2343) V2345) (shen.lazyderef (hd V2344) V2345) V2345 (freeze (shen.lzy= (shen.lazyderef (tl V2343) V2345) (shen.lazyderef (tl V2344) V2345) V2345 V2346)))) (true false))) +(defun shen.lzy= (V1182 V1183 V1184 V1185) (cond ((= V1183 V1182) (thaw V1185)) ((shen.pvar? V1182) (bind V1182 V1183 V1184 V1185)) ((shen.pvar? V1183) (bind V1183 V1182 V1184 V1185)) ((and (cons? V1182) (cons? V1183)) (shen.lzy= (shen.lazyderef (hd V1182) V1184) (shen.lazyderef (hd V1183) V1184) V1184 (freeze (shen.lzy= (shen.lazyderef (tl V1182) V1184) (shen.lazyderef (tl V1183) V1184) V1184 V1185)))) (true false))) -(defun shen.deref (V2349 V2350) (cond ((cons? V2349) (cons (shen.deref (hd V2349) V2350) (shen.deref (tl V2349) V2350))) (true (if (shen.pvar? V2349) (let Value (shen.valvector V2349 V2350) (if (= Value shen.-null-) V2349 (shen.deref Value V2350))) V2349)))) +(defun shen.deref (V1188 V1189) (cond ((cons? V1188) (cons (shen.deref (hd V1188) V1189) (shen.deref (tl V1188) V1189))) (true (if (shen.pvar? V1188) (let Value (shen.valvector V1188 V1189) (if (= Value shen.-null-) V1188 (shen.deref Value V1189))) V1188)))) -(defun shen.lazyderef (V2353 V2354) (if (shen.pvar? V2353) (let Value (shen.valvector V2353 V2354) (if (= Value shen.-null-) V2353 (shen.lazyderef Value V2354))) V2353)) +(defun shen.lazyderef (V1192 V1193) (if (shen.pvar? V1192) (let Value (shen.valvector V1192 V1193) (if (= Value shen.-null-) V1192 (shen.lazyderef Value V1193))) V1192)) -(defun shen.valvector (V2357 V2358) (<-address (<-address (value shen.*prologvectors*) V2358) (<-address V2357 1))) +(defun shen.valvector (V1196 V1197) (<-address (<-address (value shen.*prologvectors*) V1197) (<-address V1196 1))) -(defun unify! (V2363 V2364 V2365 V2366) (shen.lzy=! (shen.lazyderef V2363 V2365) (shen.lazyderef V2364 V2365) V2365 V2366)) +(defun unify! (V1202 V1203 V1204 V1205) (shen.lzy=! (shen.lazyderef V1202 V1204) (shen.lazyderef V1203 V1204) V1204 V1205)) -(defun shen.lzy=! (V2388 V2389 V2390 V2391) (cond ((= V2389 V2388) (thaw V2391)) ((and (shen.pvar? V2388) (not (shen.occurs? V2388 (shen.deref V2389 V2390)))) (bind V2388 V2389 V2390 V2391)) ((and (shen.pvar? V2389) (not (shen.occurs? V2389 (shen.deref V2388 V2390)))) (bind V2389 V2388 V2390 V2391)) ((and (cons? V2388) (cons? V2389)) (shen.lzy=! (shen.lazyderef (hd V2388) V2390) (shen.lazyderef (hd V2389) V2390) V2390 (freeze (shen.lzy=! (shen.lazyderef (tl V2388) V2390) (shen.lazyderef (tl V2389) V2390) V2390 V2391)))) (true false))) +(defun shen.lzy=! (V1227 V1228 V1229 V1230) (cond ((= V1228 V1227) (thaw V1230)) ((and (shen.pvar? V1227) (not (shen.occurs? V1227 (shen.deref V1228 V1229)))) (bind V1227 V1228 V1229 V1230)) ((and (shen.pvar? V1228) (not (shen.occurs? V1228 (shen.deref V1227 V1229)))) (bind V1228 V1227 V1229 V1230)) ((and (cons? V1227) (cons? V1228)) (shen.lzy=! (shen.lazyderef (hd V1227) V1229) (shen.lazyderef (hd V1228) V1229) V1229 (freeze (shen.lzy=! (shen.lazyderef (tl V1227) V1229) (shen.lazyderef (tl V1228) V1229) V1229 V1230)))) (true false))) -(defun shen.occurs? (V2403 V2404) (cond ((= V2404 V2403) true) ((cons? V2404) (or (shen.occurs? V2403 (hd V2404)) (shen.occurs? V2403 (tl V2404)))) (true false))) +(defun shen.occurs? (V1242 V1243) (cond ((= V1243 V1242) true) ((cons? V1243) (or (shen.occurs? V1242 (hd V1243)) (shen.occurs? V1242 (tl V1243)))) (true false))) -(defun identical (V2409 V2410 V2411 V2412) (shen.lzy== (shen.lazyderef V2409 V2411) (shen.lazyderef V2410 V2411) V2411 V2412)) +(defun identical (V1248 V1249 V1250 V1251) (shen.lzy== (shen.lazyderef V1248 V1250) (shen.lazyderef V1249 V1250) V1250 V1251)) -(defun shen.lzy== (V2434 V2435 V2436 V2437) (cond ((= V2435 V2434) (thaw V2437)) ((and (cons? V2434) (cons? V2435)) (shen.lzy== (shen.lazyderef (hd V2434) V2436) (shen.lazyderef (hd V2435) V2436) V2436 (freeze (shen.lzy== (tl V2434) (tl V2435) V2436 V2437)))) (true false))) +(defun shen.lzy== (V1273 V1274 V1275 V1276) (cond ((= V1274 V1273) (thaw V1276)) ((and (cons? V1273) (cons? V1274)) (shen.lzy== (shen.lazyderef (hd V1273) V1275) (shen.lazyderef (hd V1274) V1275) V1275 (freeze (shen.lzy== (tl V1273) (tl V1274) V1275 V1276)))) (true false))) -(defun shen.pvar (V2439) (cn "Var" (shen.app (<-address V2439 1) "" shen.a))) +(defun shen.pvar (V1278) (cn "Var" (shen.app (<-address V1278 1) "" shen.a))) -(defun bind (V2444 V2445 V2446 V2447) (do (shen.bindv V2444 V2445 V2446) (let Result (thaw V2447) (do (shen.unbindv V2444 V2446) Result)))) +(defun bind (V1283 V1284 V1285 V1286) (do (shen.bindv V1283 V1284 V1285) (let Result (thaw V1286) (do (shen.unbindv V1283 V1285) Result)))) -(defun fwhen (V2465 V2466 V2467) (cond ((= true V2465) (thaw V2467)) ((= false V2465) false) (true (simple-error (cn "fwhen expects a boolean: not " (shen.app V2465 "%" shen.s)))))) +(defun fwhen (V1304 V1305 V1306) (cond ((= true V1304) (thaw V1306)) ((= false V1304) false) (true (simple-error (cn "fwhen expects a boolean: not " (shen.app V1304 "%" shen.s)))))) -(defun call (V2483 V2484 V2485) (cond ((cons? V2483) (shen.call-help (function (shen.lazyderef (hd V2483) V2484)) (tl V2483) V2484 V2485)) ((shen.pvar? V2483) (call (shen.lazyderef V2483 V2484) V2484 V2485)) (true false))) +(defun call (V1322 V1323 V1324) (cond ((cons? V1322) (shen.call-help (function (shen.lazyderef (hd V1322) V1323)) (tl V1322) V1323 V1324)) ((shen.pvar? V1322) (call (shen.lazyderef V1322 V1323) V1323 V1324)) (true false))) -(defun shen.call-help (V2490 V2491 V2492 V2493) (cond ((= () V2491) (V2490 V2492 V2493)) ((cons? V2491) (shen.call-help (V2490 (hd V2491)) (tl V2491) V2492 V2493)) (true (shen.f_error shen.call-help)))) +(defun shen.call-help (V1329 V1330 V1331 V1332) (cond ((= () V1330) (V1329 V1331 V1332)) ((cons? V1330) (shen.call-help (V1329 (hd V1330)) (tl V1330) V1331 V1332)) (true (shen.f_error shen.call-help)))) -(defun shen.intprolog (V2495) (cond ((and (cons? V2495) (cons? (hd V2495))) (let ProcessN (shen.start-new-prolog-process) (shen.intprolog-help (hd (hd V2495)) (shen.insert-prolog-variables (cons (tl (hd V2495)) (cons (tl V2495) ())) ProcessN) ProcessN))) (true (shen.f_error shen.intprolog)))) +(defun shen.intprolog (V1334) (cond ((and (cons? V1334) (cons? (hd V1334))) (let ProcessN (shen.start-new-prolog-process) (shen.intprolog-help (hd (hd V1334)) (shen.insert-prolog-variables (cons (tl (hd V1334)) (cons (tl V1334) ())) ProcessN) ProcessN))) (true (shen.f_error shen.intprolog)))) -(defun shen.intprolog-help (V2499 V2500 V2501) (cond ((and (cons? V2500) (and (cons? (tl V2500)) (= () (tl (tl V2500))))) (shen.intprolog-help-help V2499 (hd V2500) (hd (tl V2500)) V2501)) (true (shen.f_error shen.intprolog-help)))) +(defun shen.intprolog-help (V1338 V1339 V1340) (cond ((and (cons? V1339) (and (cons? (tl V1339)) (= () (tl (tl V1339))))) (shen.intprolog-help-help V1338 (hd V1339) (hd (tl V1339)) V1340)) (true (shen.f_error shen.intprolog-help)))) -(defun shen.intprolog-help-help (V2506 V2507 V2508 V2509) (cond ((= () V2507) (V2506 V2509 (freeze (shen.call-rest V2508 V2509)))) ((cons? V2507) (shen.intprolog-help-help (V2506 (hd V2507)) (tl V2507) V2508 V2509)) (true (shen.f_error shen.intprolog-help-help)))) +(defun shen.intprolog-help-help (V1345 V1346 V1347 V1348) (cond ((= () V1346) (V1345 V1348 (freeze (shen.call-rest V1347 V1348)))) ((cons? V1346) (shen.intprolog-help-help (V1345 (hd V1346)) (tl V1346) V1347 V1348)) (true (shen.f_error shen.intprolog-help-help)))) -(defun shen.call-rest (V2514 V2515) (cond ((= () V2514) true) ((and (cons? V2514) (and (cons? (hd V2514)) (cons? (tl (hd V2514))))) (shen.call-rest (cons (cons ((hd (hd V2514)) (hd (tl (hd V2514)))) (tl (tl (hd V2514)))) (tl V2514)) V2515)) ((and (cons? V2514) (and (cons? (hd V2514)) (= () (tl (hd V2514))))) ((hd (hd V2514)) V2515 (freeze (shen.call-rest (tl V2514) V2515)))) (true (shen.f_error shen.call-rest)))) +(defun shen.call-rest (V1353 V1354) (cond ((= () V1353) true) ((and (cons? V1353) (and (cons? (hd V1353)) (cons? (tl (hd V1353))))) (shen.call-rest (cons (cons ((hd (hd V1353)) (hd (tl (hd V1353)))) (tl (tl (hd V1353)))) (tl V1353)) V1354)) ((and (cons? V1353) (and (cons? (hd V1353)) (= () (tl (hd V1353))))) ((hd (hd V1353)) V1354 (freeze (shen.call-rest (tl V1353) V1354)))) (true (shen.f_error shen.call-rest)))) (defun shen.start-new-prolog-process () (let IncrementProcessCounter (set shen.*process-counter* (+ 1 (value shen.*process-counter*))) (shen.initialise-prolog IncrementProcessCounter))) -(defun shen.insert-prolog-variables (V2518 V2519) (shen.insert-prolog-variables-help V2518 (shen.flatten V2518) V2519)) +(defun shen.insert-prolog-variables (V1357 V1358) (shen.insert-prolog-variables-help V1357 (shen.flatten V1357) V1358)) -(defun shen.insert-prolog-variables-help (V2527 V2528 V2529) (cond ((= () V2528) V2527) ((and (cons? V2528) (variable? (hd V2528))) (let V (shen.newpv V2529) (let XV/Y (subst V (hd V2528) V2527) (let Z-Y (remove (hd V2528) (tl V2528)) (shen.insert-prolog-variables-help XV/Y Z-Y V2529))))) ((cons? V2528) (shen.insert-prolog-variables-help V2527 (tl V2528) V2529)) (true (shen.f_error shen.insert-prolog-variables-help)))) +(defun shen.insert-prolog-variables-help (V1366 V1367 V1368) (cond ((= () V1367) V1366) ((and (cons? V1367) (variable? (hd V1367))) (let V (shen.newpv V1368) (let XV/Y (subst V (hd V1367) V1366) (let Z-Y (remove (hd V1367) (tl V1367)) (shen.insert-prolog-variables-help XV/Y Z-Y V1368))))) ((cons? V1367) (shen.insert-prolog-variables-help V1366 (tl V1367) V1368)) (true (shen.f_error shen.insert-prolog-variables-help)))) -(defun shen.initialise-prolog (V2531) (let Vector (address-> (value shen.*prologvectors*) V2531 (shen.fillvector (vector 10) 1 10 shen.-null-)) (let Counter (address-> (value shen.*varcounter*) V2531 1) V2531))) +(defun shen.initialise-prolog (V1370) (let Vector (address-> (value shen.*prologvectors*) V1370 (shen.fillvector (vector 10) 1 10 shen.-null-)) (let Counter (address-> (value shen.*varcounter*) V1370 1) V1370))) diff --git a/kl/reader.kl b/kl/reader.kl index d215f8b..5946ddc 100644 --- a/kl/reader.kl +++ b/kl/reader.kl @@ -28,186 +28,186 @@ OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. " -(defun shen.read-char-code (V2533) (read-byte V2533)) +(defun shen.read-char-code (V1372) (read-byte V1372)) -(defun read-file-as-bytelist (V2535) (shen.read-file-as-Xlist V2535 (lambda S (read-byte S)))) +(defun read-file-as-bytelist (V1374) (shen.read-file-as-Xlist V1374 (lambda S (read-byte S)))) -(defun shen.read-file-as-charlist (V2537) (shen.read-file-as-Xlist V2537 (lambda S (shen.read-char-code S)))) +(defun shen.read-file-as-charlist (V1376) (shen.read-file-as-Xlist V1376 (lambda S (shen.read-char-code S)))) -(defun shen.read-file-as-Xlist (V2540 V2541) (let Stream (open V2540 in) (let X (V2541 Stream) (let Xs (shen.read-file-as-Xlist-help Stream V2541 X ()) (let Close (close Stream) (reverse Xs)))))) +(defun shen.read-file-as-Xlist (V1379 V1380) (let Stream (open V1379 in) (let X (V1380 Stream) (let Xs (shen.read-file-as-Xlist-help Stream V1380 X ()) (let Close (close Stream) (reverse Xs)))))) -(defun shen.read-file-as-Xlist-help (V2546 V2547 V2548 V2549) (cond ((= -1 V2548) V2549) (true (shen.read-file-as-Xlist-help V2546 V2547 (V2547 V2546) (cons V2548 V2549))))) +(defun shen.read-file-as-Xlist-help (V1385 V1386 V1387 V1388) (cond ((= -1 V1387) V1388) (true (shen.read-file-as-Xlist-help V1385 V1386 (V1386 V1385) (cons V1387 V1388))))) -(defun read-file-as-string (V2551) (let Stream (open V2551 in) (shen.rfas-h Stream (shen.read-char-code Stream) ""))) +(defun read-file-as-string (V1390) (let Stream (open V1390 in) (shen.rfas-h Stream (shen.read-char-code Stream) ""))) -(defun shen.rfas-h (V2555 V2556 V2557) (cond ((= -1 V2556) (do (close V2555) V2557)) (true (shen.rfas-h V2555 (shen.read-char-code V2555) (cn V2557 (n->string V2556)))))) +(defun shen.rfas-h (V1394 V1395 V1396) (cond ((= -1 V1395) (do (close V1394) V1396)) (true (shen.rfas-h V1394 (shen.read-char-code V1394) (cn V1396 (n->string V1395)))))) -(defun input (V2559) (eval-kl (read V2559))) +(defun input (V1398) (eval-kl (read V1398))) -(defun input+ (V2562 V2563) (let Mono? (shen.monotype V2562) (let Input (read V2563) (if (= false (shen.typecheck Input (shen.demodulate V2562))) (simple-error (cn "type error: " (shen.app Input (cn " is not of type " (shen.app V2562 " +(defun input+ (V1401 V1402) (let Mono? (shen.monotype V1401) (let Input (read V1402) (if (= false (shen.typecheck Input (shen.demodulate V1401))) (simple-error (cn "type error: " (shen.app Input (cn " is not of type " (shen.app V1401 " " shen.r)) shen.r))) (eval-kl Input))))) -(defun shen.monotype (V2565) (cond ((cons? V2565) (map (lambda Z (shen.monotype Z)) V2565)) (true (if (variable? V2565) (simple-error (cn "input+ expects a monotype: not " (shen.app V2565 " -" shen.a))) V2565)))) +(defun shen.monotype (V1404) (cond ((cons? V1404) (map (lambda Z (shen.monotype Z)) V1404)) (true (if (variable? V1404) (simple-error (cn "input+ expects a monotype: not " (shen.app V1404 " +" shen.a))) V1404)))) -(defun read (V2567) (hd (shen.read-loop V2567 (shen.read-char-code V2567) ()))) +(defun read (V1406) (hd (shen.read-loop V1406 (shen.read-char-code V1406) ()))) (defun it () (value shen.*it*)) -(defun shen.read-loop (V2575 V2576 V2577) (cond ((= 94 V2576) (simple-error "read aborted")) ((= -1 V2576) (if (empty? V2577) (simple-error "error: empty stream") (compile (lambda X (shen. X)) V2577 (lambda E E)))) ((shen.terminator? V2576) (let AllChars (append V2577 (cons V2576 ())) (let It (shen.record-it AllChars) (let Read (compile (lambda X (shen. X)) AllChars (lambda E shen.nextbyte)) (if (or (= Read shen.nextbyte) (empty? Read)) (shen.read-loop V2575 (shen.read-char-code V2575) AllChars) Read))))) (true (shen.read-loop V2575 (shen.read-char-code V2575) (append V2577 (cons V2576 ())))))) +(defun shen.read-loop (V1414 V1415 V1416) (cond ((= 94 V1415) (simple-error "read aborted")) ((= -1 V1415) (if (empty? V1416) (simple-error "error: empty stream") (compile (lambda X (shen. X)) V1416 (lambda E E)))) ((shen.terminator? V1415) (let AllChars (append V1416 (cons V1415 ())) (let It (shen.record-it AllChars) (let Read (compile (lambda X (shen. X)) AllChars (lambda E shen.nextbyte)) (if (or (= Read shen.nextbyte) (empty? Read)) (shen.read-loop V1414 (shen.read-char-code V1414) AllChars) Read))))) (true (shen.read-loop V1414 (shen.read-char-code V1414) (append V1416 (cons V1415 ())))))) -(defun shen.terminator? (V2579) (element? V2579 (cons 9 (cons 10 (cons 13 (cons 32 (cons 34 (cons 41 (cons 93 ()))))))))) +(defun shen.terminator? (V1418) (element? V1418 (cons 9 (cons 10 (cons 13 (cons 32 (cons 34 (cons 41 (cons 93 ()))))))))) -(defun lineread (V2581) (shen.lineread-loop (shen.read-char-code V2581) () V2581)) +(defun lineread (V1420) (shen.lineread-loop (shen.read-char-code V1420) () V1420)) -(defun shen.lineread-loop (V2586 V2587 V2588) (cond ((= -1 V2586) (if (empty? V2587) (simple-error "empty stream") (compile (lambda X (shen. X)) V2587 (lambda E E)))) ((= V2586 (shen.hat)) (simple-error "line read aborted")) ((element? V2586 (cons (shen.newline) (cons (shen.carriage-return) ()))) (let Line (compile (lambda X (shen. X)) V2587 (lambda E shen.nextline)) (let It (shen.record-it V2587) (if (or (= Line shen.nextline) (empty? Line)) (shen.lineread-loop (shen.read-char-code V2588) (append V2587 (cons V2586 ())) V2588) Line)))) (true (shen.lineread-loop (shen.read-char-code V2588) (append V2587 (cons V2586 ())) V2588)))) +(defun shen.lineread-loop (V1425 V1426 V1427) (cond ((= -1 V1425) (if (empty? V1426) (simple-error "empty stream") (compile (lambda X (shen. X)) V1426 (lambda E E)))) ((= V1425 (shen.hat)) (simple-error "line read aborted")) ((element? V1425 (cons (shen.newline) (cons (shen.carriage-return) ()))) (let Line (compile (lambda X (shen. X)) V1426 (lambda E shen.nextline)) (let It (shen.record-it V1426) (if (or (= Line shen.nextline) (empty? Line)) (shen.lineread-loop (shen.read-char-code V1427) (append V1426 (cons V1425 ())) V1427) Line)))) (true (shen.lineread-loop (shen.read-char-code V1427) (append V1426 (cons V1425 ())) V1427)))) -(defun shen.record-it (V2590) (let TrimLeft (shen.trim-whitespace V2590) (let TrimRight (shen.trim-whitespace (reverse TrimLeft)) (let Trimmed (reverse TrimRight) (shen.record-it-h Trimmed))))) +(defun shen.record-it (V1429) (let TrimLeft (shen.trim-whitespace V1429) (let TrimRight (shen.trim-whitespace (reverse TrimLeft)) (let Trimmed (reverse TrimRight) (shen.record-it-h Trimmed))))) -(defun shen.trim-whitespace (V2592) (cond ((and (cons? V2592) (element? (hd V2592) (cons 9 (cons 10 (cons 13 (cons 32 ())))))) (shen.trim-whitespace (tl V2592))) (true V2592))) +(defun shen.trim-whitespace (V1431) (cond ((and (cons? V1431) (element? (hd V1431) (cons 9 (cons 10 (cons 13 (cons 32 ())))))) (shen.trim-whitespace (tl V1431))) (true V1431))) -(defun shen.record-it-h (V2594) (do (set shen.*it* (shen.cn-all (map (lambda X (n->string X)) V2594))) V2594)) +(defun shen.record-it-h (V1433) (do (set shen.*it* (shen.cn-all (map (lambda X (n->string X)) V1433))) V1433)) -(defun shen.cn-all (V2596) (cond ((= () V2596) "") ((cons? V2596) (cn (hd V2596) (shen.cn-all (tl V2596)))) (true (shen.f_error shen.cn-all)))) +(defun shen.cn-all (V1435) (cond ((= () V1435) "") ((cons? V1435) (cn (hd V1435) (shen.cn-all (tl V1435)))) (true (shen.f_error shen.cn-all)))) -(defun read-file (V2598) (let Charlist (shen.read-file-as-charlist V2598) (compile (lambda X (shen. X)) Charlist (lambda X (shen.read-error X))))) +(defun read-file (V1437) (let Charlist (shen.read-file-as-charlist V1437) (compile (lambda X (shen. X)) Charlist (lambda X (shen.read-error X))))) -(defun read-from-string (V2600) (let Ns (map (lambda X (string->n X)) (explode V2600)) (compile (lambda X (shen. X)) Ns (lambda X (shen.read-error X))))) +(defun read-from-string (V1439) (let Ns (map (lambda X (string->n X)) (explode V1439)) (compile (lambda X (shen. X)) Ns (lambda X (shen.read-error X))))) -(defun shen.read-error (V2608) (cond ((and (cons? V2608) (and (cons? (hd V2608)) (and (cons? (tl V2608)) (= () (tl (tl V2608)))))) (simple-error (cn "read error here: +(defun shen.read-error (V1447) (cond ((and (cons? V1447) (and (cons? (hd V1447)) (and (cons? (tl V1447)) (= () (tl (tl V1447)))))) (simple-error (cn "read error here: - " (shen.app (shen.compress-50 50 (hd V2608)) " + " (shen.app (shen.compress-50 50 (hd V1447)) " " shen.a)))) (true (simple-error "read error ")))) -(defun shen.compress-50 (V2615 V2616) (cond ((= () V2616) "") ((= 0 V2615) "") ((cons? V2616) (cn (n->string (hd V2616)) (shen.compress-50 (- V2615 1) (tl V2616)))) (true (shen.f_error shen.compress-50)))) +(defun shen.compress-50 (V1454 V1455) (cond ((= () V1455) "") ((= 0 V1454) "") ((cons? V1455) (cn (n->string (hd V1455)) (shen.compress-50 (- V1454 1) (tl V1455)))) (true (shen.f_error shen.compress-50)))) -(defun shen. (V2618) (let YaccParse (let Parse_shen. (shen. V2618) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (macroexpand (shen.cons_form (shen.hdtl Parse_shen.))) (shen.hdtl Parse_shen.))) (fail))) (fail))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V2618) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.package-macro (macroexpand (shen.hdtl Parse_shen.)) (shen.hdtl Parse_shen.))) (fail))) (fail))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V2618) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons { (shen.hdtl Parse_shen.))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V2618) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons } (shen.hdtl Parse_shen.))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V2618) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons bar! (shen.hdtl Parse_shen.))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V2618) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons ; (shen.hdtl Parse_shen.))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V2618) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons := (shen.hdtl Parse_shen.))) (fail))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V2618) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons :- (shen.hdtl Parse_shen.))) (fail))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V2618) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons : (shen.hdtl Parse_shen.))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V2618) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (intern ",") (shen.hdtl Parse_shen.))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V2618) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.hdtl Parse_shen.)) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V2618) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (macroexpand (shen.hdtl Parse_shen.)) (shen.hdtl Parse_shen.))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V2618) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.hdtl Parse_shen.)) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_ ( V2618) (if (not (= (fail) Parse_)) (shen.pair (hd Parse_) ()) (fail))) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse))) +(defun shen. (V1457) (let YaccParse (let Parse_shen. (shen. V1457) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (macroexpand (shen.cons_form (shen.hdtl Parse_shen.))) (shen.hdtl Parse_shen.))) (fail))) (fail))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V1457) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.package-macro (macroexpand (shen.hdtl Parse_shen.)) (shen.hdtl Parse_shen.))) (fail))) (fail))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V1457) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons { (shen.hdtl Parse_shen.))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V1457) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons } (shen.hdtl Parse_shen.))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V1457) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons bar! (shen.hdtl Parse_shen.))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V1457) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons ; (shen.hdtl Parse_shen.))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V1457) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons := (shen.hdtl Parse_shen.))) (fail))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V1457) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons :- (shen.hdtl Parse_shen.))) (fail))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V1457) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons : (shen.hdtl Parse_shen.))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V1457) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (intern ",") (shen.hdtl Parse_shen.))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V1457) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.hdtl Parse_shen.)) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V1457) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (macroexpand (shen.hdtl Parse_shen.)) (shen.hdtl Parse_shen.))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V1457) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.hdtl Parse_shen.)) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_ ( V1457) (if (not (= (fail) Parse_)) (shen.pair (hd Parse_) ()) (fail))) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse))) -(defun shen. (V2621) (if (and (cons? (hd V2621)) (= 91 (shen.hdhd V2621))) (let NewStream2619 (shen.pair (shen.tlhd V2621) (shen.hdtl V2621)) (shen.pair (hd NewStream2619) shen.skip)) (fail))) +(defun shen. (V1460) (if (and (cons? (hd V1460)) (= 91 (shen.hdhd V1460))) (let NewStream1458 (shen.pair (shen.tlhd V1460) (shen.hdtl V1460)) (shen.pair (hd NewStream1458) shen.skip)) (fail))) -(defun shen. (V2624) (if (and (cons? (hd V2624)) (= 93 (shen.hdhd V2624))) (let NewStream2622 (shen.pair (shen.tlhd V2624) (shen.hdtl V2624)) (shen.pair (hd NewStream2622) shen.skip)) (fail))) +(defun shen. (V1463) (if (and (cons? (hd V1463)) (= 93 (shen.hdhd V1463))) (let NewStream1461 (shen.pair (shen.tlhd V1463) (shen.hdtl V1463)) (shen.pair (hd NewStream1461) shen.skip)) (fail))) -(defun shen. (V2627) (if (and (cons? (hd V2627)) (= 123 (shen.hdhd V2627))) (let NewStream2625 (shen.pair (shen.tlhd V2627) (shen.hdtl V2627)) (shen.pair (hd NewStream2625) shen.skip)) (fail))) +(defun shen. (V1466) (if (and (cons? (hd V1466)) (= 123 (shen.hdhd V1466))) (let NewStream1464 (shen.pair (shen.tlhd V1466) (shen.hdtl V1466)) (shen.pair (hd NewStream1464) shen.skip)) (fail))) -(defun shen. (V2630) (if (and (cons? (hd V2630)) (= 125 (shen.hdhd V2630))) (let NewStream2628 (shen.pair (shen.tlhd V2630) (shen.hdtl V2630)) (shen.pair (hd NewStream2628) shen.skip)) (fail))) +(defun shen. (V1469) (if (and (cons? (hd V1469)) (= 125 (shen.hdhd V1469))) (let NewStream1467 (shen.pair (shen.tlhd V1469) (shen.hdtl V1469)) (shen.pair (hd NewStream1467) shen.skip)) (fail))) -(defun shen. (V2633) (if (and (cons? (hd V2633)) (= 124 (shen.hdhd V2633))) (let NewStream2631 (shen.pair (shen.tlhd V2633) (shen.hdtl V2633)) (shen.pair (hd NewStream2631) shen.skip)) (fail))) +(defun shen. (V1472) (if (and (cons? (hd V1472)) (= 124 (shen.hdhd V1472))) (let NewStream1470 (shen.pair (shen.tlhd V1472) (shen.hdtl V1472)) (shen.pair (hd NewStream1470) shen.skip)) (fail))) -(defun shen. (V2636) (if (and (cons? (hd V2636)) (= 59 (shen.hdhd V2636))) (let NewStream2634 (shen.pair (shen.tlhd V2636) (shen.hdtl V2636)) (shen.pair (hd NewStream2634) shen.skip)) (fail))) +(defun shen. (V1475) (if (and (cons? (hd V1475)) (= 59 (shen.hdhd V1475))) (let NewStream1473 (shen.pair (shen.tlhd V1475) (shen.hdtl V1475)) (shen.pair (hd NewStream1473) shen.skip)) (fail))) -(defun shen. (V2639) (if (and (cons? (hd V2639)) (= 58 (shen.hdhd V2639))) (let NewStream2637 (shen.pair (shen.tlhd V2639) (shen.hdtl V2639)) (shen.pair (hd NewStream2637) shen.skip)) (fail))) +(defun shen. (V1478) (if (and (cons? (hd V1478)) (= 58 (shen.hdhd V1478))) (let NewStream1476 (shen.pair (shen.tlhd V1478) (shen.hdtl V1478)) (shen.pair (hd NewStream1476) shen.skip)) (fail))) -(defun shen. (V2642) (if (and (cons? (hd V2642)) (= 44 (shen.hdhd V2642))) (let NewStream2640 (shen.pair (shen.tlhd V2642) (shen.hdtl V2642)) (shen.pair (hd NewStream2640) shen.skip)) (fail))) +(defun shen. (V1481) (if (and (cons? (hd V1481)) (= 44 (shen.hdhd V1481))) (let NewStream1479 (shen.pair (shen.tlhd V1481) (shen.hdtl V1481)) (shen.pair (hd NewStream1479) shen.skip)) (fail))) -(defun shen. (V2645) (if (and (cons? (hd V2645)) (= 61 (shen.hdhd V2645))) (let NewStream2643 (shen.pair (shen.tlhd V2645) (shen.hdtl V2645)) (shen.pair (hd NewStream2643) shen.skip)) (fail))) +(defun shen. (V1484) (if (and (cons? (hd V1484)) (= 61 (shen.hdhd V1484))) (let NewStream1482 (shen.pair (shen.tlhd V1484) (shen.hdtl V1484)) (shen.pair (hd NewStream1482) shen.skip)) (fail))) -(defun shen. (V2648) (if (and (cons? (hd V2648)) (= 45 (shen.hdhd V2648))) (let NewStream2646 (shen.pair (shen.tlhd V2648) (shen.hdtl V2648)) (shen.pair (hd NewStream2646) shen.skip)) (fail))) +(defun shen. (V1487) (if (and (cons? (hd V1487)) (= 45 (shen.hdhd V1487))) (let NewStream1485 (shen.pair (shen.tlhd V1487) (shen.hdtl V1487)) (shen.pair (hd NewStream1485) shen.skip)) (fail))) -(defun shen. (V2651) (if (and (cons? (hd V2651)) (= 40 (shen.hdhd V2651))) (let NewStream2649 (shen.pair (shen.tlhd V2651) (shen.hdtl V2651)) (shen.pair (hd NewStream2649) shen.skip)) (fail))) +(defun shen. (V1490) (if (and (cons? (hd V1490)) (= 40 (shen.hdhd V1490))) (let NewStream1488 (shen.pair (shen.tlhd V1490) (shen.hdtl V1490)) (shen.pair (hd NewStream1488) shen.skip)) (fail))) -(defun shen. (V2654) (if (and (cons? (hd V2654)) (= 41 (shen.hdhd V2654))) (let NewStream2652 (shen.pair (shen.tlhd V2654) (shen.hdtl V2654)) (shen.pair (hd NewStream2652) shen.skip)) (fail))) +(defun shen. (V1493) (if (and (cons? (hd V1493)) (= 41 (shen.hdhd V1493))) (let NewStream1491 (shen.pair (shen.tlhd V1493) (shen.hdtl V1493)) (shen.pair (hd NewStream1491) shen.skip)) (fail))) -(defun shen. (V2656) (let YaccParse (let Parse_shen. (shen. V2656) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.control-chars (shen.hdtl Parse_shen.))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V2656) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.hdtl Parse_shen.)) (fail))) (if (= YaccParse (fail)) (let Parse_shen. (shen. V2656) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (if (= (shen.hdtl Parse_shen.) "<>") (cons vector (cons 0 ())) (intern (shen.hdtl Parse_shen.)))) (fail))) YaccParse)) YaccParse))) +(defun shen. (V1495) (let YaccParse (let Parse_shen. (shen. V1495) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.control-chars (shen.hdtl Parse_shen.))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V1495) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.hdtl Parse_shen.)) (fail))) (if (= YaccParse (fail)) (let Parse_shen. (shen. V1495) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (if (= (shen.hdtl Parse_shen.) "<>") (cons vector (cons 0 ())) (intern (shen.hdtl Parse_shen.)))) (fail))) YaccParse)) YaccParse))) -(defun shen.control-chars (V2658) (cond ((= () V2658) "") ((and (cons? V2658) (and (= "c" (hd V2658)) (and (cons? (tl V2658)) (= "#" (hd (tl V2658)))))) (let CodePoint (shen.code-point (tl (tl V2658))) (let AfterCodePoint (shen.after-codepoint (tl (tl V2658))) (@s (n->string (shen.decimalise CodePoint)) (shen.control-chars AfterCodePoint))))) ((cons? V2658) (@s (hd V2658) (shen.control-chars (tl V2658)))) (true (shen.f_error shen.control-chars)))) +(defun shen.control-chars (V1497) (cond ((= () V1497) "") ((and (cons? V1497) (and (= "c" (hd V1497)) (and (cons? (tl V1497)) (= "#" (hd (tl V1497)))))) (let CodePoint (shen.code-point (tl (tl V1497))) (let AfterCodePoint (shen.after-codepoint (tl (tl V1497))) (@s (n->string (shen.decimalise CodePoint)) (shen.control-chars AfterCodePoint))))) ((cons? V1497) (@s (hd V1497) (shen.control-chars (tl V1497)))) (true (shen.f_error shen.control-chars)))) -(defun shen.code-point (V2662) (cond ((and (cons? V2662) (= ";" (hd V2662))) "") ((and (cons? V2662) (element? (hd V2662) (cons "0" (cons "1" (cons "2" (cons "3" (cons "4" (cons "5" (cons "6" (cons "7" (cons "8" (cons "9" (cons "0" ()))))))))))))) (cons (hd V2662) (shen.code-point (tl V2662)))) (true (simple-error (cn "code point parse error " (shen.app V2662 " +(defun shen.code-point (V1501) (cond ((and (cons? V1501) (= ";" (hd V1501))) "") ((and (cons? V1501) (element? (hd V1501) (cons "0" (cons "1" (cons "2" (cons "3" (cons "4" (cons "5" (cons "6" (cons "7" (cons "8" (cons "9" (cons "0" ()))))))))))))) (cons (hd V1501) (shen.code-point (tl V1501)))) (true (simple-error (cn "code point parse error " (shen.app V1501 " " shen.a)))))) -(defun shen.after-codepoint (V2668) (cond ((= () V2668) ()) ((and (cons? V2668) (= ";" (hd V2668))) (tl V2668)) ((cons? V2668) (shen.after-codepoint (tl V2668))) (true (shen.f_error shen.after-codepoint)))) +(defun shen.after-codepoint (V1507) (cond ((= () V1507) ()) ((and (cons? V1507) (= ";" (hd V1507))) (tl V1507)) ((cons? V1507) (shen.after-codepoint (tl V1507))) (true (shen.f_error shen.after-codepoint)))) -(defun shen.decimalise (V2670) (shen.pre (reverse (shen.digits->integers V2670)) 0)) +(defun shen.decimalise (V1509) (shen.pre (reverse (shen.digits->integers V1509)) 0)) -(defun shen.digits->integers (V2676) (cond ((and (cons? V2676) (= "0" (hd V2676))) (cons 0 (shen.digits->integers (tl V2676)))) ((and (cons? V2676) (= "1" (hd V2676))) (cons 1 (shen.digits->integers (tl V2676)))) ((and (cons? V2676) (= "2" (hd V2676))) (cons 2 (shen.digits->integers (tl V2676)))) ((and (cons? V2676) (= "3" (hd V2676))) (cons 3 (shen.digits->integers (tl V2676)))) ((and (cons? V2676) (= "4" (hd V2676))) (cons 4 (shen.digits->integers (tl V2676)))) ((and (cons? V2676) (= "5" (hd V2676))) (cons 5 (shen.digits->integers (tl V2676)))) ((and (cons? V2676) (= "6" (hd V2676))) (cons 6 (shen.digits->integers (tl V2676)))) ((and (cons? V2676) (= "7" (hd V2676))) (cons 7 (shen.digits->integers (tl V2676)))) ((and (cons? V2676) (= "8" (hd V2676))) (cons 8 (shen.digits->integers (tl V2676)))) ((and (cons? V2676) (= "9" (hd V2676))) (cons 9 (shen.digits->integers (tl V2676)))) (true ()))) +(defun shen.digits->integers (V1515) (cond ((and (cons? V1515) (= "0" (hd V1515))) (cons 0 (shen.digits->integers (tl V1515)))) ((and (cons? V1515) (= "1" (hd V1515))) (cons 1 (shen.digits->integers (tl V1515)))) ((and (cons? V1515) (= "2" (hd V1515))) (cons 2 (shen.digits->integers (tl V1515)))) ((and (cons? V1515) (= "3" (hd V1515))) (cons 3 (shen.digits->integers (tl V1515)))) ((and (cons? V1515) (= "4" (hd V1515))) (cons 4 (shen.digits->integers (tl V1515)))) ((and (cons? V1515) (= "5" (hd V1515))) (cons 5 (shen.digits->integers (tl V1515)))) ((and (cons? V1515) (= "6" (hd V1515))) (cons 6 (shen.digits->integers (tl V1515)))) ((and (cons? V1515) (= "7" (hd V1515))) (cons 7 (shen.digits->integers (tl V1515)))) ((and (cons? V1515) (= "8" (hd V1515))) (cons 8 (shen.digits->integers (tl V1515)))) ((and (cons? V1515) (= "9" (hd V1515))) (cons 9 (shen.digits->integers (tl V1515)))) (true ()))) -(defun shen. (V2678) (let Parse_shen. (shen. V2678) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (@s (shen.hdtl Parse_shen.) (shen.hdtl Parse_shen.))) (fail))) (fail)))) +(defun shen. (V1517) (let Parse_shen. (shen. V1517) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (@s (shen.hdtl Parse_shen.) (shen.hdtl Parse_shen.))) (fail))) (fail)))) -(defun shen. (V2680) (let YaccParse (let Parse_shen. (shen. V2680) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (@s (shen.hdtl Parse_shen.) (shen.hdtl Parse_shen.))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_ ( V2680) (if (not (= (fail) Parse_)) (shen.pair (hd Parse_) "") (fail))) YaccParse))) +(defun shen. (V1519) (let YaccParse (let Parse_shen. (shen. V1519) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (@s (shen.hdtl Parse_shen.) (shen.hdtl Parse_shen.))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_ ( V1519) (if (not (= (fail) Parse_)) (shen.pair (hd Parse_) "") (fail))) YaccParse))) -(defun shen. (V2682) (let YaccParse (let Parse_shen. (shen. V2682) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.hdtl Parse_shen.)) (fail))) (if (= YaccParse (fail)) (let Parse_shen. (shen. V2682) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.hdtl Parse_shen.)) (fail))) YaccParse))) +(defun shen. (V1521) (let YaccParse (let Parse_shen. (shen. V1521) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.hdtl Parse_shen.)) (fail))) (if (= YaccParse (fail)) (let Parse_shen. (shen. V1521) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.hdtl Parse_shen.)) (fail))) YaccParse))) -(defun shen. (V2684) (if (cons? (hd V2684)) (let Parse_Char (shen.hdhd V2684) (if (shen.numbyte? Parse_Char) (shen.pair (hd (shen.pair (shen.tlhd V2684) (shen.hdtl V2684))) (n->string Parse_Char)) (fail))) (fail))) +(defun shen. (V1523) (if (cons? (hd V1523)) (let Parse_Char (shen.hdhd V1523) (if (shen.numbyte? Parse_Char) (shen.pair (hd (shen.pair (shen.tlhd V1523) (shen.hdtl V1523))) (n->string Parse_Char)) (fail))) (fail))) -(defun shen.numbyte? (V2690) (cond ((= 48 V2690) true) ((= 49 V2690) true) ((= 50 V2690) true) ((= 51 V2690) true) ((= 52 V2690) true) ((= 53 V2690) true) ((= 54 V2690) true) ((= 55 V2690) true) ((= 56 V2690) true) ((= 57 V2690) true) (true false))) +(defun shen.numbyte? (V1529) (cond ((= 48 V1529) true) ((= 49 V1529) true) ((= 50 V1529) true) ((= 51 V1529) true) ((= 52 V1529) true) ((= 53 V1529) true) ((= 54 V1529) true) ((= 55 V1529) true) ((= 56 V1529) true) ((= 57 V1529) true) (true false))) -(defun shen. (V2692) (if (cons? (hd V2692)) (let Parse_Char (shen.hdhd V2692) (if (shen.symbol-code? Parse_Char) (shen.pair (hd (shen.pair (shen.tlhd V2692) (shen.hdtl V2692))) (n->string Parse_Char)) (fail))) (fail))) +(defun shen. (V1531) (if (cons? (hd V1531)) (let Parse_Char (shen.hdhd V1531) (if (shen.symbol-code? Parse_Char) (shen.pair (hd (shen.pair (shen.tlhd V1531) (shen.hdtl V1531))) (n->string Parse_Char)) (fail))) (fail))) -(defun shen.symbol-code? (V2694) (or (= V2694 126) (or (and (> V2694 94) (< V2694 123)) (or (and (> V2694 59) (< V2694 91)) (or (and (> V2694 41) (and (< V2694 58) (not (= V2694 44)))) (or (and (> V2694 34) (< V2694 40)) (= V2694 33))))))) +(defun shen.symbol-code? (V1533) (or (= V1533 126) (or (and (> V1533 94) (< V1533 123)) (or (and (> V1533 59) (< V1533 91)) (or (and (> V1533 41) (and (< V1533 58) (not (= V1533 44)))) (or (and (> V1533 34) (< V1533 40)) (= V1533 33))))))) -(defun shen. (V2696) (let Parse_shen. (shen. V2696) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.hdtl Parse_shen.)) (fail))) (fail))) (fail)))) +(defun shen. (V1535) (let Parse_shen. (shen. V1535) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.hdtl Parse_shen.)) (fail))) (fail))) (fail)))) -(defun shen. (V2698) (if (cons? (hd V2698)) (let Parse_Char (shen.hdhd V2698) (if (= Parse_Char 34) (shen.pair (hd (shen.pair (shen.tlhd V2698) (shen.hdtl V2698))) Parse_Char) (fail))) (fail))) +(defun shen. (V1537) (if (cons? (hd V1537)) (let Parse_Char (shen.hdhd V1537) (if (= Parse_Char 34) (shen.pair (hd (shen.pair (shen.tlhd V1537) (shen.hdtl V1537))) Parse_Char) (fail))) (fail))) -(defun shen. (V2700) (let YaccParse (let Parse_shen. (shen. V2700) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (shen.hdtl Parse_shen.) (shen.hdtl Parse_shen.))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_ ( V2700) (if (not (= (fail) Parse_)) (shen.pair (hd Parse_) ()) (fail))) YaccParse))) +(defun shen. (V1539) (let YaccParse (let Parse_shen. (shen. V1539) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (shen.hdtl Parse_shen.) (shen.hdtl Parse_shen.))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_ ( V1539) (if (not (= (fail) Parse_)) (shen.pair (hd Parse_) ()) (fail))) YaccParse))) -(defun shen. (V2702) (if (cons? (hd V2702)) (let Parse_Char (shen.hdhd V2702) (shen.pair (hd (shen.pair (shen.tlhd V2702) (shen.hdtl V2702))) (n->string Parse_Char))) (fail))) +(defun shen. (V1541) (if (cons? (hd V1541)) (let Parse_Char (shen.hdhd V1541) (shen.pair (hd (shen.pair (shen.tlhd V1541) (shen.hdtl V1541))) (n->string Parse_Char))) (fail))) -(defun shen. (V2704) (if (cons? (hd V2704)) (let Parse_Char (shen.hdhd V2704) (if (not (= Parse_Char 34)) (shen.pair (hd (shen.pair (shen.tlhd V2704) (shen.hdtl V2704))) (n->string Parse_Char)) (fail))) (fail))) +(defun shen. (V1543) (if (cons? (hd V1543)) (let Parse_Char (shen.hdhd V1543) (if (not (= Parse_Char 34)) (shen.pair (hd (shen.pair (shen.tlhd V1543) (shen.hdtl V1543))) (n->string Parse_Char)) (fail))) (fail))) -(defun shen. (V2706) (let YaccParse (let Parse_shen. (shen. V2706) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (- 0 (shen.hdtl Parse_shen.))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V2706) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.hdtl Parse_shen.)) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V2706) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (* (shen.expt 10 (shen.hdtl Parse_shen.)) (+ (shen.pre (reverse (shen.hdtl Parse_shen.)) 0) (shen.post (shen.hdtl Parse_shen.) 1)))) (fail))) (fail))) (fail))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V2706) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (* (shen.expt 10 (shen.hdtl Parse_shen.)) (shen.pre (reverse (shen.hdtl Parse_shen.)) 0))) (fail))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V2706) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (+ (shen.pre (reverse (shen.hdtl Parse_shen.)) 0) (shen.post (shen.hdtl Parse_shen.) 1))) (fail))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_shen. (shen. V2706) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.pre (reverse (shen.hdtl Parse_shen.)) 0)) (fail))) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse))) +(defun shen. (V1545) (let YaccParse (let Parse_shen. (shen. V1545) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (- 0 (shen.hdtl Parse_shen.))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V1545) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.hdtl Parse_shen.)) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V1545) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (* (shen.expt 10 (shen.hdtl Parse_shen.)) (+ (shen.pre (reverse (shen.hdtl Parse_shen.)) 0) (shen.post (shen.hdtl Parse_shen.) 1)))) (fail))) (fail))) (fail))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V1545) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (* (shen.expt 10 (shen.hdtl Parse_shen.)) (shen.pre (reverse (shen.hdtl Parse_shen.)) 0))) (fail))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V1545) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (+ (shen.pre (reverse (shen.hdtl Parse_shen.)) 0) (shen.post (shen.hdtl Parse_shen.) 1))) (fail))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_shen. (shen. V1545) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.pre (reverse (shen.hdtl Parse_shen.)) 0)) (fail))) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse))) -(defun shen. (V2709) (if (and (cons? (hd V2709)) (= 101 (shen.hdhd V2709))) (let NewStream2707 (shen.pair (shen.tlhd V2709) (shen.hdtl V2709)) (shen.pair (hd NewStream2707) shen.skip)) (fail))) +(defun shen. (V1548) (if (and (cons? (hd V1548)) (= 101 (shen.hdhd V1548))) (let NewStream1546 (shen.pair (shen.tlhd V1548) (shen.hdtl V1548)) (shen.pair (hd NewStream1546) shen.skip)) (fail))) -(defun shen. (V2711) (let YaccParse (let Parse_shen. (shen. V2711) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (- 0 (shen.pre (reverse (shen.hdtl Parse_shen.)) 0))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_shen. (shen. V2711) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.pre (reverse (shen.hdtl Parse_shen.)) 0)) (fail))) YaccParse))) +(defun shen. (V1550) (let YaccParse (let Parse_shen. (shen. V1550) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (- 0 (shen.pre (reverse (shen.hdtl Parse_shen.)) 0))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_shen. (shen. V1550) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.pre (reverse (shen.hdtl Parse_shen.)) 0)) (fail))) YaccParse))) -(defun shen. (V2713) (if (cons? (hd V2713)) (let Parse_Char (shen.hdhd V2713) (if (= Parse_Char 43) (shen.pair (hd (shen.pair (shen.tlhd V2713) (shen.hdtl V2713))) Parse_Char) (fail))) (fail))) +(defun shen. (V1552) (if (cons? (hd V1552)) (let Parse_Char (shen.hdhd V1552) (if (= Parse_Char 43) (shen.pair (hd (shen.pair (shen.tlhd V1552) (shen.hdtl V1552))) Parse_Char) (fail))) (fail))) -(defun shen. (V2715) (if (cons? (hd V2715)) (let Parse_Char (shen.hdhd V2715) (if (= Parse_Char 46) (shen.pair (hd (shen.pair (shen.tlhd V2715) (shen.hdtl V2715))) Parse_Char) (fail))) (fail))) +(defun shen. (V1554) (if (cons? (hd V1554)) (let Parse_Char (shen.hdhd V1554) (if (= Parse_Char 46) (shen.pair (hd (shen.pair (shen.tlhd V1554) (shen.hdtl V1554))) Parse_Char) (fail))) (fail))) -(defun shen. (V2717) (let YaccParse (let Parse_shen. (shen. V2717) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.hdtl Parse_shen.)) (fail))) (if (= YaccParse (fail)) (let Parse_ ( V2717) (if (not (= (fail) Parse_)) (shen.pair (hd Parse_) ()) (fail))) YaccParse))) +(defun shen. (V1556) (let YaccParse (let Parse_shen. (shen. V1556) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.hdtl Parse_shen.)) (fail))) (if (= YaccParse (fail)) (let Parse_ ( V1556) (if (not (= (fail) Parse_)) (shen.pair (hd Parse_) ()) (fail))) YaccParse))) -(defun shen. (V2719) (let Parse_shen. (shen. V2719) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.hdtl Parse_shen.)) (fail)))) +(defun shen. (V1558) (let Parse_shen. (shen. V1558) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.hdtl Parse_shen.)) (fail)))) -(defun shen. (V2721) (let YaccParse (let Parse_shen. (shen. V2721) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (shen.hdtl Parse_shen.) (shen.hdtl Parse_shen.))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_shen. (shen. V2721) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (shen.hdtl Parse_shen.) ())) (fail))) YaccParse))) +(defun shen. (V1560) (let YaccParse (let Parse_shen. (shen. V1560) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (shen.hdtl Parse_shen.) (shen.hdtl Parse_shen.))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_shen. (shen. V1560) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (shen.hdtl Parse_shen.) ())) (fail))) YaccParse))) -(defun shen. (V2723) (if (cons? (hd V2723)) (let Parse_X (shen.hdhd V2723) (if (shen.numbyte? Parse_X) (shen.pair (hd (shen.pair (shen.tlhd V2723) (shen.hdtl V2723))) (shen.byte->digit Parse_X)) (fail))) (fail))) +(defun shen. (V1562) (if (cons? (hd V1562)) (let Parse_X (shen.hdhd V1562) (if (shen.numbyte? Parse_X) (shen.pair (hd (shen.pair (shen.tlhd V1562) (shen.hdtl V1562))) (shen.byte->digit Parse_X)) (fail))) (fail))) -(defun shen.byte->digit (V2725) (cond ((= 48 V2725) 0) ((= 49 V2725) 1) ((= 50 V2725) 2) ((= 51 V2725) 3) ((= 52 V2725) 4) ((= 53 V2725) 5) ((= 54 V2725) 6) ((= 55 V2725) 7) ((= 56 V2725) 8) ((= 57 V2725) 9) (true (shen.f_error shen.byte->digit)))) +(defun shen.byte->digit (V1564) (cond ((= 48 V1564) 0) ((= 49 V1564) 1) ((= 50 V1564) 2) ((= 51 V1564) 3) ((= 52 V1564) 4) ((= 53 V1564) 5) ((= 54 V1564) 6) ((= 55 V1564) 7) ((= 56 V1564) 8) ((= 57 V1564) 9) (true (shen.f_error shen.byte->digit)))) -(defun shen.pre (V2730 V2731) (cond ((= () V2730) 0) ((cons? V2730) (+ (* (shen.expt 10 V2731) (hd V2730)) (shen.pre (tl V2730) (+ V2731 1)))) (true (shen.f_error shen.pre)))) +(defun shen.pre (V1569 V1570) (cond ((= () V1569) 0) ((cons? V1569) (+ (* (shen.expt 10 V1570) (hd V1569)) (shen.pre (tl V1569) (+ V1570 1)))) (true (shen.f_error shen.pre)))) -(defun shen.post (V2736 V2737) (cond ((= () V2736) 0) ((cons? V2736) (+ (* (shen.expt 10 (- 0 V2737)) (hd V2736)) (shen.post (tl V2736) (+ V2737 1)))) (true (shen.f_error shen.post)))) +(defun shen.post (V1575 V1576) (cond ((= () V1575) 0) ((cons? V1575) (+ (* (shen.expt 10 (- 0 V1576)) (hd V1575)) (shen.post (tl V1575) (+ V1576 1)))) (true (shen.f_error shen.post)))) -(defun shen.expt (V2742 V2743) (cond ((= 0 V2743) 1) ((> V2743 0) (* V2742 (shen.expt V2742 (- V2743 1)))) (true (* 1 (/ (shen.expt V2742 (+ V2743 1)) V2742))))) +(defun shen.expt (V1581 V1582) (cond ((= 0 V1582) 1) ((> V1582 0) (* V1581 (shen.expt V1581 (- V1582 1)))) (true (* 1.000000 (/ (shen.expt V1581 (+ V1582 1)) V1581))))) -(defun shen. (V2745) (let Parse_shen. (shen. V2745) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.hdtl Parse_shen.)) (fail)))) +(defun shen. (V1584) (let Parse_shen. (shen. V1584) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.hdtl Parse_shen.)) (fail)))) -(defun shen. (V2747) (let Parse_shen. (shen. V2747) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.hdtl Parse_shen.)) (fail)))) +(defun shen. (V1586) (let Parse_shen. (shen. V1586) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.hdtl Parse_shen.)) (fail)))) -(defun shen. (V2749) (let YaccParse (let Parse_shen. (shen. V2749) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) shen.skip) (fail))) (if (= YaccParse (fail)) (let Parse_shen. (shen. V2749) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) shen.skip) (fail))) YaccParse))) +(defun shen. (V1588) (let YaccParse (let Parse_shen. (shen. V1588) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) shen.skip) (fail))) (if (= YaccParse (fail)) (let Parse_shen. (shen. V1588) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) shen.skip) (fail))) YaccParse))) -(defun shen. (V2751) (let Parse_shen. (shen. V2751) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) shen.skip) (fail))) (fail))) (fail))) (fail)))) +(defun shen. (V1590) (let Parse_shen. (shen. V1590) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) shen.skip) (fail))) (fail))) (fail))) (fail)))) -(defun shen. (V2754) (if (and (cons? (hd V2754)) (= 92 (shen.hdhd V2754))) (let NewStream2752 (shen.pair (shen.tlhd V2754) (shen.hdtl V2754)) (shen.pair (hd NewStream2752) shen.skip)) (fail))) +(defun shen. (V1593) (if (and (cons? (hd V1593)) (= 92 (shen.hdhd V1593))) (let NewStream1591 (shen.pair (shen.tlhd V1593) (shen.hdtl V1593)) (shen.pair (hd NewStream1591) shen.skip)) (fail))) -(defun shen. (V2756) (let YaccParse (let Parse_shen. (shen. V2756) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) shen.skip) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_ ( V2756) (if (not (= (fail) Parse_)) (shen.pair (hd Parse_) shen.skip) (fail))) YaccParse))) +(defun shen. (V1595) (let YaccParse (let Parse_shen. (shen. V1595) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) shen.skip) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_ ( V1595) (if (not (= (fail) Parse_)) (shen.pair (hd Parse_) shen.skip) (fail))) YaccParse))) -(defun shen. (V2758) (if (cons? (hd V2758)) (let Parse_X (shen.hdhd V2758) (if (not (element? Parse_X (cons 10 (cons 13 ())))) (shen.pair (hd (shen.pair (shen.tlhd V2758) (shen.hdtl V2758))) shen.skip) (fail))) (fail))) +(defun shen. (V1597) (if (cons? (hd V1597)) (let Parse_X (shen.hdhd V1597) (if (not (element? Parse_X (cons 10 (cons 13 ())))) (shen.pair (hd (shen.pair (shen.tlhd V1597) (shen.hdtl V1597))) shen.skip) (fail))) (fail))) -(defun shen. (V2760) (if (cons? (hd V2760)) (let Parse_X (shen.hdhd V2760) (if (element? Parse_X (cons 10 (cons 13 ()))) (shen.pair (hd (shen.pair (shen.tlhd V2760) (shen.hdtl V2760))) shen.skip) (fail))) (fail))) +(defun shen. (V1599) (if (cons? (hd V1599)) (let Parse_X (shen.hdhd V1599) (if (element? Parse_X (cons 10 (cons 13 ()))) (shen.pair (hd (shen.pair (shen.tlhd V1599) (shen.hdtl V1599))) shen.skip) (fail))) (fail))) -(defun shen. (V2762) (let Parse_shen. (shen. V2762) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) shen.skip) (fail))) (fail))) (fail)))) +(defun shen. (V1601) (let Parse_shen. (shen. V1601) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) shen.skip) (fail))) (fail))) (fail)))) -(defun shen. (V2765) (if (and (cons? (hd V2765)) (= 42 (shen.hdhd V2765))) (let NewStream2763 (shen.pair (shen.tlhd V2765) (shen.hdtl V2765)) (shen.pair (hd NewStream2763) shen.skip)) (fail))) +(defun shen. (V1604) (if (and (cons? (hd V1604)) (= 42 (shen.hdhd V1604))) (let NewStream1602 (shen.pair (shen.tlhd V1604) (shen.hdtl V1604)) (shen.pair (hd NewStream1602) shen.skip)) (fail))) -(defun shen. (V2767) (let YaccParse (let Parse_shen. (shen. V2767) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) shen.skip) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V2767) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) shen.skip) (fail))) (fail))) (if (= YaccParse (fail)) (if (cons? (hd V2767)) (let Parse_X (shen.hdhd V2767) (let Parse_shen. (shen. (shen.pair (shen.tlhd V2767) (shen.hdtl V2767))) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) shen.skip) (fail)))) (fail)) YaccParse)) YaccParse))) +(defun shen. (V1606) (let YaccParse (let Parse_shen. (shen. V1606) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) shen.skip) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V1606) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) shen.skip) (fail))) (fail))) (if (= YaccParse (fail)) (if (cons? (hd V1606)) (let Parse_X (shen.hdhd V1606) (let Parse_shen. (shen. (shen.pair (shen.tlhd V1606) (shen.hdtl V1606))) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) shen.skip) (fail)))) (fail)) YaccParse)) YaccParse))) -(defun shen. (V2769) (let YaccParse (let Parse_shen. (shen. V2769) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) shen.skip) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_shen. (shen. V2769) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) shen.skip) (fail))) YaccParse))) +(defun shen. (V1608) (let YaccParse (let Parse_shen. (shen. V1608) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) shen.skip) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_shen. (shen. V1608) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) shen.skip) (fail))) YaccParse))) -(defun shen. (V2771) (if (cons? (hd V2771)) (let Parse_X (shen.hdhd V2771) (if (let Parse_Case Parse_X (or (= Parse_Case 32) (or (= Parse_Case 13) (or (= Parse_Case 10) (= Parse_Case 9))))) (shen.pair (hd (shen.pair (shen.tlhd V2771) (shen.hdtl V2771))) shen.skip) (fail))) (fail))) +(defun shen. (V1610) (if (cons? (hd V1610)) (let Parse_X (shen.hdhd V1610) (if (let Parse_Case Parse_X (or (= Parse_Case 32) (or (= Parse_Case 13) (or (= Parse_Case 10) (= Parse_Case 9))))) (shen.pair (hd (shen.pair (shen.tlhd V1610) (shen.hdtl V1610))) shen.skip) (fail))) (fail))) -(defun shen.cons_form (V2773) (cond ((= () V2773) ()) ((and (cons? V2773) (and (cons? (tl V2773)) (and (cons? (tl (tl V2773))) (and (= () (tl (tl (tl V2773)))) (= (hd (tl V2773)) bar!))))) (cons cons (cons (hd V2773) (tl (tl V2773))))) ((cons? V2773) (cons cons (cons (hd V2773) (cons (shen.cons_form (tl V2773)) ())))) (true (shen.f_error shen.cons_form)))) +(defun shen.cons_form (V1612) (cond ((= () V1612) ()) ((and (cons? V1612) (and (cons? (tl V1612)) (and (cons? (tl (tl V1612))) (and (= () (tl (tl (tl V1612)))) (= (hd (tl V1612)) bar!))))) (cons cons (cons (hd V1612) (tl (tl V1612))))) ((cons? V1612) (cons cons (cons (hd V1612) (cons (shen.cons_form (tl V1612)) ())))) (true (shen.f_error shen.cons_form)))) -(defun shen.package-macro (V2778 V2779) (cond ((and (cons? V2778) (and (= $ (hd V2778)) (and (cons? (tl V2778)) (= () (tl (tl V2778)))))) (append (explode (hd (tl V2778))) V2779)) ((and (cons? V2778) (and (= package (hd V2778)) (and (cons? (tl V2778)) (and (= null (hd (tl V2778))) (cons? (tl (tl V2778))))))) (append (tl (tl (tl V2778))) V2779)) ((and (cons? V2778) (and (= package (hd V2778)) (and (cons? (tl V2778)) (cons? (tl (tl V2778)))))) (let ListofExceptions (shen.eval-without-macros (hd (tl (tl V2778)))) (let External (shen.record-exceptions ListofExceptions (hd (tl V2778))) (let PackageNameDot (intern (cn (str (hd (tl V2778))) ".")) (let ExpPackageNameDot (explode PackageNameDot) (let Packaged (shen.packageh PackageNameDot ListofExceptions (tl (tl (tl V2778))) ExpPackageNameDot) (let Internal (shen.record-internal (hd (tl V2778)) (shen.internal-symbols ExpPackageNameDot Packaged)) (append Packaged V2779)))))))) (true (cons V2778 V2779)))) +(defun shen.package-macro (V1617 V1618) (cond ((and (cons? V1617) (and (= $ (hd V1617)) (and (cons? (tl V1617)) (= () (tl (tl V1617)))))) (append (explode (hd (tl V1617))) V1618)) ((and (cons? V1617) (and (= package (hd V1617)) (and (cons? (tl V1617)) (and (= null (hd (tl V1617))) (cons? (tl (tl V1617))))))) (append (tl (tl (tl V1617))) V1618)) ((and (cons? V1617) (and (= package (hd V1617)) (and (cons? (tl V1617)) (cons? (tl (tl V1617)))))) (let ListofExceptions (shen.eval-without-macros (hd (tl (tl V1617)))) (let External (shen.record-exceptions ListofExceptions (hd (tl V1617))) (let PackageNameDot (intern (cn (str (hd (tl V1617))) ".")) (let ExpPackageNameDot (explode PackageNameDot) (let Packaged (shen.packageh PackageNameDot ListofExceptions (tl (tl (tl V1617))) ExpPackageNameDot) (let Internal (shen.record-internal (hd (tl V1617)) (shen.internal-symbols ExpPackageNameDot Packaged)) (append Packaged V1618)))))))) (true (cons V1617 V1618)))) -(defun shen.record-exceptions (V2782 V2783) (let CurrExceptions (trap-error (get V2783 shen.external-symbols (value *property-vector*)) (lambda E ())) (let AllExceptions (union V2782 CurrExceptions) (put V2783 shen.external-symbols AllExceptions (value *property-vector*))))) +(defun shen.record-exceptions (V1621 V1622) (let CurrExceptions (trap-error (get V1622 shen.external-symbols (value *property-vector*)) (lambda E ())) (let AllExceptions (union V1621 CurrExceptions) (put V1622 shen.external-symbols AllExceptions (value *property-vector*))))) -(defun shen.record-internal (V2786 V2787) (put V2786 shen.internal-symbols (union V2787 (trap-error (get V2786 shen.internal-symbols (value *property-vector*)) (lambda E ()))) (value *property-vector*))) +(defun shen.record-internal (V1625 V1626) (put V1625 shen.internal-symbols (union V1626 (trap-error (get V1625 shen.internal-symbols (value *property-vector*)) (lambda E ()))) (value *property-vector*))) -(defun shen.internal-symbols (V2798 V2799) (cond ((and (symbol? V2799) (shen.prefix? V2798 (explode V2799))) (cons V2799 ())) ((cons? V2799) (union (shen.internal-symbols V2798 (hd V2799)) (shen.internal-symbols V2798 (tl V2799)))) (true ()))) +(defun shen.internal-symbols (V1637 V1638) (cond ((and (symbol? V1638) (shen.prefix? V1637 (explode V1638))) (cons V1638 ())) ((cons? V1638) (union (shen.internal-symbols V1637 (hd V1638)) (shen.internal-symbols V1637 (tl V1638)))) (true ()))) -(defun shen.packageh (V2816 V2817 V2818 V2819) (cond ((cons? V2818) (cons (shen.packageh V2816 V2817 (hd V2818) V2819) (shen.packageh V2816 V2817 (tl V2818) V2819))) ((or (shen.sysfunc? V2818) (or (variable? V2818) (or (element? V2818 V2817) (or (shen.doubleunderline? V2818) (shen.singleunderline? V2818))))) V2818) ((and (symbol? V2818) (let ExplodeX (explode V2818) (and (not (shen.prefix? (cons "s" (cons "h" (cons "e" (cons "n" (cons "." ()))))) ExplodeX)) (not (shen.prefix? V2819 ExplodeX))))) (concat V2816 V2818)) (true V2818))) +(defun shen.packageh (V1655 V1656 V1657 V1658) (cond ((cons? V1657) (cons (shen.packageh V1655 V1656 (hd V1657) V1658) (shen.packageh V1655 V1656 (tl V1657) V1658))) ((or (shen.sysfunc? V1657) (or (variable? V1657) (or (element? V1657 V1656) (or (shen.doubleunderline? V1657) (shen.singleunderline? V1657))))) V1657) ((and (symbol? V1657) (let ExplodeX (explode V1657) (and (not (shen.prefix? (cons "s" (cons "h" (cons "e" (cons "n" (cons "." ()))))) ExplodeX)) (not (shen.prefix? V1658 ExplodeX))))) (concat V1655 V1657)) (true V1657))) diff --git a/kl/sequent.kl b/kl/sequent.kl index b9b9a4f..9bf2f05 100644 --- a/kl/sequent.kl +++ b/kl/sequent.kl @@ -28,120 +28,120 @@ OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. " -(defun shen.datatype-error (V2825) (cond ((and (cons? V2825) (and (cons? (tl V2825)) (= () (tl (tl V2825))))) (simple-error (cn "datatype syntax error here: +(defun shen.datatype-error (V1664) (cond ((and (cons? V1664) (and (cons? (tl V1664)) (= () (tl (tl V1664))))) (simple-error (cn "datatype syntax error here: - " (shen.app (shen.next-50 50 (hd V2825)) " + " (shen.app (shen.next-50 50 (hd V1664)) " " shen.a)))) (true (shen.f_error shen.datatype-error)))) -(defun shen. (V2827) (let YaccParse (let Parse_shen. (shen. V2827) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (shen.hdtl Parse_shen.) (shen.hdtl Parse_shen.))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_ ( V2827) (if (not (= (fail) Parse_)) (shen.pair (hd Parse_) ()) (fail))) YaccParse))) +(defun shen. (V1666) (let YaccParse (let Parse_shen. (shen. V1666) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (shen.hdtl Parse_shen.) (shen.hdtl Parse_shen.))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_ ( V1666) (if (not (= (fail) Parse_)) (shen.pair (hd Parse_) ()) (fail))) YaccParse))) -(defun shen. (V2829) (let YaccParse (let Parse_shen. (shen. V2829) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.sequent shen.single (cons (shen.hdtl Parse_shen.) (cons (shen.hdtl Parse_shen.) (cons (shen.hdtl Parse_shen.) ()))))) (fail))) (fail))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_shen. (shen. V2829) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.sequent shen.double (cons (shen.hdtl Parse_shen.) (cons (shen.hdtl Parse_shen.) (cons (shen.hdtl Parse_shen.) ()))))) (fail))) (fail))) (fail))) (fail))) YaccParse))) +(defun shen. (V1668) (let YaccParse (let Parse_shen. (shen. V1668) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.sequent shen.single (cons (shen.hdtl Parse_shen.) (cons (shen.hdtl Parse_shen.) (cons (shen.hdtl Parse_shen.) ()))))) (fail))) (fail))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_shen. (shen. V1668) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.sequent shen.double (cons (shen.hdtl Parse_shen.) (cons (shen.hdtl Parse_shen.) (cons (shen.hdtl Parse_shen.) ()))))) (fail))) (fail))) (fail))) (fail))) YaccParse))) -(defun shen. (V2831) (let YaccParse (let Parse_shen. (shen. V2831) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (shen.hdtl Parse_shen.) (shen.hdtl Parse_shen.))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_ ( V2831) (if (not (= (fail) Parse_)) (shen.pair (hd Parse_) ()) (fail))) YaccParse))) +(defun shen. (V1670) (let YaccParse (let Parse_shen. (shen. V1670) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (shen.hdtl Parse_shen.) (shen.hdtl Parse_shen.))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_ ( V1670) (if (not (= (fail) Parse_)) (shen.pair (hd Parse_) ()) (fail))) YaccParse))) -(defun shen. (V2835) (let YaccParse (if (and (cons? (hd V2835)) (= if (shen.hdhd V2835))) (let NewStream2832 (shen.pair (shen.tlhd V2835) (shen.hdtl V2835)) (let Parse_shen. (shen. NewStream2832) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons if (cons (shen.hdtl Parse_shen.) ()))) (fail)))) (fail)) (if (= YaccParse (fail)) (if (and (cons? (hd V2835)) (= let (shen.hdhd V2835))) (let NewStream2833 (shen.pair (shen.tlhd V2835) (shen.hdtl V2835)) (let Parse_shen. (shen. NewStream2833) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons let (cons (shen.hdtl Parse_shen.) (cons (shen.hdtl Parse_shen.) ())))) (fail))) (fail)))) (fail)) YaccParse))) +(defun shen. (V1674) (let YaccParse (if (and (cons? (hd V1674)) (= if (shen.hdhd V1674))) (let NewStream1671 (shen.pair (shen.tlhd V1674) (shen.hdtl V1674)) (let Parse_shen. (shen. NewStream1671) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons if (cons (shen.hdtl Parse_shen.) ()))) (fail)))) (fail)) (if (= YaccParse (fail)) (if (and (cons? (hd V1674)) (= let (shen.hdhd V1674))) (let NewStream1672 (shen.pair (shen.tlhd V1674) (shen.hdtl V1674)) (let Parse_shen. (shen. NewStream1672) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons let (cons (shen.hdtl Parse_shen.) (cons (shen.hdtl Parse_shen.) ())))) (fail))) (fail)))) (fail)) YaccParse))) -(defun shen. (V2837) (if (cons? (hd V2837)) (let Parse_X (shen.hdhd V2837) (if (variable? Parse_X) (shen.pair (hd (shen.pair (shen.tlhd V2837) (shen.hdtl V2837))) Parse_X) (fail))) (fail))) +(defun shen. (V1676) (if (cons? (hd V1676)) (let Parse_X (shen.hdhd V1676) (if (variable? Parse_X) (shen.pair (hd (shen.pair (shen.tlhd V1676) (shen.hdtl V1676))) Parse_X) (fail))) (fail))) -(defun shen. (V2839) (if (cons? (hd V2839)) (let Parse_X (shen.hdhd V2839) (if (not (or (element? Parse_X (cons >> (cons ; ()))) (or (shen.singleunderline? Parse_X) (shen.doubleunderline? Parse_X)))) (shen.pair (hd (shen.pair (shen.tlhd V2839) (shen.hdtl V2839))) (shen.remove-bar Parse_X)) (fail))) (fail))) +(defun shen. (V1678) (if (cons? (hd V1678)) (let Parse_X (shen.hdhd V1678) (if (not (or (element? Parse_X (cons >> (cons ; ()))) (or (shen.singleunderline? Parse_X) (shen.doubleunderline? Parse_X)))) (shen.pair (hd (shen.pair (shen.tlhd V1678) (shen.hdtl V1678))) (shen.remove-bar Parse_X)) (fail))) (fail))) -(defun shen.remove-bar (V2841) (cond ((and (cons? V2841) (and (cons? (tl V2841)) (and (cons? (tl (tl V2841))) (and (= () (tl (tl (tl V2841)))) (= (hd (tl V2841)) bar!))))) (cons (hd V2841) (hd (tl (tl V2841))))) ((cons? V2841) (cons (shen.remove-bar (hd V2841)) (shen.remove-bar (tl V2841)))) (true V2841))) +(defun shen.remove-bar (V1680) (cond ((and (cons? V1680) (and (cons? (tl V1680)) (and (cons? (tl (tl V1680))) (and (= () (tl (tl (tl V1680)))) (= (hd (tl V1680)) bar!))))) (cons (hd V1680) (hd (tl (tl V1680))))) ((cons? V1680) (cons (shen.remove-bar (hd V1680)) (shen.remove-bar (tl V1680)))) (true V1680))) -(defun shen. (V2843) (let YaccParse (let Parse_shen. (shen. V2843) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (shen.hdtl Parse_shen.) (shen.hdtl Parse_shen.))) (fail))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_ ( V2843) (if (not (= (fail) Parse_)) (shen.pair (hd Parse_) ()) (fail))) YaccParse))) +(defun shen. (V1682) (let YaccParse (let Parse_shen. (shen. V1682) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (shen.hdtl Parse_shen.) (shen.hdtl Parse_shen.))) (fail))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_ ( V1682) (if (not (= (fail) Parse_)) (shen.pair (hd Parse_) ()) (fail))) YaccParse))) -(defun shen. (V2845) (if (cons? (hd V2845)) (let Parse_X (shen.hdhd V2845) (if (= Parse_X ;) (shen.pair (hd (shen.pair (shen.tlhd V2845) (shen.hdtl V2845))) shen.skip) (fail))) (fail))) +(defun shen. (V1684) (if (cons? (hd V1684)) (let Parse_X (shen.hdhd V1684) (if (= Parse_X ;) (shen.pair (hd (shen.pair (shen.tlhd V1684) (shen.hdtl V1684))) shen.skip) (fail))) (fail))) -(defun shen. (V2849) (let YaccParse (if (and (cons? (hd V2849)) (= ! (shen.hdhd V2849))) (let NewStream2846 (shen.pair (shen.tlhd V2849) (shen.hdtl V2849)) (shen.pair (hd NewStream2846) !)) (fail)) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V2849) (if (not (= (fail) Parse_shen.)) (if (and (cons? (hd Parse_shen.)) (= >> (shen.hdhd Parse_shen.))) (let NewStream2847 (shen.pair (shen.tlhd Parse_shen.) (shen.hdtl Parse_shen.)) (let Parse_shen. (shen. NewStream2847) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.sequent (shen.hdtl Parse_shen.) (shen.hdtl Parse_shen.))) (fail)))) (fail)) (fail))) (if (= YaccParse (fail)) (let Parse_shen. (shen. V2849) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.sequent () (shen.hdtl Parse_shen.))) (fail))) YaccParse)) YaccParse))) +(defun shen. (V1688) (let YaccParse (if (and (cons? (hd V1688)) (= ! (shen.hdhd V1688))) (let NewStream1685 (shen.pair (shen.tlhd V1688) (shen.hdtl V1688)) (shen.pair (hd NewStream1685) !)) (fail)) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V1688) (if (not (= (fail) Parse_shen.)) (if (and (cons? (hd Parse_shen.)) (= >> (shen.hdhd Parse_shen.))) (let NewStream1686 (shen.pair (shen.tlhd Parse_shen.) (shen.hdtl Parse_shen.)) (let Parse_shen. (shen. NewStream1686) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.sequent (shen.hdtl Parse_shen.) (shen.hdtl Parse_shen.))) (fail)))) (fail)) (fail))) (if (= YaccParse (fail)) (let Parse_shen. (shen. V1688) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.sequent () (shen.hdtl Parse_shen.))) (fail))) YaccParse)) YaccParse))) -(defun shen. (V2852) (let YaccParse (let Parse_shen. (shen. V2852) (if (not (= (fail) Parse_shen.)) (if (and (cons? (hd Parse_shen.)) (= >> (shen.hdhd Parse_shen.))) (let NewStream2850 (shen.pair (shen.tlhd Parse_shen.) (shen.hdtl Parse_shen.)) (let Parse_shen. (shen. NewStream2850) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.sequent (shen.hdtl Parse_shen.) (shen.hdtl Parse_shen.))) (fail))) (fail)))) (fail)) (fail))) (if (= YaccParse (fail)) (let Parse_shen. (shen. V2852) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.sequent () (shen.hdtl Parse_shen.))) (fail))) (fail))) YaccParse))) +(defun shen. (V1691) (let YaccParse (let Parse_shen. (shen. V1691) (if (not (= (fail) Parse_shen.)) (if (and (cons? (hd Parse_shen.)) (= >> (shen.hdhd Parse_shen.))) (let NewStream1689 (shen.pair (shen.tlhd Parse_shen.) (shen.hdtl Parse_shen.)) (let Parse_shen. (shen. NewStream1689) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.sequent (shen.hdtl Parse_shen.) (shen.hdtl Parse_shen.))) (fail))) (fail)))) (fail)) (fail))) (if (= YaccParse (fail)) (let Parse_shen. (shen. V1691) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.sequent () (shen.hdtl Parse_shen.))) (fail))) (fail))) YaccParse))) -(defun shen.sequent (V2855 V2856) (@p V2855 V2856)) +(defun shen.sequent (V1694 V1695) (@p V1694 V1695)) -(defun shen. (V2858) (let YaccParse (let Parse_shen. (shen. V2858) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (shen.hdtl Parse_shen.) (shen.hdtl Parse_shen.))) (fail))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V2858) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (shen.hdtl Parse_shen.) ())) (fail))) (if (= YaccParse (fail)) (let Parse_ ( V2858) (if (not (= (fail) Parse_)) (shen.pair (hd Parse_) ()) (fail))) YaccParse)) YaccParse))) +(defun shen. (V1697) (let YaccParse (let Parse_shen. (shen. V1697) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (shen.hdtl Parse_shen.) (shen.hdtl Parse_shen.))) (fail))) (fail))) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen. (shen. V1697) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (shen.hdtl Parse_shen.) ())) (fail))) (if (= YaccParse (fail)) (let Parse_ ( V1697) (if (not (= (fail) Parse_)) (shen.pair (hd Parse_) ()) (fail))) YaccParse)) YaccParse))) -(defun shen. (V2860) (if (cons? (hd V2860)) (let Parse_X (shen.hdhd V2860) (if (= Parse_X (intern ",")) (shen.pair (hd (shen.pair (shen.tlhd V2860) (shen.hdtl V2860))) shen.skip) (fail))) (fail))) +(defun shen. (V1699) (if (cons? (hd V1699)) (let Parse_X (shen.hdhd V1699) (if (= Parse_X (intern ",")) (shen.pair (hd (shen.pair (shen.tlhd V1699) (shen.hdtl V1699))) shen.skip) (fail))) (fail))) -(defun shen. (V2863) (let YaccParse (let Parse_shen. (shen. V2863) (if (not (= (fail) Parse_shen.)) (if (and (cons? (hd Parse_shen.)) (= : (shen.hdhd Parse_shen.))) (let NewStream2861 (shen.pair (shen.tlhd Parse_shen.) (shen.hdtl Parse_shen.)) (let Parse_shen. (shen. NewStream2861) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (shen.curry (shen.hdtl Parse_shen.)) (cons : (cons (shen.demodulate (shen.hdtl Parse_shen.)) ())))) (fail)))) (fail)) (fail))) (if (= YaccParse (fail)) (let Parse_shen. (shen. V2863) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.hdtl Parse_shen.)) (fail))) YaccParse))) +(defun shen. (V1702) (let YaccParse (let Parse_shen. (shen. V1702) (if (not (= (fail) Parse_shen.)) (if (and (cons? (hd Parse_shen.)) (= : (shen.hdhd Parse_shen.))) (let NewStream1700 (shen.pair (shen.tlhd Parse_shen.) (shen.hdtl Parse_shen.)) (let Parse_shen. (shen. NewStream1700) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (shen.curry (shen.hdtl Parse_shen.)) (cons : (cons (shen.demodulate (shen.hdtl Parse_shen.)) ())))) (fail)))) (fail)) (fail))) (if (= YaccParse (fail)) (let Parse_shen. (shen. V1702) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.hdtl Parse_shen.)) (fail))) YaccParse))) -(defun shen. (V2865) (let Parse_shen. (shen. V2865) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.curry-type (shen.hdtl Parse_shen.))) (fail)))) +(defun shen. (V1704) (let Parse_shen. (shen. V1704) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (shen.curry-type (shen.hdtl Parse_shen.))) (fail)))) -(defun shen. (V2867) (if (cons? (hd V2867)) (let Parse_X (shen.hdhd V2867) (if (shen.doubleunderline? Parse_X) (shen.pair (hd (shen.pair (shen.tlhd V2867) (shen.hdtl V2867))) Parse_X) (fail))) (fail))) +(defun shen. (V1706) (if (cons? (hd V1706)) (let Parse_X (shen.hdhd V1706) (if (shen.doubleunderline? Parse_X) (shen.pair (hd (shen.pair (shen.tlhd V1706) (shen.hdtl V1706))) Parse_X) (fail))) (fail))) -(defun shen. (V2869) (if (cons? (hd V2869)) (let Parse_X (shen.hdhd V2869) (if (shen.singleunderline? Parse_X) (shen.pair (hd (shen.pair (shen.tlhd V2869) (shen.hdtl V2869))) Parse_X) (fail))) (fail))) +(defun shen. (V1708) (if (cons? (hd V1708)) (let Parse_X (shen.hdhd V1708) (if (shen.singleunderline? Parse_X) (shen.pair (hd (shen.pair (shen.tlhd V1708) (shen.hdtl V1708))) Parse_X) (fail))) (fail))) -(defun shen.singleunderline? (V2871) (and (symbol? V2871) (shen.sh? (str V2871)))) +(defun shen.singleunderline? (V1710) (and (symbol? V1710) (shen.sh? (str V1710)))) -(defun shen.sh? (V2873) (cond ((= "_" V2873) true) (true (and (= (pos V2873 0) "_") (shen.sh? (tlstr V2873)))))) +(defun shen.sh? (V1712) (cond ((= "_" V1712) true) (true (and (= (pos V1712 0) "_") (shen.sh? (tlstr V1712)))))) -(defun shen.doubleunderline? (V2875) (and (symbol? V2875) (shen.dh? (str V2875)))) +(defun shen.doubleunderline? (V1714) (and (symbol? V1714) (shen.dh? (str V1714)))) -(defun shen.dh? (V2877) (cond ((= "=" V2877) true) (true (and (= (pos V2877 0) "=") (shen.dh? (tlstr V2877)))))) +(defun shen.dh? (V1716) (cond ((= "=" V1716) true) (true (and (= (pos V1716 0) "=") (shen.dh? (tlstr V1716)))))) -(defun shen.process-datatype (V2880 V2881) (shen.remember-datatype (shen.s-prolog (shen.rules->horn-clauses V2880 V2881)))) +(defun shen.process-datatype (V1719 V1720) (shen.remember-datatype (shen.s-prolog (shen.rules->horn-clauses V1719 V1720)))) -(defun shen.remember-datatype (V2887) (cond ((cons? V2887) (do (set shen.*datatypes* (adjoin (hd V2887) (value shen.*datatypes*))) (do (set shen.*alldatatypes* (adjoin (hd V2887) (value shen.*alldatatypes*))) (hd V2887)))) (true (shen.f_error shen.remember-datatype)))) +(defun shen.remember-datatype (V1726) (cond ((cons? V1726) (do (set shen.*datatypes* (adjoin (hd V1726) (value shen.*datatypes*))) (do (set shen.*alldatatypes* (adjoin (hd V1726) (value shen.*alldatatypes*))) (hd V1726)))) (true (shen.f_error shen.remember-datatype)))) -(defun shen.rules->horn-clauses (V2892 V2893) (cond ((= () V2893) ()) ((and (cons? V2893) (and (tuple? (hd V2893)) (= shen.single (fst (hd V2893))))) (cons (shen.rule->horn-clause V2892 (snd (hd V2893))) (shen.rules->horn-clauses V2892 (tl V2893)))) ((and (cons? V2893) (and (tuple? (hd V2893)) (= shen.double (fst (hd V2893))))) (shen.rules->horn-clauses V2892 (append (shen.double->singles (snd (hd V2893))) (tl V2893)))) (true (shen.f_error shen.rules->horn-clauses)))) +(defun shen.rules->horn-clauses (V1731 V1732) (cond ((= () V1732) ()) ((and (cons? V1732) (and (tuple? (hd V1732)) (= shen.single (fst (hd V1732))))) (cons (shen.rule->horn-clause V1731 (snd (hd V1732))) (shen.rules->horn-clauses V1731 (tl V1732)))) ((and (cons? V1732) (and (tuple? (hd V1732)) (= shen.double (fst (hd V1732))))) (shen.rules->horn-clauses V1731 (append (shen.double->singles (snd (hd V1732))) (tl V1732)))) (true (shen.f_error shen.rules->horn-clauses)))) -(defun shen.double->singles (V2895) (cons (shen.right-rule V2895) (cons (shen.left-rule V2895) ()))) +(defun shen.double->singles (V1734) (cons (shen.right-rule V1734) (cons (shen.left-rule V1734) ()))) -(defun shen.right-rule (V2897) (@p shen.single V2897)) +(defun shen.right-rule (V1736) (@p shen.single V1736)) -(defun shen.left-rule (V2899) (cond ((and (cons? V2899) (and (cons? (tl V2899)) (and (cons? (tl (tl V2899))) (and (tuple? (hd (tl (tl V2899)))) (and (= () (fst (hd (tl (tl V2899))))) (= () (tl (tl (tl V2899))))))))) (let Q (gensym Qv) (let NewConclusion (@p (cons (snd (hd (tl (tl V2899)))) ()) Q) (let NewPremises (cons (@p (map (lambda X (shen.right->left X)) (hd (tl V2899))) Q) ()) (@p shen.single (cons (hd V2899) (cons NewPremises (cons NewConclusion ())))))))) (true (shen.f_error shen.left-rule)))) +(defun shen.left-rule (V1738) (cond ((and (cons? V1738) (and (cons? (tl V1738)) (and (cons? (tl (tl V1738))) (and (tuple? (hd (tl (tl V1738)))) (and (= () (fst (hd (tl (tl V1738))))) (= () (tl (tl (tl V1738))))))))) (let Q (gensym Qv) (let NewConclusion (@p (cons (snd (hd (tl (tl V1738)))) ()) Q) (let NewPremises (cons (@p (map (lambda X (shen.right->left X)) (hd (tl V1738))) Q) ()) (@p shen.single (cons (hd V1738) (cons NewPremises (cons NewConclusion ())))))))) (true (shen.f_error shen.left-rule)))) -(defun shen.right->left (V2905) (cond ((and (tuple? V2905) (= () (fst V2905))) (snd V2905)) (true (simple-error "syntax error with ========== +(defun shen.right->left (V1744) (cond ((and (tuple? V1744) (= () (fst V1744))) (snd V1744)) (true (simple-error "syntax error with ========== ")))) -(defun shen.rule->horn-clause (V2908 V2909) (cond ((and (cons? V2909) (and (cons? (tl V2909)) (and (cons? (tl (tl V2909))) (and (tuple? (hd (tl (tl V2909)))) (= () (tl (tl (tl V2909)))))))) (cons (shen.rule->horn-clause-head V2908 (snd (hd (tl (tl V2909))))) (cons :- (cons (shen.rule->horn-clause-body (hd V2909) (hd (tl V2909)) (fst (hd (tl (tl V2909))))) ())))) (true (shen.f_error shen.rule->horn-clause)))) +(defun shen.rule->horn-clause (V1747 V1748) (cond ((and (cons? V1748) (and (cons? (tl V1748)) (and (cons? (tl (tl V1748))) (and (tuple? (hd (tl (tl V1748)))) (= () (tl (tl (tl V1748)))))))) (cons (shen.rule->horn-clause-head V1747 (snd (hd (tl (tl V1748))))) (cons :- (cons (shen.rule->horn-clause-body (hd V1748) (hd (tl V1748)) (fst (hd (tl (tl V1748))))) ())))) (true (shen.f_error shen.rule->horn-clause)))) -(defun shen.rule->horn-clause-head (V2912 V2913) (cons V2912 (cons (shen.mode-ify V2913) (cons Context_1957 ())))) +(defun shen.rule->horn-clause-head (V1751 V1752) (cons V1751 (cons (shen.mode-ify V1752) (cons Context_1957 ())))) -(defun shen.mode-ify (V2915) (cond ((and (cons? V2915) (and (cons? (tl V2915)) (and (= : (hd (tl V2915))) (and (cons? (tl (tl V2915))) (= () (tl (tl (tl V2915)))))))) (cons mode (cons (cons (hd V2915) (cons : (cons (cons mode (cons (hd (tl (tl V2915))) (cons + ()))) ()))) (cons - ())))) (true V2915))) +(defun shen.mode-ify (V1754) (cond ((and (cons? V1754) (and (cons? (tl V1754)) (and (= : (hd (tl V1754))) (and (cons? (tl (tl V1754))) (= () (tl (tl (tl V1754)))))))) (cons mode (cons (cons (hd V1754) (cons : (cons (cons mode (cons (hd (tl (tl V1754))) (cons + ()))) ()))) (cons - ())))) (true V1754))) -(defun shen.rule->horn-clause-body (V2919 V2920 V2921) (let Variables (map (lambda X (shen.extract_vars X)) V2921) (let Predicates (map (lambda X (gensym shen.cl)) V2921) (let SearchLiterals (shen.construct-search-literals Predicates Variables Context_1957 Context1_1957) (let SearchClauses (shen.construct-search-clauses Predicates V2921 Variables) (let SideLiterals (shen.construct-side-literals V2919) (let PremissLiterals (map (lambda X (shen.construct-premiss-literal X (empty? V2921))) V2920) (append SearchLiterals (append SideLiterals PremissLiterals))))))))) +(defun shen.rule->horn-clause-body (V1758 V1759 V1760) (let Variables (map (lambda X (shen.extract_vars X)) V1760) (let Predicates (map (lambda X (gensym shen.cl)) V1760) (let SearchLiterals (shen.construct-search-literals Predicates Variables Context_1957 Context1_1957) (let SearchClauses (shen.construct-search-clauses Predicates V1760 Variables) (let SideLiterals (shen.construct-side-literals V1758) (let PremissLiterals (map (lambda X (shen.construct-premiss-literal X (empty? V1760))) V1759) (append SearchLiterals (append SideLiterals PremissLiterals))))))))) -(defun shen.construct-search-literals (V2930 V2931 V2932 V2933) (cond ((and (= () V2930) (= () V2931)) ()) (true (shen.csl-help V2930 V2931 V2932 V2933)))) +(defun shen.construct-search-literals (V1769 V1770 V1771 V1772) (cond ((and (= () V1769) (= () V1770)) ()) (true (shen.csl-help V1769 V1770 V1771 V1772)))) -(defun shen.csl-help (V2940 V2941 V2942 V2943) (cond ((and (= () V2940) (= () V2941)) (cons (cons bind (cons ContextOut_1957 (cons V2942 ()))) ())) ((and (cons? V2940) (cons? V2941)) (cons (cons (hd V2940) (cons V2942 (cons V2943 (hd V2941)))) (shen.csl-help (tl V2940) (tl V2941) V2943 (gensym Context)))) (true (shen.f_error shen.csl-help)))) +(defun shen.csl-help (V1779 V1780 V1781 V1782) (cond ((and (= () V1779) (= () V1780)) (cons (cons bind (cons ContextOut_1957 (cons V1781 ()))) ())) ((and (cons? V1779) (cons? V1780)) (cons (cons (hd V1779) (cons V1781 (cons V1782 (hd V1780)))) (shen.csl-help (tl V1779) (tl V1780) V1782 (gensym Context)))) (true (shen.f_error shen.csl-help)))) -(defun shen.construct-search-clauses (V2947 V2948 V2949) (cond ((and (= () V2947) (and (= () V2948) (= () V2949))) shen.skip) ((and (cons? V2947) (and (cons? V2948) (cons? V2949))) (do (shen.construct-search-clause (hd V2947) (hd V2948) (hd V2949)) (shen.construct-search-clauses (tl V2947) (tl V2948) (tl V2949)))) (true (shen.f_error shen.construct-search-clauses)))) +(defun shen.construct-search-clauses (V1786 V1787 V1788) (cond ((and (= () V1786) (and (= () V1787) (= () V1788))) shen.skip) ((and (cons? V1786) (and (cons? V1787) (cons? V1788))) (do (shen.construct-search-clause (hd V1786) (hd V1787) (hd V1788)) (shen.construct-search-clauses (tl V1786) (tl V1787) (tl V1788)))) (true (shen.f_error shen.construct-search-clauses)))) -(defun shen.construct-search-clause (V2953 V2954 V2955) (shen.s-prolog (cons (shen.construct-base-search-clause V2953 V2954 V2955) (cons (shen.construct-recursive-search-clause V2953 V2954 V2955) ())))) +(defun shen.construct-search-clause (V1792 V1793 V1794) (shen.s-prolog (cons (shen.construct-base-search-clause V1792 V1793 V1794) (cons (shen.construct-recursive-search-clause V1792 V1793 V1794) ())))) -(defun shen.construct-base-search-clause (V2959 V2960 V2961) (cons (cons V2959 (cons (cons (shen.mode-ify V2960) In_1957) (cons In_1957 V2961))) (cons :- (cons () ())))) +(defun shen.construct-base-search-clause (V1798 V1799 V1800) (cons (cons V1798 (cons (cons (shen.mode-ify V1799) In_1957) (cons In_1957 V1800))) (cons :- (cons () ())))) -(defun shen.construct-recursive-search-clause (V2965 V2966 V2967) (cons (cons V2965 (cons (cons Assumption_1957 Assumptions_1957) (cons (cons Assumption_1957 Out_1957) V2967))) (cons :- (cons (cons (cons V2965 (cons Assumptions_1957 (cons Out_1957 V2967))) ()) ())))) +(defun shen.construct-recursive-search-clause (V1804 V1805 V1806) (cons (cons V1804 (cons (cons Assumption_1957 Assumptions_1957) (cons (cons Assumption_1957 Out_1957) V1806))) (cons :- (cons (cons (cons V1804 (cons Assumptions_1957 (cons Out_1957 V1806))) ()) ())))) -(defun shen.construct-side-literals (V2973) (cond ((= () V2973) ()) ((and (cons? V2973) (and (cons? (hd V2973)) (and (= if (hd (hd V2973))) (and (cons? (tl (hd V2973))) (= () (tl (tl (hd V2973)))))))) (cons (cons when (tl (hd V2973))) (shen.construct-side-literals (tl V2973)))) ((and (cons? V2973) (and (cons? (hd V2973)) (and (= let (hd (hd V2973))) (and (cons? (tl (hd V2973))) (and (cons? (tl (tl (hd V2973)))) (= () (tl (tl (tl (hd V2973)))))))))) (cons (cons is (tl (hd V2973))) (shen.construct-side-literals (tl V2973)))) ((cons? V2973) (shen.construct-side-literals (tl V2973))) (true (shen.f_error shen.construct-side-literals)))) +(defun shen.construct-side-literals (V1812) (cond ((= () V1812) ()) ((and (cons? V1812) (and (cons? (hd V1812)) (and (= if (hd (hd V1812))) (and (cons? (tl (hd V1812))) (= () (tl (tl (hd V1812)))))))) (cons (cons when (tl (hd V1812))) (shen.construct-side-literals (tl V1812)))) ((and (cons? V1812) (and (cons? (hd V1812)) (and (= let (hd (hd V1812))) (and (cons? (tl (hd V1812))) (and (cons? (tl (tl (hd V1812)))) (= () (tl (tl (tl (hd V1812)))))))))) (cons (cons is (tl (hd V1812))) (shen.construct-side-literals (tl V1812)))) ((cons? V1812) (shen.construct-side-literals (tl V1812))) (true (shen.f_error shen.construct-side-literals)))) -(defun shen.construct-premiss-literal (V2980 V2981) (cond ((tuple? V2980) (cons shen.t* (cons (shen.recursive_cons_form (snd V2980)) (cons (shen.construct-context V2981 (fst V2980)) ())))) ((= ! V2980) (cons cut (cons Throwcontrol ()))) (true (shen.f_error shen.construct-premiss-literal)))) +(defun shen.construct-premiss-literal (V1819 V1820) (cond ((tuple? V1819) (cons shen.t* (cons (shen.recursive_cons_form (snd V1819)) (cons (shen.construct-context V1820 (fst V1819)) ())))) ((= ! V1819) (cons cut (cons Throwcontrol ()))) (true (shen.f_error shen.construct-premiss-literal)))) -(defun shen.construct-context (V2984 V2985) (cond ((and (= true V2984) (= () V2985)) Context_1957) ((and (= false V2984) (= () V2985)) ContextOut_1957) ((cons? V2985) (cons cons (cons (shen.recursive_cons_form (hd V2985)) (cons (shen.construct-context V2984 (tl V2985)) ())))) (true (shen.f_error shen.construct-context)))) +(defun shen.construct-context (V1823 V1824) (cond ((and (= true V1823) (= () V1824)) Context_1957) ((and (= false V1823) (= () V1824)) ContextOut_1957) ((cons? V1824) (cons cons (cons (shen.recursive_cons_form (hd V1824)) (cons (shen.construct-context V1823 (tl V1824)) ())))) (true (shen.f_error shen.construct-context)))) -(defun shen.recursive_cons_form (V2987) (cond ((cons? V2987) (cons cons (cons (shen.recursive_cons_form (hd V2987)) (cons (shen.recursive_cons_form (tl V2987)) ())))) (true V2987))) +(defun shen.recursive_cons_form (V1826) (cond ((cons? V1826) (cons cons (cons (shen.recursive_cons_form (hd V1826)) (cons (shen.recursive_cons_form (tl V1826)) ())))) (true V1826))) -(defun preclude (V2989) (shen.preclude-h (map (lambda X (shen.intern-type X)) V2989))) +(defun preclude (V1828) (shen.preclude-h (map (lambda X (shen.intern-type X)) V1828))) -(defun shen.preclude-h (V2991) (let FilterDatatypes (set shen.*datatypes* (difference (value shen.*datatypes*) V2991)) (value shen.*datatypes*))) +(defun shen.preclude-h (V1830) (let FilterDatatypes (set shen.*datatypes* (difference (value shen.*datatypes*) V1830)) (value shen.*datatypes*))) -(defun include (V2993) (shen.include-h (map (lambda X (shen.intern-type X)) V2993))) +(defun include (V1832) (shen.include-h (map (lambda X (shen.intern-type X)) V1832))) -(defun shen.include-h (V2995) (let ValidTypes (intersection V2995 (value shen.*alldatatypes*)) (let NewDatatypes (set shen.*datatypes* (union ValidTypes (value shen.*datatypes*))) (value shen.*datatypes*)))) +(defun shen.include-h (V1834) (let ValidTypes (intersection V1834 (value shen.*alldatatypes*)) (let NewDatatypes (set shen.*datatypes* (union ValidTypes (value shen.*datatypes*))) (value shen.*datatypes*)))) -(defun preclude-all-but (V2997) (shen.preclude-h (difference (value shen.*alldatatypes*) (map (lambda X (shen.intern-type X)) V2997)))) +(defun preclude-all-but (V1836) (shen.preclude-h (difference (value shen.*alldatatypes*) (map (lambda X (shen.intern-type X)) V1836)))) -(defun include-all-but (V2999) (shen.include-h (difference (value shen.*alldatatypes*) (map (lambda X (shen.intern-type X)) V2999)))) +(defun include-all-but (V1838) (shen.include-h (difference (value shen.*alldatatypes*) (map (lambda X (shen.intern-type X)) V1838)))) -(defun shen.synonyms-help (V3005) (cond ((= () V3005) (shen.update-demodulation-function (value shen.*tc*) (mapcan (lambda X (shen.demod-rule X)) (value shen.*synonyms*)))) ((and (cons? V3005) (cons? (tl V3005))) (let Vs (difference (shen.extract_vars (hd (tl V3005))) (shen.extract_vars (hd V3005))) (if (empty? Vs) (do (shen.pushnew (cons (hd V3005) (cons (hd (tl V3005)) ())) shen.*synonyms*) (shen.synonyms-help (tl (tl V3005)))) (shen.free_variable_warnings (hd (tl V3005)) Vs)))) (true (simple-error "odd number of synonyms +(defun shen.synonyms-help (V1844) (cond ((= () V1844) (shen.update-demodulation-function (value shen.*tc*) (mapcan (lambda X (shen.demod-rule X)) (value shen.*synonyms*)))) ((and (cons? V1844) (cons? (tl V1844))) (let Vs (difference (shen.extract_vars (hd (tl V1844))) (shen.extract_vars (hd V1844))) (if (empty? Vs) (do (shen.pushnew (cons (hd V1844) (cons (hd (tl V1844)) ())) shen.*synonyms*) (shen.synonyms-help (tl (tl V1844)))) (shen.free_variable_warnings (hd (tl V1844)) Vs)))) (true (simple-error "odd number of synonyms ")))) -(defun shen.pushnew (V3008 V3009) (if (element? V3008 (value V3009)) (value V3009) (set V3009 (cons V3008 (value V3009))))) +(defun shen.pushnew (V1847 V1848) (if (element? V1847 (value V1848)) (value V1848) (set V1848 (cons V1847 (value V1848))))) -(defun shen.demod-rule (V3011) (cond ((and (cons? V3011) (and (cons? (tl V3011)) (= () (tl (tl V3011))))) (cons (shen.rcons_form (hd V3011)) (cons -> (cons (shen.rcons_form (hd (tl V3011))) ())))) (true (shen.f_error shen.demod-rule)))) +(defun shen.demod-rule (V1850) (cond ((and (cons? V1850) (and (cons? (tl V1850)) (= () (tl (tl V1850))))) (cons (shen.rcons_form (hd V1850)) (cons -> (cons (shen.rcons_form (hd (tl V1850))) ())))) (true (shen.f_error shen.demod-rule)))) -(defun shen.lambda-of-defun (V3017) (cond ((and (cons? V3017) (and (= defun (hd V3017)) (and (cons? (tl V3017)) (and (cons? (tl (tl V3017))) (and (cons? (hd (tl (tl V3017)))) (and (= () (tl (hd (tl (tl V3017))))) (and (cons? (tl (tl (tl V3017)))) (= () (tl (tl (tl (tl V3017)))))))))))) (eval (cons /. (cons (hd (hd (tl (tl V3017)))) (tl (tl (tl V3017))))))) (true (shen.f_error shen.lambda-of-defun)))) +(defun shen.lambda-of-defun (V1856) (cond ((and (cons? V1856) (and (= defun (hd V1856)) (and (cons? (tl V1856)) (and (cons? (tl (tl V1856))) (and (cons? (hd (tl (tl V1856)))) (and (= () (tl (hd (tl (tl V1856))))) (and (cons? (tl (tl (tl V1856)))) (= () (tl (tl (tl (tl V1856)))))))))))) (eval (cons /. (cons (hd (hd (tl (tl V1856)))) (tl (tl (tl V1856))))))) (true (shen.f_error shen.lambda-of-defun)))) -(defun shen.update-demodulation-function (V3020 V3021) (do (tc -) (do (set shen.*demodulation-function* (shen.lambda-of-defun (shen.elim-def (cons define (cons shen.demod (append V3021 (shen.default-rule))))))) (do (if V3020 (tc +) shen.skip) synonyms)))) +(defun shen.update-demodulation-function (V1859 V1860) (do (tc -) (do (set shen.*demodulation-function* (shen.lambda-of-defun (shen.elim-def (cons define (cons shen.demod (append V1860 (shen.default-rule))))))) (do (if V1859 (tc +) shen.skip) synonyms)))) (defun shen.default-rule () (cons X (cons -> (cons X ())))) diff --git a/kl/sys.kl b/kl/sys.kl index 9c77c13..648bec0 100644 --- a/kl/sys.kl +++ b/kl/sys.kl @@ -28,217 +28,217 @@ OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. " -(defun thaw (V3023) (V3023)) +(defun thaw (V1862) (V1862)) -(defun eval (V3025) (let Macroexpand (shen.walk (lambda Y (macroexpand Y)) V3025) (if (shen.packaged? Macroexpand) (map (lambda Z (shen.eval-without-macros Z)) (shen.package-contents Macroexpand)) (shen.eval-without-macros Macroexpand)))) +(defun eval (V1864) (let Macroexpand (shen.walk (lambda Y (macroexpand Y)) V1864) (if (shen.packaged? Macroexpand) (map (lambda Z (shen.eval-without-macros Z)) (shen.package-contents Macroexpand)) (shen.eval-without-macros Macroexpand)))) -(defun shen.eval-without-macros (V3027) (eval-kl (shen.elim-def (shen.proc-input+ V3027)))) +(defun shen.eval-without-macros (V1866) (eval-kl (shen.elim-def (shen.proc-input+ V1866)))) -(defun shen.proc-input+ (V3029) (cond ((and (cons? V3029) (and (= input+ (hd V3029)) (and (cons? (tl V3029)) (and (cons? (tl (tl V3029))) (= () (tl (tl (tl V3029)))))))) (cons input+ (cons (shen.rcons_form (hd (tl V3029))) (tl (tl V3029))))) ((and (cons? V3029) (and (= shen.read+ (hd V3029)) (and (cons? (tl V3029)) (and (cons? (tl (tl V3029))) (= () (tl (tl (tl V3029)))))))) (cons shen.read+ (cons (shen.rcons_form (hd (tl V3029))) (tl (tl V3029))))) ((cons? V3029) (map (lambda Z (shen.proc-input+ Z)) V3029)) (true V3029))) +(defun shen.proc-input+ (V1868) (cond ((and (cons? V1868) (and (= input+ (hd V1868)) (and (cons? (tl V1868)) (and (cons? (tl (tl V1868))) (= () (tl (tl (tl V1868)))))))) (cons input+ (cons (shen.rcons_form (hd (tl V1868))) (tl (tl V1868))))) ((and (cons? V1868) (and (= shen.read+ (hd V1868)) (and (cons? (tl V1868)) (and (cons? (tl (tl V1868))) (= () (tl (tl (tl V1868)))))))) (cons shen.read+ (cons (shen.rcons_form (hd (tl V1868))) (tl (tl V1868))))) ((cons? V1868) (map (lambda Z (shen.proc-input+ Z)) V1868)) (true V1868))) -(defun shen.elim-def (V3031) (cond ((and (cons? V3031) (and (= define (hd V3031)) (cons? (tl V3031)))) (shen.shen->kl (hd (tl V3031)) (tl (tl V3031)))) ((and (cons? V3031) (and (= defmacro (hd V3031)) (cons? (tl V3031)))) (let Default (cons X (cons -> (cons X ()))) (let Def (shen.elim-def (cons define (cons (hd (tl V3031)) (append (tl (tl V3031)) Default)))) (let MacroAdd (shen.add-macro (hd (tl V3031))) Def)))) ((and (cons? V3031) (and (= defcc (hd V3031)) (cons? (tl V3031)))) (shen.elim-def (shen.yacc V3031))) ((cons? V3031) (map (lambda Z (shen.elim-def Z)) V3031)) (true V3031))) +(defun shen.elim-def (V1870) (cond ((and (cons? V1870) (and (= define (hd V1870)) (cons? (tl V1870)))) (shen.shen->kl (hd (tl V1870)) (tl (tl V1870)))) ((and (cons? V1870) (and (= defmacro (hd V1870)) (cons? (tl V1870)))) (let Default (cons X (cons -> (cons X ()))) (let Def (shen.elim-def (cons define (cons (hd (tl V1870)) (append (tl (tl V1870)) Default)))) (let MacroAdd (shen.add-macro (hd (tl V1870))) Def)))) ((and (cons? V1870) (and (= defcc (hd V1870)) (cons? (tl V1870)))) (shen.elim-def (shen.yacc V1870))) ((cons? V1870) (map (lambda Z (shen.elim-def Z)) V1870)) (true V1870))) -(defun shen.add-macro (V3033) (let MacroReg (value shen.*macroreg*) (let NewMacroReg (set shen.*macroreg* (adjoin V3033 (value shen.*macroreg*))) (if (= MacroReg NewMacroReg) shen.skip (set *macros* (cons (function V3033) (value *macros*))))))) +(defun shen.add-macro (V1872) (let MacroReg (value shen.*macroreg*) (let NewMacroReg (set shen.*macroreg* (adjoin V1872 (value shen.*macroreg*))) (if (= MacroReg NewMacroReg) shen.skip (set *macros* (cons (function V1872) (value *macros*))))))) -(defun shen.packaged? (V3041) (cond ((and (cons? V3041) (and (= package (hd V3041)) (and (cons? (tl V3041)) (cons? (tl (tl V3041)))))) true) (true false))) +(defun shen.packaged? (V1880) (cond ((and (cons? V1880) (and (= package (hd V1880)) (and (cons? (tl V1880)) (cons? (tl (tl V1880)))))) true) (true false))) -(defun external (V3043) (trap-error (get V3043 shen.external-symbols (value *property-vector*)) (lambda E (simple-error (cn "package " (shen.app V3043 " has not been used. +(defun external (V1882) (trap-error (get V1882 shen.external-symbols (value *property-vector*)) (lambda E (simple-error (cn "package " (shen.app V1882 " has not been used. " shen.a)))))) -(defun internal (V3045) (trap-error (get V3045 shen.internal-symbols (value *property-vector*)) (lambda E (simple-error (cn "package " (shen.app V3045 " has not been used. +(defun internal (V1884) (trap-error (get V1884 shen.internal-symbols (value *property-vector*)) (lambda E (simple-error (cn "package " (shen.app V1884 " has not been used. " shen.a)))))) -(defun shen.package-contents (V3049) (cond ((and (cons? V3049) (and (= package (hd V3049)) (and (cons? (tl V3049)) (and (= null (hd (tl V3049))) (cons? (tl (tl V3049))))))) (tl (tl (tl V3049)))) ((and (cons? V3049) (and (= package (hd V3049)) (and (cons? (tl V3049)) (cons? (tl (tl V3049)))))) (let PackageNameDot (intern (cn (str (hd (tl V3049))) ".")) (let ExpPackageNameDot (explode PackageNameDot) (shen.packageh (hd (tl V3049)) (hd (tl (tl V3049))) (tl (tl (tl V3049))) ExpPackageNameDot)))) (true (shen.f_error shen.package-contents)))) +(defun shen.package-contents (V1888) (cond ((and (cons? V1888) (and (= package (hd V1888)) (and (cons? (tl V1888)) (and (= null (hd (tl V1888))) (cons? (tl (tl V1888))))))) (tl (tl (tl V1888)))) ((and (cons? V1888) (and (= package (hd V1888)) (and (cons? (tl V1888)) (cons? (tl (tl V1888)))))) (let PackageNameDot (intern (cn (str (hd (tl V1888))) ".")) (let ExpPackageNameDot (explode PackageNameDot) (shen.packageh (hd (tl V1888)) (hd (tl (tl V1888))) (tl (tl (tl V1888))) ExpPackageNameDot)))) (true (shen.f_error shen.package-contents)))) -(defun shen.walk (V3052 V3053) (cond ((cons? V3053) (V3052 (map (lambda Z (shen.walk V3052 Z)) V3053))) (true (V3052 V3053)))) +(defun shen.walk (V1891 V1892) (cond ((cons? V1892) (V1891 (map (lambda Z (shen.walk V1891 Z)) V1892))) (true (V1891 V1892)))) -(defun compile (V3057 V3058 V3059) (let O (V3057 (cons V3058 (cons () ()))) (if (or (= (fail) O) (not (empty? (hd O)))) (V3059 O) (shen.hdtl O)))) +(defun compile (V1896 V1897 V1898) (let O (V1896 (cons V1897 (cons () ()))) (if (or (= (fail) O) (not (empty? (hd O)))) (V1898 O) (shen.hdtl O)))) -(defun fail-if (V3062 V3063) (if (V3062 V3063) (fail) V3063)) +(defun fail-if (V1901 V1902) (if (V1901 V1902) (fail) V1902)) -(defun @s (V3066 V3067) (cn V3066 V3067)) +(defun @s (V1905 V1906) (cn V1905 V1906)) (defun tc? () (value shen.*tc*)) -(defun ps (V3069) (trap-error (get V3069 shen.source (value *property-vector*)) (lambda E (simple-error (shen.app V3069 " not found. +(defun ps (V1908) (trap-error (get V1908 shen.source (value *property-vector*)) (lambda E (simple-error (shen.app V1908 " not found. " shen.a))))) (defun stinput () (value *stinput*)) -(defun vector (V3071) (let Vector (absvector (+ V3071 1)) (let ZeroStamp (address-> Vector 0 V3071) (let Standard (if (= V3071 0) ZeroStamp (shen.fillvector ZeroStamp 1 V3071 (fail))) Standard)))) +(defun vector (V1910) (let Vector (absvector (+ V1910 1)) (let ZeroStamp (address-> Vector 0 V1910) (let Standard (if (= V1910 0) ZeroStamp (shen.fillvector ZeroStamp 1 V1910 (fail))) Standard)))) -(defun shen.fillvector (V3077 V3078 V3079 V3080) (cond ((= V3079 V3078) (address-> V3077 V3079 V3080)) (true (shen.fillvector (address-> V3077 V3078 V3080) (+ 1 V3078) V3079 V3080)))) +(defun shen.fillvector (V1916 V1917 V1918 V1919) (cond ((= V1918 V1917) (address-> V1916 V1918 V1919)) (true (shen.fillvector (address-> V1916 V1917 V1919) (+ 1 V1917) V1918 V1919)))) -(defun vector? (V3082) (and (absvector? V3082) (let X (trap-error (<-address V3082 0) (lambda E -1)) (and (number? X) (>= X 0))))) +(defun vector? (V1921) (and (absvector? V1921) (let X (trap-error (<-address V1921 0) (lambda E -1)) (and (number? X) (>= X 0))))) -(defun vector-> (V3086 V3087 V3088) (if (= V3087 0) (simple-error "cannot access 0th element of a vector -") (address-> V3086 V3087 V3088))) +(defun vector-> (V1925 V1926 V1927) (if (= V1926 0) (simple-error "cannot access 0th element of a vector +") (address-> V1925 V1926 V1927))) -(defun <-vector (V3091 V3092) (if (= V3092 0) (simple-error "cannot access 0th element of a vector -") (let VectorElement (<-address V3091 V3092) (if (= VectorElement (fail)) (simple-error "vector element not found +(defun <-vector (V1930 V1931) (if (= V1931 0) (simple-error "cannot access 0th element of a vector +") (let VectorElement (<-address V1930 V1931) (if (= VectorElement (fail)) (simple-error "vector element not found ") VectorElement)))) -(defun shen.posint? (V3094) (and (integer? V3094) (>= V3094 0))) +(defun shen.posint? (V1933) (and (integer? V1933) (>= V1933 0))) -(defun limit (V3096) (<-address V3096 0)) +(defun limit (V1935) (<-address V1935 0)) -(defun symbol? (V3098) (cond ((or (boolean? V3098) (or (number? V3098) (string? V3098))) false) (true (trap-error (let String (str V3098) (shen.analyse-symbol? String)) (lambda E false))))) +(defun symbol? (V1937) (cond ((or (boolean? V1937) (or (number? V1937) (string? V1937))) false) (true (trap-error (let String (str V1937) (shen.analyse-symbol? String)) (lambda E false))))) -(defun shen.analyse-symbol? (V3100) (cond ((= "" V3100) false) ((shen.+string? V3100) (and (shen.alpha? (pos V3100 0)) (shen.alphanums? (tlstr V3100)))) (true (shen.f_error shen.analyse-symbol?)))) +(defun shen.analyse-symbol? (V1939) (cond ((= "" V1939) false) ((shen.+string? V1939) (and (shen.alpha? (pos V1939 0)) (shen.alphanums? (tlstr V1939)))) (true (shen.f_error shen.analyse-symbol?)))) -(defun shen.alpha? (V3102) (element? V3102 (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 "." ()))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) +(defun shen.alpha? (V1941) (element? V1941 (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 "." ()))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) -(defun shen.alphanums? (V3104) (cond ((= "" V3104) true) ((shen.+string? V3104) (and (shen.alphanum? (pos V3104 0)) (shen.alphanums? (tlstr V3104)))) (true (shen.f_error shen.alphanums?)))) +(defun shen.alphanums? (V1943) (cond ((= "" V1943) true) ((shen.+string? V1943) (and (shen.alphanum? (pos V1943 0)) (shen.alphanums? (tlstr V1943)))) (true (shen.f_error shen.alphanums?)))) -(defun shen.alphanum? (V3106) (or (shen.alpha? V3106) (shen.digit? V3106))) +(defun shen.alphanum? (V1945) (or (shen.alpha? V1945) (shen.digit? V1945))) -(defun shen.digit? (V3108) (element? V3108 (cons "1" (cons "2" (cons "3" (cons "4" (cons "5" (cons "6" (cons "7" (cons "8" (cons "9" (cons "0" ())))))))))))) +(defun shen.digit? (V1947) (element? V1947 (cons "1" (cons "2" (cons "3" (cons "4" (cons "5" (cons "6" (cons "7" (cons "8" (cons "9" (cons "0" ())))))))))))) -(defun variable? (V3110) (cond ((or (boolean? V3110) (or (number? V3110) (string? V3110))) false) (true (trap-error (let String (str V3110) (shen.analyse-variable? String)) (lambda E false))))) +(defun variable? (V1949) (cond ((or (boolean? V1949) (or (number? V1949) (string? V1949))) false) (true (trap-error (let String (str V1949) (shen.analyse-variable? String)) (lambda E false))))) -(defun shen.analyse-variable? (V3112) (cond ((shen.+string? V3112) (and (shen.uppercase? (pos V3112 0)) (shen.alphanums? (tlstr V3112)))) (true (shen.f_error shen.analyse-variable?)))) +(defun shen.analyse-variable? (V1951) (cond ((shen.+string? V1951) (and (shen.uppercase? (pos V1951 0)) (shen.alphanums? (tlstr V1951)))) (true (shen.f_error shen.analyse-variable?)))) -(defun shen.uppercase? (V3114) (element? V3114 (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" ())))))))))))))))))))))))))))) +(defun shen.uppercase? (V1953) (element? V1953 (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" ())))))))))))))))))))))))))))) -(defun gensym (V3116) (concat V3116 (set shen.*gensym* (+ 1 (value shen.*gensym*))))) +(defun gensym (V1955) (concat V1955 (set shen.*gensym* (+ 1 (value shen.*gensym*))))) -(defun concat (V3119 V3120) (intern (cn (str V3119) (str V3120)))) +(defun concat (V1958 V1959) (intern (cn (str V1958) (str V1959)))) -(defun @p (V3123 V3124) (let Vector (absvector 3) (let Tag (address-> Vector 0 shen.tuple) (let Fst (address-> Vector 1 V3123) (let Snd (address-> Vector 2 V3124) Vector))))) +(defun @p (V1962 V1963) (let Vector (absvector 3) (let Tag (address-> Vector 0 shen.tuple) (let Fst (address-> Vector 1 V1962) (let Snd (address-> Vector 2 V1963) Vector))))) -(defun fst (V3126) (<-address V3126 1)) +(defun fst (V1965) (<-address V1965 1)) -(defun snd (V3128) (<-address V3128 2)) +(defun snd (V1967) (<-address V1967 2)) -(defun tuple? (V3130) (and (absvector? V3130) (= shen.tuple (trap-error (<-address V3130 0) (lambda E shen.not-tuple))))) +(defun tuple? (V1969) (and (absvector? V1969) (= shen.tuple (trap-error (<-address V1969 0) (lambda E shen.not-tuple))))) -(defun append (V3133 V3134) (cond ((= () V3133) V3134) ((cons? V3133) (cons (hd V3133) (append (tl V3133) V3134))) (true (shen.f_error append)))) +(defun append (V1972 V1973) (cond ((= () V1972) V1973) ((cons? V1972) (cons (hd V1972) (append (tl V1972) V1973))) (true (shen.f_error append)))) -(defun @v (V3137 V3138) (let Limit (limit V3138) (let NewVector (vector (+ Limit 1)) (let X+NewVector (vector-> NewVector 1 V3137) (if (= Limit 0) X+NewVector (shen.@v-help V3138 1 Limit X+NewVector)))))) +(defun @v (V1976 V1977) (let Limit (limit V1977) (let NewVector (vector (+ Limit 1)) (let X+NewVector (vector-> NewVector 1 V1976) (if (= Limit 0) X+NewVector (shen.@v-help V1977 1 Limit X+NewVector)))))) -(defun shen.@v-help (V3144 V3145 V3146 V3147) (cond ((= V3146 V3145) (shen.copyfromvector V3144 V3147 V3146 (+ V3146 1))) (true (shen.@v-help V3144 (+ V3145 1) V3146 (shen.copyfromvector V3144 V3147 V3145 (+ V3145 1)))))) +(defun shen.@v-help (V1983 V1984 V1985 V1986) (cond ((= V1985 V1984) (shen.copyfromvector V1983 V1986 V1985 (+ V1985 1))) (true (shen.@v-help V1983 (+ V1984 1) V1985 (shen.copyfromvector V1983 V1986 V1984 (+ V1984 1)))))) -(defun shen.copyfromvector (V3152 V3153 V3154 V3155) (trap-error (vector-> V3153 V3155 (<-vector V3152 V3154)) (lambda E V3153))) +(defun shen.copyfromvector (V1991 V1992 V1993 V1994) (trap-error (vector-> V1992 V1994 (<-vector V1991 V1993)) (lambda E V1992))) -(defun hdv (V3157) (trap-error (<-vector V3157 1) (lambda E (simple-error (cn "hdv needs a non-empty vector as an argument; not " (shen.app V3157 " +(defun hdv (V1996) (trap-error (<-vector V1996 1) (lambda E (simple-error (cn "hdv needs a non-empty vector as an argument; not " (shen.app V1996 " " shen.s)))))) -(defun tlv (V3159) (let Limit (limit V3159) (if (= Limit 0) (simple-error "cannot take the tail of the empty vector -") (if (= Limit 1) (vector 0) (let NewVector (vector (- Limit 1)) (shen.tlv-help V3159 2 Limit (vector (- Limit 1)))))))) +(defun tlv (V1998) (let Limit (limit V1998) (if (= Limit 0) (simple-error "cannot take the tail of the empty vector +") (if (= Limit 1) (vector 0) (let NewVector (vector (- Limit 1)) (shen.tlv-help V1998 2 Limit (vector (- Limit 1)))))))) -(defun shen.tlv-help (V3165 V3166 V3167 V3168) (cond ((= V3167 V3166) (shen.copyfromvector V3165 V3168 V3167 (- V3167 1))) (true (shen.tlv-help V3165 (+ V3166 1) V3167 (shen.copyfromvector V3165 V3168 V3166 (- V3166 1)))))) +(defun shen.tlv-help (V2004 V2005 V2006 V2007) (cond ((= V2006 V2005) (shen.copyfromvector V2004 V2007 V2006 (- V2006 1))) (true (shen.tlv-help V2004 (+ V2005 1) V2006 (shen.copyfromvector V2004 V2007 V2005 (- V2005 1)))))) -(defun assoc (V3180 V3181) (cond ((= () V3181) ()) ((and (cons? V3181) (and (cons? (hd V3181)) (= (hd (hd V3181)) V3180))) (hd V3181)) ((cons? V3181) (assoc V3180 (tl V3181))) (true (shen.f_error assoc)))) +(defun assoc (V2019 V2020) (cond ((= () V2020) ()) ((and (cons? V2020) (and (cons? (hd V2020)) (= (hd (hd V2020)) V2019))) (hd V2020)) ((cons? V2020) (assoc V2019 (tl V2020))) (true (shen.f_error assoc)))) -(defun shen.assoc-set (V3188 V3189 V3190) (cond ((= () V3190) (cons (cons V3188 V3189) ())) ((and (cons? V3190) (and (cons? (hd V3190)) (= (hd (hd V3190)) V3188))) (cons (cons (hd (hd V3190)) V3189) (tl V3190))) ((cons? V3190) (cons (hd V3190) (shen.assoc-set V3188 V3189 (tl V3190)))) (true (shen.f_error shen.assoc-set)))) +(defun shen.assoc-set (V2027 V2028 V2029) (cond ((= () V2029) (cons (cons V2027 V2028) ())) ((and (cons? V2029) (and (cons? (hd V2029)) (= (hd (hd V2029)) V2027))) (cons (cons (hd (hd V2029)) V2028) (tl V2029))) ((cons? V2029) (cons (hd V2029) (shen.assoc-set V2027 V2028 (tl V2029)))) (true (shen.f_error shen.assoc-set)))) -(defun shen.assoc-rm (V3196 V3197) (cond ((= () V3197) ()) ((and (cons? V3197) (and (cons? (hd V3197)) (= (hd (hd V3197)) V3196))) (tl V3197)) ((cons? V3197) (cons (hd V3197) (shen.assoc-rm V3196 (tl V3197)))) (true (shen.f_error shen.assoc-rm)))) +(defun shen.assoc-rm (V2035 V2036) (cond ((= () V2036) ()) ((and (cons? V2036) (and (cons? (hd V2036)) (= (hd (hd V2036)) V2035))) (tl V2036)) ((cons? V2036) (cons (hd V2036) (shen.assoc-rm V2035 (tl V2036)))) (true (shen.f_error shen.assoc-rm)))) -(defun boolean? (V3203) (cond ((= true V3203) true) ((= false V3203) true) (true false))) +(defun boolean? (V2042) (cond ((= true V2042) true) ((= false V2042) true) (true false))) -(defun nl (V3205) (cond ((= 0 V3205) 0) (true (do (shen.prhush " -" (stoutput)) (nl (- V3205 1)))))) +(defun nl (V2044) (cond ((= 0 V2044) 0) (true (do (shen.prhush " +" (stoutput)) (nl (- V2044 1)))))) -(defun difference (V3210 V3211) (cond ((= () V3210) ()) ((cons? V3210) (if (element? (hd V3210) V3211) (difference (tl V3210) V3211) (cons (hd V3210) (difference (tl V3210) V3211)))) (true (shen.f_error difference)))) +(defun difference (V2049 V2050) (cond ((= () V2049) ()) ((cons? V2049) (if (element? (hd V2049) V2050) (difference (tl V2049) V2050) (cons (hd V2049) (difference (tl V2049) V2050)))) (true (shen.f_error difference)))) -(defun do (V3214 V3215) V3215) +(defun do (V2053 V2054) V2054) -(defun element? (V3227 V3228) (cond ((= () V3228) false) ((and (cons? V3228) (= (hd V3228) V3227)) true) ((cons? V3228) (element? V3227 (tl V3228))) (true (shen.f_error element?)))) +(defun element? (V2066 V2067) (cond ((= () V2067) false) ((and (cons? V2067) (= (hd V2067) V2066)) true) ((cons? V2067) (element? V2066 (tl V2067))) (true (shen.f_error element?)))) -(defun empty? (V3234) (cond ((= () V3234) true) (true false))) +(defun empty? (V2073) (cond ((= () V2073) true) (true false))) -(defun fix (V3237 V3238) (shen.fix-help V3237 V3238 (V3237 V3238))) +(defun fix (V2076 V2077) (shen.fix-help V2076 V2077 (V2076 V2077))) -(defun shen.fix-help (V3249 V3250 V3251) (cond ((= V3251 V3250) V3251) (true (shen.fix-help V3249 V3251 (V3249 V3251))))) +(defun shen.fix-help (V2088 V2089 V2090) (cond ((= V2090 V2089) V2090) (true (shen.fix-help V2088 V2090 (V2088 V2090))))) -(defun put (V3256 V3257 V3258 V3259) (let Curr (trap-error (shen.<-dict V3259 V3256) (lambda E ())) (let Added (shen.assoc-set V3257 V3258 Curr) (let Update (shen.dict-> V3259 V3256 Added) V3258)))) +(defun put (V2095 V2096 V2097 V2098) (let Curr (trap-error (shen.<-dict V2098 V2095) (lambda E ())) (let Added (shen.assoc-set V2096 V2097 Curr) (let Update (shen.dict-> V2098 V2095 Added) V2097)))) -(defun unput (V3263 V3264 V3265) (let Curr (trap-error (shen.<-dict V3265 V3263) (lambda E ())) (let Removed (shen.assoc-rm V3264 Curr) (let Update (shen.dict-> V3265 V3263 Removed) V3263)))) +(defun unput (V2102 V2103 V2104) (let Curr (trap-error (shen.<-dict V2104 V2102) (lambda E ())) (let Removed (shen.assoc-rm V2103 Curr) (let Update (shen.dict-> V2104 V2102 Removed) V2102)))) -(defun get (V3269 V3270 V3271) (let Entry (trap-error (shen.<-dict V3271 V3269) (lambda E ())) (let Result (assoc V3270 Entry) (if (empty? Result) (simple-error "value not found +(defun get (V2108 V2109 V2110) (let Entry (trap-error (shen.<-dict V2110 V2108) (lambda E ())) (let Result (assoc V2109 Entry) (if (empty? Result) (simple-error "value not found ") (tl Result))))) -(defun hash (V3274 V3275) (shen.mod (sum (map (lambda X (string->n X)) (explode V3274))) V3275)) +(defun hash (V2113 V2114) (shen.mod (sum (map (lambda X (string->n X)) (explode V2113))) V2114)) -(defun shen.mod (V3278 V3279) (shen.modh V3278 (shen.multiples V3278 (cons V3279 ())))) +(defun shen.mod (V2117 V2118) (shen.modh V2117 (shen.multiples V2117 (cons V2118 ())))) -(defun shen.multiples (V3282 V3283) (cond ((and (cons? V3283) (> (hd V3283) V3282)) (tl V3283)) ((cons? V3283) (shen.multiples V3282 (cons (* 2 (hd V3283)) V3283))) (true (shen.f_error shen.multiples)))) +(defun shen.multiples (V2121 V2122) (cond ((and (cons? V2122) (> (hd V2122) V2121)) (tl V2122)) ((cons? V2122) (shen.multiples V2121 (cons (* 2 (hd V2122)) V2122))) (true (shen.f_error shen.multiples)))) -(defun shen.modh (V3288 V3289) (cond ((= 0 V3288) 0) ((= () V3289) V3288) ((and (cons? V3289) (> (hd V3289) V3288)) (if (empty? (tl V3289)) V3288 (shen.modh V3288 (tl V3289)))) ((cons? V3289) (shen.modh (- V3288 (hd V3289)) V3289)) (true (shen.f_error shen.modh)))) +(defun shen.modh (V2127 V2128) (cond ((= 0 V2127) 0) ((= () V2128) V2127) ((and (cons? V2128) (> (hd V2128) V2127)) (if (empty? (tl V2128)) V2127 (shen.modh V2127 (tl V2128)))) ((cons? V2128) (shen.modh (- V2127 (hd V2128)) V2128)) (true (shen.f_error shen.modh)))) -(defun sum (V3291) (cond ((= () V3291) 0) ((cons? V3291) (+ (hd V3291) (sum (tl V3291)))) (true (shen.f_error sum)))) +(defun sum (V2130) (cond ((= () V2130) 0) ((cons? V2130) (+ (hd V2130) (sum (tl V2130)))) (true (shen.f_error sum)))) -(defun head (V3299) (cond ((cons? V3299) (hd V3299)) (true (simple-error "head expects a non-empty list")))) +(defun head (V2138) (cond ((cons? V2138) (hd V2138)) (true (simple-error "head expects a non-empty list")))) -(defun tail (V3307) (cond ((cons? V3307) (tl V3307)) (true (simple-error "tail expects a non-empty list")))) +(defun tail (V2146) (cond ((cons? V2146) (tl V2146)) (true (simple-error "tail expects a non-empty list")))) -(defun hdstr (V3309) (pos V3309 0)) +(defun hdstr (V2148) (pos V2148 0)) -(defun intersection (V3314 V3315) (cond ((= () V3314) ()) ((cons? V3314) (if (element? (hd V3314) V3315) (cons (hd V3314) (intersection (tl V3314) V3315)) (intersection (tl V3314) V3315))) (true (shen.f_error intersection)))) +(defun intersection (V2153 V2154) (cond ((= () V2153) ()) ((cons? V2153) (if (element? (hd V2153) V2154) (cons (hd V2153) (intersection (tl V2153) V2154)) (intersection (tl V2153) V2154))) (true (shen.f_error intersection)))) -(defun reverse (V3317) (shen.reverse_help V3317 ())) +(defun reverse (V2156) (shen.reverse_help V2156 ())) -(defun shen.reverse_help (V3320 V3321) (cond ((= () V3320) V3321) ((cons? V3320) (shen.reverse_help (tl V3320) (cons (hd V3320) V3321))) (true (shen.f_error shen.reverse_help)))) +(defun shen.reverse_help (V2159 V2160) (cond ((= () V2159) V2160) ((cons? V2159) (shen.reverse_help (tl V2159) (cons (hd V2159) V2160))) (true (shen.f_error shen.reverse_help)))) -(defun union (V3324 V3325) (cond ((= () V3324) V3325) ((cons? V3324) (if (element? (hd V3324) V3325) (union (tl V3324) V3325) (cons (hd V3324) (union (tl V3324) V3325)))) (true (shen.f_error union)))) +(defun union (V2163 V2164) (cond ((= () V2163) V2164) ((cons? V2163) (if (element? (hd V2163) V2164) (union (tl V2163) V2164) (cons (hd V2163) (union (tl V2163) V2164)))) (true (shen.f_error union)))) -(defun y-or-n? (V3327) (let Message (shen.prhush (shen.proc-nl V3327) (stoutput)) (let Y-or-N (shen.prhush " (y/n) " (stoutput)) (let Input (shen.app (read (stinput)) "" shen.s) (if (= "y" Input) true (if (= "n" Input) false (do (shen.prhush "please answer y or n -" (stoutput)) (y-or-n? V3327)))))))) +(defun y-or-n? (V2166) (let Message (shen.prhush (shen.proc-nl V2166) (stoutput)) (let Y-or-N (shen.prhush " (y/n) " (stoutput)) (let Input (shen.app (read (stinput)) "" shen.s) (if (= "y" Input) true (if (= "n" Input) false (do (shen.prhush "please answer y or n +" (stoutput)) (y-or-n? V2166)))))))) -(defun not (V3329) (if V3329 false true)) +(defun not (V2168) (if V2168 false true)) -(defun subst (V3342 V3343 V3344) (cond ((= V3344 V3343) V3342) ((cons? V3344) (map (lambda W (subst V3342 V3343 W)) V3344)) (true V3344))) +(defun subst (V2181 V2182 V2183) (cond ((= V2183 V2182) V2181) ((cons? V2183) (map (lambda W (subst V2181 V2182 W)) V2183)) (true V2183))) -(defun explode (V3346) (shen.explode-h (shen.app V3346 "" shen.a))) +(defun explode (V2185) (shen.explode-h (shen.app V2185 "" shen.a))) -(defun shen.explode-h (V3348) (cond ((= "" V3348) ()) ((shen.+string? V3348) (cons (pos V3348 0) (shen.explode-h (tlstr V3348)))) (true (shen.f_error shen.explode-h)))) +(defun shen.explode-h (V2187) (cond ((= "" V2187) ()) ((shen.+string? V2187) (cons (pos V2187 0) (shen.explode-h (tlstr V2187)))) (true (shen.f_error shen.explode-h)))) -(defun cd (V3350) (set *home-directory* (if (= V3350 "") "" (shen.app V3350 "/" shen.a)))) +(defun cd (V2189) (set *home-directory* (if (= V2189 "") "" (shen.app V2189 "/" shen.a)))) -(defun shen.for-each (V3353 V3354) (cond ((= () V3354) true) ((cons? V3354) (let _ (V3353 (hd V3354)) (shen.for-each V3353 (tl V3354)))) (true (shen.f_error shen.for-each)))) +(defun shen.for-each (V2192 V2193) (cond ((= () V2193) true) ((cons? V2193) (let _ (V2192 (hd V2193)) (shen.for-each V2192 (tl V2193)))) (true (shen.f_error shen.for-each)))) -(defun map (V3359 V3360) (cond ((= () V3360) ()) ((cons? V3360) (cons (V3359 (hd V3360)) (map V3359 (tl V3360)))) (true (V3359 V3360)))) +(defun map (V2198 V2199) (cond ((= () V2199) ()) ((cons? V2199) (cons (V2198 (hd V2199)) (map V2198 (tl V2199)))) (true (V2198 V2199)))) -(defun length (V3362) (shen.length-h V3362 0)) +(defun length (V2201) (shen.length-h V2201 0)) -(defun shen.length-h (V3365 V3366) (cond ((= () V3365) V3366) (true (shen.length-h (tl V3365) (+ V3366 1))))) +(defun shen.length-h (V2204 V2205) (cond ((= () V2204) V2205) (true (shen.length-h (tl V2204) (+ V2205 1))))) -(defun occurrences (V3378 V3379) (cond ((= V3379 V3378) 1) ((cons? V3379) (+ (occurrences V3378 (hd V3379)) (occurrences V3378 (tl V3379)))) (true 0))) +(defun occurrences (V2217 V2218) (cond ((= V2218 V2217) 1) ((cons? V2218) (+ (occurrences V2217 (hd V2218)) (occurrences V2217 (tl V2218)))) (true 0))) -(defun nth (V3386 V3387) (cond ((and (= 1 V3386) (cons? V3387)) (hd V3387)) ((cons? V3387) (nth (- V3386 1) (tl V3387))) (true (simple-error (cn "nth applied to " (shen.app V3386 (cn ", " (shen.app V3387 " +(defun nth (V2225 V2226) (cond ((and (= 1 V2225) (cons? V2226)) (hd V2226)) ((cons? V2226) (nth (- V2225 1) (tl V2226))) (true (simple-error (cn "nth applied to " (shen.app V2225 (cn ", " (shen.app V2226 " " shen.a)) shen.a)))))) -(defun integer? (V3389) (and (number? V3389) (let Abs (shen.abs V3389) (shen.integer-test? Abs (shen.magless Abs 1))))) +(defun integer? (V2228) (and (number? V2228) (let Abs (shen.abs V2228) (shen.integer-test? Abs (shen.magless Abs 1))))) -(defun shen.abs (V3391) (if (> V3391 0) V3391 (- 0 V3391))) +(defun shen.abs (V2230) (if (> V2230 0) V2230 (- 0 V2230))) -(defun shen.magless (V3394 V3395) (let Nx2 (* V3395 2) (if (> Nx2 V3394) V3395 (shen.magless V3394 Nx2)))) +(defun shen.magless (V2233 V2234) (let Nx2 (* V2234 2) (if (> Nx2 V2233) V2234 (shen.magless V2233 Nx2)))) -(defun shen.integer-test? (V3401 V3402) (cond ((= 0 V3401) true) ((> 1 V3401) false) (true (let Abs-N (- V3401 V3402) (if (> 0 Abs-N) (integer? V3401) (shen.integer-test? Abs-N V3402)))))) +(defun shen.integer-test? (V2240 V2241) (cond ((= 0 V2240) true) ((> 1 V2240) false) (true (let Abs-N (- V2240 V2241) (if (> 0 Abs-N) (integer? V2240) (shen.integer-test? Abs-N V2241)))))) -(defun mapcan (V3407 V3408) (cond ((= () V3408) ()) ((cons? V3408) (append (V3407 (hd V3408)) (mapcan V3407 (tl V3408)))) (true (shen.f_error mapcan)))) +(defun mapcan (V2246 V2247) (cond ((= () V2247) ()) ((cons? V2247) (append (V2246 (hd V2247)) (mapcan V2246 (tl V2247)))) (true (shen.f_error mapcan)))) -(defun == (V3420 V3421) (cond ((= V3421 V3420) true) (true false))) +(defun == (V2259 V2260) (cond ((= V2260 V2259) true) (true false))) (defun abort () (simple-error "")) -(defun bound? (V3423) (and (symbol? V3423) (let Val (trap-error (value V3423) (lambda E shen.this-symbol-is-unbound)) (if (= Val shen.this-symbol-is-unbound) false true)))) +(defun bound? (V2262) (and (symbol? V2262) (let Val (trap-error (value V2262) (lambda E shen.this-symbol-is-unbound)) (if (= Val shen.this-symbol-is-unbound) false true)))) -(defun shen.string->bytes (V3425) (cond ((= "" V3425) ()) (true (cons (string->n (pos V3425 0)) (shen.string->bytes (tlstr V3425)))))) +(defun shen.string->bytes (V2264) (cond ((= "" V2264) ()) (true (cons (string->n (pos V2264 0)) (shen.string->bytes (tlstr V2264)))))) -(defun maxinferences (V3427) (set shen.*maxinferences* V3427)) +(defun maxinferences (V2266) (set shen.*maxinferences* V2266)) (defun inferences () (value shen.*infs*)) -(defun protect (V3429) V3429) +(defun protect (V2268) V2268) (defun stoutput () (value *stoutput*)) (defun sterror () (value *sterror*)) -(defun string->symbol (V3431) (let Symbol (intern V3431) (if (symbol? Symbol) Symbol (simple-error (cn "cannot intern " (shen.app V3431 " to a symbol" shen.s)))))) +(defun string->symbol (V2270) (let Symbol (intern V2270) (if (symbol? Symbol) Symbol (simple-error (cn "cannot intern " (shen.app V2270 " to a symbol" shen.s)))))) -(defun optimise (V3437) (cond ((= + V3437) (set shen.*optimise* true)) ((= - V3437) (set shen.*optimise* false)) (true (simple-error "optimise expects a + or a -. +(defun optimise (V2276) (cond ((= + V2276) (set shen.*optimise* true)) ((= - V2276) (set shen.*optimise* false)) (true (simple-error "optimise expects a + or a -. ")))) (defun os () (value *os*)) @@ -255,11 +255,11 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. (defun release () (value *release*)) -(defun package? (V3439) (trap-error (do (external V3439) true) (lambda E false))) +(defun package? (V2278) (trap-error (do (external V2278) true) (lambda E false))) -(defun function (V3441) (shen.lookup-func V3441)) +(defun function (V2280) (shen.lookup-func V2280)) -(defun shen.lookup-func (V3443) (trap-error (get V3443 shen.lambda-form (value *property-vector*)) (lambda E (simple-error (shen.app V3443 " has no lambda expansion +(defun shen.lookup-func (V2282) (trap-error (get V2282 shen.lambda-form (value *property-vector*)) (lambda E (simple-error (shen.app V2282 " has no lambda expansion " shen.a))))) diff --git a/kl/t-star.kl b/kl/t-star.kl index f4ba53a..c0e0779 100644 --- a/kl/t-star.kl +++ b/kl/t-star.kl @@ -28,101 +28,101 @@ OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. " -(defun shen.typecheck (V3834 V3835) (let Curry (shen.curry V3834) (let ProcessN (shen.start-new-prolog-process) (let Type (shen.insert-prolog-variables (shen.demodulate (shen.curry-type V3835)) ProcessN) (let Continuation (freeze (return Type ProcessN shen.void)) (shen.t* (cons Curry (cons : (cons Type ()))) () ProcessN Continuation)))))) +(defun shen.typecheck (V2673 V2674) (let Curry (shen.curry V2673) (let ProcessN (shen.start-new-prolog-process) (let Type (shen.insert-prolog-variables (shen.demodulate (shen.curry-type V2674)) ProcessN) (let Continuation (freeze (return Type ProcessN shen.void)) (shen.t* (cons Curry (cons : (cons Type ()))) () ProcessN Continuation)))))) -(defun shen.curry (V3837) (cond ((and (cons? V3837) (shen.special? (hd V3837))) (cons (hd V3837) (map (lambda Y (shen.curry Y)) (tl V3837)))) ((and (cons? V3837) (and (cons? (tl V3837)) (shen.extraspecial? (hd V3837)))) V3837) ((and (cons? V3837) (and (= type (hd V3837)) (and (cons? (tl V3837)) (and (cons? (tl (tl V3837))) (= () (tl (tl (tl V3837)))))))) (cons type (cons (shen.curry (hd (tl V3837))) (tl (tl V3837))))) ((and (cons? V3837) (and (cons? (tl V3837)) (cons? (tl (tl V3837))))) (shen.curry (cons (cons (hd V3837) (cons (hd (tl V3837)) ())) (tl (tl V3837))))) ((and (cons? V3837) (and (cons? (tl V3837)) (= () (tl (tl V3837))))) (cons (shen.curry (hd V3837)) (cons (shen.curry (hd (tl V3837))) ()))) (true V3837))) +(defun shen.curry (V2676) (cond ((and (cons? V2676) (shen.special? (hd V2676))) (cons (hd V2676) (map (lambda Y (shen.curry Y)) (tl V2676)))) ((and (cons? V2676) (and (cons? (tl V2676)) (shen.extraspecial? (hd V2676)))) V2676) ((and (cons? V2676) (and (= type (hd V2676)) (and (cons? (tl V2676)) (and (cons? (tl (tl V2676))) (= () (tl (tl (tl V2676)))))))) (cons type (cons (shen.curry (hd (tl V2676))) (tl (tl V2676))))) ((and (cons? V2676) (and (cons? (tl V2676)) (cons? (tl (tl V2676))))) (shen.curry (cons (cons (hd V2676) (cons (hd (tl V2676)) ())) (tl (tl V2676))))) ((and (cons? V2676) (and (cons? (tl V2676)) (= () (tl (tl V2676))))) (cons (shen.curry (hd V2676)) (cons (shen.curry (hd (tl V2676))) ()))) (true V2676))) -(defun shen.special? (V3839) (element? V3839 (value shen.*special*))) +(defun shen.special? (V2678) (element? V2678 (value shen.*special*))) -(defun shen.extraspecial? (V3841) (element? V3841 (value shen.*extraspecial*))) +(defun shen.extraspecial? (V2680) (element? V2680 (value shen.*extraspecial*))) -(defun shen.t* (V3846 V3847 V3848 V3849) (let Throwcontrol (shen.catchpoint) (shen.cutpoint Throwcontrol (let Case (let Error (shen.newpv V3848) (do (shen.incinfs) (fwhen (shen.maxinfexceeded?) V3848 (freeze (bind Error (shen.errormaxinfs) V3848 V3849))))) (if (= Case false) (let Case (let V3826 (shen.lazyderef V3846 V3848) (if (= fail V3826) (do (shen.incinfs) (cut Throwcontrol V3848 (freeze (shen.prolog-failure V3848 V3849)))) false)) (if (= Case false) (let Case (let V3827 (shen.lazyderef V3846 V3848) (if (cons? V3827) (let X (hd V3827) (let V3828 (shen.lazyderef (tl V3827) V3848) (if (cons? V3828) (let V3829 (shen.lazyderef (hd V3828) V3848) (if (= : V3829) (let V3830 (shen.lazyderef (tl V3828) V3848) (if (cons? V3830) (let A (hd V3830) (let V3831 (shen.lazyderef (tl V3830) V3848) (if (= () V3831) (do (shen.incinfs) (fwhen (shen.type-theory-enabled?) V3848 (freeze (cut Throwcontrol V3848 (freeze (shen.th* X A V3847 V3848 V3849)))))) false))) false)) false)) false))) false)) (if (= Case false) (let Datatypes (shen.newpv V3848) (do (shen.incinfs) (shen.show V3846 V3847 V3848 (freeze (bind Datatypes (value shen.*datatypes*) V3848 (freeze (shen.udefs* V3846 V3847 Datatypes V3848 V3849))))))) Case)) Case)) Case))))) +(defun shen.t* (V2685 V2686 V2687 V2688) (let Throwcontrol (shen.catchpoint) (shen.cutpoint Throwcontrol (let Case (let Error (shen.newpv V2687) (do (shen.incinfs) (fwhen (shen.maxinfexceeded?) V2687 (freeze (bind Error (shen.errormaxinfs) V2687 V2688))))) (if (= Case false) (let Case (let V2665 (shen.lazyderef V2685 V2687) (if (= fail V2665) (do (shen.incinfs) (cut Throwcontrol V2687 (freeze (shen.prolog-failure V2687 V2688)))) false)) (if (= Case false) (let Case (let V2666 (shen.lazyderef V2685 V2687) (if (cons? V2666) (let X (hd V2666) (let V2667 (shen.lazyderef (tl V2666) V2687) (if (cons? V2667) (let V2668 (shen.lazyderef (hd V2667) V2687) (if (= : V2668) (let V2669 (shen.lazyderef (tl V2667) V2687) (if (cons? V2669) (let A (hd V2669) (let V2670 (shen.lazyderef (tl V2669) V2687) (if (= () V2670) (do (shen.incinfs) (fwhen (shen.type-theory-enabled?) V2687 (freeze (cut Throwcontrol V2687 (freeze (shen.th* X A V2686 V2687 V2688)))))) false))) false)) false)) false))) false)) (if (= Case false) (let Datatypes (shen.newpv V2687) (do (shen.incinfs) (shen.show V2685 V2686 V2687 (freeze (bind Datatypes (value shen.*datatypes*) V2687 (freeze (shen.udefs* V2685 V2686 Datatypes V2687 V2688))))))) Case)) Case)) Case))))) (defun shen.type-theory-enabled? () (value shen.*shen-type-theory-enabled?*)) -(defun enable-type-theory (V3855) (cond ((= + V3855) (set shen.*shen-type-theory-enabled?* true)) ((= - V3855) (set shen.*shen-type-theory-enabled?* false)) (true (simple-error "enable-type-theory expects a + or a - +(defun enable-type-theory (V2694) (cond ((= + V2694) (set shen.*shen-type-theory-enabled?* true)) ((= - V2694) (set shen.*shen-type-theory-enabled?* false)) (true (simple-error "enable-type-theory expects a + or a - ")))) -(defun shen.prolog-failure (V3866 V3867) false) +(defun shen.prolog-failure (V2705 V2706) false) (defun shen.maxinfexceeded? () (> (inferences) (value shen.*maxinferences*))) (defun shen.errormaxinfs () (simple-error "maximum inferences exceeded~%")) -(defun shen.udefs* (V3873 V3874 V3875 V3876 V3877) (let Case (let V3822 (shen.lazyderef V3875 V3876) (if (cons? V3822) (let D (hd V3822) (do (shen.incinfs) (call (cons D (cons V3873 (cons V3874 ()))) V3876 V3877))) false)) (if (= Case false) (let V3823 (shen.lazyderef V3875 V3876) (if (cons? V3823) (let Ds (tl V3823) (do (shen.incinfs) (shen.udefs* V3873 V3874 Ds V3876 V3877))) false)) Case))) +(defun shen.udefs* (V2712 V2713 V2714 V2715 V2716) (let Case (let V2661 (shen.lazyderef V2714 V2715) (if (cons? V2661) (let D (hd V2661) (do (shen.incinfs) (call (cons D (cons V2712 (cons V2713 ()))) V2715 V2716))) false)) (if (= Case false) (let V2662 (shen.lazyderef V2714 V2715) (if (cons? V2662) (let Ds (tl V2662) (do (shen.incinfs) (shen.udefs* V2712 V2713 Ds V2715 V2716))) false)) Case))) -(defun shen.th* (V3883 V3884 V3885 V3886 V3887) (let Throwcontrol (shen.catchpoint) (shen.cutpoint Throwcontrol (let Case (do (shen.incinfs) (shen.show (cons V3883 (cons : (cons V3884 ()))) V3885 V3886 (freeze (fwhen false V3886 V3887)))) (if (= Case false) (let Case (let F (shen.newpv V3886) (do (shen.incinfs) (fwhen (shen.typedf? (shen.lazyderef V3883 V3886)) V3886 (freeze (bind F (shen.sigf (shen.lazyderef V3883 V3886)) V3886 (freeze (call (cons F (cons V3884 ())) V3886 V3887))))))) (if (= Case false) (let Case (do (shen.incinfs) (shen.base V3883 V3884 V3886 V3887)) (if (= Case false) (let Case (do (shen.incinfs) (shen.by_hypothesis V3883 V3884 V3885 V3886 V3887)) (if (= Case false) (let Case (let V3718 (shen.lazyderef V3883 V3886) (if (cons? V3718) (let F (hd V3718) (let V3719 (shen.lazyderef (tl V3718) V3886) (if (= () V3719) (do (shen.incinfs) (shen.th* F (cons --> (cons V3884 ())) V3885 V3886 V3887)) false))) false)) (if (= Case false) (let Case (let V3720 (shen.lazyderef V3883 V3886) (if (cons? V3720) (let F (hd V3720) (let V3721 (shen.lazyderef (tl V3720) V3886) (if (cons? V3721) (let X (hd V3721) (let V3722 (shen.lazyderef (tl V3721) V3886) (if (= () V3722) (let B (shen.newpv V3886) (do (shen.incinfs) (shen.th* F (cons B (cons --> (cons V3884 ()))) V3885 V3886 (freeze (shen.th* X B V3885 V3886 V3887))))) false))) false))) false)) (if (= Case false) (let Case (let V3723 (shen.lazyderef V3883 V3886) (if (cons? V3723) (let V3724 (shen.lazyderef (hd V3723) V3886) (if (= cons V3724) (let V3725 (shen.lazyderef (tl V3723) V3886) (if (cons? V3725) (let X (hd V3725) (let V3726 (shen.lazyderef (tl V3725) V3886) (if (cons? V3726) (let Y (hd V3726) (let V3727 (shen.lazyderef (tl V3726) V3886) (if (= () V3727) (let V3728 (shen.lazyderef V3884 V3886) (if (cons? V3728) (let V3729 (shen.lazyderef (hd V3728) V3886) (if (= list V3729) (let V3730 (shen.lazyderef (tl V3728) V3886) (if (cons? V3730) (let A (hd V3730) (let V3731 (shen.lazyderef (tl V3730) V3886) (if (= () V3731) (do (shen.incinfs) (shen.th* X A V3885 V3886 (freeze (shen.th* Y (cons list (cons A ())) V3885 V3886 V3887)))) (if (shen.pvar? V3731) (do (shen.bindv V3731 () V3886) (let Result (do (shen.incinfs) (shen.th* X A V3885 V3886 (freeze (shen.th* Y (cons list (cons A ())) V3885 V3886 V3887)))) (do (shen.unbindv V3731 V3886) Result))) false)))) (if (shen.pvar? V3730) (let A (shen.newpv V3886) (do (shen.bindv V3730 (cons A ()) V3886) (let Result (do (shen.incinfs) (shen.th* X A V3885 V3886 (freeze (shen.th* Y (cons list (cons A ())) V3885 V3886 V3887)))) (do (shen.unbindv V3730 V3886) Result)))) false))) (if (shen.pvar? V3729) (do (shen.bindv V3729 list V3886) (let Result (let V3732 (shen.lazyderef (tl V3728) V3886) (if (cons? V3732) (let A (hd V3732) (let V3733 (shen.lazyderef (tl V3732) V3886) (if (= () V3733) (do (shen.incinfs) (shen.th* X A V3885 V3886 (freeze (shen.th* Y (cons list (cons A ())) V3885 V3886 V3887)))) (if (shen.pvar? V3733) (do (shen.bindv V3733 () V3886) (let Result (do (shen.incinfs) (shen.th* X A V3885 V3886 (freeze (shen.th* Y (cons list (cons A ())) V3885 V3886 V3887)))) (do (shen.unbindv V3733 V3886) Result))) false)))) (if (shen.pvar? V3732) (let A (shen.newpv V3886) (do (shen.bindv V3732 (cons A ()) V3886) (let Result (do (shen.incinfs) (shen.th* X A V3885 V3886 (freeze (shen.th* Y (cons list (cons A ())) V3885 V3886 V3887)))) (do (shen.unbindv V3732 V3886) Result)))) false))) (do (shen.unbindv V3729 V3886) Result))) false))) (if (shen.pvar? V3728) (let A (shen.newpv V3886) (do (shen.bindv V3728 (cons list (cons A ())) V3886) (let Result (do (shen.incinfs) (shen.th* X A V3885 V3886 (freeze (shen.th* Y (cons list (cons A ())) V3885 V3886 V3887)))) (do (shen.unbindv V3728 V3886) Result)))) false))) false))) false))) false)) false)) false)) (if (= Case false) (let Case (let V3734 (shen.lazyderef V3883 V3886) (if (cons? V3734) (let V3735 (shen.lazyderef (hd V3734) V3886) (if (= @p V3735) (let V3736 (shen.lazyderef (tl V3734) V3886) (if (cons? V3736) (let X (hd V3736) (let V3737 (shen.lazyderef (tl V3736) V3886) (if (cons? V3737) (let Y (hd V3737) (let V3738 (shen.lazyderef (tl V3737) V3886) (if (= () V3738) (let V3739 (shen.lazyderef V3884 V3886) (if (cons? V3739) (let A (hd V3739) (let V3740 (shen.lazyderef (tl V3739) V3886) (if (cons? V3740) (let V3741 (shen.lazyderef (hd V3740) V3886) (if (= * V3741) (let V3742 (shen.lazyderef (tl V3740) V3886) (if (cons? V3742) (let B (hd V3742) (let V3743 (shen.lazyderef (tl V3742) V3886) (if (= () V3743) (do (shen.incinfs) (shen.th* X A V3885 V3886 (freeze (shen.th* Y B V3885 V3886 V3887)))) (if (shen.pvar? V3743) (do (shen.bindv V3743 () V3886) (let Result (do (shen.incinfs) (shen.th* X A V3885 V3886 (freeze (shen.th* Y B V3885 V3886 V3887)))) (do (shen.unbindv V3743 V3886) Result))) false)))) (if (shen.pvar? V3742) (let B (shen.newpv V3886) (do (shen.bindv V3742 (cons B ()) V3886) (let Result (do (shen.incinfs) (shen.th* X A V3885 V3886 (freeze (shen.th* Y B V3885 V3886 V3887)))) (do (shen.unbindv V3742 V3886) Result)))) false))) (if (shen.pvar? V3741) (do (shen.bindv V3741 * V3886) (let Result (let V3744 (shen.lazyderef (tl V3740) V3886) (if (cons? V3744) (let B (hd V3744) (let V3745 (shen.lazyderef (tl V3744) V3886) (if (= () V3745) (do (shen.incinfs) (shen.th* X A V3885 V3886 (freeze (shen.th* Y B V3885 V3886 V3887)))) (if (shen.pvar? V3745) (do (shen.bindv V3745 () V3886) (let Result (do (shen.incinfs) (shen.th* X A V3885 V3886 (freeze (shen.th* Y B V3885 V3886 V3887)))) (do (shen.unbindv V3745 V3886) Result))) false)))) (if (shen.pvar? V3744) (let B (shen.newpv V3886) (do (shen.bindv V3744 (cons B ()) V3886) (let Result (do (shen.incinfs) (shen.th* X A V3885 V3886 (freeze (shen.th* Y B V3885 V3886 V3887)))) (do (shen.unbindv V3744 V3886) Result)))) false))) (do (shen.unbindv V3741 V3886) Result))) false))) (if (shen.pvar? V3740) (let B (shen.newpv V3886) (do (shen.bindv V3740 (cons * (cons B ())) V3886) (let Result (do (shen.incinfs) (shen.th* X A V3885 V3886 (freeze (shen.th* Y B V3885 V3886 V3887)))) (do (shen.unbindv V3740 V3886) Result)))) false)))) (if (shen.pvar? V3739) (let A (shen.newpv V3886) (let B (shen.newpv V3886) (do (shen.bindv V3739 (cons A (cons * (cons B ()))) V3886) (let Result (do (shen.incinfs) (shen.th* X A V3885 V3886 (freeze (shen.th* Y B V3885 V3886 V3887)))) (do (shen.unbindv V3739 V3886) Result))))) false))) false))) false))) false)) false)) false)) (if (= Case false) (let Case (let V3746 (shen.lazyderef V3883 V3886) (if (cons? V3746) (let V3747 (shen.lazyderef (hd V3746) V3886) (if (= @v V3747) (let V3748 (shen.lazyderef (tl V3746) V3886) (if (cons? V3748) (let X (hd V3748) (let V3749 (shen.lazyderef (tl V3748) V3886) (if (cons? V3749) (let Y (hd V3749) (let V3750 (shen.lazyderef (tl V3749) V3886) (if (= () V3750) (let V3751 (shen.lazyderef V3884 V3886) (if (cons? V3751) (let V3752 (shen.lazyderef (hd V3751) V3886) (if (= vector V3752) (let V3753 (shen.lazyderef (tl V3751) V3886) (if (cons? V3753) (let A (hd V3753) (let V3754 (shen.lazyderef (tl V3753) V3886) (if (= () V3754) (do (shen.incinfs) (shen.th* X A V3885 V3886 (freeze (shen.th* Y (cons vector (cons A ())) V3885 V3886 V3887)))) (if (shen.pvar? V3754) (do (shen.bindv V3754 () V3886) (let Result (do (shen.incinfs) (shen.th* X A V3885 V3886 (freeze (shen.th* Y (cons vector (cons A ())) V3885 V3886 V3887)))) (do (shen.unbindv V3754 V3886) Result))) false)))) (if (shen.pvar? V3753) (let A (shen.newpv V3886) (do (shen.bindv V3753 (cons A ()) V3886) (let Result (do (shen.incinfs) (shen.th* X A V3885 V3886 (freeze (shen.th* Y (cons vector (cons A ())) V3885 V3886 V3887)))) (do (shen.unbindv V3753 V3886) Result)))) false))) (if (shen.pvar? V3752) (do (shen.bindv V3752 vector V3886) (let Result (let V3755 (shen.lazyderef (tl V3751) V3886) (if (cons? V3755) (let A (hd V3755) (let V3756 (shen.lazyderef (tl V3755) V3886) (if (= () V3756) (do (shen.incinfs) (shen.th* X A V3885 V3886 (freeze (shen.th* Y (cons vector (cons A ())) V3885 V3886 V3887)))) (if (shen.pvar? V3756) (do (shen.bindv V3756 () V3886) (let Result (do (shen.incinfs) (shen.th* X A V3885 V3886 (freeze (shen.th* Y (cons vector (cons A ())) V3885 V3886 V3887)))) (do (shen.unbindv V3756 V3886) Result))) false)))) (if (shen.pvar? V3755) (let A (shen.newpv V3886) (do (shen.bindv V3755 (cons A ()) V3886) (let Result (do (shen.incinfs) (shen.th* X A V3885 V3886 (freeze (shen.th* Y (cons vector (cons A ())) V3885 V3886 V3887)))) (do (shen.unbindv V3755 V3886) Result)))) false))) (do (shen.unbindv V3752 V3886) Result))) false))) (if (shen.pvar? V3751) (let A (shen.newpv V3886) (do (shen.bindv V3751 (cons vector (cons A ())) V3886) (let Result (do (shen.incinfs) (shen.th* X A V3885 V3886 (freeze (shen.th* Y (cons vector (cons A ())) V3885 V3886 V3887)))) (do (shen.unbindv V3751 V3886) Result)))) false))) false))) false))) false)) false)) false)) (if (= Case false) (let Case (let V3757 (shen.lazyderef V3883 V3886) (if (cons? V3757) (let V3758 (shen.lazyderef (hd V3757) V3886) (if (= @s V3758) (let V3759 (shen.lazyderef (tl V3757) V3886) (if (cons? V3759) (let X (hd V3759) (let V3760 (shen.lazyderef (tl V3759) V3886) (if (cons? V3760) (let Y (hd V3760) (let V3761 (shen.lazyderef (tl V3760) V3886) (if (= () V3761) (let V3762 (shen.lazyderef V3884 V3886) (if (= string V3762) (do (shen.incinfs) (shen.th* X string V3885 V3886 (freeze (shen.th* Y string V3885 V3886 V3887)))) (if (shen.pvar? V3762) (do (shen.bindv V3762 string V3886) (let Result (do (shen.incinfs) (shen.th* X string V3885 V3886 (freeze (shen.th* Y string V3885 V3886 V3887)))) (do (shen.unbindv V3762 V3886) Result))) false))) false))) false))) false)) false)) false)) (if (= Case false) (let Case (let V3763 (shen.lazyderef V3883 V3886) (if (cons? V3763) (let V3764 (shen.lazyderef (hd V3763) V3886) (if (= lambda V3764) (let V3765 (shen.lazyderef (tl V3763) V3886) (if (cons? V3765) (let X (hd V3765) (let V3766 (shen.lazyderef (tl V3765) V3886) (if (cons? V3766) (let Y (hd V3766) (let V3767 (shen.lazyderef (tl V3766) V3886) (if (= () V3767) (let V3768 (shen.lazyderef V3884 V3886) (if (cons? V3768) (let A (hd V3768) (let V3769 (shen.lazyderef (tl V3768) V3886) (if (cons? V3769) (let V3770 (shen.lazyderef (hd V3769) V3886) (if (= --> V3770) (let V3771 (shen.lazyderef (tl V3769) V3886) (if (cons? V3771) (let B (hd V3771) (let V3772 (shen.lazyderef (tl V3771) V3886) (if (= () V3772) (let Z (shen.newpv V3886) (let X&& (shen.newpv V3886) (do (shen.incinfs) (cut Throwcontrol V3886 (freeze (bind X&& (shen.placeholder) V3886 (freeze (bind Z (shen.ebr (shen.lazyderef X&& V3886) (shen.lazyderef X V3886) (shen.lazyderef Y V3886)) V3886 (freeze (shen.th* Z B (cons (cons X&& (cons : (cons A ()))) V3885) V3886 V3887)))))))))) (if (shen.pvar? V3772) (do (shen.bindv V3772 () V3886) (let Result (let Z (shen.newpv V3886) (let X&& (shen.newpv V3886) (do (shen.incinfs) (cut Throwcontrol V3886 (freeze (bind X&& (shen.placeholder) V3886 (freeze (bind Z (shen.ebr (shen.lazyderef X&& V3886) (shen.lazyderef X V3886) (shen.lazyderef Y V3886)) V3886 (freeze (shen.th* Z B (cons (cons X&& (cons : (cons A ()))) V3885) V3886 V3887)))))))))) (do (shen.unbindv V3772 V3886) Result))) false)))) (if (shen.pvar? V3771) (let B (shen.newpv V3886) (do (shen.bindv V3771 (cons B ()) V3886) (let Result (let Z (shen.newpv V3886) (let X&& (shen.newpv V3886) (do (shen.incinfs) (cut Throwcontrol V3886 (freeze (bind X&& (shen.placeholder) V3886 (freeze (bind Z (shen.ebr (shen.lazyderef X&& V3886) (shen.lazyderef X V3886) (shen.lazyderef Y V3886)) V3886 (freeze (shen.th* Z B (cons (cons X&& (cons : (cons A ()))) V3885) V3886 V3887)))))))))) (do (shen.unbindv V3771 V3886) Result)))) false))) (if (shen.pvar? V3770) (do (shen.bindv V3770 --> V3886) (let Result (let V3773 (shen.lazyderef (tl V3769) V3886) (if (cons? V3773) (let B (hd V3773) (let V3774 (shen.lazyderef (tl V3773) V3886) (if (= () V3774) (let Z (shen.newpv V3886) (let X&& (shen.newpv V3886) (do (shen.incinfs) (cut Throwcontrol V3886 (freeze (bind X&& (shen.placeholder) V3886 (freeze (bind Z (shen.ebr (shen.lazyderef X&& V3886) (shen.lazyderef X V3886) (shen.lazyderef Y V3886)) V3886 (freeze (shen.th* Z B (cons (cons X&& (cons : (cons A ()))) V3885) V3886 V3887)))))))))) (if (shen.pvar? V3774) (do (shen.bindv V3774 () V3886) (let Result (let Z (shen.newpv V3886) (let X&& (shen.newpv V3886) (do (shen.incinfs) (cut Throwcontrol V3886 (freeze (bind X&& (shen.placeholder) V3886 (freeze (bind Z (shen.ebr (shen.lazyderef X&& V3886) (shen.lazyderef X V3886) (shen.lazyderef Y V3886)) V3886 (freeze (shen.th* Z B (cons (cons X&& (cons : (cons A ()))) V3885) V3886 V3887)))))))))) (do (shen.unbindv V3774 V3886) Result))) false)))) (if (shen.pvar? V3773) (let B (shen.newpv V3886) (do (shen.bindv V3773 (cons B ()) V3886) (let Result (let Z (shen.newpv V3886) (let X&& (shen.newpv V3886) (do (shen.incinfs) (cut Throwcontrol V3886 (freeze (bind X&& (shen.placeholder) V3886 (freeze (bind Z (shen.ebr (shen.lazyderef X&& V3886) (shen.lazyderef X V3886) (shen.lazyderef Y V3886)) V3886 (freeze (shen.th* Z B (cons (cons X&& (cons : (cons A ()))) V3885) V3886 V3887)))))))))) (do (shen.unbindv V3773 V3886) Result)))) false))) (do (shen.unbindv V3770 V3886) Result))) false))) (if (shen.pvar? V3769) (let B (shen.newpv V3886) (do (shen.bindv V3769 (cons --> (cons B ())) V3886) (let Result (let Z (shen.newpv V3886) (let X&& (shen.newpv V3886) (do (shen.incinfs) (cut Throwcontrol V3886 (freeze (bind X&& (shen.placeholder) V3886 (freeze (bind Z (shen.ebr (shen.lazyderef X&& V3886) (shen.lazyderef X V3886) (shen.lazyderef Y V3886)) V3886 (freeze (shen.th* Z B (cons (cons X&& (cons : (cons A ()))) V3885) V3886 V3887)))))))))) (do (shen.unbindv V3769 V3886) Result)))) false)))) (if (shen.pvar? V3768) (let A (shen.newpv V3886) (let B (shen.newpv V3886) (do (shen.bindv V3768 (cons A (cons --> (cons B ()))) V3886) (let Result (let Z (shen.newpv V3886) (let X&& (shen.newpv V3886) (do (shen.incinfs) (cut Throwcontrol V3886 (freeze (bind X&& (shen.placeholder) V3886 (freeze (bind Z (shen.ebr (shen.lazyderef X&& V3886) (shen.lazyderef X V3886) (shen.lazyderef Y V3886)) V3886 (freeze (shen.th* Z B (cons (cons X&& (cons : (cons A ()))) V3885) V3886 V3887)))))))))) (do (shen.unbindv V3768 V3886) Result))))) false))) false))) false))) false)) false)) false)) (if (= Case false) (let Case (let V3775 (shen.lazyderef V3883 V3886) (if (cons? V3775) (let V3776 (shen.lazyderef (hd V3775) V3886) (if (= let V3776) (let V3777 (shen.lazyderef (tl V3775) V3886) (if (cons? V3777) (let X (hd V3777) (let V3778 (shen.lazyderef (tl V3777) V3886) (if (cons? V3778) (let Y (hd V3778) (let V3779 (shen.lazyderef (tl V3778) V3886) (if (cons? V3779) (let Z (hd V3779) (let V3780 (shen.lazyderef (tl V3779) V3886) (if (= () V3780) (let W (shen.newpv V3886) (let X&& (shen.newpv V3886) (let B (shen.newpv V3886) (do (shen.incinfs) (shen.th* Y B V3885 V3886 (freeze (bind X&& (shen.placeholder) V3886 (freeze (bind W (shen.ebr (shen.lazyderef X&& V3886) (shen.lazyderef X V3886) (shen.lazyderef Z V3886)) V3886 (freeze (shen.th* W V3884 (cons (cons X&& (cons : (cons B ()))) V3885) V3886 V3887))))))))))) false))) false))) false))) false)) false)) false)) (if (= Case false) (let Case (let V3781 (shen.lazyderef V3883 V3886) (if (cons? V3781) (let V3782 (shen.lazyderef (hd V3781) V3886) (if (= open V3782) (let V3783 (shen.lazyderef (tl V3781) V3886) (if (cons? V3783) (let FileName (hd V3783) (let V3784 (shen.lazyderef (tl V3783) V3886) (if (cons? V3784) (let Direction3714 (hd V3784) (let V3785 (shen.lazyderef (tl V3784) V3886) (if (= () V3785) (let V3786 (shen.lazyderef V3884 V3886) (if (cons? V3786) (let V3787 (shen.lazyderef (hd V3786) V3886) (if (= stream V3787) (let V3788 (shen.lazyderef (tl V3786) V3886) (if (cons? V3788) (let Direction (hd V3788) (let V3789 (shen.lazyderef (tl V3788) V3886) (if (= () V3789) (do (shen.incinfs) (unify! Direction Direction3714 V3886 (freeze (cut Throwcontrol V3886 (freeze (fwhen (element? (shen.lazyderef Direction V3886) (cons in (cons out ()))) V3886 (freeze (shen.th* FileName string V3885 V3886 V3887)))))))) (if (shen.pvar? V3789) (do (shen.bindv V3789 () V3886) (let Result (do (shen.incinfs) (unify! Direction Direction3714 V3886 (freeze (cut Throwcontrol V3886 (freeze (fwhen (element? (shen.lazyderef Direction V3886) (cons in (cons out ()))) V3886 (freeze (shen.th* FileName string V3885 V3886 V3887)))))))) (do (shen.unbindv V3789 V3886) Result))) false)))) (if (shen.pvar? V3788) (let Direction (shen.newpv V3886) (do (shen.bindv V3788 (cons Direction ()) V3886) (let Result (do (shen.incinfs) (unify! Direction Direction3714 V3886 (freeze (cut Throwcontrol V3886 (freeze (fwhen (element? (shen.lazyderef Direction V3886) (cons in (cons out ()))) V3886 (freeze (shen.th* FileName string V3885 V3886 V3887)))))))) (do (shen.unbindv V3788 V3886) Result)))) false))) (if (shen.pvar? V3787) (do (shen.bindv V3787 stream V3886) (let Result (let V3790 (shen.lazyderef (tl V3786) V3886) (if (cons? V3790) (let Direction (hd V3790) (let V3791 (shen.lazyderef (tl V3790) V3886) (if (= () V3791) (do (shen.incinfs) (unify! Direction Direction3714 V3886 (freeze (cut Throwcontrol V3886 (freeze (fwhen (element? (shen.lazyderef Direction V3886) (cons in (cons out ()))) V3886 (freeze (shen.th* FileName string V3885 V3886 V3887)))))))) (if (shen.pvar? V3791) (do (shen.bindv V3791 () V3886) (let Result (do (shen.incinfs) (unify! Direction Direction3714 V3886 (freeze (cut Throwcontrol V3886 (freeze (fwhen (element? (shen.lazyderef Direction V3886) (cons in (cons out ()))) V3886 (freeze (shen.th* FileName string V3885 V3886 V3887)))))))) (do (shen.unbindv V3791 V3886) Result))) false)))) (if (shen.pvar? V3790) (let Direction (shen.newpv V3886) (do (shen.bindv V3790 (cons Direction ()) V3886) (let Result (do (shen.incinfs) (unify! Direction Direction3714 V3886 (freeze (cut Throwcontrol V3886 (freeze (fwhen (element? (shen.lazyderef Direction V3886) (cons in (cons out ()))) V3886 (freeze (shen.th* FileName string V3885 V3886 V3887)))))))) (do (shen.unbindv V3790 V3886) Result)))) false))) (do (shen.unbindv V3787 V3886) Result))) false))) (if (shen.pvar? V3786) (let Direction (shen.newpv V3886) (do (shen.bindv V3786 (cons stream (cons Direction ())) V3886) (let Result (do (shen.incinfs) (unify! Direction Direction3714 V3886 (freeze (cut Throwcontrol V3886 (freeze (fwhen (element? (shen.lazyderef Direction V3886) (cons in (cons out ()))) V3886 (freeze (shen.th* FileName string V3885 V3886 V3887)))))))) (do (shen.unbindv V3786 V3886) Result)))) false))) false))) false))) false)) false)) false)) (if (= Case false) (let Case (let V3792 (shen.lazyderef V3883 V3886) (if (cons? V3792) (let V3793 (shen.lazyderef (hd V3792) V3886) (if (= type V3793) (let V3794 (shen.lazyderef (tl V3792) V3886) (if (cons? V3794) (let X (hd V3794) (let V3795 (shen.lazyderef (tl V3794) V3886) (if (cons? V3795) (let A (hd V3795) (let V3796 (shen.lazyderef (tl V3795) V3886) (if (= () V3796) (do (shen.incinfs) (cut Throwcontrol V3886 (freeze (unify A V3884 V3886 (freeze (shen.th* X A V3885 V3886 V3887)))))) false))) false))) false)) false)) false)) (if (= Case false) (let Case (let V3797 (shen.lazyderef V3883 V3886) (if (cons? V3797) (let V3798 (shen.lazyderef (hd V3797) V3886) (if (= input+ V3798) (let V3799 (shen.lazyderef (tl V3797) V3886) (if (cons? V3799) (let A (hd V3799) (let V3800 (shen.lazyderef (tl V3799) V3886) (if (cons? V3800) (let Stream (hd V3800) (let V3801 (shen.lazyderef (tl V3800) V3886) (if (= () V3801) (let C (shen.newpv V3886) (do (shen.incinfs) (bind C (shen.demodulate (shen.lazyderef A V3886)) V3886 (freeze (unify V3884 C V3886 (freeze (shen.th* Stream (cons stream (cons in ())) V3885 V3886 V3887))))))) false))) false))) false)) false)) false)) (if (= Case false) (let Case (let V3802 (shen.lazyderef V3883 V3886) (if (cons? V3802) (let V3803 (shen.lazyderef (hd V3802) V3886) (if (= set V3803) (let V3804 (shen.lazyderef (tl V3802) V3886) (if (cons? V3804) (let Var (hd V3804) (let V3805 (shen.lazyderef (tl V3804) V3886) (if (cons? V3805) (let Val (hd V3805) (let V3806 (shen.lazyderef (tl V3805) V3886) (if (= () V3806) (do (shen.incinfs) (cut Throwcontrol V3886 (freeze (shen.th* Var symbol V3885 V3886 (freeze (cut Throwcontrol V3886 (freeze (shen.th* (cons value (cons Var ())) V3884 V3885 V3886 (freeze (shen.th* Val V3884 V3885 V3886 V3887)))))))))) false))) false))) false)) false)) false)) (if (= Case false) (let Case (let NewHyp (shen.newpv V3886) (do (shen.incinfs) (shen.t*-hyps V3885 NewHyp V3886 (freeze (shen.th* V3883 V3884 NewHyp V3886 V3887))))) (if (= Case false) (let Case (let V3807 (shen.lazyderef V3883 V3886) (if (cons? V3807) (let V3808 (shen.lazyderef (hd V3807) V3886) (if (= define V3808) (let V3809 (shen.lazyderef (tl V3807) V3886) (if (cons? V3809) (let F (hd V3809) (let X (tl V3809) (do (shen.incinfs) (cut Throwcontrol V3886 (freeze (shen.t*-def (cons define (cons F X)) V3884 V3885 V3886 V3887)))))) false)) false)) false)) (if (= Case false) (let Case (let V3810 (shen.lazyderef V3883 V3886) (if (cons? V3810) (let V3811 (shen.lazyderef (hd V3810) V3886) (if (= defmacro V3811) (let V3812 (shen.lazyderef V3884 V3886) (if (= unit V3812) (do (shen.incinfs) (cut Throwcontrol V3886 V3887)) (if (shen.pvar? V3812) (do (shen.bindv V3812 unit V3886) (let Result (do (shen.incinfs) (cut Throwcontrol V3886 V3887)) (do (shen.unbindv V3812 V3886) Result))) false))) false)) false)) (if (= Case false) (let Case (let V3813 (shen.lazyderef V3883 V3886) (if (cons? V3813) (let V3814 (shen.lazyderef (hd V3813) V3886) (if (= shen.process-datatype V3814) (let V3815 (shen.lazyderef V3884 V3886) (if (= symbol V3815) (do (shen.incinfs) (thaw V3887)) (if (shen.pvar? V3815) (do (shen.bindv V3815 symbol V3886) (let Result (do (shen.incinfs) (thaw V3887)) (do (shen.unbindv V3815 V3886) Result))) false))) false)) false)) (if (= Case false) (let Case (let V3816 (shen.lazyderef V3883 V3886) (if (cons? V3816) (let V3817 (shen.lazyderef (hd V3816) V3886) (if (= shen.synonyms-help V3817) (let V3818 (shen.lazyderef V3884 V3886) (if (= symbol V3818) (do (shen.incinfs) (thaw V3887)) (if (shen.pvar? V3818) (do (shen.bindv V3818 symbol V3886) (let Result (do (shen.incinfs) (thaw V3887)) (do (shen.unbindv V3818 V3886) Result))) false))) false)) false)) (if (= Case false) (let Datatypes (shen.newpv V3886) (do (shen.incinfs) (bind Datatypes (value shen.*datatypes*) V3886 (freeze (shen.udefs* (cons V3883 (cons : (cons V3884 ()))) V3885 Datatypes V3886 V3887))))) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case))))) +(defun shen.th* (V2722 V2723 V2724 V2725 V2726) (let Throwcontrol (shen.catchpoint) (shen.cutpoint Throwcontrol (let Case (do (shen.incinfs) (shen.show (cons V2722 (cons : (cons V2723 ()))) V2724 V2725 (freeze (fwhen false V2725 V2726)))) (if (= Case false) (let Case (let F (shen.newpv V2725) (do (shen.incinfs) (fwhen (shen.typedf? (shen.lazyderef V2722 V2725)) V2725 (freeze (bind F (shen.sigf (shen.lazyderef V2722 V2725)) V2725 (freeze (call (cons F (cons V2723 ())) V2725 V2726))))))) (if (= Case false) (let Case (do (shen.incinfs) (shen.base V2722 V2723 V2725 V2726)) (if (= Case false) (let Case (do (shen.incinfs) (shen.by_hypothesis V2722 V2723 V2724 V2725 V2726)) (if (= Case false) (let Case (let V2557 (shen.lazyderef V2722 V2725) (if (cons? V2557) (let F (hd V2557) (let V2558 (shen.lazyderef (tl V2557) V2725) (if (= () V2558) (do (shen.incinfs) (shen.th* F (cons --> (cons V2723 ())) V2724 V2725 V2726)) false))) false)) (if (= Case false) (let Case (let V2559 (shen.lazyderef V2722 V2725) (if (cons? V2559) (let F (hd V2559) (let V2560 (shen.lazyderef (tl V2559) V2725) (if (cons? V2560) (let X (hd V2560) (let V2561 (shen.lazyderef (tl V2560) V2725) (if (= () V2561) (let B (shen.newpv V2725) (do (shen.incinfs) (shen.th* F (cons B (cons --> (cons V2723 ()))) V2724 V2725 (freeze (shen.th* X B V2724 V2725 V2726))))) false))) false))) false)) (if (= Case false) (let Case (let V2562 (shen.lazyderef V2722 V2725) (if (cons? V2562) (let V2563 (shen.lazyderef (hd V2562) V2725) (if (= cons V2563) (let V2564 (shen.lazyderef (tl V2562) V2725) (if (cons? V2564) (let X (hd V2564) (let V2565 (shen.lazyderef (tl V2564) V2725) (if (cons? V2565) (let Y (hd V2565) (let V2566 (shen.lazyderef (tl V2565) V2725) (if (= () V2566) (let V2567 (shen.lazyderef V2723 V2725) (if (cons? V2567) (let V2568 (shen.lazyderef (hd V2567) V2725) (if (= list V2568) (let V2569 (shen.lazyderef (tl V2567) V2725) (if (cons? V2569) (let A (hd V2569) (let V2570 (shen.lazyderef (tl V2569) V2725) (if (= () V2570) (do (shen.incinfs) (shen.th* X A V2724 V2725 (freeze (shen.th* Y (cons list (cons A ())) V2724 V2725 V2726)))) (if (shen.pvar? V2570) (do (shen.bindv V2570 () V2725) (let Result (do (shen.incinfs) (shen.th* X A V2724 V2725 (freeze (shen.th* Y (cons list (cons A ())) V2724 V2725 V2726)))) (do (shen.unbindv V2570 V2725) Result))) false)))) (if (shen.pvar? V2569) (let A (shen.newpv V2725) (do (shen.bindv V2569 (cons A ()) V2725) (let Result (do (shen.incinfs) (shen.th* X A V2724 V2725 (freeze (shen.th* Y (cons list (cons A ())) V2724 V2725 V2726)))) (do (shen.unbindv V2569 V2725) Result)))) false))) (if (shen.pvar? V2568) (do (shen.bindv V2568 list V2725) (let Result (let V2571 (shen.lazyderef (tl V2567) V2725) (if (cons? V2571) (let A (hd V2571) (let V2572 (shen.lazyderef (tl V2571) V2725) (if (= () V2572) (do (shen.incinfs) (shen.th* X A V2724 V2725 (freeze (shen.th* Y (cons list (cons A ())) V2724 V2725 V2726)))) (if (shen.pvar? V2572) (do (shen.bindv V2572 () V2725) (let Result (do (shen.incinfs) (shen.th* X A V2724 V2725 (freeze (shen.th* Y (cons list (cons A ())) V2724 V2725 V2726)))) (do (shen.unbindv V2572 V2725) Result))) false)))) (if (shen.pvar? V2571) (let A (shen.newpv V2725) (do (shen.bindv V2571 (cons A ()) V2725) (let Result (do (shen.incinfs) (shen.th* X A V2724 V2725 (freeze (shen.th* Y (cons list (cons A ())) V2724 V2725 V2726)))) (do (shen.unbindv V2571 V2725) Result)))) false))) (do (shen.unbindv V2568 V2725) Result))) false))) (if (shen.pvar? V2567) (let A (shen.newpv V2725) (do (shen.bindv V2567 (cons list (cons A ())) V2725) (let Result (do (shen.incinfs) (shen.th* X A V2724 V2725 (freeze (shen.th* Y (cons list (cons A ())) V2724 V2725 V2726)))) (do (shen.unbindv V2567 V2725) Result)))) false))) false))) false))) false)) false)) false)) (if (= Case false) (let Case (let V2573 (shen.lazyderef V2722 V2725) (if (cons? V2573) (let V2574 (shen.lazyderef (hd V2573) V2725) (if (= @p V2574) (let V2575 (shen.lazyderef (tl V2573) V2725) (if (cons? V2575) (let X (hd V2575) (let V2576 (shen.lazyderef (tl V2575) V2725) (if (cons? V2576) (let Y (hd V2576) (let V2577 (shen.lazyderef (tl V2576) V2725) (if (= () V2577) (let V2578 (shen.lazyderef V2723 V2725) (if (cons? V2578) (let A (hd V2578) (let V2579 (shen.lazyderef (tl V2578) V2725) (if (cons? V2579) (let V2580 (shen.lazyderef (hd V2579) V2725) (if (= * V2580) (let V2581 (shen.lazyderef (tl V2579) V2725) (if (cons? V2581) (let B (hd V2581) (let V2582 (shen.lazyderef (tl V2581) V2725) (if (= () V2582) (do (shen.incinfs) (shen.th* X A V2724 V2725 (freeze (shen.th* Y B V2724 V2725 V2726)))) (if (shen.pvar? V2582) (do (shen.bindv V2582 () V2725) (let Result (do (shen.incinfs) (shen.th* X A V2724 V2725 (freeze (shen.th* Y B V2724 V2725 V2726)))) (do (shen.unbindv V2582 V2725) Result))) false)))) (if (shen.pvar? V2581) (let B (shen.newpv V2725) (do (shen.bindv V2581 (cons B ()) V2725) (let Result (do (shen.incinfs) (shen.th* X A V2724 V2725 (freeze (shen.th* Y B V2724 V2725 V2726)))) (do (shen.unbindv V2581 V2725) Result)))) false))) (if (shen.pvar? V2580) (do (shen.bindv V2580 * V2725) (let Result (let V2583 (shen.lazyderef (tl V2579) V2725) (if (cons? V2583) (let B (hd V2583) (let V2584 (shen.lazyderef (tl V2583) V2725) (if (= () V2584) (do (shen.incinfs) (shen.th* X A V2724 V2725 (freeze (shen.th* Y B V2724 V2725 V2726)))) (if (shen.pvar? V2584) (do (shen.bindv V2584 () V2725) (let Result (do (shen.incinfs) (shen.th* X A V2724 V2725 (freeze (shen.th* Y B V2724 V2725 V2726)))) (do (shen.unbindv V2584 V2725) Result))) false)))) (if (shen.pvar? V2583) (let B (shen.newpv V2725) (do (shen.bindv V2583 (cons B ()) V2725) (let Result (do (shen.incinfs) (shen.th* X A V2724 V2725 (freeze (shen.th* Y B V2724 V2725 V2726)))) (do (shen.unbindv V2583 V2725) Result)))) false))) (do (shen.unbindv V2580 V2725) Result))) false))) (if (shen.pvar? V2579) (let B (shen.newpv V2725) (do (shen.bindv V2579 (cons * (cons B ())) V2725) (let Result (do (shen.incinfs) (shen.th* X A V2724 V2725 (freeze (shen.th* Y B V2724 V2725 V2726)))) (do (shen.unbindv V2579 V2725) Result)))) false)))) (if (shen.pvar? V2578) (let A (shen.newpv V2725) (let B (shen.newpv V2725) (do (shen.bindv V2578 (cons A (cons * (cons B ()))) V2725) (let Result (do (shen.incinfs) (shen.th* X A V2724 V2725 (freeze (shen.th* Y B V2724 V2725 V2726)))) (do (shen.unbindv V2578 V2725) Result))))) false))) false))) false))) false)) false)) false)) (if (= Case false) (let Case (let V2585 (shen.lazyderef V2722 V2725) (if (cons? V2585) (let V2586 (shen.lazyderef (hd V2585) V2725) (if (= @v V2586) (let V2587 (shen.lazyderef (tl V2585) V2725) (if (cons? V2587) (let X (hd V2587) (let V2588 (shen.lazyderef (tl V2587) V2725) (if (cons? V2588) (let Y (hd V2588) (let V2589 (shen.lazyderef (tl V2588) V2725) (if (= () V2589) (let V2590 (shen.lazyderef V2723 V2725) (if (cons? V2590) (let V2591 (shen.lazyderef (hd V2590) V2725) (if (= vector V2591) (let V2592 (shen.lazyderef (tl V2590) V2725) (if (cons? V2592) (let A (hd V2592) (let V2593 (shen.lazyderef (tl V2592) V2725) (if (= () V2593) (do (shen.incinfs) (shen.th* X A V2724 V2725 (freeze (shen.th* Y (cons vector (cons A ())) V2724 V2725 V2726)))) (if (shen.pvar? V2593) (do (shen.bindv V2593 () V2725) (let Result (do (shen.incinfs) (shen.th* X A V2724 V2725 (freeze (shen.th* Y (cons vector (cons A ())) V2724 V2725 V2726)))) (do (shen.unbindv V2593 V2725) Result))) false)))) (if (shen.pvar? V2592) (let A (shen.newpv V2725) (do (shen.bindv V2592 (cons A ()) V2725) (let Result (do (shen.incinfs) (shen.th* X A V2724 V2725 (freeze (shen.th* Y (cons vector (cons A ())) V2724 V2725 V2726)))) (do (shen.unbindv V2592 V2725) Result)))) false))) (if (shen.pvar? V2591) (do (shen.bindv V2591 vector V2725) (let Result (let V2594 (shen.lazyderef (tl V2590) V2725) (if (cons? V2594) (let A (hd V2594) (let V2595 (shen.lazyderef (tl V2594) V2725) (if (= () V2595) (do (shen.incinfs) (shen.th* X A V2724 V2725 (freeze (shen.th* Y (cons vector (cons A ())) V2724 V2725 V2726)))) (if (shen.pvar? V2595) (do (shen.bindv V2595 () V2725) (let Result (do (shen.incinfs) (shen.th* X A V2724 V2725 (freeze (shen.th* Y (cons vector (cons A ())) V2724 V2725 V2726)))) (do (shen.unbindv V2595 V2725) Result))) false)))) (if (shen.pvar? V2594) (let A (shen.newpv V2725) (do (shen.bindv V2594 (cons A ()) V2725) (let Result (do (shen.incinfs) (shen.th* X A V2724 V2725 (freeze (shen.th* Y (cons vector (cons A ())) V2724 V2725 V2726)))) (do (shen.unbindv V2594 V2725) Result)))) false))) (do (shen.unbindv V2591 V2725) Result))) false))) (if (shen.pvar? V2590) (let A (shen.newpv V2725) (do (shen.bindv V2590 (cons vector (cons A ())) V2725) (let Result (do (shen.incinfs) (shen.th* X A V2724 V2725 (freeze (shen.th* Y (cons vector (cons A ())) V2724 V2725 V2726)))) (do (shen.unbindv V2590 V2725) Result)))) false))) false))) false))) false)) false)) false)) (if (= Case false) (let Case (let V2596 (shen.lazyderef V2722 V2725) (if (cons? V2596) (let V2597 (shen.lazyderef (hd V2596) V2725) (if (= @s V2597) (let V2598 (shen.lazyderef (tl V2596) V2725) (if (cons? V2598) (let X (hd V2598) (let V2599 (shen.lazyderef (tl V2598) V2725) (if (cons? V2599) (let Y (hd V2599) (let V2600 (shen.lazyderef (tl V2599) V2725) (if (= () V2600) (let V2601 (shen.lazyderef V2723 V2725) (if (= string V2601) (do (shen.incinfs) (shen.th* X string V2724 V2725 (freeze (shen.th* Y string V2724 V2725 V2726)))) (if (shen.pvar? V2601) (do (shen.bindv V2601 string V2725) (let Result (do (shen.incinfs) (shen.th* X string V2724 V2725 (freeze (shen.th* Y string V2724 V2725 V2726)))) (do (shen.unbindv V2601 V2725) Result))) false))) false))) false))) false)) false)) false)) (if (= Case false) (let Case (let V2602 (shen.lazyderef V2722 V2725) (if (cons? V2602) (let V2603 (shen.lazyderef (hd V2602) V2725) (if (= lambda V2603) (let V2604 (shen.lazyderef (tl V2602) V2725) (if (cons? V2604) (let X (hd V2604) (let V2605 (shen.lazyderef (tl V2604) V2725) (if (cons? V2605) (let Y (hd V2605) (let V2606 (shen.lazyderef (tl V2605) V2725) (if (= () V2606) (let V2607 (shen.lazyderef V2723 V2725) (if (cons? V2607) (let A (hd V2607) (let V2608 (shen.lazyderef (tl V2607) V2725) (if (cons? V2608) (let V2609 (shen.lazyderef (hd V2608) V2725) (if (= --> V2609) (let V2610 (shen.lazyderef (tl V2608) V2725) (if (cons? V2610) (let B (hd V2610) (let V2611 (shen.lazyderef (tl V2610) V2725) (if (= () V2611) (let Z (shen.newpv V2725) (let X&& (shen.newpv V2725) (do (shen.incinfs) (bind X&& (shen.placeholder) V2725 (freeze (bind Z (shen.ebr (shen.lazyderef X&& V2725) (shen.lazyderef X V2725) (shen.lazyderef Y V2725)) V2725 (freeze (shen.th* Z B (cons (cons X&& (cons : (cons A ()))) V2724) V2725 V2726)))))))) (if (shen.pvar? V2611) (do (shen.bindv V2611 () V2725) (let Result (let Z (shen.newpv V2725) (let X&& (shen.newpv V2725) (do (shen.incinfs) (bind X&& (shen.placeholder) V2725 (freeze (bind Z (shen.ebr (shen.lazyderef X&& V2725) (shen.lazyderef X V2725) (shen.lazyderef Y V2725)) V2725 (freeze (shen.th* Z B (cons (cons X&& (cons : (cons A ()))) V2724) V2725 V2726)))))))) (do (shen.unbindv V2611 V2725) Result))) false)))) (if (shen.pvar? V2610) (let B (shen.newpv V2725) (do (shen.bindv V2610 (cons B ()) V2725) (let Result (let Z (shen.newpv V2725) (let X&& (shen.newpv V2725) (do (shen.incinfs) (bind X&& (shen.placeholder) V2725 (freeze (bind Z (shen.ebr (shen.lazyderef X&& V2725) (shen.lazyderef X V2725) (shen.lazyderef Y V2725)) V2725 (freeze (shen.th* Z B (cons (cons X&& (cons : (cons A ()))) V2724) V2725 V2726)))))))) (do (shen.unbindv V2610 V2725) Result)))) false))) (if (shen.pvar? V2609) (do (shen.bindv V2609 --> V2725) (let Result (let V2612 (shen.lazyderef (tl V2608) V2725) (if (cons? V2612) (let B (hd V2612) (let V2613 (shen.lazyderef (tl V2612) V2725) (if (= () V2613) (let Z (shen.newpv V2725) (let X&& (shen.newpv V2725) (do (shen.incinfs) (bind X&& (shen.placeholder) V2725 (freeze (bind Z (shen.ebr (shen.lazyderef X&& V2725) (shen.lazyderef X V2725) (shen.lazyderef Y V2725)) V2725 (freeze (shen.th* Z B (cons (cons X&& (cons : (cons A ()))) V2724) V2725 V2726)))))))) (if (shen.pvar? V2613) (do (shen.bindv V2613 () V2725) (let Result (let Z (shen.newpv V2725) (let X&& (shen.newpv V2725) (do (shen.incinfs) (bind X&& (shen.placeholder) V2725 (freeze (bind Z (shen.ebr (shen.lazyderef X&& V2725) (shen.lazyderef X V2725) (shen.lazyderef Y V2725)) V2725 (freeze (shen.th* Z B (cons (cons X&& (cons : (cons A ()))) V2724) V2725 V2726)))))))) (do (shen.unbindv V2613 V2725) Result))) false)))) (if (shen.pvar? V2612) (let B (shen.newpv V2725) (do (shen.bindv V2612 (cons B ()) V2725) (let Result (let Z (shen.newpv V2725) (let X&& (shen.newpv V2725) (do (shen.incinfs) (bind X&& (shen.placeholder) V2725 (freeze (bind Z (shen.ebr (shen.lazyderef X&& V2725) (shen.lazyderef X V2725) (shen.lazyderef Y V2725)) V2725 (freeze (shen.th* Z B (cons (cons X&& (cons : (cons A ()))) V2724) V2725 V2726)))))))) (do (shen.unbindv V2612 V2725) Result)))) false))) (do (shen.unbindv V2609 V2725) Result))) false))) (if (shen.pvar? V2608) (let B (shen.newpv V2725) (do (shen.bindv V2608 (cons --> (cons B ())) V2725) (let Result (let Z (shen.newpv V2725) (let X&& (shen.newpv V2725) (do (shen.incinfs) (bind X&& (shen.placeholder) V2725 (freeze (bind Z (shen.ebr (shen.lazyderef X&& V2725) (shen.lazyderef X V2725) (shen.lazyderef Y V2725)) V2725 (freeze (shen.th* Z B (cons (cons X&& (cons : (cons A ()))) V2724) V2725 V2726)))))))) (do (shen.unbindv V2608 V2725) Result)))) false)))) (if (shen.pvar? V2607) (let A (shen.newpv V2725) (let B (shen.newpv V2725) (do (shen.bindv V2607 (cons A (cons --> (cons B ()))) V2725) (let Result (let Z (shen.newpv V2725) (let X&& (shen.newpv V2725) (do (shen.incinfs) (bind X&& (shen.placeholder) V2725 (freeze (bind Z (shen.ebr (shen.lazyderef X&& V2725) (shen.lazyderef X V2725) (shen.lazyderef Y V2725)) V2725 (freeze (shen.th* Z B (cons (cons X&& (cons : (cons A ()))) V2724) V2725 V2726)))))))) (do (shen.unbindv V2607 V2725) Result))))) false))) false))) false))) false)) false)) false)) (if (= Case false) (let Case (let V2614 (shen.lazyderef V2722 V2725) (if (cons? V2614) (let V2615 (shen.lazyderef (hd V2614) V2725) (if (= let V2615) (let V2616 (shen.lazyderef (tl V2614) V2725) (if (cons? V2616) (let X (hd V2616) (let V2617 (shen.lazyderef (tl V2616) V2725) (if (cons? V2617) (let Y (hd V2617) (let V2618 (shen.lazyderef (tl V2617) V2725) (if (cons? V2618) (let Z (hd V2618) (let V2619 (shen.lazyderef (tl V2618) V2725) (if (= () V2619) (let W (shen.newpv V2725) (let X&& (shen.newpv V2725) (let B (shen.newpv V2725) (do (shen.incinfs) (shen.th* Y B V2724 V2725 (freeze (bind X&& (shen.placeholder) V2725 (freeze (bind W (shen.ebr (shen.lazyderef X&& V2725) (shen.lazyderef X V2725) (shen.lazyderef Z V2725)) V2725 (freeze (shen.th* W V2723 (cons (cons X&& (cons : (cons B ()))) V2724) V2725 V2726))))))))))) false))) false))) false))) false)) false)) false)) (if (= Case false) (let Case (let V2620 (shen.lazyderef V2722 V2725) (if (cons? V2620) (let V2621 (shen.lazyderef (hd V2620) V2725) (if (= open V2621) (let V2622 (shen.lazyderef (tl V2620) V2725) (if (cons? V2622) (let FileName (hd V2622) (let V2623 (shen.lazyderef (tl V2622) V2725) (if (cons? V2623) (let Direction2553 (hd V2623) (let V2624 (shen.lazyderef (tl V2623) V2725) (if (= () V2624) (let V2625 (shen.lazyderef V2723 V2725) (if (cons? V2625) (let V2626 (shen.lazyderef (hd V2625) V2725) (if (= stream V2626) (let V2627 (shen.lazyderef (tl V2625) V2725) (if (cons? V2627) (let Direction (hd V2627) (let V2628 (shen.lazyderef (tl V2627) V2725) (if (= () V2628) (do (shen.incinfs) (unify! Direction Direction2553 V2725 (freeze (cut Throwcontrol V2725 (freeze (fwhen (element? (shen.lazyderef Direction V2725) (cons in (cons out ()))) V2725 (freeze (shen.th* FileName string V2724 V2725 V2726)))))))) (if (shen.pvar? V2628) (do (shen.bindv V2628 () V2725) (let Result (do (shen.incinfs) (unify! Direction Direction2553 V2725 (freeze (cut Throwcontrol V2725 (freeze (fwhen (element? (shen.lazyderef Direction V2725) (cons in (cons out ()))) V2725 (freeze (shen.th* FileName string V2724 V2725 V2726)))))))) (do (shen.unbindv V2628 V2725) Result))) false)))) (if (shen.pvar? V2627) (let Direction (shen.newpv V2725) (do (shen.bindv V2627 (cons Direction ()) V2725) (let Result (do (shen.incinfs) (unify! Direction Direction2553 V2725 (freeze (cut Throwcontrol V2725 (freeze (fwhen (element? (shen.lazyderef Direction V2725) (cons in (cons out ()))) V2725 (freeze (shen.th* FileName string V2724 V2725 V2726)))))))) (do (shen.unbindv V2627 V2725) Result)))) false))) (if (shen.pvar? V2626) (do (shen.bindv V2626 stream V2725) (let Result (let V2629 (shen.lazyderef (tl V2625) V2725) (if (cons? V2629) (let Direction (hd V2629) (let V2630 (shen.lazyderef (tl V2629) V2725) (if (= () V2630) (do (shen.incinfs) (unify! Direction Direction2553 V2725 (freeze (cut Throwcontrol V2725 (freeze (fwhen (element? (shen.lazyderef Direction V2725) (cons in (cons out ()))) V2725 (freeze (shen.th* FileName string V2724 V2725 V2726)))))))) (if (shen.pvar? V2630) (do (shen.bindv V2630 () V2725) (let Result (do (shen.incinfs) (unify! Direction Direction2553 V2725 (freeze (cut Throwcontrol V2725 (freeze (fwhen (element? (shen.lazyderef Direction V2725) (cons in (cons out ()))) V2725 (freeze (shen.th* FileName string V2724 V2725 V2726)))))))) (do (shen.unbindv V2630 V2725) Result))) false)))) (if (shen.pvar? V2629) (let Direction (shen.newpv V2725) (do (shen.bindv V2629 (cons Direction ()) V2725) (let Result (do (shen.incinfs) (unify! Direction Direction2553 V2725 (freeze (cut Throwcontrol V2725 (freeze (fwhen (element? (shen.lazyderef Direction V2725) (cons in (cons out ()))) V2725 (freeze (shen.th* FileName string V2724 V2725 V2726)))))))) (do (shen.unbindv V2629 V2725) Result)))) false))) (do (shen.unbindv V2626 V2725) Result))) false))) (if (shen.pvar? V2625) (let Direction (shen.newpv V2725) (do (shen.bindv V2625 (cons stream (cons Direction ())) V2725) (let Result (do (shen.incinfs) (unify! Direction Direction2553 V2725 (freeze (cut Throwcontrol V2725 (freeze (fwhen (element? (shen.lazyderef Direction V2725) (cons in (cons out ()))) V2725 (freeze (shen.th* FileName string V2724 V2725 V2726)))))))) (do (shen.unbindv V2625 V2725) Result)))) false))) false))) false))) false)) false)) false)) (if (= Case false) (let Case (let V2631 (shen.lazyderef V2722 V2725) (if (cons? V2631) (let V2632 (shen.lazyderef (hd V2631) V2725) (if (= type V2632) (let V2633 (shen.lazyderef (tl V2631) V2725) (if (cons? V2633) (let X (hd V2633) (let V2634 (shen.lazyderef (tl V2633) V2725) (if (cons? V2634) (let A (hd V2634) (let V2635 (shen.lazyderef (tl V2634) V2725) (if (= () V2635) (do (shen.incinfs) (cut Throwcontrol V2725 (freeze (unify A V2723 V2725 (freeze (shen.th* X A V2724 V2725 V2726)))))) false))) false))) false)) false)) false)) (if (= Case false) (let Case (let V2636 (shen.lazyderef V2722 V2725) (if (cons? V2636) (let V2637 (shen.lazyderef (hd V2636) V2725) (if (= input+ V2637) (let V2638 (shen.lazyderef (tl V2636) V2725) (if (cons? V2638) (let A (hd V2638) (let V2639 (shen.lazyderef (tl V2638) V2725) (if (cons? V2639) (let Stream (hd V2639) (let V2640 (shen.lazyderef (tl V2639) V2725) (if (= () V2640) (let C (shen.newpv V2725) (do (shen.incinfs) (bind C (shen.demodulate (shen.lazyderef A V2725)) V2725 (freeze (unify V2723 C V2725 (freeze (shen.th* Stream (cons stream (cons in ())) V2724 V2725 V2726))))))) false))) false))) false)) false)) false)) (if (= Case false) (let Case (let V2641 (shen.lazyderef V2722 V2725) (if (cons? V2641) (let V2642 (shen.lazyderef (hd V2641) V2725) (if (= set V2642) (let V2643 (shen.lazyderef (tl V2641) V2725) (if (cons? V2643) (let Var (hd V2643) (let V2644 (shen.lazyderef (tl V2643) V2725) (if (cons? V2644) (let Val (hd V2644) (let V2645 (shen.lazyderef (tl V2644) V2725) (if (= () V2645) (do (shen.incinfs) (cut Throwcontrol V2725 (freeze (shen.th* Var symbol V2724 V2725 (freeze (cut Throwcontrol V2725 (freeze (shen.th* (cons value (cons Var ())) V2723 V2724 V2725 (freeze (shen.th* Val V2723 V2724 V2725 V2726)))))))))) false))) false))) false)) false)) false)) (if (= Case false) (let Case (let NewHyp (shen.newpv V2725) (do (shen.incinfs) (shen.t*-hyps V2724 NewHyp V2725 (freeze (shen.th* V2722 V2723 NewHyp V2725 V2726))))) (if (= Case false) (let Case (let V2646 (shen.lazyderef V2722 V2725) (if (cons? V2646) (let V2647 (shen.lazyderef (hd V2646) V2725) (if (= define V2647) (let V2648 (shen.lazyderef (tl V2646) V2725) (if (cons? V2648) (let F (hd V2648) (let X (tl V2648) (do (shen.incinfs) (cut Throwcontrol V2725 (freeze (shen.t*-def (cons define (cons F X)) V2723 V2724 V2725 V2726)))))) false)) false)) false)) (if (= Case false) (let Case (let V2649 (shen.lazyderef V2722 V2725) (if (cons? V2649) (let V2650 (shen.lazyderef (hd V2649) V2725) (if (= defmacro V2650) (let V2651 (shen.lazyderef V2723 V2725) (if (= unit V2651) (do (shen.incinfs) (cut Throwcontrol V2725 V2726)) (if (shen.pvar? V2651) (do (shen.bindv V2651 unit V2725) (let Result (do (shen.incinfs) (cut Throwcontrol V2725 V2726)) (do (shen.unbindv V2651 V2725) Result))) false))) false)) false)) (if (= Case false) (let Case (let V2652 (shen.lazyderef V2722 V2725) (if (cons? V2652) (let V2653 (shen.lazyderef (hd V2652) V2725) (if (= shen.process-datatype V2653) (let V2654 (shen.lazyderef V2723 V2725) (if (= symbol V2654) (do (shen.incinfs) (thaw V2726)) (if (shen.pvar? V2654) (do (shen.bindv V2654 symbol V2725) (let Result (do (shen.incinfs) (thaw V2726)) (do (shen.unbindv V2654 V2725) Result))) false))) false)) false)) (if (= Case false) (let Case (let V2655 (shen.lazyderef V2722 V2725) (if (cons? V2655) (let V2656 (shen.lazyderef (hd V2655) V2725) (if (= shen.synonyms-help V2656) (let V2657 (shen.lazyderef V2723 V2725) (if (= symbol V2657) (do (shen.incinfs) (thaw V2726)) (if (shen.pvar? V2657) (do (shen.bindv V2657 symbol V2725) (let Result (do (shen.incinfs) (thaw V2726)) (do (shen.unbindv V2657 V2725) Result))) false))) false)) false)) (if (= Case false) (let Datatypes (shen.newpv V2725) (do (shen.incinfs) (bind Datatypes (value shen.*datatypes*) V2725 (freeze (shen.udefs* (cons V2722 (cons : (cons V2723 ()))) V2724 Datatypes V2725 V2726))))) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case)) Case))))) -(defun shen.t*-hyps (V3892 V3893 V3894 V3895) (let Case (let V3629 (shen.lazyderef V3892 V3894) (if (cons? V3629) (let V3630 (shen.lazyderef (hd V3629) V3894) (if (cons? V3630) (let V3631 (shen.lazyderef (hd V3630) V3894) (if (cons? V3631) (let V3632 (shen.lazyderef (hd V3631) V3894) (if (= cons V3632) (let V3633 (shen.lazyderef (tl V3631) V3894) (if (cons? V3633) (let X (hd V3633) (let V3634 (shen.lazyderef (tl V3633) V3894) (if (cons? V3634) (let Y (hd V3634) (let V3635 (shen.lazyderef (tl V3634) V3894) (if (= () V3635) (let V3636 (shen.lazyderef (tl V3630) V3894) (if (cons? V3636) (let V3637 (shen.lazyderef (hd V3636) V3894) (if (= : V3637) (let V3638 (shen.lazyderef (tl V3636) V3894) (if (cons? V3638) (let V3639 (shen.lazyderef (hd V3638) V3894) (if (cons? V3639) (let V3640 (shen.lazyderef (hd V3639) V3894) (if (= list V3640) (let V3641 (shen.lazyderef (tl V3639) V3894) (if (cons? V3641) (let A (hd V3641) (let V3642 (shen.lazyderef (tl V3641) V3894) (if (= () V3642) (let V3643 (shen.lazyderef (tl V3638) V3894) (if (= () V3643) (let Hyp (tl V3629) (do (shen.incinfs) (bind V3893 (cons (cons (shen.lazyderef X V3894) (cons : (cons (shen.lazyderef A V3894) ()))) (cons (cons (shen.lazyderef Y V3894) (cons : (cons (cons list (cons (shen.lazyderef A V3894) ())) ()))) (shen.lazyderef Hyp V3894))) V3894 V3895))) (if (shen.pvar? V3643) (do (shen.bindv V3643 () V3894) (let Result (let Hyp (tl V3629) (do (shen.incinfs) (bind V3893 (cons (cons (shen.lazyderef X V3894) (cons : (cons (shen.lazyderef A V3894) ()))) (cons (cons (shen.lazyderef Y V3894) (cons : (cons (cons list (cons (shen.lazyderef A V3894) ())) ()))) (shen.lazyderef Hyp V3894))) V3894 V3895))) (do (shen.unbindv V3643 V3894) Result))) false))) (if (shen.pvar? V3642) (do (shen.bindv V3642 () V3894) (let Result (let V3644 (shen.lazyderef (tl V3638) V3894) (if (= () V3644) (let Hyp (tl V3629) (do (shen.incinfs) (bind V3893 (cons (cons (shen.lazyderef X V3894) (cons : (cons (shen.lazyderef A V3894) ()))) (cons (cons (shen.lazyderef Y V3894) (cons : (cons (cons list (cons (shen.lazyderef A V3894) ())) ()))) (shen.lazyderef Hyp V3894))) V3894 V3895))) (if (shen.pvar? V3644) (do (shen.bindv V3644 () V3894) (let Result (let Hyp (tl V3629) (do (shen.incinfs) (bind V3893 (cons (cons (shen.lazyderef X V3894) (cons : (cons (shen.lazyderef A V3894) ()))) (cons (cons (shen.lazyderef Y V3894) (cons : (cons (cons list (cons (shen.lazyderef A V3894) ())) ()))) (shen.lazyderef Hyp V3894))) V3894 V3895))) (do (shen.unbindv V3644 V3894) Result))) false))) (do (shen.unbindv V3642 V3894) Result))) false)))) (if (shen.pvar? V3641) (let A (shen.newpv V3894) (do (shen.bindv V3641 (cons A ()) V3894) (let Result (let V3645 (shen.lazyderef (tl V3638) V3894) (if (= () V3645) (let Hyp (tl V3629) (do (shen.incinfs) (bind V3893 (cons (cons (shen.lazyderef X V3894) (cons : (cons (shen.lazyderef A V3894) ()))) (cons (cons (shen.lazyderef Y V3894) (cons : (cons (cons list (cons (shen.lazyderef A V3894) ())) ()))) (shen.lazyderef Hyp V3894))) V3894 V3895))) (if (shen.pvar? V3645) (do (shen.bindv V3645 () V3894) (let Result (let Hyp (tl V3629) (do (shen.incinfs) (bind V3893 (cons (cons (shen.lazyderef X V3894) (cons : (cons (shen.lazyderef A V3894) ()))) (cons (cons (shen.lazyderef Y V3894) (cons : (cons (cons list (cons (shen.lazyderef A V3894) ())) ()))) (shen.lazyderef Hyp V3894))) V3894 V3895))) (do (shen.unbindv V3645 V3894) Result))) false))) (do (shen.unbindv V3641 V3894) Result)))) false))) (if (shen.pvar? V3640) (do (shen.bindv V3640 list V3894) (let Result (let V3646 (shen.lazyderef (tl V3639) V3894) (if (cons? V3646) (let A (hd V3646) (let V3647 (shen.lazyderef (tl V3646) V3894) (if (= () V3647) (let V3648 (shen.lazyderef (tl V3638) V3894) (if (= () V3648) (let Hyp (tl V3629) (do (shen.incinfs) (bind V3893 (cons (cons (shen.lazyderef X V3894) (cons : (cons (shen.lazyderef A V3894) ()))) (cons (cons (shen.lazyderef Y V3894) (cons : (cons (cons list (cons (shen.lazyderef A V3894) ())) ()))) (shen.lazyderef Hyp V3894))) V3894 V3895))) (if (shen.pvar? V3648) (do (shen.bindv V3648 () V3894) (let Result (let Hyp (tl V3629) (do (shen.incinfs) (bind V3893 (cons (cons (shen.lazyderef X V3894) (cons : (cons (shen.lazyderef A V3894) ()))) (cons (cons (shen.lazyderef Y V3894) (cons : (cons (cons list (cons (shen.lazyderef A V3894) ())) ()))) (shen.lazyderef Hyp V3894))) V3894 V3895))) (do (shen.unbindv V3648 V3894) Result))) false))) (if (shen.pvar? V3647) (do (shen.bindv V3647 () V3894) (let Result (let V3649 (shen.lazyderef (tl V3638) V3894) (if (= () V3649) (let Hyp (tl V3629) (do (shen.incinfs) (bind V3893 (cons (cons (shen.lazyderef X V3894) (cons : (cons (shen.lazyderef A V3894) ()))) (cons (cons (shen.lazyderef Y V3894) (cons : (cons (cons list (cons (shen.lazyderef A V3894) ())) ()))) (shen.lazyderef Hyp V3894))) V3894 V3895))) (if (shen.pvar? V3649) (do (shen.bindv V3649 () V3894) (let Result (let Hyp (tl V3629) (do (shen.incinfs) (bind V3893 (cons (cons (shen.lazyderef X V3894) (cons : (cons (shen.lazyderef A V3894) ()))) (cons (cons (shen.lazyderef Y V3894) (cons : (cons (cons list (cons (shen.lazyderef A V3894) ())) ()))) (shen.lazyderef Hyp V3894))) V3894 V3895))) (do (shen.unbindv V3649 V3894) Result))) false))) (do (shen.unbindv V3647 V3894) Result))) false)))) (if (shen.pvar? V3646) (let A (shen.newpv V3894) (do (shen.bindv V3646 (cons A ()) V3894) (let Result (let V3650 (shen.lazyderef (tl V3638) V3894) (if (= () V3650) (let Hyp (tl V3629) (do (shen.incinfs) (bind V3893 (cons (cons (shen.lazyderef X V3894) (cons : (cons (shen.lazyderef A V3894) ()))) (cons (cons (shen.lazyderef Y V3894) (cons : (cons (cons list (cons (shen.lazyderef A V3894) ())) ()))) (shen.lazyderef Hyp V3894))) V3894 V3895))) (if (shen.pvar? V3650) (do (shen.bindv V3650 () V3894) (let Result (let Hyp (tl V3629) (do (shen.incinfs) (bind V3893 (cons (cons (shen.lazyderef X V3894) (cons : (cons (shen.lazyderef A V3894) ()))) (cons (cons (shen.lazyderef Y V3894) (cons : (cons (cons list (cons (shen.lazyderef A V3894) ())) ()))) (shen.lazyderef Hyp V3894))) V3894 V3895))) (do (shen.unbindv V3650 V3894) Result))) false))) (do (shen.unbindv V3646 V3894) Result)))) false))) (do (shen.unbindv V3640 V3894) Result))) false))) (if (shen.pvar? V3639) (let A (shen.newpv V3894) (do (shen.bindv V3639 (cons list (cons A ())) V3894) (let Result (let V3651 (shen.lazyderef (tl V3638) V3894) (if (= () V3651) (let Hyp (tl V3629) (do (shen.incinfs) (bind V3893 (cons (cons (shen.lazyderef X V3894) (cons : (cons (shen.lazyderef A V3894) ()))) (cons (cons (shen.lazyderef Y V3894) (cons : (cons (cons list (cons (shen.lazyderef A V3894) ())) ()))) (shen.lazyderef Hyp V3894))) V3894 V3895))) (if (shen.pvar? V3651) (do (shen.bindv V3651 () V3894) (let Result (let Hyp (tl V3629) (do (shen.incinfs) (bind V3893 (cons (cons (shen.lazyderef X V3894) (cons : (cons (shen.lazyderef A V3894) ()))) (cons (cons (shen.lazyderef Y V3894) (cons : (cons (cons list (cons (shen.lazyderef A V3894) ())) ()))) (shen.lazyderef Hyp V3894))) V3894 V3895))) (do (shen.unbindv V3651 V3894) Result))) false))) (do (shen.unbindv V3639 V3894) Result)))) false))) false)) false)) false)) false))) false))) false)) false)) false)) false)) false)) (if (= Case false) (let Case (let V3652 (shen.lazyderef V3892 V3894) (if (cons? V3652) (let V3653 (shen.lazyderef (hd V3652) V3894) (if (cons? V3653) (let V3654 (shen.lazyderef (hd V3653) V3894) (if (cons? V3654) (let V3655 (shen.lazyderef (hd V3654) V3894) (if (= @p V3655) (let V3656 (shen.lazyderef (tl V3654) V3894) (if (cons? V3656) (let X (hd V3656) (let V3657 (shen.lazyderef (tl V3656) V3894) (if (cons? V3657) (let Y (hd V3657) (let V3658 (shen.lazyderef (tl V3657) V3894) (if (= () V3658) (let V3659 (shen.lazyderef (tl V3653) V3894) (if (cons? V3659) (let V3660 (shen.lazyderef (hd V3659) V3894) (if (= : V3660) (let V3661 (shen.lazyderef (tl V3659) V3894) (if (cons? V3661) (let V3662 (shen.lazyderef (hd V3661) V3894) (if (cons? V3662) (let A (hd V3662) (let V3663 (shen.lazyderef (tl V3662) V3894) (if (cons? V3663) (let V3664 (shen.lazyderef (hd V3663) V3894) (if (= * V3664) (let V3665 (shen.lazyderef (tl V3663) V3894) (if (cons? V3665) (let B (hd V3665) (let V3666 (shen.lazyderef (tl V3665) V3894) (if (= () V3666) (let V3667 (shen.lazyderef (tl V3661) V3894) (if (= () V3667) (let Hyp (tl V3652) (do (shen.incinfs) (bind V3893 (cons (cons (shen.lazyderef X V3894) (cons : (cons (shen.lazyderef A V3894) ()))) (cons (cons (shen.lazyderef Y V3894) (cons : (cons (shen.lazyderef B V3894) ()))) (shen.lazyderef Hyp V3894))) V3894 V3895))) (if (shen.pvar? V3667) (do (shen.bindv V3667 () V3894) (let Result (let Hyp (tl V3652) (do (shen.incinfs) (bind V3893 (cons (cons (shen.lazyderef X V3894) (cons : (cons (shen.lazyderef A V3894) ()))) (cons (cons (shen.lazyderef Y V3894) (cons : (cons (shen.lazyderef B V3894) ()))) (shen.lazyderef Hyp V3894))) V3894 V3895))) (do (shen.unbindv V3667 V3894) Result))) false))) (if (shen.pvar? V3666) (do (shen.bindv V3666 () V3894) (let Result (let V3668 (shen.lazyderef (tl V3661) V3894) (if (= () V3668) (let Hyp (tl V3652) (do (shen.incinfs) (bind V3893 (cons (cons (shen.lazyderef X V3894) (cons : (cons (shen.lazyderef A V3894) ()))) (cons (cons (shen.lazyderef Y V3894) (cons : (cons (shen.lazyderef B V3894) ()))) (shen.lazyderef Hyp V3894))) V3894 V3895))) (if (shen.pvar? V3668) (do (shen.bindv V3668 () V3894) (let Result (let Hyp (tl V3652) (do (shen.incinfs) (bind V3893 (cons (cons (shen.lazyderef X V3894) (cons : (cons (shen.lazyderef A V3894) ()))) (cons (cons (shen.lazyderef Y V3894) (cons : (cons (shen.lazyderef B V3894) ()))) (shen.lazyderef Hyp V3894))) V3894 V3895))) (do (shen.unbindv V3668 V3894) Result))) false))) (do (shen.unbindv V3666 V3894) Result))) false)))) (if (shen.pvar? V3665) (let B (shen.newpv V3894) (do (shen.bindv V3665 (cons B ()) V3894) (let Result (let V3669 (shen.lazyderef (tl V3661) V3894) (if (= () V3669) (let Hyp (tl V3652) (do (shen.incinfs) (bind V3893 (cons (cons (shen.lazyderef X V3894) (cons : (cons (shen.lazyderef A V3894) ()))) (cons (cons (shen.lazyderef Y V3894) (cons : (cons (shen.lazyderef B V3894) ()))) (shen.lazyderef Hyp V3894))) V3894 V3895))) (if (shen.pvar? V3669) (do (shen.bindv V3669 () V3894) (let Result (let Hyp (tl V3652) (do (shen.incinfs) (bind V3893 (cons (cons (shen.lazyderef X V3894) (cons : (cons (shen.lazyderef A V3894) ()))) (cons (cons (shen.lazyderef Y V3894) (cons : (cons (shen.lazyderef B V3894) ()))) (shen.lazyderef Hyp V3894))) V3894 V3895))) (do (shen.unbindv V3669 V3894) Result))) false))) (do (shen.unbindv V3665 V3894) Result)))) false))) (if (shen.pvar? V3664) (do (shen.bindv V3664 * V3894) (let Result (let V3670 (shen.lazyderef (tl V3663) V3894) (if (cons? V3670) (let B (hd V3670) (let V3671 (shen.lazyderef (tl V3670) V3894) (if (= () V3671) (let V3672 (shen.lazyderef (tl V3661) V3894) (if (= () V3672) (let Hyp (tl V3652) (do (shen.incinfs) (bind V3893 (cons (cons (shen.lazyderef X V3894) (cons : (cons (shen.lazyderef A V3894) ()))) (cons (cons (shen.lazyderef Y V3894) (cons : (cons (shen.lazyderef B V3894) ()))) (shen.lazyderef Hyp V3894))) V3894 V3895))) (if (shen.pvar? V3672) (do (shen.bindv V3672 () V3894) (let Result (let Hyp (tl V3652) (do (shen.incinfs) (bind V3893 (cons (cons (shen.lazyderef X V3894) (cons : (cons (shen.lazyderef A V3894) ()))) (cons (cons (shen.lazyderef Y V3894) (cons : (cons (shen.lazyderef B V3894) ()))) (shen.lazyderef Hyp V3894))) V3894 V3895))) (do (shen.unbindv V3672 V3894) Result))) false))) (if (shen.pvar? V3671) (do (shen.bindv V3671 () V3894) (let Result (let V3673 (shen.lazyderef (tl V3661) V3894) (if (= () V3673) (let Hyp (tl V3652) (do (shen.incinfs) (bind V3893 (cons (cons (shen.lazyderef X V3894) (cons : (cons (shen.lazyderef A V3894) ()))) (cons (cons (shen.lazyderef Y V3894) (cons : (cons (shen.lazyderef B V3894) ()))) (shen.lazyderef Hyp V3894))) V3894 V3895))) (if (shen.pvar? V3673) (do (shen.bindv V3673 () V3894) (let Result (let Hyp (tl V3652) (do (shen.incinfs) (bind V3893 (cons (cons (shen.lazyderef X V3894) (cons : (cons (shen.lazyderef A V3894) ()))) (cons (cons (shen.lazyderef Y V3894) (cons : (cons (shen.lazyderef B V3894) ()))) (shen.lazyderef Hyp V3894))) V3894 V3895))) (do (shen.unbindv V3673 V3894) Result))) false))) (do (shen.unbindv V3671 V3894) Result))) false)))) (if (shen.pvar? V3670) (let B (shen.newpv V3894) (do (shen.bindv V3670 (cons B ()) V3894) (let Result (let V3674 (shen.lazyderef (tl V3661) V3894) (if (= () V3674) (let Hyp (tl V3652) (do (shen.incinfs) (bind V3893 (cons (cons (shen.lazyderef X V3894) (cons : (cons (shen.lazyderef A V3894) ()))) (cons (cons (shen.lazyderef Y V3894) (cons : (cons (shen.lazyderef B V3894) ()))) (shen.lazyderef Hyp V3894))) V3894 V3895))) (if (shen.pvar? V3674) (do (shen.bindv V3674 () V3894) (let Result (let Hyp (tl V3652) (do (shen.incinfs) (bind V3893 (cons (cons (shen.lazyderef X V3894) (cons : (cons (shen.lazyderef A V3894) ()))) (cons (cons (shen.lazyderef Y V3894) (cons : (cons (shen.lazyderef B V3894) ()))) (shen.lazyderef Hyp V3894))) V3894 V3895))) (do (shen.unbindv V3674 V3894) Result))) false))) (do (shen.unbindv V3670 V3894) Result)))) false))) (do (shen.unbindv V3664 V3894) Result))) false))) (if (shen.pvar? V3663) (let B (shen.newpv V3894) (do (shen.bindv V3663 (cons * (cons B ())) V3894) (let Result (let V3675 (shen.lazyderef (tl V3661) V3894) (if (= () V3675) (let Hyp (tl V3652) (do (shen.incinfs) (bind V3893 (cons (cons (shen.lazyderef X V3894) (cons : (cons (shen.lazyderef A V3894) ()))) (cons (cons (shen.lazyderef Y V3894) (cons : (cons (shen.lazyderef B V3894) ()))) (shen.lazyderef Hyp V3894))) V3894 V3895))) (if (shen.pvar? V3675) (do (shen.bindv V3675 () V3894) (let Result (let Hyp (tl V3652) (do (shen.incinfs) (bind V3893 (cons (cons (shen.lazyderef X V3894) (cons : (cons (shen.lazyderef A V3894) ()))) (cons (cons (shen.lazyderef Y V3894) (cons : (cons (shen.lazyderef B V3894) ()))) (shen.lazyderef Hyp V3894))) V3894 V3895))) (do (shen.unbindv V3675 V3894) Result))) false))) (do (shen.unbindv V3663 V3894) Result)))) false)))) (if (shen.pvar? V3662) (let A (shen.newpv V3894) (let B (shen.newpv V3894) (do (shen.bindv V3662 (cons A (cons * (cons B ()))) V3894) (let Result (let V3676 (shen.lazyderef (tl V3661) V3894) (if (= () V3676) (let Hyp (tl V3652) (do (shen.incinfs) (bind V3893 (cons (cons (shen.lazyderef X V3894) (cons : (cons (shen.lazyderef A V3894) ()))) (cons (cons (shen.lazyderef Y V3894) (cons : (cons (shen.lazyderef B V3894) ()))) (shen.lazyderef Hyp V3894))) V3894 V3895))) (if (shen.pvar? V3676) (do (shen.bindv V3676 () V3894) (let Result (let Hyp (tl V3652) (do (shen.incinfs) (bind V3893 (cons (cons (shen.lazyderef X V3894) (cons : (cons (shen.lazyderef A V3894) ()))) (cons (cons (shen.lazyderef Y V3894) (cons : (cons (shen.lazyderef B V3894) ()))) (shen.lazyderef Hyp V3894))) V3894 V3895))) (do (shen.unbindv V3676 V3894) Result))) false))) (do (shen.unbindv V3662 V3894) Result))))) false))) false)) false)) false)) false))) false))) false)) false)) false)) false)) false)) (if (= Case false) (let Case (let V3677 (shen.lazyderef V3892 V3894) (if (cons? V3677) (let V3678 (shen.lazyderef (hd V3677) V3894) (if (cons? V3678) (let V3679 (shen.lazyderef (hd V3678) V3894) (if (cons? V3679) (let V3680 (shen.lazyderef (hd V3679) V3894) (if (= @v V3680) (let V3681 (shen.lazyderef (tl V3679) V3894) (if (cons? V3681) (let X (hd V3681) (let V3682 (shen.lazyderef (tl V3681) V3894) (if (cons? V3682) (let Y (hd V3682) (let V3683 (shen.lazyderef (tl V3682) V3894) (if (= () V3683) (let V3684 (shen.lazyderef (tl V3678) V3894) (if (cons? V3684) (let V3685 (shen.lazyderef (hd V3684) V3894) (if (= : V3685) (let V3686 (shen.lazyderef (tl V3684) V3894) (if (cons? V3686) (let V3687 (shen.lazyderef (hd V3686) V3894) (if (cons? V3687) (let V3688 (shen.lazyderef (hd V3687) V3894) (if (= vector V3688) (let V3689 (shen.lazyderef (tl V3687) V3894) (if (cons? V3689) (let A (hd V3689) (let V3690 (shen.lazyderef (tl V3689) V3894) (if (= () V3690) (let V3691 (shen.lazyderef (tl V3686) V3894) (if (= () V3691) (let Hyp (tl V3677) (do (shen.incinfs) (bind V3893 (cons (cons (shen.lazyderef X V3894) (cons : (cons (shen.lazyderef A V3894) ()))) (cons (cons (shen.lazyderef Y V3894) (cons : (cons (cons vector (cons (shen.lazyderef A V3894) ())) ()))) (shen.lazyderef Hyp V3894))) V3894 V3895))) (if (shen.pvar? V3691) (do (shen.bindv V3691 () V3894) (let Result (let Hyp (tl V3677) (do (shen.incinfs) (bind V3893 (cons (cons (shen.lazyderef X V3894) (cons : (cons (shen.lazyderef A V3894) ()))) (cons (cons (shen.lazyderef Y V3894) (cons : (cons (cons vector (cons (shen.lazyderef A V3894) ())) ()))) (shen.lazyderef Hyp V3894))) V3894 V3895))) (do (shen.unbindv V3691 V3894) Result))) false))) (if (shen.pvar? V3690) (do (shen.bindv V3690 () V3894) (let Result (let V3692 (shen.lazyderef (tl V3686) V3894) (if (= () V3692) (let Hyp (tl V3677) (do (shen.incinfs) (bind V3893 (cons (cons (shen.lazyderef X V3894) (cons : (cons (shen.lazyderef A V3894) ()))) (cons (cons (shen.lazyderef Y V3894) (cons : (cons (cons vector (cons (shen.lazyderef A V3894) ())) ()))) (shen.lazyderef Hyp V3894))) V3894 V3895))) (if (shen.pvar? V3692) (do (shen.bindv V3692 () V3894) (let Result (let Hyp (tl V3677) (do (shen.incinfs) (bind V3893 (cons (cons (shen.lazyderef X V3894) (cons : (cons (shen.lazyderef A V3894) ()))) (cons (cons (shen.lazyderef Y V3894) (cons : (cons (cons vector (cons (shen.lazyderef A V3894) ())) ()))) (shen.lazyderef Hyp V3894))) V3894 V3895))) (do (shen.unbindv V3692 V3894) Result))) false))) (do (shen.unbindv V3690 V3894) Result))) false)))) (if (shen.pvar? V3689) (let A (shen.newpv V3894) (do (shen.bindv V3689 (cons A ()) V3894) (let Result (let V3693 (shen.lazyderef (tl V3686) V3894) (if (= () V3693) (let Hyp (tl V3677) (do (shen.incinfs) (bind V3893 (cons (cons (shen.lazyderef X V3894) (cons : (cons (shen.lazyderef A V3894) ()))) (cons (cons (shen.lazyderef Y V3894) (cons : (cons (cons vector (cons (shen.lazyderef A V3894) ())) ()))) (shen.lazyderef Hyp V3894))) V3894 V3895))) (if (shen.pvar? V3693) (do (shen.bindv V3693 () V3894) (let Result (let Hyp (tl V3677) (do (shen.incinfs) (bind V3893 (cons (cons (shen.lazyderef X V3894) (cons : (cons (shen.lazyderef A V3894) ()))) (cons (cons (shen.lazyderef Y V3894) (cons : (cons (cons vector (cons (shen.lazyderef A V3894) ())) ()))) (shen.lazyderef Hyp V3894))) V3894 V3895))) (do (shen.unbindv V3693 V3894) Result))) false))) (do (shen.unbindv V3689 V3894) Result)))) false))) (if (shen.pvar? V3688) (do (shen.bindv V3688 vector V3894) (let Result (let V3694 (shen.lazyderef (tl V3687) V3894) (if (cons? V3694) (let A (hd V3694) (let V3695 (shen.lazyderef (tl V3694) V3894) (if (= () V3695) (let V3696 (shen.lazyderef (tl V3686) V3894) (if (= () V3696) (let Hyp (tl V3677) (do (shen.incinfs) (bind V3893 (cons (cons (shen.lazyderef X V3894) (cons : (cons (shen.lazyderef A V3894) ()))) (cons (cons (shen.lazyderef Y V3894) (cons : (cons (cons vector (cons (shen.lazyderef A V3894) ())) ()))) (shen.lazyderef Hyp V3894))) V3894 V3895))) (if (shen.pvar? V3696) (do (shen.bindv V3696 () V3894) (let Result (let Hyp (tl V3677) (do (shen.incinfs) (bind V3893 (cons (cons (shen.lazyderef X V3894) (cons : (cons (shen.lazyderef A V3894) ()))) (cons (cons (shen.lazyderef Y V3894) (cons : (cons (cons vector (cons (shen.lazyderef A V3894) ())) ()))) (shen.lazyderef Hyp V3894))) V3894 V3895))) (do (shen.unbindv V3696 V3894) Result))) false))) (if (shen.pvar? V3695) (do (shen.bindv V3695 () V3894) (let Result (let V3697 (shen.lazyderef (tl V3686) V3894) (if (= () V3697) (let Hyp (tl V3677) (do (shen.incinfs) (bind V3893 (cons (cons (shen.lazyderef X V3894) (cons : (cons (shen.lazyderef A V3894) ()))) (cons (cons (shen.lazyderef Y V3894) (cons : (cons (cons vector (cons (shen.lazyderef A V3894) ())) ()))) (shen.lazyderef Hyp V3894))) V3894 V3895))) (if (shen.pvar? V3697) (do (shen.bindv V3697 () V3894) (let Result (let Hyp (tl V3677) (do (shen.incinfs) (bind V3893 (cons (cons (shen.lazyderef X V3894) (cons : (cons (shen.lazyderef A V3894) ()))) (cons (cons (shen.lazyderef Y V3894) (cons : (cons (cons vector (cons (shen.lazyderef A V3894) ())) ()))) (shen.lazyderef Hyp V3894))) V3894 V3895))) (do (shen.unbindv V3697 V3894) Result))) false))) (do (shen.unbindv V3695 V3894) Result))) false)))) (if (shen.pvar? V3694) (let A (shen.newpv V3894) (do (shen.bindv V3694 (cons A ()) V3894) (let Result (let V3698 (shen.lazyderef (tl V3686) V3894) (if (= () V3698) (let Hyp (tl V3677) (do (shen.incinfs) (bind V3893 (cons (cons (shen.lazyderef X V3894) (cons : (cons (shen.lazyderef A V3894) ()))) (cons (cons (shen.lazyderef Y V3894) (cons : (cons (cons vector (cons (shen.lazyderef A V3894) ())) ()))) (shen.lazyderef Hyp V3894))) V3894 V3895))) (if (shen.pvar? V3698) (do (shen.bindv V3698 () V3894) (let Result (let Hyp (tl V3677) (do (shen.incinfs) (bind V3893 (cons (cons (shen.lazyderef X V3894) (cons : (cons (shen.lazyderef A V3894) ()))) (cons (cons (shen.lazyderef Y V3894) (cons : (cons (cons vector (cons (shen.lazyderef A V3894) ())) ()))) (shen.lazyderef Hyp V3894))) V3894 V3895))) (do (shen.unbindv V3698 V3894) Result))) false))) (do (shen.unbindv V3694 V3894) Result)))) false))) (do (shen.unbindv V3688 V3894) Result))) false))) (if (shen.pvar? V3687) (let A (shen.newpv V3894) (do (shen.bindv V3687 (cons vector (cons A ())) V3894) (let Result (let V3699 (shen.lazyderef (tl V3686) V3894) (if (= () V3699) (let Hyp (tl V3677) (do (shen.incinfs) (bind V3893 (cons (cons (shen.lazyderef X V3894) (cons : (cons (shen.lazyderef A V3894) ()))) (cons (cons (shen.lazyderef Y V3894) (cons : (cons (cons vector (cons (shen.lazyderef A V3894) ())) ()))) (shen.lazyderef Hyp V3894))) V3894 V3895))) (if (shen.pvar? V3699) (do (shen.bindv V3699 () V3894) (let Result (let Hyp (tl V3677) (do (shen.incinfs) (bind V3893 (cons (cons (shen.lazyderef X V3894) (cons : (cons (shen.lazyderef A V3894) ()))) (cons (cons (shen.lazyderef Y V3894) (cons : (cons (cons vector (cons (shen.lazyderef A V3894) ())) ()))) (shen.lazyderef Hyp V3894))) V3894 V3895))) (do (shen.unbindv V3699 V3894) Result))) false))) (do (shen.unbindv V3687 V3894) Result)))) false))) false)) false)) false)) false))) false))) false)) false)) false)) false)) false)) (if (= Case false) (let Case (let V3700 (shen.lazyderef V3892 V3894) (if (cons? V3700) (let V3701 (shen.lazyderef (hd V3700) V3894) (if (cons? V3701) (let V3702 (shen.lazyderef (hd V3701) V3894) (if (cons? V3702) (let V3703 (shen.lazyderef (hd V3702) V3894) (if (= @s V3703) (let V3704 (shen.lazyderef (tl V3702) V3894) (if (cons? V3704) (let X (hd V3704) (let V3705 (shen.lazyderef (tl V3704) V3894) (if (cons? V3705) (let Y (hd V3705) (let V3706 (shen.lazyderef (tl V3705) V3894) (if (= () V3706) (let V3707 (shen.lazyderef (tl V3701) V3894) (if (cons? V3707) (let V3708 (shen.lazyderef (hd V3707) V3894) (if (= : V3708) (let V3709 (shen.lazyderef (tl V3707) V3894) (if (cons? V3709) (let V3710 (shen.lazyderef (hd V3709) V3894) (if (= string V3710) (let V3711 (shen.lazyderef (tl V3709) V3894) (if (= () V3711) (let Hyp (tl V3700) (do (shen.incinfs) (bind V3893 (cons (cons (shen.lazyderef X V3894) (cons : (cons string ()))) (cons (cons (shen.lazyderef Y V3894) (cons : (cons string ()))) (shen.lazyderef Hyp V3894))) V3894 V3895))) (if (shen.pvar? V3711) (do (shen.bindv V3711 () V3894) (let Result (let Hyp (tl V3700) (do (shen.incinfs) (bind V3893 (cons (cons (shen.lazyderef X V3894) (cons : (cons string ()))) (cons (cons (shen.lazyderef Y V3894) (cons : (cons string ()))) (shen.lazyderef Hyp V3894))) V3894 V3895))) (do (shen.unbindv V3711 V3894) Result))) false))) (if (shen.pvar? V3710) (do (shen.bindv V3710 string V3894) (let Result (let V3712 (shen.lazyderef (tl V3709) V3894) (if (= () V3712) (let Hyp (tl V3700) (do (shen.incinfs) (bind V3893 (cons (cons (shen.lazyderef X V3894) (cons : (cons string ()))) (cons (cons (shen.lazyderef Y V3894) (cons : (cons string ()))) (shen.lazyderef Hyp V3894))) V3894 V3895))) (if (shen.pvar? V3712) (do (shen.bindv V3712 () V3894) (let Result (let Hyp (tl V3700) (do (shen.incinfs) (bind V3893 (cons (cons (shen.lazyderef X V3894) (cons : (cons string ()))) (cons (cons (shen.lazyderef Y V3894) (cons : (cons string ()))) (shen.lazyderef Hyp V3894))) V3894 V3895))) (do (shen.unbindv V3712 V3894) Result))) false))) (do (shen.unbindv V3710 V3894) Result))) false))) false)) false)) false)) false))) false))) false)) false)) false)) false)) false)) (if (= Case false) (let V3713 (shen.lazyderef V3892 V3894) (if (cons? V3713) (let X (hd V3713) (let Hyp (tl V3713) (let NewHyps (shen.newpv V3894) (do (shen.incinfs) (bind V3893 (cons (shen.lazyderef X V3894) (shen.lazyderef NewHyps V3894)) V3894 (freeze (shen.t*-hyps Hyp NewHyps V3894 V3895))))))) false)) Case)) Case)) Case)) Case))) +(defun shen.t*-hyps (V2731 V2732 V2733 V2734) (let Case (let V2468 (shen.lazyderef V2731 V2733) (if (cons? V2468) (let V2469 (shen.lazyderef (hd V2468) V2733) (if (cons? V2469) (let V2470 (shen.lazyderef (hd V2469) V2733) (if (cons? V2470) (let V2471 (shen.lazyderef (hd V2470) V2733) (if (= cons V2471) (let V2472 (shen.lazyderef (tl V2470) V2733) (if (cons? V2472) (let X (hd V2472) (let V2473 (shen.lazyderef (tl V2472) V2733) (if (cons? V2473) (let Y (hd V2473) (let V2474 (shen.lazyderef (tl V2473) V2733) (if (= () V2474) (let V2475 (shen.lazyderef (tl V2469) V2733) (if (cons? V2475) (let V2476 (shen.lazyderef (hd V2475) V2733) (if (= : V2476) (let V2477 (shen.lazyderef (tl V2475) V2733) (if (cons? V2477) (let V2478 (shen.lazyderef (hd V2477) V2733) (if (cons? V2478) (let V2479 (shen.lazyderef (hd V2478) V2733) (if (= list V2479) (let V2480 (shen.lazyderef (tl V2478) V2733) (if (cons? V2480) (let A (hd V2480) (let V2481 (shen.lazyderef (tl V2480) V2733) (if (= () V2481) (let V2482 (shen.lazyderef (tl V2477) V2733) (if (= () V2482) (let Hyp (tl V2468) (do (shen.incinfs) (bind V2732 (cons (cons (shen.lazyderef X V2733) (cons : (cons (shen.lazyderef A V2733) ()))) (cons (cons (shen.lazyderef Y V2733) (cons : (cons (cons list (cons (shen.lazyderef A V2733) ())) ()))) (shen.lazyderef Hyp V2733))) V2733 V2734))) (if (shen.pvar? V2482) (do (shen.bindv V2482 () V2733) (let Result (let Hyp (tl V2468) (do (shen.incinfs) (bind V2732 (cons (cons (shen.lazyderef X V2733) (cons : (cons (shen.lazyderef A V2733) ()))) (cons (cons (shen.lazyderef Y V2733) (cons : (cons (cons list (cons (shen.lazyderef A V2733) ())) ()))) (shen.lazyderef Hyp V2733))) V2733 V2734))) (do (shen.unbindv V2482 V2733) Result))) false))) (if (shen.pvar? V2481) (do (shen.bindv V2481 () V2733) (let Result (let V2483 (shen.lazyderef (tl V2477) V2733) (if (= () V2483) (let Hyp (tl V2468) (do (shen.incinfs) (bind V2732 (cons (cons (shen.lazyderef X V2733) (cons : (cons (shen.lazyderef A V2733) ()))) (cons (cons (shen.lazyderef Y V2733) (cons : (cons (cons list (cons (shen.lazyderef A V2733) ())) ()))) (shen.lazyderef Hyp V2733))) V2733 V2734))) (if (shen.pvar? V2483) (do (shen.bindv V2483 () V2733) (let Result (let Hyp (tl V2468) (do (shen.incinfs) (bind V2732 (cons (cons (shen.lazyderef X V2733) (cons : (cons (shen.lazyderef A V2733) ()))) (cons (cons (shen.lazyderef Y V2733) (cons : (cons (cons list (cons (shen.lazyderef A V2733) ())) ()))) (shen.lazyderef Hyp V2733))) V2733 V2734))) (do (shen.unbindv V2483 V2733) Result))) false))) (do (shen.unbindv V2481 V2733) Result))) false)))) (if (shen.pvar? V2480) (let A (shen.newpv V2733) (do (shen.bindv V2480 (cons A ()) V2733) (let Result (let V2484 (shen.lazyderef (tl V2477) V2733) (if (= () V2484) (let Hyp (tl V2468) (do (shen.incinfs) (bind V2732 (cons (cons (shen.lazyderef X V2733) (cons : (cons (shen.lazyderef A V2733) ()))) (cons (cons (shen.lazyderef Y V2733) (cons : (cons (cons list (cons (shen.lazyderef A V2733) ())) ()))) (shen.lazyderef Hyp V2733))) V2733 V2734))) (if (shen.pvar? V2484) (do (shen.bindv V2484 () V2733) (let Result (let Hyp (tl V2468) (do (shen.incinfs) (bind V2732 (cons (cons (shen.lazyderef X V2733) (cons : (cons (shen.lazyderef A V2733) ()))) (cons (cons (shen.lazyderef Y V2733) (cons : (cons (cons list (cons (shen.lazyderef A V2733) ())) ()))) (shen.lazyderef Hyp V2733))) V2733 V2734))) (do (shen.unbindv V2484 V2733) Result))) false))) (do (shen.unbindv V2480 V2733) Result)))) false))) (if (shen.pvar? V2479) (do (shen.bindv V2479 list V2733) (let Result (let V2485 (shen.lazyderef (tl V2478) V2733) (if (cons? V2485) (let A (hd V2485) (let V2486 (shen.lazyderef (tl V2485) V2733) (if (= () V2486) (let V2487 (shen.lazyderef (tl V2477) V2733) (if (= () V2487) (let Hyp (tl V2468) (do (shen.incinfs) (bind V2732 (cons (cons (shen.lazyderef X V2733) (cons : (cons (shen.lazyderef A V2733) ()))) (cons (cons (shen.lazyderef Y V2733) (cons : (cons (cons list (cons (shen.lazyderef A V2733) ())) ()))) (shen.lazyderef Hyp V2733))) V2733 V2734))) (if (shen.pvar? V2487) (do (shen.bindv V2487 () V2733) (let Result (let Hyp (tl V2468) (do (shen.incinfs) (bind V2732 (cons (cons (shen.lazyderef X V2733) (cons : (cons (shen.lazyderef A V2733) ()))) (cons (cons (shen.lazyderef Y V2733) (cons : (cons (cons list (cons (shen.lazyderef A V2733) ())) ()))) (shen.lazyderef Hyp V2733))) V2733 V2734))) (do (shen.unbindv V2487 V2733) Result))) false))) (if (shen.pvar? V2486) (do (shen.bindv V2486 () V2733) (let Result (let V2488 (shen.lazyderef (tl V2477) V2733) (if (= () V2488) (let Hyp (tl V2468) (do (shen.incinfs) (bind V2732 (cons (cons (shen.lazyderef X V2733) (cons : (cons (shen.lazyderef A V2733) ()))) (cons (cons (shen.lazyderef Y V2733) (cons : (cons (cons list (cons (shen.lazyderef A V2733) ())) ()))) (shen.lazyderef Hyp V2733))) V2733 V2734))) (if (shen.pvar? V2488) (do (shen.bindv V2488 () V2733) (let Result (let Hyp (tl V2468) (do (shen.incinfs) (bind V2732 (cons (cons (shen.lazyderef X V2733) (cons : (cons (shen.lazyderef A V2733) ()))) (cons (cons (shen.lazyderef Y V2733) (cons : (cons (cons list (cons (shen.lazyderef A V2733) ())) ()))) (shen.lazyderef Hyp V2733))) V2733 V2734))) (do (shen.unbindv V2488 V2733) Result))) false))) (do (shen.unbindv V2486 V2733) Result))) false)))) (if (shen.pvar? V2485) (let A (shen.newpv V2733) (do (shen.bindv V2485 (cons A ()) V2733) (let Result (let V2489 (shen.lazyderef (tl V2477) V2733) (if (= () V2489) (let Hyp (tl V2468) (do (shen.incinfs) (bind V2732 (cons (cons (shen.lazyderef X V2733) (cons : (cons (shen.lazyderef A V2733) ()))) (cons (cons (shen.lazyderef Y V2733) (cons : (cons (cons list (cons (shen.lazyderef A V2733) ())) ()))) (shen.lazyderef Hyp V2733))) V2733 V2734))) (if (shen.pvar? V2489) (do (shen.bindv V2489 () V2733) (let Result (let Hyp (tl V2468) (do (shen.incinfs) (bind V2732 (cons (cons (shen.lazyderef X V2733) (cons : (cons (shen.lazyderef A V2733) ()))) (cons (cons (shen.lazyderef Y V2733) (cons : (cons (cons list (cons (shen.lazyderef A V2733) ())) ()))) (shen.lazyderef Hyp V2733))) V2733 V2734))) (do (shen.unbindv V2489 V2733) Result))) false))) (do (shen.unbindv V2485 V2733) Result)))) false))) (do (shen.unbindv V2479 V2733) Result))) false))) (if (shen.pvar? V2478) (let A (shen.newpv V2733) (do (shen.bindv V2478 (cons list (cons A ())) V2733) (let Result (let V2490 (shen.lazyderef (tl V2477) V2733) (if (= () V2490) (let Hyp (tl V2468) (do (shen.incinfs) (bind V2732 (cons (cons (shen.lazyderef X V2733) (cons : (cons (shen.lazyderef A V2733) ()))) (cons (cons (shen.lazyderef Y V2733) (cons : (cons (cons list (cons (shen.lazyderef A V2733) ())) ()))) (shen.lazyderef Hyp V2733))) V2733 V2734))) (if (shen.pvar? V2490) (do (shen.bindv V2490 () V2733) (let Result (let Hyp (tl V2468) (do (shen.incinfs) (bind V2732 (cons (cons (shen.lazyderef X V2733) (cons : (cons (shen.lazyderef A V2733) ()))) (cons (cons (shen.lazyderef Y V2733) (cons : (cons (cons list (cons (shen.lazyderef A V2733) ())) ()))) (shen.lazyderef Hyp V2733))) V2733 V2734))) (do (shen.unbindv V2490 V2733) Result))) false))) (do (shen.unbindv V2478 V2733) Result)))) false))) false)) false)) false)) false))) false))) false)) false)) false)) false)) false)) (if (= Case false) (let Case (let V2491 (shen.lazyderef V2731 V2733) (if (cons? V2491) (let V2492 (shen.lazyderef (hd V2491) V2733) (if (cons? V2492) (let V2493 (shen.lazyderef (hd V2492) V2733) (if (cons? V2493) (let V2494 (shen.lazyderef (hd V2493) V2733) (if (= @p V2494) (let V2495 (shen.lazyderef (tl V2493) V2733) (if (cons? V2495) (let X (hd V2495) (let V2496 (shen.lazyderef (tl V2495) V2733) (if (cons? V2496) (let Y (hd V2496) (let V2497 (shen.lazyderef (tl V2496) V2733) (if (= () V2497) (let V2498 (shen.lazyderef (tl V2492) V2733) (if (cons? V2498) (let V2499 (shen.lazyderef (hd V2498) V2733) (if (= : V2499) (let V2500 (shen.lazyderef (tl V2498) V2733) (if (cons? V2500) (let V2501 (shen.lazyderef (hd V2500) V2733) (if (cons? V2501) (let A (hd V2501) (let V2502 (shen.lazyderef (tl V2501) V2733) (if (cons? V2502) (let V2503 (shen.lazyderef (hd V2502) V2733) (if (= * V2503) (let V2504 (shen.lazyderef (tl V2502) V2733) (if (cons? V2504) (let B (hd V2504) (let V2505 (shen.lazyderef (tl V2504) V2733) (if (= () V2505) (let V2506 (shen.lazyderef (tl V2500) V2733) (if (= () V2506) (let Hyp (tl V2491) (do (shen.incinfs) (bind V2732 (cons (cons (shen.lazyderef X V2733) (cons : (cons (shen.lazyderef A V2733) ()))) (cons (cons (shen.lazyderef Y V2733) (cons : (cons (shen.lazyderef B V2733) ()))) (shen.lazyderef Hyp V2733))) V2733 V2734))) (if (shen.pvar? V2506) (do (shen.bindv V2506 () V2733) (let Result (let Hyp (tl V2491) (do (shen.incinfs) (bind V2732 (cons (cons (shen.lazyderef X V2733) (cons : (cons (shen.lazyderef A V2733) ()))) (cons (cons (shen.lazyderef Y V2733) (cons : (cons (shen.lazyderef B V2733) ()))) (shen.lazyderef Hyp V2733))) V2733 V2734))) (do (shen.unbindv V2506 V2733) Result))) false))) (if (shen.pvar? V2505) (do (shen.bindv V2505 () V2733) (let Result (let V2507 (shen.lazyderef (tl V2500) V2733) (if (= () V2507) (let Hyp (tl V2491) (do (shen.incinfs) (bind V2732 (cons (cons (shen.lazyderef X V2733) (cons : (cons (shen.lazyderef A V2733) ()))) (cons (cons (shen.lazyderef Y V2733) (cons : (cons (shen.lazyderef B V2733) ()))) (shen.lazyderef Hyp V2733))) V2733 V2734))) (if (shen.pvar? V2507) (do (shen.bindv V2507 () V2733) (let Result (let Hyp (tl V2491) (do (shen.incinfs) (bind V2732 (cons (cons (shen.lazyderef X V2733) (cons : (cons (shen.lazyderef A V2733) ()))) (cons (cons (shen.lazyderef Y V2733) (cons : (cons (shen.lazyderef B V2733) ()))) (shen.lazyderef Hyp V2733))) V2733 V2734))) (do (shen.unbindv V2507 V2733) Result))) false))) (do (shen.unbindv V2505 V2733) Result))) false)))) (if (shen.pvar? V2504) (let B (shen.newpv V2733) (do (shen.bindv V2504 (cons B ()) V2733) (let Result (let V2508 (shen.lazyderef (tl V2500) V2733) (if (= () V2508) (let Hyp (tl V2491) (do (shen.incinfs) (bind V2732 (cons (cons (shen.lazyderef X V2733) (cons : (cons (shen.lazyderef A V2733) ()))) (cons (cons (shen.lazyderef Y V2733) (cons : (cons (shen.lazyderef B V2733) ()))) (shen.lazyderef Hyp V2733))) V2733 V2734))) (if (shen.pvar? V2508) (do (shen.bindv V2508 () V2733) (let Result (let Hyp (tl V2491) (do (shen.incinfs) (bind V2732 (cons (cons (shen.lazyderef X V2733) (cons : (cons (shen.lazyderef A V2733) ()))) (cons (cons (shen.lazyderef Y V2733) (cons : (cons (shen.lazyderef B V2733) ()))) (shen.lazyderef Hyp V2733))) V2733 V2734))) (do (shen.unbindv V2508 V2733) Result))) false))) (do (shen.unbindv V2504 V2733) Result)))) false))) (if (shen.pvar? V2503) (do (shen.bindv V2503 * V2733) (let Result (let V2509 (shen.lazyderef (tl V2502) V2733) (if (cons? V2509) (let B (hd V2509) (let V2510 (shen.lazyderef (tl V2509) V2733) (if (= () V2510) (let V2511 (shen.lazyderef (tl V2500) V2733) (if (= () V2511) (let Hyp (tl V2491) (do (shen.incinfs) (bind V2732 (cons (cons (shen.lazyderef X V2733) (cons : (cons (shen.lazyderef A V2733) ()))) (cons (cons (shen.lazyderef Y V2733) (cons : (cons (shen.lazyderef B V2733) ()))) (shen.lazyderef Hyp V2733))) V2733 V2734))) (if (shen.pvar? V2511) (do (shen.bindv V2511 () V2733) (let Result (let Hyp (tl V2491) (do (shen.incinfs) (bind V2732 (cons (cons (shen.lazyderef X V2733) (cons : (cons (shen.lazyderef A V2733) ()))) (cons (cons (shen.lazyderef Y V2733) (cons : (cons (shen.lazyderef B V2733) ()))) (shen.lazyderef Hyp V2733))) V2733 V2734))) (do (shen.unbindv V2511 V2733) Result))) false))) (if (shen.pvar? V2510) (do (shen.bindv V2510 () V2733) (let Result (let V2512 (shen.lazyderef (tl V2500) V2733) (if (= () V2512) (let Hyp (tl V2491) (do (shen.incinfs) (bind V2732 (cons (cons (shen.lazyderef X V2733) (cons : (cons (shen.lazyderef A V2733) ()))) (cons (cons (shen.lazyderef Y V2733) (cons : (cons (shen.lazyderef B V2733) ()))) (shen.lazyderef Hyp V2733))) V2733 V2734))) (if (shen.pvar? V2512) (do (shen.bindv V2512 () V2733) (let Result (let Hyp (tl V2491) (do (shen.incinfs) (bind V2732 (cons (cons (shen.lazyderef X V2733) (cons : (cons (shen.lazyderef A V2733) ()))) (cons (cons (shen.lazyderef Y V2733) (cons : (cons (shen.lazyderef B V2733) ()))) (shen.lazyderef Hyp V2733))) V2733 V2734))) (do (shen.unbindv V2512 V2733) Result))) false))) (do (shen.unbindv V2510 V2733) Result))) false)))) (if (shen.pvar? V2509) (let B (shen.newpv V2733) (do (shen.bindv V2509 (cons B ()) V2733) (let Result (let V2513 (shen.lazyderef (tl V2500) V2733) (if (= () V2513) (let Hyp (tl V2491) (do (shen.incinfs) (bind V2732 (cons (cons (shen.lazyderef X V2733) (cons : (cons (shen.lazyderef A V2733) ()))) (cons (cons (shen.lazyderef Y V2733) (cons : (cons (shen.lazyderef B V2733) ()))) (shen.lazyderef Hyp V2733))) V2733 V2734))) (if (shen.pvar? V2513) (do (shen.bindv V2513 () V2733) (let Result (let Hyp (tl V2491) (do (shen.incinfs) (bind V2732 (cons (cons (shen.lazyderef X V2733) (cons : (cons (shen.lazyderef A V2733) ()))) (cons (cons (shen.lazyderef Y V2733) (cons : (cons (shen.lazyderef B V2733) ()))) (shen.lazyderef Hyp V2733))) V2733 V2734))) (do (shen.unbindv V2513 V2733) Result))) false))) (do (shen.unbindv V2509 V2733) Result)))) false))) (do (shen.unbindv V2503 V2733) Result))) false))) (if (shen.pvar? V2502) (let B (shen.newpv V2733) (do (shen.bindv V2502 (cons * (cons B ())) V2733) (let Result (let V2514 (shen.lazyderef (tl V2500) V2733) (if (= () V2514) (let Hyp (tl V2491) (do (shen.incinfs) (bind V2732 (cons (cons (shen.lazyderef X V2733) (cons : (cons (shen.lazyderef A V2733) ()))) (cons (cons (shen.lazyderef Y V2733) (cons : (cons (shen.lazyderef B V2733) ()))) (shen.lazyderef Hyp V2733))) V2733 V2734))) (if (shen.pvar? V2514) (do (shen.bindv V2514 () V2733) (let Result (let Hyp (tl V2491) (do (shen.incinfs) (bind V2732 (cons (cons (shen.lazyderef X V2733) (cons : (cons (shen.lazyderef A V2733) ()))) (cons (cons (shen.lazyderef Y V2733) (cons : (cons (shen.lazyderef B V2733) ()))) (shen.lazyderef Hyp V2733))) V2733 V2734))) (do (shen.unbindv V2514 V2733) Result))) false))) (do (shen.unbindv V2502 V2733) Result)))) false)))) (if (shen.pvar? V2501) (let A (shen.newpv V2733) (let B (shen.newpv V2733) (do (shen.bindv V2501 (cons A (cons * (cons B ()))) V2733) (let Result (let V2515 (shen.lazyderef (tl V2500) V2733) (if (= () V2515) (let Hyp (tl V2491) (do (shen.incinfs) (bind V2732 (cons (cons (shen.lazyderef X V2733) (cons : (cons (shen.lazyderef A V2733) ()))) (cons (cons (shen.lazyderef Y V2733) (cons : (cons (shen.lazyderef B V2733) ()))) (shen.lazyderef Hyp V2733))) V2733 V2734))) (if (shen.pvar? V2515) (do (shen.bindv V2515 () V2733) (let Result (let Hyp (tl V2491) (do (shen.incinfs) (bind V2732 (cons (cons (shen.lazyderef X V2733) (cons : (cons (shen.lazyderef A V2733) ()))) (cons (cons (shen.lazyderef Y V2733) (cons : (cons (shen.lazyderef B V2733) ()))) (shen.lazyderef Hyp V2733))) V2733 V2734))) (do (shen.unbindv V2515 V2733) Result))) false))) (do (shen.unbindv V2501 V2733) Result))))) false))) false)) false)) false)) false))) false))) false)) false)) false)) false)) false)) (if (= Case false) (let Case (let V2516 (shen.lazyderef V2731 V2733) (if (cons? V2516) (let V2517 (shen.lazyderef (hd V2516) V2733) (if (cons? V2517) (let V2518 (shen.lazyderef (hd V2517) V2733) (if (cons? V2518) (let V2519 (shen.lazyderef (hd V2518) V2733) (if (= @v V2519) (let V2520 (shen.lazyderef (tl V2518) V2733) (if (cons? V2520) (let X (hd V2520) (let V2521 (shen.lazyderef (tl V2520) V2733) (if (cons? V2521) (let Y (hd V2521) (let V2522 (shen.lazyderef (tl V2521) V2733) (if (= () V2522) (let V2523 (shen.lazyderef (tl V2517) V2733) (if (cons? V2523) (let V2524 (shen.lazyderef (hd V2523) V2733) (if (= : V2524) (let V2525 (shen.lazyderef (tl V2523) V2733) (if (cons? V2525) (let V2526 (shen.lazyderef (hd V2525) V2733) (if (cons? V2526) (let V2527 (shen.lazyderef (hd V2526) V2733) (if (= vector V2527) (let V2528 (shen.lazyderef (tl V2526) V2733) (if (cons? V2528) (let A (hd V2528) (let V2529 (shen.lazyderef (tl V2528) V2733) (if (= () V2529) (let V2530 (shen.lazyderef (tl V2525) V2733) (if (= () V2530) (let Hyp (tl V2516) (do (shen.incinfs) (bind V2732 (cons (cons (shen.lazyderef X V2733) (cons : (cons (shen.lazyderef A V2733) ()))) (cons (cons (shen.lazyderef Y V2733) (cons : (cons (cons vector (cons (shen.lazyderef A V2733) ())) ()))) (shen.lazyderef Hyp V2733))) V2733 V2734))) (if (shen.pvar? V2530) (do (shen.bindv V2530 () V2733) (let Result (let Hyp (tl V2516) (do (shen.incinfs) (bind V2732 (cons (cons (shen.lazyderef X V2733) (cons : (cons (shen.lazyderef A V2733) ()))) (cons (cons (shen.lazyderef Y V2733) (cons : (cons (cons vector (cons (shen.lazyderef A V2733) ())) ()))) (shen.lazyderef Hyp V2733))) V2733 V2734))) (do (shen.unbindv V2530 V2733) Result))) false))) (if (shen.pvar? V2529) (do (shen.bindv V2529 () V2733) (let Result (let V2531 (shen.lazyderef (tl V2525) V2733) (if (= () V2531) (let Hyp (tl V2516) (do (shen.incinfs) (bind V2732 (cons (cons (shen.lazyderef X V2733) (cons : (cons (shen.lazyderef A V2733) ()))) (cons (cons (shen.lazyderef Y V2733) (cons : (cons (cons vector (cons (shen.lazyderef A V2733) ())) ()))) (shen.lazyderef Hyp V2733))) V2733 V2734))) (if (shen.pvar? V2531) (do (shen.bindv V2531 () V2733) (let Result (let Hyp (tl V2516) (do (shen.incinfs) (bind V2732 (cons (cons (shen.lazyderef X V2733) (cons : (cons (shen.lazyderef A V2733) ()))) (cons (cons (shen.lazyderef Y V2733) (cons : (cons (cons vector (cons (shen.lazyderef A V2733) ())) ()))) (shen.lazyderef Hyp V2733))) V2733 V2734))) (do (shen.unbindv V2531 V2733) Result))) false))) (do (shen.unbindv V2529 V2733) Result))) false)))) (if (shen.pvar? V2528) (let A (shen.newpv V2733) (do (shen.bindv V2528 (cons A ()) V2733) (let Result (let V2532 (shen.lazyderef (tl V2525) V2733) (if (= () V2532) (let Hyp (tl V2516) (do (shen.incinfs) (bind V2732 (cons (cons (shen.lazyderef X V2733) (cons : (cons (shen.lazyderef A V2733) ()))) (cons (cons (shen.lazyderef Y V2733) (cons : (cons (cons vector (cons (shen.lazyderef A V2733) ())) ()))) (shen.lazyderef Hyp V2733))) V2733 V2734))) (if (shen.pvar? V2532) (do (shen.bindv V2532 () V2733) (let Result (let Hyp (tl V2516) (do (shen.incinfs) (bind V2732 (cons (cons (shen.lazyderef X V2733) (cons : (cons (shen.lazyderef A V2733) ()))) (cons (cons (shen.lazyderef Y V2733) (cons : (cons (cons vector (cons (shen.lazyderef A V2733) ())) ()))) (shen.lazyderef Hyp V2733))) V2733 V2734))) (do (shen.unbindv V2532 V2733) Result))) false))) (do (shen.unbindv V2528 V2733) Result)))) false))) (if (shen.pvar? V2527) (do (shen.bindv V2527 vector V2733) (let Result (let V2533 (shen.lazyderef (tl V2526) V2733) (if (cons? V2533) (let A (hd V2533) (let V2534 (shen.lazyderef (tl V2533) V2733) (if (= () V2534) (let V2535 (shen.lazyderef (tl V2525) V2733) (if (= () V2535) (let Hyp (tl V2516) (do (shen.incinfs) (bind V2732 (cons (cons (shen.lazyderef X V2733) (cons : (cons (shen.lazyderef A V2733) ()))) (cons (cons (shen.lazyderef Y V2733) (cons : (cons (cons vector (cons (shen.lazyderef A V2733) ())) ()))) (shen.lazyderef Hyp V2733))) V2733 V2734))) (if (shen.pvar? V2535) (do (shen.bindv V2535 () V2733) (let Result (let Hyp (tl V2516) (do (shen.incinfs) (bind V2732 (cons (cons (shen.lazyderef X V2733) (cons : (cons (shen.lazyderef A V2733) ()))) (cons (cons (shen.lazyderef Y V2733) (cons : (cons (cons vector (cons (shen.lazyderef A V2733) ())) ()))) (shen.lazyderef Hyp V2733))) V2733 V2734))) (do (shen.unbindv V2535 V2733) Result))) false))) (if (shen.pvar? V2534) (do (shen.bindv V2534 () V2733) (let Result (let V2536 (shen.lazyderef (tl V2525) V2733) (if (= () V2536) (let Hyp (tl V2516) (do (shen.incinfs) (bind V2732 (cons (cons (shen.lazyderef X V2733) (cons : (cons (shen.lazyderef A V2733) ()))) (cons (cons (shen.lazyderef Y V2733) (cons : (cons (cons vector (cons (shen.lazyderef A V2733) ())) ()))) (shen.lazyderef Hyp V2733))) V2733 V2734))) (if (shen.pvar? V2536) (do (shen.bindv V2536 () V2733) (let Result (let Hyp (tl V2516) (do (shen.incinfs) (bind V2732 (cons (cons (shen.lazyderef X V2733) (cons : (cons (shen.lazyderef A V2733) ()))) (cons (cons (shen.lazyderef Y V2733) (cons : (cons (cons vector (cons (shen.lazyderef A V2733) ())) ()))) (shen.lazyderef Hyp V2733))) V2733 V2734))) (do (shen.unbindv V2536 V2733) Result))) false))) (do (shen.unbindv V2534 V2733) Result))) false)))) (if (shen.pvar? V2533) (let A (shen.newpv V2733) (do (shen.bindv V2533 (cons A ()) V2733) (let Result (let V2537 (shen.lazyderef (tl V2525) V2733) (if (= () V2537) (let Hyp (tl V2516) (do (shen.incinfs) (bind V2732 (cons (cons (shen.lazyderef X V2733) (cons : (cons (shen.lazyderef A V2733) ()))) (cons (cons (shen.lazyderef Y V2733) (cons : (cons (cons vector (cons (shen.lazyderef A V2733) ())) ()))) (shen.lazyderef Hyp V2733))) V2733 V2734))) (if (shen.pvar? V2537) (do (shen.bindv V2537 () V2733) (let Result (let Hyp (tl V2516) (do (shen.incinfs) (bind V2732 (cons (cons (shen.lazyderef X V2733) (cons : (cons (shen.lazyderef A V2733) ()))) (cons (cons (shen.lazyderef Y V2733) (cons : (cons (cons vector (cons (shen.lazyderef A V2733) ())) ()))) (shen.lazyderef Hyp V2733))) V2733 V2734))) (do (shen.unbindv V2537 V2733) Result))) false))) (do (shen.unbindv V2533 V2733) Result)))) false))) (do (shen.unbindv V2527 V2733) Result))) false))) (if (shen.pvar? V2526) (let A (shen.newpv V2733) (do (shen.bindv V2526 (cons vector (cons A ())) V2733) (let Result (let V2538 (shen.lazyderef (tl V2525) V2733) (if (= () V2538) (let Hyp (tl V2516) (do (shen.incinfs) (bind V2732 (cons (cons (shen.lazyderef X V2733) (cons : (cons (shen.lazyderef A V2733) ()))) (cons (cons (shen.lazyderef Y V2733) (cons : (cons (cons vector (cons (shen.lazyderef A V2733) ())) ()))) (shen.lazyderef Hyp V2733))) V2733 V2734))) (if (shen.pvar? V2538) (do (shen.bindv V2538 () V2733) (let Result (let Hyp (tl V2516) (do (shen.incinfs) (bind V2732 (cons (cons (shen.lazyderef X V2733) (cons : (cons (shen.lazyderef A V2733) ()))) (cons (cons (shen.lazyderef Y V2733) (cons : (cons (cons vector (cons (shen.lazyderef A V2733) ())) ()))) (shen.lazyderef Hyp V2733))) V2733 V2734))) (do (shen.unbindv V2538 V2733) Result))) false))) (do (shen.unbindv V2526 V2733) Result)))) false))) false)) false)) false)) false))) false))) false)) false)) false)) false)) false)) (if (= Case false) (let Case (let V2539 (shen.lazyderef V2731 V2733) (if (cons? V2539) (let V2540 (shen.lazyderef (hd V2539) V2733) (if (cons? V2540) (let V2541 (shen.lazyderef (hd V2540) V2733) (if (cons? V2541) (let V2542 (shen.lazyderef (hd V2541) V2733) (if (= @s V2542) (let V2543 (shen.lazyderef (tl V2541) V2733) (if (cons? V2543) (let X (hd V2543) (let V2544 (shen.lazyderef (tl V2543) V2733) (if (cons? V2544) (let Y (hd V2544) (let V2545 (shen.lazyderef (tl V2544) V2733) (if (= () V2545) (let V2546 (shen.lazyderef (tl V2540) V2733) (if (cons? V2546) (let V2547 (shen.lazyderef (hd V2546) V2733) (if (= : V2547) (let V2548 (shen.lazyderef (tl V2546) V2733) (if (cons? V2548) (let V2549 (shen.lazyderef (hd V2548) V2733) (if (= string V2549) (let V2550 (shen.lazyderef (tl V2548) V2733) (if (= () V2550) (let Hyp (tl V2539) (do (shen.incinfs) (bind V2732 (cons (cons (shen.lazyderef X V2733) (cons : (cons string ()))) (cons (cons (shen.lazyderef Y V2733) (cons : (cons string ()))) (shen.lazyderef Hyp V2733))) V2733 V2734))) (if (shen.pvar? V2550) (do (shen.bindv V2550 () V2733) (let Result (let Hyp (tl V2539) (do (shen.incinfs) (bind V2732 (cons (cons (shen.lazyderef X V2733) (cons : (cons string ()))) (cons (cons (shen.lazyderef Y V2733) (cons : (cons string ()))) (shen.lazyderef Hyp V2733))) V2733 V2734))) (do (shen.unbindv V2550 V2733) Result))) false))) (if (shen.pvar? V2549) (do (shen.bindv V2549 string V2733) (let Result (let V2551 (shen.lazyderef (tl V2548) V2733) (if (= () V2551) (let Hyp (tl V2539) (do (shen.incinfs) (bind V2732 (cons (cons (shen.lazyderef X V2733) (cons : (cons string ()))) (cons (cons (shen.lazyderef Y V2733) (cons : (cons string ()))) (shen.lazyderef Hyp V2733))) V2733 V2734))) (if (shen.pvar? V2551) (do (shen.bindv V2551 () V2733) (let Result (let Hyp (tl V2539) (do (shen.incinfs) (bind V2732 (cons (cons (shen.lazyderef X V2733) (cons : (cons string ()))) (cons (cons (shen.lazyderef Y V2733) (cons : (cons string ()))) (shen.lazyderef Hyp V2733))) V2733 V2734))) (do (shen.unbindv V2551 V2733) Result))) false))) (do (shen.unbindv V2549 V2733) Result))) false))) false)) false)) false)) false))) false))) false)) false)) false)) false)) false)) (if (= Case false) (let V2552 (shen.lazyderef V2731 V2733) (if (cons? V2552) (let X (hd V2552) (let Hyp (tl V2552) (let NewHyps (shen.newpv V2733) (do (shen.incinfs) (bind V2732 (cons (shen.lazyderef X V2733) (shen.lazyderef NewHyps V2733)) V2733 (freeze (shen.t*-hyps Hyp NewHyps V2733 V2734))))))) false)) Case)) Case)) Case)) Case))) -(defun shen.show (V3912 V3913 V3914 V3915) (cond ((value shen.*spy*) (do (shen.line) (do (shen.show-p (shen.deref V3912 V3914)) (do (nl 1) (do (nl 1) (do (shen.show-assumptions (shen.deref V3913 V3914) 1) (do (shen.prhush " -> " (stoutput)) (do (shen.pause-for-user) (thaw V3915))))))))) (true (thaw V3915)))) +(defun shen.show (V2751 V2752 V2753 V2754) (cond ((value shen.*spy*) (do (shen.line) (do (shen.show-p (shen.deref V2751 V2753)) (do (nl 1) (do (nl 1) (do (shen.show-assumptions (shen.deref V2752 V2753) 1) (do (shen.prhush " +> " (stoutput)) (do (shen.pause-for-user) (thaw V2754))))))))) (true (thaw V2754)))) (defun shen.line () (let Infs (inferences) (shen.prhush (cn "____________________________________________________________ " (shen.app Infs (cn " inference" (shen.app (if (= 1 Infs) "" "s") " ?- " shen.a)) shen.a)) (stoutput)))) -(defun shen.show-p (V3917) (cond ((and (cons? V3917) (and (cons? (tl V3917)) (and (= : (hd (tl V3917))) (and (cons? (tl (tl V3917))) (= () (tl (tl (tl V3917)))))))) (shen.prhush (shen.app (hd V3917) (cn " : " (shen.app (hd (tl (tl V3917))) "" shen.r)) shen.r) (stoutput))) (true (shen.prhush (shen.app V3917 "" shen.r) (stoutput))))) +(defun shen.show-p (V2756) (cond ((and (cons? V2756) (and (cons? (tl V2756)) (and (= : (hd (tl V2756))) (and (cons? (tl (tl V2756))) (= () (tl (tl (tl V2756)))))))) (shen.prhush (shen.app (hd V2756) (cn " : " (shen.app (hd (tl (tl V2756))) "" shen.r)) shen.r) (stoutput))) (true (shen.prhush (shen.app V2756 "" shen.r) (stoutput))))) -(defun shen.show-assumptions (V3922 V3923) (cond ((= () V3922) shen.skip) ((cons? V3922) (do (shen.prhush (shen.app V3923 ". " shen.a) (stoutput)) (do (shen.show-p (hd V3922)) (do (nl 1) (shen.show-assumptions (tl V3922) (+ V3923 1)))))) (true (shen.f_error shen.show-assumptions)))) +(defun shen.show-assumptions (V2761 V2762) (cond ((= () V2761) shen.skip) ((cons? V2761) (do (shen.prhush (shen.app V2762 ". " shen.a) (stoutput)) (do (shen.show-p (hd V2761)) (do (nl 1) (shen.show-assumptions (tl V2761) (+ V2762 1)))))) (true (shen.f_error shen.show-assumptions)))) (defun shen.pause-for-user () (let Byte (read-byte (stinput)) (if (= Byte 94) (simple-error "input aborted ") (nl 1)))) -(defun shen.typedf? (V3925) (cons? (assoc V3925 (value shen.*signedfuncs*)))) +(defun shen.typedf? (V2764) (cons? (assoc V2764 (value shen.*signedfuncs*)))) -(defun shen.sigf (V3927) (concat shen.type-signature-of- V3927)) +(defun shen.sigf (V2766) (concat shen.type-signature-of- V2766)) (defun shen.placeholder () (gensym &&)) -(defun shen.base (V3932 V3933 V3934 V3935) (let Case (let V3616 (shen.lazyderef V3933 V3934) (if (= number V3616) (do (shen.incinfs) (fwhen (number? (shen.lazyderef V3932 V3934)) V3934 V3935)) (if (shen.pvar? V3616) (do (shen.bindv V3616 number V3934) (let Result (do (shen.incinfs) (fwhen (number? (shen.lazyderef V3932 V3934)) V3934 V3935)) (do (shen.unbindv V3616 V3934) Result))) false))) (if (= Case false) (let Case (let V3617 (shen.lazyderef V3933 V3934) (if (= boolean V3617) (do (shen.incinfs) (fwhen (boolean? (shen.lazyderef V3932 V3934)) V3934 V3935)) (if (shen.pvar? V3617) (do (shen.bindv V3617 boolean V3934) (let Result (do (shen.incinfs) (fwhen (boolean? (shen.lazyderef V3932 V3934)) V3934 V3935)) (do (shen.unbindv V3617 V3934) Result))) false))) (if (= Case false) (let Case (let V3618 (shen.lazyderef V3933 V3934) (if (= string V3618) (do (shen.incinfs) (fwhen (string? (shen.lazyderef V3932 V3934)) V3934 V3935)) (if (shen.pvar? V3618) (do (shen.bindv V3618 string V3934) (let Result (do (shen.incinfs) (fwhen (string? (shen.lazyderef V3932 V3934)) V3934 V3935)) (do (shen.unbindv V3618 V3934) Result))) false))) (if (= Case false) (let Case (let V3619 (shen.lazyderef V3933 V3934) (if (= symbol V3619) (do (shen.incinfs) (fwhen (symbol? (shen.lazyderef V3932 V3934)) V3934 (freeze (fwhen (not (shen.ue? (shen.lazyderef V3932 V3934))) V3934 V3935)))) (if (shen.pvar? V3619) (do (shen.bindv V3619 symbol V3934) (let Result (do (shen.incinfs) (fwhen (symbol? (shen.lazyderef V3932 V3934)) V3934 (freeze (fwhen (not (shen.ue? (shen.lazyderef V3932 V3934))) V3934 V3935)))) (do (shen.unbindv V3619 V3934) Result))) false))) (if (= Case false) (let V3620 (shen.lazyderef V3932 V3934) (if (= () V3620) (let V3621 (shen.lazyderef V3933 V3934) (if (cons? V3621) (let V3622 (shen.lazyderef (hd V3621) V3934) (if (= list V3622) (let V3623 (shen.lazyderef (tl V3621) V3934) (if (cons? V3623) (let A (hd V3623) (let V3624 (shen.lazyderef (tl V3623) V3934) (if (= () V3624) (do (shen.incinfs) (thaw V3935)) (if (shen.pvar? V3624) (do (shen.bindv V3624 () V3934) (let Result (do (shen.incinfs) (thaw V3935)) (do (shen.unbindv V3624 V3934) Result))) false)))) (if (shen.pvar? V3623) (let A (shen.newpv V3934) (do (shen.bindv V3623 (cons A ()) V3934) (let Result (do (shen.incinfs) (thaw V3935)) (do (shen.unbindv V3623 V3934) Result)))) false))) (if (shen.pvar? V3622) (do (shen.bindv V3622 list V3934) (let Result (let V3625 (shen.lazyderef (tl V3621) V3934) (if (cons? V3625) (let A (hd V3625) (let V3626 (shen.lazyderef (tl V3625) V3934) (if (= () V3626) (do (shen.incinfs) (thaw V3935)) (if (shen.pvar? V3626) (do (shen.bindv V3626 () V3934) (let Result (do (shen.incinfs) (thaw V3935)) (do (shen.unbindv V3626 V3934) Result))) false)))) (if (shen.pvar? V3625) (let A (shen.newpv V3934) (do (shen.bindv V3625 (cons A ()) V3934) (let Result (do (shen.incinfs) (thaw V3935)) (do (shen.unbindv V3625 V3934) Result)))) false))) (do (shen.unbindv V3622 V3934) Result))) false))) (if (shen.pvar? V3621) (let A (shen.newpv V3934) (do (shen.bindv V3621 (cons list (cons A ())) V3934) (let Result (do (shen.incinfs) (thaw V3935)) (do (shen.unbindv V3621 V3934) Result)))) false))) false)) Case)) Case)) Case)) Case))) +(defun shen.base (V2771 V2772 V2773 V2774) (let Case (let V2455 (shen.lazyderef V2772 V2773) (if (= number V2455) (do (shen.incinfs) (fwhen (number? (shen.lazyderef V2771 V2773)) V2773 V2774)) (if (shen.pvar? V2455) (do (shen.bindv V2455 number V2773) (let Result (do (shen.incinfs) (fwhen (number? (shen.lazyderef V2771 V2773)) V2773 V2774)) (do (shen.unbindv V2455 V2773) Result))) false))) (if (= Case false) (let Case (let V2456 (shen.lazyderef V2772 V2773) (if (= boolean V2456) (do (shen.incinfs) (fwhen (boolean? (shen.lazyderef V2771 V2773)) V2773 V2774)) (if (shen.pvar? V2456) (do (shen.bindv V2456 boolean V2773) (let Result (do (shen.incinfs) (fwhen (boolean? (shen.lazyderef V2771 V2773)) V2773 V2774)) (do (shen.unbindv V2456 V2773) Result))) false))) (if (= Case false) (let Case (let V2457 (shen.lazyderef V2772 V2773) (if (= string V2457) (do (shen.incinfs) (fwhen (string? (shen.lazyderef V2771 V2773)) V2773 V2774)) (if (shen.pvar? V2457) (do (shen.bindv V2457 string V2773) (let Result (do (shen.incinfs) (fwhen (string? (shen.lazyderef V2771 V2773)) V2773 V2774)) (do (shen.unbindv V2457 V2773) Result))) false))) (if (= Case false) (let Case (let V2458 (shen.lazyderef V2772 V2773) (if (= symbol V2458) (do (shen.incinfs) (fwhen (symbol? (shen.lazyderef V2771 V2773)) V2773 (freeze (fwhen (not (shen.ue? (shen.lazyderef V2771 V2773))) V2773 V2774)))) (if (shen.pvar? V2458) (do (shen.bindv V2458 symbol V2773) (let Result (do (shen.incinfs) (fwhen (symbol? (shen.lazyderef V2771 V2773)) V2773 (freeze (fwhen (not (shen.ue? (shen.lazyderef V2771 V2773))) V2773 V2774)))) (do (shen.unbindv V2458 V2773) Result))) false))) (if (= Case false) (let V2459 (shen.lazyderef V2771 V2773) (if (= () V2459) (let V2460 (shen.lazyderef V2772 V2773) (if (cons? V2460) (let V2461 (shen.lazyderef (hd V2460) V2773) (if (= list V2461) (let V2462 (shen.lazyderef (tl V2460) V2773) (if (cons? V2462) (let A (hd V2462) (let V2463 (shen.lazyderef (tl V2462) V2773) (if (= () V2463) (do (shen.incinfs) (thaw V2774)) (if (shen.pvar? V2463) (do (shen.bindv V2463 () V2773) (let Result (do (shen.incinfs) (thaw V2774)) (do (shen.unbindv V2463 V2773) Result))) false)))) (if (shen.pvar? V2462) (let A (shen.newpv V2773) (do (shen.bindv V2462 (cons A ()) V2773) (let Result (do (shen.incinfs) (thaw V2774)) (do (shen.unbindv V2462 V2773) Result)))) false))) (if (shen.pvar? V2461) (do (shen.bindv V2461 list V2773) (let Result (let V2464 (shen.lazyderef (tl V2460) V2773) (if (cons? V2464) (let A (hd V2464) (let V2465 (shen.lazyderef (tl V2464) V2773) (if (= () V2465) (do (shen.incinfs) (thaw V2774)) (if (shen.pvar? V2465) (do (shen.bindv V2465 () V2773) (let Result (do (shen.incinfs) (thaw V2774)) (do (shen.unbindv V2465 V2773) Result))) false)))) (if (shen.pvar? V2464) (let A (shen.newpv V2773) (do (shen.bindv V2464 (cons A ()) V2773) (let Result (do (shen.incinfs) (thaw V2774)) (do (shen.unbindv V2464 V2773) Result)))) false))) (do (shen.unbindv V2461 V2773) Result))) false))) (if (shen.pvar? V2460) (let A (shen.newpv V2773) (do (shen.bindv V2460 (cons list (cons A ())) V2773) (let Result (do (shen.incinfs) (thaw V2774)) (do (shen.unbindv V2460 V2773) Result)))) false))) false)) Case)) Case)) Case)) Case))) -(defun shen.by_hypothesis (V3941 V3942 V3943 V3944 V3945) (let Case (let V3607 (shen.lazyderef V3943 V3944) (if (cons? V3607) (let V3608 (shen.lazyderef (hd V3607) V3944) (if (cons? V3608) (let Y (hd V3608) (let V3609 (shen.lazyderef (tl V3608) V3944) (if (cons? V3609) (let V3610 (shen.lazyderef (hd V3609) V3944) (if (= : V3610) (let V3611 (shen.lazyderef (tl V3609) V3944) (if (cons? V3611) (let B (hd V3611) (let V3612 (shen.lazyderef (tl V3611) V3944) (if (= () V3612) (do (shen.incinfs) (identical V3941 Y V3944 (freeze (unify! V3942 B V3944 V3945)))) false))) false)) false)) false))) false)) false)) (if (= Case false) (let V3613 (shen.lazyderef V3943 V3944) (if (cons? V3613) (let Hyp (tl V3613) (do (shen.incinfs) (shen.by_hypothesis V3941 V3942 Hyp V3944 V3945))) false)) Case))) +(defun shen.by_hypothesis (V2780 V2781 V2782 V2783 V2784) (let Case (let V2446 (shen.lazyderef V2782 V2783) (if (cons? V2446) (let V2447 (shen.lazyderef (hd V2446) V2783) (if (cons? V2447) (let Y (hd V2447) (let V2448 (shen.lazyderef (tl V2447) V2783) (if (cons? V2448) (let V2449 (shen.lazyderef (hd V2448) V2783) (if (= : V2449) (let V2450 (shen.lazyderef (tl V2448) V2783) (if (cons? V2450) (let B (hd V2450) (let V2451 (shen.lazyderef (tl V2450) V2783) (if (= () V2451) (do (shen.incinfs) (identical V2780 Y V2783 (freeze (unify! V2781 B V2783 V2784)))) false))) false)) false)) false))) false)) false)) (if (= Case false) (let V2452 (shen.lazyderef V2782 V2783) (if (cons? V2452) (let Hyp (tl V2452) (do (shen.incinfs) (shen.by_hypothesis V2780 V2781 Hyp V2783 V2784))) false)) Case))) -(defun shen.t*-def (V3951 V3952 V3953 V3954 V3955) (let V3601 (shen.lazyderef V3951 V3954) (if (cons? V3601) (let V3602 (shen.lazyderef (hd V3601) V3954) (if (= define V3602) (let V3603 (shen.lazyderef (tl V3601) V3954) (if (cons? V3603) (let F (hd V3603) (let X (tl V3603) (let Y (shen.newpv V3954) (let E (shen.newpv V3954) (do (shen.incinfs) (shen.t*-defh (compile (lambda Y (shen. Y)) X (lambda E (if (cons? E) (simple-error (cn "parse error here: " (shen.app E " +(defun shen.t*-def (V2790 V2791 V2792 V2793 V2794) (let V2440 (shen.lazyderef V2790 V2793) (if (cons? V2440) (let V2441 (shen.lazyderef (hd V2440) V2793) (if (= define V2441) (let V2442 (shen.lazyderef (tl V2440) V2793) (if (cons? V2442) (let F (hd V2442) (let X (tl V2442) (let Y (shen.newpv V2793) (let E (shen.newpv V2793) (do (shen.incinfs) (shen.t*-defh (compile (lambda Y (shen. Y)) X (lambda E (if (cons? E) (simple-error (cn "parse error here: " (shen.app E " " shen.s))) (simple-error "parse error -")))) F V3952 V3953 V3954 V3955)))))) false)) false)) false))) +")))) F V2791 V2792 V2793 V2794)))))) false)) false)) false))) -(defun shen.t*-defh (V3962 V3963 V3964 V3965 V3966 V3967) (let V3597 (shen.lazyderef V3962 V3966) (if (cons? V3597) (let Sig (hd V3597) (let Rules (tl V3597) (do (shen.incinfs) (shen.t*-defhh Sig (shen.ue-sig Sig) V3963 V3964 V3965 Rules V3966 V3967)))) false))) +(defun shen.t*-defh (V2801 V2802 V2803 V2804 V2805 V2806) (let V2436 (shen.lazyderef V2801 V2805) (if (cons? V2436) (let Sig (hd V2436) (let Rules (tl V2436) (do (shen.incinfs) (shen.t*-defhh Sig (shen.ue-sig Sig) V2802 V2803 V2804 Rules V2805 V2806)))) false))) -(defun shen.t*-defhh (V3976 V3977 V3978 V3979 V3980 V3981 V3982 V3983) (do (shen.incinfs) (shen.t*-rules V3981 V3977 1 V3978 (cons (cons V3978 (cons : (cons V3977 ()))) V3980) V3982 (freeze (shen.memo V3978 V3976 V3979 V3982 V3983))))) +(defun shen.t*-defhh (V2815 V2816 V2817 V2818 V2819 V2820 V2821 V2822) (do (shen.incinfs) (shen.t*-rules V2820 V2816 1 V2817 (cons (cons V2817 (cons : (cons V2816 ()))) V2819) V2821 (freeze (shen.memo V2817 V2815 V2818 V2821 V2822))))) -(defun shen.memo (V3989 V3990 V3991 V3992 V3993) (let Jnk (shen.newpv V3992) (do (shen.incinfs) (unify! V3991 V3990 V3992 (freeze (bind Jnk (declare (shen.lazyderef V3989 V3992) (shen.lazyderef V3991 V3992)) V3992 V3993)))))) +(defun shen.memo (V2828 V2829 V2830 V2831 V2832) (let Jnk (shen.newpv V2831) (do (shen.incinfs) (unify! V2830 V2829 V2831 (freeze (bind Jnk (declare (shen.lazyderef V2828 V2831) (shen.lazyderef V2830 V2831)) V2831 V2832)))))) -(defun shen. (V3995) (let Parse_shen. (shen. V3995) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (shen.hdtl Parse_shen.) (shen.hdtl Parse_shen.))) (fail))) (fail)))) +(defun shen. (V2834) (let Parse_shen. (shen. V2834) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (shen.hdtl Parse_shen.) (shen.hdtl Parse_shen.))) (fail))) (fail)))) -(defun shen. (V3997) (let YaccParse (let Parse_shen. (shen. V3997) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (shen.hdtl Parse_shen.) (shen.hdtl Parse_shen.))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_shen. (shen. V3997) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (shen.hdtl Parse_shen.) ())) (fail))) YaccParse))) +(defun shen. (V2836) (let YaccParse (let Parse_shen. (shen. V2836) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (shen.hdtl Parse_shen.) (shen.hdtl Parse_shen.))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_shen. (shen. V2836) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (shen.hdtl Parse_shen.) ())) (fail))) YaccParse))) -(defun shen.ue (V3999) (cond ((and (cons? V3999) (and (cons? (tl V3999)) (and (= () (tl (tl V3999))) (= (hd V3999) protect)))) V3999) ((cons? V3999) (map (lambda Z (shen.ue Z)) V3999)) ((variable? V3999) (concat && V3999)) (true V3999))) +(defun shen.ue (V2838) (cond ((and (cons? V2838) (and (cons? (tl V2838)) (and (= () (tl (tl V2838))) (= (hd V2838) protect)))) V2838) ((cons? V2838) (map (lambda Z (shen.ue Z)) V2838)) ((variable? V2838) (concat && V2838)) (true V2838))) -(defun shen.ue-sig (V4001) (cond ((cons? V4001) (map (lambda Z (shen.ue-sig Z)) V4001)) ((variable? V4001) (concat &&& V4001)) (true V4001))) +(defun shen.ue-sig (V2840) (cond ((cons? V2840) (map (lambda Z (shen.ue-sig Z)) V2840)) ((variable? V2840) (concat &&& V2840)) (true V2840))) -(defun shen.ues (V4007) (cond ((shen.ue? V4007) (cons V4007 ())) ((cons? V4007) (union (shen.ues (hd V4007)) (shen.ues (tl V4007)))) (true ()))) +(defun shen.ues (V2846) (cond ((shen.ue? V2846) (cons V2846 ())) ((cons? V2846) (union (shen.ues (hd V2846)) (shen.ues (tl V2846)))) (true ()))) -(defun shen.ue? (V4009) (and (symbol? V4009) (shen.ue-h? (str V4009)))) +(defun shen.ue? (V2848) (and (symbol? V2848) (shen.ue-h? (str V2848)))) -(defun shen.ue-h? (V4017) (cond ((and (shen.+string? V4017) (and (= "&" (pos V4017 0)) (and (shen.+string? (tlstr V4017)) (= "&" (pos (tlstr V4017) 0))))) true) (true false))) +(defun shen.ue-h? (V2856) (cond ((and (shen.+string? V2856) (and (= "&" (pos V2856 0)) (and (shen.+string? (tlstr V2856)) (= "&" (pos (tlstr V2856) 0))))) true) (true false))) -(defun shen.t*-rules (V4025 V4026 V4027 V4028 V4029 V4030 V4031) (let Throwcontrol (shen.catchpoint) (shen.cutpoint Throwcontrol (let Case (let V3581 (shen.lazyderef V4025 V4030) (if (= () V3581) (do (shen.incinfs) (thaw V4031)) false)) (if (= Case false) (let Case (let V3582 (shen.lazyderef V4025 V4030) (if (cons? V3582) (let Rule (hd V3582) (let Rules (tl V3582) (do (shen.incinfs) (shen.t*-rule (shen.ue Rule) V4026 V4029 V4030 (freeze (cut Throwcontrol V4030 (freeze (shen.t*-rules Rules V4026 (+ V4027 1) V4028 V4029 V4030 V4031)))))))) false)) (if (= Case false) (let Err (shen.newpv V4030) (do (shen.incinfs) (bind Err (simple-error (cn "type error in rule " (shen.app (shen.lazyderef V4027 V4030) (cn " of " (shen.app (shen.lazyderef V4028 V4030) "" shen.a)) shen.a))) V4030 V4031))) Case)) Case))))) +(defun shen.t*-rules (V2864 V2865 V2866 V2867 V2868 V2869 V2870) (let Throwcontrol (shen.catchpoint) (shen.cutpoint Throwcontrol (let Case (let V2420 (shen.lazyderef V2864 V2869) (if (= () V2420) (do (shen.incinfs) (thaw V2870)) false)) (if (= Case false) (let Case (let V2421 (shen.lazyderef V2864 V2869) (if (cons? V2421) (let Rule (hd V2421) (let Rules (tl V2421) (do (shen.incinfs) (shen.t*-rule (shen.ue Rule) V2865 V2868 V2869 (freeze (cut Throwcontrol V2869 (freeze (shen.t*-rules Rules V2865 (+ V2866 1) V2867 V2868 V2869 V2870)))))))) false)) (if (= Case false) (let Err (shen.newpv V2869) (do (shen.incinfs) (bind Err (simple-error (cn "type error in rule " (shen.app (shen.lazyderef V2866 V2869) (cn " of " (shen.app (shen.lazyderef V2867 V2869) "" shen.a)) shen.a))) V2869 V2870))) Case)) Case))))) -(defun shen.t*-rule (V4037 V4038 V4039 V4040 V4041) (let Throwcontrol (shen.catchpoint) (shen.cutpoint Throwcontrol (let V3573 (shen.lazyderef V4037 V4040) (if (cons? V3573) (let Patterns (hd V3573) (let V3574 (shen.lazyderef (tl V3573) V4040) (if (cons? V3574) (let Action (hd V3574) (let V3575 (shen.lazyderef (tl V3574) V4040) (if (= () V3575) (let NewHyps (shen.newpv V4040) (do (shen.incinfs) (shen.newhyps (shen.placeholders Patterns) V4039 NewHyps V4040 (freeze (shen.t*-patterns Patterns V4038 NewHyps V4040 (freeze (cut Throwcontrol V4040 (freeze (shen.t*-action (shen.curry (shen.ue Action)) (shen.result-type Patterns V4038) (shen.patthyps Patterns V4038 V4039) V4040 V4041))))))))) false))) false))) false))))) +(defun shen.t*-rule (V2876 V2877 V2878 V2879 V2880) (let Throwcontrol (shen.catchpoint) (shen.cutpoint Throwcontrol (let V2412 (shen.lazyderef V2876 V2879) (if (cons? V2412) (let Patterns (hd V2412) (let V2413 (shen.lazyderef (tl V2412) V2879) (if (cons? V2413) (let Action (hd V2413) (let V2414 (shen.lazyderef (tl V2413) V2879) (if (= () V2414) (let NewHyps (shen.newpv V2879) (do (shen.incinfs) (shen.newhyps (shen.placeholders Patterns) V2878 NewHyps V2879 (freeze (shen.t*-patterns Patterns V2877 NewHyps V2879 (freeze (cut Throwcontrol V2879 (freeze (shen.t*-action (shen.curry (shen.ue Action)) (shen.result-type Patterns V2877) (shen.patthyps Patterns V2877 V2878) V2879 V2880))))))))) false))) false))) false))))) -(defun shen.placeholders (V4047) (cond ((shen.ue? V4047) (cons V4047 ())) ((cons? V4047) (union (shen.placeholders (hd V4047)) (shen.placeholders (tl V4047)))) (true ()))) +(defun shen.placeholders (V2886) (cond ((shen.ue? V2886) (cons V2886 ())) ((cons? V2886) (union (shen.placeholders (hd V2886)) (shen.placeholders (tl V2886)))) (true ()))) -(defun shen.newhyps (V4053 V4054 V4055 V4056 V4057) (let Case (let V3560 (shen.lazyderef V4053 V4056) (if (= () V3560) (do (shen.incinfs) (unify! V4055 V4054 V4056 V4057)) false)) (if (= Case false) (let V3561 (shen.lazyderef V4053 V4056) (if (cons? V3561) (let V3556 (hd V3561) (let Vs (tl V3561) (let V3562 (shen.lazyderef V4055 V4056) (if (cons? V3562) (let V3563 (shen.lazyderef (hd V3562) V4056) (if (cons? V3563) (let V (hd V3563) (let V3564 (shen.lazyderef (tl V3563) V4056) (if (cons? V3564) (let V3565 (shen.lazyderef (hd V3564) V4056) (if (= : V3565) (let V3566 (shen.lazyderef (tl V3564) V4056) (if (cons? V3566) (let A (hd V3566) (let V3567 (shen.lazyderef (tl V3566) V4056) (if (= () V3567) (let NewHyp (tl V3562) (do (shen.incinfs) (unify! V V3556 V4056 (freeze (shen.newhyps Vs V4054 NewHyp V4056 V4057))))) (if (shen.pvar? V3567) (do (shen.bindv V3567 () V4056) (let Result (let NewHyp (tl V3562) (do (shen.incinfs) (unify! V V3556 V4056 (freeze (shen.newhyps Vs V4054 NewHyp V4056 V4057))))) (do (shen.unbindv V3567 V4056) Result))) false)))) (if (shen.pvar? V3566) (let A (shen.newpv V4056) (do (shen.bindv V3566 (cons A ()) V4056) (let Result (let NewHyp (tl V3562) (do (shen.incinfs) (unify! V V3556 V4056 (freeze (shen.newhyps Vs V4054 NewHyp V4056 V4057))))) (do (shen.unbindv V3566 V4056) Result)))) false))) (if (shen.pvar? V3565) (do (shen.bindv V3565 : V4056) (let Result (let V3568 (shen.lazyderef (tl V3564) V4056) (if (cons? V3568) (let A (hd V3568) (let V3569 (shen.lazyderef (tl V3568) V4056) (if (= () V3569) (let NewHyp (tl V3562) (do (shen.incinfs) (unify! V V3556 V4056 (freeze (shen.newhyps Vs V4054 NewHyp V4056 V4057))))) (if (shen.pvar? V3569) (do (shen.bindv V3569 () V4056) (let Result (let NewHyp (tl V3562) (do (shen.incinfs) (unify! V V3556 V4056 (freeze (shen.newhyps Vs V4054 NewHyp V4056 V4057))))) (do (shen.unbindv V3569 V4056) Result))) false)))) (if (shen.pvar? V3568) (let A (shen.newpv V4056) (do (shen.bindv V3568 (cons A ()) V4056) (let Result (let NewHyp (tl V3562) (do (shen.incinfs) (unify! V V3556 V4056 (freeze (shen.newhyps Vs V4054 NewHyp V4056 V4057))))) (do (shen.unbindv V3568 V4056) Result)))) false))) (do (shen.unbindv V3565 V4056) Result))) false))) (if (shen.pvar? V3564) (let A (shen.newpv V4056) (do (shen.bindv V3564 (cons : (cons A ())) V4056) (let Result (let NewHyp (tl V3562) (do (shen.incinfs) (unify! V V3556 V4056 (freeze (shen.newhyps Vs V4054 NewHyp V4056 V4057))))) (do (shen.unbindv V3564 V4056) Result)))) false)))) (if (shen.pvar? V3563) (let V (shen.newpv V4056) (let A (shen.newpv V4056) (do (shen.bindv V3563 (cons V (cons : (cons A ()))) V4056) (let Result (let NewHyp (tl V3562) (do (shen.incinfs) (unify! V V3556 V4056 (freeze (shen.newhyps Vs V4054 NewHyp V4056 V4057))))) (do (shen.unbindv V3563 V4056) Result))))) false))) (if (shen.pvar? V3562) (let V (shen.newpv V4056) (let A (shen.newpv V4056) (let NewHyp (shen.newpv V4056) (do (shen.bindv V3562 (cons (cons V (cons : (cons A ()))) NewHyp) V4056) (let Result (do (shen.incinfs) (unify! V V3556 V4056 (freeze (shen.newhyps Vs V4054 NewHyp V4056 V4057)))) (do (shen.unbindv V3562 V4056) Result)))))) false))))) false)) Case))) +(defun shen.newhyps (V2892 V2893 V2894 V2895 V2896) (let Case (let V2399 (shen.lazyderef V2892 V2895) (if (= () V2399) (do (shen.incinfs) (unify! V2894 V2893 V2895 V2896)) false)) (if (= Case false) (let V2400 (shen.lazyderef V2892 V2895) (if (cons? V2400) (let V2395 (hd V2400) (let Vs (tl V2400) (let V2401 (shen.lazyderef V2894 V2895) (if (cons? V2401) (let V2402 (shen.lazyderef (hd V2401) V2895) (if (cons? V2402) (let V (hd V2402) (let V2403 (shen.lazyderef (tl V2402) V2895) (if (cons? V2403) (let V2404 (shen.lazyderef (hd V2403) V2895) (if (= : V2404) (let V2405 (shen.lazyderef (tl V2403) V2895) (if (cons? V2405) (let A (hd V2405) (let V2406 (shen.lazyderef (tl V2405) V2895) (if (= () V2406) (let NewHyp (tl V2401) (do (shen.incinfs) (unify! V V2395 V2895 (freeze (shen.newhyps Vs V2893 NewHyp V2895 V2896))))) (if (shen.pvar? V2406) (do (shen.bindv V2406 () V2895) (let Result (let NewHyp (tl V2401) (do (shen.incinfs) (unify! V V2395 V2895 (freeze (shen.newhyps Vs V2893 NewHyp V2895 V2896))))) (do (shen.unbindv V2406 V2895) Result))) false)))) (if (shen.pvar? V2405) (let A (shen.newpv V2895) (do (shen.bindv V2405 (cons A ()) V2895) (let Result (let NewHyp (tl V2401) (do (shen.incinfs) (unify! V V2395 V2895 (freeze (shen.newhyps Vs V2893 NewHyp V2895 V2896))))) (do (shen.unbindv V2405 V2895) Result)))) false))) (if (shen.pvar? V2404) (do (shen.bindv V2404 : V2895) (let Result (let V2407 (shen.lazyderef (tl V2403) V2895) (if (cons? V2407) (let A (hd V2407) (let V2408 (shen.lazyderef (tl V2407) V2895) (if (= () V2408) (let NewHyp (tl V2401) (do (shen.incinfs) (unify! V V2395 V2895 (freeze (shen.newhyps Vs V2893 NewHyp V2895 V2896))))) (if (shen.pvar? V2408) (do (shen.bindv V2408 () V2895) (let Result (let NewHyp (tl V2401) (do (shen.incinfs) (unify! V V2395 V2895 (freeze (shen.newhyps Vs V2893 NewHyp V2895 V2896))))) (do (shen.unbindv V2408 V2895) Result))) false)))) (if (shen.pvar? V2407) (let A (shen.newpv V2895) (do (shen.bindv V2407 (cons A ()) V2895) (let Result (let NewHyp (tl V2401) (do (shen.incinfs) (unify! V V2395 V2895 (freeze (shen.newhyps Vs V2893 NewHyp V2895 V2896))))) (do (shen.unbindv V2407 V2895) Result)))) false))) (do (shen.unbindv V2404 V2895) Result))) false))) (if (shen.pvar? V2403) (let A (shen.newpv V2895) (do (shen.bindv V2403 (cons : (cons A ())) V2895) (let Result (let NewHyp (tl V2401) (do (shen.incinfs) (unify! V V2395 V2895 (freeze (shen.newhyps Vs V2893 NewHyp V2895 V2896))))) (do (shen.unbindv V2403 V2895) Result)))) false)))) (if (shen.pvar? V2402) (let V (shen.newpv V2895) (let A (shen.newpv V2895) (do (shen.bindv V2402 (cons V (cons : (cons A ()))) V2895) (let Result (let NewHyp (tl V2401) (do (shen.incinfs) (unify! V V2395 V2895 (freeze (shen.newhyps Vs V2893 NewHyp V2895 V2896))))) (do (shen.unbindv V2402 V2895) Result))))) false))) (if (shen.pvar? V2401) (let V (shen.newpv V2895) (let A (shen.newpv V2895) (let NewHyp (shen.newpv V2895) (do (shen.bindv V2401 (cons (cons V (cons : (cons A ()))) NewHyp) V2895) (let Result (do (shen.incinfs) (unify! V V2395 V2895 (freeze (shen.newhyps Vs V2893 NewHyp V2895 V2896)))) (do (shen.unbindv V2401 V2895) Result)))))) false))))) false)) Case))) -(defun shen.patthyps (V4063 V4064 V4065) (cond ((= () V4063) V4065) ((and (cons? V4063) (and (cons? V4064) (and (cons? (tl V4064)) (and (= --> (hd (tl V4064))) (and (cons? (tl (tl V4064))) (= () (tl (tl (tl V4064))))))))) (adjoin (cons (hd V4063) (cons : (cons (hd V4064) ()))) (shen.patthyps (tl V4063) (hd (tl (tl V4064))) V4065))) (true (shen.f_error shen.patthyps)))) +(defun shen.patthyps (V2902 V2903 V2904) (cond ((= () V2902) V2904) ((and (cons? V2902) (and (cons? V2903) (and (cons? (tl V2903)) (and (= --> (hd (tl V2903))) (and (cons? (tl (tl V2903))) (= () (tl (tl (tl V2903))))))))) (adjoin (cons (shen.curry (hd V2902)) (cons : (cons (hd V2903) ()))) (shen.patthyps (tl V2902) (hd (tl (tl V2903))) V2904))) (true (shen.f_error shen.patthyps)))) -(defun shen.result-type (V4072 V4073) (cond ((and (= () V4072) (and (cons? V4073) (and (= --> (hd V4073)) (and (cons? (tl V4073)) (= () (tl (tl V4073))))))) (hd (tl V4073))) ((= () V4072) V4073) ((and (cons? V4072) (and (cons? V4073) (and (cons? (tl V4073)) (and (= --> (hd (tl V4073))) (and (cons? (tl (tl V4073))) (= () (tl (tl (tl V4073))))))))) (shen.result-type (tl V4072) (hd (tl (tl V4073))))) (true (shen.f_error shen.result-type)))) +(defun shen.result-type (V2911 V2912) (cond ((and (= () V2911) (and (cons? V2912) (and (= --> (hd V2912)) (and (cons? (tl V2912)) (= () (tl (tl V2912))))))) (hd (tl V2912))) ((= () V2911) V2912) ((and (cons? V2911) (and (cons? V2912) (and (cons? (tl V2912)) (and (= --> (hd (tl V2912))) (and (cons? (tl (tl V2912))) (= () (tl (tl (tl V2912))))))))) (shen.result-type (tl V2911) (hd (tl (tl V2912))))) (true (shen.f_error shen.result-type)))) -(defun shen.t*-patterns (V4079 V4080 V4081 V4082 V4083) (let Case (let V3548 (shen.lazyderef V4079 V4082) (if (= () V3548) (do (shen.incinfs) (thaw V4083)) false)) (if (= Case false) (let V3549 (shen.lazyderef V4079 V4082) (if (cons? V3549) (let Pattern (hd V3549) (let Patterns (tl V3549) (let V3550 (shen.lazyderef V4080 V4082) (if (cons? V3550) (let A (hd V3550) (let V3551 (shen.lazyderef (tl V3550) V4082) (if (cons? V3551) (let V3552 (shen.lazyderef (hd V3551) V4082) (if (= --> V3552) (let V3553 (shen.lazyderef (tl V3551) V4082) (if (cons? V3553) (let B (hd V3553) (let V3554 (shen.lazyderef (tl V3553) V4082) (if (= () V3554) (do (shen.incinfs) (shen.t* (cons Pattern (cons : (cons A ()))) V4081 V4082 (freeze (shen.t*-patterns Patterns B V4081 V4082 V4083)))) false))) false)) false)) false))) false)))) false)) Case))) +(defun shen.t*-patterns (V2918 V2919 V2920 V2921 V2922) (let Case (let V2387 (shen.lazyderef V2918 V2921) (if (= () V2387) (do (shen.incinfs) (thaw V2922)) false)) (if (= Case false) (let V2388 (shen.lazyderef V2918 V2921) (if (cons? V2388) (let Pattern (hd V2388) (let Patterns (tl V2388) (let V2389 (shen.lazyderef V2919 V2921) (if (cons? V2389) (let A (hd V2389) (let V2390 (shen.lazyderef (tl V2389) V2921) (if (cons? V2390) (let V2391 (shen.lazyderef (hd V2390) V2921) (if (= --> V2391) (let V2392 (shen.lazyderef (tl V2390) V2921) (if (cons? V2392) (let B (hd V2392) (let V2393 (shen.lazyderef (tl V2392) V2921) (if (= () V2393) (do (shen.incinfs) (shen.t* (cons (shen.curry Pattern) (cons : (cons A ()))) V2920 V2921 (freeze (shen.t*-patterns Patterns B V2920 V2921 V2922)))) false))) false)) false)) false))) false)))) false)) Case))) -(defun shen.t*-action (V4089 V4090 V4091 V4092 V4093) (let Throwcontrol (shen.catchpoint) (shen.cutpoint Throwcontrol (let Case (let V3525 (shen.lazyderef V4089 V4092) (if (cons? V3525) (let V3526 (shen.lazyderef (hd V3525) V4092) (if (= where V3526) (let V3527 (shen.lazyderef (tl V3525) V4092) (if (cons? V3527) (let P (hd V3527) (let V3528 (shen.lazyderef (tl V3527) V4092) (if (cons? V3528) (let Action (hd V3528) (let V3529 (shen.lazyderef (tl V3528) V4092) (if (= () V3529) (do (shen.incinfs) (cut Throwcontrol V4092 (freeze (shen.t* (cons P (cons : (cons boolean ()))) V4091 V4092 (freeze (cut Throwcontrol V4092 (freeze (shen.t*-action Action V4090 (cons (cons P (cons : (cons verified ()))) V4091) V4092 V4093)))))))) false))) false))) false)) false)) false)) (if (= Case false) (let Case (let V3530 (shen.lazyderef V4089 V4092) (if (cons? V3530) (let V3531 (shen.lazyderef (hd V3530) V4092) (if (= shen.choicepoint! V3531) (let V3532 (shen.lazyderef (tl V3530) V4092) (if (cons? V3532) (let V3533 (shen.lazyderef (hd V3532) V4092) (if (cons? V3533) (let V3534 (shen.lazyderef (hd V3533) V4092) (if (cons? V3534) (let V3535 (shen.lazyderef (hd V3534) V4092) (if (= fail-if V3535) (let V3536 (shen.lazyderef (tl V3534) V4092) (if (cons? V3536) (let F (hd V3536) (let V3537 (shen.lazyderef (tl V3536) V4092) (if (= () V3537) (let V3538 (shen.lazyderef (tl V3533) V4092) (if (cons? V3538) (let Action (hd V3538) (let V3539 (shen.lazyderef (tl V3538) V4092) (if (= () V3539) (let V3540 (shen.lazyderef (tl V3532) V4092) (if (= () V3540) (do (shen.incinfs) (cut Throwcontrol V4092 (freeze (shen.t*-action (cons where (cons (cons not (cons (cons F (cons Action ())) ())) (cons Action ()))) V4090 V4091 V4092 V4093)))) false)) false))) false)) false))) false)) false)) false)) false)) false)) false)) false)) (if (= Case false) (let Case (let V3541 (shen.lazyderef V4089 V4092) (if (cons? V3541) (let V3542 (shen.lazyderef (hd V3541) V4092) (if (= shen.choicepoint! V3542) (let V3543 (shen.lazyderef (tl V3541) V4092) (if (cons? V3543) (let Action (hd V3543) (let V3544 (shen.lazyderef (tl V3543) V4092) (if (= () V3544) (do (shen.incinfs) (cut Throwcontrol V4092 (freeze (shen.t*-action (cons where (cons (cons not (cons (cons (cons = (cons Action ())) (cons (cons fail ()) ())) ())) (cons Action ()))) V4090 V4091 V4092 V4093)))) false))) false)) false)) false)) (if (= Case false) (do (shen.incinfs) (shen.t* (cons V4089 (cons : (cons V4090 ()))) V4091 V4092 V4093)) Case)) Case)) Case))))) +(defun shen.t*-action (V2928 V2929 V2930 V2931 V2932) (let Throwcontrol (shen.catchpoint) (shen.cutpoint Throwcontrol (let Case (let V2364 (shen.lazyderef V2928 V2931) (if (cons? V2364) (let V2365 (shen.lazyderef (hd V2364) V2931) (if (= where V2365) (let V2366 (shen.lazyderef (tl V2364) V2931) (if (cons? V2366) (let P (hd V2366) (let V2367 (shen.lazyderef (tl V2366) V2931) (if (cons? V2367) (let Action (hd V2367) (let V2368 (shen.lazyderef (tl V2367) V2931) (if (= () V2368) (do (shen.incinfs) (cut Throwcontrol V2931 (freeze (shen.t* (cons P (cons : (cons boolean ()))) V2930 V2931 (freeze (cut Throwcontrol V2931 (freeze (shen.t*-action Action V2929 (cons (cons P (cons : (cons verified ()))) V2930) V2931 V2932)))))))) false))) false))) false)) false)) false)) (if (= Case false) (let Case (let V2369 (shen.lazyderef V2928 V2931) (if (cons? V2369) (let V2370 (shen.lazyderef (hd V2369) V2931) (if (= shen.choicepoint! V2370) (let V2371 (shen.lazyderef (tl V2369) V2931) (if (cons? V2371) (let V2372 (shen.lazyderef (hd V2371) V2931) (if (cons? V2372) (let V2373 (shen.lazyderef (hd V2372) V2931) (if (cons? V2373) (let V2374 (shen.lazyderef (hd V2373) V2931) (if (= fail-if V2374) (let V2375 (shen.lazyderef (tl V2373) V2931) (if (cons? V2375) (let F (hd V2375) (let V2376 (shen.lazyderef (tl V2375) V2931) (if (= () V2376) (let V2377 (shen.lazyderef (tl V2372) V2931) (if (cons? V2377) (let Action (hd V2377) (let V2378 (shen.lazyderef (tl V2377) V2931) (if (= () V2378) (let V2379 (shen.lazyderef (tl V2371) V2931) (if (= () V2379) (do (shen.incinfs) (cut Throwcontrol V2931 (freeze (shen.t*-action (cons where (cons (cons not (cons (cons F (cons Action ())) ())) (cons Action ()))) V2929 V2930 V2931 V2932)))) false)) false))) false)) false))) false)) false)) false)) false)) false)) false)) false)) (if (= Case false) (let Case (let V2380 (shen.lazyderef V2928 V2931) (if (cons? V2380) (let V2381 (shen.lazyderef (hd V2380) V2931) (if (= shen.choicepoint! V2381) (let V2382 (shen.lazyderef (tl V2380) V2931) (if (cons? V2382) (let Action (hd V2382) (let V2383 (shen.lazyderef (tl V2382) V2931) (if (= () V2383) (do (shen.incinfs) (cut Throwcontrol V2931 (freeze (shen.t*-action (cons where (cons (cons not (cons (cons (cons = (cons Action ())) (cons (cons fail ()) ())) ())) (cons Action ()))) V2929 V2930 V2931 V2932)))) false))) false)) false)) false)) (if (= Case false) (do (shen.incinfs) (shen.t* (cons V2928 (cons : (cons V2929 ()))) V2930 V2931 V2932)) Case)) Case)) Case))))) -(defun findall (V4099 V4100 V4101 V4102 V4103) (let B (shen.newpv V4102) (let A (shen.newpv V4102) (do (shen.incinfs) (bind A (gensym shen.a) V4102 (freeze (bind B (set (shen.lazyderef A V4102) ()) V4102 (freeze (shen.findallhelp V4099 V4100 V4101 A V4102 V4103))))))))) +(defun findall (V2938 V2939 V2940 V2941 V2942) (let B (shen.newpv V2941) (let A (shen.newpv V2941) (do (shen.incinfs) (bind A (gensym shen.a) V2941 (freeze (bind B (set (shen.lazyderef A V2941) ()) V2941 (freeze (shen.findallhelp V2938 V2939 V2940 A V2941 V2942))))))))) -(defun shen.findallhelp (V4110 V4111 V4112 V4113 V4114 V4115) (let Case (do (shen.incinfs) (call V4111 V4114 (freeze (shen.remember V4113 V4110 V4114 (freeze (fwhen false V4114 V4115)))))) (if (= Case false) (do (shen.incinfs) (bind V4112 (value (shen.lazyderef V4113 V4114)) V4114 V4115)) Case))) +(defun shen.findallhelp (V2949 V2950 V2951 V2952 V2953 V2954) (let Case (do (shen.incinfs) (call V2950 V2953 (freeze (shen.remember V2952 V2949 V2953 (freeze (fwhen false V2953 V2954)))))) (if (= Case false) (do (shen.incinfs) (bind V2951 (value (shen.lazyderef V2952 V2953)) V2953 V2954)) Case))) -(defun shen.remember (V4120 V4121 V4122 V4123) (let B (shen.newpv V4122) (do (shen.incinfs) (bind B (set (shen.deref V4120 V4122) (cons (shen.deref V4121 V4122) (value (shen.deref V4120 V4122)))) V4122 V4123)))) +(defun shen.remember (V2959 V2960 V2961 V2962) (let B (shen.newpv V2961) (do (shen.incinfs) (bind B (set (shen.deref V2959 V2961) (cons (shen.deref V2960 V2961) (value (shen.deref V2959 V2961)))) V2961 V2962)))) diff --git a/kl/toplevel.kl b/kl/toplevel.kl index 1f6d44e..f12fd64 100644 --- a/kl/toplevel.kl +++ b/kl/toplevel.kl @@ -32,7 +32,7 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. (defun shen.loop () (do (shen.initialise_environment) (do (shen.prompt) (do (trap-error (shen.read-evaluate-print) (lambda E (shen.toplevel-display-exception E))) (shen.loop))))) -(defun shen.toplevel-display-exception (V4125) (pr (error-to-string V4125) (stoutput))) +(defun shen.toplevel-display-exception (V2964) (pr (error-to-string V2964) (stoutput))) (defun shen.credits () (do (shen.prhush " Shen, copyright (C) 2010-2015 Mark Tarver @@ -43,25 +43,25 @@ port " (shen.app (value *port*) (cn " ported by " (shen.app (value *porters*) " (defun shen.initialise_environment () (shen.multiple-set (cons shen.*call* (cons 0 (cons shen.*infs* (cons 0 (cons shen.*process-counter* (cons 0 (cons shen.*catch* (cons 0 ())))))))))) -(defun shen.multiple-set (V4127) (cond ((= () V4127) ()) ((and (cons? V4127) (cons? (tl V4127))) (do (set (hd V4127) (hd (tl V4127))) (shen.multiple-set (tl (tl V4127))))) (true (shen.f_error shen.multiple-set)))) +(defun shen.multiple-set (V2966) (cond ((= () V2966) ()) ((and (cons? V2966) (cons? (tl V2966))) (do (set (hd V2966) (hd (tl V2966))) (shen.multiple-set (tl (tl V2966))))) (true (shen.f_error shen.multiple-set)))) -(defun destroy (V4129) (declare V4129 symbol)) +(defun destroy (V2968) (declare V2968 symbol)) (defun shen.read-evaluate-print () (let Lineread (shen.toplineread) (let History (value shen.*history*) (let NewLineread (shen.retrieve-from-history-if-needed Lineread History) (let NewHistory (shen.update_history NewLineread History) (let Parsed (fst NewLineread) (shen.toplevel Parsed))))))) -(defun shen.retrieve-from-history-if-needed (V4141 V4142) (cond ((and (tuple? V4141) (and (cons? (snd V4141)) (element? (hd (snd V4141)) (cons (shen.space) (cons (shen.newline) ()))))) (shen.retrieve-from-history-if-needed (@p (fst V4141) (tl (snd V4141))) V4142)) ((and (tuple? V4141) (and (cons? (snd V4141)) (and (cons? (tl (snd V4141))) (and (= () (tl (tl (snd V4141)))) (and (cons? V4142) (and (= (hd (snd V4141)) (shen.exclamation)) (= (hd (tl (snd V4141))) (shen.exclamation)))))))) (let PastPrint (shen.prbytes (snd (hd V4142))) (hd V4142))) ((and (tuple? V4141) (and (cons? (snd V4141)) (= (hd (snd V4141)) (shen.exclamation)))) (let Key? (shen.make-key (tl (snd V4141)) V4142) (let Find (head (shen.find-past-inputs Key? V4142)) (let PastPrint (shen.prbytes (snd Find)) Find)))) ((and (tuple? V4141) (and (cons? (snd V4141)) (and (= () (tl (snd V4141))) (= (hd (snd V4141)) (shen.percent))))) (do (shen.print-past-inputs (lambda X true) (reverse V4142) 0) (abort))) ((and (tuple? V4141) (and (cons? (snd V4141)) (= (hd (snd V4141)) (shen.percent)))) (let Key? (shen.make-key (tl (snd V4141)) V4142) (let Pastprint (shen.print-past-inputs Key? (reverse V4142) 0) (abort)))) (true V4141))) +(defun shen.retrieve-from-history-if-needed (V2980 V2981) (cond ((and (tuple? V2980) (and (cons? (snd V2980)) (element? (hd (snd V2980)) (cons (shen.space) (cons (shen.newline) ()))))) (shen.retrieve-from-history-if-needed (@p (fst V2980) (tl (snd V2980))) V2981)) ((and (tuple? V2980) (and (cons? (snd V2980)) (and (cons? (tl (snd V2980))) (and (= () (tl (tl (snd V2980)))) (and (cons? V2981) (and (= (hd (snd V2980)) (shen.exclamation)) (= (hd (tl (snd V2980))) (shen.exclamation)))))))) (let PastPrint (shen.prbytes (snd (hd V2981))) (hd V2981))) ((and (tuple? V2980) (and (cons? (snd V2980)) (= (hd (snd V2980)) (shen.exclamation)))) (let Key? (shen.make-key (tl (snd V2980)) V2981) (let Find (head (shen.find-past-inputs Key? V2981)) (let PastPrint (shen.prbytes (snd Find)) Find)))) ((and (tuple? V2980) (and (cons? (snd V2980)) (and (= () (tl (snd V2980))) (= (hd (snd V2980)) (shen.percent))))) (do (shen.print-past-inputs (lambda X true) (reverse V2981) 0) (abort))) ((and (tuple? V2980) (and (cons? (snd V2980)) (= (hd (snd V2980)) (shen.percent)))) (let Key? (shen.make-key (tl (snd V2980)) V2981) (let Pastprint (shen.print-past-inputs Key? (reverse V2981) 0) (abort)))) (true V2980))) (defun shen.percent () 37) (defun shen.exclamation () 33) -(defun shen.prbytes (V4144) (do (shen.for-each (lambda Byte (pr (n->string Byte) (stoutput))) V4144) (nl 1))) +(defun shen.prbytes (V2983) (do (shen.for-each (lambda Byte (pr (n->string Byte) (stoutput))) V2983) (nl 1))) -(defun shen.update_history (V4147 V4148) (set shen.*history* (cons V4147 V4148))) +(defun shen.update_history (V2986 V2987) (set shen.*history* (cons V2986 V2987))) (defun shen.toplineread () (shen.toplineread_loop (shen.read-char-code (stinput)) ())) -(defun shen.toplineread_loop (V4152 V4153) (cond ((= V4152 (shen.hat)) (simple-error "line read aborted")) ((element? V4152 (cons (shen.newline) (cons (shen.carriage-return) ()))) (let Line (compile (lambda X (shen. X)) V4153 (lambda E shen.nextline)) (let It (shen.record-it V4153) (if (or (= Line shen.nextline) (empty? Line)) (shen.toplineread_loop (shen.read-char-code (stinput)) (append V4153 (cons V4152 ()))) (@p Line V4153))))) (true (shen.toplineread_loop (shen.read-char-code (stinput)) (if (= V4152 -1) V4153 (append V4153 (cons V4152 ()))))))) +(defun shen.toplineread_loop (V2991 V2992) (cond ((= V2991 (shen.hat)) (simple-error "line read aborted")) ((element? V2991 (cons (shen.newline) (cons (shen.carriage-return) ()))) (let Line (compile (lambda X (shen. X)) V2992 (lambda E shen.nextline)) (let It (shen.record-it V2992) (if (or (= Line shen.nextline) (empty? Line)) (shen.toplineread_loop (shen.read-char-code (stinput)) (append V2992 (cons V2991 ()))) (@p Line V2992))))) (true (shen.toplineread_loop (shen.read-char-code (stinput)) (if (= V2991 -1) V2992 (append V2992 (cons V2991 ()))))))) (defun shen.hat () 94) @@ -69,7 +69,7 @@ port " (shen.app (value *port*) (cn " ported by " (shen.app (value *porters*) " (defun shen.carriage-return () 13) -(defun tc (V4159) (cond ((= + V4159) (set shen.*tc* true)) ((= - V4159) (set shen.*tc* false)) (true (simple-error "tc expects a + or -")))) +(defun tc (V2998) (cond ((= + V2998) (set shen.*tc* true)) ((= - V2998) (set shen.*tc* false)) (true (simple-error "tc expects a + or -")))) (defun shen.prompt () (if (value shen.*tc*) (shen.prhush (cn " @@ -77,16 +77,16 @@ port " (shen.app (value *port*) (cn " ported by " (shen.app (value *porters*) " (" (shen.app (length (value shen.*history*)) "-) " shen.a)) (stoutput)))) -(defun shen.toplevel (V4161) (shen.toplevel_evaluate V4161 (value shen.*tc*))) +(defun shen.toplevel (V3000) (shen.toplevel_evaluate V3000 (value shen.*tc*))) -(defun shen.find-past-inputs (V4164 V4165) (let F (shen.find V4164 V4165) (if (empty? F) (simple-error "input not found +(defun shen.find-past-inputs (V3003 V3004) (let F (shen.find V3003 V3004) (if (empty? F) (simple-error "input not found ") F))) -(defun shen.make-key (V4168 V4169) (let Atom (hd (compile (lambda X (shen. X)) V4168 (lambda E (if (cons? E) (simple-error (cn "parse error here: " (shen.app E " +(defun shen.make-key (V3007 V3008) (let Atom (hd (compile (lambda X (shen. X)) V3007 (lambda E (if (cons? E) (simple-error (cn "parse error here: " (shen.app E " " shen.s))) (simple-error "parse error -"))))) (if (integer? Atom) (lambda X (= X (nth (+ Atom 1) (reverse V4169)))) (lambda X (shen.prefix? V4168 (shen.trim-gubbins (snd X))))))) +"))))) (if (integer? Atom) (lambda X (= X (nth (+ Atom 1) (reverse V3008)))) (lambda X (shen.prefix? V3007 (shen.trim-gubbins (snd X))))))) -(defun shen.trim-gubbins (V4171) (cond ((and (cons? V4171) (= (hd V4171) (shen.space))) (shen.trim-gubbins (tl V4171))) ((and (cons? V4171) (= (hd V4171) (shen.newline))) (shen.trim-gubbins (tl V4171))) ((and (cons? V4171) (= (hd V4171) (shen.carriage-return))) (shen.trim-gubbins (tl V4171))) ((and (cons? V4171) (= (hd V4171) (shen.tab))) (shen.trim-gubbins (tl V4171))) ((and (cons? V4171) (= (hd V4171) (shen.left-round))) (shen.trim-gubbins (tl V4171))) (true V4171))) +(defun shen.trim-gubbins (V3010) (cond ((and (cons? V3010) (= (hd V3010) (shen.space))) (shen.trim-gubbins (tl V3010))) ((and (cons? V3010) (= (hd V3010) (shen.newline))) (shen.trim-gubbins (tl V3010))) ((and (cons? V3010) (= (hd V3010) (shen.carriage-return))) (shen.trim-gubbins (tl V3010))) ((and (cons? V3010) (= (hd V3010) (shen.tab))) (shen.trim-gubbins (tl V3010))) ((and (cons? V3010) (= (hd V3010) (shen.left-round))) (shen.trim-gubbins (tl V3010))) (true V3010))) (defun shen.space () 32) @@ -94,22 +94,22 @@ port " (shen.app (value *port*) (cn " ported by " (shen.app (value *porters*) " (defun shen.left-round () 40) -(defun shen.find (V4180 V4181) (cond ((= () V4181) ()) ((and (cons? V4181) (V4180 (hd V4181))) (cons (hd V4181) (shen.find V4180 (tl V4181)))) ((cons? V4181) (shen.find V4180 (tl V4181))) (true (shen.f_error shen.find)))) +(defun shen.find (V3019 V3020) (cond ((= () V3020) ()) ((and (cons? V3020) (V3019 (hd V3020))) (cons (hd V3020) (shen.find V3019 (tl V3020)))) ((cons? V3020) (shen.find V3019 (tl V3020))) (true (shen.f_error shen.find)))) -(defun shen.prefix? (V4195 V4196) (cond ((= () V4195) true) ((and (cons? V4195) (and (cons? V4196) (= (hd V4196) (hd V4195)))) (shen.prefix? (tl V4195) (tl V4196))) (true false))) +(defun shen.prefix? (V3034 V3035) (cond ((= () V3034) true) ((and (cons? V3034) (and (cons? V3035) (= (hd V3035) (hd V3034)))) (shen.prefix? (tl V3034) (tl V3035))) (true false))) -(defun shen.print-past-inputs (V4208 V4209 V4210) (cond ((= () V4209) _) ((and (cons? V4209) (not (V4208 (hd V4209)))) (shen.print-past-inputs V4208 (tl V4209) (+ V4210 1))) ((and (cons? V4209) (tuple? (hd V4209))) (do (shen.prhush (shen.app V4210 ". " shen.a) (stoutput)) (do (shen.prbytes (snd (hd V4209))) (shen.print-past-inputs V4208 (tl V4209) (+ V4210 1))))) (true (shen.f_error shen.print-past-inputs)))) +(defun shen.print-past-inputs (V3047 V3048 V3049) (cond ((= () V3048) _) ((and (cons? V3048) (not (V3047 (hd V3048)))) (shen.print-past-inputs V3047 (tl V3048) (+ V3049 1))) ((and (cons? V3048) (tuple? (hd V3048))) (do (shen.prhush (shen.app V3049 ". " shen.a) (stoutput)) (do (shen.prbytes (snd (hd V3048))) (shen.print-past-inputs V3047 (tl V3048) (+ V3049 1))))) (true (shen.f_error shen.print-past-inputs)))) -(defun shen.toplevel_evaluate (V4213 V4214) (cond ((and (cons? V4213) (and (cons? (tl V4213)) (and (= : (hd (tl V4213))) (and (cons? (tl (tl V4213))) (and (= () (tl (tl (tl V4213)))) (= true V4214)))))) (shen.typecheck-and-evaluate (hd V4213) (hd (tl (tl V4213))))) ((and (cons? V4213) (cons? (tl V4213))) (do (shen.toplevel_evaluate (cons (hd V4213) ()) V4214) (do (nl 1) (shen.toplevel_evaluate (tl V4213) V4214)))) ((and (cons? V4213) (and (= () (tl V4213)) (= true V4214))) (shen.typecheck-and-evaluate (hd V4213) (gensym A))) ((and (cons? V4213) (and (= () (tl V4213)) (= false V4214))) (let Eval (shen.eval-without-macros (hd V4213)) (print Eval))) (true (shen.f_error shen.toplevel_evaluate)))) +(defun shen.toplevel_evaluate (V3052 V3053) (cond ((and (cons? V3052) (and (cons? (tl V3052)) (and (= : (hd (tl V3052))) (and (cons? (tl (tl V3052))) (and (= () (tl (tl (tl V3052)))) (= true V3053)))))) (shen.typecheck-and-evaluate (hd V3052) (hd (tl (tl V3052))))) ((and (cons? V3052) (cons? (tl V3052))) (do (shen.toplevel_evaluate (cons (hd V3052) ()) V3053) (do (nl 1) (shen.toplevel_evaluate (tl V3052) V3053)))) ((and (cons? V3052) (and (= () (tl V3052)) (= true V3053))) (shen.typecheck-and-evaluate (hd V3052) (gensym A))) ((and (cons? V3052) (and (= () (tl V3052)) (= false V3053))) (let Eval (shen.eval-without-macros (hd V3052)) (print Eval))) (true (shen.f_error shen.toplevel_evaluate)))) -(defun shen.typecheck-and-evaluate (V4217 V4218) (let Typecheck (shen.typecheck V4217 V4218) (if (= Typecheck false) (simple-error "type error -") (let Eval (shen.eval-without-macros V4217) (let Type (shen.pretty-type Typecheck) (shen.prhush (shen.app Eval (cn " : " (shen.app Type "" shen.r)) shen.s) (stoutput))))))) +(defun shen.typecheck-and-evaluate (V3056 V3057) (let Typecheck (shen.typecheck V3056 V3057) (if (= Typecheck false) (simple-error "type error +") (let Eval (shen.eval-without-macros V3056) (let Type (shen.pretty-type Typecheck) (shen.prhush (shen.app Eval (cn " : " (shen.app Type "" shen.r)) shen.s) (stoutput))))))) -(defun shen.pretty-type (V4220) (shen.mult_subst (value shen.*alphabet*) (shen.extract-pvars V4220) V4220)) +(defun shen.pretty-type (V3059) (shen.mult_subst (value shen.*alphabet*) (shen.extract-pvars V3059) V3059)) -(defun shen.extract-pvars (V4226) (cond ((shen.pvar? V4226) (cons V4226 ())) ((cons? V4226) (union (shen.extract-pvars (hd V4226)) (shen.extract-pvars (tl V4226)))) (true ()))) +(defun shen.extract-pvars (V3065) (cond ((shen.pvar? V3065) (cons V3065 ())) ((cons? V3065) (union (shen.extract-pvars (hd V3065)) (shen.extract-pvars (tl V3065)))) (true ()))) -(defun shen.mult_subst (V4234 V4235 V4236) (cond ((= () V4234) V4236) ((= () V4235) V4236) ((and (cons? V4234) (cons? V4235)) (shen.mult_subst (tl V4234) (tl V4235) (subst (hd V4234) (hd V4235) V4236))) (true (shen.f_error shen.mult_subst)))) +(defun shen.mult_subst (V3073 V3074 V3075) (cond ((= () V3073) V3075) ((= () V3074) V3075) ((and (cons? V3073) (cons? V3074)) (shen.mult_subst (tl V3073) (tl V3074) (subst (hd V3073) (hd V3074) V3075))) (true (shen.f_error shen.mult_subst)))) diff --git a/kl/track.kl b/kl/track.kl index 5f964b1..a08a88b 100644 --- a/kl/track.kl +++ b/kl/track.kl @@ -28,55 +28,55 @@ OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. " -(defun shen.f_error (V4238) (do (shen.prhush (cn "partial function " (shen.app V4238 "; -" shen.a)) (stoutput)) (do (if (and (not (shen.tracked? V4238)) (y-or-n? (cn "track " (shen.app V4238 "? " shen.a)))) (shen.track-function (ps V4238)) shen.ok) (simple-error "aborted")))) +(defun shen.f_error (V3077) (do (shen.prhush (cn "partial function " (shen.app V3077 "; +" shen.a)) (stoutput)) (do (if (and (not (shen.tracked? V3077)) (y-or-n? (cn "track " (shen.app V3077 "? " shen.a)))) (shen.track-function (ps V3077)) shen.ok) (simple-error "aborted")))) -(defun shen.tracked? (V4240) (element? V4240 (value shen.*tracking*))) +(defun shen.tracked? (V3079) (element? V3079 (value shen.*tracking*))) -(defun track (V4242) (let Source (ps V4242) (shen.track-function Source))) +(defun track (V3081) (let Source (ps V3081) (shen.track-function Source))) -(defun shen.track-function (V4244) (cond ((and (cons? V4244) (and (= defun (hd V4244)) (and (cons? (tl V4244)) (and (cons? (tl (tl V4244))) (and (cons? (tl (tl (tl V4244)))) (= () (tl (tl (tl (tl V4244)))))))))) (let KL (cons defun (cons (hd (tl V4244)) (cons (hd (tl (tl V4244))) (cons (shen.insert-tracking-code (hd (tl V4244)) (hd (tl (tl V4244))) (hd (tl (tl (tl V4244))))) ())))) (let Ob (eval-kl KL) (let Tr (set shen.*tracking* (cons Ob (value shen.*tracking*))) Ob)))) (true (shen.f_error shen.track-function)))) +(defun shen.track-function (V3083) (cond ((and (cons? V3083) (and (= defun (hd V3083)) (and (cons? (tl V3083)) (and (cons? (tl (tl V3083))) (and (cons? (tl (tl (tl V3083)))) (= () (tl (tl (tl (tl V3083)))))))))) (let KL (cons defun (cons (hd (tl V3083)) (cons (hd (tl (tl V3083))) (cons (shen.insert-tracking-code (hd (tl V3083)) (hd (tl (tl V3083))) (hd (tl (tl (tl V3083))))) ())))) (let Ob (eval-kl KL) (let Tr (set shen.*tracking* (cons Ob (value shen.*tracking*))) Ob)))) (true (shen.f_error shen.track-function)))) -(defun shen.insert-tracking-code (V4248 V4249 V4250) (cons do (cons (cons set (cons shen.*call* (cons (cons + (cons (cons value (cons shen.*call* ())) (cons 1 ()))) ()))) (cons (cons do (cons (cons shen.input-track (cons (cons value (cons shen.*call* ())) (cons V4248 (cons (shen.cons_form V4249) ())))) (cons (cons do (cons (cons shen.terpri-or-read-char ()) (cons (cons let (cons Result (cons V4250 (cons (cons do (cons (cons shen.output-track (cons (cons value (cons shen.*call* ())) (cons V4248 (cons Result ())))) (cons (cons do (cons (cons set (cons shen.*call* (cons (cons - (cons (cons value (cons shen.*call* ())) (cons 1 ()))) ()))) (cons (cons do (cons (cons shen.terpri-or-read-char ()) (cons Result ()))) ()))) ()))) ())))) ()))) ()))) ())))) +(defun shen.insert-tracking-code (V3087 V3088 V3089) (cons do (cons (cons set (cons shen.*call* (cons (cons + (cons (cons value (cons shen.*call* ())) (cons 1 ()))) ()))) (cons (cons do (cons (cons shen.input-track (cons (cons value (cons shen.*call* ())) (cons V3087 (cons (shen.cons_form V3088) ())))) (cons (cons do (cons (cons shen.terpri-or-read-char ()) (cons (cons let (cons Result (cons V3089 (cons (cons do (cons (cons shen.output-track (cons (cons value (cons shen.*call* ())) (cons V3087 (cons Result ())))) (cons (cons do (cons (cons set (cons shen.*call* (cons (cons - (cons (cons value (cons shen.*call* ())) (cons 1 ()))) ()))) (cons (cons do (cons (cons shen.terpri-or-read-char ()) (cons Result ()))) ()))) ()))) ())))) ()))) ()))) ())))) -(defun step (V4256) (cond ((= + V4256) (set shen.*step* true)) ((= - V4256) (set shen.*step* false)) (true (simple-error "step expects a + or a -. +(defun step (V3095) (cond ((= + V3095) (set shen.*step* true)) ((= - V3095) (set shen.*step* false)) (true (simple-error "step expects a + or a -. ")))) -(defun spy (V4262) (cond ((= + V4262) (set shen.*spy* true)) ((= - V4262) (set shen.*spy* false)) (true (simple-error "spy expects a + or a -. +(defun spy (V3101) (cond ((= + V3101) (set shen.*spy* true)) ((= - V3101) (set shen.*spy* false)) (true (simple-error "spy expects a + or a -. ")))) (defun shen.terpri-or-read-char () (if (value shen.*step*) (shen.check-byte (read-byte (value *stinput*))) (nl 1))) -(defun shen.check-byte (V4268) (cond ((= V4268 (shen.hat)) (simple-error "aborted")) (true true))) +(defun shen.check-byte (V3107) (cond ((= V3107 (shen.hat)) (simple-error "aborted")) (true true))) -(defun shen.input-track (V4272 V4273 V4274) (do (shen.prhush (cn " -" (shen.app (shen.spaces V4272) (cn "<" (shen.app V4272 (cn "> Inputs to " (shen.app V4273 (cn " -" (shen.app (shen.spaces V4272) "" shen.a)) shen.a)) shen.a)) shen.a)) (stoutput)) (shen.recursively-print V4274))) +(defun shen.input-track (V3111 V3112 V3113) (do (shen.prhush (cn " +" (shen.app (shen.spaces V3111) (cn "<" (shen.app V3111 (cn "> Inputs to " (shen.app V3112 (cn " +" (shen.app (shen.spaces V3111) "" shen.a)) shen.a)) shen.a)) shen.a)) (stoutput)) (shen.recursively-print V3113))) -(defun shen.recursively-print (V4276) (cond ((= () V4276) (shen.prhush " ==>" (stoutput))) ((cons? V4276) (do (print (hd V4276)) (do (shen.prhush ", " (stoutput)) (shen.recursively-print (tl V4276))))) (true (shen.f_error shen.recursively-print)))) +(defun shen.recursively-print (V3115) (cond ((= () V3115) (shen.prhush " ==>" (stoutput))) ((cons? V3115) (do (print (hd V3115)) (do (shen.prhush ", " (stoutput)) (shen.recursively-print (tl V3115))))) (true (shen.f_error shen.recursively-print)))) -(defun shen.spaces (V4278) (cond ((= 0 V4278) "") (true (cn " " (shen.spaces (- V4278 1)))))) +(defun shen.spaces (V3117) (cond ((= 0 V3117) "") (true (cn " " (shen.spaces (- V3117 1)))))) -(defun shen.output-track (V4282 V4283 V4284) (shen.prhush (cn " -" (shen.app (shen.spaces V4282) (cn "<" (shen.app V4282 (cn "> Output from " (shen.app V4283 (cn " -" (shen.app (shen.spaces V4282) (cn "==> " (shen.app V4284 "" shen.s)) shen.a)) shen.a)) shen.a)) shen.a)) (stoutput))) +(defun shen.output-track (V3121 V3122 V3123) (shen.prhush (cn " +" (shen.app (shen.spaces V3121) (cn "<" (shen.app V3121 (cn "> Output from " (shen.app V3122 (cn " +" (shen.app (shen.spaces V3121) (cn "==> " (shen.app V3123 "" shen.s)) shen.a)) shen.a)) shen.a)) shen.a)) (stoutput))) -(defun untrack (V4286) (let Tracking (value shen.*tracking*) (let Tracking (set shen.*tracking* (remove V4286 Tracking)) (eval (ps V4286))))) +(defun untrack (V3125) (let Tracking (value shen.*tracking*) (let Tracking (set shen.*tracking* (remove V3125 Tracking)) (eval (ps V3125))))) -(defun profile (V4288) (shen.profile-help (ps V4288))) +(defun profile (V3127) (shen.profile-help (ps V3127))) -(defun shen.profile-help (V4294) (cond ((and (cons? V4294) (and (= defun (hd V4294)) (and (cons? (tl V4294)) (and (cons? (tl (tl V4294))) (and (cons? (tl (tl (tl V4294)))) (= () (tl (tl (tl (tl V4294)))))))))) (let G (gensym shen.f) (let Profile (cons defun (cons (hd (tl V4294)) (cons (hd (tl (tl V4294))) (cons (shen.profile-func (hd (tl V4294)) (hd (tl (tl V4294))) (cons G (hd (tl (tl V4294))))) ())))) (let Def (cons defun (cons G (cons (hd (tl (tl V4294))) (cons (subst G (hd (tl V4294)) (hd (tl (tl (tl V4294))))) ())))) (let CompileProfile (shen.eval-without-macros Profile) (let CompileG (shen.eval-without-macros Def) (hd (tl V4294)))))))) (true (simple-error "Cannot profile. +(defun shen.profile-help (V3133) (cond ((and (cons? V3133) (and (= defun (hd V3133)) (and (cons? (tl V3133)) (and (cons? (tl (tl V3133))) (and (cons? (tl (tl (tl V3133)))) (= () (tl (tl (tl (tl V3133)))))))))) (let G (gensym shen.f) (let Profile (cons defun (cons (hd (tl V3133)) (cons (hd (tl (tl V3133))) (cons (shen.profile-func (hd (tl V3133)) (hd (tl (tl V3133))) (cons G (hd (tl (tl V3133))))) ())))) (let Def (cons defun (cons G (cons (hd (tl (tl V3133))) (cons (subst G (hd (tl V3133)) (hd (tl (tl (tl V3133))))) ())))) (let CompileProfile (shen.eval-without-macros Profile) (let CompileG (shen.eval-without-macros Def) (hd (tl V3133)))))))) (true (simple-error "Cannot profile. ")))) -(defun unprofile (V4296) (untrack V4296)) +(defun unprofile (V3135) (untrack V3135)) -(defun shen.profile-func (V4300 V4301 V4302) (cons let (cons Start (cons (cons get-time (cons run ())) (cons (cons let (cons Result (cons V4302 (cons (cons let (cons Finish (cons (cons - (cons (cons get-time (cons run ())) (cons Start ()))) (cons (cons let (cons Record (cons (cons shen.put-profile (cons V4300 (cons (cons + (cons (cons shen.get-profile (cons V4300 ())) (cons Finish ()))) ()))) (cons Result ())))) ())))) ())))) ()))))) +(defun shen.profile-func (V3139 V3140 V3141) (cons let (cons Start (cons (cons get-time (cons run ())) (cons (cons let (cons Result (cons V3141 (cons (cons let (cons Finish (cons (cons - (cons (cons get-time (cons run ())) (cons Start ()))) (cons (cons let (cons Record (cons (cons shen.put-profile (cons V3139 (cons (cons + (cons (cons shen.get-profile (cons V3139 ())) (cons Finish ()))) ()))) (cons Result ())))) ())))) ())))) ()))))) -(defun profile-results (V4304) (let Results (shen.get-profile V4304) (let Initialise (shen.put-profile V4304 0) (@p V4304 Results)))) +(defun profile-results (V3143) (let Results (shen.get-profile V3143) (let Initialise (shen.put-profile V3143 0) (@p V3143 Results)))) -(defun shen.get-profile (V4306) (trap-error (get V4306 profile (value *property-vector*)) (lambda E 0))) +(defun shen.get-profile (V3145) (trap-error (get V3145 profile (value *property-vector*)) (lambda E 0))) -(defun shen.put-profile (V4309 V4310) (put V4309 profile V4310 (value *property-vector*))) +(defun shen.put-profile (V3148 V3149) (put V3148 profile V3149 (value *property-vector*))) diff --git a/kl/types.kl b/kl/types.kl index a11ad6c..5af50b7 100644 --- a/kl/types.kl +++ b/kl/types.kl @@ -28,286 +28,286 @@ OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. " -(defun declare (V4313 V4314) (let Record (set shen.*signedfuncs* (cons (cons V4313 V4314) (value shen.*signedfuncs*))) (let Variancy (trap-error (shen.variancy-test V4313 V4314) (lambda E shen.skip)) (let Type (shen.rcons_form (shen.demodulate V4314)) (let F* (concat shen.type-signature-of- V4313) (let Parameters (shen.parameters 1) (let Clause (cons (cons F* (cons X ())) (cons :- (cons (cons (cons unify! (cons X (cons Type ()))) ()) ()))) (let AUM_instruction (shen.aum Clause Parameters) (let Code (shen.aum_to_shen AUM_instruction) (let ShenDef (cons define (cons F* (append Parameters (append (cons ProcessN (cons Continuation ())) (cons -> (cons Code ())))))) (let Eval (shen.eval-without-macros ShenDef) V4313))))))))))) +(defun declare (V3152 V3153) (let Record (set shen.*signedfuncs* (cons (cons V3152 V3153) (value shen.*signedfuncs*))) (let Variancy (trap-error (shen.variancy-test V3152 V3153) (lambda E shen.skip)) (let Type (shen.rcons_form (shen.demodulate V3153)) (let F* (concat shen.type-signature-of- V3152) (let Parameters (shen.parameters 1) (let Clause (cons (cons F* (cons X ())) (cons :- (cons (cons (cons unify! (cons X (cons Type ()))) ()) ()))) (let AUM_instruction (shen.aum Clause Parameters) (let Code (shen.aum_to_shen AUM_instruction) (let ShenDef (cons define (cons F* (append Parameters (append (cons ProcessN (cons Continuation ())) (cons -> (cons Code ())))))) (let Eval (shen.eval-without-macros ShenDef) V3152))))))))))) -(defun shen.demodulate (V4316) (let Demod (shen.walk (value shen.*demodulation-function*) V4316) (if (= Demod V4316) V4316 (shen.demodulate Demod)))) +(defun shen.demodulate (V3155) (let Demod (shen.walk (value shen.*demodulation-function*) V3155) (if (= Demod V3155) V3155 (shen.demodulate Demod)))) -(defun shen.variancy-test (V4319 V4320) (let TypeF (shen.typecheck V4319 B) (let Check (if (= symbol TypeF) shen.skip (if (shen.variant? TypeF V4320) shen.skip (shen.prhush (cn "warning: changing the type of " (shen.app V4319 " may create errors +(defun shen.variancy-test (V3158 V3159) (let TypeF (shen.typecheck V3158 B) (let Check (if (= symbol TypeF) shen.skip (if (shen.variant? TypeF V3159) shen.skip (shen.prhush (cn "warning: changing the type of " (shen.app V3158 " may create errors " shen.a)) (stoutput)))) shen.skip))) -(defun shen.variant? (V4333 V4334) (cond ((= V4334 V4333) true) ((and (cons? V4333) (and (cons? V4334) (= (hd V4334) (hd V4333)))) (shen.variant? (tl V4333) (tl V4334))) ((and (cons? V4333) (and (cons? V4334) (and (shen.pvar? (hd V4333)) (variable? (hd V4334))))) (shen.variant? (subst shen.a (hd V4333) (tl V4333)) (subst shen.a (hd V4334) (tl V4334)))) ((and (cons? V4333) (and (cons? (hd V4333)) (and (cons? V4334) (cons? (hd V4334))))) (shen.variant? (append (hd V4333) (tl V4333)) (append (hd V4334) (tl V4334)))) (true false))) +(defun shen.variant? (V3172 V3173) (cond ((= V3173 V3172) true) ((and (cons? V3172) (and (cons? V3173) (= (hd V3173) (hd V3172)))) (shen.variant? (tl V3172) (tl V3173))) ((and (cons? V3172) (and (cons? V3173) (and (shen.pvar? (hd V3172)) (variable? (hd V3173))))) (shen.variant? (subst shen.a (hd V3172) (tl V3172)) (subst shen.a (hd V3173) (tl V3173)))) ((and (cons? V3172) (and (cons? (hd V3172)) (and (cons? V3173) (cons? (hd V3173))))) (shen.variant? (append (hd V3172) (tl V3172)) (append (hd V3173) (tl V3173)))) (true false))) -(defun shen.type-signature-of-absvector? (V4339 V4340 V4341) (let A (shen.newpv V4340) (do (shen.incinfs) (unify! V4339 (cons A (cons --> (cons boolean ()))) V4340 V4341)))) +(defun shen.type-signature-of-absvector? (V3178 V3179 V3180) (let A (shen.newpv V3179) (do (shen.incinfs) (unify! V3178 (cons A (cons --> (cons boolean ()))) V3179 V3180)))) -(defun shen.type-signature-of-adjoin (V4349 V4350 V4351) (let A (shen.newpv V4350) (do (shen.incinfs) (unify! V4349 (cons A (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) V4350 V4351)))) +(defun shen.type-signature-of-adjoin (V3188 V3189 V3190) (let A (shen.newpv V3189) (do (shen.incinfs) (unify! V3188 (cons A (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) V3189 V3190)))) -(defun shen.type-signature-of-and (V4359 V4360 V4361) (do (shen.incinfs) (unify! V4359 (cons boolean (cons --> (cons (cons boolean (cons --> (cons boolean ()))) ()))) V4360 V4361))) +(defun shen.type-signature-of-and (V3198 V3199 V3200) (do (shen.incinfs) (unify! V3198 (cons boolean (cons --> (cons (cons boolean (cons --> (cons boolean ()))) ()))) V3199 V3200))) -(defun shen.type-signature-of-shen.app (V4369 V4370 V4371) (let A (shen.newpv V4370) (do (shen.incinfs) (unify! V4369 (cons A (cons --> (cons (cons string (cons --> (cons (cons symbol (cons --> (cons string ()))) ()))) ()))) V4370 V4371)))) +(defun shen.type-signature-of-shen.app (V3208 V3209 V3210) (let A (shen.newpv V3209) (do (shen.incinfs) (unify! V3208 (cons A (cons --> (cons (cons string (cons --> (cons (cons symbol (cons --> (cons string ()))) ()))) ()))) V3209 V3210)))) -(defun shen.type-signature-of-append (V4379 V4380 V4381) (let A (shen.newpv V4380) (do (shen.incinfs) (unify! V4379 (cons (cons list (cons A ())) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) V4380 V4381)))) +(defun shen.type-signature-of-append (V3218 V3219 V3220) (let A (shen.newpv V3219) (do (shen.incinfs) (unify! V3218 (cons (cons list (cons A ())) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) V3219 V3220)))) -(defun shen.type-signature-of-arity (V4389 V4390 V4391) (let A (shen.newpv V4390) (do (shen.incinfs) (unify! V4389 (cons A (cons --> (cons number ()))) V4390 V4391)))) +(defun shen.type-signature-of-arity (V3228 V3229 V3230) (let A (shen.newpv V3229) (do (shen.incinfs) (unify! V3228 (cons A (cons --> (cons number ()))) V3229 V3230)))) -(defun shen.type-signature-of-assoc (V4399 V4400 V4401) (let A (shen.newpv V4400) (do (shen.incinfs) (unify! V4399 (cons A (cons --> (cons (cons (cons list (cons (cons list (cons A ())) ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) V4400 V4401)))) +(defun shen.type-signature-of-assoc (V3238 V3239 V3240) (let A (shen.newpv V3239) (do (shen.incinfs) (unify! V3238 (cons A (cons --> (cons (cons (cons list (cons (cons list (cons A ())) ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) V3239 V3240)))) -(defun shen.type-signature-of-boolean? (V4409 V4410 V4411) (let A (shen.newpv V4410) (do (shen.incinfs) (unify! V4409 (cons A (cons --> (cons boolean ()))) V4410 V4411)))) +(defun shen.type-signature-of-boolean? (V3248 V3249 V3250) (let A (shen.newpv V3249) (do (shen.incinfs) (unify! V3248 (cons A (cons --> (cons boolean ()))) V3249 V3250)))) -(defun shen.type-signature-of-bound? (V4419 V4420 V4421) (do (shen.incinfs) (unify! V4419 (cons symbol (cons --> (cons boolean ()))) V4420 V4421))) +(defun shen.type-signature-of-bound? (V3258 V3259 V3260) (do (shen.incinfs) (unify! V3258 (cons symbol (cons --> (cons boolean ()))) V3259 V3260))) -(defun shen.type-signature-of-cd (V4429 V4430 V4431) (do (shen.incinfs) (unify! V4429 (cons string (cons --> (cons string ()))) V4430 V4431))) +(defun shen.type-signature-of-cd (V3268 V3269 V3270) (do (shen.incinfs) (unify! V3268 (cons string (cons --> (cons string ()))) V3269 V3270))) -(defun shen.type-signature-of-close (V4439 V4440 V4441) (let A (shen.newpv V4440) (let B (shen.newpv V4440) (do (shen.incinfs) (unify! V4439 (cons (cons stream (cons A ())) (cons --> (cons (cons list (cons B ())) ()))) V4440 V4441))))) +(defun shen.type-signature-of-close (V3278 V3279 V3280) (let A (shen.newpv V3279) (let B (shen.newpv V3279) (do (shen.incinfs) (unify! V3278 (cons (cons stream (cons A ())) (cons --> (cons (cons list (cons B ())) ()))) V3279 V3280))))) -(defun shen.type-signature-of-cn (V4449 V4450 V4451) (do (shen.incinfs) (unify! V4449 (cons string (cons --> (cons (cons string (cons --> (cons string ()))) ()))) V4450 V4451))) +(defun shen.type-signature-of-cn (V3288 V3289 V3290) (do (shen.incinfs) (unify! V3288 (cons string (cons --> (cons (cons string (cons --> (cons string ()))) ()))) V3289 V3290))) -(defun shen.type-signature-of-compile (V4459 V4460 V4461) (let A (shen.newpv V4460) (let B (shen.newpv V4460) (do (shen.incinfs) (unify! V4459 (cons (cons A (cons shen.==> (cons B ()))) (cons --> (cons (cons A (cons --> (cons (cons (cons A (cons --> (cons B ()))) (cons --> (cons B ()))) ()))) ()))) V4460 V4461))))) +(defun shen.type-signature-of-compile (V3298 V3299 V3300) (let A (shen.newpv V3299) (let B (shen.newpv V3299) (do (shen.incinfs) (unify! V3298 (cons (cons A (cons shen.==> (cons B ()))) (cons --> (cons (cons A (cons --> (cons (cons (cons A (cons --> (cons B ()))) (cons --> (cons B ()))) ()))) ()))) V3299 V3300))))) -(defun shen.type-signature-of-cons? (V4469 V4470 V4471) (let A (shen.newpv V4470) (do (shen.incinfs) (unify! V4469 (cons A (cons --> (cons boolean ()))) V4470 V4471)))) +(defun shen.type-signature-of-cons? (V3308 V3309 V3310) (let A (shen.newpv V3309) (do (shen.incinfs) (unify! V3308 (cons A (cons --> (cons boolean ()))) V3309 V3310)))) -(defun shen.type-signature-of-destroy (V4479 V4480 V4481) (let A (shen.newpv V4480) (let B (shen.newpv V4480) (do (shen.incinfs) (unify! V4479 (cons (cons A (cons --> (cons B ()))) (cons --> (cons symbol ()))) V4480 V4481))))) +(defun shen.type-signature-of-destroy (V3318 V3319 V3320) (let A (shen.newpv V3319) (let B (shen.newpv V3319) (do (shen.incinfs) (unify! V3318 (cons (cons A (cons --> (cons B ()))) (cons --> (cons symbol ()))) V3319 V3320))))) -(defun shen.type-signature-of-difference (V4489 V4490 V4491) (let A (shen.newpv V4490) (do (shen.incinfs) (unify! V4489 (cons (cons list (cons A ())) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) V4490 V4491)))) +(defun shen.type-signature-of-difference (V3328 V3329 V3330) (let A (shen.newpv V3329) (do (shen.incinfs) (unify! V3328 (cons (cons list (cons A ())) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) V3329 V3330)))) -(defun shen.type-signature-of-do (V4499 V4500 V4501) (let A (shen.newpv V4500) (let B (shen.newpv V4500) (do (shen.incinfs) (unify! V4499 (cons A (cons --> (cons (cons B (cons --> (cons B ()))) ()))) V4500 V4501))))) +(defun shen.type-signature-of-do (V3338 V3339 V3340) (let A (shen.newpv V3339) (let B (shen.newpv V3339) (do (shen.incinfs) (unify! V3338 (cons A (cons --> (cons (cons B (cons --> (cons B ()))) ()))) V3339 V3340))))) -(defun shen.type-signature-of- (V4509 V4510 V4511) (let A (shen.newpv V4510) (let B (shen.newpv V4510) (do (shen.incinfs) (unify! V4509 (cons (cons list (cons A ())) (cons shen.==> (cons (cons list (cons B ())) ()))) V4510 V4511))))) +(defun shen.type-signature-of- (V3348 V3349 V3350) (let A (shen.newpv V3349) (let B (shen.newpv V3349) (do (shen.incinfs) (unify! V3348 (cons (cons list (cons A ())) (cons shen.==> (cons (cons list (cons B ())) ()))) V3349 V3350))))) -(defun shen.type-signature-of- (V4519 V4520 V4521) (let A (shen.newpv V4520) (do (shen.incinfs) (unify! V4519 (cons (cons list (cons A ())) (cons shen.==> (cons (cons list (cons A ())) ()))) V4520 V4521)))) +(defun shen.type-signature-of- (V3358 V3359 V3360) (let A (shen.newpv V3359) (do (shen.incinfs) (unify! V3358 (cons (cons list (cons A ())) (cons shen.==> (cons (cons list (cons A ())) ()))) V3359 V3360)))) -(defun shen.type-signature-of-element? (V4529 V4530 V4531) (let A (shen.newpv V4530) (do (shen.incinfs) (unify! V4529 (cons A (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons boolean ()))) ()))) V4530 V4531)))) +(defun shen.type-signature-of-element? (V3368 V3369 V3370) (let A (shen.newpv V3369) (do (shen.incinfs) (unify! V3368 (cons A (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons boolean ()))) ()))) V3369 V3370)))) -(defun shen.type-signature-of-empty? (V4539 V4540 V4541) (let A (shen.newpv V4540) (do (shen.incinfs) (unify! V4539 (cons A (cons --> (cons boolean ()))) V4540 V4541)))) +(defun shen.type-signature-of-empty? (V3378 V3379 V3380) (let A (shen.newpv V3379) (do (shen.incinfs) (unify! V3378 (cons A (cons --> (cons boolean ()))) V3379 V3380)))) -(defun shen.type-signature-of-enable-type-theory (V4549 V4550 V4551) (do (shen.incinfs) (unify! V4549 (cons symbol (cons --> (cons boolean ()))) V4550 V4551))) +(defun shen.type-signature-of-enable-type-theory (V3388 V3389 V3390) (do (shen.incinfs) (unify! V3388 (cons symbol (cons --> (cons boolean ()))) V3389 V3390))) -(defun shen.type-signature-of-external (V4559 V4560 V4561) (do (shen.incinfs) (unify! V4559 (cons symbol (cons --> (cons (cons list (cons symbol ())) ()))) V4560 V4561))) +(defun shen.type-signature-of-external (V3398 V3399 V3400) (do (shen.incinfs) (unify! V3398 (cons symbol (cons --> (cons (cons list (cons symbol ())) ()))) V3399 V3400))) -(defun shen.type-signature-of-error-to-string (V4569 V4570 V4571) (do (shen.incinfs) (unify! V4569 (cons exception (cons --> (cons string ()))) V4570 V4571))) +(defun shen.type-signature-of-error-to-string (V3408 V3409 V3410) (do (shen.incinfs) (unify! V3408 (cons exception (cons --> (cons string ()))) V3409 V3410))) -(defun shen.type-signature-of-explode (V4579 V4580 V4581) (let A (shen.newpv V4580) (do (shen.incinfs) (unify! V4579 (cons A (cons --> (cons (cons list (cons string ())) ()))) V4580 V4581)))) +(defun shen.type-signature-of-explode (V3418 V3419 V3420) (let A (shen.newpv V3419) (do (shen.incinfs) (unify! V3418 (cons A (cons --> (cons (cons list (cons string ())) ()))) V3419 V3420)))) -(defun shen.type-signature-of-fail (V4589 V4590 V4591) (do (shen.incinfs) (unify! V4589 (cons --> (cons symbol ())) V4590 V4591))) +(defun shen.type-signature-of-fail (V3428 V3429 V3430) (do (shen.incinfs) (unify! V3428 (cons --> (cons symbol ())) V3429 V3430))) -(defun shen.type-signature-of-fail-if (V4599 V4600 V4601) (do (shen.incinfs) (unify! V4599 (cons (cons symbol (cons --> (cons boolean ()))) (cons --> (cons (cons symbol (cons --> (cons symbol ()))) ()))) V4600 V4601))) +(defun shen.type-signature-of-fail-if (V3438 V3439 V3440) (do (shen.incinfs) (unify! V3438 (cons (cons symbol (cons --> (cons boolean ()))) (cons --> (cons (cons symbol (cons --> (cons symbol ()))) ()))) V3439 V3440))) -(defun shen.type-signature-of-fix (V4609 V4610 V4611) (let A (shen.newpv V4610) (do (shen.incinfs) (unify! V4609 (cons (cons A (cons --> (cons A ()))) (cons --> (cons (cons A (cons --> (cons A ()))) ()))) V4610 V4611)))) +(defun shen.type-signature-of-fix (V3448 V3449 V3450) (let A (shen.newpv V3449) (do (shen.incinfs) (unify! V3448 (cons (cons A (cons --> (cons A ()))) (cons --> (cons (cons A (cons --> (cons A ()))) ()))) V3449 V3450)))) -(defun shen.type-signature-of-freeze (V4619 V4620 V4621) (let A (shen.newpv V4620) (do (shen.incinfs) (unify! V4619 (cons A (cons --> (cons (cons lazy (cons A ())) ()))) V4620 V4621)))) +(defun shen.type-signature-of-freeze (V3458 V3459 V3460) (let A (shen.newpv V3459) (do (shen.incinfs) (unify! V3458 (cons A (cons --> (cons (cons lazy (cons A ())) ()))) V3459 V3460)))) -(defun shen.type-signature-of-fst (V4629 V4630 V4631) (let B (shen.newpv V4630) (let A (shen.newpv V4630) (do (shen.incinfs) (unify! V4629 (cons (cons A (cons * (cons B ()))) (cons --> (cons A ()))) V4630 V4631))))) +(defun shen.type-signature-of-fst (V3468 V3469 V3470) (let B (shen.newpv V3469) (let A (shen.newpv V3469) (do (shen.incinfs) (unify! V3468 (cons (cons A (cons * (cons B ()))) (cons --> (cons A ()))) V3469 V3470))))) -(defun shen.type-signature-of-function (V4639 V4640 V4641) (let A (shen.newpv V4640) (let B (shen.newpv V4640) (do (shen.incinfs) (unify! V4639 (cons (cons A (cons --> (cons B ()))) (cons --> (cons (cons A (cons --> (cons B ()))) ()))) V4640 V4641))))) +(defun shen.type-signature-of-function (V3478 V3479 V3480) (let A (shen.newpv V3479) (let B (shen.newpv V3479) (do (shen.incinfs) (unify! V3478 (cons (cons A (cons --> (cons B ()))) (cons --> (cons (cons A (cons --> (cons B ()))) ()))) V3479 V3480))))) -(defun shen.type-signature-of-gensym (V4649 V4650 V4651) (do (shen.incinfs) (unify! V4649 (cons symbol (cons --> (cons symbol ()))) V4650 V4651))) +(defun shen.type-signature-of-gensym (V3488 V3489 V3490) (do (shen.incinfs) (unify! V3488 (cons symbol (cons --> (cons symbol ()))) V3489 V3490))) -(defun shen.type-signature-of-<-vector (V4659 V4660 V4661) (let A (shen.newpv V4660) (do (shen.incinfs) (unify! V4659 (cons (cons vector (cons A ())) (cons --> (cons (cons number (cons --> (cons A ()))) ()))) V4660 V4661)))) +(defun shen.type-signature-of-<-vector (V3498 V3499 V3500) (let A (shen.newpv V3499) (do (shen.incinfs) (unify! V3498 (cons (cons vector (cons A ())) (cons --> (cons (cons number (cons --> (cons A ()))) ()))) V3499 V3500)))) -(defun shen.type-signature-of-vector-> (V4669 V4670 V4671) (let A (shen.newpv V4670) (do (shen.incinfs) (unify! V4669 (cons (cons vector (cons A ())) (cons --> (cons (cons number (cons --> (cons (cons A (cons --> (cons (cons vector (cons A ())) ()))) ()))) ()))) V4670 V4671)))) +(defun shen.type-signature-of-vector-> (V3508 V3509 V3510) (let A (shen.newpv V3509) (do (shen.incinfs) (unify! V3508 (cons (cons vector (cons A ())) (cons --> (cons (cons number (cons --> (cons (cons A (cons --> (cons (cons vector (cons A ())) ()))) ()))) ()))) V3509 V3510)))) -(defun shen.type-signature-of-vector (V4679 V4680 V4681) (let A (shen.newpv V4680) (do (shen.incinfs) (unify! V4679 (cons number (cons --> (cons (cons vector (cons A ())) ()))) V4680 V4681)))) +(defun shen.type-signature-of-vector (V3518 V3519 V3520) (let A (shen.newpv V3519) (do (shen.incinfs) (unify! V3518 (cons number (cons --> (cons (cons vector (cons A ())) ()))) V3519 V3520)))) -(defun shen.type-signature-of-get-time (V4689 V4690 V4691) (do (shen.incinfs) (unify! V4689 (cons symbol (cons --> (cons number ()))) V4690 V4691))) +(defun shen.type-signature-of-get-time (V3528 V3529 V3530) (do (shen.incinfs) (unify! V3528 (cons symbol (cons --> (cons number ()))) V3529 V3530))) -(defun shen.type-signature-of-hash (V4699 V4700 V4701) (let A (shen.newpv V4700) (do (shen.incinfs) (unify! V4699 (cons A (cons --> (cons (cons number (cons --> (cons number ()))) ()))) V4700 V4701)))) +(defun shen.type-signature-of-hash (V3538 V3539 V3540) (let A (shen.newpv V3539) (do (shen.incinfs) (unify! V3538 (cons A (cons --> (cons (cons number (cons --> (cons number ()))) ()))) V3539 V3540)))) -(defun shen.type-signature-of-head (V4709 V4710 V4711) (let A (shen.newpv V4710) (do (shen.incinfs) (unify! V4709 (cons (cons list (cons A ())) (cons --> (cons A ()))) V4710 V4711)))) +(defun shen.type-signature-of-head (V3548 V3549 V3550) (let A (shen.newpv V3549) (do (shen.incinfs) (unify! V3548 (cons (cons list (cons A ())) (cons --> (cons A ()))) V3549 V3550)))) -(defun shen.type-signature-of-hdv (V4719 V4720 V4721) (let A (shen.newpv V4720) (do (shen.incinfs) (unify! V4719 (cons (cons vector (cons A ())) (cons --> (cons A ()))) V4720 V4721)))) +(defun shen.type-signature-of-hdv (V3558 V3559 V3560) (let A (shen.newpv V3559) (do (shen.incinfs) (unify! V3558 (cons (cons vector (cons A ())) (cons --> (cons A ()))) V3559 V3560)))) -(defun shen.type-signature-of-hdstr (V4729 V4730 V4731) (do (shen.incinfs) (unify! V4729 (cons string (cons --> (cons string ()))) V4730 V4731))) +(defun shen.type-signature-of-hdstr (V3568 V3569 V3570) (do (shen.incinfs) (unify! V3568 (cons string (cons --> (cons string ()))) V3569 V3570))) -(defun shen.type-signature-of-if (V4739 V4740 V4741) (let A (shen.newpv V4740) (do (shen.incinfs) (unify! V4739 (cons boolean (cons --> (cons (cons A (cons --> (cons (cons A (cons --> (cons A ()))) ()))) ()))) V4740 V4741)))) +(defun shen.type-signature-of-if (V3578 V3579 V3580) (let A (shen.newpv V3579) (do (shen.incinfs) (unify! V3578 (cons boolean (cons --> (cons (cons A (cons --> (cons (cons A (cons --> (cons A ()))) ()))) ()))) V3579 V3580)))) -(defun shen.type-signature-of-it (V4749 V4750 V4751) (do (shen.incinfs) (unify! V4749 (cons --> (cons string ())) V4750 V4751))) +(defun shen.type-signature-of-it (V3588 V3589 V3590) (do (shen.incinfs) (unify! V3588 (cons --> (cons string ())) V3589 V3590))) -(defun shen.type-signature-of-implementation (V4759 V4760 V4761) (do (shen.incinfs) (unify! V4759 (cons --> (cons string ())) V4760 V4761))) +(defun shen.type-signature-of-implementation (V3598 V3599 V3600) (do (shen.incinfs) (unify! V3598 (cons --> (cons string ())) V3599 V3600))) -(defun shen.type-signature-of-include (V4769 V4770 V4771) (do (shen.incinfs) (unify! V4769 (cons (cons list (cons symbol ())) (cons --> (cons (cons list (cons symbol ())) ()))) V4770 V4771))) +(defun shen.type-signature-of-include (V3608 V3609 V3610) (do (shen.incinfs) (unify! V3608 (cons (cons list (cons symbol ())) (cons --> (cons (cons list (cons symbol ())) ()))) V3609 V3610))) -(defun shen.type-signature-of-include-all-but (V4779 V4780 V4781) (do (shen.incinfs) (unify! V4779 (cons (cons list (cons symbol ())) (cons --> (cons (cons list (cons symbol ())) ()))) V4780 V4781))) +(defun shen.type-signature-of-include-all-but (V3618 V3619 V3620) (do (shen.incinfs) (unify! V3618 (cons (cons list (cons symbol ())) (cons --> (cons (cons list (cons symbol ())) ()))) V3619 V3620))) -(defun shen.type-signature-of-inferences (V4789 V4790 V4791) (do (shen.incinfs) (unify! V4789 (cons --> (cons number ())) V4790 V4791))) +(defun shen.type-signature-of-inferences (V3628 V3629 V3630) (do (shen.incinfs) (unify! V3628 (cons --> (cons number ())) V3629 V3630))) -(defun shen.type-signature-of-shen.insert (V4799 V4800 V4801) (let A (shen.newpv V4800) (do (shen.incinfs) (unify! V4799 (cons A (cons --> (cons (cons string (cons --> (cons string ()))) ()))) V4800 V4801)))) +(defun shen.type-signature-of-shen.insert (V3638 V3639 V3640) (let A (shen.newpv V3639) (do (shen.incinfs) (unify! V3638 (cons A (cons --> (cons (cons string (cons --> (cons string ()))) ()))) V3639 V3640)))) -(defun shen.type-signature-of-integer? (V4809 V4810 V4811) (let A (shen.newpv V4810) (do (shen.incinfs) (unify! V4809 (cons A (cons --> (cons boolean ()))) V4810 V4811)))) +(defun shen.type-signature-of-integer? (V3648 V3649 V3650) (let A (shen.newpv V3649) (do (shen.incinfs) (unify! V3648 (cons A (cons --> (cons boolean ()))) V3649 V3650)))) -(defun shen.type-signature-of-internal (V4819 V4820 V4821) (do (shen.incinfs) (unify! V4819 (cons symbol (cons --> (cons (cons list (cons symbol ())) ()))) V4820 V4821))) +(defun shen.type-signature-of-internal (V3658 V3659 V3660) (do (shen.incinfs) (unify! V3658 (cons symbol (cons --> (cons (cons list (cons symbol ())) ()))) V3659 V3660))) -(defun shen.type-signature-of-intersection (V4829 V4830 V4831) (let A (shen.newpv V4830) (do (shen.incinfs) (unify! V4829 (cons (cons list (cons A ())) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) V4830 V4831)))) +(defun shen.type-signature-of-intersection (V3668 V3669 V3670) (let A (shen.newpv V3669) (do (shen.incinfs) (unify! V3668 (cons (cons list (cons A ())) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) V3669 V3670)))) -(defun shen.type-signature-of-kill (V4839 V4840 V4841) (let A (shen.newpv V4840) (do (shen.incinfs) (unify! V4839 (cons --> (cons A ())) V4840 V4841)))) +(defun shen.type-signature-of-kill (V3678 V3679 V3680) (let A (shen.newpv V3679) (do (shen.incinfs) (unify! V3678 (cons --> (cons A ())) V3679 V3680)))) -(defun shen.type-signature-of-language (V4849 V4850 V4851) (do (shen.incinfs) (unify! V4849 (cons --> (cons string ())) V4850 V4851))) +(defun shen.type-signature-of-language (V3688 V3689 V3690) (do (shen.incinfs) (unify! V3688 (cons --> (cons string ())) V3689 V3690))) -(defun shen.type-signature-of-length (V4859 V4860 V4861) (let A (shen.newpv V4860) (do (shen.incinfs) (unify! V4859 (cons (cons list (cons A ())) (cons --> (cons number ()))) V4860 V4861)))) +(defun shen.type-signature-of-length (V3698 V3699 V3700) (let A (shen.newpv V3699) (do (shen.incinfs) (unify! V3698 (cons (cons list (cons A ())) (cons --> (cons number ()))) V3699 V3700)))) -(defun shen.type-signature-of-limit (V4869 V4870 V4871) (let A (shen.newpv V4870) (do (shen.incinfs) (unify! V4869 (cons (cons vector (cons A ())) (cons --> (cons number ()))) V4870 V4871)))) +(defun shen.type-signature-of-limit (V3708 V3709 V3710) (let A (shen.newpv V3709) (do (shen.incinfs) (unify! V3708 (cons (cons vector (cons A ())) (cons --> (cons number ()))) V3709 V3710)))) -(defun shen.type-signature-of-load (V4879 V4880 V4881) (do (shen.incinfs) (unify! V4879 (cons string (cons --> (cons symbol ()))) V4880 V4881))) +(defun shen.type-signature-of-load (V3718 V3719 V3720) (do (shen.incinfs) (unify! V3718 (cons string (cons --> (cons symbol ()))) V3719 V3720))) -(defun shen.type-signature-of-map (V4889 V4890 V4891) (let A (shen.newpv V4890) (let B (shen.newpv V4890) (do (shen.incinfs) (unify! V4889 (cons (cons A (cons --> (cons B ()))) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons B ())) ()))) ()))) V4890 V4891))))) +(defun shen.type-signature-of-map (V3728 V3729 V3730) (let A (shen.newpv V3729) (let B (shen.newpv V3729) (do (shen.incinfs) (unify! V3728 (cons (cons A (cons --> (cons B ()))) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons B ())) ()))) ()))) V3729 V3730))))) -(defun shen.type-signature-of-mapcan (V4899 V4900 V4901) (let A (shen.newpv V4900) (let B (shen.newpv V4900) (do (shen.incinfs) (unify! V4899 (cons (cons A (cons --> (cons (cons list (cons B ())) ()))) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons B ())) ()))) ()))) V4900 V4901))))) +(defun shen.type-signature-of-mapcan (V3738 V3739 V3740) (let A (shen.newpv V3739) (let B (shen.newpv V3739) (do (shen.incinfs) (unify! V3738 (cons (cons A (cons --> (cons (cons list (cons B ())) ()))) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons B ())) ()))) ()))) V3739 V3740))))) -(defun shen.type-signature-of-maxinferences (V4909 V4910 V4911) (do (shen.incinfs) (unify! V4909 (cons number (cons --> (cons number ()))) V4910 V4911))) +(defun shen.type-signature-of-maxinferences (V3748 V3749 V3750) (do (shen.incinfs) (unify! V3748 (cons number (cons --> (cons number ()))) V3749 V3750))) -(defun shen.type-signature-of-n->string (V4919 V4920 V4921) (do (shen.incinfs) (unify! V4919 (cons number (cons --> (cons string ()))) V4920 V4921))) +(defun shen.type-signature-of-n->string (V3758 V3759 V3760) (do (shen.incinfs) (unify! V3758 (cons number (cons --> (cons string ()))) V3759 V3760))) -(defun shen.type-signature-of-nl (V4929 V4930 V4931) (do (shen.incinfs) (unify! V4929 (cons number (cons --> (cons number ()))) V4930 V4931))) +(defun shen.type-signature-of-nl (V3768 V3769 V3770) (do (shen.incinfs) (unify! V3768 (cons number (cons --> (cons number ()))) V3769 V3770))) -(defun shen.type-signature-of-not (V4939 V4940 V4941) (do (shen.incinfs) (unify! V4939 (cons boolean (cons --> (cons boolean ()))) V4940 V4941))) +(defun shen.type-signature-of-not (V3778 V3779 V3780) (do (shen.incinfs) (unify! V3778 (cons boolean (cons --> (cons boolean ()))) V3779 V3780))) -(defun shen.type-signature-of-nth (V4949 V4950 V4951) (let A (shen.newpv V4950) (do (shen.incinfs) (unify! V4949 (cons number (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons A ()))) ()))) V4950 V4951)))) +(defun shen.type-signature-of-nth (V3788 V3789 V3790) (let A (shen.newpv V3789) (do (shen.incinfs) (unify! V3788 (cons number (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons A ()))) ()))) V3789 V3790)))) -(defun shen.type-signature-of-number? (V4959 V4960 V4961) (let A (shen.newpv V4960) (do (shen.incinfs) (unify! V4959 (cons A (cons --> (cons boolean ()))) V4960 V4961)))) +(defun shen.type-signature-of-number? (V3798 V3799 V3800) (let A (shen.newpv V3799) (do (shen.incinfs) (unify! V3798 (cons A (cons --> (cons boolean ()))) V3799 V3800)))) -(defun shen.type-signature-of-occurrences (V4969 V4970 V4971) (let A (shen.newpv V4970) (let B (shen.newpv V4970) (do (shen.incinfs) (unify! V4969 (cons A (cons --> (cons (cons B (cons --> (cons number ()))) ()))) V4970 V4971))))) +(defun shen.type-signature-of-occurrences (V3808 V3809 V3810) (let A (shen.newpv V3809) (let B (shen.newpv V3809) (do (shen.incinfs) (unify! V3808 (cons A (cons --> (cons (cons B (cons --> (cons number ()))) ()))) V3809 V3810))))) -(defun shen.type-signature-of-occurs-check (V4979 V4980 V4981) (do (shen.incinfs) (unify! V4979 (cons symbol (cons --> (cons boolean ()))) V4980 V4981))) +(defun shen.type-signature-of-occurs-check (V3818 V3819 V3820) (do (shen.incinfs) (unify! V3818 (cons symbol (cons --> (cons boolean ()))) V3819 V3820))) -(defun shen.type-signature-of-optimise (V4989 V4990 V4991) (do (shen.incinfs) (unify! V4989 (cons symbol (cons --> (cons boolean ()))) V4990 V4991))) +(defun shen.type-signature-of-optimise (V3828 V3829 V3830) (do (shen.incinfs) (unify! V3828 (cons symbol (cons --> (cons boolean ()))) V3829 V3830))) -(defun shen.type-signature-of-or (V4999 V5000 V5001) (do (shen.incinfs) (unify! V4999 (cons boolean (cons --> (cons (cons boolean (cons --> (cons boolean ()))) ()))) V5000 V5001))) +(defun shen.type-signature-of-or (V3838 V3839 V3840) (do (shen.incinfs) (unify! V3838 (cons boolean (cons --> (cons (cons boolean (cons --> (cons boolean ()))) ()))) V3839 V3840))) -(defun shen.type-signature-of-os (V5009 V5010 V5011) (do (shen.incinfs) (unify! V5009 (cons --> (cons string ())) V5010 V5011))) +(defun shen.type-signature-of-os (V3848 V3849 V3850) (do (shen.incinfs) (unify! V3848 (cons --> (cons string ())) V3849 V3850))) -(defun shen.type-signature-of-package? (V5019 V5020 V5021) (do (shen.incinfs) (unify! V5019 (cons symbol (cons --> (cons boolean ()))) V5020 V5021))) +(defun shen.type-signature-of-package? (V3858 V3859 V3860) (do (shen.incinfs) (unify! V3858 (cons symbol (cons --> (cons boolean ()))) V3859 V3860))) -(defun shen.type-signature-of-port (V5029 V5030 V5031) (do (shen.incinfs) (unify! V5029 (cons --> (cons string ())) V5030 V5031))) +(defun shen.type-signature-of-port (V3868 V3869 V3870) (do (shen.incinfs) (unify! V3868 (cons --> (cons string ())) V3869 V3870))) -(defun shen.type-signature-of-porters (V5039 V5040 V5041) (do (shen.incinfs) (unify! V5039 (cons --> (cons string ())) V5040 V5041))) +(defun shen.type-signature-of-porters (V3878 V3879 V3880) (do (shen.incinfs) (unify! V3878 (cons --> (cons string ())) V3879 V3880))) -(defun shen.type-signature-of-pos (V5049 V5050 V5051) (do (shen.incinfs) (unify! V5049 (cons string (cons --> (cons (cons number (cons --> (cons string ()))) ()))) V5050 V5051))) +(defun shen.type-signature-of-pos (V3888 V3889 V3890) (do (shen.incinfs) (unify! V3888 (cons string (cons --> (cons (cons number (cons --> (cons string ()))) ()))) V3889 V3890))) -(defun shen.type-signature-of-pr (V5059 V5060 V5061) (do (shen.incinfs) (unify! V5059 (cons string (cons --> (cons (cons (cons stream (cons out ())) (cons --> (cons string ()))) ()))) V5060 V5061))) +(defun shen.type-signature-of-pr (V3898 V3899 V3900) (do (shen.incinfs) (unify! V3898 (cons string (cons --> (cons (cons (cons stream (cons out ())) (cons --> (cons string ()))) ()))) V3899 V3900))) -(defun shen.type-signature-of-print (V5069 V5070 V5071) (let A (shen.newpv V5070) (do (shen.incinfs) (unify! V5069 (cons A (cons --> (cons A ()))) V5070 V5071)))) +(defun shen.type-signature-of-print (V3908 V3909 V3910) (let A (shen.newpv V3909) (do (shen.incinfs) (unify! V3908 (cons A (cons --> (cons A ()))) V3909 V3910)))) -(defun shen.type-signature-of-profile (V5079 V5080 V5081) (let A (shen.newpv V5080) (let B (shen.newpv V5080) (do (shen.incinfs) (unify! V5079 (cons (cons A (cons --> (cons B ()))) (cons --> (cons (cons A (cons --> (cons B ()))) ()))) V5080 V5081))))) +(defun shen.type-signature-of-profile (V3918 V3919 V3920) (let A (shen.newpv V3919) (let B (shen.newpv V3919) (do (shen.incinfs) (unify! V3918 (cons (cons A (cons --> (cons B ()))) (cons --> (cons (cons A (cons --> (cons B ()))) ()))) V3919 V3920))))) -(defun shen.type-signature-of-preclude (V5089 V5090 V5091) (do (shen.incinfs) (unify! V5089 (cons (cons list (cons symbol ())) (cons --> (cons (cons list (cons symbol ())) ()))) V5090 V5091))) +(defun shen.type-signature-of-preclude (V3928 V3929 V3930) (do (shen.incinfs) (unify! V3928 (cons (cons list (cons symbol ())) (cons --> (cons (cons list (cons symbol ())) ()))) V3929 V3930))) -(defun shen.type-signature-of-shen.proc-nl (V5099 V5100 V5101) (do (shen.incinfs) (unify! V5099 (cons string (cons --> (cons string ()))) V5100 V5101))) +(defun shen.type-signature-of-shen.proc-nl (V3938 V3939 V3940) (do (shen.incinfs) (unify! V3938 (cons string (cons --> (cons string ()))) V3939 V3940))) -(defun shen.type-signature-of-profile-results (V5109 V5110 V5111) (let A (shen.newpv V5110) (let B (shen.newpv V5110) (do (shen.incinfs) (unify! V5109 (cons (cons A (cons --> (cons B ()))) (cons --> (cons (cons (cons A (cons --> (cons B ()))) (cons * (cons number ()))) ()))) V5110 V5111))))) +(defun shen.type-signature-of-profile-results (V3948 V3949 V3950) (let A (shen.newpv V3949) (let B (shen.newpv V3949) (do (shen.incinfs) (unify! V3948 (cons (cons A (cons --> (cons B ()))) (cons --> (cons (cons (cons A (cons --> (cons B ()))) (cons * (cons number ()))) ()))) V3949 V3950))))) -(defun shen.type-signature-of-protect (V5119 V5120 V5121) (do (shen.incinfs) (unify! V5119 (cons symbol (cons --> (cons symbol ()))) V5120 V5121))) +(defun shen.type-signature-of-protect (V3958 V3959 V3960) (do (shen.incinfs) (unify! V3958 (cons symbol (cons --> (cons symbol ()))) V3959 V3960))) -(defun shen.type-signature-of-preclude-all-but (V5129 V5130 V5131) (do (shen.incinfs) (unify! V5129 (cons (cons list (cons symbol ())) (cons --> (cons (cons list (cons symbol ())) ()))) V5130 V5131))) +(defun shen.type-signature-of-preclude-all-but (V3968 V3969 V3970) (do (shen.incinfs) (unify! V3968 (cons (cons list (cons symbol ())) (cons --> (cons (cons list (cons symbol ())) ()))) V3969 V3970))) -(defun shen.type-signature-of-shen.prhush (V5139 V5140 V5141) (do (shen.incinfs) (unify! V5139 (cons string (cons --> (cons (cons (cons stream (cons out ())) (cons --> (cons string ()))) ()))) V5140 V5141))) +(defun shen.type-signature-of-shen.prhush (V3978 V3979 V3980) (do (shen.incinfs) (unify! V3978 (cons string (cons --> (cons (cons (cons stream (cons out ())) (cons --> (cons string ()))) ()))) V3979 V3980))) -(defun shen.type-signature-of-ps (V5149 V5150 V5151) (do (shen.incinfs) (unify! V5149 (cons symbol (cons --> (cons (cons list (cons unit ())) ()))) V5150 V5151))) +(defun shen.type-signature-of-ps (V3988 V3989 V3990) (do (shen.incinfs) (unify! V3988 (cons symbol (cons --> (cons (cons list (cons unit ())) ()))) V3989 V3990))) -(defun shen.type-signature-of-read (V5159 V5160 V5161) (do (shen.incinfs) (unify! V5159 (cons (cons stream (cons in ())) (cons --> (cons unit ()))) V5160 V5161))) +(defun shen.type-signature-of-read (V3998 V3999 V4000) (do (shen.incinfs) (unify! V3998 (cons (cons stream (cons in ())) (cons --> (cons unit ()))) V3999 V4000))) -(defun shen.type-signature-of-read-byte (V5169 V5170 V5171) (do (shen.incinfs) (unify! V5169 (cons (cons stream (cons in ())) (cons --> (cons number ()))) V5170 V5171))) +(defun shen.type-signature-of-read-byte (V4008 V4009 V4010) (do (shen.incinfs) (unify! V4008 (cons (cons stream (cons in ())) (cons --> (cons number ()))) V4009 V4010))) -(defun shen.type-signature-of-read-file-as-bytelist (V5179 V5180 V5181) (do (shen.incinfs) (unify! V5179 (cons string (cons --> (cons (cons list (cons number ())) ()))) V5180 V5181))) +(defun shen.type-signature-of-read-file-as-bytelist (V4018 V4019 V4020) (do (shen.incinfs) (unify! V4018 (cons string (cons --> (cons (cons list (cons number ())) ()))) V4019 V4020))) -(defun shen.type-signature-of-read-file-as-string (V5189 V5190 V5191) (do (shen.incinfs) (unify! V5189 (cons string (cons --> (cons string ()))) V5190 V5191))) +(defun shen.type-signature-of-read-file-as-string (V4028 V4029 V4030) (do (shen.incinfs) (unify! V4028 (cons string (cons --> (cons string ()))) V4029 V4030))) -(defun shen.type-signature-of-read-file (V5199 V5200 V5201) (do (shen.incinfs) (unify! V5199 (cons string (cons --> (cons (cons list (cons unit ())) ()))) V5200 V5201))) +(defun shen.type-signature-of-read-file (V4038 V4039 V4040) (do (shen.incinfs) (unify! V4038 (cons string (cons --> (cons (cons list (cons unit ())) ()))) V4039 V4040))) -(defun shen.type-signature-of-read-from-string (V5209 V5210 V5211) (do (shen.incinfs) (unify! V5209 (cons string (cons --> (cons (cons list (cons unit ())) ()))) V5210 V5211))) +(defun shen.type-signature-of-read-from-string (V4048 V4049 V4050) (do (shen.incinfs) (unify! V4048 (cons string (cons --> (cons (cons list (cons unit ())) ()))) V4049 V4050))) -(defun shen.type-signature-of-release (V5219 V5220 V5221) (do (shen.incinfs) (unify! V5219 (cons --> (cons string ())) V5220 V5221))) +(defun shen.type-signature-of-release (V4058 V4059 V4060) (do (shen.incinfs) (unify! V4058 (cons --> (cons string ())) V4059 V4060))) -(defun shen.type-signature-of-remove (V5229 V5230 V5231) (let A (shen.newpv V5230) (do (shen.incinfs) (unify! V5229 (cons A (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) V5230 V5231)))) +(defun shen.type-signature-of-remove (V4068 V4069 V4070) (let A (shen.newpv V4069) (do (shen.incinfs) (unify! V4068 (cons A (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) V4069 V4070)))) -(defun shen.type-signature-of-reverse (V5239 V5240 V5241) (let A (shen.newpv V5240) (do (shen.incinfs) (unify! V5239 (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) V5240 V5241)))) +(defun shen.type-signature-of-reverse (V4078 V4079 V4080) (let A (shen.newpv V4079) (do (shen.incinfs) (unify! V4078 (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) V4079 V4080)))) -(defun shen.type-signature-of-simple-error (V5249 V5250 V5251) (let A (shen.newpv V5250) (do (shen.incinfs) (unify! V5249 (cons string (cons --> (cons A ()))) V5250 V5251)))) +(defun shen.type-signature-of-simple-error (V4088 V4089 V4090) (let A (shen.newpv V4089) (do (shen.incinfs) (unify! V4088 (cons string (cons --> (cons A ()))) V4089 V4090)))) -(defun shen.type-signature-of-snd (V5259 V5260 V5261) (let A (shen.newpv V5260) (let B (shen.newpv V5260) (do (shen.incinfs) (unify! V5259 (cons (cons A (cons * (cons B ()))) (cons --> (cons B ()))) V5260 V5261))))) +(defun shen.type-signature-of-snd (V4098 V4099 V4100) (let A (shen.newpv V4099) (let B (shen.newpv V4099) (do (shen.incinfs) (unify! V4098 (cons (cons A (cons * (cons B ()))) (cons --> (cons B ()))) V4099 V4100))))) -(defun shen.type-signature-of-specialise (V5269 V5270 V5271) (do (shen.incinfs) (unify! V5269 (cons symbol (cons --> (cons symbol ()))) V5270 V5271))) +(defun shen.type-signature-of-specialise (V4108 V4109 V4110) (do (shen.incinfs) (unify! V4108 (cons symbol (cons --> (cons symbol ()))) V4109 V4110))) -(defun shen.type-signature-of-spy (V5279 V5280 V5281) (do (shen.incinfs) (unify! V5279 (cons symbol (cons --> (cons boolean ()))) V5280 V5281))) +(defun shen.type-signature-of-spy (V4118 V4119 V4120) (do (shen.incinfs) (unify! V4118 (cons symbol (cons --> (cons boolean ()))) V4119 V4120))) -(defun shen.type-signature-of-step (V5289 V5290 V5291) (do (shen.incinfs) (unify! V5289 (cons symbol (cons --> (cons boolean ()))) V5290 V5291))) +(defun shen.type-signature-of-step (V4128 V4129 V4130) (do (shen.incinfs) (unify! V4128 (cons symbol (cons --> (cons boolean ()))) V4129 V4130))) -(defun shen.type-signature-of-stinput (V5299 V5300 V5301) (do (shen.incinfs) (unify! V5299 (cons --> (cons (cons stream (cons in ())) ())) V5300 V5301))) +(defun shen.type-signature-of-stinput (V4138 V4139 V4140) (do (shen.incinfs) (unify! V4138 (cons --> (cons (cons stream (cons in ())) ())) V4139 V4140))) -(defun shen.type-signature-of-sterror (V5309 V5310 V5311) (do (shen.incinfs) (unify! V5309 (cons --> (cons (cons stream (cons out ())) ())) V5310 V5311))) +(defun shen.type-signature-of-sterror (V4148 V4149 V4150) (do (shen.incinfs) (unify! V4148 (cons --> (cons (cons stream (cons out ())) ())) V4149 V4150))) -(defun shen.type-signature-of-stoutput (V5319 V5320 V5321) (do (shen.incinfs) (unify! V5319 (cons --> (cons (cons stream (cons out ())) ())) V5320 V5321))) +(defun shen.type-signature-of-stoutput (V4158 V4159 V4160) (do (shen.incinfs) (unify! V4158 (cons --> (cons (cons stream (cons out ())) ())) V4159 V4160))) -(defun shen.type-signature-of-string? (V5329 V5330 V5331) (let A (shen.newpv V5330) (do (shen.incinfs) (unify! V5329 (cons A (cons --> (cons boolean ()))) V5330 V5331)))) +(defun shen.type-signature-of-string? (V4168 V4169 V4170) (let A (shen.newpv V4169) (do (shen.incinfs) (unify! V4168 (cons A (cons --> (cons boolean ()))) V4169 V4170)))) -(defun shen.type-signature-of-str (V5339 V5340 V5341) (let A (shen.newpv V5340) (do (shen.incinfs) (unify! V5339 (cons A (cons --> (cons string ()))) V5340 V5341)))) +(defun shen.type-signature-of-str (V4178 V4179 V4180) (let A (shen.newpv V4179) (do (shen.incinfs) (unify! V4178 (cons A (cons --> (cons string ()))) V4179 V4180)))) -(defun shen.type-signature-of-string->n (V5349 V5350 V5351) (do (shen.incinfs) (unify! V5349 (cons string (cons --> (cons number ()))) V5350 V5351))) +(defun shen.type-signature-of-string->n (V4188 V4189 V4190) (do (shen.incinfs) (unify! V4188 (cons string (cons --> (cons number ()))) V4189 V4190))) -(defun shen.type-signature-of-string->symbol (V5359 V5360 V5361) (do (shen.incinfs) (unify! V5359 (cons string (cons --> (cons symbol ()))) V5360 V5361))) +(defun shen.type-signature-of-string->symbol (V4198 V4199 V4200) (do (shen.incinfs) (unify! V4198 (cons string (cons --> (cons symbol ()))) V4199 V4200))) -(defun shen.type-signature-of-sum (V5369 V5370 V5371) (do (shen.incinfs) (unify! V5369 (cons (cons list (cons number ())) (cons --> (cons number ()))) V5370 V5371))) +(defun shen.type-signature-of-sum (V4208 V4209 V4210) (do (shen.incinfs) (unify! V4208 (cons (cons list (cons number ())) (cons --> (cons number ()))) V4209 V4210))) -(defun shen.type-signature-of-symbol? (V5379 V5380 V5381) (let A (shen.newpv V5380) (do (shen.incinfs) (unify! V5379 (cons A (cons --> (cons boolean ()))) V5380 V5381)))) +(defun shen.type-signature-of-symbol? (V4218 V4219 V4220) (let A (shen.newpv V4219) (do (shen.incinfs) (unify! V4218 (cons A (cons --> (cons boolean ()))) V4219 V4220)))) -(defun shen.type-signature-of-systemf (V5389 V5390 V5391) (do (shen.incinfs) (unify! V5389 (cons symbol (cons --> (cons symbol ()))) V5390 V5391))) +(defun shen.type-signature-of-systemf (V4228 V4229 V4230) (do (shen.incinfs) (unify! V4228 (cons symbol (cons --> (cons symbol ()))) V4229 V4230))) -(defun shen.type-signature-of-tail (V5399 V5400 V5401) (let A (shen.newpv V5400) (do (shen.incinfs) (unify! V5399 (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) V5400 V5401)))) +(defun shen.type-signature-of-tail (V4238 V4239 V4240) (let A (shen.newpv V4239) (do (shen.incinfs) (unify! V4238 (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) V4239 V4240)))) -(defun shen.type-signature-of-tlstr (V5409 V5410 V5411) (do (shen.incinfs) (unify! V5409 (cons string (cons --> (cons string ()))) V5410 V5411))) +(defun shen.type-signature-of-tlstr (V4248 V4249 V4250) (do (shen.incinfs) (unify! V4248 (cons string (cons --> (cons string ()))) V4249 V4250))) -(defun shen.type-signature-of-tlv (V5419 V5420 V5421) (let A (shen.newpv V5420) (do (shen.incinfs) (unify! V5419 (cons (cons vector (cons A ())) (cons --> (cons (cons vector (cons A ())) ()))) V5420 V5421)))) +(defun shen.type-signature-of-tlv (V4258 V4259 V4260) (let A (shen.newpv V4259) (do (shen.incinfs) (unify! V4258 (cons (cons vector (cons A ())) (cons --> (cons (cons vector (cons A ())) ()))) V4259 V4260)))) -(defun shen.type-signature-of-tc (V5429 V5430 V5431) (do (shen.incinfs) (unify! V5429 (cons symbol (cons --> (cons boolean ()))) V5430 V5431))) +(defun shen.type-signature-of-tc (V4268 V4269 V4270) (do (shen.incinfs) (unify! V4268 (cons symbol (cons --> (cons boolean ()))) V4269 V4270))) -(defun shen.type-signature-of-tc? (V5439 V5440 V5441) (do (shen.incinfs) (unify! V5439 (cons --> (cons boolean ())) V5440 V5441))) +(defun shen.type-signature-of-tc? (V4278 V4279 V4280) (do (shen.incinfs) (unify! V4278 (cons --> (cons boolean ())) V4279 V4280))) -(defun shen.type-signature-of-thaw (V5449 V5450 V5451) (let A (shen.newpv V5450) (do (shen.incinfs) (unify! V5449 (cons (cons lazy (cons A ())) (cons --> (cons A ()))) V5450 V5451)))) +(defun shen.type-signature-of-thaw (V4288 V4289 V4290) (let A (shen.newpv V4289) (do (shen.incinfs) (unify! V4288 (cons (cons lazy (cons A ())) (cons --> (cons A ()))) V4289 V4290)))) -(defun shen.type-signature-of-track (V5459 V5460 V5461) (do (shen.incinfs) (unify! V5459 (cons symbol (cons --> (cons symbol ()))) V5460 V5461))) +(defun shen.type-signature-of-track (V4298 V4299 V4300) (do (shen.incinfs) (unify! V4298 (cons symbol (cons --> (cons symbol ()))) V4299 V4300))) -(defun shen.type-signature-of-trap-error (V5469 V5470 V5471) (let A (shen.newpv V5470) (do (shen.incinfs) (unify! V5469 (cons A (cons --> (cons (cons (cons exception (cons --> (cons A ()))) (cons --> (cons A ()))) ()))) V5470 V5471)))) +(defun shen.type-signature-of-trap-error (V4308 V4309 V4310) (let A (shen.newpv V4309) (do (shen.incinfs) (unify! V4308 (cons A (cons --> (cons (cons (cons exception (cons --> (cons A ()))) (cons --> (cons A ()))) ()))) V4309 V4310)))) -(defun shen.type-signature-of-tuple? (V5479 V5480 V5481) (let A (shen.newpv V5480) (do (shen.incinfs) (unify! V5479 (cons A (cons --> (cons boolean ()))) V5480 V5481)))) +(defun shen.type-signature-of-tuple? (V4318 V4319 V4320) (let A (shen.newpv V4319) (do (shen.incinfs) (unify! V4318 (cons A (cons --> (cons boolean ()))) V4319 V4320)))) -(defun shen.type-signature-of-undefmacro (V5489 V5490 V5491) (do (shen.incinfs) (unify! V5489 (cons symbol (cons --> (cons symbol ()))) V5490 V5491))) +(defun shen.type-signature-of-undefmacro (V4328 V4329 V4330) (do (shen.incinfs) (unify! V4328 (cons symbol (cons --> (cons symbol ()))) V4329 V4330))) -(defun shen.type-signature-of-union (V5499 V5500 V5501) (let A (shen.newpv V5500) (do (shen.incinfs) (unify! V5499 (cons (cons list (cons A ())) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) V5500 V5501)))) +(defun shen.type-signature-of-union (V4338 V4339 V4340) (let A (shen.newpv V4339) (do (shen.incinfs) (unify! V4338 (cons (cons list (cons A ())) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) V4339 V4340)))) -(defun shen.type-signature-of-unprofile (V5509 V5510 V5511) (let A (shen.newpv V5510) (let B (shen.newpv V5510) (do (shen.incinfs) (unify! V5509 (cons (cons A (cons --> (cons B ()))) (cons --> (cons (cons A (cons --> (cons B ()))) ()))) V5510 V5511))))) +(defun shen.type-signature-of-unprofile (V4348 V4349 V4350) (let A (shen.newpv V4349) (let B (shen.newpv V4349) (do (shen.incinfs) (unify! V4348 (cons (cons A (cons --> (cons B ()))) (cons --> (cons (cons A (cons --> (cons B ()))) ()))) V4349 V4350))))) -(defun shen.type-signature-of-untrack (V5519 V5520 V5521) (do (shen.incinfs) (unify! V5519 (cons symbol (cons --> (cons symbol ()))) V5520 V5521))) +(defun shen.type-signature-of-untrack (V4358 V4359 V4360) (do (shen.incinfs) (unify! V4358 (cons symbol (cons --> (cons symbol ()))) V4359 V4360))) -(defun shen.type-signature-of-unspecialise (V5529 V5530 V5531) (do (shen.incinfs) (unify! V5529 (cons symbol (cons --> (cons symbol ()))) V5530 V5531))) +(defun shen.type-signature-of-unspecialise (V4368 V4369 V4370) (do (shen.incinfs) (unify! V4368 (cons symbol (cons --> (cons symbol ()))) V4369 V4370))) -(defun shen.type-signature-of-variable? (V5539 V5540 V5541) (let A (shen.newpv V5540) (do (shen.incinfs) (unify! V5539 (cons A (cons --> (cons boolean ()))) V5540 V5541)))) +(defun shen.type-signature-of-variable? (V4378 V4379 V4380) (let A (shen.newpv V4379) (do (shen.incinfs) (unify! V4378 (cons A (cons --> (cons boolean ()))) V4379 V4380)))) -(defun shen.type-signature-of-vector? (V5549 V5550 V5551) (let A (shen.newpv V5550) (do (shen.incinfs) (unify! V5549 (cons A (cons --> (cons boolean ()))) V5550 V5551)))) +(defun shen.type-signature-of-vector? (V4388 V4389 V4390) (let A (shen.newpv V4389) (do (shen.incinfs) (unify! V4388 (cons A (cons --> (cons boolean ()))) V4389 V4390)))) -(defun shen.type-signature-of-version (V5559 V5560 V5561) (do (shen.incinfs) (unify! V5559 (cons --> (cons string ())) V5560 V5561))) +(defun shen.type-signature-of-version (V4398 V4399 V4400) (do (shen.incinfs) (unify! V4398 (cons --> (cons string ())) V4399 V4400))) -(defun shen.type-signature-of-write-to-file (V5569 V5570 V5571) (let A (shen.newpv V5570) (do (shen.incinfs) (unify! V5569 (cons string (cons --> (cons (cons A (cons --> (cons A ()))) ()))) V5570 V5571)))) +(defun shen.type-signature-of-write-to-file (V4408 V4409 V4410) (let A (shen.newpv V4409) (do (shen.incinfs) (unify! V4408 (cons string (cons --> (cons (cons A (cons --> (cons A ()))) ()))) V4409 V4410)))) -(defun shen.type-signature-of-write-byte (V5579 V5580 V5581) (do (shen.incinfs) (unify! V5579 (cons number (cons --> (cons (cons (cons stream (cons out ())) (cons --> (cons number ()))) ()))) V5580 V5581))) +(defun shen.type-signature-of-write-byte (V4418 V4419 V4420) (do (shen.incinfs) (unify! V4418 (cons number (cons --> (cons (cons (cons stream (cons out ())) (cons --> (cons number ()))) ()))) V4419 V4420))) -(defun shen.type-signature-of-y-or-n? (V5589 V5590 V5591) (do (shen.incinfs) (unify! V5589 (cons string (cons --> (cons boolean ()))) V5590 V5591))) +(defun shen.type-signature-of-y-or-n? (V4428 V4429 V4430) (do (shen.incinfs) (unify! V4428 (cons string (cons --> (cons boolean ()))) V4429 V4430))) -(defun shen.type-signature-of-> (V5599 V5600 V5601) (do (shen.incinfs) (unify! V5599 (cons number (cons --> (cons (cons number (cons --> (cons boolean ()))) ()))) V5600 V5601))) +(defun shen.type-signature-of-> (V4438 V4439 V4440) (do (shen.incinfs) (unify! V4438 (cons number (cons --> (cons (cons number (cons --> (cons boolean ()))) ()))) V4439 V4440))) -(defun shen.type-signature-of-< (V5609 V5610 V5611) (do (shen.incinfs) (unify! V5609 (cons number (cons --> (cons (cons number (cons --> (cons boolean ()))) ()))) V5610 V5611))) +(defun shen.type-signature-of-< (V4448 V4449 V4450) (do (shen.incinfs) (unify! V4448 (cons number (cons --> (cons (cons number (cons --> (cons boolean ()))) ()))) V4449 V4450))) -(defun shen.type-signature-of->= (V5619 V5620 V5621) (do (shen.incinfs) (unify! V5619 (cons number (cons --> (cons (cons number (cons --> (cons boolean ()))) ()))) V5620 V5621))) +(defun shen.type-signature-of->= (V4458 V4459 V4460) (do (shen.incinfs) (unify! V4458 (cons number (cons --> (cons (cons number (cons --> (cons boolean ()))) ()))) V4459 V4460))) -(defun shen.type-signature-of-<= (V5629 V5630 V5631) (do (shen.incinfs) (unify! V5629 (cons number (cons --> (cons (cons number (cons --> (cons boolean ()))) ()))) V5630 V5631))) +(defun shen.type-signature-of-<= (V4468 V4469 V4470) (do (shen.incinfs) (unify! V4468 (cons number (cons --> (cons (cons number (cons --> (cons boolean ()))) ()))) V4469 V4470))) -(defun shen.type-signature-of-= (V5639 V5640 V5641) (let A (shen.newpv V5640) (do (shen.incinfs) (unify! V5639 (cons A (cons --> (cons (cons A (cons --> (cons boolean ()))) ()))) V5640 V5641)))) +(defun shen.type-signature-of-= (V4478 V4479 V4480) (let A (shen.newpv V4479) (do (shen.incinfs) (unify! V4478 (cons A (cons --> (cons (cons A (cons --> (cons boolean ()))) ()))) V4479 V4480)))) -(defun shen.type-signature-of-+ (V5649 V5650 V5651) (do (shen.incinfs) (unify! V5649 (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ()))) V5650 V5651))) +(defun shen.type-signature-of-+ (V4488 V4489 V4490) (do (shen.incinfs) (unify! V4488 (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ()))) V4489 V4490))) -(defun shen.type-signature-of-/ (V5659 V5660 V5661) (do (shen.incinfs) (unify! V5659 (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ()))) V5660 V5661))) +(defun shen.type-signature-of-/ (V4498 V4499 V4500) (do (shen.incinfs) (unify! V4498 (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ()))) V4499 V4500))) -(defun shen.type-signature-of-- (V5669 V5670 V5671) (do (shen.incinfs) (unify! V5669 (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ()))) V5670 V5671))) +(defun shen.type-signature-of-- (V4508 V4509 V4510) (do (shen.incinfs) (unify! V4508 (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ()))) V4509 V4510))) -(defun shen.type-signature-of-* (V5679 V5680 V5681) (do (shen.incinfs) (unify! V5679 (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ()))) V5680 V5681))) +(defun shen.type-signature-of-* (V4518 V4519 V4520) (do (shen.incinfs) (unify! V4518 (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ()))) V4519 V4520))) -(defun shen.type-signature-of-== (V5689 V5690 V5691) (let A (shen.newpv V5690) (let B (shen.newpv V5690) (do (shen.incinfs) (unify! V5689 (cons A (cons --> (cons (cons B (cons --> (cons boolean ()))) ()))) V5690 V5691))))) +(defun shen.type-signature-of-== (V4528 V4529 V4530) (let A (shen.newpv V4529) (let B (shen.newpv V4529) (do (shen.incinfs) (unify! V4528 (cons A (cons --> (cons (cons B (cons --> (cons boolean ()))) ()))) V4529 V4530))))) diff --git a/kl/writer.kl b/kl/writer.kl index e1510a2..dd96e4c 100644 --- a/kl/writer.kl +++ b/kl/writer.kl @@ -28,63 +28,63 @@ OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. " -(defun pr (V5697 V5698) (trap-error (shen.prh V5697 V5698 0) (lambda E V5697))) +(defun pr (V4536 V4537) (trap-error (shen.prh V4536 V4537 0) (lambda E V4536))) -(defun shen.prh (V5702 V5703 V5704) (shen.prh V5702 V5703 (shen.write-char-and-inc V5702 V5703 V5704))) +(defun shen.prh (V4541 V4542 V4543) (shen.prh V4541 V4542 (shen.write-char-and-inc V4541 V4542 V4543))) -(defun shen.write-char-and-inc (V5708 V5709 V5710) (do (write-byte (string->n (pos V5708 V5710)) V5709) (+ V5710 1))) +(defun shen.write-char-and-inc (V4547 V4548 V4549) (do (write-byte (string->n (pos V4547 V4549)) V4548) (+ V4549 1))) -(defun print (V5712) (let String (shen.insert V5712 "~S") (let Print (shen.prhush String (stoutput)) V5712))) +(defun print (V4551) (let String (shen.insert V4551 "~S") (let Print (shen.prhush String (stoutput)) V4551))) -(defun shen.prhush (V5715 V5716) (if (value *hush*) V5715 (pr V5715 V5716))) +(defun shen.prhush (V4554 V4555) (if (value *hush*) V4554 (pr V4554 V4555))) -(defun shen.mkstr (V5719 V5720) (cond ((string? V5719) (shen.mkstr-l (shen.proc-nl V5719) V5720)) (true (shen.mkstr-r (cons shen.proc-nl (cons V5719 ())) V5720)))) +(defun shen.mkstr (V4558 V4559) (cond ((string? V4558) (shen.mkstr-l (shen.proc-nl V4558) V4559)) (true (shen.mkstr-r (cons shen.proc-nl (cons V4558 ())) V4559)))) -(defun shen.mkstr-l (V5723 V5724) (cond ((= () V5724) V5723) ((cons? V5724) (shen.mkstr-l (shen.insert-l (hd V5724) V5723) (tl V5724))) (true (shen.f_error shen.mkstr-l)))) +(defun shen.mkstr-l (V4562 V4563) (cond ((= () V4563) V4562) ((cons? V4563) (shen.mkstr-l (shen.insert-l (hd V4563) V4562) (tl V4563))) (true (shen.f_error shen.mkstr-l)))) -(defun shen.insert-l (V5729 V5730) (cond ((= "" V5730) "") ((and (shen.+string? V5730) (and (= "~" (pos V5730 0)) (and (shen.+string? (tlstr V5730)) (= "A" (pos (tlstr V5730) 0))))) (cons shen.app (cons V5729 (cons (tlstr (tlstr V5730)) (cons shen.a ()))))) ((and (shen.+string? V5730) (and (= "~" (pos V5730 0)) (and (shen.+string? (tlstr V5730)) (= "R" (pos (tlstr V5730) 0))))) (cons shen.app (cons V5729 (cons (tlstr (tlstr V5730)) (cons shen.r ()))))) ((and (shen.+string? V5730) (and (= "~" (pos V5730 0)) (and (shen.+string? (tlstr V5730)) (= "S" (pos (tlstr V5730) 0))))) (cons shen.app (cons V5729 (cons (tlstr (tlstr V5730)) (cons shen.s ()))))) ((shen.+string? V5730) (shen.factor-cn (cons cn (cons (pos V5730 0) (cons (shen.insert-l V5729 (tlstr V5730)) ()))))) ((and (cons? V5730) (and (= cn (hd V5730)) (and (cons? (tl V5730)) (and (cons? (tl (tl V5730))) (= () (tl (tl (tl V5730)))))))) (cons cn (cons (hd (tl V5730)) (cons (shen.insert-l V5729 (hd (tl (tl V5730)))) ())))) ((and (cons? V5730) (and (= shen.app (hd V5730)) (and (cons? (tl V5730)) (and (cons? (tl (tl V5730))) (and (cons? (tl (tl (tl V5730)))) (= () (tl (tl (tl (tl V5730)))))))))) (cons shen.app (cons (hd (tl V5730)) (cons (shen.insert-l V5729 (hd (tl (tl V5730)))) (tl (tl (tl V5730))))))) (true (shen.f_error shen.insert-l)))) +(defun shen.insert-l (V4568 V4569) (cond ((= "" V4569) "") ((and (shen.+string? V4569) (and (= "~" (pos V4569 0)) (and (shen.+string? (tlstr V4569)) (= "A" (pos (tlstr V4569) 0))))) (cons shen.app (cons V4568 (cons (tlstr (tlstr V4569)) (cons shen.a ()))))) ((and (shen.+string? V4569) (and (= "~" (pos V4569 0)) (and (shen.+string? (tlstr V4569)) (= "R" (pos (tlstr V4569) 0))))) (cons shen.app (cons V4568 (cons (tlstr (tlstr V4569)) (cons shen.r ()))))) ((and (shen.+string? V4569) (and (= "~" (pos V4569 0)) (and (shen.+string? (tlstr V4569)) (= "S" (pos (tlstr V4569) 0))))) (cons shen.app (cons V4568 (cons (tlstr (tlstr V4569)) (cons shen.s ()))))) ((shen.+string? V4569) (shen.factor-cn (cons cn (cons (pos V4569 0) (cons (shen.insert-l V4568 (tlstr V4569)) ()))))) ((and (cons? V4569) (and (= cn (hd V4569)) (and (cons? (tl V4569)) (and (cons? (tl (tl V4569))) (= () (tl (tl (tl V4569)))))))) (cons cn (cons (hd (tl V4569)) (cons (shen.insert-l V4568 (hd (tl (tl V4569)))) ())))) ((and (cons? V4569) (and (= shen.app (hd V4569)) (and (cons? (tl V4569)) (and (cons? (tl (tl V4569))) (and (cons? (tl (tl (tl V4569)))) (= () (tl (tl (tl (tl V4569)))))))))) (cons shen.app (cons (hd (tl V4569)) (cons (shen.insert-l V4568 (hd (tl (tl V4569)))) (tl (tl (tl V4569))))))) (true (shen.f_error shen.insert-l)))) -(defun shen.factor-cn (V5732) (cond ((and (cons? V5732) (and (= cn (hd V5732)) (and (cons? (tl V5732)) (and (cons? (tl (tl V5732))) (and (cons? (hd (tl (tl V5732)))) (and (= cn (hd (hd (tl (tl V5732))))) (and (cons? (tl (hd (tl (tl V5732))))) (and (cons? (tl (tl (hd (tl (tl V5732)))))) (and (= () (tl (tl (tl (hd (tl (tl V5732))))))) (and (= () (tl (tl (tl V5732)))) (and (string? (hd (tl V5732))) (string? (hd (tl (hd (tl (tl V5732))))))))))))))))) (cons cn (cons (cn (hd (tl V5732)) (hd (tl (hd (tl (tl V5732)))))) (tl (tl (hd (tl (tl V5732)))))))) (true V5732))) +(defun shen.factor-cn (V4571) (cond ((and (cons? V4571) (and (= cn (hd V4571)) (and (cons? (tl V4571)) (and (cons? (tl (tl V4571))) (and (cons? (hd (tl (tl V4571)))) (and (= cn (hd (hd (tl (tl V4571))))) (and (cons? (tl (hd (tl (tl V4571))))) (and (cons? (tl (tl (hd (tl (tl V4571)))))) (and (= () (tl (tl (tl (hd (tl (tl V4571))))))) (and (= () (tl (tl (tl V4571)))) (and (string? (hd (tl V4571))) (string? (hd (tl (hd (tl (tl V4571))))))))))))))))) (cons cn (cons (cn (hd (tl V4571)) (hd (tl (hd (tl (tl V4571)))))) (tl (tl (hd (tl (tl V4571)))))))) (true V4571))) -(defun shen.proc-nl (V5734) (cond ((= "" V5734) "") ((and (shen.+string? V5734) (and (= "~" (pos V5734 0)) (and (shen.+string? (tlstr V5734)) (= "%" (pos (tlstr V5734) 0))))) (cn (n->string 10) (shen.proc-nl (tlstr (tlstr V5734))))) ((shen.+string? V5734) (cn (pos V5734 0) (shen.proc-nl (tlstr V5734)))) (true (shen.f_error shen.proc-nl)))) +(defun shen.proc-nl (V4573) (cond ((= "" V4573) "") ((and (shen.+string? V4573) (and (= "~" (pos V4573 0)) (and (shen.+string? (tlstr V4573)) (= "%" (pos (tlstr V4573) 0))))) (cn (n->string 10) (shen.proc-nl (tlstr (tlstr V4573))))) ((shen.+string? V4573) (cn (pos V4573 0) (shen.proc-nl (tlstr V4573)))) (true (shen.f_error shen.proc-nl)))) -(defun shen.mkstr-r (V5737 V5738) (cond ((= () V5738) V5737) ((cons? V5738) (shen.mkstr-r (cons shen.insert (cons (hd V5738) (cons V5737 ()))) (tl V5738))) (true (shen.f_error shen.mkstr-r)))) +(defun shen.mkstr-r (V4576 V4577) (cond ((= () V4577) V4576) ((cons? V4577) (shen.mkstr-r (cons shen.insert (cons (hd V4577) (cons V4576 ()))) (tl V4577))) (true (shen.f_error shen.mkstr-r)))) -(defun shen.insert (V5741 V5742) (shen.insert-h V5741 V5742 "")) +(defun shen.insert (V4580 V4581) (shen.insert-h V4580 V4581 "")) -(defun shen.insert-h (V5748 V5749 V5750) (cond ((= "" V5749) V5750) ((and (shen.+string? V5749) (and (= "~" (pos V5749 0)) (and (shen.+string? (tlstr V5749)) (= "A" (pos (tlstr V5749) 0))))) (cn V5750 (shen.app V5748 (tlstr (tlstr V5749)) shen.a))) ((and (shen.+string? V5749) (and (= "~" (pos V5749 0)) (and (shen.+string? (tlstr V5749)) (= "R" (pos (tlstr V5749) 0))))) (cn V5750 (shen.app V5748 (tlstr (tlstr V5749)) shen.r))) ((and (shen.+string? V5749) (and (= "~" (pos V5749 0)) (and (shen.+string? (tlstr V5749)) (= "S" (pos (tlstr V5749) 0))))) (cn V5750 (shen.app V5748 (tlstr (tlstr V5749)) shen.s))) ((shen.+string? V5749) (shen.insert-h V5748 (tlstr V5749) (cn V5750 (pos V5749 0)))) (true (shen.f_error shen.insert-h)))) +(defun shen.insert-h (V4587 V4588 V4589) (cond ((= "" V4588) V4589) ((and (shen.+string? V4588) (and (= "~" (pos V4588 0)) (and (shen.+string? (tlstr V4588)) (= "A" (pos (tlstr V4588) 0))))) (cn V4589 (shen.app V4587 (tlstr (tlstr V4588)) shen.a))) ((and (shen.+string? V4588) (and (= "~" (pos V4588 0)) (and (shen.+string? (tlstr V4588)) (= "R" (pos (tlstr V4588) 0))))) (cn V4589 (shen.app V4587 (tlstr (tlstr V4588)) shen.r))) ((and (shen.+string? V4588) (and (= "~" (pos V4588 0)) (and (shen.+string? (tlstr V4588)) (= "S" (pos (tlstr V4588) 0))))) (cn V4589 (shen.app V4587 (tlstr (tlstr V4588)) shen.s))) ((shen.+string? V4588) (shen.insert-h V4587 (tlstr V4588) (cn V4589 (pos V4588 0)))) (true (shen.f_error shen.insert-h)))) -(defun shen.app (V5754 V5755 V5756) (cn (shen.arg->str V5754 V5756) V5755)) +(defun shen.app (V4593 V4594 V4595) (cn (shen.arg->str V4593 V4595) V4594)) -(defun shen.arg->str (V5764 V5765) (cond ((= V5764 (fail)) "...") ((shen.list? V5764) (shen.list->str V5764 V5765)) ((string? V5764) (shen.str->str V5764 V5765)) ((absvector? V5764) (shen.vector->str V5764 V5765)) (true (shen.atom->str V5764)))) +(defun shen.arg->str (V4603 V4604) (cond ((= V4603 (fail)) "...") ((shen.list? V4603) (shen.list->str V4603 V4604)) ((string? V4603) (shen.str->str V4603 V4604)) ((absvector? V4603) (shen.vector->str V4603 V4604)) (true (shen.atom->str V4603)))) -(defun shen.list->str (V5768 V5769) (cond ((= shen.r V5769) (@s "(" (@s (shen.iter-list V5768 shen.r (shen.maxseq)) ")"))) (true (@s "[" (@s (shen.iter-list V5768 V5769 (shen.maxseq)) "]"))))) +(defun shen.list->str (V4607 V4608) (cond ((= shen.r V4608) (@s "(" (@s (shen.iter-list V4607 shen.r (shen.maxseq)) ")"))) (true (@s "[" (@s (shen.iter-list V4607 V4608 (shen.maxseq)) "]"))))) (defun shen.maxseq () (value *maximum-print-sequence-size*)) -(defun shen.iter-list (V5783 V5784 V5785) (cond ((= () V5783) "") ((= 0 V5785) "... etc") ((and (cons? V5783) (= () (tl V5783))) (shen.arg->str (hd V5783) V5784)) ((cons? V5783) (@s (shen.arg->str (hd V5783) V5784) (@s " " (shen.iter-list (tl V5783) V5784 (- V5785 1))))) (true (@s "|" (@s " " (shen.arg->str V5783 V5784)))))) +(defun shen.iter-list (V4622 V4623 V4624) (cond ((= () V4622) "") ((= 0 V4624) "... etc") ((and (cons? V4622) (= () (tl V4622))) (shen.arg->str (hd V4622) V4623)) ((cons? V4622) (@s (shen.arg->str (hd V4622) V4623) (@s " " (shen.iter-list (tl V4622) V4623 (- V4624 1))))) (true (@s "|" (@s " " (shen.arg->str V4622 V4623)))))) -(defun shen.str->str (V5792 V5793) (cond ((= shen.a V5793) V5792) (true (@s (n->string 34) (@s V5792 (n->string 34)))))) +(defun shen.str->str (V4631 V4632) (cond ((= shen.a V4632) V4631) (true (@s (n->string 34) (@s V4631 (n->string 34)))))) -(defun shen.vector->str (V5796 V5797) (if (shen.print-vector? V5796) ((function (<-address V5796 0)) V5796) (if (vector? V5796) (@s "<" (@s (shen.iter-vector V5796 1 V5797 (shen.maxseq)) ">")) (@s "<" (@s "<" (@s (shen.iter-vector V5796 0 V5797 (shen.maxseq)) ">>")))))) +(defun shen.vector->str (V4635 V4636) (if (shen.print-vector? V4635) ((function (<-address V4635 0)) V4635) (if (vector? V4635) (@s "<" (@s (shen.iter-vector V4635 1 V4636 (shen.maxseq)) ">")) (@s "<" (@s "<" (@s (shen.iter-vector V4635 0 V4636 (shen.maxseq)) ">>")))))) -(defun shen.empty-absvector? (V5799) (= V5799 (value shen.*empty-absvector*))) +(defun shen.empty-absvector? (V4638) (= V4638 (value shen.*empty-absvector*))) -(defun shen.print-vector? (V5801) (and (not (shen.empty-absvector? V5801)) (let First (<-address V5801 0) (or (= First shen.tuple) (or (= First shen.pvar) (or (= First shen.dictionary) (and (not (number? First)) (shen.fbound? First)))))))) +(defun shen.print-vector? (V4640) (and (not (shen.empty-absvector? V4640)) (let First (<-address V4640 0) (or (= First shen.tuple) (or (= First shen.pvar) (or (= First shen.dictionary) (and (not (number? First)) (shen.fbound? First)))))))) -(defun shen.fbound? (V5803) (trap-error (do (shen.lookup-func V5803) true) (lambda E false))) +(defun shen.fbound? (V4642) (trap-error (do (shen.lookup-func V4642) true) (lambda E false))) -(defun shen.tuple (V5805) (cn "(@p " (shen.app (<-address V5805 1) (cn " " (shen.app (<-address V5805 2) ")" shen.s)) shen.s))) +(defun shen.tuple (V4644) (cn "(@p " (shen.app (<-address V4644 1) (cn " " (shen.app (<-address V4644 2) ")" shen.s)) shen.s))) -(defun shen.dictionary (V5807) "(dict ...)") +(defun shen.dictionary (V4646) "(dict ...)") -(defun shen.iter-vector (V5818 V5819 V5820 V5821) (cond ((= 0 V5821) "... etc") (true (let Item (trap-error (<-address V5818 V5819) (lambda E shen.out-of-bounds)) (let Next (trap-error (<-address V5818 (+ V5819 1)) (lambda E shen.out-of-bounds)) (if (= Item shen.out-of-bounds) "" (if (= Next shen.out-of-bounds) (shen.arg->str Item V5820) (@s (shen.arg->str Item V5820) (@s " " (shen.iter-vector V5818 (+ V5819 1) V5820 (- V5821 1))))))))))) +(defun shen.iter-vector (V4657 V4658 V4659 V4660) (cond ((= 0 V4660) "... etc") (true (let Item (trap-error (<-address V4657 V4658) (lambda E shen.out-of-bounds)) (let Next (trap-error (<-address V4657 (+ V4658 1)) (lambda E shen.out-of-bounds)) (if (= Item shen.out-of-bounds) "" (if (= Next shen.out-of-bounds) (shen.arg->str Item V4659) (@s (shen.arg->str Item V4659) (@s " " (shen.iter-vector V4657 (+ V4658 1) V4659 (- V4660 1))))))))))) -(defun shen.atom->str (V5823) (trap-error (str V5823) (lambda E (shen.funexstring)))) +(defun shen.atom->str (V4662) (trap-error (str V4662) (lambda E (shen.funexstring)))) (defun shen.funexstring () (@s "" (@s "f" (@s "u" (@s "n" (@s "e" (@s (shen.arg->str (gensym (intern "x")) shen.a) ""))))))) -(defun shen.list? (V5825) (or (empty? V5825) (cons? V5825))) +(defun shen.list? (V4664) (or (empty? V4664) (cons? V4664))) diff --git a/kl/yacc.kl b/kl/yacc.kl index 50ef381..f7e3437 100644 --- a/kl/yacc.kl +++ b/kl/yacc.kl @@ -28,69 +28,69 @@ OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. " -(defun shen.yacc (V5827) (cond ((and (cons? V5827) (and (= defcc (hd V5827)) (cons? (tl V5827)))) (shen.yacc->shen (hd (tl V5827)) (tl (tl V5827)))) (true (shen.f_error shen.yacc)))) +(defun shen.yacc (V4666) (cond ((and (cons? V4666) (and (= defcc (hd V4666)) (cons? (tl V4666)))) (shen.yacc->shen (hd (tl V4666)) (tl (tl V4666)))) (true (shen.f_error shen.yacc)))) -(defun shen.yacc->shen (V5830 V5831) (let CCRules (shen.split_cc_rules true V5831 ()) (let CCBody (map (lambda X (shen.cc_body X)) CCRules) (let YaccCases (shen.yacc_cases CCBody) (cons define (cons V5830 (cons Stream (cons -> (cons (shen.kill-code YaccCases) ()))))))))) +(defun shen.yacc->shen (V4669 V4670) (let CCRules (shen.split_cc_rules true V4670 ()) (let CCBody (map (lambda X (shen.cc_body X)) CCRules) (let YaccCases (shen.yacc_cases CCBody) (cons define (cons V4669 (cons Stream (cons -> (cons (shen.kill-code YaccCases) ()))))))))) -(defun shen.kill-code (V5833) (cond ((> (occurrences kill V5833) 0) (cons trap-error (cons V5833 (cons (cons lambda (cons E (cons (cons shen.analyse-kill (cons E ())) ()))) ())))) (true V5833))) +(defun shen.kill-code (V4672) (cond ((> (occurrences kill V4672) 0) (cons trap-error (cons V4672 (cons (cons lambda (cons E (cons (cons shen.analyse-kill (cons E ())) ()))) ())))) (true V4672))) (defun kill () (simple-error "yacc kill")) -(defun shen.analyse-kill (V5835) (let String (error-to-string V5835) (if (= String "yacc kill") (fail) V5835))) +(defun shen.analyse-kill (V4674) (let String (error-to-string V4674) (if (= String "yacc kill") (fail) V4674))) -(defun shen.split_cc_rules (V5841 V5842 V5843) (cond ((and (= () V5842) (= () V5843)) ()) ((= () V5842) (cons (shen.split_cc_rule V5841 (reverse V5843) ()) ())) ((and (cons? V5842) (= ; (hd V5842))) (cons (shen.split_cc_rule V5841 (reverse V5843) ()) (shen.split_cc_rules V5841 (tl V5842) ()))) ((cons? V5842) (shen.split_cc_rules V5841 (tl V5842) (cons (hd V5842) V5843))) (true (shen.f_error shen.split_cc_rules)))) +(defun shen.split_cc_rules (V4680 V4681 V4682) (cond ((and (= () V4681) (= () V4682)) ()) ((= () V4681) (cons (shen.split_cc_rule V4680 (reverse V4682) ()) ())) ((and (cons? V4681) (= ; (hd V4681))) (cons (shen.split_cc_rule V4680 (reverse V4682) ()) (shen.split_cc_rules V4680 (tl V4681) ()))) ((cons? V4681) (shen.split_cc_rules V4680 (tl V4681) (cons (hd V4681) V4682))) (true (shen.f_error shen.split_cc_rules)))) -(defun shen.split_cc_rule (V5851 V5852 V5853) (cond ((and (cons? V5852) (and (= := (hd V5852)) (and (cons? (tl V5852)) (= () (tl (tl V5852)))))) (cons (reverse V5853) (tl V5852))) ((and (cons? V5852) (and (= := (hd V5852)) (and (cons? (tl V5852)) (and (cons? (tl (tl V5852))) (and (= where (hd (tl (tl V5852)))) (and (cons? (tl (tl (tl V5852)))) (= () (tl (tl (tl (tl V5852))))))))))) (cons (reverse V5853) (cons (cons where (cons (hd (tl (tl (tl V5852)))) (cons (hd (tl V5852)) ()))) ()))) ((= () V5852) (do (shen.semantic-completion-warning V5851 V5853) (shen.split_cc_rule V5851 (cons := (cons (shen.default_semantics (reverse V5853)) ())) V5853))) ((cons? V5852) (shen.split_cc_rule V5851 (tl V5852) (cons (hd V5852) V5853))) (true (shen.f_error shen.split_cc_rule)))) +(defun shen.split_cc_rule (V4690 V4691 V4692) (cond ((and (cons? V4691) (and (= := (hd V4691)) (and (cons? (tl V4691)) (= () (tl (tl V4691)))))) (cons (reverse V4692) (tl V4691))) ((and (cons? V4691) (and (= := (hd V4691)) (and (cons? (tl V4691)) (and (cons? (tl (tl V4691))) (and (= where (hd (tl (tl V4691)))) (and (cons? (tl (tl (tl V4691)))) (= () (tl (tl (tl (tl V4691))))))))))) (cons (reverse V4692) (cons (cons where (cons (hd (tl (tl (tl V4691)))) (cons (hd (tl V4691)) ()))) ()))) ((= () V4691) (do (shen.semantic-completion-warning V4690 V4692) (shen.split_cc_rule V4690 (cons := (cons (shen.default_semantics (reverse V4692)) ())) V4692))) ((cons? V4691) (shen.split_cc_rule V4690 (tl V4691) (cons (hd V4691) V4692))) (true (shen.f_error shen.split_cc_rule)))) -(defun shen.semantic-completion-warning (V5864 V5865) (cond ((= true V5864) (do (shen.prhush "warning: " (stoutput)) (do (shen.for-each (lambda X (shen.prhush (shen.app X " " shen.a) (stoutput))) (reverse V5865)) (shen.prhush "has no semantics. +(defun shen.semantic-completion-warning (V4703 V4704) (cond ((= true V4703) (do (shen.prhush "warning: " (stoutput)) (do (shen.for-each (lambda X (shen.prhush (shen.app X " " shen.a) (stoutput))) (reverse V4704)) (shen.prhush "has no semantics. " (stoutput))))) (true shen.skip))) -(defun shen.default_semantics (V5867) (cond ((= () V5867) ()) ((and (cons? V5867) (and (= () (tl V5867)) (shen.grammar_symbol? (hd V5867)))) (hd V5867)) ((and (cons? V5867) (shen.grammar_symbol? (hd V5867))) (cons append (cons (hd V5867) (cons (shen.default_semantics (tl V5867)) ())))) ((cons? V5867) (cons cons (cons (hd V5867) (cons (shen.default_semantics (tl V5867)) ())))) (true (shen.f_error shen.default_semantics)))) +(defun shen.default_semantics (V4706) (cond ((= () V4706) ()) ((and (cons? V4706) (and (= () (tl V4706)) (shen.grammar_symbol? (hd V4706)))) (hd V4706)) ((and (cons? V4706) (shen.grammar_symbol? (hd V4706))) (cons append (cons (hd V4706) (cons (shen.default_semantics (tl V4706)) ())))) ((cons? V4706) (cons cons (cons (hd V4706) (cons (shen.default_semantics (tl V4706)) ())))) (true (shen.f_error shen.default_semantics)))) -(defun shen.grammar_symbol? (V5869) (and (symbol? V5869) (let Cs (shen.strip-pathname (explode V5869)) (and (= (hd Cs) "<") (= (hd (reverse Cs)) ">"))))) +(defun shen.grammar_symbol? (V4708) (and (symbol? V4708) (let Cs (shen.strip-pathname (explode V4708)) (and (= (hd Cs) "<") (= (hd (reverse Cs)) ">"))))) -(defun shen.yacc_cases (V5871) (cond ((and (cons? V5871) (= () (tl V5871))) (hd V5871)) ((cons? V5871) (let P YaccParse (cons let (cons P (cons (hd V5871) (cons (cons if (cons (cons = (cons P (cons (cons fail ()) ()))) (cons (shen.yacc_cases (tl V5871)) (cons P ())))) ())))))) (true (shen.f_error shen.yacc_cases)))) +(defun shen.yacc_cases (V4710) (cond ((and (cons? V4710) (= () (tl V4710))) (hd V4710)) ((cons? V4710) (let P YaccParse (cons let (cons P (cons (hd V4710) (cons (cons if (cons (cons = (cons P (cons (cons fail ()) ()))) (cons (shen.yacc_cases (tl V4710)) (cons P ())))) ())))))) (true (shen.f_error shen.yacc_cases)))) -(defun shen.cc_body (V5873) (cond ((and (cons? V5873) (and (cons? (tl V5873)) (= () (tl (tl V5873))))) (shen.syntax (hd V5873) Stream (hd (tl V5873)))) (true (shen.f_error shen.cc_body)))) +(defun shen.cc_body (V4712) (cond ((and (cons? V4712) (and (cons? (tl V4712)) (= () (tl (tl V4712))))) (shen.syntax (hd V4712) Stream (hd (tl V4712)))) (true (shen.f_error shen.cc_body)))) -(defun shen.syntax (V5877 V5878 V5879) (cond ((and (= () V5877) (and (cons? V5879) (and (= where (hd V5879)) (and (cons? (tl V5879)) (and (cons? (tl (tl V5879))) (= () (tl (tl (tl V5879))))))))) (cons if (cons (shen.semantics (hd (tl V5879))) (cons (cons shen.pair (cons (cons hd (cons V5878 ())) (cons (shen.semantics (hd (tl (tl V5879)))) ()))) (cons (cons fail ()) ()))))) ((= () V5877) (cons shen.pair (cons (cons hd (cons V5878 ())) (cons (shen.semantics V5879) ())))) ((cons? V5877) (if (shen.grammar_symbol? (hd V5877)) (shen.recursive_descent V5877 V5878 V5879) (if (variable? (hd V5877)) (shen.variable-match V5877 V5878 V5879) (if (shen.jump_stream? (hd V5877)) (shen.jump_stream V5877 V5878 V5879) (if (shen.terminal? (hd V5877)) (shen.check_stream V5877 V5878 V5879) (if (cons? (hd V5877)) (shen.list-stream (shen.decons (hd V5877)) (tl V5877) V5878 V5879) (simple-error (shen.app (hd V5877) " is not legal syntax +(defun shen.syntax (V4716 V4717 V4718) (cond ((and (= () V4716) (and (cons? V4718) (and (= where (hd V4718)) (and (cons? (tl V4718)) (and (cons? (tl (tl V4718))) (= () (tl (tl (tl V4718))))))))) (cons if (cons (shen.semantics (hd (tl V4718))) (cons (cons shen.pair (cons (cons hd (cons V4717 ())) (cons (shen.semantics (hd (tl (tl V4718)))) ()))) (cons (cons fail ()) ()))))) ((= () V4716) (cons shen.pair (cons (cons hd (cons V4717 ())) (cons (shen.semantics V4718) ())))) ((cons? V4716) (if (shen.grammar_symbol? (hd V4716)) (shen.recursive_descent V4716 V4717 V4718) (if (variable? (hd V4716)) (shen.variable-match V4716 V4717 V4718) (if (shen.jump_stream? (hd V4716)) (shen.jump_stream V4716 V4717 V4718) (if (shen.terminal? (hd V4716)) (shen.check_stream V4716 V4717 V4718) (if (cons? (hd V4716)) (shen.list-stream (shen.decons (hd V4716)) (tl V4716) V4717 V4718) (simple-error (shen.app (hd V4716) " is not legal syntax " shen.a)))))))) (true (shen.f_error shen.syntax)))) -(defun shen.list-stream (V5884 V5885 V5886 V5887) (let Test (cons and (cons (cons cons? (cons (cons hd (cons V5886 ())) ())) (cons (cons cons? (cons (cons shen.hdhd (cons V5886 ())) ())) ()))) (let Placeholder (gensym shen.place) (let RunOn (shen.syntax V5885 (cons shen.pair (cons (cons shen.tlhd (cons V5886 ())) (cons (cons shen.hdtl (cons V5886 ())) ()))) V5887) (let Action (shen.insert-runon RunOn Placeholder (shen.syntax V5884 (cons shen.pair (cons (cons shen.hdhd (cons V5886 ())) (cons (cons shen.hdtl (cons V5886 ())) ()))) Placeholder)) (cons if (cons Test (cons Action (cons (cons fail ()) ()))))))))) +(defun shen.list-stream (V4723 V4724 V4725 V4726) (let Test (cons and (cons (cons cons? (cons (cons hd (cons V4725 ())) ())) (cons (cons cons? (cons (cons shen.hdhd (cons V4725 ())) ())) ()))) (let Placeholder (gensym shen.place) (let RunOn (shen.syntax V4724 (cons shen.pair (cons (cons shen.tlhd (cons V4725 ())) (cons (cons shen.hdtl (cons V4725 ())) ()))) V4726) (let Action (shen.insert-runon RunOn Placeholder (shen.syntax V4723 (cons shen.pair (cons (cons shen.hdhd (cons V4725 ())) (cons (cons shen.hdtl (cons V4725 ())) ()))) Placeholder)) (cons if (cons Test (cons Action (cons (cons fail ()) ()))))))))) -(defun shen.decons (V5889) (cond ((and (cons? V5889) (and (= cons (hd V5889)) (and (cons? (tl V5889)) (and (cons? (tl (tl V5889))) (and (= () (hd (tl (tl V5889)))) (= () (tl (tl (tl V5889))))))))) (cons (hd (tl V5889)) ())) ((and (cons? V5889) (and (= cons (hd V5889)) (and (cons? (tl V5889)) (and (cons? (tl (tl V5889))) (= () (tl (tl (tl V5889)))))))) (cons (hd (tl V5889)) (shen.decons (hd (tl (tl V5889)))))) (true V5889))) +(defun shen.decons (V4728) (cond ((and (cons? V4728) (and (= cons (hd V4728)) (and (cons? (tl V4728)) (and (cons? (tl (tl V4728))) (and (= () (hd (tl (tl V4728)))) (= () (tl (tl (tl V4728))))))))) (cons (hd (tl V4728)) ())) ((and (cons? V4728) (and (= cons (hd V4728)) (and (cons? (tl V4728)) (and (cons? (tl (tl V4728))) (= () (tl (tl (tl V4728)))))))) (cons (hd (tl V4728)) (shen.decons (hd (tl (tl V4728)))))) (true V4728))) -(defun shen.insert-runon (V5904 V5905 V5906) (cond ((and (cons? V5906) (and (= shen.pair (hd V5906)) (and (cons? (tl V5906)) (and (cons? (tl (tl V5906))) (and (= () (tl (tl (tl V5906)))) (= (hd (tl (tl V5906))) V5905)))))) V5904) ((cons? V5906) (map (lambda Z (shen.insert-runon V5904 V5905 Z)) V5906)) (true V5906))) +(defun shen.insert-runon (V4743 V4744 V4745) (cond ((and (cons? V4745) (and (= shen.pair (hd V4745)) (and (cons? (tl V4745)) (and (cons? (tl (tl V4745))) (and (= () (tl (tl (tl V4745)))) (= (hd (tl (tl V4745))) V4744)))))) V4743) ((cons? V4745) (map (lambda Z (shen.insert-runon V4743 V4744 Z)) V4745)) (true V4745))) -(defun shen.strip-pathname (V5912) (cond ((not (element? "." V5912)) V5912) ((cons? V5912) (shen.strip-pathname (tl V5912))) (true (shen.f_error shen.strip-pathname)))) +(defun shen.strip-pathname (V4751) (cond ((not (element? "." V4751)) V4751) ((cons? V4751) (shen.strip-pathname (tl V4751))) (true (shen.f_error shen.strip-pathname)))) -(defun shen.recursive_descent (V5916 V5917 V5918) (cond ((cons? V5916) (let Test (cons (hd V5916) (cons V5917 ())) (let Action (shen.syntax (tl V5916) (concat Parse_ (hd V5916)) V5918) (let Else (cons fail ()) (cons let (cons (concat Parse_ (hd V5916)) (cons Test (cons (cons if (cons (cons not (cons (cons = (cons (cons fail ()) (cons (concat Parse_ (hd V5916)) ()))) ())) (cons Action (cons Else ())))) ())))))))) (true (shen.f_error shen.recursive_descent)))) +(defun shen.recursive_descent (V4755 V4756 V4757) (cond ((cons? V4755) (let Test (cons (hd V4755) (cons V4756 ())) (let Action (shen.syntax (tl V4755) (concat Parse_ (hd V4755)) V4757) (let Else (cons fail ()) (cons let (cons (concat Parse_ (hd V4755)) (cons Test (cons (cons if (cons (cons not (cons (cons = (cons (cons fail ()) (cons (concat Parse_ (hd V4755)) ()))) ())) (cons Action (cons Else ())))) ())))))))) (true (shen.f_error shen.recursive_descent)))) -(defun shen.variable-match (V5922 V5923 V5924) (cond ((cons? V5922) (let Test (cons cons? (cons (cons hd (cons V5923 ())) ())) (let Action (cons let (cons (concat Parse_ (hd V5922)) (cons (cons shen.hdhd (cons V5923 ())) (cons (shen.syntax (tl V5922) (cons shen.pair (cons (cons shen.tlhd (cons V5923 ())) (cons (cons shen.hdtl (cons V5923 ())) ()))) V5924) ())))) (let Else (cons fail ()) (cons if (cons Test (cons Action (cons Else ())))))))) (true (shen.f_error shen.variable-match)))) +(defun shen.variable-match (V4761 V4762 V4763) (cond ((cons? V4761) (let Test (cons cons? (cons (cons hd (cons V4762 ())) ())) (let Action (cons let (cons (concat Parse_ (hd V4761)) (cons (cons shen.hdhd (cons V4762 ())) (cons (shen.syntax (tl V4761) (cons shen.pair (cons (cons shen.tlhd (cons V4762 ())) (cons (cons shen.hdtl (cons V4762 ())) ()))) V4763) ())))) (let Else (cons fail ()) (cons if (cons Test (cons Action (cons Else ())))))))) (true (shen.f_error shen.variable-match)))) -(defun shen.terminal? (V5934) (cond ((cons? V5934) false) ((variable? V5934) false) (true true))) +(defun shen.terminal? (V4773) (cond ((cons? V4773) false) ((variable? V4773) false) (true true))) -(defun shen.jump_stream? (V5940) (cond ((= V5940 _) true) (true false))) +(defun shen.jump_stream? (V4779) (cond ((= V4779 _) true) (true false))) -(defun shen.check_stream (V5944 V5945 V5946) (cond ((cons? V5944) (let Test (cons and (cons (cons cons? (cons (cons hd (cons V5945 ())) ())) (cons (cons = (cons (hd V5944) (cons (cons shen.hdhd (cons V5945 ())) ()))) ()))) (let NewStr (gensym NewStream) (let Action (cons let (cons NewStr (cons (cons shen.pair (cons (cons shen.tlhd (cons V5945 ())) (cons (cons shen.hdtl (cons V5945 ())) ()))) (cons (shen.syntax (tl V5944) NewStr V5946) ())))) (let Else (cons fail ()) (cons if (cons Test (cons Action (cons Else ()))))))))) (true (shen.f_error shen.check_stream)))) +(defun shen.check_stream (V4783 V4784 V4785) (cond ((cons? V4783) (let Test (cons and (cons (cons cons? (cons (cons hd (cons V4784 ())) ())) (cons (cons = (cons (hd V4783) (cons (cons shen.hdhd (cons V4784 ())) ()))) ()))) (let NewStr (gensym NewStream) (let Action (cons let (cons NewStr (cons (cons shen.pair (cons (cons shen.tlhd (cons V4784 ())) (cons (cons shen.hdtl (cons V4784 ())) ()))) (cons (shen.syntax (tl V4783) NewStr V4785) ())))) (let Else (cons fail ()) (cons if (cons Test (cons Action (cons Else ()))))))))) (true (shen.f_error shen.check_stream)))) -(defun shen.jump_stream (V5950 V5951 V5952) (cond ((cons? V5950) (let Test (cons cons? (cons (cons hd (cons V5951 ())) ())) (let Action (shen.syntax (tl V5950) (cons shen.pair (cons (cons shen.tlhd (cons V5951 ())) (cons (cons shen.hdtl (cons V5951 ())) ()))) V5952) (let Else (cons fail ()) (cons if (cons Test (cons Action (cons Else ())))))))) (true (shen.f_error shen.jump_stream)))) +(defun shen.jump_stream (V4789 V4790 V4791) (cond ((cons? V4789) (let Test (cons cons? (cons (cons hd (cons V4790 ())) ())) (let Action (shen.syntax (tl V4789) (cons shen.pair (cons (cons shen.tlhd (cons V4790 ())) (cons (cons shen.hdtl (cons V4790 ())) ()))) V4791) (let Else (cons fail ()) (cons if (cons Test (cons Action (cons Else ())))))))) (true (shen.f_error shen.jump_stream)))) -(defun shen.semantics (V5954) (cond ((= () V5954) ()) ((shen.grammar_symbol? V5954) (cons shen.hdtl (cons (concat Parse_ V5954) ()))) ((variable? V5954) (concat Parse_ V5954)) ((cons? V5954) (map (lambda Z (shen.semantics Z)) V5954)) (true V5954))) +(defun shen.semantics (V4793) (cond ((= () V4793) ()) ((shen.grammar_symbol? V4793) (cons shen.hdtl (cons (concat Parse_ V4793) ()))) ((variable? V4793) (concat Parse_ V4793)) ((cons? V4793) (map (lambda Z (shen.semantics Z)) V4793)) (true V4793))) -(defun shen.pair (V5957 V5958) (cons V5957 (cons V5958 ()))) +(defun shen.pair (V4796 V4797) (cons V4796 (cons V4797 ()))) -(defun shen.hdtl (V5960) (hd (tl V5960))) +(defun shen.hdtl (V4799) (hd (tl V4799))) -(defun shen.hdhd (V5962) (hd (hd V5962))) +(defun shen.hdhd (V4801) (hd (hd V4801))) -(defun shen.tlhd (V5964) (tl (hd V5964))) +(defun shen.tlhd (V4803) (tl (hd V4803))) -(defun shen.snd-or-fail (V5972) (cond ((and (cons? V5972) (and (cons? (tl V5972)) (= () (tl (tl V5972))))) (hd (tl V5972))) (true (fail)))) +(defun shen.snd-or-fail (V4811) (cond ((and (cons? V4811) (and (cons? (tl V4811)) (= () (tl (tl V4811))))) (hd (tl V4811))) (true (fail)))) -(defun fail () shen.fail!)(defun (V5980) (cond ((and (cons? V5980) (and (cons? (tl V5980)) (= () (tl (tl V5980))))) (cons () (cons (hd V5980) ()))) (true (fail)))) +(defun fail () shen.fail!)(defun (V4819) (cond ((and (cons? V4819) (and (cons? (tl V4819)) (= () (tl (tl V4819))))) (cons () (cons (hd V4819) ()))) (true (fail)))) -(defun (V5986) (cond ((and (cons? V5986) (and (cons? (tl V5986)) (= () (tl (tl V5986))))) (cons (hd V5986) (cons () ()))) (true (shen.f_error )))) +(defun (V4825) (cond ((and (cons? V4825) (and (cons? (tl V4825)) (= () (tl (tl V4825))))) (cons (hd V4825) (cons () ()))) (true (shen.f_error )))) diff --git a/shen-lib.ms b/shen-lib.ms index fddd6ec..1d8747c 100644 --- a/shen-lib.ms +++ b/shen-lib.ms @@ -21,4 +21,5 @@ (import "compiled/init.kl") (import "compiled/extension-features.kl") (import "compiled/extension-launcher.kl") - +(import "compiled/extension-factorise-defun.kl") +(import "compiled/extension-programmable-pattern-matching.kl")