"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. (V1664) (let Parse_shen. (shen. V1664) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (hd (shen.prolog->shen (map (lambda Parse_X (shen.insert-predicate (shen.hdtl Parse_shen.) Parse_X)) (shen.hdtl Parse_shen.))))) (fail))) (fail)))) (defun shen.prolog-error (V1673 V1674) (cond ((and (cons? V1674) (and (cons? (tl V1674)) (= () (tl (tl V1674))))) (simple-error (cn "prolog syntax error in " (shen.app V1673 (cn " here: " (shen.app (shen.next-50 50 (hd V1674)) " " shen.a)) shen.a)))) (true (simple-error (cn "prolog syntax error in " (shen.app V1673 " " shen.a)))))) (defun shen.next-50 (V1681 V1682) (cond ((= () V1682) "") ((= 0 V1681) "") ((cons? V1682) (cn (shen.decons-string (hd V1682)) (shen.next-50 (- V1681 1) (tl V1682)))) (true (shen.f_error shen.next-50)))) (defun shen.decons-string (V1684) (cond ((and (cons? V1684) (and (= cons (hd V1684)) (and (cons? (tl V1684)) (and (cons? (tl (tl V1684))) (= () (tl (tl (tl V1684)))))))) (shen.app (shen.eval-cons V1684) " " shen.s)) (true (shen.app V1684 " " shen.r)))) (defun shen.insert-predicate (V1687 V1688) (cond ((and (cons? V1688) (and (cons? (tl V1688)) (= () (tl (tl V1688))))) (cons (cons V1687 (hd V1688)) (cons :- (tl V1688)))) (true (shen.f_error shen.insert-predicate)))) (defun shen. (V1690) (if (cons? (hd V1690)) (let Parse_X (shen.hdhd V1690) (shen.pair (hd (shen.pair (shen.tlhd V1690) (shen.hdtl V1690))) Parse_X)) (fail))) (defun shen. (V1692) (let YaccParse (let Parse_shen. (shen. V1692) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (shen.hdtl Parse_shen.) (shen.hdtl Parse_shen.))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_ ( V1692) (if (not (= (fail) Parse_)) (shen.pair (hd Parse_) ()) (fail))) YaccParse))) (defun shen. (V1695) (let Parse_shen. (shen. V1695) (if (not (= (fail) Parse_shen.)) (if (and (cons? (hd Parse_shen.)) (= <-- (shen.hdhd Parse_shen.))) (let NewStream1693 (shen.pair (shen.tlhd Parse_shen.) (shen.hdtl Parse_shen.)) (let Parse_shen. (shen. NewStream1693) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (shen.hdtl Parse_shen.) (cons (shen.hdtl Parse_shen.) ()))) (fail))) (fail)))) (fail)) (fail)))) (defun shen. (V1697) (let YaccParse (let Parse_shen. (shen. V1697) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (shen.hdtl Parse_shen.) (shen.hdtl Parse_shen.))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_ ( V1697) (if (not (= (fail) Parse_)) (shen.pair (hd Parse_) ()) (fail))) YaccParse))) (defun shen. (V1699) (if (cons? (hd V1699)) (let Parse_X (shen.hdhd V1699) (if (and (not (= <-- Parse_X)) (shen.legitimate-term? Parse_X)) (shen.pair (hd (shen.pair (shen.tlhd V1699) (shen.hdtl V1699))) (shen.eval-cons Parse_X)) (fail))) (fail))) (defun shen.legitimate-term? (V1705) (cond ((and (cons? V1705) (and (= cons (hd V1705)) (and (cons? (tl V1705)) (and (cons? (tl (tl V1705))) (= () (tl (tl (tl V1705)))))))) (and (shen.legitimate-term? (hd (tl V1705))) (shen.legitimate-term? (hd (tl (tl V1705)))))) ((and (cons? V1705) (and (= mode (hd V1705)) (and (cons? (tl V1705)) (and (cons? (tl (tl V1705))) (and (= + (hd (tl (tl V1705)))) (= () (tl (tl (tl V1705))))))))) (shen.legitimate-term? (hd (tl V1705)))) ((and (cons? V1705) (and (= mode (hd V1705)) (and (cons? (tl V1705)) (and (cons? (tl (tl V1705))) (and (= - (hd (tl (tl V1705)))) (= () (tl (tl (tl V1705))))))))) (shen.legitimate-term? (hd (tl V1705)))) ((cons? V1705) false) (true true))) (defun shen.eval-cons (V1707) (cond ((and (cons? V1707) (and (= cons (hd V1707)) (and (cons? (tl V1707)) (and (cons? (tl (tl V1707))) (= () (tl (tl (tl V1707)))))))) (cons (shen.eval-cons (hd (tl V1707))) (shen.eval-cons (hd (tl (tl V1707)))))) ((and (cons? V1707) (and (= mode (hd V1707)) (and (cons? (tl V1707)) (and (cons? (tl (tl V1707))) (= () (tl (tl (tl V1707)))))))) (cons mode (cons (shen.eval-cons (hd (tl V1707))) (tl (tl V1707))))) (true V1707))) (defun shen. (V1709) (let YaccParse (let Parse_shen. (shen. V1709) (if (not (= (fail) Parse_shen.)) (let Parse_shen. (shen. Parse_shen.) (if (not (= (fail) Parse_shen.)) (shen.pair (hd Parse_shen.) (cons (shen.hdtl Parse_shen.) (shen.hdtl Parse_shen.))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_ ( V1709) (if (not (= (fail) Parse_)) (shen.pair (hd Parse_) ()) (fail))) YaccParse))) (defun shen. (V1712) (let YaccParse (if (and (cons? (hd V1712)) (= ! (shen.hdhd V1712))) (let NewStream1710 (shen.pair (shen.tlhd V1712) (shen.hdtl V1712)) (shen.pair (hd NewStream1710) (cons cut (cons (intern "Throwcontrol") ())))) (fail)) (if (= YaccParse (fail)) (if (cons? (hd V1712)) (let Parse_X (shen.hdhd V1712) (if (cons? Parse_X) (shen.pair (hd (shen.pair (shen.tlhd V1712) (shen.hdtl V1712))) Parse_X) (fail))) (fail)) YaccParse))) (defun shen. (V1714) (if (cons? (hd V1714)) (let Parse_X (shen.hdhd V1714) (if (= Parse_X ;) (shen.pair (hd (shen.pair (shen.tlhd V1714) (shen.hdtl V1714))) Parse_X) (fail))) (fail))) (defun cut (V1718 V1719 V1720) (let Result (thaw V1720) (if (= Result false) V1718 Result))) (defun shen.insert_modes (V1722) (cond ((and (cons? V1722) (and (= mode (hd V1722)) (and (cons? (tl V1722)) (and (cons? (tl (tl V1722))) (= () (tl (tl (tl V1722)))))))) V1722) ((= () V1722) ()) ((cons? V1722) (cons (cons mode (cons (hd V1722) (cons + ()))) (cons mode (cons (shen.insert_modes (tl V1722)) (cons - ()))))) (true V1722))) (defun shen.s-prolog (V1724) (map (lambda X (eval X)) (shen.prolog->shen V1724))) (defun shen.prolog->shen (V1726) (map (lambda X (shen.compile_prolog_procedure X)) (shen.group_clauses (map (lambda X (shen.s-prolog_clause X)) (mapcan (lambda X (shen.head_abstraction X)) V1726))))) (defun shen.s-prolog_clause (V1728) (cond ((and (cons? V1728) (and (cons? (tl V1728)) (and (= :- (hd (tl V1728))) (and (cons? (tl (tl V1728))) (= () (tl (tl (tl V1728)))))))) (cons (hd V1728) (cons :- (cons (map (lambda X (shen.s-prolog_literal X)) (hd (tl (tl V1728)))) ())))) (true (shen.f_error shen.s-prolog_clause)))) (defun shen.head_abstraction (V1730) (cond ((and (cons? V1730) (and (cons? (tl V1730)) (and (= :- (hd (tl V1730))) (and (cons? (tl (tl V1730))) (and (= () (tl (tl (tl V1730)))) (trap-error (< (shen.complexity_head (hd V1730)) (value shen.*maxcomplexity*)) (lambda _ false))))))) (cons V1730 ())) ((and (cons? V1730) (and (cons? (hd V1730)) (and (cons? (tl V1730)) (and (= :- (hd (tl V1730))) (and (cons? (tl (tl V1730))) (= () (tl (tl (tl V1730))))))))) (let Terms (map (lambda Y (gensym V)) (tl (hd V1730))) (let XTerms (shen.rcons_form (shen.remove_modes (tl (hd V1730)))) (let Literal (cons unify (cons (shen.cons_form Terms) (cons XTerms ()))) (let Clause (cons (cons (hd (hd V1730)) Terms) (cons :- (cons (cons Literal (hd (tl (tl V1730)))) ()))) (cons Clause ())))))) (true (shen.f_error shen.head_abstraction)))) (defun shen.complexity_head (V1736) (cond ((cons? V1736) (shen.safe-product (map (lambda X (shen.complexity X)) (tl V1736)))) (true (shen.f_error shen.complexity_head)))) (defun shen.safe-multiply (V1739 V1740) (* V1739 V1740)) (defun shen.complexity (V1749) (cond ((and (cons? V1749) (and (= mode (hd V1749)) (and (cons? (tl V1749)) (and (cons? (hd (tl V1749))) (and (= mode (hd (hd (tl V1749)))) (and (cons? (tl (hd (tl V1749)))) (and (cons? (tl (tl (hd (tl V1749))))) (and (= () (tl (tl (tl (hd (tl V1749)))))) (and (cons? (tl (tl V1749))) (= () (tl (tl (tl V1749))))))))))))) (shen.complexity (hd (tl V1749)))) ((and (cons? V1749) (and (= mode (hd V1749)) (and (cons? (tl V1749)) (and (cons? (hd (tl V1749))) (and (cons? (tl (tl V1749))) (and (= + (hd (tl (tl V1749)))) (= () (tl (tl (tl V1749)))))))))) (shen.safe-multiply 2 (shen.safe-multiply (shen.complexity (cons mode (cons (hd (hd (tl V1749))) (tl (tl V1749))))) (shen.complexity (cons mode (cons (tl (hd (tl V1749))) (tl (tl V1749)))))))) ((and (cons? V1749) (and (= mode (hd V1749)) (and (cons? (tl V1749)) (and (cons? (hd (tl V1749))) (and (cons? (tl (tl V1749))) (and (= - (hd (tl (tl V1749)))) (= () (tl (tl (tl V1749)))))))))) (shen.safe-multiply (shen.complexity (cons mode (cons (hd (hd (tl V1749))) (tl (tl V1749))))) (shen.complexity (cons mode (cons (tl (hd (tl V1749))) (tl (tl V1749))))))) ((and (cons? V1749) (and (= mode (hd V1749)) (and (cons? (tl V1749)) (and (cons? (tl (tl V1749))) (and (= () (tl (tl (tl V1749)))) (variable? (hd (tl V1749)))))))) 1) ((and (cons? V1749) (and (= mode (hd V1749)) (and (cons? (tl V1749)) (and (cons? (tl (tl V1749))) (and (= + (hd (tl (tl V1749)))) (= () (tl (tl (tl V1749))))))))) 2) ((and (cons? V1749) (and (= mode (hd V1749)) (and (cons? (tl V1749)) (and (cons? (tl (tl V1749))) (and (= - (hd (tl (tl V1749)))) (= () (tl (tl (tl V1749))))))))) 1) (true (shen.complexity (cons mode (cons V1749 (cons + ()))))))) (defun shen.safe-product (V1751) (cond ((= () V1751) 1) ((cons? V1751) (shen.safe-multiply (hd V1751) (shen.safe-product (tl V1751)))) (true (shen.f_error shen.safe-product)))) (defun shen.s-prolog_literal (V1753) (cond ((and (cons? V1753) (and (= is (hd V1753)) (and (cons? (tl V1753)) (and (cons? (tl (tl V1753))) (= () (tl (tl (tl V1753)))))))) (cons bind (cons (hd (tl V1753)) (cons (shen.insert-deref (hd (tl (tl V1753))) ProcessN) ())))) ((and (cons? V1753) (and (= when (hd V1753)) (and (cons? (tl V1753)) (= () (tl (tl V1753)))))) (cons fwhen (cons (shen.insert-deref (hd (tl V1753)) ProcessN) ()))) ((and (cons? V1753) (and (= bind (hd V1753)) (and (cons? (tl V1753)) (and (cons? (tl (tl V1753))) (= () (tl (tl (tl V1753)))))))) (cons bind (cons (hd (tl V1753)) (cons (shen.insert-lazyderef (hd (tl (tl V1753))) ProcessN) ())))) ((and (cons? V1753) (and (= fwhen (hd V1753)) (and (cons? (tl V1753)) (= () (tl (tl V1753)))))) (cons fwhen (cons (shen.insert-lazyderef (hd (tl V1753)) ProcessN) ()))) ((cons? V1753) V1753) (true (shen.f_error shen.s-prolog_literal)))) (defun shen.insert-deref (V1760 V1761) (cond ((variable? V1760) (cons shen.deref (cons V1760 (cons V1761 ())))) ((and (cons? V1760) (and (= lambda (hd V1760)) (and (cons? (tl V1760)) (and (cons? (tl (tl V1760))) (= () (tl (tl (tl V1760)))))))) (cons lambda (cons (hd (tl V1760)) (cons (shen.insert-deref (hd (tl (tl V1760))) V1761) ())))) ((and (cons? V1760) (and (= let (hd V1760)) (and (cons? (tl V1760)) (and (cons? (tl (tl V1760))) (and (cons? (tl (tl (tl V1760)))) (= () (tl (tl (tl (tl V1760)))))))))) (cons let (cons (hd (tl V1760)) (cons (shen.insert-deref (hd (tl (tl V1760))) V1761) (cons (shen.insert-deref (hd (tl (tl (tl V1760)))) V1761) ()))))) ((cons? V1760) (cons (shen.insert-deref (hd V1760) V1761) (shen.insert-deref (tl V1760) V1761))) (true V1760))) (defun shen.insert-lazyderef (V1768 V1769) (cond ((variable? V1768) (cons shen.lazyderef (cons V1768 (cons V1769 ())))) ((and (cons? V1768) (and (= lambda (hd V1768)) (and (cons? (tl V1768)) (and (cons? (tl (tl V1768))) (= () (tl (tl (tl V1768)))))))) (cons lambda (cons (hd (tl V1768)) (cons (shen.insert-lazyderef (hd (tl (tl V1768))) V1769) ())))) ((and (cons? V1768) (and (= let (hd V1768)) (and (cons? (tl V1768)) (and (cons? (tl (tl V1768))) (and (cons? (tl (tl (tl V1768)))) (= () (tl (tl (tl (tl V1768)))))))))) (cons let (cons (hd (tl V1768)) (cons (shen.insert-lazyderef (hd (tl (tl V1768))) V1769) (cons (shen.insert-lazyderef (hd (tl (tl (tl V1768)))) V1769) ()))))) ((cons? V1768) (cons (shen.insert-lazyderef (hd V1768) V1769) (shen.insert-lazyderef (tl V1768) V1769))) (true V1768))) (defun shen.group_clauses (V1771) (cond ((= () V1771) ()) ((cons? V1771) (let Group (shen.collect (lambda X (shen.same_predicate? (hd V1771) X)) V1771) (let Rest (difference V1771 Group) (cons Group (shen.group_clauses Rest))))) (true (shen.f_error shen.group_clauses)))) (defun shen.collect (V1776 V1777) (cond ((= () V1777) ()) ((cons? V1777) (if (V1776 (hd V1777)) (cons (hd V1777) (shen.collect V1776 (tl V1777))) (shen.collect V1776 (tl V1777)))) (true (shen.f_error shen.collect)))) (defun shen.same_predicate? (V1796 V1797) (cond ((and (cons? V1796) (and (cons? (hd V1796)) (and (cons? V1797) (cons? (hd V1797))))) (= (hd (hd V1796)) (hd (hd V1797)))) (true (shen.f_error shen.same_predicate?)))) (defun shen.compile_prolog_procedure (V1799) (let F (shen.procedure_name V1799) (let Shen (shen.clauses-to-shen F V1799) Shen))) (defun shen.procedure_name (V1813) (cond ((and (cons? V1813) (and (cons? (hd V1813)) (cons? (hd (hd V1813))))) (hd (hd (hd V1813)))) (true (shen.f_error shen.procedure_name)))) (defun shen.clauses-to-shen (V1816 V1817) (let Linear (map (lambda X (shen.linearise-clause X)) V1817) (let Arity (shen.prolog-aritycheck V1816 (map (lambda X (head X)) V1817)) (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 (lambda X (shen.aum_to_shen X)) AUM_instructions))) (let ShenDef (cons define (cons V1816 (append Parameters (append (cons ProcessN (cons Continuation ())) (cons -> (cons Code ())))))) ShenDef))))))) (defun shen.catch-cut (V1819) (cond ((not (shen.occurs? cut V1819)) V1819) (true (cons let (cons Throwcontrol (cons (cons shen.catchpoint ()) (cons (cons shen.cutpoint (cons Throwcontrol (cons V1819 ()))) ()))))))) (defun shen.catchpoint () (set shen.*catch* (+ 1 (value shen.*catch*)))) (defun shen.cutpoint (V1827 V1828) (cond ((= V1828 V1827) false) (true V1828))) (defun shen.nest-disjunct (V1830) (cond ((and (cons? V1830) (= () (tl V1830))) (hd V1830)) ((cons? V1830) (shen.lisp-or (hd V1830) (shen.nest-disjunct (tl V1830)))) (true (shen.f_error shen.nest-disjunct)))) (defun shen.lisp-or (V1833 V1834) (cons let (cons Case (cons V1833 (cons (cons if (cons (cons = (cons Case (cons false ()))) (cons V1834 (cons Case ())))) ()))))) (defun shen.prolog-aritycheck (V1839 V1840) (cond ((and (cons? V1840) (= () (tl V1840))) (- (length (hd V1840)) 1)) ((and (cons? V1840) (cons? (tl V1840))) (if (= (length (hd V1840)) (length (hd (tl V1840)))) (shen.prolog-aritycheck V1839 (tl V1840)) (simple-error (cn "arity error in prolog procedure " (shen.app (cons V1839 ()) " " shen.a))))) (true (shen.f_error shen.prolog-aritycheck)))) (defun shen.linearise-clause (V1842) (cond ((and (cons? V1842) (and (cons? (tl V1842)) (and (= :- (hd (tl V1842))) (and (cons? (tl (tl V1842))) (= () (tl (tl (tl V1842)))))))) (let Linear (shen.linearise (cons (hd V1842) (tl (tl V1842)))) (shen.clause_form Linear))) (true (shen.f_error shen.linearise-clause)))) (defun shen.clause_form (V1844) (cond ((and (cons? V1844) (and (cons? (tl V1844)) (= () (tl (tl V1844))))) (cons (shen.explicit_modes (hd V1844)) (cons :- (cons (shen.cf_help (hd (tl V1844))) ())))) (true (shen.f_error shen.clause_form)))) (defun shen.explicit_modes (V1846) (cond ((cons? V1846) (cons (hd V1846) (map (lambda X (shen.em_help X)) (tl V1846)))) (true (shen.f_error shen.explicit_modes)))) (defun shen.em_help (V1848) (cond ((and (cons? V1848) (and (= mode (hd V1848)) (and (cons? (tl V1848)) (and (cons? (tl (tl V1848))) (= () (tl (tl (tl V1848)))))))) V1848) (true (cons mode (cons V1848 (cons + ())))))) (defun shen.cf_help (V1850) (cond ((and (cons? V1850) (and (= where (hd V1850)) (and (cons? (tl V1850)) (and (cons? (hd (tl V1850))) (and (= = (hd (hd (tl V1850)))) (and (cons? (tl (hd (tl V1850)))) (and (cons? (tl (tl (hd (tl V1850))))) (and (= () (tl (tl (tl (hd (tl V1850)))))) (and (cons? (tl (tl V1850))) (= () (tl (tl (tl V1850))))))))))))) (cons (cons (if (value shen.*occurs*) unify! unify) (tl (hd (tl V1850)))) (shen.cf_help (hd (tl (tl V1850)))))) (true V1850))) (defun occurs-check (V1856) (cond ((= + V1856) (set shen.*occurs* true)) ((= - V1856) (set shen.*occurs* false)) (true (simple-error "occurs-check expects + or - ")))) (defun shen.aum (V1859 V1860) (cond ((and (cons? V1859) (and (cons? (hd V1859)) (and (cons? (tl V1859)) (and (= :- (hd (tl V1859))) (and (cons? (tl (tl V1859))) (= () (tl (tl (tl V1859))))))))) (let MuApplication (shen.make_mu_application (cons shen.mu (cons (tl (hd V1859)) (cons (shen.continuation_call (tl (hd V1859)) (hd (tl (tl V1859)))) ()))) V1860) (shen.mu_reduction MuApplication +))) (true (shen.f_error shen.aum)))) (defun shen.continuation_call (V1863 V1864) (let VTerms (cons ProcessN (shen.extract_vars V1863)) (let VBody (shen.extract_vars V1864) (let Free (remove Throwcontrol (difference VBody VTerms)) (shen.cc_help Free V1864))))) (defun remove (V1867 V1868) (shen.remove-h V1867 V1868 ())) (defun shen.remove-h (V1875 V1876 V1877) (cond ((= () V1876) (reverse V1877)) ((and (cons? V1876) (= (hd V1876) V1875)) (shen.remove-h (hd V1876) (tl V1876) V1877)) ((cons? V1876) (shen.remove-h V1875 (tl V1876) (cons (hd V1876) V1877))) (true (shen.f_error shen.remove-h)))) (defun shen.cc_help (V1880 V1881) (cond ((and (= () V1880) (= () V1881)) (cons shen.pop (cons shen.the (cons shen.stack ())))) ((= () V1881) (cons shen.rename (cons shen.the (cons shen.variables (cons in (cons V1880 (cons and (cons shen.then (cons (cons shen.pop (cons shen.the (cons shen.stack ()))) ()))))))))) ((= () V1880) (cons call (cons shen.the (cons shen.continuation (cons V1881 ()))))) (true (cons shen.rename (cons shen.the (cons shen.variables (cons in (cons V1880 (cons and (cons shen.then (cons (cons call (cons shen.the (cons shen.continuation (cons V1881 ())))) ()))))))))))) (defun shen.make_mu_application (V1884 V1885) (cond ((and (cons? V1884) (and (= shen.mu (hd V1884)) (and (cons? (tl V1884)) (and (= () (hd (tl V1884))) (and (cons? (tl (tl V1884))) (and (= () (tl (tl (tl V1884)))) (= () V1885))))))) (hd (tl (tl V1884)))) ((and (cons? V1884) (and (= shen.mu (hd V1884)) (and (cons? (tl V1884)) (and (cons? (hd (tl V1884))) (and (cons? (tl (tl V1884))) (and (= () (tl (tl (tl V1884)))) (cons? V1885))))))) (cons (cons shen.mu (cons (hd (hd (tl V1884))) (cons (shen.make_mu_application (cons shen.mu (cons (tl (hd (tl V1884))) (tl (tl V1884)))) (tl V1885)) ()))) (cons (hd V1885) ()))) (true (shen.f_error shen.make_mu_application)))) (defun shen.mu_reduction (V1894 V1895) (cond ((and (cons? V1894) (and (cons? (hd V1894)) (and (= shen.mu (hd (hd V1894))) (and (cons? (tl (hd V1894))) (and (cons? (hd (tl (hd V1894)))) (and (= mode (hd (hd (tl (hd V1894))))) (and (cons? (tl (hd (tl (hd V1894))))) (and (cons? (tl (tl (hd (tl (hd V1894)))))) (and (= () (tl (tl (tl (hd (tl (hd V1894))))))) (and (cons? (tl (tl (hd V1894)))) (and (= () (tl (tl (tl (hd V1894))))) (and (cons? (tl V1894)) (= () (tl (tl V1894))))))))))))))) (shen.mu_reduction (cons (cons shen.mu (cons (hd (tl (hd (tl (hd V1894))))) (tl (tl (hd V1894))))) (tl V1894)) (hd (tl (tl (hd (tl (hd V1894)))))))) ((and (cons? V1894) (and (cons? (hd V1894)) (and (= shen.mu (hd (hd V1894))) (and (cons? (tl (hd V1894))) (and (cons? (tl (tl (hd V1894)))) (and (= () (tl (tl (tl (hd V1894))))) (and (cons? (tl V1894)) (and (= () (tl (tl V1894))) (= _ (hd (tl (hd V1894)))))))))))) (shen.mu_reduction (hd (tl (tl (hd V1894)))) V1895)) ((and (cons? V1894) (and (cons? (hd V1894)) (and (= shen.mu (hd (hd V1894))) (and (cons? (tl (hd V1894))) (and (cons? (tl (tl (hd V1894)))) (and (= () (tl (tl (tl (hd V1894))))) (and (cons? (tl V1894)) (and (= () (tl (tl V1894))) (shen.ephemeral_variable? (hd (tl (hd V1894))) (hd (tl V1894))))))))))) (subst (hd (tl V1894)) (hd (tl (hd V1894))) (shen.mu_reduction (hd (tl (tl (hd V1894)))) V1895))) ((and (cons? V1894) (and (cons? (hd V1894)) (and (= shen.mu (hd (hd V1894))) (and (cons? (tl (hd V1894))) (and (cons? (tl (tl (hd V1894)))) (and (= () (tl (tl (tl (hd V1894))))) (and (cons? (tl V1894)) (and (= () (tl (tl V1894))) (variable? (hd (tl (hd V1894)))))))))))) (cons let (cons (hd (tl (hd V1894))) (cons shen.be (cons (hd (tl V1894)) (cons in (cons (shen.mu_reduction (hd (tl (tl (hd V1894)))) V1895) ()))))))) ((and (cons? V1894) (and (cons? (hd V1894)) (and (= shen.mu (hd (hd V1894))) (and (cons? (tl (hd V1894))) (and (cons? (tl (tl (hd V1894)))) (and (= () (tl (tl (tl (hd V1894))))) (and (cons? (tl V1894)) (and (= () (tl (tl V1894))) (and (= - V1895) (shen.prolog_constant? (hd (tl (hd V1894))))))))))))) (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 V1894))))) (cons in (cons (cons if (cons (cons Z (cons is (cons identical (cons shen.to (cons (hd (tl (hd V1894))) ()))))) (cons shen.then (cons (shen.mu_reduction (hd (tl (tl (hd V1894)))) -) (cons shen.else (cons shen.failed! ())))))) ())))))))) ((and (cons? V1894) (and (cons? (hd V1894)) (and (= shen.mu (hd (hd V1894))) (and (cons? (tl (hd V1894))) (and (cons? (tl (tl (hd V1894)))) (and (= () (tl (tl (tl (hd V1894))))) (and (cons? (tl V1894)) (and (= () (tl (tl V1894))) (and (= + V1895) (shen.prolog_constant? (hd (tl (hd V1894))))))))))))) (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 V1894))))) (cons in (cons (cons if (cons (cons Z (cons is (cons identical (cons shen.to (cons (hd (tl (hd V1894))) ()))))) (cons shen.then (cons (shen.mu_reduction (hd (tl (tl (hd V1894)))) +) (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 V1894))) (cons in (cons (shen.mu_reduction (hd (tl (tl (hd V1894)))) +) ())))))) (cons shen.else (cons shen.failed! ())))))) ())))))) ())))))))) ((and (cons? V1894) (and (cons? (hd V1894)) (and (= shen.mu (hd (hd V1894))) (and (cons? (tl (hd V1894))) (and (cons? (hd (tl (hd V1894)))) (and (cons? (tl (tl (hd V1894)))) (and (= () (tl (tl (tl (hd V1894))))) (and (cons? (tl V1894)) (and (= () (tl (tl V1894))) (= - V1895)))))))))) (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 V1894))))) (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 V1894)))) (cons (cons (cons shen.mu (cons (tl (hd (tl (hd V1894)))) (tl (tl (hd V1894))))) (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? V1894) (and (cons? (hd V1894)) (and (= shen.mu (hd (hd V1894))) (and (cons? (tl (hd V1894))) (and (cons? (hd (tl (hd V1894)))) (and (cons? (tl (tl (hd V1894)))) (and (= () (tl (tl (tl (hd V1894))))) (and (cons? (tl V1894)) (and (= () (tl (tl V1894))) (= + V1895)))))))))) (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 V1894))))) (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 V1894)))) (cons (cons (cons shen.mu (cons (tl (hd (tl (hd V1894)))) (tl (tl (hd V1894))))) (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 V1894)))) (cons and (cons shen.then (cons (cons bind (cons Z (cons shen.to (cons (shen.rcons_form (shen.remove_modes (hd (tl (hd V1894))))) (cons in (cons (shen.mu_reduction (hd (tl (tl (hd V1894)))) +) ())))))) ())))))))) (cons shen.else (cons shen.failed! ())))))) ())))))) ())))))))) (true V1894))) (defun shen.rcons_form (V1897) (cond ((cons? V1897) (cons cons (cons (shen.rcons_form (hd V1897)) (cons (shen.rcons_form (tl V1897)) ())))) (true V1897))) (defun shen.remove_modes (V1899) (cond ((and (cons? V1899) (and (= mode (hd V1899)) (and (cons? (tl V1899)) (and (cons? (tl (tl V1899))) (and (= + (hd (tl (tl V1899)))) (= () (tl (tl (tl V1899))))))))) (shen.remove_modes (hd (tl V1899)))) ((and (cons? V1899) (and (= mode (hd V1899)) (and (cons? (tl V1899)) (and (cons? (tl (tl V1899))) (and (= - (hd (tl (tl V1899)))) (= () (tl (tl (tl V1899))))))))) (shen.remove_modes (hd (tl V1899)))) ((cons? V1899) (cons (shen.remove_modes (hd V1899)) (shen.remove_modes (tl V1899)))) (true V1899))) (defun shen.ephemeral_variable? (V1902 V1903) (and (variable? V1902) (variable? V1903))) (defun shen.prolog_constant? (V1913) (cond ((cons? V1913) false) (true true))) (defun shen.aum_to_shen (V1915) (cond ((and (cons? V1915) (and (= let (hd V1915)) (and (cons? (tl V1915)) (and (cons? (tl (tl V1915))) (and (= shen.be (hd (tl (tl V1915)))) (and (cons? (tl (tl (tl V1915)))) (and (cons? (tl (tl (tl (tl V1915))))) (and (= in (hd (tl (tl (tl (tl V1915)))))) (and (cons? (tl (tl (tl (tl (tl V1915)))))) (= () (tl (tl (tl (tl (tl (tl V1915)))))))))))))))) (cons let (cons (hd (tl V1915)) (cons (shen.aum_to_shen (hd (tl (tl (tl V1915))))) (cons (shen.aum_to_shen (hd (tl (tl (tl (tl (tl V1915))))))) ()))))) ((and (cons? V1915) (and (= shen.the (hd V1915)) (and (cons? (tl V1915)) (and (= shen.result (hd (tl V1915))) (and (cons? (tl (tl V1915))) (and (= shen.of (hd (tl (tl V1915)))) (and (cons? (tl (tl (tl V1915)))) (and (= shen.dereferencing (hd (tl (tl (tl V1915))))) (and (cons? (tl (tl (tl (tl V1915))))) (= () (tl (tl (tl (tl (tl V1915))))))))))))))) (cons shen.lazyderef (cons (shen.aum_to_shen (hd (tl (tl (tl (tl V1915)))))) (cons ProcessN ())))) ((and (cons? V1915) (and (= if (hd V1915)) (and (cons? (tl V1915)) (and (cons? (tl (tl V1915))) (and (= shen.then (hd (tl (tl V1915)))) (and (cons? (tl (tl (tl V1915)))) (and (cons? (tl (tl (tl (tl V1915))))) (and (= shen.else (hd (tl (tl (tl (tl V1915)))))) (and (cons? (tl (tl (tl (tl (tl V1915)))))) (= () (tl (tl (tl (tl (tl (tl V1915)))))))))))))))) (cons if (cons (shen.aum_to_shen (hd (tl V1915))) (cons (shen.aum_to_shen (hd (tl (tl (tl V1915))))) (cons (shen.aum_to_shen (hd (tl (tl (tl (tl (tl V1915))))))) ()))))) ((and (cons? V1915) (and (cons? (tl V1915)) (and (= is (hd (tl V1915))) (and (cons? (tl (tl V1915))) (and (= shen.a (hd (tl (tl V1915)))) (and (cons? (tl (tl (tl V1915)))) (and (= shen.variable (hd (tl (tl (tl V1915))))) (= () (tl (tl (tl (tl V1915)))))))))))) (cons shen.pvar? (cons (hd V1915) ()))) ((and (cons? V1915) (and (cons? (tl V1915)) (and (= is (hd (tl V1915))) (and (cons? (tl (tl V1915))) (and (= shen.a (hd (tl (tl V1915)))) (and (cons? (tl (tl (tl V1915)))) (and (= shen.non-empty (hd (tl (tl (tl V1915))))) (and (cons? (tl (tl (tl (tl V1915))))) (and (= list (hd (tl (tl (tl (tl V1915)))))) (= () (tl (tl (tl (tl (tl V1915))))))))))))))) (cons cons? (cons (hd V1915) ()))) ((and (cons? V1915) (and (= shen.rename (hd V1915)) (and (cons? (tl V1915)) (and (= shen.the (hd (tl V1915))) (and (cons? (tl (tl V1915))) (and (= shen.variables (hd (tl (tl V1915)))) (and (cons? (tl (tl (tl V1915)))) (and (= in (hd (tl (tl (tl V1915))))) (and (cons? (tl (tl (tl (tl V1915))))) (and (= () (hd (tl (tl (tl (tl V1915)))))) (and (cons? (tl (tl (tl (tl (tl V1915)))))) (and (= and (hd (tl (tl (tl (tl (tl V1915))))))) (and (cons? (tl (tl (tl (tl (tl (tl V1915))))))) (and (= shen.then (hd (tl (tl (tl (tl (tl (tl V1915)))))))) (and (cons? (tl (tl (tl (tl (tl (tl (tl V1915)))))))) (= () (tl (tl (tl (tl (tl (tl (tl (tl V1915)))))))))))))))))))))))) (shen.aum_to_shen (hd (tl (tl (tl (tl (tl (tl (tl V1915)))))))))) ((and (cons? V1915) (and (= shen.rename (hd V1915)) (and (cons? (tl V1915)) (and (= shen.the (hd (tl V1915))) (and (cons? (tl (tl V1915))) (and (= shen.variables (hd (tl (tl V1915)))) (and (cons? (tl (tl (tl V1915)))) (and (= in (hd (tl (tl (tl V1915))))) (and (cons? (tl (tl (tl (tl V1915))))) (and (cons? (hd (tl (tl (tl (tl V1915)))))) (and (cons? (tl (tl (tl (tl (tl V1915)))))) (and (= and (hd (tl (tl (tl (tl (tl V1915))))))) (and (cons? (tl (tl (tl (tl (tl (tl V1915))))))) (and (= shen.then (hd (tl (tl (tl (tl (tl (tl V1915)))))))) (and (cons? (tl (tl (tl (tl (tl (tl (tl V1915)))))))) (= () (tl (tl (tl (tl (tl (tl (tl (tl V1915)))))))))))))))))))))))) (cons let (cons (hd (hd (tl (tl (tl (tl V1915)))))) (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 V1915)))))) (tl (tl (tl (tl (tl V1915))))))))))) ()))))) ((and (cons? V1915) (and (= bind (hd V1915)) (and (cons? (tl V1915)) (and (cons? (tl (tl V1915))) (and (= shen.to (hd (tl (tl V1915)))) (and (cons? (tl (tl (tl V1915)))) (and (cons? (tl (tl (tl (tl V1915))))) (and (= in (hd (tl (tl (tl (tl V1915)))))) (and (cons? (tl (tl (tl (tl (tl V1915)))))) (= () (tl (tl (tl (tl (tl (tl V1915)))))))))))))))) (cons do (cons (cons shen.bindv (cons (hd (tl V1915)) (cons (shen.chwild (hd (tl (tl (tl V1915))))) (cons ProcessN ())))) (cons (cons let (cons Result (cons (shen.aum_to_shen (hd (tl (tl (tl (tl (tl V1915))))))) (cons (cons do (cons (cons shen.unbindv (cons (hd (tl V1915)) (cons ProcessN ()))) (cons Result ()))) ())))) ())))) ((and (cons? V1915) (and (cons? (tl V1915)) (and (= is (hd (tl V1915))) (and (cons? (tl (tl V1915))) (and (= identical (hd (tl (tl V1915)))) (and (cons? (tl (tl (tl V1915)))) (and (= shen.to (hd (tl (tl (tl V1915))))) (and (cons? (tl (tl (tl (tl V1915))))) (= () (tl (tl (tl (tl (tl V1915)))))))))))))) (cons = (cons (hd (tl (tl (tl (tl V1915))))) (cons (hd V1915) ())))) ((= shen.failed! V1915) false) ((and (cons? V1915) (and (= shen.the (hd V1915)) (and (cons? (tl V1915)) (and (= head (hd (tl V1915))) (and (cons? (tl (tl V1915))) (and (= shen.of (hd (tl (tl V1915)))) (and (cons? (tl (tl (tl V1915)))) (= () (tl (tl (tl (tl V1915)))))))))))) (cons hd (tl (tl (tl V1915))))) ((and (cons? V1915) (and (= shen.the (hd V1915)) (and (cons? (tl V1915)) (and (= tail (hd (tl V1915))) (and (cons? (tl (tl V1915))) (and (= shen.of (hd (tl (tl V1915)))) (and (cons? (tl (tl (tl V1915)))) (= () (tl (tl (tl (tl V1915)))))))))))) (cons tl (tl (tl (tl V1915))))) ((and (cons? V1915) (and (= shen.pop (hd V1915)) (and (cons? (tl V1915)) (and (= shen.the (hd (tl V1915))) (and (cons? (tl (tl V1915))) (and (= shen.stack (hd (tl (tl V1915)))) (= () (tl (tl (tl V1915)))))))))) (cons do (cons (cons shen.incinfs ()) (cons (cons thaw (cons Continuation ())) ())))) ((and (cons? V1915) (and (= call (hd V1915)) (and (cons? (tl V1915)) (and (= shen.the (hd (tl V1915))) (and (cons? (tl (tl V1915))) (and (= shen.continuation (hd (tl (tl V1915)))) (and (cons? (tl (tl (tl V1915)))) (= () (tl (tl (tl (tl V1915)))))))))))) (cons do (cons (cons shen.incinfs ()) (cons (shen.call_the_continuation (shen.chwild (hd (tl (tl (tl V1915))))) ProcessN Continuation) ())))) (true V1915))) (defun shen.chwild (V1917) (cond ((= V1917 _) (cons shen.newpv (cons ProcessN ()))) ((cons? V1917) (map (lambda Z (shen.chwild Z)) V1917)) (true V1917))) (defun shen.newpv (V1919) (let Count+1 (+ (<-address (value shen.*varcounter*) V1919) 1) (let IncVar (address-> (value shen.*varcounter*) V1919 Count+1) (let Vector (<-address (value shen.*prologvectors*) V1919) (let ResizeVectorIfNeeded (if (= Count+1 (limit Vector)) (shen.resizeprocessvector V1919 Count+1) shen.skip) (shen.mk-pvar Count+1)))))) (defun shen.resizeprocessvector (V1922 V1923) (let Vector (<-address (value shen.*prologvectors*) V1922) (let BigVector (shen.resize-vector Vector (+ V1923 V1923) shen.-null-) (address-> (value shen.*prologvectors*) V1922 BigVector)))) (defun shen.resize-vector (V1927 V1928 V1929) (let BigVector (address-> (absvector (+ 1 V1928)) 0 V1928) (shen.copy-vector V1927 BigVector (limit V1927) V1928 V1929))) (defun shen.copy-vector (V1935 V1936 V1937 V1938 V1939) (shen.copy-vector-stage-2 (+ 1 V1937) (+ V1938 1) V1939 (shen.copy-vector-stage-1 1 V1935 V1936 (+ 1 V1937)))) (defun shen.copy-vector-stage-1 (V1947 V1948 V1949 V1950) (cond ((= V1950 V1947) V1949) (true (shen.copy-vector-stage-1 (+ 1 V1947) V1948 (address-> V1949 V1947 (<-address V1948 V1947)) V1950)))) (defun shen.copy-vector-stage-2 (V1958 V1959 V1960 V1961) (cond ((= V1959 V1958) V1961) (true (shen.copy-vector-stage-2 (+ V1958 1) V1959 V1960 (address-> V1961 V1958 V1960))))) (defun shen.mk-pvar (V1963) (address-> (address-> (absvector 2) 0 shen.pvar) 1 V1963)) (defun shen.pvar? (V1965) (and (absvector? V1965) (= (trap-error (<-address V1965 0) (lambda E shen.not-pvar)) shen.pvar))) (defun shen.bindv (V1969 V1970 V1971) (let Vector (<-address (value shen.*prologvectors*) V1971) (address-> Vector (<-address V1969 1) V1970))) (defun shen.unbindv (V1974 V1975) (let Vector (<-address (value shen.*prologvectors*) V1975) (address-> Vector (<-address V1974 1) shen.-null-))) (defun shen.incinfs () (set shen.*infs* (+ 1 (value shen.*infs*)))) (defun shen.call_the_continuation (V1979 V1980 V1981) (cond ((and (cons? V1979) (and (cons? (hd V1979)) (= () (tl V1979)))) (cons (hd (hd V1979)) (append (tl (hd V1979)) (cons V1980 (cons V1981 ()))))) ((and (cons? V1979) (cons? (hd V1979))) (let NewContinuation (shen.newcontinuation (tl V1979) V1980 V1981) (cons (hd (hd V1979)) (append (tl (hd V1979)) (cons V1980 (cons NewContinuation ())))))) (true (shen.f_error shen.call_the_continuation)))) (defun shen.newcontinuation (V1985 V1986 V1987) (cond ((= () V1985) V1987) ((and (cons? V1985) (cons? (hd V1985))) (cons freeze (cons (cons (hd (hd V1985)) (append (tl (hd V1985)) (cons V1986 (cons (shen.newcontinuation (tl V1985) V1986 V1987) ())))) ()))) (true (shen.f_error shen.newcontinuation)))) (defun return (V1995 V1996 V1997) (shen.deref V1995 V1996)) (defun shen.measure&return (V2005 V2006 V2007) (do (shen.prhush (shen.app (value shen.*infs*) " inferences " shen.a) (stoutput)) (shen.deref V2005 V2006))) (defun unify (V2012 V2013 V2014 V2015) (shen.lzy= (shen.lazyderef V2012 V2014) (shen.lazyderef V2013 V2014) V2014 V2015)) (defun shen.lzy= (V2037 V2038 V2039 V2040) (cond ((= V2038 V2037) (thaw V2040)) ((shen.pvar? V2037) (bind V2037 V2038 V2039 V2040)) ((shen.pvar? V2038) (bind V2038 V2037 V2039 V2040)) ((and (cons? V2037) (cons? V2038)) (shen.lzy= (shen.lazyderef (hd V2037) V2039) (shen.lazyderef (hd V2038) V2039) V2039 (freeze (shen.lzy= (shen.lazyderef (tl V2037) V2039) (shen.lazyderef (tl V2038) V2039) V2039 V2040)))) (true false))) (defun shen.deref (V2043 V2044) (cond ((cons? V2043) (cons (shen.deref (hd V2043) V2044) (shen.deref (tl V2043) V2044))) (true (if (shen.pvar? V2043) (let Value (shen.valvector V2043 V2044) (if (= Value shen.-null-) V2043 (shen.deref Value V2044))) V2043)))) (defun shen.lazyderef (V2047 V2048) (if (shen.pvar? V2047) (let Value (shen.valvector V2047 V2048) (if (= Value shen.-null-) V2047 (shen.lazyderef Value V2048))) V2047)) (defun shen.valvector (V2051 V2052) (<-address (<-address (value shen.*prologvectors*) V2052) (<-address V2051 1))) (defun unify! (V2057 V2058 V2059 V2060) (shen.lzy=! (shen.lazyderef V2057 V2059) (shen.lazyderef V2058 V2059) V2059 V2060)) (defun shen.lzy=! (V2082 V2083 V2084 V2085) (cond ((= V2083 V2082) (thaw V2085)) ((and (shen.pvar? V2082) (not (shen.occurs? V2082 (shen.deref V2083 V2084)))) (bind V2082 V2083 V2084 V2085)) ((and (shen.pvar? V2083) (not (shen.occurs? V2083 (shen.deref V2082 V2084)))) (bind V2083 V2082 V2084 V2085)) ((and (cons? V2082) (cons? V2083)) (shen.lzy=! (shen.lazyderef (hd V2082) V2084) (shen.lazyderef (hd V2083) V2084) V2084 (freeze (shen.lzy=! (shen.lazyderef (tl V2082) V2084) (shen.lazyderef (tl V2083) V2084) V2084 V2085)))) (true false))) (defun shen.occurs? (V2097 V2098) (cond ((= V2098 V2097) true) ((cons? V2098) (or (shen.occurs? V2097 (hd V2098)) (shen.occurs? V2097 (tl V2098)))) (true false))) (defun identical (V2103 V2104 V2105 V2106) (shen.lzy== (shen.lazyderef V2103 V2105) (shen.lazyderef V2104 V2105) V2105 V2106)) (defun shen.lzy== (V2128 V2129 V2130 V2131) (cond ((= V2129 V2128) (thaw V2131)) ((and (cons? V2128) (cons? V2129)) (shen.lzy== (shen.lazyderef (hd V2128) V2130) (shen.lazyderef (hd V2129) V2130) V2130 (freeze (shen.lzy== (tl V2128) (tl V2129) V2130 V2131)))) (true false))) (defun shen.pvar (V2133) (cn "Var" (shen.app (<-address V2133 1) "" shen.a))) (defun bind (V2138 V2139 V2140 V2141) (do (shen.bindv V2138 V2139 V2140) (let Result (thaw V2141) (do (shen.unbindv V2138 V2140) Result)))) (defun fwhen (V2159 V2160 V2161) (cond ((= true V2159) (thaw V2161)) ((= false V2159) false) (true (simple-error (cn "fwhen expects a boolean: not " (shen.app V2159 "%" shen.s)))))) (defun call (V2177 V2178 V2179) (cond ((cons? V2177) (shen.call-help (function (shen.lazyderef (hd V2177) V2178)) (tl V2177) V2178 V2179)) ((shen.pvar? V2177) (call (shen.lazyderef V2177 V2178) V2178 V2179)) (true false))) (defun shen.call-help (V2184 V2185 V2186 V2187) (cond ((= () V2185) (V2184 V2186 V2187)) ((cons? V2185) (shen.call-help (V2184 (hd V2185)) (tl V2185) V2186 V2187)) (true (shen.f_error shen.call-help)))) (defun shen.intprolog (V2189) (cond ((and (cons? V2189) (cons? (hd V2189))) (let ProcessN (shen.start-new-prolog-process) (shen.intprolog-help (hd (hd V2189)) (shen.insert-prolog-variables (cons (tl (hd V2189)) (cons (tl V2189) ())) ProcessN) ProcessN))) (true (shen.f_error shen.intprolog)))) (defun shen.intprolog-help (V2193 V2194 V2195) (cond ((and (cons? V2194) (and (cons? (tl V2194)) (= () (tl (tl V2194))))) (shen.intprolog-help-help V2193 (hd V2194) (hd (tl V2194)) V2195)) (true (shen.f_error shen.intprolog-help)))) (defun shen.intprolog-help-help (V2200 V2201 V2202 V2203) (cond ((= () V2201) (V2200 V2203 (freeze (shen.call-rest V2202 V2203)))) ((cons? V2201) (shen.intprolog-help-help (V2200 (hd V2201)) (tl V2201) V2202 V2203)) (true (shen.f_error shen.intprolog-help-help)))) (defun shen.call-rest (V2208 V2209) (cond ((= () V2208) true) ((and (cons? V2208) (and (cons? (hd V2208)) (cons? (tl (hd V2208))))) (shen.call-rest (cons (cons ((hd (hd V2208)) (hd (tl (hd V2208)))) (tl (tl (hd V2208)))) (tl V2208)) V2209)) ((and (cons? V2208) (and (cons? (hd V2208)) (= () (tl (hd V2208))))) ((hd (hd V2208)) V2209 (freeze (shen.call-rest (tl V2208) V2209)))) (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 (V2212 V2213) (shen.insert-prolog-variables-help V2212 (shen.flatten V2212) V2213)) (defun shen.insert-prolog-variables-help (V2221 V2222 V2223) (cond ((= () V2222) V2221) ((and (cons? V2222) (variable? (hd V2222))) (let V (shen.newpv V2223) (let XV/Y (subst V (hd V2222) V2221) (let Z-Y (remove (hd V2222) (tl V2222)) (shen.insert-prolog-variables-help XV/Y Z-Y V2223))))) ((cons? V2222) (shen.insert-prolog-variables-help V2221 (tl V2222) V2223)) (true (shen.f_error shen.insert-prolog-variables-help)))) (defun shen.initialise-prolog (V2225) (let Vector (address-> (value shen.*prologvectors*) V2225 (shen.fillvector (vector 10) 1 10 shen.-null-)) (let Counter (address-> (value shen.*varcounter*) V2225 1) V2225)))