shen-ruby 0.12.1 → 0.13.0

data/shen/release/benchmarks/powerset.shen

@@ -1,10 +0,0 @@
-(define powerset
-   [] -> [[]]
-   [X | Y] -> (let Powerset (powerset Y)
-                (append (cons-X-to-each-set X Powerset) Powerset)))
-
-(define cons-X-to-each-set  
-    _ [ ] -> [ ]  
-    X [Y | Z] -> [[X | Y] | (cons-X-to-each-set X Z)])
-
-

data/shen/release/benchmarks/prime.shen

@@ -1,10 +0,0 @@
-(define prime? 
-  X -> (prime* X (sqrt X) 2))
-
-(define prime*
-  X Max Div -> false	where (integer? (/ X Div))				
-  X Max Div -> true	where (> Div Max)			
-  X Max Div -> (prime* X Max (+ 1 Div)))
-
- 
-

data/shen/release/benchmarks/short.shen

@@ -1,129 +0,0 @@
-(define l_interpreter
-  {A --> B}
-  _ -> (read_eval_print_loop (output "~%L interpreter ~%~%~%~%l-interp --> ~A~%" 
-                                     (normal_form (input+ : l_formula)))))
-
-(define read_eval_print_loop
-  {string --> A}
-  _ -> (read_eval_print_loop 
-           (output "l-interp --> ~A~%"
-              (normal_form (input+ : l_formula))))) 
-
-(define normal_form
-  {l_formula --> l_formula}
-   X -> (fix ==> X))                 
-    
-(define ==>
-   {l_formula --> l_formula}
-   [= X Y] -> (let X* (normal_form X) 
-                   (let Y* (normal_form Y) 
-                        (if (or (eval_error? X*) (eval_error? Y*))
-                            "error!"
-                            (if (= X* Y*) true false))))
-   [[/. P X] Y] -> (let Match (match P (normal_form Y))
-                        (if (no_match? Match) 
-                            "no match"
-                            (sub Match X))) 
-   [if X Y Z] -> (let X* (normal_form X)
-                      (if (= X* true)
-                          Y
-                          (if (= X* false)
-                              Z
-                              "error!")))
-   [let X Y Z] -> [[/. X Z] Y]
-   [@p X Y] -> (let X* (normal_form X)
-                    (let Y* (normal_form Y)
-                         (if (or (eval_error? X*) (eval_error? Y*))
-                             "error!"
-                             [@p X* Y*])))
-   [cons X Y] -> (let X* (normal_form X)
-                      (let Y* (normal_form Y)
-                           (if (or (eval_error? X*) (eval_error? Y*))
-                               "error!"
-                               [cons X* Y*])))
-   [++ X] -> (successor (normal_form X))
-   [-- X] -> (predecessor (normal_form X))
-   \*[cases X1 | Xn] -> (let Case1 (normal_form X1)
-                           (if (= Case1 "no match")
-                               [cases | Xn]
-                               Case1))
-   [cases] -> "error!"            
-   [where X Y] -> [if X Y "no match"]
-   [y-combinator [/. X Y]] -> (replace X [y-combinator [/. X Y]] Y)
-   [X Y] -> (let X* (normal_form X)
-               (let Y* (normal_form Y)
-                  (if (or (eval_error? X*) (eval_error? Y*))
-                      "error!"
-                      [X* Y*])))*\
-    X -> X)
-
-(define eval_error?
-  {l_formula --> boolean}
-   "error!" -> true
-   "no match" -> true
-   _ -> false)  
-
-(define successor
-  {A --> l_formula}
-  X -> (+ 1 X) where (number? X)
-  _ -> "error!")
-
-(define predecessor
-  {A --> l_formula}
-  X -> (- X 1) where (number? X)
-  _ -> "error!")
-
-\* (spy +) *\
-
-(define sub
-  {[(pattern * l_formula)] --> l_formula --> l_formula}
-   [] X -> X
-   [(@p Var Val) | Assoc] X -> (sub Assoc (replace Var Val X)))
-
-(define match
-   {pattern --> l_formula --> (list (pattern * l_formula))}
-    P X -> [] where (== P X)
-    P X -> [(@p P X)]      where (variable? P)
-    [cons P1 P2] [cons X Y] -> (let Match1 (match P1 X)
-                                    (if (no_match? Match1)
-                                        Match1
-                                        (let Match2 (match P2 Y)
-                                            (if (no_match? Match2)
-                                                Match2
-						(append Match1 Match2)))))
-    [@p P1 P2] [@p X Y] -> (let Match1 (match P1 X)
-                                    (if (no_match? Match1)
-                                        Match1
-                                        (let Match2 (match P2 Y)
-                                            (if (no_match? Match2)
-                                                Match2
-						(append Match1 Match2)))))
-
-    _ _ -> [(@p no matching)])
-      
-(define no_match?
-  {[(pattern * l_formula)] --> boolean}
-   [(@p no matching)] -> true
-   _ -> false)
-
-(define replace
-   {pattern --> l_formula --> l_formula --> l_formula}
-    V W [let V* X Y] -> [let V* X Y]  where (== V V*)
-    X Y X -> Y
-    V W [= X Y] -> [= (replace V W X) (replace V W Y)]
-    V W [/. P X] -> [/. P (replace V W X)] 		where (free? V P)
-    V W [if X Y Z] -> [if (replace V W X) (replace V W Y) (replace V W Z)]
-    V W [let X Y Z] -> [let X (replace V W Y) (replace V W Z)]
-    V W [@p X Y] -> [@p (replace V W X) (replace V W Y)]
-    \* V W [cons X Y] -> [cons (replace V W X) (replace V W Y)]
-    V W [cases | Xn] -> [cases | (map (/. Xi (replace V W Xi)) Xn)]
-    V W [where X Y] -> [where (replace V W X) (replace V W Y)]
-    V W [X Y] -> [(replace V W X) (replace V W Y)] *\
-    _ _ X -> X) 	
-
-(define free?
-  {pattern --> pattern --> boolean}
-   P P -> false 
-   P [cons P1 P2] -> (and (free? P P1) (free? P P2))
-   P [@p P1 P2] -> (and (free? P P1) (free? P P2))
-   _ _ -> true)

data/shen/release/benchmarks/text.txt

@@ -1,68 +0,0 @@
-"Terms of Use
-By 'derivative work' we understand it as defined by the US copyright law. We emphasise the following passage from the copyright act of the USA
-
-Making minor changes or additions of little substance to a preexisting work will not qualify the work as a new version for copyright purposes.
-
-By 'copyright holder' we understand Dr Mark Tarver, or, in the event of his decease, the committee appointed under the terms of his will to administer his intellectual estate.
-
-By 'the software' we understand Shen and all the code used to implement it. We include both the original source code written in Shen, and the code derived from this code through compilation to other languages.
-
-By 'Shen standard' we understand the latest standards for Shen laid down in Lambda Associates by the copyright holder.
-
-By 'the user' we understand any person or group of persons, whether organised in a commercial company, cooperative or institution or not, that use the software. The use of 'he' and 'his' to refer to the user follows English usage, but makes no special assumptions about gender or plurality.
-
-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 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.
-
-The License in Detail
-
-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.
-
-That's the $free part. You can write your own Shen software and put your own license on it and charge what you want and distribute it either as closed or open source. We'll come back to that.
-
-1. The license applies to all the software and all derived software and must appear on that software.
-
-That means that the license applies to the Shen source code and the Kl source code which comes with the download. You will see that this code carries a copyright on the code. The concept of derivative is explained in US law as follows.
-
-A 'derivative work' is a work based upon one or more pre-existing works, such as a translation, musical arrangement, dramatization, fictionalization, motion picture version, sound recording, art reproduction, abridgment, condensation, or any other form in which a work may be recast, transformed, or adapted. A work consisting of editorial revisions, annotations, elaborations, or other modifications which, as a whole, represent an original work of authorship, is a 'derivative work'.
-
-To this we add that any computable mapping of the Shen source code and the Kl source code to another medium i.e. another language; counts as a derivative work in our understanding, and it is immaterial whether this mapping is done by a human being or by a computer. If you map Shen into Javascript by writing a compiler, then the resulting Javascript program carries the same license as the original and that license must appear on the code. If you retitle some of the functions using a global substitution it is a derivative work. If you copy it out in copperplate using a quill, it is derivative. In other words, the message and not the medium is important. 
-
-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.
-
-This is basic. You cannot remove this license or change it - only the copyright holder can do that. 
-
-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.
-
-You cannot say 'My software is great because Mark Tarver recommends it' or 'Lambda Associates says this is really reliable' unless we did actually say that, and gave you the written permission to use our endorsement. That said, if you do write something really great in Shen, I'd be happy to endorse it and for you to use that endorsement.
-
-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. 
-
-This is the usual disclaimer. It protects us from a lawsuit in case anything goes wrong with our software. However Shen is based on a design with 20 years R&D; it has been very thoroughly tested by myself and by the people who have ported it to other platforms. So in all you are pretty safe here.
-
-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 and the original license. The user must it clear with his distribution that he/she is the author of the changes and what these changes are and why. 
-
-Shen sources are readable for several reasons. The first is that we want to allow people to read our code and correct mistakes. The second is that people porting Shen to different OSes and different platforms need open access to the code to do the porting. The last is we allow people to improve the efficiency of our code by changing it - as long as it then still works i.e. it conforms to the spec. You have to put your name on the changes you make, because, in the event that something goes wrong, we cannot take the moral responsibility for those changes. It should be obvious (I hope) that optimising a small piece of code does not change the license or allow you to change the license. The resulting work is still derivative.
-
-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.
-
-Again this emphasises what we said in explicating 1. This point just says you cannot evade the license by simply retitling and reselling our code under a different title e.g. Shine. 
-
-7. It is permitted to distribute versions of Shen which incorporate libraries, graphics or other facilities which are not part of the Shen standard.
-
-This means you are free to add things to Shen which are not part of the standard and you can distribute that work under the Shen title."

data/shen/release/k_lambda/core.kl

@@ -1,181 +0,0 @@
-"**********************************************************************************
-*                           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 shen.shen->kl (V614 V615) (compile (lambda X608 (shen.<define> X608)) (cons V614 V615) (lambda X (shen.shen-syntax-error V614 X))))
-
-(defun shen.shen-syntax-error (V616 V617) (simple-error (cn "syntax error in " (shen.app V616 (cn " here:
-
- " (shen.app (shen.next-50 50 V617) "
-" shen.a)) shen.a))))
-
-(defun shen.<define> (V622) (let Result (let Parse_shen.<name> (shen.<name> V622) (if (not (= (fail) Parse_shen.<name>)) (let Parse_shen.<signature> (shen.<signature> Parse_shen.<name>) (if (not (= (fail) Parse_shen.<signature>)) (let Parse_shen.<rules> (shen.<rules> Parse_shen.<signature>) (if (not (= (fail) Parse_shen.<rules>)) (shen.pair (hd Parse_shen.<rules>) (shen.compile_to_machine_code (shen.hdtl Parse_shen.<name>) (shen.hdtl Parse_shen.<rules>))) (fail))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<name> (shen.<name> V622) (if (not (= (fail) Parse_shen.<name>)) (let Parse_shen.<rules> (shen.<rules> Parse_shen.<name>) (if (not (= (fail) Parse_shen.<rules>)) (shen.pair (hd Parse_shen.<rules>) (shen.compile_to_machine_code (shen.hdtl Parse_shen.<name>) (shen.hdtl Parse_shen.<rules>))) (fail))) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
-
-(defun shen.<name> (V627) (let Result (if (cons? (hd V627)) (let Parse_X (hd (hd V627)) (shen.pair (hd (shen.pair (tl (hd V627)) (shen.hdtl V627))) (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)) (if (= Result (fail)) (fail) Result)))
-
-(defun shen.sysfunc? (V628) (element? V628 (get (intern "shen") shen.external-symbols (value *property-vector*))))
-
-(defun shen.<signature> (V633) (let Result (if (and (cons? (hd V633)) (= { (hd (hd V633)))) (let Parse_shen.<signature-help> (shen.<signature-help> (shen.pair (tl (hd V633)) (shen.hdtl V633))) (if (not (= (fail) Parse_shen.<signature-help>)) (if (and (cons? (hd Parse_shen.<signature-help>)) (= } (hd (hd Parse_shen.<signature-help>)))) (shen.pair (hd (shen.pair (tl (hd Parse_shen.<signature-help>)) (shen.hdtl Parse_shen.<signature-help>))) (shen.demodulate (shen.curry-type (shen.hdtl Parse_shen.<signature-help>)))) (fail)) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
-
-(defun shen.curry-type (V634) (cond ((and (cons? V634) (and (cons? (tl V634)) (and (= --> (hd (tl V634))) (and (cons? (tl (tl V634))) (and (cons? (tl (tl (tl V634)))) (= --> (hd (tl (tl (tl V634)))))))))) (shen.curry-type (cons (hd V634) (cons --> (cons (tl (tl V634)) ()))))) ((and (cons? V634) (and (cons? (tl V634)) (and (= * (hd (tl V634))) (and (cons? (tl (tl V634))) (and (cons? (tl (tl (tl V634)))) (= * (hd (tl (tl (tl V634)))))))))) (shen.curry-type (cons (hd V634) (cons * (cons (tl (tl V634)) ()))))) ((cons? V634) (map (lambda X609 (shen.curry-type X609)) V634)) (true V634)))
-
-(defun shen.<signature-help> (V639) (let Result (if (cons? (hd V639)) (let Parse_X (hd (hd V639)) (let Parse_shen.<signature-help> (shen.<signature-help> (shen.pair (tl (hd V639)) (shen.hdtl V639))) (if (not (= (fail) Parse_shen.<signature-help>)) (if (not (element? Parse_X (cons { (cons } ())))) (shen.pair (hd Parse_shen.<signature-help>) (cons Parse_X (shen.hdtl Parse_shen.<signature-help>))) (fail)) (fail)))) (fail)) (if (= Result (fail)) (let Result (let Parse_<e> (<e> V639) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) ()) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
-
-(defun shen.<rules> (V644) (let Result (let Parse_shen.<rule> (shen.<rule> V644) (if (not (= (fail) Parse_shen.<rule>)) (let Parse_shen.<rules> (shen.<rules> Parse_shen.<rule>) (if (not (= (fail) Parse_shen.<rules>)) (shen.pair (hd Parse_shen.<rules>) (cons (shen.linearise (shen.hdtl Parse_shen.<rule>)) (shen.hdtl Parse_shen.<rules>))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<rule> (shen.<rule> V644) (if (not (= (fail) Parse_shen.<rule>)) (shen.pair (hd Parse_shen.<rule>) (cons (shen.linearise (shen.hdtl Parse_shen.<rule>)) ())) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
-
-(defun shen.<rule> (V649) (let Result (let Parse_shen.<patterns> (shen.<patterns> V649) (if (not (= (fail) Parse_shen.<patterns>)) (if (and (cons? (hd Parse_shen.<patterns>)) (= -> (hd (hd Parse_shen.<patterns>)))) (let Parse_shen.<action> (shen.<action> (shen.pair (tl (hd Parse_shen.<patterns>)) (shen.hdtl Parse_shen.<patterns>))) (if (not (= (fail) Parse_shen.<action>)) (if (and (cons? (hd Parse_shen.<action>)) (= where (hd (hd Parse_shen.<action>)))) (let Parse_shen.<guard> (shen.<guard> (shen.pair (tl (hd Parse_shen.<action>)) (shen.hdtl Parse_shen.<action>))) (if (not (= (fail) Parse_shen.<guard>)) (shen.pair (hd Parse_shen.<guard>) (cons (shen.hdtl Parse_shen.<patterns>) (cons (cons where (cons (shen.hdtl Parse_shen.<guard>) (cons (shen.hdtl Parse_shen.<action>) ()))) ()))) (fail))) (fail)) (fail))) (fail)) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<patterns> (shen.<patterns> V649) (if (not (= (fail) Parse_shen.<patterns>)) (if (and (cons? (hd Parse_shen.<patterns>)) (= -> (hd (hd Parse_shen.<patterns>)))) (let Parse_shen.<action> (shen.<action> (shen.pair (tl (hd Parse_shen.<patterns>)) (shen.hdtl Parse_shen.<patterns>))) (if (not (= (fail) Parse_shen.<action>)) (shen.pair (hd Parse_shen.<action>) (cons (shen.hdtl Parse_shen.<patterns>) (cons (shen.hdtl Parse_shen.<action>) ()))) (fail))) (fail)) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<patterns> (shen.<patterns> V649) (if (not (= (fail) Parse_shen.<patterns>)) (if (and (cons? (hd Parse_shen.<patterns>)) (= <- (hd (hd Parse_shen.<patterns>)))) (let Parse_shen.<action> (shen.<action> (shen.pair (tl (hd Parse_shen.<patterns>)) (shen.hdtl Parse_shen.<patterns>))) (if (not (= (fail) Parse_shen.<action>)) (if (and (cons? (hd Parse_shen.<action>)) (= where (hd (hd Parse_shen.<action>)))) (let Parse_shen.<guard> (shen.<guard> (shen.pair (tl (hd Parse_shen.<action>)) (shen.hdtl Parse_shen.<action>))) (if (not (= (fail) Parse_shen.<guard>)) (shen.pair (hd Parse_shen.<guard>) (cons (shen.hdtl Parse_shen.<patterns>) (cons (cons where (cons (shen.hdtl Parse_shen.<guard>) (cons (cons shen.choicepoint! (cons (shen.hdtl Parse_shen.<action>) ())) ()))) ()))) (fail))) (fail)) (fail))) (fail)) (fail))) (if (= Result (fail)) (let Result (let Parse_shen.<patterns> (shen.<patterns> V649) (if (not (= (fail) Parse_shen.<patterns>)) (if (and (cons? (hd Parse_shen.<patterns>)) (= <- (hd (hd Parse_shen.<patterns>)))) (let Parse_shen.<action> (shen.<action> (shen.pair (tl (hd Parse_shen.<patterns>)) (shen.hdtl Parse_shen.<patterns>))) (if (not (= (fail) Parse_shen.<action>)) (shen.pair (hd Parse_shen.<action>) (cons (shen.hdtl Parse_shen.<patterns>) (cons (cons shen.choicepoint! (cons (shen.hdtl Parse_shen.<action>) ())) ()))) (fail))) (fail)) (fail))) (if (= Result (fail)) (fail) Result)) Result)) Result)) Result)))
-
-(defun shen.fail_if (V650 V651) (if (V650 V651) (fail) V651))
-
-(defun shen.succeeds? (V656) (cond ((= V656 (fail)) false) (true true)))
-
-(defun shen.<patterns> (V661) (let Result (let Parse_shen.<pattern> (shen.<pattern> V661) (if (not (= (fail) Parse_shen.<pattern>)) (let Parse_shen.<patterns> (shen.<patterns> Parse_shen.<pattern>) (if (not (= (fail) Parse_shen.<patterns>)) (shen.pair (hd Parse_shen.<patterns>) (cons (shen.hdtl Parse_shen.<pattern>) (shen.hdtl Parse_shen.<patterns>))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_<e> (<e> V661) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) ()) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
-
-(defun shen.<pattern> (V666) (let Result (if (and (cons? (hd V666)) (cons? (hd (hd V666)))) (shen.snd-or-fail (if (and (cons? (hd (shen.pair (hd (hd V666)) (shen.hdtl V666)))) (= @p (hd (hd (shen.pair (hd (hd V666)) (shen.hdtl V666)))))) (let Parse_shen.<pattern1> (shen.<pattern1> (shen.pair (tl (hd (shen.pair (hd (hd V666)) (shen.hdtl V666)))) (shen.hdtl (shen.pair (hd (hd V666)) (shen.hdtl V666))))) (if (not (= (fail) Parse_shen.<pattern1>)) (let Parse_shen.<pattern2> (shen.<pattern2> Parse_shen.<pattern1>) (if (not (= (fail) Parse_shen.<pattern2>)) (shen.pair (hd Parse_shen.<pattern2>) (shen.pair (hd (shen.pair (tl (hd V666)) (shen.hdtl V666))) (cons @p (cons (shen.hdtl Parse_shen.<pattern1>) (cons (shen.hdtl Parse_shen.<pattern2>) ()))))) (fail))) (fail))) (fail))) (fail)) (if (= Result (fail)) (let Result (if (and (cons? (hd V666)) (cons? (hd (hd V666)))) (shen.snd-or-fail (if (and (cons? (hd (shen.pair (hd (hd V666)) (shen.hdtl V666)))) (= cons (hd (hd (shen.pair (hd (hd V666)) (shen.hdtl V666)))))) (let Parse_shen.<pattern1> (shen.<pattern1> (shen.pair (tl (hd (shen.pair (hd (hd V666)) (shen.hdtl V666)))) (shen.hdtl (shen.pair (hd (hd V666)) (shen.hdtl V666))))) (if (not (= (fail) Parse_shen.<pattern1>)) (let Parse_shen.<pattern2> (shen.<pattern2> Parse_shen.<pattern1>) (if (not (= (fail) Parse_shen.<pattern2>)) (shen.pair (hd Parse_shen.<pattern2>) (shen.pair (hd (shen.pair (tl (hd V666)) (shen.hdtl V666))) (cons cons (cons (shen.hdtl Parse_shen.<pattern1>) (cons (shen.hdtl Parse_shen.<pattern2>) ()))))) (fail))) (fail))) (fail))) (fail)) (if (= Result (fail)) (let Result (if (and (cons? (hd V666)) (cons? (hd (hd V666)))) (shen.snd-or-fail (if (and (cons? (hd (shen.pair (hd (hd V666)) (shen.hdtl V666)))) (= @v (hd (hd (shen.pair (hd (hd V666)) (shen.hdtl V666)))))) (let Parse_shen.<pattern1> (shen.<pattern1> (shen.pair (tl (hd (shen.pair (hd (hd V666)) (shen.hdtl V666)))) (shen.hdtl (shen.pair (hd (hd V666)) (shen.hdtl V666))))) (if (not (= (fail) Parse_shen.<pattern1>)) (let Parse_shen.<pattern2> (shen.<pattern2> Parse_shen.<pattern1>) (if (not (= (fail) Parse_shen.<pattern2>)) (shen.pair (hd Parse_shen.<pattern2>) (shen.pair (hd (shen.pair (tl (hd V666)) (shen.hdtl V666))) (cons @v (cons (shen.hdtl Parse_shen.<pattern1>) (cons (shen.hdtl Parse_shen.<pattern2>) ()))))) (fail))) (fail))) (fail))) (fail)) (if (= Result (fail)) (let Result (if (and (cons? (hd V666)) (cons? (hd (hd V666)))) (shen.snd-or-fail (if (and (cons? (hd (shen.pair (hd (hd V666)) (shen.hdtl V666)))) (= @s (hd (hd (shen.pair (hd (hd V666)) (shen.hdtl V666)))))) (let Parse_shen.<pattern1> (shen.<pattern1> (shen.pair (tl (hd (shen.pair (hd (hd V666)) (shen.hdtl V666)))) (shen.hdtl (shen.pair (hd (hd V666)) (shen.hdtl V666))))) (if (not (= (fail) Parse_shen.<pattern1>)) (let Parse_shen.<pattern2> (shen.<pattern2> Parse_shen.<pattern1>) (if (not (= (fail) Parse_shen.<pattern2>)) (shen.pair (hd Parse_shen.<pattern2>) (shen.pair (hd (shen.pair (tl (hd V666)) (shen.hdtl V666))) (cons @s (cons (shen.hdtl Parse_shen.<pattern1>) (cons (shen.hdtl Parse_shen.<pattern2>) ()))))) (fail))) (fail))) (fail))) (fail)) (if (= Result (fail)) (let Result (if (and (cons? (hd V666)) (cons? (hd (hd V666)))) (shen.snd-or-fail (if (and (cons? (hd (shen.pair (hd (hd V666)) (shen.hdtl V666)))) (= vector (hd (hd (shen.pair (hd (hd V666)) (shen.hdtl V666)))))) (if (and (cons? (hd (shen.pair (tl (hd (shen.pair (hd (hd V666)) (shen.hdtl V666)))) (shen.hdtl (shen.pair (hd (hd V666)) (shen.hdtl V666)))))) (= 0 (hd (hd (shen.pair (tl (hd (shen.pair (hd (hd V666)) (shen.hdtl V666)))) (shen.hdtl (shen.pair (hd (hd V666)) (shen.hdtl V666)))))))) (shen.pair (hd (shen.pair (tl (hd (shen.pair (tl (hd (shen.pair (hd (hd V666)) (shen.hdtl V666)))) (shen.hdtl (shen.pair (hd (hd V666)) (shen.hdtl V666)))))) (shen.hdtl (shen.pair (tl (hd (shen.pair (hd (hd V666)) (shen.hdtl V666)))) (shen.hdtl (shen.pair (hd (hd V666)) (shen.hdtl V666))))))) (shen.pair (hd (shen.pair (tl (hd V666)) (shen.hdtl V666))) (cons vector (cons 0 ())))) (fail)) (fail))) (fail)) (if (= Result (fail)) (let Result (if (cons? (hd V666)) (let Parse_X (hd (hd V666)) (if (cons? Parse_X) (shen.pair (hd (shen.pair (tl (hd V666)) (shen.hdtl V666))) (shen.constructor-error Parse_X)) (fail))) (fail)) (if (= Result (fail)) (let Result (let Parse_shen.<simple_pattern> (shen.<simple_pattern> V666) (if (not (= (fail) Parse_shen.<simple_pattern>)) (shen.pair (hd Parse_shen.<simple_pattern>) (shen.hdtl Parse_shen.<simple_pattern>)) (fail))) (if (= Result (fail)) (fail) Result)) Result)) Result)) Result)) Result)) Result)) Result)))
-
-(defun shen.constructor-error (V667) (simple-error (shen.app V667 " is not a legitimate constructor
-" shen.a)))
-
-(defun shen.<simple_pattern> (V672) (let Result (if (cons? (hd V672)) (let Parse_X (hd (hd V672)) (if (= Parse_X _) (shen.pair (hd (shen.pair (tl (hd V672)) (shen.hdtl V672))) (gensym Parse_Y)) (fail))) (fail)) (if (= Result (fail)) (let Result (if (cons? (hd V672)) (let Parse_X (hd (hd V672)) (if (not (element? Parse_X (cons -> (cons <- ())))) (shen.pair (hd (shen.pair (tl (hd V672)) (shen.hdtl V672))) Parse_X) (fail))) (fail)) (if (= Result (fail)) (fail) Result)) Result)))
-
-(defun shen.<pattern1> (V677) (let Result (let Parse_shen.<pattern> (shen.<pattern> V677) (if (not (= (fail) Parse_shen.<pattern>)) (shen.pair (hd Parse_shen.<pattern>) (shen.hdtl Parse_shen.<pattern>)) (fail))) (if (= Result (fail)) (fail) Result)))
-
-(defun shen.<pattern2> (V682) (let Result (let Parse_shen.<pattern> (shen.<pattern> V682) (if (not (= (fail) Parse_shen.<pattern>)) (shen.pair (hd Parse_shen.<pattern>) (shen.hdtl Parse_shen.<pattern>)) (fail))) (if (= Result (fail)) (fail) Result)))
-
-(defun shen.<action> (V687) (let Result (if (cons? (hd V687)) (let Parse_X (hd (hd V687)) (shen.pair (hd (shen.pair (tl (hd V687)) (shen.hdtl V687))) Parse_X)) (fail)) (if (= Result (fail)) (fail) Result)))
-
-(defun shen.<guard> (V692) (let Result (if (cons? (hd V692)) (let Parse_X (hd (hd V692)) (shen.pair (hd (shen.pair (tl (hd V692)) (shen.hdtl V692))) Parse_X)) (fail)) (if (= Result (fail)) (fail) Result)))
-
-(defun shen.compile_to_machine_code (V693 V694) (let Lambda+ (shen.compile_to_lambda+ V693 V694) (let KL (shen.compile_to_kl V693 Lambda+) (let Record (shen.record-source V693 KL) KL))))
-
-(defun shen.record-source (V697 V698) (cond ((value shen.*installing-kl*) shen.skip) (true (put V697 shen.source V698 (value *property-vector*)))))
-
-(defun shen.compile_to_lambda+ (V699 V700) (let Arity (shen.aritycheck V699 V700) (let Free (map (lambda Rule (shen.free_variable_check V699 Rule)) V700) (let Variables (shen.parameters Arity) (let Strip (map (lambda X610 (shen.strip-protect X610)) V700) (let Abstractions (map (lambda X611 (shen.abstract_rule X611)) Strip) (let Applications (map (lambda X (shen.application_build Variables X)) Abstractions) (cons Variables (cons Applications ())))))))))
-
-(defun shen.free_variable_check (V701 V702) (cond ((and (cons? V702) (and (cons? (tl V702)) (= () (tl (tl V702))))) (let Bound (shen.extract_vars (hd V702)) (let Free (shen.extract_free_vars Bound (hd (tl V702))) (shen.free_variable_warnings V701 Free)))) (true (shen.sys-error shen.free_variable_check))))
-
-(defun shen.extract_vars (V703) (cond ((variable? V703) (cons V703 ())) ((cons? V703) (union (shen.extract_vars (hd V703)) (shen.extract_vars (tl V703)))) (true ())))
-
-(defun shen.extract_free_vars (V713 V714) (cond ((and (cons? V714) (and (cons? (tl V714)) (and (= () (tl (tl V714))) (= (hd V714) protect)))) ()) ((and (variable? V714) (not (element? V714 V713))) (cons V714 ())) ((and (cons? V714) (and (= lambda (hd V714)) (and (cons? (tl V714)) (and (cons? (tl (tl V714))) (= () (tl (tl (tl V714)))))))) (shen.extract_free_vars (cons (hd (tl V714)) V713) (hd (tl (tl V714))))) ((and (cons? V714) (and (= let (hd V714)) (and (cons? (tl V714)) (and (cons? (tl (tl V714))) (and (cons? (tl (tl (tl V714)))) (= () (tl (tl (tl (tl V714)))))))))) (union (shen.extract_free_vars V713 (hd (tl (tl V714)))) (shen.extract_free_vars (cons (hd (tl V714)) V713) (hd (tl (tl (tl V714))))))) ((cons? V714) (union (shen.extract_free_vars V713 (hd V714)) (shen.extract_free_vars V713 (tl V714)))) (true ())))
-
-(defun shen.free_variable_warnings (V717 V718) (cond ((= () V718) _) (true (simple-error (cn "error: the following variables are free in " (shen.app V717 (cn ": " (shen.app (shen.list_variables V718) "" shen.a)) shen.a))))))
-
-(defun shen.list_variables (V719) (cond ((and (cons? V719) (= () (tl V719))) (cn (str (hd V719)) ".")) ((cons? V719) (cn (str (hd V719)) (cn ", " (shen.list_variables (tl V719))))) (true (shen.sys-error shen.list_variables))))
-
-(defun shen.strip-protect (V720) (cond ((and (cons? V720) (and (cons? (tl V720)) (and (= () (tl (tl V720))) (= (hd V720) protect)))) (hd (tl V720))) ((cons? V720) (cons (shen.strip-protect (hd V720)) (shen.strip-protect (tl V720)))) (true V720)))
-
-(defun shen.linearise (V721) (cond ((and (cons? V721) (and (cons? (tl V721)) (= () (tl (tl V721))))) (shen.linearise_help (shen.flatten (hd V721)) (hd V721) (hd (tl V721)))) (true (shen.sys-error shen.linearise))))
-
-(defun shen.flatten (V722) (cond ((= () V722) ()) ((cons? V722) (append (shen.flatten (hd V722)) (shen.flatten (tl V722)))) (true (cons V722 ()))))
-
-(defun shen.linearise_help (V723 V724 V725) (cond ((= () V723) (cons V724 (cons V725 ()))) ((cons? V723) (if (and (variable? (hd V723)) (element? (hd V723) (tl V723))) (let Var (gensym (hd V723)) (let NewAction (cons where (cons (cons = (cons (hd V723) (cons Var ()))) (cons V725 ()))) (let NewPatts (shen.linearise_X (hd V723) Var V724) (shen.linearise_help (tl V723) NewPatts NewAction)))) (shen.linearise_help (tl V723) V724 V725))) (true (shen.sys-error shen.linearise_help))))
-
-(defun shen.linearise_X (V734 V735 V736) (cond ((= V736 V734) V735) ((cons? V736) (let L (shen.linearise_X V734 V735 (hd V736)) (if (= L (hd V736)) (cons (hd V736) (shen.linearise_X V734 V735 (tl V736))) (cons L (tl V736))))) (true V736)))
-
-(defun shen.aritycheck (V738 V739) (cond ((and (cons? V739) (and (cons? (hd V739)) (and (cons? (tl (hd V739))) (and (= () (tl (tl (hd V739)))) (= () (tl V739)))))) (do (shen.aritycheck-action (hd (tl (hd V739)))) (shen.aritycheck-name V738 (arity V738) (length (hd (hd V739)))))) ((and (cons? V739) (and (cons? (hd V739)) (and (cons? (tl (hd V739))) (and (= () (tl (tl (hd V739)))) (and (cons? (tl V739)) (and (cons? (hd (tl V739))) (and (cons? (tl (hd (tl V739)))) (= () (tl (tl (hd (tl V739)))))))))))) (if (= (length (hd (hd V739))) (length (hd (hd (tl V739))))) (do (shen.aritycheck-action (hd (tl (hd V739)))) (shen.aritycheck V738 (tl V739))) (simple-error (cn "arity error in " (shen.app V738 "
-" shen.a))))) (true (shen.sys-error shen.aritycheck))))
-
-(defun shen.aritycheck-name (V748 V749 V750) (cond ((= -1 V749) V750) ((= V750 V749) V750) (true (do (shen.prhush (cn "
-warning: changing the arity of " (shen.app V748 " can cause errors.
-" shen.a)) (stoutput)) V750))))
-
-(defun shen.aritycheck-action (V756) (cond ((cons? V756) (do (shen.aah (hd V756) (tl V756)) (map (lambda X612 (shen.aritycheck-action X612)) V756))) (true shen.skip)))
-
-(defun shen.aah (V757 V758) (let Arity (arity V757) (let Len (length V758) (if (and (> Arity -1) (> Len Arity)) (shen.prhush (cn "warning: " (shen.app V757 (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 (V759) (cond ((and (cons? V759) (and (cons? (tl V759)) (= () (tl (tl V759))))) (shen.abstraction_build (hd V759) (hd (tl V759)))) (true (shen.sys-error shen.abstract_rule))))
-
-(defun shen.abstraction_build (V760 V761) (cond ((= () V760) V761) ((cons? V760) (cons /. (cons (hd V760) (cons (shen.abstraction_build (tl V760) V761) ())))) (true (shen.sys-error shen.abstraction_build))))
-
-(defun shen.parameters (V762) (cond ((= 0 V762) ()) (true (cons (gensym V) (shen.parameters (- V762 1))))))
-
-(defun shen.application_build (V763 V764) (cond ((= () V763) V764) ((cons? V763) (shen.application_build (tl V763) (cons V764 (cons (hd V763) ())))) (true (shen.sys-error shen.application_build))))
-
-(defun shen.compile_to_kl (V765 V766) (cond ((and (cons? V766) (and (cons? (tl V766)) (= () (tl (tl V766))))) (let Arity (shen.store-arity V765 (length (hd V766))) (let Reduce (map (lambda X613 (shen.reduce X613)) (hd (tl V766))) (let CondExpression (shen.cond-expression V765 (hd V766) Reduce) (let TypeTable (if (value shen.*optimise*) (shen.typextable (shen.get-type V765) (hd V766)) shen.skip) (let TypedCondExpression (if (value shen.*optimise*) (shen.assign-types (hd V766) TypeTable CondExpression) CondExpression) (let KL (cons defun (cons V765 (cons (hd V766) (cons TypedCondExpression ())))) KL))))))) (true (shen.sys-error shen.compile_to_kl))))
-
-(defun shen.get-type (V771) (cond ((cons? V771) shen.skip) (true (let FType (assoc V771 (value shen.*signedfuncs*)) (if (empty? FType) shen.skip (tl FType))))))
-
-(defun shen.typextable (V780 V781) (cond ((and (cons? V780) (and (cons? (tl V780)) (and (= --> (hd (tl V780))) (and (cons? (tl (tl V780))) (and (= () (tl (tl (tl V780)))) (cons? V781)))))) (if (variable? (hd V780)) (shen.typextable (hd (tl (tl V780))) (tl V781)) (cons (cons (hd V781) (hd V780)) (shen.typextable (hd (tl (tl V780))) (tl V781))))) (true ())))
-
-(defun shen.assign-types (V782 V783 V784) (cond ((and (cons? V784) (and (= let (hd V784)) (and (cons? (tl V784)) (and (cons? (tl (tl V784))) (and (cons? (tl (tl (tl V784)))) (= () (tl (tl (tl (tl V784)))))))))) (cons let (cons (hd (tl V784)) (cons (shen.assign-types V782 V783 (hd (tl (tl V784)))) (cons (shen.assign-types (cons (hd (tl V784)) V782) V783 (hd (tl (tl (tl V784))))) ()))))) ((and (cons? V784) (and (= lambda (hd V784)) (and (cons? (tl V784)) (and (cons? (tl (tl V784))) (= () (tl (tl (tl V784)))))))) (cons lambda (cons (hd (tl V784)) (cons (shen.assign-types (cons (hd (tl V784)) V782) V783 (hd (tl (tl V784)))) ())))) ((and (cons? V784) (= cond (hd V784))) (cons cond (map (lambda Y (cons (shen.assign-types V782 V783 (hd Y)) (cons (shen.assign-types V782 V783 (hd (tl Y))) ()))) (tl V784)))) ((cons? V784) (let NewTable (shen.typextable (shen.get-type (hd V784)) (tl V784)) (cons (hd V784) (map (lambda Y (shen.assign-types V782 (append V783 NewTable) Y)) (tl V784))))) (true (let AtomType (assoc V784 V783) (if (cons? AtomType) (cons type (cons V784 (cons (tl AtomType) ()))) (if (element? V784 V782) V784 (shen.atom-type V784)))))))
-
-(defun shen.atom-type (V785) (if (string? V785) (cons type (cons V785 (cons string ()))) (if (number? V785) (cons type (cons V785 (cons number ()))) (if (boolean? V785) (cons type (cons V785 (cons boolean ()))) (if (symbol? V785) (cons type (cons V785 (cons symbol ()))) V785)))))
-
-(defun shen.store-arity (V788 V789) (cond ((value shen.*installing-kl*) shen.skip) (true (put V788 arity V789 (value *property-vector*)))))
-
-(defun shen.reduce (V790) (do (set shen.*teststack* ()) (let Result (shen.reduce_help V790) (cons (cons : (cons shen.tests (reverse (value shen.*teststack*)))) (cons Result ())))))
-
-(defun shen.reduce_help (V791) (cond ((and (cons? V791) (and (cons? (hd V791)) (and (= /. (hd (hd V791))) (and (cons? (tl (hd V791))) (and (cons? (hd (tl (hd V791)))) (and (= cons (hd (hd (tl (hd V791))))) (and (cons? (tl (hd (tl (hd V791))))) (and (cons? (tl (tl (hd (tl (hd V791)))))) (and (= () (tl (tl (tl (hd (tl (hd V791))))))) (and (cons? (tl (tl (hd V791)))) (and (= () (tl (tl (tl (hd V791))))) (and (cons? (tl V791)) (= () (tl (tl V791))))))))))))))) (do (shen.add_test (cons cons? (tl V791))) (let Abstraction (cons /. (cons (hd (tl (hd (tl (hd V791))))) (cons (cons /. (cons (hd (tl (tl (hd (tl (hd V791)))))) (cons (shen.ebr (hd (tl V791)) (hd (tl (hd V791))) (hd (tl (tl (hd V791))))) ()))) ()))) (let Application (cons (cons Abstraction (cons (cons hd (tl V791)) ())) (cons (cons tl (tl V791)) ())) (shen.reduce_help Application))))) ((and (cons? V791) (and (cons? (hd V791)) (and (= /. (hd (hd V791))) (and (cons? (tl (hd V791))) (and (cons? (hd (tl (hd V791)))) (and (= @p (hd (hd (tl (hd V791))))) (and (cons? (tl (hd (tl (hd V791))))) (and (cons? (tl (tl (hd (tl (hd V791)))))) (and (= () (tl (tl (tl (hd (tl (hd V791))))))) (and (cons? (tl (tl (hd V791)))) (and (= () (tl (tl (tl (hd V791))))) (and (cons? (tl V791)) (= () (tl (tl V791))))))))))))))) (do (shen.add_test (cons tuple? (tl V791))) (let Abstraction (cons /. (cons (hd (tl (hd (tl (hd V791))))) (cons (cons /. (cons (hd (tl (tl (hd (tl (hd V791)))))) (cons (shen.ebr (hd (tl V791)) (hd (tl (hd V791))) (hd (tl (tl (hd V791))))) ()))) ()))) (let Application (cons (cons Abstraction (cons (cons fst (tl V791)) ())) (cons (cons snd (tl V791)) ())) (shen.reduce_help Application))))) ((and (cons? V791) (and (cons? (hd V791)) (and (= /. (hd (hd V791))) (and (cons? (tl (hd V791))) (and (cons? (hd (tl (hd V791)))) (and (= @v (hd (hd (tl (hd V791))))) (and (cons? (tl (hd (tl (hd V791))))) (and (cons? (tl (tl (hd (tl (hd V791)))))) (and (= () (tl (tl (tl (hd (tl (hd V791))))))) (and (cons? (tl (tl (hd V791)))) (and (= () (tl (tl (tl (hd V791))))) (and (cons? (tl V791)) (= () (tl (tl V791))))))))))))))) (do (shen.add_test (cons shen.+vector? (tl V791))) (let Abstraction (cons /. (cons (hd (tl (hd (tl (hd V791))))) (cons (cons /. (cons (hd (tl (tl (hd (tl (hd V791)))))) (cons (shen.ebr (hd (tl V791)) (hd (tl (hd V791))) (hd (tl (tl (hd V791))))) ()))) ()))) (let Application (cons (cons Abstraction (cons (cons hdv (tl V791)) ())) (cons (cons tlv (tl V791)) ())) (shen.reduce_help Application))))) ((and (cons? V791) (and (cons? (hd V791)) (and (= /. (hd (hd V791))) (and (cons? (tl (hd V791))) (and (cons? (hd (tl (hd V791)))) (and (= @s (hd (hd (tl (hd V791))))) (and (cons? (tl (hd (tl (hd V791))))) (and (cons? (tl (tl (hd (tl (hd V791)))))) (and (= () (tl (tl (tl (hd (tl (hd V791))))))) (and (cons? (tl (tl (hd V791)))) (and (= () (tl (tl (tl (hd V791))))) (and (cons? (tl V791)) (= () (tl (tl V791))))))))))))))) (do (shen.add_test (cons shen.+string? (tl V791))) (let Abstraction (cons /. (cons (hd (tl (hd (tl (hd V791))))) (cons (cons /. (cons (hd (tl (tl (hd (tl (hd V791)))))) (cons (shen.ebr (hd (tl V791)) (hd (tl (hd V791))) (hd (tl (tl (hd V791))))) ()))) ()))) (let Application (cons (cons Abstraction (cons (cons pos (cons (hd (tl V791)) (cons 0 ()))) ())) (cons (cons tlstr (tl V791)) ())) (shen.reduce_help Application))))) ((and (cons? V791) (and (cons? (hd V791)) (and (= /. (hd (hd V791))) (and (cons? (tl (hd V791))) (and (cons? (tl (tl (hd V791)))) (and (= () (tl (tl (tl (hd V791))))) (and (cons? (tl V791)) (and (= () (tl (tl V791))) (not (variable? (hd (tl (hd V791))))))))))))) (do (shen.add_test (cons = (cons (hd (tl (hd V791))) (tl V791)))) (shen.reduce_help (hd (tl (tl (hd V791))))))) ((and (cons? V791) (and (cons? (hd V791)) (and (= /. (hd (hd V791))) (and (cons? (tl (hd V791))) (and (cons? (tl (tl (hd V791)))) (and (= () (tl (tl (tl (hd V791))))) (and (cons? (tl V791)) (= () (tl (tl V791)))))))))) (shen.reduce_help (shen.ebr (hd (tl V791)) (hd (tl (hd V791))) (hd (tl (tl (hd V791))))))) ((and (cons? V791) (and (= where (hd V791)) (and (cons? (tl V791)) (and (cons? (tl (tl V791))) (= () (tl (tl (tl V791)))))))) (do (shen.add_test (hd (tl V791))) (shen.reduce_help (hd (tl (tl V791)))))) ((and (cons? V791) (and (cons? (tl V791)) (= () (tl (tl V791))))) (let Z (shen.reduce_help (hd V791)) (if (= (hd V791) Z) V791 (shen.reduce_help (cons Z (tl V791)))))) (true V791)))
-
-(defun shen.+string? (V792) (cond ((= "" V792) false) (true (string? V792))))
-
-(defun shen.+vector (V793) (cond ((= V793 (vector 0)) false) (true (vector? V793))))
-
-(defun shen.ebr (V802 V803 V804) (cond ((= V804 V803) V802) ((and (cons? V804) (and (= /. (hd V804)) (and (cons? (tl V804)) (and (cons? (tl (tl V804))) (and (= () (tl (tl (tl V804)))) (> (occurrences V803 (hd (tl V804))) 0)))))) V804) ((and (cons? V804) (and (= let (hd V804)) (and (cons? (tl V804)) (and (cons? (tl (tl V804))) (and (cons? (tl (tl (tl V804)))) (and (= () (tl (tl (tl (tl V804))))) (= (hd (tl V804)) V803))))))) (cons let (cons (hd (tl V804)) (cons (shen.ebr V802 (hd (tl V804)) (hd (tl (tl V804)))) (tl (tl (tl V804))))))) ((cons? V804) (cons (shen.ebr V802 V803 (hd V804)) (shen.ebr V802 V803 (tl V804)))) (true V804)))
-
-(defun shen.add_test (V807) (set shen.*teststack* (cons V807 (value shen.*teststack*))))
-
-(defun shen.cond-expression (V808 V809 V810) (let Err (shen.err-condition V808) (let Cases (shen.case-form V810 Err) (let EncodeChoices (shen.encode-choices Cases V808) (shen.cond-form EncodeChoices)))))
-
-(defun shen.cond-form (V813) (cond ((and (cons? V813) (and (cons? (hd V813)) (and (= true (hd (hd V813))) (and (cons? (tl (hd V813))) (= () (tl (tl (hd V813)))))))) (hd (tl (hd V813)))) (true (cons cond V813))))
-
-(defun shen.encode-choices (V816 V817) (cond ((= () V816) ()) ((and (cons? V816) (and (cons? (hd V816)) (and (= true (hd (hd V816))) (and (cons? (tl (hd V816))) (and (cons? (hd (tl (hd V816)))) (and (= shen.choicepoint! (hd (hd (tl (hd V816))))) (and (cons? (tl (hd (tl (hd V816))))) (and (= () (tl (tl (hd (tl (hd V816)))))) (and (= () (tl (tl (hd V816)))) (= () (tl V816))))))))))) (cons (cons true (cons (cons let (cons Result (cons (hd (tl (hd (tl (hd V816))))) (cons (cons if (cons (cons = (cons Result (cons (cons fail ()) ()))) (cons (if (value shen.*installing-kl*) (cons shen.sys-error (cons V817 ())) (cons shen.f_error (cons V817 ()))) (cons Result ())))) ())))) ())) ())) ((and (cons? V816) (and (cons? (hd V816)) (and (= true (hd (hd V816))) (and (cons? (tl (hd V816))) (and (cons? (hd (tl (hd V816)))) (and (= shen.choicepoint! (hd (hd (tl (hd V816))))) (and (cons? (tl (hd (tl (hd V816))))) (and (= () (tl (tl (hd (tl (hd V816)))))) (= () (tl (tl (hd V816)))))))))))) (cons (cons true (cons (cons let (cons Result (cons (hd (tl (hd (tl (hd V816))))) (cons (cons if (cons (cons = (cons Result (cons (cons fail ()) ()))) (cons (shen.cond-form (shen.encode-choices (tl V816) V817)) (cons Result ())))) ())))) ())) ())) ((and (cons? V816) (and (cons? (hd V816)) (and (cons? (tl (hd V816))) (and (cons? (hd (tl (hd V816)))) (and (= shen.choicepoint! (hd (hd (tl (hd V816))))) (and (cons? (tl (hd (tl (hd V816))))) (and (= () (tl (tl (hd (tl (hd V816)))))) (= () (tl (tl (hd V816))))))))))) (cons (cons true (cons (cons let (cons Freeze (cons (cons freeze (cons (shen.cond-form (shen.encode-choices (tl V816) V817)) ())) (cons (cons if (cons (hd (hd V816)) (cons (cons let (cons Result (cons (hd (tl (hd (tl (hd V816))))) (cons (cons if (cons (cons = (cons Result (cons (cons fail ()) ()))) (cons (cons thaw (cons Freeze ())) (cons Result ())))) ())))) (cons (cons thaw (cons Freeze ())) ())))) ())))) ())) ())) ((and (cons? V816) (and (cons? (hd V816)) (and (cons? (tl (hd V816))) (= () (tl (tl (hd V816))))))) (cons (hd V816) (shen.encode-choices (tl V816) V817))) (true (shen.sys-error shen.encode-choices))))
-
-(defun shen.case-form (V822 V823) (cond ((= () V822) (cons V823 ())) ((and (cons? V822) (and (cons? (hd V822)) (and (cons? (hd (hd V822))) (and (= : (hd (hd (hd V822)))) (and (cons? (tl (hd (hd V822)))) (and (= shen.tests (hd (tl (hd (hd V822))))) (and (= () (tl (tl (hd (hd V822))))) (and (cons? (tl (hd V822))) (and (cons? (hd (tl (hd V822)))) (and (= shen.choicepoint! (hd (hd (tl (hd V822))))) (and (cons? (tl (hd (tl (hd V822))))) (and (= () (tl (tl (hd (tl (hd V822)))))) (= () (tl (tl (hd V822)))))))))))))))) (cons (cons true (tl (hd V822))) (shen.case-form (tl V822) V823))) ((and (cons? V822) (and (cons? (hd V822)) (and (cons? (hd (hd V822))) (and (= : (hd (hd (hd V822)))) (and (cons? (tl (hd (hd V822)))) (and (= shen.tests (hd (tl (hd (hd V822))))) (and (= () (tl (tl (hd (hd V822))))) (and (cons? (tl (hd V822))) (= () (tl (tl (hd V822)))))))))))) (cons (cons true (tl (hd V822))) ())) ((and (cons? V822) (and (cons? (hd V822)) (and (cons? (hd (hd V822))) (and (= : (hd (hd (hd V822)))) (and (cons? (tl (hd (hd V822)))) (and (= shen.tests (hd (tl (hd (hd V822))))) (and (cons? (tl (hd V822))) (= () (tl (tl (hd V822))))))))))) (cons (cons (shen.embed-and (tl (tl (hd (hd V822))))) (tl (hd V822))) (shen.case-form (tl V822) V823))) (true (shen.sys-error shen.case-form))))
-
-(defun shen.embed-and (V824) (cond ((and (cons? V824) (= () (tl V824))) (hd V824)) ((cons? V824) (cons and (cons (hd V824) (cons (shen.embed-and (tl V824)) ())))) (true (shen.sys-error shen.embed-and))))
-
-(defun shen.err-condition (V825) (cons true (cons (cons shen.f_error (cons V825 ())) ())))
-
-(defun shen.sys-error (V826) (simple-error (cn "system function " (shen.app V826 ": unexpected argument
-" shen.a))))
-
-
-

data/shen/release/k_lambda/declarations.kl

@@ -1,131 +0,0 @@
-"**********************************************************************************
-*                           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.                                                        *
-*				 						                                                                    *
-*****************************************************************************************
-"(set shen.*installing-kl* false)
-
-(set shen.*history* ())
-
-(set shen.*tc* false)
-
-(set *property-vector* (vector 20000))
-
-(set shen.*process-counter* 0)
-
-(set shen.*varcounter* (vector 1000))
-
-(set shen.*prologvectors* (vector 1000))
-
-(set shen.*reader-macros* ())
-
-(set *home-directory* ())
-
-(set shen.*gensym* 0)
-
-(set shen.*tracking* ())
-
-(set *home-directory* "")
-
-(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 ())))))))))))))))))))))))))))
-
-(set shen.*special* (cons @p (cons @s (cons @v (cons cons (cons lambda (cons let (cons where (cons set (cons open ()))))))))))
-
-(set shen.*extraspecial* (cons define (cons shen.process-datatype (cons input+ (cons defcc (cons read+ (cons defmacro ())))))))
-
-(set shen.*spy* false)
-
-(set shen.*datatypes* ())
-
-(set shen.*alldatatypes* ())
-
-(set shen.*shen-type-theory-enabled?* true)
-
-(set shen.*synonyms* ())
-
-(set shen.*system* ())
-
-(set shen.*signedfuncs* ())
-
-(set shen.*maxcomplexity* 128)
-
-(set shen.*occurs* true)
-
-(set shen.*maxinferences* 1000000)
-
-(set *maximum-print-sequence-size* 20)
-
-(set shen.*catch* 0)
-
-(set shen.*call* 0)
-
-(set shen.*infs* 0)
-
-(set *hush* false)
-
-(set shen.*optimise* false)
-
-(set *version* "version 16")
-
-(defun shen.initialise_arity_table (V827) (cond ((= () V827) ()) ((and (cons? V827) (cons? (tl V827))) (let DecArity (put (hd V827) arity (hd (tl V827)) (value *property-vector*)) (shen.initialise_arity_table (tl (tl V827))))) (true (shen.sys-error shen.initialise_arity_table))))
-
-(defun arity (V828) (trap-error (get V828 arity (value *property-vector*)) (lambda E -1)))
-
-(shen.initialise_arity_table (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 cd (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 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 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 it (cons 0 (cons kill (cons 0 (cons language (cons 0 (cons length (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 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 optimise (cons 1 (cons or (cons 2 (cons os (cons 0 (cons package (cons 3 (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 (cons 1 (cons read-byte (cons 1 (cons read-from-string (cons 1 (cons release (cons 0 (cons remove (cons 2 (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 string->n (cons 1 (cons string->symbol (cons 1 (cons string? (cons 1 (cons shen.strong-warning (cons 1 (cons subst (cons 3 (cons sum (cons 1 (cons symbol? (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 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 3 (cons value (cons 1 (cons variable? (cons 1 (cons version (cons 0 (cons warn (cons 1 (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 <e> (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 (cons where (cons 2 ())))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
-
-(defun systemf (V829) (let Shen (intern "shen") (let External (get Shen shen.external-symbols (value *property-vector*)) (put Shen shen.external-symbols (adjoin V829 External) (value *property-vector*)))))
-
-(defun adjoin (V830 V831) (if (element? V830 V831) V831 (cons V830 V831)))
-
-(put (intern "shen") shen.external-symbols (cons ! (cons } (cons { (cons --> (cons <-- (cons && (cons : (cons ; (cons :- (cons := (cons _ (cons *language* (cons *implementation* (cons *stinput* (cons *home-directory* (cons *version* (cons *maximum-print-sequence-size* (cons *macros* (cons *os* (cons *release* (cons *property-vector* (cons @v (cons @p (cons @s (cons *port* (cons *porters* (cons *hush* (cons <- (cons -> (cons <e> (cons == (cons = (cons >= (cons > (cons /. (cons =! (cons $ (cons - (cons / (cons * (cons + (cons <= (cons < (cons >> (cons (vector 0) (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 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 subst (cons string? (cons string->n (cons stream (cons string (cons stinput (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 read-file (cons read-file-as-bytelist (cons read-file-as-string (cons read-byte (cons read-from-string (cons quit (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 macro (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 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 append (cons and (cons adjoin (cons <-address (cons address-> (cons absvector? (cons absvector (cons abort ()))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) (value *property-vector*))
-
-(defun specialise (V832) (do (set shen.*special* (cons V832 (value shen.*special*))) V832))
-
-(defun unspecialise (V833) (do (set shen.*special* (remove V833 (value shen.*special*))) V833))
-
-
-