shen-ruby 0.12.1 → 0.13.0

data/shen/release/klambda/declarations.kl

@@ -0,0 +1,109 @@
+"Copyright (c) 2015, Mark Tarver
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+1. Redistributions of source code must retain the above copyright
+   notice, this list of conditions and the following disclaimer.
+2. Redistributions in binary form must reproduce the above copyright
+   notice, this list of conditions and the following disclaimer in the
+   documentation and/or other materials provided with the distribution.
+3. The name of Mark Tarver may not be used to endorse or promote products
+   derived from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY Mark Tarver ''AS IS'' AND ANY
+EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL Mark Tarver BE LIABLE FOR ANY
+DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE."
+
+(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.*macroreg* (cons shen.timer-macro (cons shen.cases-macro (cons shen.abs-macro (cons shen.put/get-macro (cons shen.compile-macro (cons shen.datatype-macro (cons shen.let-macro (cons shen.assoc-macro (cons shen.make-string-macro (cons shen.output-macro (cons shen.input-macro (cons shen.error-macro (cons shen.prolog-macro (cons shen.synonyms-macro (cons shen.nl-macro (cons shen.@s-macro (cons shen.defprolog-macro (cons shen.function-macro ())))))))))))))))))))
+
+(set *macros* (cons (lambda X (shen.timer-macro X)) (cons (lambda X (shen.cases-macro X)) (cons (lambda X (shen.abs-macro X)) (cons (lambda X (shen.put/get-macro X)) (cons (lambda X (shen.compile-macro X)) (cons (lambda X (shen.datatype-macro X)) (cons (lambda X (shen.let-macro X)) (cons (lambda X (shen.assoc-macro X)) (cons (lambda X (shen.make-string-macro X)) (cons (lambda X (shen.output-macro X)) (cons (lambda X (shen.input-macro X)) (cons (lambda X (shen.error-macro X)) (cons (lambda X (shen.prolog-macro X)) (cons (lambda X (shen.synonyms-macro X)) (cons (lambda X (shen.nl-macro X)) (cons (lambda X (shen.@s-macro X)) (cons (lambda X (shen.defprolog-macro X)) (cons (lambda X (shen.function-macro X)) ())))))))))))))))))))
+
+(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 shen.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* "Shen 17")
+
+(defun shen.initialise_arity_table (V717) (cond ((= () V717) ()) ((and (cons? V717) (cons? (tl V717))) (let DecArity (put (hd V717) arity (hd (tl V717)) (value *property-vector*)) (shen.initialise_arity_table (tl (tl V717))))) (true (shen.f_error shen.initialise_arity_table))))
+
+(defun arity (V718) (trap-error (get V718 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 shen.interror (cons 2 (cons eval (cons 1 (cons eval-kl (cons 1 (cons explode (cons 1 (cons external (cons 1 (cons fail-if (cons 2 (cons fail (cons 0 (cons fix (cons 2 (cons findall (cons 5 (cons freeze (cons 1 (cons fst (cons 1 (cons gensym (cons 1 (cons get (cons 3 (cons get-time (cons 1 (cons address-> (cons 3 (cons <-address (cons 2 (cons <-vector (cons 2 (cons > (cons 2 (cons >= (cons 2 (cons = (cons 2 (cons 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 package? (cons 1 (cons port (cons 0 (cons porters (cons 0 (cons pos (cons 2 (cons print (cons 1 (cons profile (cons 1 (cons profile-results (cons 1 (cons pr (cons 2 (cons ps (cons 1 (cons preclude (cons 1 (cons preclude-all-but (cons 1 (cons protect (cons 1 (cons address-> (cons 3 (cons put (cons 4 (cons shen.reassemble (cons 2 (cons read-file-as-string (cons 1 (cons read-file (cons 1 (cons read (cons 1 (cons read-byte (cons 1 (cons read-from-string (cons 1 (cons release (cons 0 (cons remove (cons 2 (cons require (cons 3 (cons reverse (cons 1 (cons set (cons 2 (cons simple-error (cons 1 (cons snd (cons 1 (cons specialise (cons 1 (cons spy (cons 1 (cons step (cons 1 (cons stinput (cons 0 (cons stoutput (cons 0 (cons string->n (cons 1 (cons string->symbol (cons 1 (cons string? (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 unput (cons 3 (cons unprofile (cons 1 (cons unify (cons 4 (cons unify! (cons 4 (cons union (cons 2 (cons untrack (cons 1 (cons unspecialise (cons 1 (cons undefmacro (cons 1 (cons vector (cons 1 (cons vector-> (cons 3 (cons value (cons 1 (cons variable? (cons 1 (cons version (cons 0 (cons write-byte (cons 2 (cons write-to-file (cons 2 (cons y-or-n? (cons 1 (cons + (cons 2 (cons * (cons 2 (cons / (cons 2 (cons - (cons 2 (cons == (cons 2 (cons <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 (V719) (let Shen (intern "shen") (let External (get Shen shen.external-symbols (value *property-vector*)) (let Place (put Shen shen.external-symbols (adjoin V719 External) (value *property-vector*)) V719))))
+
+(defun adjoin (V720 V721) (if (element? V720 V721) V721 (cons V720 V721)))
+
+(put (intern "shen") shen.external-symbols (cons ! (cons } (cons { (cons --> (cons <-- (cons && (cons : (cons ; (cons :- (cons := (cons _ (cons *language* (cons *implementation* (cons *stinput* (cons *stoutput* (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 y-or-n? (cons write-to-file (cons write-byte (cons where (cons when (cons warn (cons version (cons verified (cons variable? (cons value (cons vector-> (cons <-vector (cons vector (cons vector? (cons unspecialise (cons untrack (cons unit (cons shen.unix (cons union (cons unify (cons unify! (cons unput (cons unprofile (cons undefmacro (cons return (cons type (cons tuple? (cons true (cons trap-error (cons track (cons time (cons thaw (cons tc? (cons tc (cons tl (cons tlstr (cons tlv (cons tail (cons systemf (cons synonyms (cons symbol (cons symbol? (cons string->symbol (cons sum (cons subst (cons string? (cons string->n (cons stream (cons string (cons stinput (cons 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 require (cons read-file-as-bytelist (cons read-file-as-string (cons read-byte (cons read-from-string (cons package? (cons put (cons preclude (cons preclude-all-but (cons ps (cons prolog? (cons protect (cons profile-results (cons profile (cons print (cons pr (cons pos (cons porters (cons port (cons package (cons output (cons out (cons os (cons or (cons optimise (cons open (cons occurrences (cons occurs-check (cons n->string (cons number? (cons number (cons null (cons nth (cons not (cons nl (cons mode (cons macroexpand (cons maxinferences (cons mapcan (cons map (cons make-string (cons load (cons loaded (cons list (cons lineread (cons limit (cons length (cons let (cons lazy (cons lambda (cons language (cons kill (cons is (cons intersection (cons inferences (cons intern (cons integer? (cons input (cons input+ (cons include (cons include-all-but (cons it (cons in (cons 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 (V722) (do (set shen.*special* (cons V722 (value shen.*special*))) V722))
+
+(defun unspecialise (V723) (do (set shen.*special* (remove V723 (value shen.*special*))) V723))
+
+
+

data/shen/release/klambda/load.kl

@@ -0,0 +1,59 @@
+"Copyright (c) 2015, Mark Tarver
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+1. Redistributions of source code must retain the above copyright
+   notice, this list of conditions and the following disclaimer.
+2. Redistributions in binary form must reproduce the above copyright
+   notice, this list of conditions and the following disclaimer in the
+   documentation and/or other materials provided with the distribution.
+3. The name of Mark Tarver may not be used to endorse or promote products
+   derived from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY Mark Tarver ''AS IS'' AND ANY
+EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL Mark Tarver BE LIABLE FOR ANY
+DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE."
+
+(defun load (V724) (let Load (let Start (get-time run) (let Result (shen.load-help (value shen.*tc*) (read-file V724)) (let Finish (get-time run) (let Time (- Finish Start) (let Message (shen.prhush (cn "
+run time: " (cn (str Time) " secs
+")) (stoutput)) Result))))) (let Infs (if (value shen.*tc*) (shen.prhush (cn "
+typechecked in " (shen.app (inferences) " inferences
+" shen.a)) (stoutput)) shen.skip) loaded)))
+
+(defun shen.load-help (V729 V730) (cond ((= false V729) (map (lambda X (shen.prhush (shen.app (shen.eval-without-macros X) "
+" shen.s) (stoutput))) V730)) (true (let RemoveSynonyms (mapcan shen.remove-synonyms V730) (let Table (mapcan shen.typetable RemoveSynonyms) (let Assume (map shen.assumetype Table) (trap-error (map shen.typecheck-and-load RemoveSynonyms) (lambda E (shen.unwind-types E Table)))))))))
+
+(defun shen.remove-synonyms (V731) (cond ((and (cons? V731) (= shen.synonyms-help (hd V731))) (do (eval V731) ())) (true (cons V731 ()))))
+
+(defun shen.typecheck-and-load (V732) (do (nl 1) (shen.typecheck-and-evaluate V732 (gensym A))))
+
+(defun shen.typetable (V737) (cond ((and (cons? V737) (and (= define (hd V737)) (cons? (tl V737)))) (let Sig (compile shen.<sig+rest> (tl (tl V737)) (lambda E (simple-error (shen.app (hd (tl V737)) " lacks a proper signature.
+" shen.a)))) (cons (cons (hd (tl V737)) Sig) ()))) (true ())))
+
+(defun shen.assumetype (V738) (cond ((cons? V738) (declare (hd V738) (tl V738))) (true (shen.f_error shen.assumetype))))
+
+(defun shen.unwind-types (V743 V744) (cond ((= () V744) (simple-error (error-to-string V743))) ((and (cons? V744) (cons? (hd V744))) (do (shen.remtype (hd (hd V744))) (shen.unwind-types V743 (tl V744)))) (true (shen.f_error shen.unwind-types))))
+
+(defun shen.remtype (V745) (set shen.*signedfuncs* (shen.removetype V745 (value shen.*signedfuncs*))))
+
+(defun shen.removetype (V751 V752) (cond ((= () V752) ()) ((and (cons? V752) (and (cons? (hd V752)) (= (hd (hd V752)) V751))) (shen.removetype (hd (hd V752)) (tl V752))) ((cons? V752) (cons (hd V752) (shen.removetype V751 (tl V752)))) (true (shen.f_error shen.removetype))))
+
+(defun shen.<sig+rest> (V753) (let Parse_shen.<signature> (shen.<signature> V753) (if (not (= (fail) Parse_shen.<signature>)) (let Parse_shen.<!> (shen.<!> Parse_shen.<signature>) (if (not (= (fail) Parse_shen.<!>)) (shen.pair (hd Parse_shen.<!>) (shen.hdtl Parse_shen.<signature>)) (fail))) (fail))))
+
+(defun write-to-file (V754 V755) (let Stream (open V754 out) (let String (if (string? V755) (shen.app V755 "
+
+" shen.a) (shen.app V755 "
+
+" shen.s)) (let Write (pr String Stream) (let Close (close Stream) V755)))))
+
+
+

data/shen/release/klambda/macros.kl

@@ -0,0 +1,91 @@
+"Copyright (c) 2015, Mark Tarver
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+1. Redistributions of source code must retain the above copyright
+   notice, this list of conditions and the following disclaimer.
+2. Redistributions in binary form must reproduce the above copyright
+   notice, this list of conditions and the following disclaimer in the
+   documentation and/or other materials provided with the distribution.
+3. The name of Mark Tarver may not be used to endorse or promote products
+   derived from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY Mark Tarver ''AS IS'' AND ANY
+EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL Mark Tarver BE LIABLE FOR ANY
+DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE."
+
+(defun macroexpand (V757) (let Y (shen.compose (value *macros*) V757) (if (= V757 Y) V757 (shen.walk (lambda V756 (macroexpand V756)) Y))))
+
+(defun shen.error-macro (V758) (cond ((and (cons? V758) (and (= error (hd V758)) (cons? (tl V758)))) (cons simple-error (cons (shen.mkstr (hd (tl V758)) (tl (tl V758))) ()))) (true V758)))
+
+(defun shen.output-macro (V759) (cond ((and (cons? V759) (and (= output (hd V759)) (cons? (tl V759)))) (cons shen.prhush (cons (shen.mkstr (hd (tl V759)) (tl (tl V759))) (cons (cons stoutput ()) ())))) ((and (cons? V759) (and (= pr (hd V759)) (and (cons? (tl V759)) (= () (tl (tl V759)))))) (cons pr (cons (hd (tl V759)) (cons (cons stoutput ()) ())))) (true V759)))
+
+(defun shen.make-string-macro (V760) (cond ((and (cons? V760) (and (= make-string (hd V760)) (cons? (tl V760)))) (shen.mkstr (hd (tl V760)) (tl (tl V760)))) (true V760)))
+
+(defun shen.input-macro (V761) (cond ((and (cons? V761) (and (= lineread (hd V761)) (= () (tl V761)))) (cons lineread (cons (cons stinput ()) ()))) ((and (cons? V761) (and (= input (hd V761)) (= () (tl V761)))) (cons input (cons (cons stinput ()) ()))) ((and (cons? V761) (and (= read (hd V761)) (= () (tl V761)))) (cons read (cons (cons stinput ()) ()))) ((and (cons? V761) (and (= input+ (hd V761)) (and (cons? (tl V761)) (= () (tl (tl V761)))))) (cons input+ (cons (hd (tl V761)) (cons (cons stinput ()) ())))) ((and (cons? V761) (and (= read-byte (hd V761)) (= () (tl V761)))) (cons read-byte (cons (cons stinput ()) ()))) (true V761)))
+
+(defun shen.compose (V762 V763) (cond ((= () V762) V763) ((cons? V762) (shen.compose (tl V762) ((hd V762) V763))) (true (shen.f_error shen.compose))))
+
+(defun shen.compile-macro (V764) (cond ((and (cons? V764) (and (= compile (hd V764)) (and (cons? (tl V764)) (and (cons? (tl (tl V764))) (= () (tl (tl (tl V764)))))))) (cons compile (cons (hd (tl V764)) (cons (hd (tl (tl V764))) (cons (cons lambda (cons E (cons (cons if (cons (cons cons? (cons E ())) (cons (cons error (cons "parse error here: ~S~%" (cons E ()))) (cons (cons error (cons "parse error~%" ())) ())))) ()))) ()))))) (true V764)))
+
+(defun shen.prolog-macro (V765) (cond ((and (cons? V765) (= prolog? (hd V765))) (let F (gensym shen.f) (let Receive (shen.receive-terms (tl V765)) (let PrologDef (eval (append (cons defprolog (cons F ())) (append Receive (append (cons <-- ()) (append (shen.pass-literals (tl V765)) (cons ; ())))))) (let Query (cons F (append Receive (cons (cons shen.start-new-prolog-process ()) (cons (cons freeze (cons true ())) ())))) Query))))) (true V765)))
+
+(defun shen.receive-terms (V770) (cond ((= () V770) ()) ((and (cons? V770) (and (cons? (hd V770)) (and (= shen.receive (hd (hd V770))) (and (cons? (tl (hd V770))) (= () (tl (tl (hd V770)))))))) (cons (hd (tl (hd V770))) (shen.receive-terms (tl V770)))) ((cons? V770) (shen.receive-terms (tl V770))) (true (shen.f_error shen.receive-terms))))
+
+(defun shen.pass-literals (V773) (cond ((= () V773) ()) ((and (cons? V773) (and (cons? (hd V773)) (and (= shen.receive (hd (hd V773))) (and (cons? (tl (hd V773))) (= () (tl (tl (hd V773)))))))) (shen.pass-literals (tl V773))) ((cons? V773) (cons (hd V773) (shen.pass-literals (tl V773)))) (true (shen.f_error shen.pass-literals))))
+
+(defun shen.defprolog-macro (V774) (cond ((and (cons? V774) (and (= defprolog (hd V774)) (cons? (tl V774)))) (compile shen.<defprolog> (tl V774) (lambda Y (shen.prolog-error (hd (tl V774)) Y)))) (true V774)))
+
+(defun shen.datatype-macro (V775) (cond ((and (cons? V775) (and (= datatype (hd V775)) (cons? (tl V775)))) (cons shen.process-datatype (cons (shen.intern-type (hd (tl V775))) (cons (cons compile (cons (cons function (cons shen.<datatype-rules> ())) (cons (shen.rcons_form (tl (tl V775))) (cons (cons function (cons shen.datatype-error ())) ())))) ())))) (true V775)))
+
+(defun shen.intern-type (V776) (intern (cn "type#" (str V776))))
+
+(defun shen.@s-macro (V777) (cond ((and (cons? V777) (and (= @s (hd V777)) (and (cons? (tl V777)) (and (cons? (tl (tl V777))) (cons? (tl (tl (tl V777)))))))) (cons @s (cons (hd (tl V777)) (cons (shen.@s-macro (cons @s (tl (tl V777)))) ())))) ((and (cons? V777) (and (= @s (hd V777)) (and (cons? (tl V777)) (and (cons? (tl (tl V777))) (and (= () (tl (tl (tl V777)))) (string? (hd (tl V777)))))))) (let E (explode (hd (tl V777))) (if (> (length E) 1) (shen.@s-macro (cons @s (append E (tl (tl V777))))) V777))) (true V777)))
+
+(defun shen.synonyms-macro (V778) (cond ((and (cons? V778) (= synonyms (hd V778))) (cons shen.synonyms-help (cons (shen.rcons_form (shen.curry-synonyms (tl V778))) ()))) (true V778)))
+
+(defun shen.curry-synonyms (V779) (map shen.curry-type V779))
+
+(defun shen.nl-macro (V780) (cond ((and (cons? V780) (and (= nl (hd V780)) (= () (tl V780)))) (cons nl (cons 1 ()))) (true V780)))
+
+(defun shen.assoc-macro (V781) (cond ((and (cons? V781) (and (cons? (tl V781)) (and (cons? (tl (tl V781))) (and (cons? (tl (tl (tl V781)))) (element? (hd V781) (cons @p (cons @v (cons append (cons and (cons or (cons + (cons * (cons do ()))))))))))))) (cons (hd V781) (cons (hd (tl V781)) (cons (shen.assoc-macro (cons (hd V781) (tl (tl V781)))) ())))) (true V781)))
+
+(defun shen.let-macro (V782) (cond ((and (cons? V782) (and (= let (hd V782)) (and (cons? (tl V782)) (and (cons? (tl (tl V782))) (and (cons? (tl (tl (tl V782)))) (cons? (tl (tl (tl (tl V782)))))))))) (cons let (cons (hd (tl V782)) (cons (hd (tl (tl V782))) (cons (shen.let-macro (cons let (tl (tl (tl V782))))) ()))))) (true V782)))
+
+(defun shen.abs-macro (V783) (cond ((and (cons? V783) (and (= /. (hd V783)) (and (cons? (tl V783)) (and (cons? (tl (tl V783))) (cons? (tl (tl (tl V783)))))))) (cons lambda (cons (hd (tl V783)) (cons (shen.abs-macro (cons /. (tl (tl V783)))) ())))) ((and (cons? V783) (and (= /. (hd V783)) (and (cons? (tl V783)) (and (cons? (tl (tl V783))) (= () (tl (tl (tl V783)))))))) (cons lambda (tl V783))) (true V783)))
+
+(defun shen.cases-macro (V786) (cond ((and (cons? V786) (and (= cases (hd V786)) (and (cons? (tl V786)) (and (= true (hd (tl V786))) (cons? (tl (tl V786))))))) (hd (tl (tl V786)))) ((and (cons? V786) (and (= cases (hd V786)) (and (cons? (tl V786)) (and (cons? (tl (tl V786))) (= () (tl (tl (tl V786)))))))) (cons if (cons (hd (tl V786)) (cons (hd (tl (tl V786))) (cons (cons simple-error (cons "error: cases exhausted" ())) ()))))) ((and (cons? V786) (and (= cases (hd V786)) (and (cons? (tl V786)) (cons? (tl (tl V786)))))) (cons if (cons (hd (tl V786)) (cons (hd (tl (tl V786))) (cons (shen.cases-macro (cons cases (tl (tl (tl V786))))) ()))))) ((and (cons? V786) (and (= cases (hd V786)) (and (cons? (tl V786)) (= () (tl (tl V786)))))) (simple-error "error: odd number of case elements
+")) (true V786)))
+
+(defun shen.timer-macro (V787) (cond ((and (cons? V787) (and (= time (hd V787)) (and (cons? (tl V787)) (= () (tl (tl V787)))))) (shen.let-macro (cons let (cons Start (cons (cons get-time (cons run ())) (cons Result (cons (hd (tl V787)) (cons Finish (cons (cons get-time (cons run ())) (cons Time (cons (cons - (cons Finish (cons Start ()))) (cons Message (cons (cons shen.prhush (cons (cons cn (cons "
+run time: " (cons (cons cn (cons (cons str (cons Time ())) (cons " secs
+" ()))) ()))) (cons (cons stoutput ()) ()))) (cons Result ())))))))))))))) (true V787)))
+
+(defun shen.tuple-up (V788) (cond ((cons? V788) (cons @p (cons (hd V788) (cons (shen.tuple-up (tl V788)) ())))) (true V788)))
+
+(defun shen.put/get-macro (V789) (cond ((and (cons? V789) (and (= put (hd V789)) (and (cons? (tl V789)) (and (cons? (tl (tl V789))) (and (cons? (tl (tl (tl V789)))) (= () (tl (tl (tl (tl V789)))))))))) (cons put (cons (hd (tl V789)) (cons (hd (tl (tl V789))) (cons (hd (tl (tl (tl V789)))) (cons (cons value (cons *property-vector* ())) ())))))) ((and (cons? V789) (and (= get (hd V789)) (and (cons? (tl V789)) (and (cons? (tl (tl V789))) (= () (tl (tl (tl V789)))))))) (cons get (cons (hd (tl V789)) (cons (hd (tl (tl V789))) (cons (cons value (cons *property-vector* ())) ()))))) ((and (cons? V789) (and (= unput (hd V789)) (and (cons? (tl V789)) (and (cons? (tl (tl V789))) (= () (tl (tl (tl V789)))))))) (cons unput (cons (hd (tl V789)) (cons (hd (tl (tl V789))) (cons (cons value (cons *property-vector* ())) ()))))) (true V789)))
+
+(defun shen.function-macro (V790) (cond ((and (cons? V790) (and (= function (hd V790)) (and (cons? (tl V790)) (= () (tl (tl V790)))))) (shen.function-abstraction (hd (tl V790)) (arity (hd (tl V790))))) (true V790)))
+
+(defun shen.function-abstraction (V791 V792) (cond ((= 0 V792) (cons freeze (cons V791 ()))) ((= -1 V792) V791) (true (shen.function-abstraction-help V791 V792 ()))))
+
+(defun shen.function-abstraction-help (V793 V794 V795) (cond ((= 0 V794) (cons V793 V795)) (true (let X (gensym V) (cons /. (cons X (cons (shen.function-abstraction-help V793 (- V794 1) (append V795 (cons X ()))) ())))))))
+
+(defun undefmacro (V796) (let MacroReg (value shen.*macroreg*) (let Pos (shen.findpos V796 MacroReg) (let Remove1 (set shen.*macroreg* (remove V796 MacroReg)) (let Remove2 (set *macros* (shen.remove-nth Pos (value *macros*))) V796)))))
+
+(defun shen.findpos (V804 V805) (cond ((= () V805) (simple-error (shen.app V804 " is not a macro
+" shen.a))) ((and (cons? V805) (= (hd V805) V804)) 1) ((cons? V805) (+ 1 (shen.findpos V804 (tl V805)))) (true (shen.f_error shen.findpos))))
+
+(defun shen.remove-nth (V808 V809) (cond ((and (= 1 V808) (cons? V809)) (tl V809)) ((cons? V809) (cons (hd V809) (shen.remove-nth (- V808 1) (tl V809)))) (true (shen.f_error shen.remove-nth))))
+
+
+

data/shen/release/klambda/prolog.kl

@@ -0,0 +1,228 @@
+"Copyright (c) 2015, Mark Tarver
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+1. Redistributions of source code must retain the above copyright
+   notice, this list of conditions and the following disclaimer.
+2. Redistributions in binary form must reproduce the above copyright
+   notice, this list of conditions and the following disclaimer in the
+   documentation and/or other materials provided with the distribution.
+3. The name of Mark Tarver may not be used to endorse or promote products
+   derived from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY Mark Tarver ''AS IS'' AND ANY
+EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL Mark Tarver BE LIABLE FOR ANY
+DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE."
+
+(defun shen.<defprolog> (V812) (let Parse_shen.<predicate*> (shen.<predicate*> V812) (if (not (= (fail) Parse_shen.<predicate*>)) (let Parse_shen.<clauses*> (shen.<clauses*> Parse_shen.<predicate*>) (if (not (= (fail) Parse_shen.<clauses*>)) (shen.pair (hd Parse_shen.<clauses*>) (hd (shen.prolog->shen (map (lambda Parse_X (shen.insert-predicate (shen.hdtl Parse_shen.<predicate*>) Parse_X)) (shen.hdtl Parse_shen.<clauses*>))))) (fail))) (fail))))
+
+(defun shen.prolog-error (V819 V820) (cond ((and (cons? V820) (and (cons? (tl V820)) (= () (tl (tl V820))))) (simple-error (cn "prolog syntax error in " (shen.app V819 (cn " here:
+
+ " (shen.app (shen.next-50 50 (hd V820)) "
+" shen.a)) shen.a)))) (true (simple-error (cn "prolog syntax error in " (shen.app V819 "
+" shen.a))))))
+
+(defun shen.next-50 (V825 V826) (cond ((= () V826) "") ((= 0 V825) "") ((cons? V826) (cn (shen.decons-string (hd V826)) (shen.next-50 (- V825 1) (tl V826)))) (true (shen.f_error shen.next-50))))
+
+(defun shen.decons-string (V827) (cond ((and (cons? V827) (and (= cons (hd V827)) (and (cons? (tl V827)) (and (cons? (tl (tl V827))) (= () (tl (tl (tl V827)))))))) (shen.app (shen.eval-cons V827) " " shen.s)) (true (shen.app V827 " " shen.r))))
+
+(defun shen.insert-predicate (V828 V829) (cond ((and (cons? V829) (and (cons? (tl V829)) (= () (tl (tl V829))))) (cons (cons V828 (hd V829)) (cons :- (tl V829)))) (true (shen.f_error shen.insert-predicate))))
+
+(defun shen.<predicate*> (V830) (if (cons? (hd V830)) (let Parse_X (hd (hd V830)) (shen.pair (hd (shen.pair (tl (hd V830)) (shen.hdtl V830))) Parse_X)) (fail)))
+
+(defun shen.<clauses*> (V831) (let YaccParse (let Parse_shen.<clause*> (shen.<clause*> V831) (if (not (= (fail) Parse_shen.<clause*>)) (let Parse_shen.<clauses*> (shen.<clauses*> Parse_shen.<clause*>) (if (not (= (fail) Parse_shen.<clauses*>)) (shen.pair (hd Parse_shen.<clauses*>) (cons (shen.hdtl Parse_shen.<clause*>) (shen.hdtl Parse_shen.<clauses*>))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_<e> (<e> V831) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) (shen.hdtl Parse_<e>)) (fail))) YaccParse)))
+
+(defun shen.<clause*> (V832) (let Parse_shen.<head*> (shen.<head*> V832) (if (not (= (fail) Parse_shen.<head*>)) (if (and (cons? (hd Parse_shen.<head*>)) (= <-- (hd (hd Parse_shen.<head*>)))) (let Parse_shen.<body*> (shen.<body*> (shen.pair (tl (hd Parse_shen.<head*>)) (shen.hdtl Parse_shen.<head*>))) (if (not (= (fail) Parse_shen.<body*>)) (let Parse_shen.<end*> (shen.<end*> Parse_shen.<body*>) (if (not (= (fail) Parse_shen.<end*>)) (shen.pair (hd Parse_shen.<end*>) (cons (shen.hdtl Parse_shen.<head*>) (cons (shen.hdtl Parse_shen.<body*>) ()))) (fail))) (fail))) (fail)) (fail))))
+
+(defun shen.<head*> (V833) (let YaccParse (let Parse_shen.<term*> (shen.<term*> V833) (if (not (= (fail) Parse_shen.<term*>)) (let Parse_shen.<head*> (shen.<head*> Parse_shen.<term*>) (if (not (= (fail) Parse_shen.<head*>)) (shen.pair (hd Parse_shen.<head*>) (cons (shen.hdtl Parse_shen.<term*>) (shen.hdtl Parse_shen.<head*>))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_<e> (<e> V833) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) (shen.hdtl Parse_<e>)) (fail))) YaccParse)))
+
+(defun shen.<term*> (V834) (if (cons? (hd V834)) (let Parse_X (hd (hd V834)) (if (and (not (= <-- Parse_X)) (shen.legitimate-term? Parse_X)) (shen.pair (hd (shen.pair (tl (hd V834)) (shen.hdtl V834))) (shen.eval-cons Parse_X)) (fail))) (fail)))
+
+(defun shen.legitimate-term? (V839) (cond ((and (cons? V839) (and (= cons (hd V839)) (and (cons? (tl V839)) (and (cons? (tl (tl V839))) (= () (tl (tl (tl V839)))))))) (and (shen.legitimate-term? (hd (tl V839))) (shen.legitimate-term? (hd (tl (tl V839)))))) ((and (cons? V839) (and (= mode (hd V839)) (and (cons? (tl V839)) (and (cons? (tl (tl V839))) (and (= + (hd (tl (tl V839)))) (= () (tl (tl (tl V839))))))))) (shen.legitimate-term? (hd (tl V839)))) ((and (cons? V839) (and (= mode (hd V839)) (and (cons? (tl V839)) (and (cons? (tl (tl V839))) (and (= - (hd (tl (tl V839)))) (= () (tl (tl (tl V839))))))))) (shen.legitimate-term? (hd (tl V839)))) ((cons? V839) false) (true true)))
+
+(defun shen.eval-cons (V840) (cond ((and (cons? V840) (and (= cons (hd V840)) (and (cons? (tl V840)) (and (cons? (tl (tl V840))) (= () (tl (tl (tl V840)))))))) (cons (shen.eval-cons (hd (tl V840))) (shen.eval-cons (hd (tl (tl V840)))))) ((and (cons? V840) (and (= mode (hd V840)) (and (cons? (tl V840)) (and (cons? (tl (tl V840))) (= () (tl (tl (tl V840)))))))) (cons mode (cons (shen.eval-cons (hd (tl V840))) (tl (tl V840))))) (true V840)))
+
+(defun shen.<body*> (V841) (let YaccParse (let Parse_shen.<literal*> (shen.<literal*> V841) (if (not (= (fail) Parse_shen.<literal*>)) (let Parse_shen.<body*> (shen.<body*> Parse_shen.<literal*>) (if (not (= (fail) Parse_shen.<body*>)) (shen.pair (hd Parse_shen.<body*>) (cons (shen.hdtl Parse_shen.<literal*>) (shen.hdtl Parse_shen.<body*>))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_<e> (<e> V841) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) (shen.hdtl Parse_<e>)) (fail))) YaccParse)))
+
+(defun shen.<literal*> (V842) (let YaccParse (if (and (cons? (hd V842)) (= ! (hd (hd V842)))) (shen.pair (hd (shen.pair (tl (hd V842)) (shen.hdtl V842))) (cons cut (cons (intern "Throwcontrol") ()))) (fail)) (if (= YaccParse (fail)) (if (cons? (hd V842)) (let Parse_X (hd (hd V842)) (if (cons? Parse_X) (shen.pair (hd (shen.pair (tl (hd V842)) (shen.hdtl V842))) Parse_X) (fail))) (fail)) YaccParse)))
+
+(defun shen.<end*> (V843) (if (cons? (hd V843)) (let Parse_X (hd (hd V843)) (if (= Parse_X ;) (shen.pair (hd (shen.pair (tl (hd V843)) (shen.hdtl V843))) Parse_X) (fail))) (fail)))
+
+(defun cut (V844 V845 V846) (let Result (thaw V846) (if (= Result false) V844 Result)))
+
+(defun shen.insert_modes (V847) (cond ((and (cons? V847) (and (= mode (hd V847)) (and (cons? (tl V847)) (and (cons? (tl (tl V847))) (= () (tl (tl (tl V847)))))))) V847) ((= () V847) ()) ((cons? V847) (cons (cons mode (cons (hd V847) (cons + ()))) (cons mode (cons (shen.insert_modes (tl V847)) (cons - ()))))) (true V847)))
+
+(defun shen.s-prolog (V848) (map (lambda V810 (eval V810)) (shen.prolog->shen V848)))
+
+(defun shen.prolog->shen (V849) (map shen.compile_prolog_procedure (shen.group_clauses (map shen.s-prolog_clause (mapcan shen.head_abstraction V849)))))
+
+(defun shen.s-prolog_clause (V850) (cond ((and (cons? V850) (and (cons? (tl V850)) (and (= :- (hd (tl V850))) (and (cons? (tl (tl V850))) (= () (tl (tl (tl V850)))))))) (cons (hd V850) (cons :- (cons (map shen.s-prolog_literal (hd (tl (tl V850)))) ())))) (true (shen.f_error shen.s-prolog_clause))))
+
+(defun shen.head_abstraction (V851) (cond ((and (cons? V851) (and (cons? (tl V851)) (and (= :- (hd (tl V851))) (and (cons? (tl (tl V851))) (and (= () (tl (tl (tl V851)))) (< (shen.complexity_head (hd V851)) (value shen.*maxcomplexity*))))))) (cons V851 ())) ((and (cons? V851) (and (cons? (hd V851)) (and (cons? (tl V851)) (and (= :- (hd (tl V851))) (and (cons? (tl (tl V851))) (= () (tl (tl (tl V851))))))))) (let Terms (map (lambda Y (gensym V)) (tl (hd V851))) (let XTerms (shen.rcons_form (shen.remove_modes (tl (hd V851)))) (let Literal (cons unify (cons (shen.cons_form Terms) (cons XTerms ()))) (let Clause (cons (cons (hd (hd V851)) Terms) (cons :- (cons (cons Literal (hd (tl (tl V851)))) ()))) (cons Clause ())))))) (true (shen.f_error shen.head_abstraction))))
+
+(defun shen.complexity_head (V856) (cond ((cons? V856) (shen.product (map shen.complexity (tl V856)))) (true (shen.f_error shen.complexity_head))))
+
+(defun shen.complexity (V864) (cond ((and (cons? V864) (and (= mode (hd V864)) (and (cons? (tl V864)) (and (cons? (hd (tl V864))) (and (= mode (hd (hd (tl V864)))) (and (cons? (tl (hd (tl V864)))) (and (cons? (tl (tl (hd (tl V864))))) (and (= () (tl (tl (tl (hd (tl V864)))))) (and (cons? (tl (tl V864))) (= () (tl (tl (tl V864))))))))))))) (shen.complexity (hd (tl V864)))) ((and (cons? V864) (and (= mode (hd V864)) (and (cons? (tl V864)) (and (cons? (hd (tl V864))) (and (cons? (tl (tl V864))) (and (= + (hd (tl (tl V864)))) (= () (tl (tl (tl V864)))))))))) (* 2 (* (shen.complexity (cons mode (cons (hd (hd (tl V864))) (tl (tl V864))))) (shen.complexity (cons mode (cons (tl (hd (tl V864))) (tl (tl V864)))))))) ((and (cons? V864) (and (= mode (hd V864)) (and (cons? (tl V864)) (and (cons? (hd (tl V864))) (and (cons? (tl (tl V864))) (and (= - (hd (tl (tl V864)))) (= () (tl (tl (tl V864)))))))))) (* (shen.complexity (cons mode (cons (hd (hd (tl V864))) (tl (tl V864))))) (shen.complexity (cons mode (cons (tl (hd (tl V864))) (tl (tl V864))))))) ((and (cons? V864) (and (= mode (hd V864)) (and (cons? (tl V864)) (and (cons? (tl (tl V864))) (and (= () (tl (tl (tl V864)))) (variable? (hd (tl V864)))))))) 1) ((and (cons? V864) (and (= mode (hd V864)) (and (cons? (tl V864)) (and (cons? (tl (tl V864))) (and (= + (hd (tl (tl V864)))) (= () (tl (tl (tl V864))))))))) 2) ((and (cons? V864) (and (= mode (hd V864)) (and (cons? (tl V864)) (and (cons? (tl (tl V864))) (and (= - (hd (tl (tl V864)))) (= () (tl (tl (tl V864))))))))) 1) (true (shen.complexity (cons mode (cons V864 (cons + ())))))))
+
+(defun shen.product (V865) (cond ((= () V865) 1) ((cons? V865) (* (hd V865) (shen.product (tl V865)))) (true (shen.f_error shen.product))))
+
+(defun shen.s-prolog_literal (V866) (cond ((and (cons? V866) (and (= is (hd V866)) (and (cons? (tl V866)) (and (cons? (tl (tl V866))) (= () (tl (tl (tl V866)))))))) (cons bind (cons (hd (tl V866)) (cons (shen.insert_deref (hd (tl (tl V866)))) ())))) ((and (cons? V866) (and (= when (hd V866)) (and (cons? (tl V866)) (= () (tl (tl V866)))))) (cons fwhen (cons (shen.insert_deref (hd (tl V866))) ()))) ((and (cons? V866) (and (= bind (hd V866)) (and (cons? (tl V866)) (and (cons? (tl (tl V866))) (= () (tl (tl (tl V866)))))))) (cons bind (cons (hd (tl V866)) (cons (shen.insert_lazyderef (hd (tl (tl V866)))) ())))) ((and (cons? V866) (and (= fwhen (hd V866)) (and (cons? (tl V866)) (= () (tl (tl V866)))))) (cons fwhen (cons (shen.insert_lazyderef (hd (tl V866))) ()))) ((cons? V866) V866) (true (shen.f_error shen.s-prolog_literal))))
+
+(defun shen.insert_deref (V867) (cond ((variable? V867) (cons shen.deref (cons V867 (cons ProcessN ())))) ((cons? V867) (cons (shen.insert_deref (hd V867)) (shen.insert_deref (tl V867)))) (true V867)))
+
+(defun shen.insert_lazyderef (V868) (cond ((variable? V868) (cons shen.lazyderef (cons V868 (cons ProcessN ())))) ((cons? V868) (cons (shen.insert_lazyderef (hd V868)) (shen.insert_lazyderef (tl V868)))) (true V868)))
+
+(defun shen.m_prolog_to_s-prolog_predicate (V869) (cond ((= = V869) unify) ((= =! V869) unify!) ((= == V869) identical) (true V869)))
+
+(defun shen.group_clauses (V870) (cond ((= () V870) ()) ((cons? V870) (let Group (shen.collect (lambda X (shen.same_predicate? (hd V870) X)) V870) (let Rest (difference V870 Group) (cons Group (shen.group_clauses Rest))))) (true (shen.f_error shen.group_clauses))))
+
+(defun shen.collect (V873 V874) (cond ((= () V874) ()) ((cons? V874) (if (V873 (hd V874)) (cons (hd V874) (shen.collect V873 (tl V874))) (shen.collect V873 (tl V874)))) (true (shen.f_error shen.collect))))
+
+(defun shen.same_predicate? (V891 V892) (cond ((and (cons? V891) (and (cons? (hd V891)) (and (cons? V892) (cons? (hd V892))))) (= (hd (hd V891)) (hd (hd V892)))) (true (shen.f_error shen.same_predicate?))))
+
+(defun shen.compile_prolog_procedure (V893) (let F (shen.procedure_name V893) (let Shen (shen.clauses-to-shen F V893) Shen)))
+
+(defun shen.procedure_name (V906) (cond ((and (cons? V906) (and (cons? (hd V906)) (cons? (hd (hd V906))))) (hd (hd (hd V906)))) (true (shen.f_error shen.procedure_name))))
+
+(defun shen.clauses-to-shen (V907 V908) (let Linear (map shen.linearise-clause V908) (let Arity (shen.prolog-aritycheck V907 (map (lambda V811 (head V811)) V908)) (let Parameters (shen.parameters Arity) (let AUM_instructions (map (lambda X (shen.aum X Parameters)) Linear) (let Code (shen.catch-cut (shen.nest-disjunct (map shen.aum_to_shen AUM_instructions))) (let ShenDef (cons define (cons V907 (append Parameters (append (cons ProcessN (cons Continuation ())) (cons -> (cons Code ())))))) ShenDef)))))))
+
+(defun shen.catch-cut (V909) (cond ((not (shen.occurs? cut V909)) V909) (true (cons let (cons Throwcontrol (cons (cons shen.catchpoint ()) (cons (cons shen.cutpoint (cons Throwcontrol (cons V909 ()))) ())))))))
+
+(defun shen.catchpoint () (set shen.*catch* (+ 1 (value shen.*catch*))))
+
+(defun shen.cutpoint (V915 V916) (cond ((= V916 V915) false) (true V916)))
+
+(defun shen.nest-disjunct (V917) (cond ((and (cons? V917) (= () (tl V917))) (hd V917)) ((cons? V917) (shen.lisp-or (hd V917) (shen.nest-disjunct (tl V917)))) (true (shen.f_error shen.nest-disjunct))))
+
+(defun shen.lisp-or (V918 V919) (cons let (cons Case (cons V918 (cons (cons if (cons (cons = (cons Case (cons false ()))) (cons V919 (cons Case ())))) ())))))
+
+(defun shen.prolog-aritycheck (V922 V923) (cond ((and (cons? V923) (= () (tl V923))) (- (length (hd V923)) 1)) ((and (cons? V923) (cons? (tl V923))) (if (= (length (hd V923)) (length (hd (tl V923)))) (shen.prolog-aritycheck V922 (tl V923)) (simple-error (cn "arity error in prolog procedure " (shen.app (cons V922 ()) "
+" shen.a))))) (true (shen.f_error shen.prolog-aritycheck))))
+
+(defun shen.linearise-clause (V924) (cond ((and (cons? V924) (and (cons? (tl V924)) (and (= :- (hd (tl V924))) (and (cons? (tl (tl V924))) (= () (tl (tl (tl V924)))))))) (let Linear (shen.linearise (cons (hd V924) (tl (tl V924)))) (shen.clause_form Linear))) (true (shen.f_error shen.linearise-clause))))
+
+(defun shen.clause_form (V925) (cond ((and (cons? V925) (and (cons? (tl V925)) (= () (tl (tl V925))))) (cons (shen.explicit_modes (hd V925)) (cons :- (cons (shen.cf_help (hd (tl V925))) ())))) (true (shen.f_error shen.clause_form))))
+
+(defun shen.explicit_modes (V926) (cond ((cons? V926) (cons (hd V926) (map shen.em_help (tl V926)))) (true (shen.f_error shen.explicit_modes))))
+
+(defun shen.em_help (V927) (cond ((and (cons? V927) (and (= mode (hd V927)) (and (cons? (tl V927)) (and (cons? (tl (tl V927))) (= () (tl (tl (tl V927)))))))) V927) (true (cons mode (cons V927 (cons + ()))))))
+
+(defun shen.cf_help (V928) (cond ((and (cons? V928) (and (= where (hd V928)) (and (cons? (tl V928)) (and (cons? (hd (tl V928))) (and (= = (hd (hd (tl V928)))) (and (cons? (tl (hd (tl V928)))) (and (cons? (tl (tl (hd (tl V928))))) (and (= () (tl (tl (tl (hd (tl V928)))))) (and (cons? (tl (tl V928))) (= () (tl (tl (tl V928))))))))))))) (cons (cons (if (value shen.*occurs*) unify! unify) (tl (hd (tl V928)))) (shen.cf_help (hd (tl (tl V928)))))) (true V928)))
+
+(defun occurs-check (V933) (cond ((= + V933) (set shen.*occurs* true)) ((= - V933) (set shen.*occurs* false)) (true (simple-error "occurs-check expects + or -
+"))))
+
+(defun shen.aum (V934 V935) (cond ((and (cons? V934) (and (cons? (hd V934)) (and (cons? (tl V934)) (and (= :- (hd (tl V934))) (and (cons? (tl (tl V934))) (= () (tl (tl (tl V934))))))))) (let MuApplication (shen.make_mu_application (cons shen.mu (cons (tl (hd V934)) (cons (shen.continuation_call (tl (hd V934)) (hd (tl (tl V934)))) ()))) V935) (shen.mu_reduction MuApplication +))) (true (shen.f_error shen.aum))))
+
+(defun shen.continuation_call (V936 V937) (let VTerms (cons ProcessN (shen.extract_vars V936)) (let VBody (shen.extract_vars V937) (let Free (remove Throwcontrol (difference VBody VTerms)) (shen.cc_help Free V937)))))
+
+(defun remove (V938 V939) (shen.remove-h V938 V939 ()))
+
+(defun shen.remove-h (V943 V944 V945) (cond ((= () V944) (reverse V945)) ((and (cons? V944) (= (hd V944) V943)) (shen.remove-h (hd V944) (tl V944) V945)) ((cons? V944) (shen.remove-h V943 (tl V944) (cons (hd V944) V945))) (true (shen.f_error shen.remove-h))))
+
+(defun shen.cc_help (V946 V947) (cond ((and (= () V946) (= () V947)) (cons shen.pop (cons shen.the (cons shen.stack ())))) ((= () V947) (cons shen.rename (cons shen.the (cons shen.variables (cons in (cons V946 (cons and (cons shen.then (cons (cons shen.pop (cons shen.the (cons shen.stack ()))) ()))))))))) ((= () V946) (cons call (cons shen.the (cons shen.continuation (cons V947 ()))))) (true (cons shen.rename (cons shen.the (cons shen.variables (cons in (cons V946 (cons and (cons shen.then (cons (cons call (cons shen.the (cons shen.continuation (cons V947 ())))) ())))))))))))
+
+(defun shen.make_mu_application (V948 V949) (cond ((and (cons? V948) (and (= shen.mu (hd V948)) (and (cons? (tl V948)) (and (= () (hd (tl V948))) (and (cons? (tl (tl V948))) (and (= () (tl (tl (tl V948)))) (= () V949))))))) (hd (tl (tl V948)))) ((and (cons? V948) (and (= shen.mu (hd V948)) (and (cons? (tl V948)) (and (cons? (hd (tl V948))) (and (cons? (tl (tl V948))) (and (= () (tl (tl (tl V948)))) (cons? V949))))))) (cons (cons shen.mu (cons (hd (hd (tl V948))) (cons (shen.make_mu_application (cons shen.mu (cons (tl (hd (tl V948))) (tl (tl V948)))) (tl V949)) ()))) (cons (hd V949) ()))) (true (shen.f_error shen.make_mu_application))))
+
+(defun shen.mu_reduction (V956 V957) (cond ((and (cons? V956) (and (cons? (hd V956)) (and (= shen.mu (hd (hd V956))) (and (cons? (tl (hd V956))) (and (cons? (hd (tl (hd V956)))) (and (= mode (hd (hd (tl (hd V956))))) (and (cons? (tl (hd (tl (hd V956))))) (and (cons? (tl (tl (hd (tl (hd V956)))))) (and (= () (tl (tl (tl (hd (tl (hd V956))))))) (and (cons? (tl (tl (hd V956)))) (and (= () (tl (tl (tl (hd V956))))) (and (cons? (tl V956)) (= () (tl (tl V956))))))))))))))) (shen.mu_reduction (cons (cons shen.mu (cons (hd (tl (hd (tl (hd V956))))) (tl (tl (hd V956))))) (tl V956)) (hd (tl (tl (hd (tl (hd V956)))))))) ((and (cons? V956) (and (cons? (hd V956)) (and (= shen.mu (hd (hd V956))) (and (cons? (tl (hd V956))) (and (cons? (tl (tl (hd V956)))) (and (= () (tl (tl (tl (hd V956))))) (and (cons? (tl V956)) (and (= () (tl (tl V956))) (= _ (hd (tl (hd V956)))))))))))) (shen.mu_reduction (hd (tl (tl (hd V956)))) V957)) ((and (cons? V956) (and (cons? (hd V956)) (and (= shen.mu (hd (hd V956))) (and (cons? (tl (hd V956))) (and (cons? (tl (tl (hd V956)))) (and (= () (tl (tl (tl (hd V956))))) (and (cons? (tl V956)) (and (= () (tl (tl V956))) (shen.ephemeral_variable? (hd (tl (hd V956))) (hd (tl V956))))))))))) (subst (hd (tl V956)) (hd (tl (hd V956))) (shen.mu_reduction (hd (tl (tl (hd V956)))) V957))) ((and (cons? V956) (and (cons? (hd V956)) (and (= shen.mu (hd (hd V956))) (and (cons? (tl (hd V956))) (and (cons? (tl (tl (hd V956)))) (and (= () (tl (tl (tl (hd V956))))) (and (cons? (tl V956)) (and (= () (tl (tl V956))) (variable? (hd (tl (hd V956)))))))))))) (cons let (cons (hd (tl (hd V956))) (cons shen.be (cons (hd (tl V956)) (cons in (cons (shen.mu_reduction (hd (tl (tl (hd V956)))) V957) ()))))))) ((and (cons? V956) (and (cons? (hd V956)) (and (= shen.mu (hd (hd V956))) (and (cons? (tl (hd V956))) (and (cons? (tl (tl (hd V956)))) (and (= () (tl (tl (tl (hd V956))))) (and (cons? (tl V956)) (and (= () (tl (tl V956))) (and (= - V957) (shen.prolog_constant? (hd (tl (hd V956))))))))))))) (let Z (gensym V) (cons let (cons Z (cons shen.be (cons (cons shen.the (cons shen.result (cons shen.of (cons shen.dereferencing (tl V956))))) (cons in (cons (cons if (cons (cons Z (cons is (cons identical (cons shen.to (cons (hd (tl (hd V956))) ()))))) (cons shen.then (cons (shen.mu_reduction (hd (tl (tl (hd V956)))) -) (cons shen.else (cons shen.failed! ())))))) ())))))))) ((and (cons? V956) (and (cons? (hd V956)) (and (= shen.mu (hd (hd V956))) (and (cons? (tl (hd V956))) (and (cons? (tl (tl (hd V956)))) (and (= () (tl (tl (tl (hd V956))))) (and (cons? (tl V956)) (and (= () (tl (tl V956))) (and (= + V957) (shen.prolog_constant? (hd (tl (hd V956))))))))))))) (let Z (gensym V) (cons let (cons Z (cons shen.be (cons (cons shen.the (cons shen.result (cons shen.of (cons shen.dereferencing (tl V956))))) (cons in (cons (cons if (cons (cons Z (cons is (cons identical (cons shen.to (cons (hd (tl (hd V956))) ()))))) (cons shen.then (cons (shen.mu_reduction (hd (tl (tl (hd V956)))) +) (cons shen.else (cons (cons if (cons (cons Z (cons is (cons shen.a (cons shen.variable ())))) (cons shen.then (cons (cons bind (cons Z (cons shen.to (cons (hd (tl (hd V956))) (cons in (cons (shen.mu_reduction (hd (tl (tl (hd V956)))) +) ())))))) (cons shen.else (cons shen.failed! ())))))) ())))))) ())))))))) ((and (cons? V956) (and (cons? (hd V956)) (and (= shen.mu (hd (hd V956))) (and (cons? (tl (hd V956))) (and (cons? (hd (tl (hd V956)))) (and (cons? (tl (tl (hd V956)))) (and (= () (tl (tl (tl (hd V956))))) (and (cons? (tl V956)) (and (= () (tl (tl V956))) (= - V957)))))))))) (let Z (gensym V) (cons let (cons Z (cons shen.be (cons (cons shen.the (cons shen.result (cons shen.of (cons shen.dereferencing (tl V956))))) (cons in (cons (cons if (cons (cons Z (cons is (cons shen.a (cons shen.non-empty (cons list ()))))) (cons shen.then (cons (shen.mu_reduction (cons (cons shen.mu (cons (hd (hd (tl (hd V956)))) (cons (cons (cons shen.mu (cons (tl (hd (tl (hd V956)))) (tl (tl (hd V956))))) (cons (cons shen.the (cons tail (cons shen.of (cons Z ())))) ())) ()))) (cons (cons shen.the (cons head (cons shen.of (cons Z ())))) ())) -) (cons shen.else (cons shen.failed! ())))))) ())))))))) ((and (cons? V956) (and (cons? (hd V956)) (and (= shen.mu (hd (hd V956))) (and (cons? (tl (hd V956))) (and (cons? (hd (tl (hd V956)))) (and (cons? (tl (tl (hd V956)))) (and (= () (tl (tl (tl (hd V956))))) (and (cons? (tl V956)) (and (= () (tl (tl V956))) (= + V957)))))))))) (let Z (gensym V) (cons let (cons Z (cons shen.be (cons (cons shen.the (cons shen.result (cons shen.of (cons shen.dereferencing (tl V956))))) (cons in (cons (cons if (cons (cons Z (cons is (cons shen.a (cons shen.non-empty (cons list ()))))) (cons shen.then (cons (shen.mu_reduction (cons (cons shen.mu (cons (hd (hd (tl (hd V956)))) (cons (cons (cons shen.mu (cons (tl (hd (tl (hd V956)))) (tl (tl (hd V956))))) (cons (cons shen.the (cons tail (cons shen.of (cons Z ())))) ())) ()))) (cons (cons shen.the (cons head (cons shen.of (cons Z ())))) ())) +) (cons shen.else (cons (cons if (cons (cons Z (cons is (cons shen.a (cons shen.variable ())))) (cons shen.then (cons (cons shen.rename (cons shen.the (cons shen.variables (cons in (cons (shen.extract_vars (hd (tl (hd V956)))) (cons and (cons shen.then (cons (cons bind (cons Z (cons shen.to (cons (shen.rcons_form (shen.remove_modes (hd (tl (hd V956))))) (cons in (cons (shen.mu_reduction (hd (tl (tl (hd V956)))) +) ())))))) ())))))))) (cons shen.else (cons shen.failed! ())))))) ())))))) ())))))))) (true V956)))
+
+(defun shen.rcons_form (V958) (cond ((cons? V958) (cons cons (cons (shen.rcons_form (hd V958)) (cons (shen.rcons_form (tl V958)) ())))) (true V958)))
+
+(defun shen.remove_modes (V959) (cond ((and (cons? V959) (and (= mode (hd V959)) (and (cons? (tl V959)) (and (cons? (tl (tl V959))) (and (= + (hd (tl (tl V959)))) (= () (tl (tl (tl V959))))))))) (shen.remove_modes (hd (tl V959)))) ((and (cons? V959) (and (= mode (hd V959)) (and (cons? (tl V959)) (and (cons? (tl (tl V959))) (and (= - (hd (tl (tl V959)))) (= () (tl (tl (tl V959))))))))) (shen.remove_modes (hd (tl V959)))) ((cons? V959) (cons (shen.remove_modes (hd V959)) (shen.remove_modes (tl V959)))) (true V959)))
+
+(defun shen.ephemeral_variable? (V960 V961) (and (variable? V960) (variable? V961)))
+
+(defun shen.prolog_constant? (V970) (cond ((cons? V970) false) (true true)))
+
+(defun shen.aum_to_shen (V971) (cond ((and (cons? V971) (and (= let (hd V971)) (and (cons? (tl V971)) (and (cons? (tl (tl V971))) (and (= shen.be (hd (tl (tl V971)))) (and (cons? (tl (tl (tl V971)))) (and (cons? (tl (tl (tl (tl V971))))) (and (= in (hd (tl (tl (tl (tl V971)))))) (and (cons? (tl (tl (tl (tl (tl V971)))))) (= () (tl (tl (tl (tl (tl (tl V971)))))))))))))))) (cons let (cons (hd (tl V971)) (cons (shen.aum_to_shen (hd (tl (tl (tl V971))))) (cons (shen.aum_to_shen (hd (tl (tl (tl (tl (tl V971))))))) ()))))) ((and (cons? V971) (and (= shen.the (hd V971)) (and (cons? (tl V971)) (and (= shen.result (hd (tl V971))) (and (cons? (tl (tl V971))) (and (= shen.of (hd (tl (tl V971)))) (and (cons? (tl (tl (tl V971)))) (and (= shen.dereferencing (hd (tl (tl (tl V971))))) (and (cons? (tl (tl (tl (tl V971))))) (= () (tl (tl (tl (tl (tl V971))))))))))))))) (cons shen.lazyderef (cons (shen.aum_to_shen (hd (tl (tl (tl (tl V971)))))) (cons ProcessN ())))) ((and (cons? V971) (and (= if (hd V971)) (and (cons? (tl V971)) (and (cons? (tl (tl V971))) (and (= shen.then (hd (tl (tl V971)))) (and (cons? (tl (tl (tl V971)))) (and (cons? (tl (tl (tl (tl V971))))) (and (= shen.else (hd (tl (tl (tl (tl V971)))))) (and (cons? (tl (tl (tl (tl (tl V971)))))) (= () (tl (tl (tl (tl (tl (tl V971)))))))))))))))) (cons if (cons (shen.aum_to_shen (hd (tl V971))) (cons (shen.aum_to_shen (hd (tl (tl (tl V971))))) (cons (shen.aum_to_shen (hd (tl (tl (tl (tl (tl V971))))))) ()))))) ((and (cons? V971) (and (cons? (tl V971)) (and (= is (hd (tl V971))) (and (cons? (tl (tl V971))) (and (= shen.a (hd (tl (tl V971)))) (and (cons? (tl (tl (tl V971)))) (and (= shen.variable (hd (tl (tl (tl V971))))) (= () (tl (tl (tl (tl V971)))))))))))) (cons shen.pvar? (cons (hd V971) ()))) ((and (cons? V971) (and (cons? (tl V971)) (and (= is (hd (tl V971))) (and (cons? (tl (tl V971))) (and (= shen.a (hd (tl (tl V971)))) (and (cons? (tl (tl (tl V971)))) (and (= shen.non-empty (hd (tl (tl (tl V971))))) (and (cons? (tl (tl (tl (tl V971))))) (and (= list (hd (tl (tl (tl (tl V971)))))) (= () (tl (tl (tl (tl (tl V971))))))))))))))) (cons cons? (cons (hd V971) ()))) ((and (cons? V971) (and (= shen.rename (hd V971)) (and (cons? (tl V971)) (and (= shen.the (hd (tl V971))) (and (cons? (tl (tl V971))) (and (= shen.variables (hd (tl (tl V971)))) (and (cons? (tl (tl (tl V971)))) (and (= in (hd (tl (tl (tl V971))))) (and (cons? (tl (tl (tl (tl V971))))) (and (= () (hd (tl (tl (tl (tl V971)))))) (and (cons? (tl (tl (tl (tl (tl V971)))))) (and (= and (hd (tl (tl (tl (tl (tl V971))))))) (and (cons? (tl (tl (tl (tl (tl (tl V971))))))) (and (= shen.then (hd (tl (tl (tl (tl (tl (tl V971)))))))) (and (cons? (tl (tl (tl (tl (tl (tl (tl V971)))))))) (= () (tl (tl (tl (tl (tl (tl (tl (tl V971)))))))))))))))))))))))) (shen.aum_to_shen (hd (tl (tl (tl (tl (tl (tl (tl V971)))))))))) ((and (cons? V971) (and (= shen.rename (hd V971)) (and (cons? (tl V971)) (and (= shen.the (hd (tl V971))) (and (cons? (tl (tl V971))) (and (= shen.variables (hd (tl (tl V971)))) (and (cons? (tl (tl (tl V971)))) (and (= in (hd (tl (tl (tl V971))))) (and (cons? (tl (tl (tl (tl V971))))) (and (cons? (hd (tl (tl (tl (tl V971)))))) (and (cons? (tl (tl (tl (tl (tl V971)))))) (and (= and (hd (tl (tl (tl (tl (tl V971))))))) (and (cons? (tl (tl (tl (tl (tl (tl V971))))))) (and (= shen.then (hd (tl (tl (tl (tl (tl (tl V971)))))))) (and (cons? (tl (tl (tl (tl (tl (tl (tl V971)))))))) (= () (tl (tl (tl (tl (tl (tl (tl (tl V971)))))))))))))))))))))))) (cons let (cons (hd (hd (tl (tl (tl (tl V971)))))) (cons (cons shen.newpv (cons ProcessN ())) (cons (shen.aum_to_shen (cons shen.rename (cons shen.the (cons shen.variables (cons in (cons (tl (hd (tl (tl (tl (tl V971)))))) (tl (tl (tl (tl (tl V971))))))))))) ()))))) ((and (cons? V971) (and (= bind (hd V971)) (and (cons? (tl V971)) (and (cons? (tl (tl V971))) (and (= shen.to (hd (tl (tl V971)))) (and (cons? (tl (tl (tl V971)))) (and (cons? (tl (tl (tl (tl V971))))) (and (= in (hd (tl (tl (tl (tl V971)))))) (and (cons? (tl (tl (tl (tl (tl V971)))))) (= () (tl (tl (tl (tl (tl (tl V971)))))))))))))))) (cons do (cons (cons shen.bindv (cons (hd (tl V971)) (cons (shen.chwild (hd (tl (tl (tl V971))))) (cons ProcessN ())))) (cons (cons let (cons Result (cons (shen.aum_to_shen (hd (tl (tl (tl (tl (tl V971))))))) (cons (cons do (cons (cons shen.unbindv (cons (hd (tl V971)) (cons ProcessN ()))) (cons Result ()))) ())))) ())))) ((and (cons? V971) (and (cons? (tl V971)) (and (= is (hd (tl V971))) (and (cons? (tl (tl V971))) (and (= identical (hd (tl (tl V971)))) (and (cons? (tl (tl (tl V971)))) (and (= shen.to (hd (tl (tl (tl V971))))) (and (cons? (tl (tl (tl (tl V971))))) (= () (tl (tl (tl (tl (tl V971)))))))))))))) (cons = (cons (hd (tl (tl (tl (tl V971))))) (cons (hd V971) ())))) ((= shen.failed! V971) false) ((and (cons? V971) (and (= shen.the (hd V971)) (and (cons? (tl V971)) (and (= head (hd (tl V971))) (and (cons? (tl (tl V971))) (and (= shen.of (hd (tl (tl V971)))) (and (cons? (tl (tl (tl V971)))) (= () (tl (tl (tl (tl V971)))))))))))) (cons hd (tl (tl (tl V971))))) ((and (cons? V971) (and (= shen.the (hd V971)) (and (cons? (tl V971)) (and (= tail (hd (tl V971))) (and (cons? (tl (tl V971))) (and (= shen.of (hd (tl (tl V971)))) (and (cons? (tl (tl (tl V971)))) (= () (tl (tl (tl (tl V971)))))))))))) (cons tl (tl (tl (tl V971))))) ((and (cons? V971) (and (= shen.pop (hd V971)) (and (cons? (tl V971)) (and (= shen.the (hd (tl V971))) (and (cons? (tl (tl V971))) (and (= shen.stack (hd (tl (tl V971)))) (= () (tl (tl (tl V971)))))))))) (cons do (cons (cons shen.incinfs ()) (cons (cons thaw (cons Continuation ())) ())))) ((and (cons? V971) (and (= call (hd V971)) (and (cons? (tl V971)) (and (= shen.the (hd (tl V971))) (and (cons? (tl (tl V971))) (and (= shen.continuation (hd (tl (tl V971)))) (and (cons? (tl (tl (tl V971)))) (= () (tl (tl (tl (tl V971)))))))))))) (cons do (cons (cons shen.incinfs ()) (cons (shen.call_the_continuation (shen.chwild (hd (tl (tl (tl V971))))) ProcessN Continuation) ())))) (true V971)))
+
+(defun shen.chwild (V972) (cond ((= V972 _) (cons shen.newpv (cons ProcessN ()))) ((cons? V972) (map shen.chwild V972)) (true V972)))
+
+(defun shen.newpv (V973) (let Count+1 (+ (<-address (value shen.*varcounter*) V973) 1) (let IncVar (address-> (value shen.*varcounter*) V973 Count+1) (let Vector (<-address (value shen.*prologvectors*) V973) (let ResizeVectorIfNeeded (if (= Count+1 (limit Vector)) (shen.resizeprocessvector V973 Count+1) shen.skip) (shen.mk-pvar Count+1))))))
+
+(defun shen.resizeprocessvector (V974 V975) (let Vector (<-address (value shen.*prologvectors*) V974) (let BigVector (shen.resize-vector Vector (+ V975 V975) shen.-null-) (address-> (value shen.*prologvectors*) V974 BigVector))))
+
+(defun shen.resize-vector (V976 V977 V978) (let BigVector (address-> (absvector (+ 1 V977)) 0 V977) (shen.copy-vector V976 BigVector (limit V976) V977 V978)))
+
+(defun shen.copy-vector (V979 V980 V981 V982 V983) (shen.copy-vector-stage-2 (+ 1 V981) (+ V982 1) V983 (shen.copy-vector-stage-1 1 V979 V980 (+ 1 V981))))
+
+(defun shen.copy-vector-stage-1 (V987 V988 V989 V990) (cond ((= V990 V987) V989) (true (shen.copy-vector-stage-1 (+ 1 V987) V988 (address-> V989 V987 (<-address V988 V987)) V990))))
+
+(defun shen.copy-vector-stage-2 (V994 V995 V996 V997) (cond ((= V995 V994) V997) (true (shen.copy-vector-stage-2 (+ V994 1) V995 V996 (address-> V997 V994 V996)))))
+
+(defun shen.mk-pvar (V998) (address-> (address-> (absvector 2) 0 shen.pvar) 1 V998))
+
+(defun shen.pvar? (V999) (trap-error (and (absvector? V999) (= (<-address V999 0) shen.pvar)) (lambda E false)))
+
+(defun shen.bindv (V1000 V1001 V1002) (let Vector (<-address (value shen.*prologvectors*) V1002) (address-> Vector (<-address V1000 1) V1001)))
+
+(defun shen.unbindv (V1003 V1004) (let Vector (<-address (value shen.*prologvectors*) V1004) (address-> Vector (<-address V1003 1) shen.-null-)))
+
+(defun shen.incinfs () (set shen.*infs* (+ 1 (value shen.*infs*))))
+
+(defun shen.call_the_continuation (V1005 V1006 V1007) (cond ((and (cons? V1005) (and (cons? (hd V1005)) (= () (tl V1005)))) (cons (hd (hd V1005)) (append (tl (hd V1005)) (cons V1006 (cons V1007 ()))))) ((and (cons? V1005) (cons? (hd V1005))) (let NewContinuation (shen.newcontinuation (tl V1005) V1006 V1007) (cons (hd (hd V1005)) (append (tl (hd V1005)) (cons V1006 (cons NewContinuation ())))))) (true (shen.f_error shen.call_the_continuation))))
+
+(defun shen.newcontinuation (V1008 V1009 V1010) (cond ((= () V1008) V1010) ((and (cons? V1008) (cons? (hd V1008))) (cons freeze (cons (cons (hd (hd V1008)) (append (tl (hd V1008)) (cons V1009 (cons (shen.newcontinuation (tl V1008) V1009 V1010) ())))) ()))) (true (shen.f_error shen.newcontinuation))))
+
+(defun return (V1015 V1016 V1017) (shen.deref V1015 V1016))
+
+(defun shen.measure&return (V1022 V1023 V1024) (do (shen.prhush (shen.app (value shen.*infs*) " inferences
+" shen.a) (stoutput)) (shen.deref V1022 V1023)))
+
+(defun unify (V1025 V1026 V1027 V1028) (shen.lzy= (shen.lazyderef V1025 V1027) (shen.lazyderef V1026 V1027) V1027 V1028))
+
+(defun shen.lzy= (V1046 V1047 V1048 V1049) (cond ((= V1047 V1046) (thaw V1049)) ((shen.pvar? V1046) (bind V1046 V1047 V1048 V1049)) ((shen.pvar? V1047) (bind V1047 V1046 V1048 V1049)) ((and (cons? V1046) (cons? V1047)) (shen.lzy= (shen.lazyderef (hd V1046) V1048) (shen.lazyderef (hd V1047) V1048) V1048 (freeze (shen.lzy= (shen.lazyderef (tl V1046) V1048) (shen.lazyderef (tl V1047) V1048) V1048 V1049)))) (true false)))
+
+(defun shen.deref (V1050 V1051) (cond ((cons? V1050) (cons (shen.deref (hd V1050) V1051) (shen.deref (tl V1050) V1051))) (true (if (shen.pvar? V1050) (let Value (shen.valvector V1050 V1051) (if (= Value shen.-null-) V1050 (shen.deref Value V1051))) V1050))))
+
+(defun shen.lazyderef (V1052 V1053) (if (shen.pvar? V1052) (let Value (shen.valvector V1052 V1053) (if (= Value shen.-null-) V1052 (shen.lazyderef Value V1053))) V1052))
+
+(defun shen.valvector (V1054 V1055) (<-address (<-address (value shen.*prologvectors*) V1055) (<-address V1054 1)))
+
+(defun unify! (V1056 V1057 V1058 V1059) (shen.lzy=! (shen.lazyderef V1056 V1058) (shen.lazyderef V1057 V1058) V1058 V1059))
+
+(defun shen.lzy=! (V1077 V1078 V1079 V1080) (cond ((= V1078 V1077) (thaw V1080)) ((and (shen.pvar? V1077) (not (shen.occurs? V1077 (shen.deref V1078 V1079)))) (bind V1077 V1078 V1079 V1080)) ((and (shen.pvar? V1078) (not (shen.occurs? V1078 (shen.deref V1077 V1079)))) (bind V1078 V1077 V1079 V1080)) ((and (cons? V1077) (cons? V1078)) (shen.lzy=! (shen.lazyderef (hd V1077) V1079) (shen.lazyderef (hd V1078) V1079) V1079 (freeze (shen.lzy=! (shen.lazyderef (tl V1077) V1079) (shen.lazyderef (tl V1078) V1079) V1079 V1080)))) (true false)))
+
+(defun shen.occurs? (V1090 V1091) (cond ((= V1091 V1090) true) ((cons? V1091) (or (shen.occurs? V1090 (hd V1091)) (shen.occurs? V1090 (tl V1091)))) (true false)))
+
+(defun identical (V1092 V1093 V1094 V1095) (shen.lzy== (shen.lazyderef V1092 V1094) (shen.lazyderef V1093 V1094) V1094 V1095))
+
+(defun shen.lzy== (V1113 V1114 V1115 V1116) (cond ((= V1114 V1113) (thaw V1116)) ((and (cons? V1113) (cons? V1114)) (shen.lzy== (shen.lazyderef (hd V1113) V1115) (shen.lazyderef (hd V1114) V1115) V1115 (freeze (shen.lzy== (tl V1113) (tl V1114) V1115 V1116)))) (true false)))
+
+(defun shen.pvar (V1117) (cn "Var" (shen.app (<-address V1117 1) "" shen.a)))
+
+(defun bind (V1118 V1119 V1120 V1121) (do (shen.bindv V1118 V1119 V1120) (let Result (thaw V1121) (do (shen.unbindv V1118 V1120) Result))))
+
+(defun fwhen (V1136 V1137 V1138) (cond ((= true V1136) (thaw V1138)) ((= false V1136) false) (true (simple-error (cn "fwhen expects a boolean: not " (shen.app V1136 "%" shen.s))))))
+
+(defun call (V1151 V1152 V1153) (cond ((cons? V1151) (shen.call-help (shen.m_prolog_to_s-prolog_predicate (shen.lazyderef (hd V1151) V1152)) (tl V1151) V1152 V1153)) (true false)))
+
+(defun shen.call-help (V1154 V1155 V1156 V1157) (cond ((= () V1155) (V1154 V1156 V1157)) ((cons? V1155) (shen.call-help (V1154 (hd V1155)) (tl V1155) V1156 V1157)) (true (shen.f_error shen.call-help))))
+
+(defun shen.intprolog (V1158) (cond ((and (cons? V1158) (cons? (hd V1158))) (let ProcessN (shen.start-new-prolog-process) (shen.intprolog-help (hd (hd V1158)) (shen.insert-prolog-variables (cons (tl (hd V1158)) (cons (tl V1158) ())) ProcessN) ProcessN))) (true (shen.f_error shen.intprolog))))
+
+(defun shen.intprolog-help (V1159 V1160 V1161) (cond ((and (cons? V1160) (and (cons? (tl V1160)) (= () (tl (tl V1160))))) (shen.intprolog-help-help V1159 (hd V1160) (hd (tl V1160)) V1161)) (true (shen.f_error shen.intprolog-help))))
+
+(defun shen.intprolog-help-help (V1162 V1163 V1164 V1165) (cond ((= () V1163) (V1162 V1165 (freeze (shen.call-rest V1164 V1165)))) ((cons? V1163) (shen.intprolog-help-help (V1162 (hd V1163)) (tl V1163) V1164 V1165)) (true (shen.f_error shen.intprolog-help-help))))
+
+(defun shen.call-rest (V1168 V1169) (cond ((= () V1168) true) ((and (cons? V1168) (and (cons? (hd V1168)) (cons? (tl (hd V1168))))) (shen.call-rest (cons (cons ((hd (hd V1168)) (hd (tl (hd V1168)))) (tl (tl (hd V1168)))) (tl V1168)) V1169)) ((and (cons? V1168) (and (cons? (hd V1168)) (= () (tl (hd V1168))))) ((hd (hd V1168)) V1169 (freeze (shen.call-rest (tl V1168) V1169)))) (true (shen.f_error shen.call-rest))))
+
+(defun shen.start-new-prolog-process () (let IncrementProcessCounter (set shen.*process-counter* (+ 1 (value shen.*process-counter*))) (shen.initialise-prolog IncrementProcessCounter)))
+
+(defun shen.insert-prolog-variables (V1170 V1171) (shen.insert-prolog-variables-help V1170 (shen.flatten V1170) V1171))
+
+(defun shen.insert-prolog-variables-help (V1176 V1177 V1178) (cond ((= () V1177) V1176) ((and (cons? V1177) (variable? (hd V1177))) (let V (shen.newpv V1178) (let XV/Y (subst V (hd V1177) V1176) (let Z-Y (remove (hd V1177) (tl V1177)) (shen.insert-prolog-variables-help XV/Y Z-Y V1178))))) ((cons? V1177) (shen.insert-prolog-variables-help V1176 (tl V1177) V1178)) (true (shen.f_error shen.insert-prolog-variables-help))))
+
+(defun shen.initialise-prolog (V1179) (let Vector (address-> (value shen.*prologvectors*) V1179 (shen.fillvector (vector 10) 1 10 shen.-null-)) (let Counter (address-> (value shen.*varcounter*) V1179 1) V1179)))
+
+
+