"Copyright (c) 2015, Mark Tarver\n\nAll rights reserved.\n\nRedistribution and use in source and binary forms, with or without\nmodification, are permitted provided that the following conditions are met:\n1. Redistributions of source code must retain the above copyright\n notice, this list of conditions and the following disclaimer.\n2. Redistributions in binary form must reproduce the above copyright\n notice, this list of conditions and the following disclaimer in the\n documentation and/or other materials provided with the distribution.\n3. The name of Mark Tarver may not be used to endorse or promote products\n derived from this software without specific prior written permission.\n\nTHIS SOFTWARE IS PROVIDED BY Mark Tarver ''AS IS'' AND ANY\nEXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED\nWARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE\nDISCLAIMED. IN NO EVENT SHALL Mark Tarver BE LIABLE FOR ANY\nDIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES\n(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;\nLOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND\nON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT\n(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS\nSOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE." (begin (register-function-arity (quote thaw) 1) (define (kl:thaw V2717) (V2717)) (quote thaw)) (begin (register-function-arity (quote eval) 1) (define (kl:eval V2719) (let ((Macroexpand (kl:shen.walk (lambda (Y) (kl:macroexpand Y)) V2719))) (if (assert-boolean (kl:shen.packaged? Macroexpand)) (kl:map (lambda (Z) (kl:shen.eval-without-macros Z)) (kl:shen.package-contents Macroexpand)) (kl:shen.eval-without-macros Macroexpand)))) (quote eval)) (begin (register-function-arity (quote shen.eval-without-macros) 1) (define (kl:shen.eval-without-macros V2721) (kl:eval-kl (kl:shen.elim-def (kl:shen.proc-input+ V2721)))) (quote shen.eval-without-macros)) (begin (register-function-arity (quote shen.proc-input+) 1) (define (kl:shen.proc-input+ V2723) (cond ((and (pair? V2723) (and (eq? (quote input+) (car V2723)) (and (pair? (cdr V2723)) (and (pair? (cdr (cdr V2723))) (null? (cdr (cdr (cdr V2723)))))))) (cons (quote input+) (cons (kl:shen.rcons_form (car (cdr V2723))) (cdr (cdr V2723))))) ((and (pair? V2723) (and (eq? (quote shen.read+) (car V2723)) (and (pair? (cdr V2723)) (and (pair? (cdr (cdr V2723))) (null? (cdr (cdr (cdr V2723)))))))) (cons (quote shen.read+) (cons (kl:shen.rcons_form (car (cdr V2723))) (cdr (cdr V2723))))) ((pair? V2723) (kl:map (lambda (Z) (kl:shen.proc-input+ Z)) V2723)) (#t V2723))) (quote shen.proc-input+)) (begin (register-function-arity (quote shen.elim-def) 1) (define (kl:shen.elim-def V2725) (cond ((and (pair? V2725) (and (eq? (quote define) (car V2725)) (pair? (cdr V2725)))) (kl:shen.shen->kl (car (cdr V2725)) (cdr (cdr V2725)))) ((and (pair? V2725) (and (eq? (quote defmacro) (car V2725)) (pair? (cdr V2725)))) (let ((Default (cons (quote X) (cons (quote ->) (cons (quote X) (quote ())))))) (let ((Def (kl:shen.elim-def (cons (quote define) (cons (car (cdr V2725)) (kl:append (cdr (cdr V2725)) Default)))))) (let ((MacroAdd (kl:shen.add-macro (car (cdr V2725))))) Def)))) ((and (pair? V2725) (and (eq? (quote defcc) (car V2725)) (pair? (cdr V2725)))) (kl:shen.elim-def (kl:shen.yacc V2725))) ((pair? V2725) (kl:map (lambda (Z) (kl:shen.elim-def Z)) V2725)) (#t V2725))) (quote shen.elim-def)) (begin (register-function-arity (quote shen.add-macro) 1) (define (kl:shen.add-macro V2727) (let ((MacroReg (kl:value (quote shen.*macroreg*)))) (let ((NewMacroReg (kl:set (quote shen.*macroreg*) (kl:adjoin V2727 (kl:value (quote shen.*macroreg*)))))) (if (kl:= MacroReg NewMacroReg) (quote shen.skip) (kl:set (quote *macros*) (cons (kl:function V2727) (kl:value (quote *macros*)))))))) (quote shen.add-macro)) (begin (register-function-arity (quote shen.packaged?) 1) (define (kl:shen.packaged? V2735) (cond ((and (pair? V2735) (and (eq? (quote package) (car V2735)) (and (pair? (cdr V2735)) (pair? (cdr (cdr V2735)))))) #t) (#t #f))) (quote shen.packaged?)) (begin (register-function-arity (quote external) 1) (define (kl:external V2737) (guard (lambda (E) (simple-error (string-append "package " (kl:shen.app V2737 " has not been used.\n" (quote shen.a))))) (lambda () (kl:get V2737 (quote shen.external-symbols) (kl:value (quote *property-vector*)))))) (quote external)) (begin (register-function-arity (quote internal) 1) (define (kl:internal V2739) (guard (lambda (E) (simple-error (string-append "package " (kl:shen.app V2739 " has not been used.\n" (quote shen.a))))) (lambda () (kl:get V2739 (quote shen.internal-symbols) (kl:value (quote *property-vector*)))))) (quote internal)) (begin (register-function-arity (quote shen.package-contents) 1) (define (kl:shen.package-contents V2743) (cond ((and (pair? V2743) (and (eq? (quote package) (car V2743)) (and (pair? (cdr V2743)) (and (eq? (quote null) (car (cdr V2743))) (pair? (cdr (cdr V2743))))))) (cdr (cdr (cdr V2743)))) ((and (pair? V2743) (and (eq? (quote package) (car V2743)) (and (pair? (cdr V2743)) (pair? (cdr (cdr V2743)))))) (let ((PackageNameDot (kl:intern (string-append (kl:str (car (cdr V2743))) ".")))) (let ((ExpPackageNameDot (kl:explode PackageNameDot))) (kl:shen.packageh (car (cdr V2743)) (car (cdr (cdr V2743))) (cdr (cdr (cdr V2743))) ExpPackageNameDot)))) (#t (kl:shen.f_error (quote shen.package-contents))))) (quote shen.package-contents)) (begin (register-function-arity (quote shen.walk) 2) (define (kl:shen.walk V2746 V2747) (cond ((pair? V2747) (V2746 (kl:map (lambda (Z) (kl:shen.walk V2746 Z)) V2747))) (#t (V2746 V2747)))) (quote shen.walk)) (begin (register-function-arity (quote compile) 3) (define (kl:compile V2751 V2752 V2753) (let ((O (V2751 (cons V2752 (cons (quote ()) (quote ())))))) (if (or (eq? (quote shen.fail!) O) (kl:not (kl:empty? (car O)))) (V2753 O) (kl:shen.hdtl O)))) (quote compile)) (begin (register-function-arity (quote fail-if) 2) (define (kl:fail-if V2756 V2757) (if (assert-boolean (V2756 V2757)) (quote shen.fail!) V2757)) (quote fail-if)) (begin (register-function-arity (quote _scheme_at_s) 2) (define (kl:_scheme_at_s V2760 V2761) (string-append V2760 V2761)) (quote _scheme_at_s)) (begin (register-function-arity (quote tc?) 0) (define (kl:tc?) (kl:value (quote shen.*tc*))) (quote tc?)) (begin (register-function-arity (quote ps) 1) (define (kl:ps V2763) (guard (lambda (E) (simple-error (kl:shen.app V2763 " not found.\n" (quote shen.a)))) (lambda () (kl:get V2763 (quote shen.source) (kl:value (quote *property-vector*)))))) (quote ps)) (begin (register-function-arity (quote stinput) 0) (define (kl:stinput) (kl:value (quote *stinput*))) (quote stinput)) (begin (register-function-arity (quote vector) 1) (define (kl:vector V2765) (let ((Vector (make-vector (+ V2765 1) (quote (quote shen.fail!))))) (let ((ZeroStamp (let ((_tmp Vector)) (vector-set! _tmp 0 V2765) _tmp))) (let ((Standard (if (kl:= V2765 0) ZeroStamp (kl:shen.fillvector ZeroStamp 1 V2765 (quote shen.fail!))))) Standard)))) (quote vector)) (begin (register-function-arity (quote shen.fillvector) 4) (define (kl:shen.fillvector V2771 V2772 V2773 V2774) (cond ((kl:= V2773 V2772) (let ((_tmp V2771)) (vector-set! _tmp V2773 V2774) _tmp)) (#t (kl:shen.fillvector (let ((_tmp V2771)) (vector-set! _tmp V2772 V2774) _tmp) (+ 1 V2772) V2773 V2774)))) (quote shen.fillvector)) (begin (register-function-arity (quote vector?) 1) (define (kl:vector? V2776) (and (vector? V2776) (assert-boolean (let ((X (guard (lambda (E) -1) (lambda () (vector-ref V2776 0))))) (and (number? X) (>= X 0)))))) (quote vector?)) (begin (register-function-arity (quote vector->) 3) (define (kl:vector-> V2780 V2781 V2782) (if (kl:= V2781 0) (simple-error "cannot access 0th element of a vector\n") (let ((_tmp V2780)) (vector-set! _tmp V2781 V2782) _tmp))) (quote vector->)) (begin (register-function-arity (quote <-vector) 2) (define (kl:<-vector V2785 V2786) (if (kl:= V2786 0) (simple-error "cannot access 0th element of a vector\n") (let ((VectorElement (vector-ref V2785 V2786))) (if (eq? VectorElement (quote shen.fail!)) (simple-error "vector element not found\n") VectorElement)))) (quote <-vector)) (begin (register-function-arity (quote shen.posint?) 1) (define (kl:shen.posint? V2788) (and (assert-boolean (kl:integer? V2788)) (>= V2788 0))) (quote shen.posint?)) (begin (register-function-arity (quote limit) 1) (define (kl:limit V2790) (vector-ref V2790 0)) (quote limit)) (begin (register-function-arity (quote symbol?) 1) (define (kl:symbol? V2792) (cond ((or (kl:boolean? V2792) (or (number? V2792) (string? V2792))) #f) (#t (guard (lambda (E) #f) (lambda () (let ((String (kl:str V2792))) (kl:shen.analyse-symbol? String))))))) (quote symbol?)) (begin (register-function-arity (quote shen.analyse-symbol?) 1) (define (kl:shen.analyse-symbol? V2794) (cond ((equal? "" V2794) #f) ((assert-boolean (kl:shen.+string? V2794)) (and (assert-boolean (kl:shen.alpha? (make-string 1 (string-ref V2794 0)))) (assert-boolean (kl:shen.alphanums? (kl:tlstr V2794))))) (#t (kl:shen.f_error (quote shen.analyse-symbol?))))) (quote shen.analyse-symbol?)) (begin (register-function-arity (quote shen.alpha?) 1) (define (kl:shen.alpha? V2796) (kl:element? V2796 (cons "A" (cons "B" (cons "C" (cons "D" (cons "E" (cons "F" (cons "G" (cons "H" (cons "I" (cons "J" (cons "K" (cons "L" (cons "M" (cons "N" (cons "O" (cons "P" (cons "Q" (cons "R" (cons "S" (cons "T" (cons "U" (cons "V" (cons "W" (cons "X" (cons "Y" (cons "Z" (cons "a" (cons "b" (cons "c" (cons "d" (cons "e" (cons "f" (cons "g" (cons "h" (cons "i" (cons "j" (cons "k" (cons "l" (cons "m" (cons "n" (cons "o" (cons "p" (cons "q" (cons "r" (cons "s" (cons "t" (cons "u" (cons "v" (cons "w" (cons "x" (cons "y" (cons "z" (cons "=" (cons "*" (cons "/" (cons "+" (cons "-" (cons "_" (cons "?" (cons "$" (cons "!" (cons "@" (cons "~" (cons ">" (cons "<" (cons "&" (cons "%" (cons "{" (cons "}" (cons ":" (cons ";" (cons "`" (cons "#" (cons "'" (cons "." (quote ())))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) (quote shen.alpha?)) (begin (register-function-arity (quote shen.alphanums?) 1) (define (kl:shen.alphanums? V2798) (cond ((equal? "" V2798) #t) ((assert-boolean (kl:shen.+string? V2798)) (and (assert-boolean (kl:shen.alphanum? (make-string 1 (string-ref V2798 0)))) (assert-boolean (kl:shen.alphanums? (kl:tlstr V2798))))) (#t (kl:shen.f_error (quote shen.alphanums?))))) (quote shen.alphanums?)) (begin (register-function-arity (quote shen.alphanum?) 1) (define (kl:shen.alphanum? V2800) (or (assert-boolean (kl:shen.alpha? V2800)) (assert-boolean (kl:shen.digit? V2800)))) (quote shen.alphanum?)) (begin (register-function-arity (quote shen.digit?) 1) (define (kl:shen.digit? V2802) (kl:element? V2802 (cons "1" (cons "2" (cons "3" (cons "4" (cons "5" (cons "6" (cons "7" (cons "8" (cons "9" (cons "0" (quote ()))))))))))))) (quote shen.digit?)) (begin (register-function-arity (quote variable?) 1) (define (kl:variable? V2804) (cond ((or (kl:boolean? V2804) (or (number? V2804) (string? V2804))) #f) (#t (guard (lambda (E) #f) (lambda () (let ((String (kl:str V2804))) (kl:shen.analyse-variable? String))))))) (quote variable?)) (begin (register-function-arity (quote shen.analyse-variable?) 1) (define (kl:shen.analyse-variable? V2806) (cond ((assert-boolean (kl:shen.+string? V2806)) (and (assert-boolean (kl:shen.uppercase? (make-string 1 (string-ref V2806 0)))) (assert-boolean (kl:shen.alphanums? (kl:tlstr V2806))))) (#t (kl:shen.f_error (quote shen.analyse-variable?))))) (quote shen.analyse-variable?)) (begin (register-function-arity (quote shen.uppercase?) 1) (define (kl:shen.uppercase? V2808) (kl:element? V2808 (cons "A" (cons "B" (cons "C" (cons "D" (cons "E" (cons "F" (cons "G" (cons "H" (cons "I" (cons "J" (cons "K" (cons "L" (cons "M" (cons "N" (cons "O" (cons "P" (cons "Q" (cons "R" (cons "S" (cons "T" (cons "U" (cons "V" (cons "W" (cons "X" (cons "Y" (cons "Z" (quote ()))))))))))))))))))))))))))))) (quote shen.uppercase?)) (begin (register-function-arity (quote gensym) 1) (define (kl:gensym V2810) (kl:concat V2810 (kl:set (quote shen.*gensym*) (+ 1 (kl:value (quote shen.*gensym*)))))) (quote gensym)) (begin (register-function-arity (quote concat) 2) (define (kl:concat V2813 V2814) (kl:intern (string-append (kl:str V2813) (kl:str V2814)))) (quote concat)) (begin (register-function-arity (quote _scheme_at_p) 2) (define (kl:_scheme_at_p V2817 V2818) (let ((Vector (make-vector 3 (quote (quote shen.fail!))))) (let ((Tag (let ((_tmp Vector)) (vector-set! _tmp 0 (quote shen.tuple)) _tmp))) (let ((Fst (let ((_tmp Vector)) (vector-set! _tmp 1 V2817) _tmp))) (let ((Snd (let ((_tmp Vector)) (vector-set! _tmp 2 V2818) _tmp))) Vector))))) (quote _scheme_at_p)) (begin (register-function-arity (quote fst) 1) (define (kl:fst V2820) (vector-ref V2820 1)) (quote fst)) (begin (register-function-arity (quote snd) 1) (define (kl:snd V2822) (vector-ref V2822 2)) (quote snd)) (begin (register-function-arity (quote tuple?) 1) (define (kl:tuple? V2824) (and (vector? V2824) (eq? (quote shen.tuple) (guard (lambda (E) (quote shen.not-tuple)) (lambda () (vector-ref V2824 0)))))) (quote tuple?)) (begin (register-function-arity (quote append) 2) (define (kl:append V2827 V2828) (cond ((null? V2827) V2828) ((pair? V2827) (cons (car V2827) (kl:append (cdr V2827) V2828))) (#t (kl:shen.f_error (quote append))))) (quote append)) (begin (register-function-arity (quote _scheme_at_v) 2) (define (kl:_scheme_at_v V2831 V2832) (let ((Limit (kl:limit V2832))) (let ((NewVector (kl:vector (+ Limit 1)))) (let ((X+NewVector (kl:vector-> NewVector 1 V2831))) (if (kl:= Limit 0) X+NewVector (kl:shen._scheme_at_v-help V2832 1 Limit X+NewVector)))))) (quote _scheme_at_v)) (begin (register-function-arity (quote shen._scheme_at_v-help) 4) (define (kl:shen._scheme_at_v-help V2838 V2839 V2840 V2841) (cond ((kl:= V2840 V2839) (kl:shen.copyfromvector V2838 V2841 V2840 (+ V2840 1))) (#t (kl:shen._scheme_at_v-help V2838 (+ V2839 1) V2840 (kl:shen.copyfromvector V2838 V2841 V2839 (+ V2839 1)))))) (quote shen._scheme_at_v-help)) (begin (register-function-arity (quote shen.copyfromvector) 4) (define (kl:shen.copyfromvector V2846 V2847 V2848 V2849) (guard (lambda (E) V2847) (lambda () (kl:vector-> V2847 V2849 (kl:<-vector V2846 V2848))))) (quote shen.copyfromvector)) (begin (register-function-arity (quote hdv) 1) (define (kl:hdv V2851) (guard (lambda (E) (simple-error (string-append "hdv needs a non-empty vector as an argument; not " (kl:shen.app V2851 "\n" (quote shen.s))))) (lambda () (kl:<-vector V2851 1)))) (quote hdv)) (begin (register-function-arity (quote tlv) 1) (define (kl:tlv V2853) (let ((Limit (kl:limit V2853))) (if (kl:= Limit 0) (simple-error "cannot take the tail of the empty vector\n") (if (kl:= Limit 1) (kl:vector 0) (let ((NewVector (kl:vector (- Limit 1)))) (kl:shen.tlv-help V2853 2 Limit (kl:vector (- Limit 1)))))))) (quote tlv)) (begin (register-function-arity (quote shen.tlv-help) 4) (define (kl:shen.tlv-help V2859 V2860 V2861 V2862) (cond ((kl:= V2861 V2860) (kl:shen.copyfromvector V2859 V2862 V2861 (- V2861 1))) (#t (kl:shen.tlv-help V2859 (+ V2860 1) V2861 (kl:shen.copyfromvector V2859 V2862 V2860 (- V2860 1)))))) (quote shen.tlv-help)) (begin (register-function-arity (quote assoc) 2) (define (kl:assoc V2874 V2875) (cond ((null? V2875) (quote ())) ((and (pair? V2875) (and (pair? (car V2875)) (kl:= (car (car V2875)) V2874))) (car V2875)) ((pair? V2875) (kl:assoc V2874 (cdr V2875))) (#t (kl:shen.f_error (quote assoc))))) (quote assoc)) (begin (register-function-arity (quote shen.assoc-set) 3) (define (kl:shen.assoc-set V2882 V2883 V2884) (cond ((null? V2884) (cons (cons V2882 V2883) (quote ()))) ((and (pair? V2884) (and (pair? (car V2884)) (kl:= (car (car V2884)) V2882))) (cons (cons (car (car V2884)) V2883) (cdr V2884))) ((pair? V2884) (cons (car V2884) (kl:shen.assoc-set V2882 V2883 (cdr V2884)))) (#t (kl:shen.f_error (quote shen.assoc-set))))) (quote shen.assoc-set)) (begin (register-function-arity (quote shen.assoc-rm) 2) (define (kl:shen.assoc-rm V2890 V2891) (cond ((null? V2891) (quote ())) ((and (pair? V2891) (and (pair? (car V2891)) (kl:= (car (car V2891)) V2890))) (cdr V2891)) ((pair? V2891) (cons (car V2891) (kl:shen.assoc-rm V2890 (cdr V2891)))) (#t (kl:shen.f_error (quote shen.assoc-rm))))) (quote shen.assoc-rm)) (begin (register-function-arity (quote boolean?) 1) (define (kl:boolean? V2897) (cond ((kl:= #t V2897) #t) ((kl:= #f V2897) #t) (#t #f))) (quote boolean?)) (begin (register-function-arity (quote nl) 1) (define (kl:nl V2899) (cond ((kl:= 0 V2899) 0) (#t (begin (kl:shen.prhush "\n" (kl:stoutput)) (kl:nl (- V2899 1)))))) (quote nl)) (begin (register-function-arity (quote difference) 2) (define (kl:difference V2904 V2905) (cond ((null? V2904) (quote ())) ((pair? V2904) (if (kl:element? (car V2904) V2905) (kl:difference (cdr V2904) V2905) (cons (car V2904) (kl:difference (cdr V2904) V2905)))) (#t (kl:shen.f_error (quote difference))))) (quote difference)) (begin (register-function-arity (quote do) 2) (define (kl:do V2908 V2909) V2909) (quote do)) (begin (register-function-arity (quote element?) 2) (define (kl:element? V2921 V2922) (cond ((null? V2922) #f) ((and (pair? V2922) (kl:= (car V2922) V2921)) #t) ((pair? V2922) (kl:element? V2921 (cdr V2922))) (#t (kl:shen.f_error (quote element?))))) (quote element?)) (begin (register-function-arity (quote empty?) 1) (define (kl:empty? V2928) (cond ((null? V2928) #t) (#t #f))) (quote empty?)) (begin (register-function-arity (quote fix) 2) (define (kl:fix V2931 V2932) (kl:shen.fix-help V2931 V2932 (V2931 V2932))) (quote fix)) (begin (register-function-arity (quote shen.fix-help) 3) (define (kl:shen.fix-help V2943 V2944 V2945) (cond ((kl:= V2945 V2944) V2945) (#t (kl:shen.fix-help V2943 V2945 (V2943 V2945))))) (quote shen.fix-help)) (begin (register-function-arity (quote put) 4) (define (kl:put V2950 V2951 V2952 V2953) (let ((Curr (guard (lambda (E) (quote ())) (lambda () (kl:shen.<-dict V2953 V2950))))) (let ((Added (kl:shen.assoc-set V2951 V2952 Curr))) (let ((Update (kl:shen.dict-> V2953 V2950 Added))) V2952)))) (quote put)) (begin (register-function-arity (quote unput) 3) (define (kl:unput V2957 V2958 V2959) (let ((Curr (guard (lambda (E) (quote ())) (lambda () (kl:shen.<-dict V2959 V2957))))) (let ((Removed (kl:shen.assoc-rm V2958 Curr))) (let ((Update (kl:shen.dict-> V2959 V2957 Removed))) V2957)))) (quote unput)) (begin (register-function-arity (quote get) 3) (define (kl:get V2963 V2964 V2965) (let ((Entry (guard (lambda (E) (quote ())) (lambda () (kl:shen.<-dict V2965 V2963))))) (let ((Result (kl:assoc V2964 Entry))) (if (kl:empty? Result) (simple-error "value not found\n") (cdr Result))))) (quote get)) (begin (register-function-arity (quote hash) 2) (define (kl:hash V2968 V2969) (kl:shen.mod (kl:sum (kl:map (lambda (X) (kl:string->n X)) (kl:explode V2968))) V2969)) (quote hash)) (begin (register-function-arity (quote shen.mod) 2) (define (kl:shen.mod V2972 V2973) (kl:shen.modh V2972 (kl:shen.multiples V2972 (cons V2973 (quote ()))))) (quote shen.mod)) (begin (register-function-arity (quote shen.multiples) 2) (define (kl:shen.multiples V2976 V2977) (cond ((and (pair? V2977) (> (car V2977) V2976)) (cdr V2977)) ((pair? V2977) (kl:shen.multiples V2976 (cons (* 2 (car V2977)) V2977))) (#t (kl:shen.f_error (quote shen.multiples))))) (quote shen.multiples)) (begin (register-function-arity (quote shen.modh) 2) (define (kl:shen.modh V2982 V2983) (cond ((kl:= 0 V2982) 0) ((null? V2983) V2982) ((and (pair? V2983) (> (car V2983) V2982)) (if (kl:empty? (cdr V2983)) V2982 (kl:shen.modh V2982 (cdr V2983)))) ((pair? V2983) (kl:shen.modh (- V2982 (car V2983)) V2983)) (#t (kl:shen.f_error (quote shen.modh))))) (quote shen.modh)) (begin (register-function-arity (quote sum) 1) (define (kl:sum V2985) (cond ((null? V2985) 0) ((pair? V2985) (+ (car V2985) (kl:sum (cdr V2985)))) (#t (kl:shen.f_error (quote sum))))) (quote sum)) (begin (register-function-arity (quote head) 1) (define (kl:head V2993) (cond ((pair? V2993) (car V2993)) (#t (simple-error "head expects a non-empty list")))) (quote head)) (begin (register-function-arity (quote tail) 1) (define (kl:tail V3001) (cond ((pair? V3001) (cdr V3001)) (#t (simple-error "tail expects a non-empty list")))) (quote tail)) (begin (register-function-arity (quote hdstr) 1) (define (kl:hdstr V3003) (make-string 1 (string-ref V3003 0))) (quote hdstr)) (begin (register-function-arity (quote intersection) 2) (define (kl:intersection V3008 V3009) (cond ((null? V3008) (quote ())) ((pair? V3008) (if (kl:element? (car V3008) V3009) (cons (car V3008) (kl:intersection (cdr V3008) V3009)) (kl:intersection (cdr V3008) V3009))) (#t (kl:shen.f_error (quote intersection))))) (quote intersection)) (begin (register-function-arity (quote reverse) 1) (define (kl:reverse V3011) (kl:shen.reverse_help V3011 (quote ()))) (quote reverse)) (begin (register-function-arity (quote shen.reverse_help) 2) (define (kl:shen.reverse_help V3014 V3015) (cond ((null? V3014) V3015) ((pair? V3014) (kl:shen.reverse_help (cdr V3014) (cons (car V3014) V3015))) (#t (kl:shen.f_error (quote shen.reverse_help))))) (quote shen.reverse_help)) (begin (register-function-arity (quote union) 2) (define (kl:union V3018 V3019) (cond ((null? V3018) V3019) ((pair? V3018) (if (kl:element? (car V3018) V3019) (kl:union (cdr V3018) V3019) (cons (car V3018) (kl:union (cdr V3018) V3019)))) (#t (kl:shen.f_error (quote union))))) (quote union)) (begin (register-function-arity (quote y-or-n?) 1) (define (kl:y-or-n? V3021) (let ((Message (kl:shen.prhush (kl:shen.proc-nl V3021) (kl:stoutput)))) (let ((Y-or-N (kl:shen.prhush " (y/n) " (kl:stoutput)))) (let ((Input (kl:shen.app (kl:read (kl:stinput)) "" (quote shen.s)))) (if (equal? "y" Input) #t (if (equal? "n" Input) #f (begin (kl:shen.prhush "please answer y or n\n" (kl:stoutput)) (kl:y-or-n? V3021)))))))) (quote y-or-n?)) (begin (register-function-arity (quote not) 1) (define (kl:not V3023) (if (assert-boolean V3023) #f #t)) (quote not)) (begin (register-function-arity (quote subst) 3) (define (kl:subst V3036 V3037 V3038) (cond ((kl:= V3038 V3037) V3036) ((pair? V3038) (kl:map (lambda (W) (kl:subst V3036 V3037 W)) V3038)) (#t V3038))) (quote subst)) (begin (register-function-arity (quote explode) 1) (define (kl:explode V3040) (kl:shen.explode-h (kl:shen.app V3040 "" (quote shen.a)))) (quote explode)) (begin (register-function-arity (quote shen.explode-h) 1) (define (kl:shen.explode-h V3042) (cond ((equal? "" V3042) (quote ())) ((assert-boolean (kl:shen.+string? V3042)) (cons (make-string 1 (string-ref V3042 0)) (kl:shen.explode-h (kl:tlstr V3042)))) (#t (kl:shen.f_error (quote shen.explode-h))))) (quote shen.explode-h)) (begin (register-function-arity (quote cd) 1) (define (kl:cd V3044) (kl:set (quote *home-directory*) (if (equal? V3044 "") "" (kl:shen.app V3044 "/" (quote shen.a))))) (quote cd)) (begin (register-function-arity (quote shen.for-each) 2) (define (kl:shen.for-each V3047 V3048) (cond ((null? V3048) #t) ((pair? V3048) (let ((_ (V3047 (car V3048)))) (kl:shen.for-each V3047 (cdr V3048)))) (#t (kl:shen.f_error (quote shen.for-each))))) (quote shen.for-each)) (begin (register-function-arity (quote map) 2) (define (kl:map V3053 V3054) (cond ((null? V3054) (quote ())) ((pair? V3054) (cons (V3053 (car V3054)) (kl:map V3053 (cdr V3054)))) (#t (V3053 V3054)))) (quote map)) (begin (register-function-arity (quote length) 1) (define (kl:length V3056) (kl:shen.length-h V3056 0)) (quote length)) (begin (register-function-arity (quote shen.length-h) 2) (define (kl:shen.length-h V3059 V3060) (cond ((null? V3059) V3060) (#t (kl:shen.length-h (cdr V3059) (+ V3060 1))))) (quote shen.length-h)) (begin (register-function-arity (quote occurrences) 2) (define (kl:occurrences V3072 V3073) (cond ((kl:= V3073 V3072) 1) ((pair? V3073) (+ (kl:occurrences V3072 (car V3073)) (kl:occurrences V3072 (cdr V3073)))) (#t 0))) (quote occurrences)) (begin (register-function-arity (quote nth) 2) (define (kl:nth V3080 V3081) (cond ((and (kl:= 1 V3080) (pair? V3081)) (car V3081)) ((pair? V3081) (kl:nth (- V3080 1) (cdr V3081))) (#t (simple-error (string-append "nth applied to " (kl:shen.app V3080 (string-append ", " (kl:shen.app V3081 "\n" (quote shen.a))) (quote shen.a))))))) (quote nth)) (begin (register-function-arity (quote integer?) 1) (define (kl:integer? V3083) (and (number? V3083) (assert-boolean (let ((Abs (kl:shen.abs V3083))) (kl:shen.integer-test? Abs (kl:shen.magless Abs 1)))))) (quote integer?)) (begin (register-function-arity (quote shen.abs) 1) (define (kl:shen.abs V3085) (if (> V3085 0) V3085 (- 0 V3085))) (quote shen.abs)) (begin (register-function-arity (quote shen.magless) 2) (define (kl:shen.magless V3088 V3089) (let ((Nx2 (* V3089 2))) (if (> Nx2 V3088) V3089 (kl:shen.magless V3088 Nx2)))) (quote shen.magless)) (begin (register-function-arity (quote shen.integer-test?) 2) (define (kl:shen.integer-test? V3095 V3096) (cond ((kl:= 0 V3095) #t) ((> 1 V3095) #f) (#t (let ((Abs-N (- V3095 V3096))) (if (> 0 Abs-N) (kl:integer? V3095) (kl:shen.integer-test? Abs-N V3096)))))) (quote shen.integer-test?)) (begin (register-function-arity (quote mapcan) 2) (define (kl:mapcan V3101 V3102) (cond ((null? V3102) (quote ())) ((pair? V3102) (kl:append (V3101 (car V3102)) (kl:mapcan V3101 (cdr V3102)))) (#t (kl:shen.f_error (quote mapcan))))) (quote mapcan)) (begin (register-function-arity (quote ==) 2) (define (kl:== V3114 V3115) (cond ((kl:= V3115 V3114) #t) (#t #f))) (quote ==)) (begin (register-function-arity (quote abort) 0) (define (kl:abort) (simple-error "")) (quote abort)) (begin (register-function-arity (quote bound?) 1) (define (kl:bound? V3117) (and (assert-boolean (symbol? V3117)) (assert-boolean (let ((Val (guard (lambda (E) (quote shen.this-symbol-is-unbound)) (lambda () (kl:value V3117))))) (if (eq? Val (quote shen.this-symbol-is-unbound)) #f #t))))) (quote bound?)) (begin (register-function-arity (quote shen.string->bytes) 1) (define (kl:shen.string->bytes V3119) (cond ((equal? "" V3119) (quote ())) (#t (cons (kl:string->n (make-string 1 (string-ref V3119 0))) (kl:shen.string->bytes (kl:tlstr V3119)))))) (quote shen.string->bytes)) (begin (register-function-arity (quote maxinferences) 1) (define (kl:maxinferences V3121) (kl:set (quote shen.*maxinferences*) V3121)) (quote maxinferences)) (begin (register-function-arity (quote inferences) 0) (define (kl:inferences) (kl:value (quote shen.*infs*))) (quote inferences)) (begin (register-function-arity (quote protect) 1) (define (kl:protect V3123) V3123) (quote protect)) (begin (register-function-arity (quote stoutput) 0) (define (kl:stoutput) (kl:value (quote *stoutput*))) (quote stoutput)) (begin (register-function-arity (quote sterror) 0) (define (kl:sterror) (kl:value (quote *sterror*))) (quote sterror)) (begin (register-function-arity (quote string->symbol) 1) (define (kl:string->symbol V3125) (let ((Symbol (kl:intern V3125))) (if (assert-boolean (symbol? Symbol)) Symbol (simple-error (string-append "cannot intern " (kl:shen.app V3125 " to a symbol" (quote shen.s))))))) (quote string->symbol)) (begin (register-function-arity (quote optimise) 1) (define (kl:optimise V3131) (cond ((eq? (quote +) V3131) (kl:set (quote shen.*optimise*) #t)) ((eq? (quote -) V3131) (kl:set (quote shen.*optimise*) #f)) (#t (simple-error "optimise expects a + or a -.\n")))) (quote optimise)) (begin (register-function-arity (quote os) 0) (define (kl:os) (kl:value (quote *os*))) (quote os)) (begin (register-function-arity (quote language) 0) (define (kl:language) (kl:value (quote *language*))) (quote language)) (begin (register-function-arity (quote version) 0) (define (kl:version) (kl:value (quote *version*))) (quote version)) (begin (register-function-arity (quote port) 0) (define (kl:port) (kl:value (quote *port*))) (quote port)) (begin (register-function-arity (quote porters) 0) (define (kl:porters) (kl:value (quote *porters*))) (quote porters)) (begin (register-function-arity (quote implementation) 0) (define (kl:implementation) (kl:value (quote *implementation*))) (quote implementation)) (begin (register-function-arity (quote release) 0) (define (kl:release) (kl:value (quote *release*))) (quote release)) (begin (register-function-arity (quote package?) 1) (define (kl:package? V3133) (guard (lambda (E) #f) (lambda () (begin (kl:external V3133) #t)))) (quote package?)) (begin (register-function-arity (quote function) 1) (define (kl:function V3135) (kl:shen.lookup-func V3135)) (quote function)) (begin (register-function-arity (quote shen.lookup-func) 1) (define (kl:shen.lookup-func V3137) (guard (lambda (E) (simple-error (kl:shen.app V3137 " has no lambda expansion\n" (quote shen.a)))) (lambda () (kl:get V3137 (quote shen.lambda-form) (kl:value (quote *property-vector*)))))) (quote shen.lookup-func))