shen-ruby 0.3.1 → 0.4.0

data/shen/release/k_lambda/sys.kl

@@ -1,548 +1,244 @@
+"**********************************************************************************
+*                           The License						                                      *
+* 										                                                                  *
+* The user is free to produce commercial applications with the software, to 	          *
+* distribute these applications in source or binary  form, and to charge monies         *
+* for them as he sees fit and in concordance with the laws of the land subject 	        *
+* to the following license.							                                                *
+*										                                                                    * 
+* 1. The license applies to all the software and all derived software and 	            *
+*    must appear on such.							                                                  *
+*										                                                                    *
+* 2. It is illegal to distribute the software without this license attached	            *
+*    to it and use of the software implies agreement with the license as such.          *
+*    It is illegal for anyone who is not the copyright holder to tamper with 	          *
+*    or change the license.							                                                *
+*										                                                                    *
+* 3. Neither the names of Lambda Associates or the copyright holder may be used         *
+*    to endorse or promote products built using the software without specific 	        *
+*    prior written permission from the copyright holder.		                            *
+*										                                                                    *
+* 4. That possession of this license does not confer on the copyright holder 	          *
+*    any special contractual obligation towards the user. That in no event 	            * 
+*    shall the copyright holder 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, 	              * 
+*    interruption), however caused and on any theory of liability, whether in	          * 
+*    contract, strict liability or tort (including negligence) arising in any         	*
+*    way out of the use of the software, even if advised of the possibility of         	*
+*    such damage.						                                                        		* 
+*										                                                                    *
+* 5. It is permitted for the user to change the software, for the purpose of 	          *
+*    improving performance, correcting an error, or porting to a new platform, 	        *
+*    and distribute the derived version of Shen provided the resulting program 	        *
+*    conforms in all respects to the Shen standard and is issued under that             * 
+*    title. The user must make it clear with his distribution that he/she is 	          *
+*    the author of the changes and what these changes are and why. 		                  *
+*										                                                                    *
+* 6. Derived versions of this software in whatever form are subject to the same         *
+*    restrictions. In particular it is not permitted to make derived copies of          *
+*    this software which do not conform to the Shen standard or appear under a          *
+*    different title.								                                                    *
+*										                                                                    *
+*    It is permitted to distribute versions of Shen which incorporate libraries,        *
+*    graphics or other facilities which are not part of the Shen standard.	            *
+*										                                                                    *
+* For an explication of this license see www.shenlanguage.org/license.htm which         *
+* explains this license in full.                                                        *
+*				 						                                                                    *
+*****************************************************************************************
+"(defun thaw (V1753) (V1753))
 
-"                                                   The License
- 
- The user is free to produce commercial applications with the software, to distribute these applications in source or binary  form, and to charge monies for them as he sees fit and in concordance with the laws of the land subject to the following  license.
- 
- 1. The license applies to all the software and all derived software and must appear on such.
- 2. It is illegal to distribute the software without this license attached to it and use of the software implies agreement 
-    with the license as such. It is illegal for anyone who is not the copyright holder to tamper with or change the license.
- 3. Neither the names of Lambda Associates or the copyright holder may be used to endorse or promote products built using
-     the software without specific prior written permission from the copyright holder.
- 4. That possession of this license does not confer on the copyright holder any special contractual obligation towards the    user. That in no event shall the copyright holder 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) arising in any way out of the use of the software, even if advised of the possibility of   such damage. 
-5. It is permitted for the user to change the software, for the purpose of improving performance, correcting an error, or    porting to a new platform, and distribute the modified version of Shen (hereafter the modified version) provided the     resulting program conforms in all respects to the Shen standard and is issued under that title. The user must make it clear   with his distribution that he/she is the author of the changes and what these changes are and why. 
-6. Derived versions of this software in whatever form are subject to the same restrictions. In particular it is not          permitted to make derived copies of this software which do not conform to the Shen standard or appear under a different title.
-7. It is permitted to distribute versions of Shen which incorporate libraries, graphics or other facilities which are not    part of the Shen standard.
-
-For an explication of this license see http://www.lambdassociates.org/News/june11/license.htm which explains this license in full."
-
-(defun thaw (V650) (V650))
-
-(defun eval (V651)
- (let Macroexpand (shen-walk (lambda V652 (macroexpand V652)) V651)
-  (if (shen-packaged? Macroexpand)
-   (map (lambda V653 (shen-eval-without-macros V653))
-    (shen-package-contents Macroexpand))
-   (shen-eval-without-macros Macroexpand))))
-
-(defun shen-eval-without-macros (V654)
- (eval-kl (shen-elim-define (shen-proc-input+ V654))))
-
-(defun shen-proc-input+ (V655)
- (cond
-  ((and (cons? V655)
-    (and (= input+ (hd V655))
-     (and (cons? (tl V655))
-      (and (cons? (tl (tl V655))) (= () (tl (tl (tl V655))))))))
-   (cons input+
-    (cons (hd (tl V655)) (cons (shen-rcons_form (hd (tl (tl V655)))) ()))))
-  ((cons? V655) (map (lambda V656 (shen-proc-input+ V656)) V655)) (true V655)))
-
-(defun shen-elim-define (V657)
- (cond
-  ((and (cons? V657) (and (= define (hd V657)) (cons? (tl V657))))
-   (shen-shen->kl (hd (tl V657)) (tl (tl V657))))
-  ((cons? V657) (map (lambda V658 (shen-elim-define V658)) V657)) (true V657)))
-
-(defun shen-packaged? (V665)
- (cond
-  ((and (cons? V665)
-    (and (= package (hd V665))
-     (and (cons? (tl V665)) (cons? (tl (tl V665))))))
-   true)
-  (true false)))
-
-(defun external (V666)
- (trap-error (get V666 shen-external-symbols (value shen-*property-vector*))
-  (lambda E (interror "package ~A has not been used.~%" (@p V666 ())))))
-
-(defun shen-package-contents (V669)
- (cond
-  ((and (cons? V669)
-    (and (= package (hd V669))
-     (and (cons? (tl V669))
-      (and (= null (hd (tl V669))) (cons? (tl (tl V669)))))))
-   (tl (tl (tl V669))))
-  ((and (cons? V669)
-    (and (= package (hd V669))
-     (and (cons? (tl V669)) (cons? (tl (tl V669))))))
-   (shen-packageh (hd (tl V669)) (hd (tl (tl V669))) Code))
-  (true (shen-sys-error shen-package-contents))))
-
-(defun shen-walk (V670 V671)
- (cond ((cons? V671) (V670 (map (lambda Z (shen-walk V670 Z)) V671)))
-  (true (V670 V671))))
-
-(defun compile (V672 V673 V674)
- (let O (V672 (@p V673 ()))
-  (if (or (= (fail) O) (not (empty? (fst O)))) (shen-compile-error O V674)
-   (snd O))))
-
-(defun shen-compile-error (V687 V688)
- (cond ((= () V688) (fail))
-  ((and (tuple? V687) (cons? (fst V687))) (V688 (fst V687)))
-  (true (interror "syntax error~%" ()))))
-
-(defun <e> (V693)
- (cond ((tuple? V693) (@p (fst V693) ())) (true (shen-sys-error <e>))))
-
-(defun fail-if (V694 V695) (if (V694 V695) (fail) V695))
-
-(defun @s (V696 V697) (cn V696 V697))
-
-(defun tc? (V702) (value shen-*tc*))
-
-(defun ps (V703)
- (trap-error (get V703 shen-source (value shen-*property-vector*))
-  (lambda E (interror "~A not found.~%" (@p V703 ())))))
-
-(defun explode (V704)
- (if (string? V704) (shen-explode-string V704)
-  (explode (intmake-string "~A" (@p V704 ())))))
-
-(defun shen-explode-string (V705)
- (cond ((= "" V705) ())
-  (true
-   (let S (pos V705 0)
-    (let Ss (tlstr V705)
-     (if (= Ss shen-eos) () (cons S (shen-explode-string Ss))))))))
-
-(defun stinput (V710) (value *stinput*))
-
-(defun shen-+vector? (V711)
- (and (absvector? V711) (> (<-address V711 0) 0)))
-
-(defun vector (V712)
- (let Vector (absvector (+ V712 1))
-  (let ZeroStamp (address-> Vector 0 V712)
-   (let Standard
-    (if (= V712 0) ZeroStamp (shen-fillvector ZeroStamp 1 V712 (fail)))
-    Standard))))
-
-(defun shen-fillvector (V713 V714 V715 V716)
- (cond ((= V715 V714) (address-> V713 V715 V716))
-  (true (shen-fillvector (address-> V713 V714 V716) (+ 1 V714) V715 V716))))
-
-(defun vector? (V718)
- (and (absvector? V718)
-  (trap-error (>= (<-address V718 0) 0) (lambda E false))))
-
-(defun vector-> (V719 V720 V721)
- (if (= V720 0) (interror "cannot access 0th element of a vector~%" ())
-  (address-> V719 V720 V721)))
-
-(defun <-vector (V722 V723)
- (if (= V723 0) (interror "cannot access 0th element of a vector~%" ())
-  (let VectorElement (<-address V722 V723)
-   (if (= VectorElement (fail)) (interror "vector element not found~%" ())
-    VectorElement))))
-
-(defun shen-posint? (V724) (and (integer? V724) (>= V724 0)))
-
-(defun limit (V725) (<-address V725 0))
-
-(defun symbol? (V726)
- (cond ((or (boolean? V726) (or (number? V726) (string? V726))) false)
-  (true
-   (trap-error (let Explode (explode V726) (shen-analyse-symbol? Explode))
-    (lambda E false)))))
-
-(defun shen-analyse-symbol? (V727)
- (cond ((cons? V727) (and (shen-alpha? (hd V727)) (shen-alphanums? (tl V727))))
-  (true (shen-sys-error shen-analyse-symbol?))))
-
-(defun shen-alpha? (V728)
- (element? V728
-  (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? (V729)
- (cond ((= () V729) true)
-  ((cons? V729) (and (shen-alphanum? (hd V729)) (shen-alphanums? (tl V729))))
-  (true (shen-sys-error shen-alphanums?))))
-
-(defun shen-alphanum? (V730) (or (shen-alpha? V730) (shen-digit? V730)))
-
-(defun shen-digit? (V731)
- (element? V731
-  (cons "1"
-   (cons "2"
-    (cons "3"
-     (cons "4"
-      (cons "5"
-       (cons "6" (cons "7" (cons "8" (cons "9" (cons "0" ()))))))))))))
-
-(defun variable? (V732)
- (cond ((or (boolean? V732) (or (number? V732) (string? V732))) false)
-  (true
-   (trap-error (let Explode (explode V732) (shen-analyse-variable? Explode))
-    (lambda E false)))))
-
-(defun shen-analyse-variable? (V733)
- (cond
-  ((cons? V733) (and (shen-uppercase? (hd V733)) (shen-alphanums? (tl V733))))
-  (true (shen-sys-error shen-analyse-variable?))))
-
-(defun shen-uppercase? (V734)
- (element? V734
-  (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 (V735)
- (concat V735 (set shen-*gensym* (+ 1 (value shen-*gensym*)))))
-
-(defun concat (V736 V737) (intern (cn (str V736) (str V737))))
-
-(defun @p (V738 V739)
- (let Vector (absvector 3)
-  (let Tag (address-> Vector 0 shen-tuple)
-   (let Fst (address-> Vector 1 V738)
-    (let Snd (address-> Vector 2 V739) Vector)))))
-
-(defun fst (V740) (<-address V740 1))
-
-(defun snd (V741) (<-address V741 2))
-
-(defun tuple? (V742)
- (trap-error (and (absvector? V742) (= shen-tuple (<-address V742 0)))
-  (lambda E false)))
-
-(defun append (V743 V744)
- (cond ((= () V743) V744)
-  ((cons? V743) (cons (hd V743) (append (tl V743) V744)))
-  (true (shen-sys-error append))))
-
-(defun @v (V745 V746)
- (let Limit (limit V746)
-  (let NewVector (vector (+ Limit 1))
-   (let X+NewVector (vector-> NewVector 1 V745)
-    (if (= Limit 0) X+NewVector (shen-@v-help V746 1 Limit X+NewVector))))))
-
-(defun shen-@v-help (V747 V748 V749 V750)
- (cond ((= V749 V748) (shen-copyfromvector V747 V750 V749 (+ V749 1)))
-  (true
-   (shen-@v-help V747 (+ V748 1) V749
-    (shen-copyfromvector V747 V750 V748 (+ V748 1))))))
-
-(defun shen-copyfromvector (V752 V753 V754 V755)
- (trap-error (vector-> V753 V755 (<-vector V752 V754)) (lambda E V753)))
-
-(defun hdv (V756)
- (trap-error (<-vector V756 1)
-  (lambda E
-   (interror "hdv needs a non-empty vector as an argument; not ~S~%"
-    (@p V756 ())))))
-
-(defun tlv (V757)
- (let Limit (limit V757)
-  (if (= Limit 0)
-   (interror "cannot take the tail of the empty vector~%" ())
-   (if (= Limit 1) (vector 0)
-    (let NewVector (vector (- Limit 1))
-     (shen-tlv-help V757 2 Limit (vector (- Limit 1))))))))
-
-(defun shen-tlv-help (V758 V759 V760 V761)
- (cond ((= V760 V759) (shen-copyfromvector V758 V761 V760 (- V760 1)))
-  (true
-   (shen-tlv-help V758 (+ V759 1) V760
-    (shen-copyfromvector V758 V761 V759 (- V759 1))))))
-
-(defun assoc (V771 V772)
- (cond ((= () V772) ())
-  ((and (cons? V772) (and (cons? (hd V772)) (= (hd (hd V772)) V771)))
-   (hd V772))
-  ((cons? V772) (assoc V771 (tl V772))) (true (shen-sys-error assoc))))
-
-(defun boolean? (V778)
- (cond ((= true V778) true) ((= false V778) true) (true false)))
-
-(defun nl (V779)
- (cond ((= 0 V779) 0) (true (do (intoutput "~%" ()) (nl (- V779 1))))))
-
-(defun difference (V782 V783)
- (cond ((= () V782) ())
-  ((cons? V782)
-   (if (element? (hd V782) V783) (difference (tl V782) V783)
-    (cons (hd V782) (difference (tl V782) V783))))
-  (true (shen-sys-error difference))))
-
-(defun do (V784 V785) V785)
-
-(defun element? (V794 V795)
- (cond ((= () V795) false) ((and (cons? V795) (= (hd V795) V794)) true)
-  ((cons? V795) (element? V794 (tl V795))) (true (shen-sys-error element?))))
-
-(defun empty? (V801) (cond ((= () V801) true) (true false)))
-
-(defun fix (V802 V803) (shen-fix-help V802 V803 (V802 V803)))
-
-(defun shen-fix-help (V810 V811 V812)
- (cond ((= V812 V811) V812) (true (shen-fix-help V810 V812 (V810 V812)))))
-
-(defun put (V814 V815 V816 V817)
- (let N (hash V814 (limit V817))
-  (let Entry (trap-error (<-vector V817 N) (lambda E ()))
-   (let Change
-    (vector-> V817 N (shen-change-pointer-value V814 V815 V816 Entry)) V816))))
-
-(defun shen-change-pointer-value (V820 V821 V822 V823)
- (cond ((= () V823) (cons (cons (cons V820 (cons V821 ())) V822) ()))
-  ((and (cons? V823)
-    (and (cons? (hd V823))
-     (and (cons? (hd (hd V823)))
-      (and (cons? (tl (hd (hd V823))))
-       (and (= () (tl (tl (hd (hd V823)))))
-        (and (= (hd (tl (hd (hd V823)))) V821)
-         (= (hd (hd (hd V823))) V820)))))))
-   (cons (cons (hd (hd V823)) V822) (tl V823)))
-  ((cons? V823)
-   (cons (hd V823) (shen-change-pointer-value V820 V821 V822 (tl V823))))
-  (true (shen-sys-error shen-change-pointer-value))))
-
-(defun get (V826 V827 V828)
- (let N (hash V826 (limit V828))
-  (let Entry
-   (trap-error (<-vector V828 N)
-    (lambda E (interror "pointer not found~%" ())))
-   (let Result (assoc (cons V826 (cons V827 ())) Entry)
-    (if (empty? Result) (interror "value not found~%" ()) (tl Result))))))
-
-(defun hash (V829 V830)
- (let Hash
-  (shen-mod (sum (map (lambda V831 (string->n V831)) (explode V829))) V830)
-  (if (= 0 Hash) 1 Hash)))
-
-(defun shen-mod (V832 V833)
- (shen-modh V832 (shen-multiples V832 (cons V833 ()))))
-
-(defun shen-multiples (V834 V835)
- (cond ((and (cons? V835) (> (hd V835) V834)) (tl V835))
-  ((cons? V835) (shen-multiples V834 (cons (* 2 (hd V835)) V835)))
-  (true (shen-sys-error shen-multiples))))
-
-(defun shen-modh (V838 V839)
- (cond ((= 0 V838) 0) ((= () V839) V838)
-  ((and (cons? V839) (> (hd V839) V838))
-   (if (empty? (tl V839)) V838 (shen-modh V838 (tl V839))))
-  ((cons? V839) (shen-modh (- V838 (hd V839)) V839))
-  (true (shen-sys-error shen-modh))))
-
-(defun sum (V840)
- (cond ((= () V840) 0) ((cons? V840) (+ (hd V840) (sum (tl V840))))
-  (true (shen-sys-error sum))))
-
-(defun head (V847)
- (cond ((cons? V847) (hd V847))
-  (true (interror "head expects a non-empty list" ()))))
-
-(defun tail (V854)
- (cond ((cons? V854) (tl V854))
-  (true (interror "tail expects a non-empty list" ()))))
-
-(defun hdstr (V855) (pos V855 0))
-
-(defun intersection (V858 V859)
- (cond ((= () V858) ())
-  ((cons? V858)
-   (if (element? (hd V858) V859) (cons (hd V858) (intersection (tl V858) V859))
-    (intersection (tl V858) V859)))
-  (true (shen-sys-error intersection))))
-
-(defun reverse (V860) (shen-reverse_help V860 ()))
-
-(defun shen-reverse_help (V861 V862)
- (cond ((= () V861) V862)
-  ((cons? V861) (shen-reverse_help (tl V861) (cons (hd V861) V862)))
-  (true (shen-sys-error shen-reverse_help))))
-
-(defun union (V863 V864)
- (cond ((= () V863) V864)
-  ((cons? V863)
-   (if (element? (hd V863) V864) (union (tl V863) V864)
-    (cons (hd V863) (union (tl V863) V864))))
-  (true (shen-sys-error union))))
-
-(defun y-or-n? (V865)
- (let Message (intoutput V865 ())
-  (let Y-or-N (intoutput " (y/n) " ())
-   (let Input (intmake-string "~S" (@p (input) ()))
-    (if (= "y" Input) true
-     (if (= "n" Input) false
-      (do (intoutput "please answer y or n~%" ()) (y-or-n? V865))))))))
-
-(defun not (V866) (if V866 false true))
-
-(defun subst (V875 V876 V877)
- (cond ((= V877 V876) V875)
-  ((cons? V877) (cons (subst V875 V876 (hd V877)) (subst V875 V876 (tl V877))))
-  (true V877)))
-
-(defun cd (V879)
- (set *home-directory*
-  (if (= V879 "") "" (intmake-string "~A/" (@p V879 ())))))
-
-(defun map (V880 V881) (shen-map-h V880 V881 ()))
-
-(defun shen-map-h (V884 V885 V886)
- (cond ((= () V885) (reverse V886))
-  ((cons? V885) (shen-map-h V884 (tl V885) (cons (V884 (hd V885)) V886)))
-  (true (shen-sys-error shen-map-h))))
-
-(defun length (V887) (shen-length-h V887 0))
-
-(defun shen-length-h (V888 V889)
- (cond ((= () V888) V889) (true (shen-length-h (tl V888) (+ V889 1)))))
-
-(defun occurrences (V898 V899)
- (cond ((= V899 V898) 1)
-  ((cons? V899) (+ (occurrences V898 (hd V899)) (occurrences V898 (tl V899))))
-  (true 0)))
-
-(defun nth (V907 V908)
- (cond ((and (= 1 V907) (cons? V908)) (hd V908))
-  ((cons? V908) (nth (- V907 1) (tl V908))) (true (shen-sys-error nth))))
-
-(defun integer? (V909)
- (and (number? V909)
-  (let Abs (shen-abs V909) (shen-integer-test? Abs (shen-magless Abs 1)))))
-
-(defun shen-abs (V910) (if (> V910 0) V910 (- 0 V910)))
-
-(defun shen-magless (V911 V912)
- (let Nx2 (* V912 2) (if (> Nx2 V911) V912 (shen-magless V911 Nx2))))
-
-(defun shen-integer-test? (V916 V917)
- (cond ((= 0 V916) true) ((> 1 V916) false)
-  (true
-   (let Abs-N (- V916 V917)
-    (if (> 0 Abs-N) (integer? V916) (shen-integer-test? Abs-N V917))))))
-
-(defun mapcan (V920 V921)
- (cond ((= () V921) ())
-  ((cons? V921) (append (V920 (hd V921)) (mapcan V920 (tl V921))))
-  (true (shen-sys-error mapcan))))
-
-(defun read-file-as-bytelist (V922)
- (let Stream (open file V922 in)
-  (let Byte (read-byte Stream)
-   (let Bytes (shen-read-file-as-bytelist-help Stream Byte ())
-    (let Close (close Stream) (reverse Bytes))))))
+(defun eval (V1754) (let Macroexpand (shen.walk (lambda V1751 (macroexpand V1751)) V1754) (if (shen.packaged? Macroexpand) (map shen.eval-without-macros (shen.package-contents Macroexpand)) (shen.eval-without-macros Macroexpand))))
 
-(defun shen-read-file-as-bytelist-help (V923 V924 V925)
- (cond ((= -1 V924) V925)
-  (true
-   (shen-read-file-as-bytelist-help V923 (read-byte V923) (cons V924 V925)))))
+(defun shen.eval-without-macros (V1755) (eval-kl (shen.elim-define (shen.proc-input+ V1755))))
 
-(defun read-file-as-string (V926)
- (let Stream (open file V926 in) (shen-rfas-h Stream (read-byte Stream) "")))
+(defun shen.proc-input+ (V1756) (cond ((and (cons? V1756) (and (= input+ (hd V1756)) (and (cons? (tl V1756)) (and (cons? (tl (tl V1756))) (= () (tl (tl (tl V1756)))))))) (cons input+ (cons (hd (tl V1756)) (cons (shen.rcons_form (hd (tl (tl V1756)))) ())))) ((cons? V1756) (map shen.proc-input+ V1756)) (true V1756)))
 
-(defun shen-rfas-h (V927 V928 V929)
- (cond ((= -1 V928) (do (close V927) V929))
-  (true (shen-rfas-h V927 (read-byte V927) (cn V929 (n->string V928))))))
+(defun shen.elim-define (V1757) (cond ((and (cons? V1757) (and (= define (hd V1757)) (cons? (tl V1757)))) (shen.shen->kl (hd (tl V1757)) (tl (tl V1757)))) ((and (cons? V1757) (and (= defcc (hd V1757)) (cons? (tl V1757)))) (shen.elim-define (shen.yacc V1757))) ((cons? V1757) (map shen.elim-define V1757)) (true V1757)))
 
-(defun == (V938 V939) (cond ((= V939 V938) true) (true false)))
+(defun shen.packaged? (V1764) (cond ((and (cons? V1764) (and (= package (hd V1764)) (and (cons? (tl V1764)) (cons? (tl (tl V1764)))))) true) (true false)))
+
+(defun external (V1765) (trap-error (get V1765 shen.external-symbols (value *property-vector*)) (lambda E (simple-error (cn "package " (shen.app V1765 " has not been used.
+" shen.a))))))
+
+(defun shen.package-contents (V1768) (cond ((and (cons? V1768) (and (= package (hd V1768)) (and (cons? (tl V1768)) (and (= null (hd (tl V1768))) (cons? (tl (tl V1768))))))) (tl (tl (tl V1768)))) ((and (cons? V1768) (and (= package (hd V1768)) (and (cons? (tl V1768)) (cons? (tl (tl V1768)))))) (shen.packageh (hd (tl V1768)) (hd (tl (tl V1768))) (tl (tl (tl V1768))))) (true (shen.sys-error shen.package-contents))))
+
+(defun shen.walk (V1769 V1770) (cond ((cons? V1770) (V1769 (map (lambda Z (shen.walk V1769 Z)) V1770))) (true (V1769 V1770))))
+
+(defun compile (V1771 V1772 V1773) (let O (V1771 (cons V1772 (cons () ()))) (if (or (= (fail) O) (not (empty? (hd O)))) (V1773 O) (shen.hdtl O))))
+
+(defun fail-if (V1774 V1775) (if (V1774 V1775) (fail) V1775))
+
+(defun @s (V1776 V1777) (cn V1776 V1777))
+
+(defun tc? (V1782) (value shen.*tc*))
+
+(defun ps (V1783) (trap-error (get V1783 shen.source (value *property-vector*)) (lambda E (simple-error (shen.app V1783 " not found.
+" shen.a)))))
+
+(defun stinput () (value *stinput*))
+
+(defun shen.+vector? (V1784) (and (absvector? V1784) (> (<-address V1784 0) 0)))
+
+(defun vector (V1785) (let Vector (absvector (+ V1785 1)) (let ZeroStamp (address-> Vector 0 V1785) (let Standard (if (= V1785 0) ZeroStamp (shen.fillvector ZeroStamp 1 V1785 (fail))) Standard))))
+
+(defun shen.fillvector (V1786 V1787 V1788 V1789) (cond ((= V1788 V1787) (address-> V1786 V1788 V1789)) (true (shen.fillvector (address-> V1786 V1787 V1789) (+ 1 V1787) V1788 V1789))))
+
+(defun vector? (V1791) (and (absvector? V1791) (trap-error (>= (<-address V1791 0) 0) (lambda E false))))
+
+(defun vector-> (V1792 V1793 V1794) (if (= V1793 0) (simple-error "cannot access 0th element of a vector
+") (address-> V1792 V1793 V1794)))
+
+(defun <-vector (V1795 V1796) (if (= V1796 0) (simple-error "cannot access 0th element of a vector
+") (let VectorElement (<-address V1795 V1796) (if (= VectorElement (fail)) (simple-error "vector element not found
+") VectorElement))))
+
+(defun shen.posint? (V1797) (and (integer? V1797) (>= V1797 0)))
+
+(defun limit (V1798) (<-address V1798 0))
+
+(defun symbol? (V1799) (cond ((or (boolean? V1799) (or (number? V1799) (string? V1799))) false) (true (trap-error (let String (str V1799) (shen.analyse-symbol? String)) (lambda E false)))))
+
+(defun shen.analyse-symbol? (V1800) (cond ((shen.+string? V1800) (and (shen.alpha? (pos V1800 0)) (shen.alphanums? (tlstr V1800)))) (true (shen.sys-error shen.analyse-symbol?))))
+
+(defun shen.alpha? (V1801) (element? V1801 (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? (V1802) (cond ((= "" V1802) true) ((shen.+string? V1802) (and (shen.alphanum? (pos V1802 0)) (shen.alphanums? (tlstr V1802)))) (true (shen.sys-error shen.alphanums?))))
+
+(defun shen.alphanum? (V1803) (or (shen.alpha? V1803) (shen.digit? V1803)))
+
+(defun shen.digit? (V1804) (element? V1804 (cons "1" (cons "2" (cons "3" (cons "4" (cons "5" (cons "6" (cons "7" (cons "8" (cons "9" (cons "0" ()))))))))))))
+
+(defun variable? (V1805) (cond ((or (boolean? V1805) (or (number? V1805) (string? V1805))) false) (true (trap-error (let String (str V1805) (shen.analyse-variable? String)) (lambda E false)))))
+
+(defun shen.analyse-variable? (V1806) (cond ((shen.+string? V1806) (and (shen.uppercase? (pos V1806 0)) (shen.alphanums? (tlstr V1806)))) (true (shen.sys-error shen.analyse-variable?))))
+
+(defun shen.uppercase? (V1807) (element? V1807 (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 (V1808) (concat V1808 (set shen.*gensym* (+ 1 (value shen.*gensym*)))))
+
+(defun concat (V1809 V1810) (intern (cn (str V1809) (str V1810))))
+
+(defun @p (V1811 V1812) (let Vector (absvector 3) (let Tag (address-> Vector 0 shen.tuple) (let Fst (address-> Vector 1 V1811) (let Snd (address-> Vector 2 V1812) Vector)))))
+
+(defun fst (V1813) (<-address V1813 1))
+
+(defun snd (V1814) (<-address V1814 2))
+
+(defun tuple? (V1815) (trap-error (and (absvector? V1815) (= shen.tuple (<-address V1815 0))) (lambda E false)))
+
+(defun append (V1816 V1817) (cond ((= () V1816) V1817) ((cons? V1816) (cons (hd V1816) (append (tl V1816) V1817))) (true (shen.sys-error append))))
+
+(defun @v (V1818 V1819) (let Limit (limit V1819) (let NewVector (vector (+ Limit 1)) (let X+NewVector (vector-> NewVector 1 V1818) (if (= Limit 0) X+NewVector (shen.@v-help V1819 1 Limit X+NewVector))))))
+
+(defun shen.@v-help (V1820 V1821 V1822 V1823) (cond ((= V1822 V1821) (shen.copyfromvector V1820 V1823 V1822 (+ V1822 1))) (true (shen.@v-help V1820 (+ V1821 1) V1822 (shen.copyfromvector V1820 V1823 V1821 (+ V1821 1))))))
+
+(defun shen.copyfromvector (V1825 V1826 V1827 V1828) (trap-error (vector-> V1826 V1828 (<-vector V1825 V1827)) (lambda E V1826)))
+
+(defun hdv (V1829) (trap-error (<-vector V1829 1) (lambda E (simple-error (cn "hdv needs a non-empty vector as an argument; not " (shen.app V1829 "
+" shen.s))))))
+
+(defun tlv (V1830) (let Limit (limit V1830) (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 V1830 2 Limit (vector (- Limit 1))))))))
+
+(defun shen.tlv-help (V1831 V1832 V1833 V1834) (cond ((= V1833 V1832) (shen.copyfromvector V1831 V1834 V1833 (- V1833 1))) (true (shen.tlv-help V1831 (+ V1832 1) V1833 (shen.copyfromvector V1831 V1834 V1832 (- V1832 1))))))
+
+(defun assoc (V1844 V1845) (cond ((= () V1845) ()) ((and (cons? V1845) (and (cons? (hd V1845)) (= (hd (hd V1845)) V1844))) (hd V1845)) ((cons? V1845) (assoc V1844 (tl V1845))) (true (shen.sys-error assoc))))
+
+(defun boolean? (V1851) (cond ((= true V1851) true) ((= false V1851) true) (true false)))
+
+(defun nl (V1852) (cond ((= 0 V1852) 0) (true (do (pr "
+" (stoutput)) (nl (- V1852 1))))))
+
+(defun difference (V1855 V1856) (cond ((= () V1855) ()) ((cons? V1855) (if (element? (hd V1855) V1856) (difference (tl V1855) V1856) (cons (hd V1855) (difference (tl V1855) V1856)))) (true (shen.sys-error difference))))
+
+(defun do (V1857 V1858) V1858)
+
+(defun element? (V1867 V1868) (cond ((= () V1868) false) ((and (cons? V1868) (= (hd V1868) V1867)) true) ((cons? V1868) (element? V1867 (tl V1868))) (true (shen.sys-error element?))))
+
+(defun empty? (V1874) (cond ((= () V1874) true) (true false)))
+
+(defun fix (V1875 V1876) (shen.fix-help V1875 V1876 (V1875 V1876)))
+
+(defun shen.fix-help (V1883 V1884 V1885) (cond ((= V1885 V1884) V1885) (true (shen.fix-help V1883 V1885 (V1883 V1885)))))
+
+(defun put (V1887 V1888 V1889 V1890) (let N (hash V1887 (limit V1890)) (let Entry (trap-error (<-vector V1890 N) (lambda E ())) (let Change (vector-> V1890 N (shen.change-pointer-value V1887 V1888 V1889 Entry)) V1889))))
+
+(defun shen.change-pointer-value (V1893 V1894 V1895 V1896) (cond ((= () V1896) (cons (cons (cons V1893 (cons V1894 ())) V1895) ())) ((and (cons? V1896) (and (cons? (hd V1896)) (and (cons? (hd (hd V1896))) (and (cons? (tl (hd (hd V1896)))) (and (= () (tl (tl (hd (hd V1896))))) (and (= (hd (tl (hd (hd V1896)))) V1894) (= (hd (hd (hd V1896))) V1893))))))) (cons (cons (hd (hd V1896)) V1895) (tl V1896))) ((cons? V1896) (cons (hd V1896) (shen.change-pointer-value V1893 V1894 V1895 (tl V1896)))) (true (shen.sys-error shen.change-pointer-value))))
+
+(defun get (V1899 V1900 V1901) (let N (hash V1899 (limit V1901)) (let Entry (trap-error (<-vector V1901 N) (lambda E (simple-error "pointer not found
+"))) (let Result (assoc (cons V1899 (cons V1900 ())) Entry) (if (empty? Result) (simple-error "value not found
+") (tl Result))))))
+
+(defun hash (V1902 V1903) (let Hash (shen.mod (shen.sum (map (lambda V1752 (string->n V1752)) (explode V1902))) V1903) (if (= 0 Hash) 1 Hash)))
+
+(defun shen.mod (V1904 V1905) (shen.modh V1904 (shen.multiples V1904 (cons V1905 ()))))
+
+(defun shen.multiples (V1906 V1907) (cond ((and (cons? V1907) (> (hd V1907) V1906)) (tl V1907)) ((cons? V1907) (shen.multiples V1906 (cons (* 2 (hd V1907)) V1907))) (true (shen.sys-error shen.multiples))))
+
+(defun shen.modh (V1910 V1911) (cond ((= 0 V1910) 0) ((= () V1911) V1910) ((and (cons? V1911) (> (hd V1911) V1910)) (if (empty? (tl V1911)) V1910 (shen.modh V1910 (tl V1911)))) ((cons? V1911) (shen.modh (- V1910 (hd V1911)) V1911)) (true (shen.sys-error shen.modh))))
+
+(defun shen.sum (V1912) (cond ((= () V1912) 0) ((cons? V1912) (+ (hd V1912) (shen.sum (tl V1912)))) (true (shen.sys-error shen.sum))))
+
+(defun head (V1919) (cond ((cons? V1919) (hd V1919)) (true (simple-error "head expects a non-empty list"))))
+
+(defun tail (V1926) (cond ((cons? V1926) (tl V1926)) (true (simple-error "tail expects a non-empty list"))))
+
+(defun hdstr (V1927) (pos V1927 0))
+
+(defun intersection (V1930 V1931) (cond ((= () V1930) ()) ((cons? V1930) (if (element? (hd V1930) V1931) (cons (hd V1930) (intersection (tl V1930) V1931)) (intersection (tl V1930) V1931))) (true (shen.sys-error intersection))))
+
+(defun reverse (V1932) (shen.reverse_help V1932 ()))
+
+(defun shen.reverse_help (V1933 V1934) (cond ((= () V1933) V1934) ((cons? V1933) (shen.reverse_help (tl V1933) (cons (hd V1933) V1934))) (true (shen.sys-error shen.reverse_help))))
+
+(defun union (V1935 V1936) (cond ((= () V1935) V1936) ((cons? V1935) (if (element? (hd V1935) V1936) (union (tl V1935) V1936) (cons (hd V1935) (union (tl V1935) V1936)))) (true (shen.sys-error union))))
+
+(defun y-or-n? (V1937) (let Message (pr (shen.proc-nl V1937) (stoutput)) (let Y-or-N (pr " (y/n) " (stoutput)) (let Input (shen.app (input) "" shen.s) (if (= "y" Input) true (if (= "n" Input) false (do (pr "please answer y or n
+" (stoutput)) (y-or-n? V1937))))))))
+
+(defun not (V1938) (if V1938 false true))
+
+(defun subst (V1947 V1948 V1949) (cond ((= V1949 V1948) V1947) ((cons? V1949) (cons (subst V1947 V1948 (hd V1949)) (subst V1947 V1948 (tl V1949)))) (true V1949)))
+
+(defun explode (V1951) (shen.explode-h (shen.app V1951 "" shen.a)))
+
+(defun shen.explode-h (V1952) (cond ((= "" V1952) ()) ((shen.+string? V1952) (cons (pos V1952 0) (shen.explode-h (tlstr V1952)))) (true (shen.sys-error shen.explode-h))))
+
+(defun cd (V1953) (set *home-directory* (if (= V1953 "") "" (shen.app V1953 "/" shen.a))))
+
+(defun map (V1954 V1955) (shen.map-h V1954 V1955 ()))
+
+(defun shen.map-h (V1958 V1959 V1960) (cond ((= () V1959) (reverse V1960)) ((cons? V1959) (shen.map-h V1958 (tl V1959) (cons (V1958 (hd V1959)) V1960))) (true (shen.sys-error shen.map-h))))
+
+(defun length (V1961) (shen.length-h V1961 0))
+
+(defun shen.length-h (V1962 V1963) (cond ((= () V1962) V1963) (true (shen.length-h (tl V1962) (+ V1963 1)))))
+
+(defun occurrences (V1972 V1973) (cond ((= V1973 V1972) 1) ((cons? V1973) (+ (occurrences V1972 (hd V1973)) (occurrences V1972 (tl V1973)))) (true 0)))
+
+(defun nth (V1981 V1982) (cond ((and (= 1 V1981) (cons? V1982)) (hd V1982)) ((cons? V1982) (nth (- V1981 1) (tl V1982))) (true (shen.sys-error nth))))
+
+(defun integer? (V1983) (and (number? V1983) (let Abs (shen.abs V1983) (shen.integer-test? Abs (shen.magless Abs 1)))))
+
+(defun shen.abs (V1984) (if (> V1984 0) V1984 (- 0 V1984)))
+
+(defun shen.magless (V1985 V1986) (let Nx2 (* V1986 2) (if (> Nx2 V1985) V1986 (shen.magless V1985 Nx2))))
+
+(defun shen.integer-test? (V1990 V1991) (cond ((= 0 V1990) true) ((> 1 V1990) false) (true (let Abs-N (- V1990 V1991) (if (> 0 Abs-N) (integer? V1990) (shen.integer-test? Abs-N V1991))))))
+
+(defun mapcan (V1994 V1995) (cond ((= () V1995) ()) ((cons? V1995) (append (V1994 (hd V1995)) (mapcan V1994 (tl V1995)))) (true (shen.sys-error mapcan))))
+
+(defun read-file-as-bytelist (V1996) (let Stream (open file V1996 in) (let Byte (read-byte Stream) (let Bytes (shen.read-file-as-bytelist-help Stream Byte ()) (let Close (close Stream) (reverse Bytes))))))
+
+(defun shen.read-file-as-bytelist-help (V1997 V1998 V1999) (cond ((= -1 V1998) V1999) (true (shen.read-file-as-bytelist-help V1997 (read-byte V1997) (cons V1998 V1999)))))
+
+(defun read-file-as-string (V2000) (let Stream (open file V2000 in) (shen.rfas-h Stream (read-byte Stream) "")))
+
+(defun shen.rfas-h (V2001 V2002 V2003) (cond ((= -1 V2002) (do (close V2001) V2003)) (true (shen.rfas-h V2001 (read-byte V2001) (cn V2003 (n->string V2002))))))
+
+(defun == (V2012 V2013) (cond ((= V2013 V2012) true) (true false)))
 
 (defun abort () (simple-error ""))
 
@@ -550,33 +246,21 @@ For an explication of this license see http://www.lambdassociates.org/News/june1
 
 (defun input () (eval (read)))
 
-(defun input+ (V945 V946)
- (let Input (read)
-  (let Check (shen-typecheck Input V946)
-   (if (= false Check)
-    (do (intoutput "input is not of type ~R: please re-enter " (@p V946 ()))
-     (input+ : V946))
-    (eval Input)))))
+(defun input+ (V2019 V2020) (let Input (read) (let Check (shen.typecheck Input V2020) (if (= false Check) (do (pr (cn "input is not of type " (shen.app V2020 ": please re-enter " shen.r)) (stoutput)) (input+ : V2020)) (eval Input)))))
+
+(defun bound? (V2021) (and (symbol? V2021) (let Val (trap-error (value V2021) (lambda E shen.this-symbol-is-unbound)) (if (= Val shen.this-symbol-is-unbound) false true))))
+
+(defun shen.string->bytes (V2022) (cond ((= "" V2022) ()) (true (cons (string->n (pos V2022 0)) (shen.string->bytes (tlstr V2022))))))
 
-(defun bound? (V947)
- (and (symbol? V947)
-  (let Val (trap-error (value V947) (lambda E shen-this-symbol-is-unbound))
-   (if (= Val shen-this-symbol-is-unbound) false true))))
+(defun maxinferences (V2023) (set shen.*maxinferences* V2023))
 
-(defun shen-string->bytes (V948)
- (cond ((= "" V948) ())
-  (true (cons (string->n (pos V948 0)) (shen-string->bytes (tlstr V948))))))
+(defun inferences () (value shen.*infs*))
 
-(defun maxinferences (V949) (set shen-*maxinferences* V949))
+(defun protect (V2024) V2024)
 
-(defun inferences (V954) (value shen-*infs*))
+(defun stoutput () (value *stoutput*))
 
-(defun shen-hush (V959)
- (cond ((= + V959) (set shen-*hush* shen-hushed))
-  ((= - V959) (set shen-*hush* shen-unhushed))
-  (true (interror "'hush' expects a + or a -~%" ()))))
+(defun string->symbol (V2025) (let Symbol (intern V2025) (if (symbol? Symbol) Symbol (simple-error (cn "cannot intern " (shen.app V2025 " to a symbol" shen.s))))))
 
-(defun protect (V960) V960)
 
-(defun shen-stoutput (V965) (value *stoutput*))