"Copyright (c) 2015, Mark Tarver\n\nAll rights reserved.\n\nRedistribution and use in source and binary forms, with or without\nmodification, are permitted provided that the following conditions are met:\n1. Redistributions of source code must retain the above copyright\n notice, this list of conditions and the following disclaimer.\n2. Redistributions in binary form must reproduce the above copyright\n notice, this list of conditions and the following disclaimer in the\n documentation and/or other materials provided with the distribution.\n3. The name of Mark Tarver may not be used to endorse or promote products\n derived from this software without specific prior written permission.\n\nTHIS SOFTWARE IS PROVIDED BY Mark Tarver ''AS IS'' AND ANY\nEXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED\nWARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE\nDISCLAIMED. IN NO EVENT SHALL Mark Tarver BE LIABLE FOR ANY\nDIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES\n(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;\nLOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND\nON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT\n(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS\nSOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE." (kl:set (quote shen.*installing-kl*) #f) (kl:set (quote shen.*history*) (quote ())) (kl:set (quote shen.*tc*) #f) (kl:set (quote *property-vector*) (kl:shen.dict 20000)) (kl:set (quote shen.*process-counter*) 0) (kl:set (quote shen.*varcounter*) (kl:vector 10000)) (kl:set (quote shen.*prologvectors*) (kl:vector 10000)) (kl:set (quote shen.*demodulation-function*) (lambda (X) X)) (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._scheme_at_s-macro) (cons (quote shen.defprolog-macro) (cons (quote shen.function-macro) (quote ())))))))))))))))))))) (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._scheme_at_s-macro X)) (cons (lambda (X) (kl:shen.defprolog-macro X)) (cons (lambda (X) (kl:shen.function-macro X)) (quote ())))))))))))))))))))) (kl:set (quote shen.*gensym*) 0) (kl:set (quote shen.*tracking*) (quote ())) (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 ())))))))))))))))))))))))))))) (kl:set (quote shen.*special*) (cons (quote _scheme_at_p) (cons (quote _scheme_at_s) (cons (quote _scheme_at_v) (cons (quote cons) (cons (quote lambda) (cons (quote let) (cons (quote where) (cons (quote set) (cons (quote open) (quote ()))))))))))) (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 ())))))))) (kl:set (quote shen.*spy*) #f) (kl:set (quote shen.*datatypes*) (quote ())) (kl:set (quote shen.*alldatatypes*) (quote ())) (kl:set (quote shen.*shen-type-theory-enabled?*) #t) (kl:set (quote shen.*synonyms*) (quote ())) (kl:set (quote shen.*system*) (quote ())) (kl:set (quote shen.*signedfuncs*) (quote ())) (kl:set (quote shen.*maxcomplexity*) 128) (kl:set (quote shen.*occurs*) #t) (kl:set (quote shen.*maxinferences*) 1000000) (kl:set (quote *maximum-print-sequence-size*) 20) (kl:set (quote shen.*catch*) 0) (kl:set (quote shen.*call*) 0) (kl:set (quote shen.*infs*) 0) (kl:set (quote *hush*) #f) (kl:set (quote shen.*optimise*) #f) (kl:set (quote *version*) "Shen 21.1") (if (kl:not (kl:bound? (quote *home-directory*))) (kl:set (quote *home-directory*) "") (quote shen.skip)) (if (kl:not (kl:bound? (quote *sterror*))) (kl:set (quote *sterror*) (kl:value (quote *stoutput*))) (quote shen.skip)) (begin (register-function-arity (quote shen.initialise_arity_table) 1) (define (kl:shen.initialise_arity_table V1472) (cond ((null? V1472) (quote ())) ((and (pair? V1472) (pair? (cdr V1472))) (let ((DecArity (kl:put (car V1472) (quote arity) (car (cdr V1472)) (kl:value (quote *property-vector*))))) (kl:shen.initialise_arity_table (cdr (cdr V1472))))) (#t (kl:shen.f_error (quote shen.initialise_arity_table))))) (quote shen.initialise_arity_table)) (begin (register-function-arity (quote arity) 1) (define (kl:arity V1474) (guard (lambda (E) -1) (lambda () (kl:get V1474 (quote arity) (kl:value (quote *property-vector*)))))) (quote arity)) (kl:shen.initialise_arity_table (cons (quote abort) (cons 0 (cons (quote absvector?) (cons 1 (cons (quote absvector) (cons 1 (cons (quote adjoin) (cons 2 (cons (quote and) (cons 2 (cons (quote append) (cons 2 (cons (quote arity) (cons 1 (cons (quote assoc) (cons 2 (cons (quote boolean?) (cons 1 (cons (quote bound?) (cons 1 (cons (quote cd) (cons 1 (cons (quote close) (cons 1 (cons (quote compile) (cons 3 (cons (quote concat) (cons 2 (cons (quote cons) (cons 2 (cons (quote cons?) (cons 1 (cons (quote cn) (cons 2 (cons (quote declare) (cons 2 (cons (quote destroy) (cons 1 (cons (quote difference) (cons 2 (cons (quote do) (cons 2 (cons (quote element?) (cons 2 (cons (quote empty?) (cons 1 (cons (quote enable-type-theory) (cons 1 (cons (quote error-to-string) (cons 1 (cons (quote shen.interror) (cons 2 (cons (quote eval) (cons 1 (cons (quote eval-kl) (cons 1 (cons (quote explode) (cons 1 (cons (quote external) (cons 1 (cons (quote fail-if) (cons 2 (cons (quote fail) (cons 0 (cons (quote fix) (cons 2 (cons (quote findall) (cons 5 (cons (quote freeze) (cons 1 (cons (quote fst) (cons 1 (cons (quote gensym) (cons 1 (cons (quote get) (cons 3 (cons (quote get-time) (cons 1 (cons (quote address->) (cons 3 (cons (quote <-address) (cons 2 (cons (quote <-vector) (cons 2 (cons (quote >) (cons 2 (cons (quote >=) (cons 2 (cons (quote =) (cons 2 (cons (quote hash) (cons 2 (cons (quote hd) (cons 1 (cons (quote hdv) (cons 1 (cons (quote hdstr) (cons 1 (cons (quote head) (cons 1 (cons (quote if) (cons 3 (cons (quote integer?) (cons 1 (cons (quote intern) (cons 1 (cons (quote identical) (cons 4 (cons (quote inferences) (cons 0 (cons (quote input) (cons 1 (cons (quote input+) (cons 2 (cons (quote implementation) (cons 0 (cons (quote intersection) (cons 2 (cons (quote internal) (cons 1 (cons (quote it) (cons 0 (cons (quote kill) (cons 0 (cons (quote language) (cons 0 (cons (quote length) (cons 1 (cons (quote limit) (cons 1 (cons (quote lineread) (cons 1 (cons (quote load) (cons 1 (cons (quote <) (cons 2 (cons (quote <=) (cons 2 (cons (quote vector) (cons 1 (cons (quote macroexpand) (cons 1 (cons (quote map) (cons 2 (cons (quote mapcan) (cons 2 (cons (quote maxinferences) (cons 1 (cons (quote nl) (cons 1 (cons (quote not) (cons 1 (cons (quote nth) (cons 2 (cons (quote n->string) (cons 1 (cons (quote number?) (cons 1 (cons (quote occurs-check) (cons 1 (cons (quote occurrences) (cons 2 (cons (quote occurs-check) (cons 1 (cons (quote open) (cons 2 (cons (quote optimise) (cons 1 (cons (quote or) (cons 2 (cons (quote os) (cons 0 (cons (quote package) (cons 3 (cons (quote package?) (cons 1 (cons (quote port) (cons 0 (cons (quote porters) (cons 0 (cons (quote pos) (cons 2 (cons (quote print) (cons 1 (cons (quote profile) (cons 1 (cons (quote profile-results) (cons 1 (cons (quote pr) (cons 2 (cons (quote ps) (cons 1 (cons (quote preclude) (cons 1 (cons (quote preclude-all-but) (cons 1 (cons (quote protect) (cons 1 (cons (quote address->) (cons 3 (cons (quote put) (cons 4 (cons (quote shen.reassemble) (cons 2 (cons (quote read-file-as-string) (cons 1 (cons (quote read-file) (cons 1 (cons (quote read-file-as-bytelist) (cons 1 (cons (quote read) (cons 1 (cons (quote read-byte) (cons 1 (cons (quote read-from-string) (cons 1 (cons (quote receive) (cons 1 (cons (quote release) (cons 0 (cons (quote remove) (cons 2 (cons (quote shen.require) (cons 3 (cons (quote reverse) (cons 1 (cons (quote set) (cons 2 (cons (quote simple-error) (cons 1 (cons (quote snd) (cons 1 (cons (quote specialise) (cons 1 (cons (quote spy) (cons 1 (cons (quote step) (cons 1 (cons (quote stinput) (cons 0 (cons (quote stoutput) (cons 0 (cons (quote sterror) (cons 0 (cons (quote string->n) (cons 1 (cons (quote string->symbol) (cons 1 (cons (quote string?) (cons 1 (cons (quote str) (cons 1 (cons (quote subst) (cons 3 (cons (quote sum) (cons 1 (cons (quote symbol?) (cons 1 (cons (quote systemf) (cons 1 (cons (quote tail) (cons 1 (cons (quote tl) (cons 1 (cons (quote tc) (cons 1 (cons (quote tc?) (cons 0 (cons (quote thaw) (cons 1 (cons (quote tlstr) (cons 1 (cons (quote track) (cons 1 (cons (quote trap-error) (cons 2 (cons (quote tuple?) (cons 1 (cons (quote type) (cons 2 (cons (quote return) (cons 3 (cons (quote undefmacro) (cons 1 (cons (quote unput) (cons 3 (cons (quote unprofile) (cons 1 (cons (quote unify) (cons 4 (cons (quote unify!) (cons 4 (cons (quote union) (cons 2 (cons (quote untrack) (cons 1 (cons (quote unspecialise) (cons 1 (cons (quote undefmacro) (cons 1 (cons (quote vector) (cons 1 (cons (quote vector?) (cons 1 (cons (quote vector->) (cons 3 (cons (quote value) (cons 1 (cons (quote variable?) (cons 1 (cons (quote version) (cons 0 (cons (quote write-byte) (cons 2 (cons (quote write-to-file) (cons 2 (cons (quote y-or-n?) (cons 1 (cons (quote +) (cons 2 (cons (quote *) (cons 2 (cons (quote /) (cons 2 (cons (quote -) (cons 2 (cons (quote ==) (cons 2 (cons (quote ) (cons 1 (cons (quote ) (cons 1 (cons (quote _scheme_at_p) (cons 2 (cons (quote _scheme_at_v) (cons 2 (cons (quote _scheme_at_s) (cons 2 (cons (quote preclude) (cons 1 (cons (quote include) (cons 1 (cons (quote preclude-all-but) (cons 1 (cons (quote include-all-but) (cons 1 (quote ())))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) (begin (register-function-arity (quote systemf) 1) (define (kl:systemf V1476) (let ((Shen (kl:intern "shen"))) (let ((External (kl:get Shen (quote shen.external-symbols) (kl:value (quote *property-vector*))))) (let ((Place (kl:put Shen (quote shen.external-symbols) (kl:adjoin V1476 External) (kl:value (quote *property-vector*))))) V1476)))) (quote systemf)) (begin (register-function-arity (quote adjoin) 2) (define (kl:adjoin V1479 V1480) (if (kl:element? V1479 V1480) V1480 (cons V1479 V1480))) (quote adjoin)) (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 _scheme_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 _scheme_at_v) (cons (quote _scheme_at_p) (cons (quote _scheme_at_s) (cons (quote <-) (cons (quote ->) (cons (quote ) (cons (quote ) (cons (quote ==) (cons (quote =) (cons (quote >=) (cons (quote >) (cons (quote /.) (cons (quote =!) (cons (quote _scheme_dl_) (cons (quote -) (cons (quote /) (cons (quote *) (cons (quote +) (cons (quote <=) (cons (quote <) (cons (quote >>) (cons (kl:vector 0) (cons (quote y-or-n?) (cons (quote write-to-file) (cons (quote write-byte) (cons (quote where) (cons (quote when) (cons (quote warn) (cons (quote version) (cons (quote verified) (cons (quote variable?) (cons (quote value) (cons (quote vector->) (cons (quote <-vector) (cons (quote vector) (cons (quote vector?) (cons (quote unspecialise) (cons (quote untrack) (cons (quote unit) (cons (quote shen.unix) (cons (quote union) (cons (quote unify) (cons (quote unify!) (cons (quote unput) (cons (quote unprofile) (cons (quote undefmacro) (cons (quote return) (cons (quote type) (cons (quote tuple?) (cons #t (cons (quote trap-error) (cons (quote track) (cons (quote time) (cons (quote thaw) (cons (quote tc?) (cons (quote tc) (cons (quote tl) (cons (quote tlstr) (cons (quote tlv) (cons (quote tail) (cons (quote systemf) (cons (quote synonyms) (cons (quote symbol) (cons (quote symbol?) (cons (quote string->symbol) (cons (quote sum) (cons (quote subst) (cons (quote string?) (cons (quote string->n) (cons (quote stream) (cons (quote string) (cons (quote stinput) (cons (quote sterror) (cons (quote stoutput) (cons (quote step) (cons (quote spy) (cons (quote specialise) (cons (quote snd) (cons (quote simple-error) (cons (quote set) (cons (quote save) (cons (quote str) (cons (quote run) (cons (quote reverse) (cons (quote remove) (cons (quote release) (cons (quote read) (cons (quote receive) (cons (quote read-file) (cons (quote read-file-as-bytelist) (cons (quote read-file-as-string) (cons (quote read-byte) (cons (quote read-from-string) (cons (quote package?) (cons (quote put) (cons (quote preclude) (cons (quote preclude-all-but) (cons (quote ps) (cons (quote prolog?) (cons (quote protect) (cons (quote profile-results) (cons (quote profile) (cons (quote print) (cons (quote pr) (cons (quote pos) (cons (quote porters) (cons (quote port) (cons (quote package) (cons (quote output) (cons (quote out) (cons (quote os) (cons (quote or) (cons (quote optimise) (cons (quote open) (cons (quote occurrences) (cons (quote occurs-check) (cons (quote n->string) (cons (quote number?) (cons (quote number) (cons (quote null) (cons (quote nth) (cons (quote not) (cons (quote nl) (cons (quote mode) (cons (quote macroexpand) (cons (quote maxinferences) (cons (quote mapcan) (cons (quote map) (cons (quote make-string) (cons (quote load) (cons (quote loaded) (cons (quote list) (cons (quote lineread) (cons (quote limit) (cons (quote length) (cons (quote let) (cons (quote lazy) (cons (quote lambda) (cons (quote language) (cons (quote kill) (cons (quote is) (cons (quote intersection) (cons (quote inferences) (cons (quote intern) (cons (quote integer?) (cons (quote input) (cons (quote input+) (cons (quote include) (cons (quote include-all-but) (cons (quote it) (cons (quote in) (cons (quote internal) (cons (quote implementation) (cons (quote if) (cons (quote identical) (cons (quote head) (cons (quote hd) (cons (quote hdv) (cons (quote hdstr) (cons (quote hash) (cons (quote get) (cons (quote get-time) (cons (quote gensym) (cons (quote function) (cons (quote fst) (cons (quote freeze) (cons (quote fix) (cons (quote file) (cons (quote fail) (cons (quote fail-if) (cons (quote fwhen) (cons (quote findall) (cons #f (cons (quote enable-type-theory) (cons (quote explode) (cons (quote external) (cons (quote exception) (cons (quote eval-kl) (cons (quote eval) (cons (quote error-to-string) (cons (quote error) (cons (quote empty?) (cons (quote element?) (cons (quote do) (cons (quote difference) (cons (quote destroy) (cons (quote defun) (cons (quote define) (cons (quote defmacro) (cons (quote defcc) (cons (quote defprolog) (cons (quote declare) (cons (quote datatype) (cons (quote cut) (cons (quote cn) (cons (quote cons?) (cons (quote cons) (cons (quote cond) (cons (quote concat) (cons (quote compile) (cons (quote cd) (cons (quote cases) (cons (quote call) (cons (quote close) (cons (quote bind) (cons (quote bound?) (cons (quote boolean?) (cons (quote boolean) (cons (quote bar!) (cons (quote assoc) (cons (quote arity) (cons (quote abort) (cons (quote append) (cons (quote and) (cons (quote adjoin) (cons (quote <-address) (cons (quote address->) (cons (quote absvector?) (cons (quote absvector) (quote ()))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) (kl:value (quote *property-vector*))) (begin (register-function-arity (quote shen.lambda-form-entry) 1) (define (kl:shen.lambda-form-entry V1482) (cond ((eq? (quote package) V1482) (quote ())) ((eq? (quote receive) V1482) (quote ())) (#t (let ((ArityF (kl:arity V1482))) (if (kl:= ArityF -1) (quote ()) (if (kl:= ArityF 0) (quote ()) (cons (cons V1482 (kl:eval-kl (kl:shen.lambda-form V1482 ArityF))) (quote ())))))))) (quote shen.lambda-form-entry)) (begin (register-function-arity (quote shen.lambda-form) 2) (define (kl:shen.lambda-form V1485 V1486) (cond ((kl:= 0 V1486) V1485) (#t (let ((X (kl:gensym (quote V)))) (cons (quote lambda) (cons X (cons (kl:shen.lambda-form (kl:shen.add-end V1485 X) (- V1486 1)) (quote ())))))))) (quote shen.lambda-form)) (begin (register-function-arity (quote shen.add-end) 2) (define (kl:shen.add-end V1489 V1490) (cond ((pair? V1489) (kl:append V1489 (cons V1490 (quote ())))) (#t (cons V1489 (cons V1490 (quote ())))))) (quote shen.add-end)) (begin (register-function-arity (quote shen.set-lambda-form-entry) 1) (define (kl:shen.set-lambda-form-entry V1492) (cond ((pair? V1492) (kl:put (car V1492) (quote shen.lambda-form) (cdr V1492) (kl:value (quote *property-vector*)))) (#t (kl:shen.f_error (quote shen.set-lambda-form-entry))))) (quote shen.set-lambda-form-entry)) (kl:shen.for-each (lambda (Entry) (kl:shen.set-lambda-form-entry Entry)) (cons (cons (quote shen.datatype-error) (lambda (X) (kl:shen.datatype-error X))) (cons (cons (quote shen.tuple) (lambda (X) (kl:shen.tuple X))) (cons (cons (quote shen.pvar) (lambda (X) (kl:shen.pvar X))) (cons (cons (quote shen.dictionary) (lambda (X) (kl:shen.dictionary X))) (kl:mapcan (lambda (X) (kl:shen.lambda-form-entry X)) (kl:external (kl:intern "shen")))))))) (begin (register-function-arity (quote specialise) 1) (define (kl:specialise V1494) (begin (kl:set (quote shen.*special*) (cons V1494 (kl:value (quote shen.*special*)))) V1494)) (quote specialise)) (begin (register-function-arity (quote unspecialise) 1) (define (kl:unspecialise V1496) (begin (kl:set (quote shen.*special*) (kl:remove V1496 (kl:value (quote shen.*special*)))) V1496)) (quote unspecialise))