(defun cl.kl-to-lisp (V1046) (cl.kl-to-lisp-h () V1046))

(defun cl.kl-to-lisp-h (V1054 V1055) (cond ((= T (MEMBER V1055 V1054)) V1055) ((and (cons? V1055) (and (= type (hd V1055)) (and (cons? (tl V1055)) (and (cons? (tl (tl V1055))) (= () (tl (tl (tl V1055)))))))) (cl.kl-to-lisp-h V1054 (hd (tl V1055)))) ((and (cons? V1055) (and (= protect (hd V1055)) (and (cons? (tl V1055)) (= () (tl (tl V1055)))))) (cl.kl-to-lisp-h V1054 (hd (tl V1055)))) ((and (cons? V1055) (and (= lambda (hd V1055)) (and (cons? (tl V1055)) (and (cons? (tl (tl V1055))) (and (= () (tl (tl (tl V1055)))) (= (hd (tl V1055)) T)))))) (cl.kl-to-lisp-h V1054 (cl.rectify-t V1055))) ((and (cons? V1055) (and (= lambda (hd V1055)) (and (cons? (tl V1055)) (and (cons? (tl (tl V1055))) (= () (tl (tl (tl V1055)))))))) (cons FUNCTION (cons (cons LAMBDA (cons (cons (hd (tl V1055)) ()) (cons (cl.kl-to-lisp-h (cons (hd (tl V1055)) V1054) (hd (tl (tl V1055)))) ()))) ()))) ((and (cons? V1055) (and (= let (hd V1055)) (and (cons? (tl V1055)) (and (cons? (tl (tl V1055))) (and (cons? (tl (tl (tl V1055)))) (and (= () (tl (tl (tl (tl V1055))))) (= (hd (tl V1055)) T))))))) (cl.kl-to-lisp-h V1054 (cl.rectify-t V1055))) ((and (cons? V1055) (and (= let (hd V1055)) (and (cons? (tl V1055)) (and (cons? (tl (tl V1055))) (and (cons? (tl (tl (tl V1055)))) (= () (tl (tl (tl (tl V1055)))))))))) (cons LET (cons (cons (cons (hd (tl V1055)) (cons (cl.kl-to-lisp-h V1054 (hd (tl (tl V1055)))) ())) ()) (cons (cl.kl-to-lisp-h (cons (hd (tl V1055)) V1054) (hd (tl (tl (tl V1055))))) ())))) ((and (cons? V1055) (and (= defun (hd V1055)) (and (cons? (tl V1055)) (and (cons? (tl (tl V1055))) (and (cons? (tl (tl (tl V1055)))) (= () (tl (tl (tl (tl V1055)))))))))) (cons DEFUN (cons (hd (tl V1055)) (cons (hd (tl (tl V1055))) (cons (cl.kl-to-lisp-h (hd (tl (tl V1055))) (hd (tl (tl (tl V1055))))) ()))))) ((and (cons? V1055) (= cond (hd V1055))) (cons COND (CL.MAPCAR (lambda C (cl.cond-code V1054 C)) (tl V1055)))) ((and (cons? V1055) (or (= T (MEMBER (hd V1055) V1054)) (cons? (hd V1055)))) (let Lisp (CL.MAPCAR (lambda Y (cl.kl-to-lisp-h V1054 Y)) V1055) (cl.currylisp Lisp))) ((and (cons? V1055) (cl.fastsymbol? (hd V1055))) (let LispX (CL.MAPCAR (lambda Y (cl.kl-to-lisp-h V1054 Y)) (tl V1055)) (let LispF (cl.maplispsym (hd V1055)) (cl.optimise-application (cons LispF LispX))))) ((or (number? V1055) (or (string? V1055) (empty? V1055))) V1055) (true (cons QUOTE (cons V1055 ())))))

(defun cl.rectify-t (V1056) (SUBST (GENSYM "x") T V1056))

(defun cl.currylisp (V1057) (cond ((and (cons? V1057) (and (cons? (tl V1057)) (cons? (tl (tl V1057))))) (cl.currylisp (cons (cons FUNCALL (cons (hd V1057) (cons (hd (tl V1057)) ()))) (tl (tl V1057))))) ((and (cons? V1057) (and (cons? (tl V1057)) (= () (tl (tl V1057))))) (cons FUNCALL V1057)) ((and (cons? V1057) (= () (tl V1057))) (cons FUNCALL V1057)) (true V1057)))

(defun cl.optimise-application (V1058) (cond ((and (cons? V1058) (and (= protect (hd V1058)) (and (cons? (tl V1058)) (= () (tl (tl V1058)))))) (cl.optimise-application (hd (tl V1058)))) ((and (cons? V1058) (and (= hd (hd V1058)) (and (cons? (tl V1058)) (= () (tl (tl V1058)))))) (cons CAR (cons (cl.optimise-application (hd (tl V1058))) ()))) ((and (cons? V1058) (and (= tl (hd V1058)) (and (cons? (tl V1058)) (= () (tl (tl V1058)))))) (cons CDR (cons (cl.optimise-application (hd (tl V1058))) ()))) ((and (cons? V1058) (and (= cons (hd V1058)) (and (cons? (tl V1058)) (and (cons? (tl (tl V1058))) (= () (tl (tl (tl V1058)))))))) (cons CONS (cons (cl.optimise-application (hd (tl V1058))) (cons (cl.optimise-application (hd (tl (tl V1058)))) ())))) ((and (cons? V1058) (and (= append (hd V1058)) (and (cons? (tl V1058)) (and (cons? (tl (tl V1058))) (= () (tl (tl (tl V1058)))))))) (cons APPEND (cons (cl.optimise-application (hd (tl V1058))) (cons (cl.optimise-application (hd (tl (tl V1058)))) ())))) ((and (cons? V1058) (and (= reverse (hd V1058)) (and (cons? (tl V1058)) (= () (tl (tl V1058)))))) (cons REVERSE (cons (cl.optimise-application (hd (tl V1058))) ()))) ((and (cons? V1058) (and (= length (hd V1058)) (and (cons? (tl V1058)) (= () (tl (tl V1058)))))) (cons CL.LIST-LENGTH (cons (cl.optimise-application (hd (tl V1058))) ()))) ((and (cons? V1058) (and (= if (hd V1058)) (and (cons? (tl V1058)) (and (cons? (tl (tl V1058))) (and (cons? (tl (tl (tl V1058)))) (= () (tl (tl (tl (tl V1058)))))))))) (cons IF (cons (cl.wrap (hd (tl V1058))) (cons (cl.optimise-application (hd (tl (tl V1058)))) (cons (cl.optimise-application (hd (tl (tl (tl V1058))))) ()))))) ((and (cons? V1058) (and (= value (hd V1058)) (and (cons? (tl V1058)) (and (cons? (hd (tl V1058))) (and (cons? (tl (hd (tl V1058)))) (and (= () (tl (tl (hd (tl V1058))))) (and (= () (tl (tl V1058))) (= (hd (hd (tl V1058))) QUOTE)))))))) (hd (tl (hd (tl V1058))))) ((and (cons? V1058) (and (= map (hd V1058)) (and (cons? (tl V1058)) (and (cons? (tl (tl V1058))) (= () (tl (tl (tl V1058)))))))) (cons CL.MAPCAR (tl V1058))) ((and (cons? V1058) (and (= + (hd V1058)) (and (cons? (tl V1058)) (and (= 1 (hd (tl V1058))) (and (cons? (tl (tl V1058))) (= () (tl (tl (tl V1058))))))))) (cons (intern "1+") (cons (cl.optimise-application (hd (tl (tl V1058)))) ()))) ((and (cons? V1058) (and (= + (hd V1058)) (and (cons? (tl V1058)) (and (cons? (tl (tl V1058))) (and (= 1 (hd (tl (tl V1058)))) (= () (tl (tl (tl V1058))))))))) (cons (intern "1+") (cons (cl.optimise-application (hd (tl V1058))) ()))) ((and (cons? V1058) (and (= - (hd V1058)) (and (cons? (tl V1058)) (and (cons? (tl (tl V1058))) (and (= 1 (hd (tl (tl V1058)))) (= () (tl (tl (tl V1058))))))))) (cons (intern "1-") (cons (cl.optimise-application (hd (tl V1058))) ()))) ((cons? V1058) (CL.MAPCAR (lambda Z (cl.optimise-application Z)) V1058)) (true V1058)))

(defun cl.cond-code (V1063 V1064) (cond ((and (cons? V1064) (and (cons? (tl V1064)) (= () (tl (tl V1064))))) (let LispTest (cl.wrap (cl.kl-to-lisp-h V1063 (hd V1064))) (let LispResult (cl.kl-to-lisp-h V1063 (hd (tl V1064))) (cons LispTest (cons LispResult ()))))) (true (simple-error "implementation error in shen.cond-code"))))

(defun cl.wrap (V1065) (cond ((and (cons? V1065) (and (cons? (tl V1065)) (and (= true (hd (tl V1065))) (and (= () (tl (tl V1065))) (= (hd V1065) QUOTE))))) T) ((and (cons? V1065) (and (= cons? (hd V1065)) (and (cons? (tl V1065)) (= () (tl (tl V1065)))))) (cons CONSP (tl V1065))) ((and (cons? V1065) (and (= string? (hd V1065)) (and (cons? (tl V1065)) (= () (tl (tl V1065)))))) (cons STRINGP (tl V1065))) ((and (cons? V1065) (and (= number? (hd V1065)) (and (cons? (tl V1065)) (= () (tl (tl V1065)))))) (cons NUMBERP (tl V1065))) ((and (cons? V1065) (and (= empty? (hd V1065)) (and (cons? (tl V1065)) (= () (tl (tl V1065)))))) (cons NULL (tl V1065))) ((and (cons? V1065) (and (= and (hd V1065)) (and (cons? (tl V1065)) (and (cons? (tl (tl V1065))) (= () (tl (tl (tl V1065)))))))) (cons AND (cons (cl.wrap (hd (tl V1065))) (cons (cl.wrap (hd (tl (tl V1065)))) ())))) ((and (cons? V1065) (and (= or (hd V1065)) (and (cons? (tl V1065)) (and (cons? (tl (tl V1065))) (= () (tl (tl (tl V1065)))))))) (cons OR (cons (cl.wrap (hd (tl V1065))) (cons (cl.wrap (hd (tl (tl V1065)))) ())))) ((and (cons? V1065) (and (= not (hd V1065)) (and (cons? (tl V1065)) (= () (tl (tl V1065)))))) (cons NOT (cons (cl.wrap (hd (tl V1065))) ()))) ((and (cons? V1065) (and (= cl.equal? (hd V1065)) (and (cons? (tl V1065)) (and (cons? (tl (tl V1065))) (and (= () (hd (tl (tl V1065)))) (= () (tl (tl (tl V1065))))))))) (cons NULL (cons (hd (tl V1065)) ()))) ((and (cons? V1065) (and (= cl.equal? (hd V1065)) (and (cons? (tl V1065)) (and (= () (hd (tl V1065))) (and (cons? (tl (tl V1065))) (= () (tl (tl (tl V1065))))))))) (cons NULL (tl (tl V1065)))) ((and (cons? V1065) (and (= cl.equal? (hd V1065)) (and (cons? (tl V1065)) (and (cons? (tl (tl V1065))) (and (cons? (hd (tl (tl V1065)))) (and (cons? (tl (hd (tl (tl V1065))))) (and (= () (tl (tl (hd (tl (tl V1065)))))) (and (= () (tl (tl (tl V1065)))) (and (= (hd (hd (tl (tl V1065)))) QUOTE) (cl.fastsymbol? (hd (tl (hd (tl (tl V1065))))))))))))))) (cons EQ (tl V1065))) ((and (cons? V1065) (and (= cl.equal? (hd V1065)) (and (cons? (tl V1065)) (and (cons? (hd (tl V1065))) (and (cons? (tl (hd (tl V1065)))) (and (= () (tl (tl (hd (tl V1065))))) (and (cons? (tl (tl V1065))) (and (= () (tl (tl (tl V1065)))) (and (= (hd (hd (tl V1065))) QUOTE) (cl.fastsymbol? (hd (tl (hd (tl V1065)))))))))))))) (cons EQ (tl V1065))) ((and (cons? V1065) (and (= cl.equal? (hd V1065)) (and (cons? (tl V1065)) (and (cons? (hd (tl V1065))) (and (= fail (hd (hd (tl V1065)))) (and (= () (tl (hd (tl V1065)))) (and (cons? (tl (tl V1065))) (= () (tl (tl (tl V1065))))))))))) (cons EQ (tl V1065))) ((and (cons? V1065) (and (= cl.equal? (hd V1065)) (and (cons? (tl V1065)) (and (cons? (tl (tl V1065))) (and (cons? (hd (tl (tl V1065)))) (and (= fail (hd (hd (tl (tl V1065))))) (and (= () (tl (hd (tl (tl V1065))))) (= () (tl (tl (tl V1065))))))))))) (cons EQ (tl V1065))) ((and (cons? V1065) (and (= cl.equal? (hd V1065)) (and (cons? (tl V1065)) (and (cons? (tl (tl V1065))) (and (= () (tl (tl (tl V1065)))) (string? (hd (tl V1065)))))))) (cons EQUAL (tl V1065))) ((and (cons? V1065) (and (= cl.equal? (hd V1065)) (and (cons? (tl V1065)) (and (cons? (tl (tl V1065))) (and (= () (tl (tl (tl V1065)))) (string? (hd (tl (tl V1065))))))))) (cons EQUAL (tl V1065))) ((and (cons? V1065) (and (= cl.equal? (hd V1065)) (and (cons? (tl V1065)) (and (cons? (tl (tl V1065))) (and (= () (tl (tl (tl V1065)))) (number? (hd (tl V1065)))))))) (cons EQL (tl V1065))) ((and (cons? V1065) (and (= cl.equal? (hd V1065)) (and (cons? (tl V1065)) (and (cons? (tl (tl V1065))) (and (= () (tl (tl (tl V1065)))) (number? (hd (tl (tl V1065))))))))) (cons EQL (tl V1065))) ((and (cons? V1065) (and (= cl.equal? (hd V1065)) (and (cons? (tl V1065)) (and (cons? (tl (tl V1065))) (= () (tl (tl (tl V1065)))))))) (cons shen.ABSEQUAL (tl V1065))) ... etc))

(defun cl.fastsymbol? (V1072) (cond ((cons? V1072) false) ((= () V1072) false) ((string? V1072) false) ((number? V1072) false) (true true)))

(defun cl.wrapper (V1073) (cond ((= true V1073) T) ((= false V1073) ()) (true (simple-error "boolean expected"))))

(defun cl.maplispsym (V1074) (cond ((= = V1074) cl.equal?) ((= > V1074) cl.greater?) ((= < V1074) cl.less?) ((= >= V1074) cl.greater-than-or-equal-to?) ((= <= V1074) cl.less-than-or-equal-to?) ((= + V1074) cl.add) ((= - V1074) cl.subtract) ((= / V1074) cl.divide) ((= * V1074) cl.multiply) (true V1074)))

(defun shen.shen->kl (V1448) (let KL (shen.shen->kl-h V1448) (shen.record-and-evaluate KL)))

(defun shen.record-and-evaluate (V1449) (cond ((and (cons? V1449) (and (= defun (hd V1449)) (and (cons? (tl V1449)) (and (cons? (tl (tl V1449))) (and (cons? (tl (tl (tl V1449)))) (= () (tl (tl (tl (tl V1449)))))))))) (let SysfuncChk (if (shen.sysfunc? (hd (tl V1449))) (simple-error (shen.app (hd (tl V1449)) " is not a legitimate function name
" shen.a)) shen.skip) (let Arity (shen.store-arity (hd (tl V1449)) (length (hd (tl (tl V1449))))) (let Record (shen.record-kl (hd (tl V1449)) V1449) (let Eval (eval-kl V1449) (shen.fn-print (hd (tl V1449)))))))) (true V1449)))

(defun shen.shen->kl-h (V1450) (cond ((and (cons? V1450) (and (= define (hd V1450)) (cons? (tl V1450)))) (shen.shendef->kldef (hd (tl V1450)) (tl (tl V1450)))) ((and (cons? V1450) (and (= defun (hd V1450)) (and (cons? (tl V1450)) (and (cons? (tl (tl V1450))) (and (cons? (tl (tl (tl V1450)))) (= () (tl (tl (tl (tl V1450)))))))))) V1450) ((and (cons? V1450) (and (= type (hd V1450)) (and (cons? (tl V1450)) (and (cons? (tl (tl V1450))) (= () (tl (tl (tl V1450)))))))) (cons type (cons (hd (tl V1450)) (cons (shen.rcons_form (hd (tl (tl V1450)))) ())))) ((and (cons? V1450) (and (= input+ (hd V1450)) (and (cons? (tl V1450)) (and (cons? (tl (tl V1450))) (= () (tl (tl (tl V1450)))))))) (cons input+ (cons (shen.rcons_form (hd (tl V1450))) (tl (tl V1450))))) ((cons? V1450) (map (lambda Z (shen.shen->kl-h Z)) V1450)) (true V1450)))

(defun shen.shendef->kldef (V1451 V1452) (compile (lambda X (shen.<define> X)) (cons V1451 V1452)))

(defun shen.<define> (V1453) (let Result (let Parseshen.<name> (shen.<name> V1453) (if (shen.parse-failure? Parseshen.<name>) (shen.parse-failure) (if (shen.=hd? Parseshen.<name> {) (let News1313 (shen.tls Parseshen.<name>) (let Parseshen.<signature> (shen.<signature> News1313) (if (shen.parse-failure? Parseshen.<signature>) (shen.parse-failure) (if (shen.=hd? Parseshen.<signature> }) (let News1314 (shen.tls Parseshen.<signature>) (let Parseshen.<rules> (shen.<rules> News1314) (if (shen.parse-failure? Parseshen.<rules>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<rules>) (shen.shendef->kldef-h (shen.<-out Parseshen.<name>) (shen.<-out Parseshen.<rules>)))))) (shen.parse-failure))))) (shen.parse-failure)))) (if (shen.parse-failure? Result) (let Result (let Parseshen.<name> (shen.<name> V1453) (if (shen.parse-failure? Parseshen.<name>) (shen.parse-failure) (let Parseshen.<rules> (shen.<rules> Parseshen.<name>) (if (shen.parse-failure? Parseshen.<rules>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<rules>) (shen.shendef->kldef-h (shen.<-out Parseshen.<name>) (shen.<-out Parseshen.<rules>))))))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)) Result)))

(defun shen.shendef->kldef-h (V1454 V1455) (let Ps (map (lambda X (fst X)) V1455) (let Arity (shen.arity-chk V1454 Ps) (let FreeVarChk (map (lambda R (shen.free-var-chk V1454 R)) V1455) (let Unprotect (shen.unprotect V1455) (let KL (shen.factorise-code (shen.compile-to-kl V1454 Unprotect Arity)) KL))))))

(defun shen.unprotect (V1456) (cond ((tuple? V1456) (@p (shen.unprotect (fst V1456)) (shen.unprotect (snd V1456)))) ((and (cons? V1456) (and (= protect (hd V1456)) (and (cons? (tl V1456)) (= () (tl (tl V1456)))))) (shen.unprotect (hd (tl V1456)))) ((cons? V1456) (map (lambda Z (shen.unprotect Z)) V1456)) (true V1456)))

(defun shen.<name> (V1457) (let Result (if (shen.non-empty-stream? V1457) (let X (shen.hds V1457) (let News1316 (shen.tls V1457) (shen.comb (shen.in-> News1316) (if (and (symbol? X) (not (variable? X))) X (simple-error (shen.app X " is not a legitimate function name.
" shen.a)))))) (shen.parse-failure)) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.<signature> (V1458) (let Result (if (shen.non-empty-stream? V1458) (let X (shen.hds V1458) (let News1318 (shen.tls V1458) (let Parseshen.<signature> (shen.<signature> News1318) (if (shen.parse-failure? Parseshen.<signature>) (shen.parse-failure) (if (not (element? X (cons { (cons } ())))) (shen.comb (shen.in-> Parseshen.<signature>) (cons X (shen.<-out Parseshen.<signature>))) (shen.parse-failure)))))) (shen.parse-failure)) (if (shen.parse-failure? Result) (let Result (let Parse<e> (<e> V1458) (if (shen.parse-failure? Parse<e>) (shen.parse-failure) (shen.comb (shen.in-> Parse<e>) ()))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)) Result)))

(defun shen.<rules> (V1459) (let Result (let Parseshen.<rule> (shen.<rule> V1459) (if (shen.parse-failure? Parseshen.<rule>) (shen.parse-failure) (let Parseshen.<rules> (shen.<rules> Parseshen.<rule>) (if (shen.parse-failure? Parseshen.<rules>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<rules>) (cons (shen.linearise (shen.<-out Parseshen.<rule>)) (shen.<-out Parseshen.<rules>))))))) (if (shen.parse-failure? Result) (let Result (let Parse<!> (<!> V1459) (if (shen.parse-failure? Parse<!>) (shen.parse-failure) (shen.comb (shen.in-> Parse<!>) (if (empty? (shen.<-out Parse<!>)) () (simple-error (cn "Shen syntax error here:
 " (shen.app (shen.<-out Parse<!>) "
 ..." shen.r))))))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)) Result)))

(defun shen.linearise (V1462) (cond ((tuple? V1462) (shen.linearise-h (fst V1462) (fst V1462) () (snd V1462))) (true (simple-error "implementation error in shen.linearise"))))

(defun shen.linearise-h (V1475 V1476 V1477 V1478) (cond ((= () V1475) (@p V1476 V1478)) ((and (cons? V1475) (cons? (hd V1475))) (shen.linearise-h (append (hd V1475) (tl V1475)) V1476 V1477 V1478)) ((and (cons? V1475) (variable? (hd V1475))) (if (element? (hd V1475) V1477) (let Z (gensym (protect V)) (shen.linearise-h (tl V1475) (shen.rep-X (hd V1475) Z V1476) V1477 (cons where (cons (cons = (cons Z (cons (hd V1475) ()))) (cons V1478 ()))))) (shen.linearise-h (tl V1475) V1476 (cons (hd V1475) V1477) V1478))) ((cons? V1475) (shen.linearise-h (tl V1475) V1476 V1477 V1478)) (true (simple-error "implementation error in shen.linearise-h"))))

(defun shen.<rule> (V1479) (let Result (let Parseshen.<patterns> (shen.<patterns> V1479) (if (shen.parse-failure? Parseshen.<patterns>) (shen.parse-failure) (if (shen.=hd? Parseshen.<patterns> ->) (let News1321 (shen.tls Parseshen.<patterns>) (if (shen.non-empty-stream? News1321) (let Action (shen.hds News1321) (let News1322 (shen.tls News1321) (if (shen.=hd? News1322 where) (let News1323 (shen.tls News1322) (if (shen.non-empty-stream? News1323) (let Guard (shen.hds News1323) (let News1324 (shen.tls News1323) (shen.comb (shen.in-> News1324) (@p (shen.<-out Parseshen.<patterns>) (cons where (cons Guard (cons Action ()))))))) (shen.parse-failure))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)))) (if (shen.parse-failure? Result) (let Result (let Parseshen.<patterns> (shen.<patterns> V1479) (if (shen.parse-failure? Parseshen.<patterns>) (shen.parse-failure) (if (shen.=hd? Parseshen.<patterns> ->) (let News1325 (shen.tls Parseshen.<patterns>) (if (shen.non-empty-stream? News1325) (let Action (shen.hds News1325) (let News1326 (shen.tls News1325) (shen.comb (shen.in-> News1326) (@p (shen.<-out Parseshen.<patterns>) Action)))) (shen.parse-failure))) (shen.parse-failure)))) (if (shen.parse-failure? Result) (let Result (let Parseshen.<patterns> (shen.<patterns> V1479) (if (shen.parse-failure? Parseshen.<patterns>) (shen.parse-failure) (if (shen.=hd? Parseshen.<patterns> <-) (let News1327 (shen.tls Parseshen.<patterns>) (if (shen.non-empty-stream? News1327) (let Action (shen.hds News1327) (let News1328 (shen.tls News1327) (if (shen.=hd? News1328 where) (let News1329 (shen.tls News1328) (if (shen.non-empty-stream? News1329) (let Guard (shen.hds News1329) (let News1330 (shen.tls News1329) (shen.comb (shen.in-> News1330) (@p (shen.<-out Parseshen.<patterns>) (cons where (cons Guard (cons (cons shen.choicepoint! (cons Action ())) ()))))))) (shen.parse-failure))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)))) (if (shen.parse-failure? Result) (let Result (let Parseshen.<patterns> (shen.<patterns> V1479) (if (shen.parse-failure? Parseshen.<patterns>) (shen.parse-failure) (if (shen.=hd? Parseshen.<patterns> <-) (let News1331 (shen.tls Parseshen.<patterns>) (if (shen.non-empty-stream? News1331) (let Action (shen.hds News1331) (let News1332 (shen.tls News1331) (shen.comb (shen.in-> News1332) (@p (shen.<-out Parseshen.<patterns>) (cons shen.choicepoint! (cons Action ())))))) (shen.parse-failure))) (shen.parse-failure)))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)) Result)) Result)) Result)))

(defun shen.<patterns> (V1480) (let Result (let Parseshen.<pattern> (shen.<pattern> V1480) (if (shen.parse-failure? Parseshen.<pattern>) (shen.parse-failure) (let Parseshen.<patterns> (shen.<patterns> Parseshen.<pattern>) (if (shen.parse-failure? Parseshen.<patterns>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<patterns>) (cons (shen.<-out Parseshen.<pattern>) (shen.<-out Parseshen.<patterns>))))))) (if (shen.parse-failure? Result) (let Result (let Parse<e> (<e> V1480) (if (shen.parse-failure? Parse<e>) (shen.parse-failure) (shen.comb (shen.in-> Parse<e>) ()))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)) Result)))

(defun shen.<pattern> (V1481) (let Result (if (shen.ccons? V1481) (let SynCons (shen.comb (shen.hds V1481) (shen.<-out V1481)) (let Parseshen.<constructor> (shen.<constructor> SynCons) (if (shen.parse-failure? Parseshen.<constructor>) (shen.parse-failure) (let Parseshen.<pattern1> (shen.<pattern1> Parseshen.<constructor>) (if (shen.parse-failure? Parseshen.<pattern1>) (shen.parse-failure) (let Parseshen.<pattern2> (shen.<pattern2> Parseshen.<pattern1>) (if (shen.parse-failure? Parseshen.<pattern2>) (shen.parse-failure) (let Parseshen.<end> (shen.<end> Parseshen.<pattern2>) (if (shen.parse-failure? Parseshen.<end>) (shen.parse-failure) (shen.comb (shen.in-> (shen.tlstream V1481)) (cons (shen.<-out Parseshen.<constructor>) (cons (shen.<-out Parseshen.<pattern1>) (cons (shen.<-out Parseshen.<pattern2>) ()))))))))))))) (shen.parse-failure)) (if (shen.parse-failure? Result) (let Result (if (shen.ccons? V1481) (let SynCons (shen.comb (shen.hds V1481) (shen.<-out V1481)) (if (shen.=hd? SynCons vector) (let News1335 (shen.tls SynCons) (if (shen.=hd? News1335 0) (let News1336 (shen.tls News1335) (let Parseshen.<end> (shen.<end> News1336) (if (shen.parse-failure? Parseshen.<end>) (shen.parse-failure) (shen.comb (shen.in-> (shen.tlstream V1481)) (cons vector (cons 0 ())))))) (shen.parse-failure))) (shen.parse-failure))) (shen.parse-failure)) (if (shen.parse-failure? Result) (let Result (if (shen.non-empty-stream? V1481) (let X (shen.hds V1481) (let News1337 (shen.tls V1481) (if (cons? X) (shen.comb (shen.in-> News1337) (shen.constructor-error X)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? Result) (let Result (let Parseshen.<simple-pattern> (shen.<simple-pattern> V1481) (if (shen.parse-failure? Parseshen.<simple-pattern>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<simple-pattern>) (shen.<-out Parseshen.<simple-pattern>)))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)) Result)) Result)) Result)))

(defun shen.<constructor> (V1482) (let Result (if (shen.non-empty-stream? V1482) (let C (shen.hds V1482) (let News1339 (shen.tls V1482) (if (shen.constructor? C) (shen.comb (shen.in-> News1339) C) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.constructor? (V1483) (element? V1483 (cons cons (cons @p (cons @s (cons @v ()))))))

(defun shen.constructor-error (V1484) (simple-error (shen.app V1484 " is not a legitimate constructor
" shen.r)))

(defun shen.<simple-pattern> (V1485) (let Result (if (shen.non-empty-stream? V1485) (let X (shen.hds V1485) (let News1341 (shen.tls V1485) (if (= X _) (shen.comb (shen.in-> News1341) (gensym (protect Y))) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? Result) (let Result (if (shen.non-empty-stream? V1485) (let X (shen.hds V1485) (let News1342 (shen.tls V1485) (if (not (element? X (cons -> (cons <- ())))) (shen.comb (shen.in-> News1342) X) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? Result) (shen.parse-failure) Result)) Result)))

(defun shen.<pattern1> (V1486) (let Result (let Parseshen.<pattern> (shen.<pattern> V1486) (if (shen.parse-failure? Parseshen.<pattern>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<pattern>) (shen.<-out Parseshen.<pattern>)))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.<pattern2> (V1487) (let Result (let Parseshen.<pattern> (shen.<pattern> V1487) (if (shen.parse-failure? Parseshen.<pattern>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<pattern>) (shen.<-out Parseshen.<pattern>)))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.fn-print (V1488) (let V (absvector 2) (let Print (address-> V 0 shen.printF) (let Named (address-> Print 1 (@s "(" (@s "f" (@s "n" (@s " " (@s (str V1488) ")")))))) Named))))

(defun shen.printF (V1489) (<-address V1489 1))

(defun shen.arity-chk (V1494 V1495) (cond ((and (cons? V1495) (= () (tl V1495))) (length (hd V1495))) ((and (cons? V1495) (and (cons? (tl V1495)) (= (length (hd V1495)) (length (hd (tl V1495)))))) (shen.arity-chk V1494 (tl V1495))) (true (simple-error (cn "arity error in " (shen.app V1494 "
" shen.a))))))

(defun shen.free-var-chk (V1496 V1497) (cond ((tuple? V1497) (shen.free-variable-error-message V1496 (shen.find-free-vars (shen.extract-vars (fst V1497)) (snd V1497)))) (true (shen.f-error shen.free-var-chk))))

(defun shen.free-variable-error-message (V1498 V1499) (if (empty? V1499) shen.skip (do (pr (cn "free variables in " (shen.app V1498 ":" shen.a)) (stoutput)) (do (map (lambda X (pr (cn " " (shen.app X "" shen.a)) (stoutput))) V1499) (do (nl 1) (abort))))))

(defun shen.extract-vars (V1502) (cond ((variable? V1502) (cons V1502 ())) ((cons? V1502) (union (shen.extract-vars (hd V1502)) (shen.extract-vars (tl V1502)))) (true ())))

(defun shen.find-free-vars (V1507 V1508) (cond ((and (cons? V1508) (and (= protect (hd V1508)) (and (cons? (tl V1508)) (= () (tl (tl V1508)))))) ()) ((and (cons? V1508) (and (= let (hd V1508)) (and (cons? (tl V1508)) (and (cons? (tl (tl V1508))) (and (cons? (tl (tl (tl V1508)))) (= () (tl (tl (tl (tl V1508)))))))))) (union (shen.find-free-vars V1507 (hd (tl (tl V1508)))) (shen.find-free-vars (cons (hd (tl V1508)) V1507) (hd (tl (tl (tl V1508))))))) ((and (cons? V1508) (and (= lambda (hd V1508)) (and (cons? (tl V1508)) (and (cons? (tl (tl V1508))) (= () (tl (tl (tl V1508)))))))) (shen.find-free-vars (cons (hd (tl V1508)) V1507) (hd (tl (tl V1508))))) ((cons? V1508) (union (shen.find-free-vars V1507 (hd V1508)) (shen.find-free-vars V1507 (tl V1508)))) ((shen.free-variable? V1508 V1507) (cons V1508 ())) (true ())))

(defun shen.free-variable? (V1509 V1510) (and (variable? V1509) (not (element? V1509 V1510))))

(defun shen.record-kl (V1511 V1512) (put V1511 shen.source V1512 (value *property-vector*)))

(defun shen.compile-to-kl (V1513 V1514 V1515) (let Parameters (shen.parameters V1515) (let Body (shen.scan-body V1513 (shen.kl-body V1514 Parameters)) (let Defun (cons defun (cons V1513 (cons Parameters (cons (shen.cond-form Body) ())))) Defun))))

(defun shen.parameters (V1516) (cond ((= 0 V1516) ()) (true (cons (gensym (protect V)) (shen.parameters (- V1516 1))))))

(defun shen.cond-form (V1519) (cond ((and (cons? V1519) (and (cons? (hd V1519)) (and (= true (hd (hd V1519))) (and (cons? (tl (hd V1519))) (= () (tl (tl (hd V1519)))))))) (hd (tl (hd V1519)))) (true (cons cond V1519))))

(defun shen.scan-body (V1528 V1529) (cond ((= () V1529) (cons (cons true (cons (cons shen.f-error (cons V1528 ())) ())) ())) ((and (cons? V1529) (shen.choicepoint? (hd V1529))) (shen.choicepoint V1528 (gensym (protect Freeze)) (gensym (protect Result)) (hd V1529) (tl V1529))) ((and (cons? V1529) (and (cons? (hd V1529)) (and (= true (hd (hd V1529))) (and (cons? (tl (hd V1529))) (= () (tl (tl (hd V1529)))))))) (cons (hd V1529) ())) ((cons? V1529) (cons (hd V1529) (shen.scan-body V1528 (tl V1529)))) (true (simple-error "implementation error in shen.scan-body"))))

(defun shen.choicepoint? (V1536) (cond ((and (cons? V1536) (and (cons? (tl V1536)) (and (cons? (hd (tl V1536))) (and (= shen.choicepoint! (hd (hd (tl V1536)))) (and (cons? (tl (hd (tl V1536)))) (and (= () (tl (tl (hd (tl V1536))))) (= () (tl (tl V1536))))))))) true) (true false)))

(defun shen.choicepoint (V1552 V1553 V1554 V1555 V1556) (cond ((and (cons? V1555) (and (cons? (tl V1555)) (and (cons? (hd (tl V1555))) (and (cons? (tl (hd (tl V1555)))) (and (cons? (hd (tl (hd (tl V1555))))) (and (= fail-if (hd (hd (tl (hd (tl V1555)))))) (and (cons? (tl (hd (tl (hd (tl V1555)))))) (and (cons? (tl (tl (hd (tl (hd (tl V1555))))))) (and (= () (tl (tl (tl (hd (tl (hd (tl V1555)))))))) (and (= () (tl (tl (hd (tl V1555))))) (and (= () (tl (tl V1555))) (= V1552 (hd (tl (hd (tl (hd (tl V1555)))))))))))))))))) (cons (cons true (cons (cons let (cons V1553 (cons (cons freeze (cons (cons cond (shen.scan-body (hd (tl (hd (tl (hd (tl V1555)))))) V1556)) ())) (cons (cons if (cons (hd V1555) (cons (cons let (cons V1554 (cons (hd (tl (tl (hd (tl (hd (tl V1555))))))) (cons (cons if (cons (cons (hd (tl (hd (tl (hd (tl V1555)))))) (cons V1554 ())) (cons (cons thaw (cons V1553 ())) (cons V1554 ())))) ())))) (cons (cons thaw (cons V1553 ())) ())))) ())))) ())) ())) ((and (cons? V1555) (and (cons? (tl V1555)) (and (cons? (hd (tl V1555))) (and (cons? (tl (hd (tl V1555)))) (and (= () (tl (tl (hd (tl V1555))))) (= () (tl (tl V1555)))))))) (cons (cons true (cons (cons let (cons V1553 (cons (cons freeze (cons (cons cond (shen.scan-body V1552 V1556)) ())) (cons (cons if (cons (hd V1555) (cons (cons let (cons V1554 (cons (hd (tl (hd (tl V1555)))) (cons (cons if (cons (cons = (cons V1554 (cons (cons fail ()) ()))) (cons (cons thaw (cons V1553 ())) (cons V1554 ())))) ())))) (cons (cons thaw (cons V1553 ())) ())))) ())))) ())) ())) (true (simple-error "implementation error in shen.choicepoint"))))

(defun shen.rep-X (V1558 V1559 V1560) (cond ((= V1558 V1560) V1559) ((cons? V1560) (let Rep (shen.rep-X V1558 V1559 (hd V1560)) (if (= Rep (hd V1560)) (cons (hd V1560) (shen.rep-X V1558 V1559 (tl V1560))) (cons Rep (tl V1560))))) (true V1560)))

(defun shen.kl-body (V1561 V1562) (map (lambda R (shen.triple-stack () (fst R) V1562 (snd R))) V1561))

(defun shen.triple-stack (V1571 V1572 V1573 V1574) (cond ((and (= () V1572) (and (= () V1573) (and (cons? V1574) (and (= where (hd V1574)) (and (cons? (tl V1574)) (and (cons? (tl (tl V1574))) (= () (tl (tl (tl V1574)))))))))) (shen.triple-stack (cons (hd (tl V1574)) V1571) () () (hd (tl (tl V1574))))) ((and (= () V1572) (= () V1573)) (cons (shen.rectify-test (reverse V1571)) (cons V1574 ()))) ((and (cons? V1572) (and (cons? V1573) (variable? (hd V1572)))) (shen.triple-stack V1571 (tl V1572) (tl V1573) (shen.beta (hd V1572) (hd V1573) V1574))) ((and (cons? V1572) (and (cons? (hd V1572)) (and (cons? (tl (hd V1572))) (and (cons? (tl (tl (hd V1572)))) (and (= () (tl (tl (tl (hd V1572))))) (cons? V1573)))))) (shen.triple-stack (cons (cons (shen.op-test (hd (hd V1572))) (cons (hd V1573) ())) V1571) (cons (hd (tl (hd V1572))) (cons (hd (tl (tl (hd V1572)))) (tl V1572))) (cons (cons (shen.op1 (hd (hd V1572))) (cons (hd V1573) ())) (cons (cons (shen.op2 (hd (hd V1572))) (cons (hd V1573) ())) (tl V1573))) (shen.beta (hd V1572) (hd V1573) V1574))) ((and (cons? V1572) (cons? V1573)) (shen.triple-stack (cons (cons = (cons (hd V1572) (cons (hd V1573) ()))) V1571) (tl V1572) (tl V1573) V1574)) (true (simple-error "implementation error in shen.triple-stack"))))

(defun shen.rectify-test (V1577) (cond ((= () V1577) true) ((and (cons? V1577) (= () (tl V1577))) (hd V1577)) ((and (cons? V1577) (cons? (tl V1577))) (cons and (cons (hd V1577) (cons (shen.rectify-test (tl V1577)) ())))) (true (simple-error "implementation error in shen.rectify-test"))))

(defun shen.beta (V1587 V1588 V1589) (cond ((= V1587 V1589) V1588) ((and (cons? V1589) (and (= lambda (hd V1589)) (and (cons? (tl V1589)) (and (cons? (tl (tl V1589))) (and (= () (tl (tl (tl V1589)))) (= V1587 (hd (tl V1589)))))))) V1589) ((and (cons? V1589) (and (= let (hd V1589)) (and (cons? (tl V1589)) (and (cons? (tl (tl V1589))) (and (cons? (tl (tl (tl V1589)))) (and (= () (tl (tl (tl (tl V1589))))) (= V1587 (hd (tl V1589))))))))) (cons let (cons (hd (tl V1589)) (cons (shen.beta (hd (tl V1589)) V1588 (hd (tl (tl V1589)))) (tl (tl (tl V1589))))))) ((cons? V1589) (map (lambda V (shen.beta V1587 V1588 V)) V1589)) (true V1589)))

(defun shen.op1 (V1592) (cond ((= cons V1592) hd) ((= @s V1592) hdstr) ((= @p V1592) fst) ((= @v V1592) hdv) (true (simple-error "implementation error in shen.op1"))))

(defun shen.op2 (V1595) (cond ((= cons V1595) tl) ((= @s V1595) tlstr) ((= @p V1595) snd) ((= @v V1595) tlv) (true (simple-error "implementation error in shen.op2"))))

(defun shen.op-test (V1598) (cond ((= cons V1598) cons?) ((= @s V1598) shen.+string?) ((= @p V1598) tuple?) ((= @v V1598) shen.+vector?) (true (simple-error "implementation error in shen.op-test"))))

(defun shen.+string? (V1599) (cond ((= "" V1599) false) (true (string? V1599))))

(defun shen.+vector? (V1600) (cond ((= V1600 (vector 0)) false) (true (vector? V1600))))

(defun factorise (V1603) (cond ((= + V1603) (set shen.*factorise?* true)) ((= - V1603) (set shen.*factorise?* false)) (true (simple-error "factorise expects a + or a -
"))))

(defun shen.factorise-code (V1604) (cond ((and (cons? V1604) (and (= defun (hd V1604)) (and (cons? (tl V1604)) (and (cons? (tl (tl V1604))) (and (cons? (tl (tl (tl V1604)))) (and (cons? (hd (tl (tl (tl V1604))))) (and (= cond (hd (hd (tl (tl (tl V1604)))))) (and (= () (tl (tl (tl (tl V1604))))) (value shen.*factorise?*))))))))) (cons defun (cons (hd (tl V1604)) (cons (hd (tl (tl V1604))) (cons (shen.vertical (hd (tl (tl V1604))) (tl (hd (tl (tl (tl V1604))))) (cons shen.f-error (cons (hd (tl V1604)) ()))) ()))))) (true V1604)))

(defun shen.vertical (V1617 V1618 V1619) (cond ((and (cons? V1618) (and (cons? (hd V1618)) (and (= true (hd (hd V1618))) (and (cons? (tl (hd V1618))) (= () (tl (tl (hd V1618)))))))) (hd (tl (hd V1618)))) ((= () V1618) V1619) ((and (cons? V1618) (and (cons? (hd V1618)) (and (cons? (hd (hd V1618))) (and (= and (hd (hd (hd V1618)))) (and (cons? (tl (hd (hd V1618)))) (and (cons? (tl (tl (hd (hd V1618))))) (and (= () (tl (tl (tl (hd (hd V1618)))))) (and (cons? (tl (hd V1618))) (= () (tl (tl (hd V1618)))))))))))) (let Before+After (shen.split-cases (hd (tl (hd (hd V1618)))) V1618 ()) (shen.branch (hd (tl (hd (hd V1618)))) V1617 Before+After V1619))) ((and (cons? V1618) (and (cons? (hd V1618)) (and (cons? (tl (hd V1618))) (= () (tl (tl (hd V1618))))))) (cons if (cons (hd (hd V1618)) (cons (hd (tl (hd V1618))) (cons (shen.vertical V1617 (tl V1618) V1619) ()))))) (true (simple-error "implementation error in shen.vertical"))))

(defun shen.split-cases (V1624 V1625 V1626) (cond ((and (cons? V1625) (and (cons? (hd V1625)) (and (cons? (hd (hd V1625))) (and (= and (hd (hd (hd V1625)))) (and (cons? (tl (hd (hd V1625)))) (and (cons? (tl (tl (hd (hd V1625))))) (and (= () (tl (tl (tl (hd (hd V1625)))))) (and (cons? (tl (hd V1625))) (and (= () (tl (tl (hd V1625)))) (= V1624 (hd (tl (hd (hd V1625)))))))))))))) (shen.split-cases (hd (tl (hd (hd V1625)))) (tl V1625) (cons (cons (hd (tl (tl (hd (hd V1625))))) (tl (hd V1625))) V1626))) ((and (cons? V1625) (and (cons? (hd V1625)) (and (cons? (tl (hd V1625))) (and (= () (tl (tl (hd V1625)))) (= V1624 (hd (hd V1625))))))) (shen.split-cases (hd (hd V1625)) (tl V1625) (cons (cons true (tl (hd V1625))) V1626))) (true (cons (reverse V1626) (cons V1625 ())))))

(defun shen.branch (V1627 V1628 V1629 V1630) (cond ((and (cons? V1629) (and (cons? (tl V1629)) (= () (tl (tl V1629))))) (let Else (shen.else V1628 (hd (tl V1629)) V1630) (let Then (shen.then V1627 V1628 (hd V1629) Else) (cons if (cons V1627 (cons Then (cons Else ()))))))) (true (shen.f-error shen.branch))))

(defun shen.else (V1631 V1632 V1633) (let Else (shen.vertical V1631 V1632 V1633) (if (shen.inline? Else) Else (shen.procedure-call V1631 Else))))

(defun shen.procedure-call (V1634 V1635) (let F (gensym shen.else) (let Used (shen.remove-if-unused V1634 V1635) (let KL (cons defun (cons F (cons Used (cons V1635 ())))) (let EvalKL (eval-kl KL) (let Record (shen.record-kl F KL) (cons F Used)))))))

(defun shen.remove-if-unused (V1642 V1643) (cond ((= () V1642) ()) ((cons? V1642) (if (shen.occurs? (hd V1642) V1643) (cons (hd V1642) (shen.remove-if-unused (tl V1642) V1643)) (shen.remove-if-unused (tl V1642) V1643))) (true (simple-error "implementation error in shen.remove-if-unused"))))

(defun shen.then (V1644 V1645 V1646 V1647) (shen.horizontal (shen.selectors V1644 V1646) V1645 V1646 V1647))

(defun shen.horizontal (V1656 V1657 V1658 V1659) (cond ((= () V1656) (shen.vertical V1657 V1658 V1659)) ((cons? V1656) (let V (gensym (protect V)) (cons let (cons V (cons (hd V1656) (cons (shen.horizontal (tl V1656) (cons V V1657) (subst V (hd V1656) V1658) V1659) ())))))) (true (simple-error "implementation error in shen.horizontal"))))

(defun shen.selectors (V1664 V1665) (cond ((and (cons? V1664) (and (cons? (tl V1664)) (and (= () (tl (tl V1664))) (shen.constructor? (shen.op (hd V1664)))))) (let Op (shen.op (hd V1664)) (let Hd (cons (shen.op1 Op) (tl V1664)) (let Tl (cons (shen.op2 Op) (tl V1664)) (let RptedHd? (shen.rpted? Hd V1665) (let RptedTl? (shen.rpted? Tl V1665) (if (and RptedHd? RptedTl?) (cons Hd (cons Tl ())) (if RptedHd? (cons Hd ()) (if RptedTl? (cons Tl ()) ()))))))))) (true ())))

(defun shen.rpted? (V1666 V1667) (> (occurrences V1666 V1667) 1))

(defun shen.inline? (V1668) (cond ((cons? V1668) (and (atom? (hd V1668)) (shen.inline? (tl V1668)))) (true (atom? V1668))))

(defun shen.op (V1671) (cond ((= cons? V1671) cons) ((= shen.+string? V1671) @s) ((= shen.+vector? V1671) @v) ((= tuple? V1671) @p) (true shen.skip)))

(set shen.*history* ())

(set shen.*tc* false)

(set *property-vector* (vector 20000))

(set *macros* (cons (cons shen.defmacro-macro (lambda X (shen.defmacro-macro X))) (cons (cons shen.timer-macro (lambda X (shen.timer-macro X))) (cons (cons shen.cases-macro (lambda X (shen.cases-macro X))) (cons (cons shen.abs-macro (lambda X (shen.abs-macro X))) (cons (cons shen.put/get-macro (lambda X (shen.put/get-macro X))) (cons (cons shen.datatype-macro (lambda X (shen.datatype-macro X))) (cons (cons shen.let-macro (lambda X (shen.let-macro X))) (cons (cons shen.assoc-macro (lambda X (shen.assoc-macro X))) (cons (cons make-string (lambda X (shen.make-string-macro X))) (cons (cons shen.output-macro (lambda X (shen.output-macro X))) (cons (cons shen.input-macro (lambda X (shen.input-macro X))) (cons (cons shen.error-macro (lambda X (shen.error-macro X))) (cons (cons shen.prolog-macro (lambda X (shen.prolog-macro X))) (cons (cons shen.synonyms-macro (lambda X (shen.synonyms-macro X))) (cons (cons shen.nl-macro (lambda X (shen.nl-macro X))) (cons (cons shen.@s-macro (lambda X (shen.@s-macro X))) (cons (cons defprolog (lambda X (shen.defprolog-macro X))) (cons (cons shen.defcc-macro (lambda X (shen.defcc-macro X))) (cons (cons shen.u!-macro (lambda X (shen.u!-macro X))) ()))))))))))))))))))))

(set shen.*gensym* 0)

(set shen.*tracking* ())

(set shen.*profiled* ())

(set *home-directory* "")

(set shen.*special* (cons @p (cons @s (cons @v (cons cons (cons lambda (cons let (cons where (cons set (cons open (cons input+ (cons type ()))))))))))))

(set shen.*extraspecial* ())

(set shen.*spy* false)

(set shen.*datatypes* ())

(set shen.*alldatatypes* ())

(set shen.*shen-type-theory-enabled?* true)

(set shen.*package* null)

(set shen.*synonyms* ())

(set shen.*system* ())

(set shen.*sigf* ())

(set shen.*occurs* true)

(set shen.*factorise?* false)

(set shen.*maxinferences* 1000000)

(set *maximum-print-sequence-size* 20)

(set shen.*call* 0)

(set shen.*infs* 0)

(set *hush* false)

(set shen.*optimise* false)

(set *version* "31.02")

(set shen.*step* false)

(set shen.*it* "")

(set shen.*residue* ())

(defun prolog-memory (V1676) (let Bindings (absvector V1676) (let PrintNamed (address-> Bindings 0 shen.print-prolog-vector) (let Ticketed (address-> Bindings 1 2) (let Assign (set shen.*prolog-vector* Ticketed) V1676)))))

(prolog-memory 10000)

(set shen.*loading?* false)

(defun shen.initialise-lambda-tables (V1679) (cond ((= () V1679) ()) ((and (cons? V1679) (cons? (tl V1679))) (let DecArity (put (hd V1679) arity (hd (tl V1679)) (value *property-vector*)) (shen.initialise-arity-table (tl (tl V1679))))) (true (simple-error "implementation error in shen.initialise-arity-table"))))

(defun arity (V1680) (trap-error (get V1680 arity (value *property-vector*)) (lambda E -1)))

(defun shen.initialise-arity-table (V1683) (cond ((= () V1683) ()) ((and (cons? V1683) (cons? (tl V1683))) (let DecArity (put (hd V1683) arity (hd (tl V1683)) (value *property-vector*)) (shen.initialise-arity-table (tl (tl V1683))))) (true (simple-error "implementation error in shen.initialise_arity_table"))))

(shen.initialise-arity-table (cons abort (cons 0 (cons absvector? (cons 1 (cons absvector (cons 1 (cons address-> (cons 3 (cons adjoin (cons 2 (cons and (cons 2 (cons append (cons 2 (cons arity (cons 1 (cons assoc (cons 2 (cons atom? (cons 1 (cons boolean? (cons 1 (cons bootstrap (cons 1 (cons bound? (cons 1 (cons bind (cons 6 (cons call (cons 5 (cons cd (cons 1 (cons compile (cons 2 (cons concat (cons 2 (cons cons (cons 2 (cons cons? (cons 1 (cons cn (cons 2 (cons close (cons 1 (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 external (cons 1 (cons error-to-string (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 factorise (cons 1 (cons fail-if (cons 2 (cons fail (cons 0 (cons fix (cons 2 (cons findall (cons 7 (cons fork (cons 5 (cons freeze (cons 1 (cons fresh (cons 0 (cons fst (cons 1 (cons fn (cons 1 (cons function (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 hash (cons 2 (cons hd (cons 1 (cons hdv (cons 1 (cons hdstr (cons 1 (cons head (cons 1 (cons if (cons 3 (cons include (cons 1 (cons in-package (cons 1 (cons integer? (cons 1 (cons internal (cons 1 (cons intern (cons 1 (cons inferences (cons 0 (cons input (cons 1 (cons input+ (cons 2 (cons implementation (cons 0 (cons include-all-but (cons 1 (cons intersection (cons 2 (cons internal (cons 1 (cons it (cons 0 (cons is (cons 6 (cons is! (cons 6 (cons language (cons 0 (cons length (cons 1 (cons limit (cons 1 (cons lineread (cons 1 (cons list (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 nl (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 open (cons 2 (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 preclude-all-but (cons 1 (cons print (cons 1 (cons shen.pprint (cons 1 (cons profile (cons 1 (cons shen.print-prolog-vector (cons 1 (cons shen.print-freshterm (cons 1 (cons shen.printF (cons 1 (cons prolog-memory (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 put (cons 4 (cons read-file-as-string (cons 1 (cons read-file-as-bytelist (cons 1 (cons read-file (cons 1 (cons read (cons 1 (cons read-byte (cons 1 (cons read-from-string (cons 1 (cons read-from-string-unprocessed (cons 1 (cons shen.read-unit-string (cons 1 (cons receive (cons 1 (cons release (cons 0 (cons remove (cons 2 (cons reverse (cons 1 (cons set (cons 2 (cons simple-error (cons 1 (cons snd (cons 1 (cons specialise (cons 2 (cons spy (cons 1 (cons step (cons 1 (cons stinput (cons 0 (cons stoutput (cons 0 (cons str (cons 1 (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 systemf (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 5 (cons undefmacro (cons 1 (cons unput (cons 3 (cons unprofile (cons 1 (cons union (cons 2 (cons untrack (cons 1 (cons undefmacro (cons 1 (cons update-lambda-table (cons 2 (cons vector (cons 1 (cons vector? (cons 1 (cons vector-> (cons 3 (cons value (cons 1 (cons variable? (cons 1 (cons var? (cons 5 (cons version (cons 0 (cons when (cons 5 (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 shen.<end> (cons 1 (cons <!> (cons 1 (cons @p (cons 2 (cons @v (cons 2 (cons @s (cons 2 ())))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))

(defun systemf (V1684) (let External (get shen shen.external-symbols (value *property-vector*)) (let Place (put shen shen.external-symbols (adjoin V1684 External) (value *property-vector*)) V1684)))

(defun adjoin (V1685 V1686) (if (element? V1685 V1686) V1686 (cons V1685 V1686)))

(put shen shen.external-symbols (cons ! (cons } (cons { (cons --> (cons <-- (cons && (cons (intern ":") (cons (intern ";") (cons (intern ":=") (cons (intern ",") (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 shen.<end> (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 var? (cons value (cons vector-> (cons <-vector (cons vector (cons vector? (cons u! (cons update-lambda-table (cons unspecialise (cons untrack (cons unit (cons shen.unix (cons union (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 receive (cons read-file (cons read-file-as-bytelist (cons read-file-as-string (cons read-byte (cons read-from-string (cons read-from-string-unprocessed (cons package? (cons put (cons preclude (cons preclude-all-but (cons ps (cons prolog? (cons protect (cons profile-results (cons profile (cons prolog-memory (cons print (cons shen.pprint (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 is (cons intersection (cons inferences (cons intern (cons integer? (cons input (cons input+ (cons inline (cons include (cons include-all-but (cons it (cons is (cons is! (cons in (cons in-package (cons internal (cons implementation (cons if (cons head (cons hd (cons hdv (cons hdstr (cons hash (cons get (cons get-time (cons gensym (cons fn (cons function (cons fst (cons freeze (cons fresh (cons fork (cons fix (cons file (cons fail (cons fail-if (cons factorise (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 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 bootstrap (cons (intern "bar!") (cons atom? (cons assoc (cons arity (cons append (cons and (cons adjoin (cons <-address (cons address-> (cons absvector? (cons absvector (cons abort ())))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) (value *property-vector*))

(defun shen.lambda-entry (V1687) (let ArityF (arity V1687) (if (or (= ArityF -1) (= ArityF 0)) () (cons V1687 (eval-kl (shen.lambda-function (cons V1687 ()) ArityF))))))

(defun shen.build-lambda-table (V1688) (let LambdaEntries (map (lambda X (shen.lambda-entry X)) V1688) (set shen.*lambdatable* (cons (cons shen.tuple (lambda X (shen.tuple X))) (cons (cons shen.pvar (lambda X (shen.pvar X))) (cons (cons shen.print-prolog-vector (lambda X (shen.print-prolog-vector X))) (cons (cons shen.print-freshterm (lambda X (shen.print-freshterm X))) (cons (cons shen.printF (lambda X (shen.printF X))) LambdaEntries))))))))

(shen.build-lambda-table (external shen))

Copyright (c) 2010-2021, 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.c#34;(defun load (V1706) (let TC? (value shen.*tc*) (let Load (let Start (get-time run) (let Result (shen.load-help TC? (read-file V1706)) (let Finish (get-time run) (let Time (- Finish Start) (let Message (pr (cn "
run time: " (cn (str Time) " secs
")) (stoutput)) Result))))) (let Infs (if TC? (pr (cn "
typechecked in " (shen.app (inferences) " inferences
" shen.a)) (stoutput)) shen.skip) loaded))))

(defun shen.load-help (V1709 V1710) (cond ((= false V1709) (shen.eval-and-print V1710)) (true (shen.check-eval-and-print V1710))))

(defun shen.eval-and-print (V1711) (map (lambda Y (pr (shen.app (eval-kl (shen.shen->kl Y)) "
" shen.s) (stoutput))) V1711))

(defun shen.check-eval-and-print (V1712) (let Table (mapcan (lambda Y (shen.typetable Y)) V1712) (let Assume (shen.assumetypes Table) (trap-error (shen.work-through V1712) (lambda E (shen.unwind-types E Table))))))

(defun shen.typetable (V1717) (cond ((and (cons? V1717) (and (= define (hd V1717)) (and (cons? (tl V1717)) (and (cons? (tl (tl V1717))) (= { (hd (tl (tl V1717)))))))) (cons (hd (tl V1717)) (cons (shen.rectify-type (shen.type-F (hd (tl V1717)) (tl (tl (tl V1717))))) ()))) ((and (cons? V1717) (and (= define (hd V1717)) (cons? (tl V1717)))) (simple-error (cn "missing { in " (shen.app (hd (tl V1717)) "
" shen.a)))) (true ())))

(defun shen.type-F (V1724 V1725) (cond ((and (cons? V1725) (= } (hd V1725))) ()) ((cons? V1725) (cons (hd V1725) (shen.type-F V1724 (tl V1725)))) (true (simple-error (cn "missing } in " (shen.app V1724 "
" shen.a))))))

(defun shen.assumetypes (V1728) (cond ((= () V1728) ()) ((and (cons? V1728) (cons? (tl V1728))) (do (declare (hd V1728) (hd (tl V1728))) (shen.assumetypes (tl (tl V1728))))) (true (simple-error "implementation error in shen.assumetype"))))

(defun shen.unwind-types (V1733 V1734) (cond ((and (cons? V1734) (cons? (hd V1734))) (do (destroy (hd (hd V1734))) (shen.unwind-types V1733 (tl V1734)))) (true (simple-error (error-to-string V1733)))))

(defun shen.work-through (V1737) (cond ((= () V1737) ()) ((and (cons? V1737) (and (cons? (tl V1737)) (and (cons? (tl (tl V1737))) (= (hd (tl V1737)) (intern ":"))))) (let Check (shen.typecheck (hd V1737) (hd (tl (tl V1737)))) (if (= Check false) (shen.type-error) (let Eval (eval-kl (shen.shen->kl (hd V1737))) (let Message (pr (shen.app Eval (cn " : " (shen.app (shen.pretty-type Check) "
" shen.r)) shen.s) (stoutput)) (shen.work-through (tl (tl (tl V1737))))))))) ((cons? V1737) (shen.work-through (cons (hd V1737) (cons (intern ":") (cons (protect A) (tl V1737)))))) (true (simple-error "implementation error in shen.work-through"))))

(defun shen.pretty-type (V1739) (cond ((and (cons? V1739) (and (cons? (hd V1739)) (and (= str (hd (hd V1739))) (and (cons? (tl (hd V1739))) (and (cons? (hd (tl (hd V1739)))) (and (= list (hd (hd (tl (hd V1739))))) (and (cons? (tl (hd (tl (hd V1739))))) (and (= () (tl (tl (hd (tl (hd V1739)))))) (and (cons? (tl (tl (hd V1739)))) (and (= () (tl (tl (tl (hd V1739))))) (and (cons? (tl V1739)) (and (= --> (hd (tl V1739))) (and (cons? (tl (tl V1739))) (and (cons? (hd (tl (tl V1739)))) (and (= str (hd (hd (tl (tl V1739))))) (and (cons? (tl (hd (tl (tl V1739))))) (and (cons? (hd (tl (hd (tl (tl V1739)))))) (and (= list (hd (hd (tl (hd (tl (tl V1739))))))) (and (cons? (tl (hd (tl (hd (tl (tl V1739))))))) (and (= () (tl (tl (hd (tl (hd (tl (tl V1739)))))))) (and (cons? (tl (tl (hd (tl (tl V1739)))))) (and (= () (tl (tl (tl (hd (tl (tl V1739))))))) (and (= () (tl (tl (tl V1739)))) (= (hd (tl (hd (tl (hd V1739))))) (hd (tl (hd (tl (hd (tl (tl V1739))))))))))))))))))))))))))))))) (cons (hd (tl (hd (tl (tl V1739))))) (cons ==> (tl (tl (hd (tl (tl V1739)))))))) (true V1739)))

(defun shen.type-error () (simple-error "type error
"))

(defun bootstrap (V1740) (let KLFile (shen.klfile V1740) (let Code (read-file V1740) (let Open (open KLFile out) (let KL (map (lambda X (shen.shen->kl-h X)) Code) (let Write (shen.write-kl KL Open) KLFile))))))

(defun shen.write-kl (V1743 V1744) (cond ((= () V1743) (close V1744)) ((and (cons? V1743) (cons? (hd V1743))) (shen.write-kl (tl V1743) (do (shen.write-kl-h (hd V1743) V1744) V1744))) ((cons? V1743) (shen.write-kl (tl V1743) V1744)) (true (shen.f-error shen.write-kl))))

(defun shen.write-kl-h (V1747 V1748) (cond ((and (cons? V1747) (and (= defun (hd V1747)) (and (cons? (tl V1747)) (and (= fail (hd (tl V1747))) (and (cons? (tl (tl V1747))) (and (= () (hd (tl (tl V1747)))) (and (cons? (tl (tl (tl V1747)))) (= () (tl (tl (tl (tl V1747)))))))))))) (pr "(defun fail () shen.fail!)" V1748)) (true (pr (shen.app V1747 "

" shen.r) V1748))))

(defun shen.klfile (V1749) (cond ((= "" V1749) ".kl") ((= ".shen" V1749) ".kl") ((shen.+string? V1749) (@s (hdstr V1749) (shen.klfile (tlstr V1749)))) (true (shen.f-error shen.klfile))))

(defun macroexpand (V1788) (let Fs (map (lambda X (tl X)) (value *macros*)) (shen.macroexpand-h V1788 Fs Fs)))

(defun shen.macroexpand-h (V1797 V1798 V1799) (cond ((= () V1798) V1797) ((cons? V1798) (let Y (shen.walk (hd V1798) V1797) (if (= V1797 Y) (shen.macroexpand-h V1797 (tl V1798) V1799) (shen.macroexpand-h Y V1799 V1799)))) (true (simple-error "implementation error in shen.macroexpand-h"))))

(defun shen.walk (V1800 V1801) (cond ((cons? V1801) (V1800 (map (lambda Z (shen.walk V1800 Z)) V1801))) (true (V1800 V1801))))

(defun shen.defmacro-macro (V1802) (cond ((and (cons? V1802) (and (= defmacro (hd V1802)) (cons? (tl V1802)))) (let Default (cons (protect X) (cons -> (cons (protect X) ()))) (let Def (eval (cons define (cons (hd (tl V1802)) (append (tl (tl V1802)) Default)))) (let Record (shen.record-macro (hd (tl V1802)) (lambda X ((hd (tl V1802)) X))) (hd (tl V1802)))))) (true V1802)))

(defun shen.u!-macro (V1803) (cond ((and (cons? V1803) (and (= u! (hd V1803)) (and (cons? (tl V1803)) (= () (tl (tl V1803)))))) (cons protect (cons (shen.make-uppercase (hd (tl V1803))) ()))) (true V1803)))

(defun shen.make-uppercase (V1804) (intern (shen.mu-h (str V1804))))

(defun shen.mu-h (V1805) (cond ((= "" V1805) "") ((shen.+string? V1805) (let ASCII (string->n (hdstr V1805)) (let ASCII-32 (- ASCII 32) (let Upper (if (and (>= ASCII 97) (<= ASCII 122)) (n->string ASCII-32) (hdstr V1805)) (@s Upper (shen.mu-h (tlstr V1805))))))) (true (shen.f-error shen.mu-h))))

(defun shen.record-macro (V1806 V1807) (set *macros* (shen.update-assoc V1806 V1807 (value *macros*))))

(defun shen.update-assoc (V1817 V1818 V1819) (cond ((= () V1819) (cons (cons V1817 V1818) ())) ((and (cons? V1819) (and (cons? (hd V1819)) (= V1817 (hd (hd V1819))))) (cons (cons (hd (hd V1819)) V1818) (tl V1819))) ((cons? V1819) (cons (hd V1819) (shen.update-assoc V1817 V1818 (tl V1819)))) (true (simple-error "implementation error in shen.update-assoc"))))

(defun shen.error-macro (V1820) (cond ((and (cons? V1820) (and (= error (hd V1820)) (cons? (tl V1820)))) (cons simple-error (cons (shen.mkstr (hd (tl V1820)) (tl (tl V1820))) ()))) (true V1820)))

(defun shen.output-macro (V1821) (cond ((and (cons? V1821) (and (= output (hd V1821)) (cons? (tl V1821)))) (cons pr (cons (shen.mkstr (hd (tl V1821)) (tl (tl V1821))) (cons (cons stoutput ()) ())))) ((and (cons? V1821) (and (= pr (hd V1821)) (and (cons? (tl V1821)) (= () (tl (tl V1821)))))) (cons pr (cons (hd (tl V1821)) (cons (cons stoutput ()) ())))) (true V1821)))

(defun shen.make-string-macro (V1822) (cond ((and (cons? V1822) (and (= make-string (hd V1822)) (cons? (tl V1822)))) (shen.mkstr (hd (tl V1822)) (tl (tl V1822)))) (true V1822)))

(defun shen.input-macro (V1823) (cond ((and (cons? V1823) (and (= lineread (hd V1823)) (= () (tl V1823)))) (cons lineread (cons (cons stinput ()) ()))) ((and (cons? V1823) (and (= input (hd V1823)) (= () (tl V1823)))) (cons input (cons (cons stinput ()) ()))) ((and (cons? V1823) (and (= read (hd V1823)) (= () (tl V1823)))) (cons read (cons (cons stinput ()) ()))) ((and (cons? V1823) (and (= input+ (hd V1823)) (and (cons? (tl V1823)) (= () (tl (tl V1823)))))) (cons input+ (cons (hd (tl V1823)) (cons (cons stinput ()) ())))) ((and (cons? V1823) (and (= read-byte (hd V1823)) (= () (tl V1823)))) (if (shen.char-stinput? (stinput)) (cons string->n (cons (cons shen.read-unit-string (cons (cons stinput ()) ())) ())) (cons read-byte (cons (cons stinput ()) ())))) (true V1823)))

(defun shen.defcc-macro (V1824) (cond ((and (cons? V1824) (= defcc (hd V1824))) (shen.yacc->shen (tl V1824))) (true V1824)))

(defun shen.prolog-macro (V1825) (cond ((and (cons? V1825) (= prolog? (hd V1825))) (shen.call-prolog (tl V1825))) (true V1825)))

(defun shen.call-prolog (V1826) (let Bindings (cons shen.reset-prolog-vector ()) (let Lock (cons @v (cons true (cons 0 (cons (cons vector (cons 0 ())) ())))) (let Key 0 (let Continuation (cons freeze (cons true ())) (let CLiterals (compile (lambda X (shen.<body> X)) V1826) (let Received (shen.received V1826) (let B (gensym (protect V)) (let L (gensym (protect L)) (let K (gensym (protect K)) (let C (gensym (protect C)) (let Lambda (cons lambda (cons B (cons (cons lambda (cons L (cons (cons lambda (cons K (cons (cons lambda (cons C (cons (shen.continue Received CLiterals B L K C) ()))) ()))) ()))) ()))) (cons Lambda (cons Bindings (cons Lock (cons Key (cons Continuation ())))))))))))))))))

(defun shen.received (V1829) (cond ((and (cons? V1829) (and (= receive (hd V1829)) (and (cons? (tl V1829)) (= () (tl (tl V1829)))))) (tl V1829)) ((cons? V1829) (union (shen.received (hd V1829)) (shen.received (tl V1829)))) (true ())))

(defun shen.reset-prolog-vector () (address-> (value shen.*prolog-vector*) 1 2))

(defun receive (V1830) V1830)

(defun shen.defprolog-macro (V1831) (cond ((and (cons? V1831) (and (= defprolog (hd V1831)) (cons? (tl V1831)))) (shen.compile-prolog (hd (tl V1831)) (tl (tl V1831)))) (true V1831)))

(defun shen.datatype-macro (V1832) (cond ((and (cons? V1832) (and (= datatype (hd V1832)) (cons? (tl V1832)))) (let D (shen.intern-type (hd (tl V1832))) (let Compile (compile (lambda X (shen.<datatype> X)) (cons D (tl (tl V1832)))) D))) (true V1832)))

(defun shen.rcons_form (V1833) (cond ((cons? V1833) (cons cons (cons (shen.rcons_form (hd V1833)) (cons (shen.rcons_form (tl V1833)) ())))) (true V1833)))

(defun shen.intern-type (V1834) (intern (cn (str V1834) "#type")))

(defun shen.@s-macro (V1835) (cond ((and (cons? V1835) (and (= @s (hd V1835)) (and (cons? (tl V1835)) (and (cons? (tl (tl V1835))) (cons? (tl (tl (tl V1835)))))))) (cons @s (cons (hd (tl V1835)) (cons (shen.@s-macro (cons @s (tl (tl V1835)))) ())))) ((and (cons? V1835) (and (= @s (hd V1835)) (and (cons? (tl V1835)) (and (cons? (tl (tl V1835))) (and (= () (tl (tl (tl V1835)))) (string? (hd (tl V1835)))))))) (let E (explode (hd (tl V1835))) (if (> (length E) 1) (shen.@s-macro (cons @s (append E (tl (tl V1835))))) V1835))) (true V1835)))

(defun shen.synonyms-macro (V1836) (cond ((and (cons? V1836) (= synonyms (hd V1836))) (shen.synonyms-h (append (tl V1836) (value shen.*synonyms*)))) (true V1836)))

(defun shen.synonyms-h (V1837) (let CurryTypes (map (lambda X (shen.curry-type X)) V1837) (let Eval (eval (cons define (cons shen.demod (shen.compile-synonyms CurryTypes)))) synonyms)))

(defun shen.compile-synonyms (V1840) (cond ((= () V1840) (let X (gensym (protect X)) (cons X (cons -> (cons X ()))))) ((and (cons? V1840) (cons? (tl V1840))) (cons (shen.rcons_form (hd V1840)) (cons -> (cons (shen.rcons_form (hd (tl V1840))) (shen.compile-synonyms (tl (tl V1840))))))) (true (simple-error "synonyms requires an even number of arguments
"))))

(defun shen.nl-macro (V1841) (cond ((and (cons? V1841) (and (= nl (hd V1841)) (= () (tl V1841)))) (cons nl (cons 1 ()))) (true V1841)))

(defun shen.assoc-macro (V1842) (cond ((and (cons? V1842) (and (cons? (tl V1842)) (and (cons? (tl (tl V1842))) (and (cons? (tl (tl (tl V1842)))) (element? (hd V1842) (cons @p (cons @v (cons append (cons and (cons or (cons + (cons * (cons do ()))))))))))))) (cons (hd V1842) (cons (hd (tl V1842)) (cons (shen.assoc-macro (cons (hd V1842) (tl (tl V1842)))) ())))) (true V1842)))

(defun shen.let-macro (V1843) (cond ((and (cons? V1843) (and (= let (hd V1843)) (and (cons? (tl V1843)) (and (cons? (tl (tl V1843))) (and (cons? (tl (tl (tl V1843)))) (cons? (tl (tl (tl (tl V1843)))))))))) (cons let (cons (hd (tl V1843)) (cons (hd (tl (tl V1843))) (cons (shen.let-macro (cons let (tl (tl (tl V1843))))) ()))))) ((and (cons? V1843) (and (= let (hd V1843)) (and (cons? (tl V1843)) (and (cons? (tl (tl V1843))) (and (cons? (tl (tl (tl V1843)))) (= () (tl (tl (tl (tl V1843)))))))))) (if (variable? (hd (tl V1843))) V1843 (simple-error (shen.app (hd (tl V1843)) " is not a variable
" shen.s)))) (true V1843)))

(defun shen.abs-macro (V1844) (cond ((and (cons? V1844) (and (= /. (hd V1844)) (and (cons? (tl V1844)) (and (cons? (tl (tl V1844))) (cons? (tl (tl (tl V1844)))))))) (cons lambda (cons (hd (tl V1844)) (cons (shen.abs-macro (cons /. (tl (tl V1844)))) ())))) ((and (cons? V1844) (and (= /. (hd V1844)) (and (cons? (tl V1844)) (and (cons? (tl (tl V1844))) (= () (tl (tl (tl V1844)))))))) (if (variable? (hd (tl V1844))) (cons lambda (tl V1844)) (simple-error (shen.app (hd (tl V1844)) " is not a variable
" shen.s)))) (true V1844)))

(defun shen.cases-macro (V1847) (cond ((and (cons? V1847) (and (= cases (hd V1847)) (and (cons? (tl V1847)) (and (= true (hd (tl V1847))) (cons? (tl (tl V1847))))))) (hd (tl (tl V1847)))) ((and (cons? V1847) (and (= cases (hd V1847)) (and (cons? (tl V1847)) (and (cons? (tl (tl V1847))) (= () (tl (tl (tl V1847)))))))) (cons if (cons (hd (tl V1847)) (cons (hd (tl (tl V1847))) (cons (cons simple-error (cons "error: cases exhausted" ())) ()))))) ((and (cons? V1847) (and (= cases (hd V1847)) (and (cons? (tl V1847)) (cons? (tl (tl V1847)))))) (cons if (cons (hd (tl V1847)) (cons (hd (tl (tl V1847))) (cons (shen.cases-macro (cons cases (tl (tl (tl V1847))))) ()))))) ((and (cons? V1847) (and (= cases (hd V1847)) (and (cons? (tl V1847)) (= () (tl (tl V1847)))))) (simple-error "error: odd number of case elements
")) (true V1847)))

(defun shen.timer-macro (V1848) (cond ((and (cons? V1848) (and (= time (hd V1848)) (and (cons? (tl V1848)) (= () (tl (tl V1848)))))) (shen.let-macro (cons let (cons (protect Start) (cons (cons get-time (cons run ())) (cons (protect Result) (cons (hd (tl V1848)) (cons (protect Finish) (cons (cons get-time (cons run ())) (cons (protect Time) (cons (cons - (cons (protect Finish) (cons (protect Start) ()))) (cons (protect Message) (cons (cons pr (cons (cons cn (cons "
run time: " (cons (cons cn (cons (cons str (cons (protect Time) ())) (cons " secs
" ()))) ()))) (cons (cons stoutput ()) ()))) (cons (protect Result) ())))))))))))))) (true V1848)))

(defun shen.tuple-up (V1849) (cond ((cons? V1849) (cons @p (cons (hd V1849) (cons (shen.tuple-up (tl V1849)) ())))) (true V1849)))

(defun shen.put/get-macro (V1850) (cond ((and (cons? V1850) (and (= put (hd V1850)) (and (cons? (tl V1850)) (and (cons? (tl (tl V1850))) (and (cons? (tl (tl (tl V1850)))) (= () (tl (tl (tl (tl V1850)))))))))) (cons put (cons (hd (tl V1850)) (cons (hd (tl (tl V1850))) (cons (hd (tl (tl (tl V1850)))) (cons (cons value (cons *property-vector* ())) ())))))) ((and (cons? V1850) (and (= get (hd V1850)) (and (cons? (tl V1850)) (and (cons? (tl (tl V1850))) (= () (tl (tl (tl V1850)))))))) (cons get (cons (hd (tl V1850)) (cons (hd (tl (tl V1850))) (cons (cons value (cons *property-vector* ())) ()))))) ((and (cons? V1850) (and (= unput (hd V1850)) (and (cons? (tl V1850)) (and (cons? (tl (tl V1850))) (= () (tl (tl (tl V1850)))))))) (cons unput (cons (hd (tl V1850)) (cons (hd (tl (tl V1850))) (cons (cons value (cons *property-vector* ())) ()))))) (true V1850)))

(defun undefmacro (V1851) (do (set *macros* (remove (assoc V1851 (value *macros*)) (value *macros*))) V1851))

(defun shen.compile-prolog (V2057 V2058) (compile (lambda X (shen.<defprolog> X)) (cons V2057 V2058)))

(defun shen.<defprolog> (V2059) (let Result (if (shen.non-empty-stream? V2059) (let F (shen.hds V2059) (let News1853 (shen.tls V2059) (let Parseshen.<clauses> (shen.<clauses> News1853) (if (shen.parse-failure? Parseshen.<clauses>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<clauses>) (let Aritycheck (shen.prolog-arity-check F (shen.<-out Parseshen.<clauses>)) (let LeftLinear (map (lambda X (shen.linearise-clause X)) (shen.<-out Parseshen.<clauses>)) (shen.horn-clause-procedure F LeftLinear)))))))) (shen.parse-failure)) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.<clauses> (V2060) (let Result (let Parseshen.<clause> (shen.<clause> V2060) (if (shen.parse-failure? Parseshen.<clause>) (shen.parse-failure) (let Parseshen.<clauses> (shen.<clauses> Parseshen.<clause>) (if (shen.parse-failure? Parseshen.<clauses>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<clauses>) (cons (shen.<-out Parseshen.<clause>) (shen.<-out Parseshen.<clauses>))))))) (if (shen.parse-failure? Result) (let Result (let Parse<!> (<!> V2060) (if (shen.parse-failure? Parse<!>) (shen.parse-failure) (shen.comb (shen.in-> Parse<!>) (if (empty? (shen.<-out Parse<!>)) () (simple-error (cn "Prolog syntax error here:
 " (shen.app (shen.<-out Parse<!>) "
 ..." shen.r))))))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)) Result)))

(defun shen.prolog-arity-check (V2065 V2066) (cond ((and (cons? V2066) (= () (tl V2066))) shen.skip) ((and (cons? V2066) (and (cons? (hd V2066)) (and (cons? (tl (hd V2066))) (= () (tl (tl (hd V2066))))))) (shen.pac-h V2065 (length (hd (hd V2066))) (tl V2066))) (true (shen.f-error shen.prolog-arity-check))))

(defun shen.linearise-clause (V2067) (cond ((and (cons? V2067) (and (cons? (tl V2067)) (= () (tl (tl V2067))))) (shen.lch (shen.linearise (@p (hd V2067) (hd (tl V2067)))))) (true (shen.f-error shen.linearise-clause))))

(defun shen.lch (V2068) (cond ((tuple? V2068) (cons (fst V2068) (cons (shen.lchh (snd V2068)) ()))) (true (shen.f-error shen.lch))))

(defun shen.lchh (V2069) (cond ((and (cons? V2069) (and (= where (hd V2069)) (and (cons? (tl V2069)) (and (cons? (hd (tl V2069))) (and (= = (hd (hd (tl V2069)))) (and (cons? (tl (hd (tl V2069)))) (and (cons? (tl (tl (hd (tl V2069))))) (and (= () (tl (tl (tl (hd (tl V2069)))))) (and (cons? (tl (tl V2069))) (= () (tl (tl (tl V2069))))))))))))) (cons (cons (if (value shen.*occurs*) is! is) (tl (hd (tl V2069)))) (shen.lchh (hd (tl (tl V2069)))))) (true V2069)))

(defun shen.pac-h (V2076 V2077 V2078) (cond ((= () V2078) true) ((and (cons? V2078) (cons? (hd V2078))) (if (= V2077 (length (hd (hd V2078)))) (shen.pac-h V2076 V2077 (tl V2078)) (simple-error (cn "arity error in prolog procedure " (shen.app V2076 "
" shen.a))))) (true (shen.f-error shen.pac-h))))

(defun shen.<clause> (V2079) (let Result (let Parseshen.<head> (shen.<head> V2079) (if (shen.parse-failure? Parseshen.<head>) (shen.parse-failure) (if (shen.=hd? Parseshen.<head> <--) (let News1856 (shen.tls Parseshen.<head>) (let Parseshen.<body> (shen.<body> News1856) (if (shen.parse-failure? Parseshen.<body>) (shen.parse-failure) (let Parseshen.<sc> (shen.<sc> Parseshen.<body>) (if (shen.parse-failure? Parseshen.<sc>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<sc>) (cons (shen.<-out Parseshen.<head>) (cons (shen.<-out Parseshen.<body>) ())))))))) (shen.parse-failure)))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.<head> (V2080) (let Result (let Parseshen.<hterm> (shen.<hterm> V2080) (if (shen.parse-failure? Parseshen.<hterm>) (shen.parse-failure) (let Parseshen.<head> (shen.<head> Parseshen.<hterm>) (if (shen.parse-failure? Parseshen.<head>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<head>) (cons (shen.<-out Parseshen.<hterm>) (shen.<-out Parseshen.<head>))))))) (if (shen.parse-failure? Result) (let Result (let Parse<e> (<e> V2080) (if (shen.parse-failure? Parse<e>) (shen.parse-failure) (shen.comb (shen.in-> Parse<e>) ()))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)) Result)))

(defun shen.<hterm> (V2081) (let Result (if (shen.non-empty-stream? V2081) (let X (shen.hds V2081) (let News1859 (shen.tls V2081) (if (and (atom? X) (not (shen.prolog-keyword? X))) (shen.comb (shen.in-> News1859) X) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? Result) (let Result (if (shen.non-empty-stream? V2081) (let X (shen.hds V2081) (let News1860 (shen.tls V2081) (if (= X (intern ":")) (shen.comb (shen.in-> News1860) X) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? Result) (let Result (if (shen.ccons? V2081) (let SynCons (shen.comb (shen.hds V2081) (shen.<-out V2081)) (if (shen.=hd? SynCons cons) (let News1861 (shen.tls SynCons) (let Parseshen.<hterm1> (shen.<hterm1> News1861) (if (shen.parse-failure? Parseshen.<hterm1>) (shen.parse-failure) (let Parseshen.<hterm2> (shen.<hterm2> Parseshen.<hterm1>) (if (shen.parse-failure? Parseshen.<hterm2>) (shen.parse-failure) (let Parseshen.<end> (shen.<end> Parseshen.<hterm2>) (if (shen.parse-failure? Parseshen.<end>) (shen.parse-failure) (shen.comb (shen.in-> (shen.tlstream V2081)) (cons cons (cons (shen.<-out Parseshen.<hterm1>) (cons (shen.<-out Parseshen.<hterm2>) ()))))))))))) (shen.parse-failure))) (shen.parse-failure)) (if (shen.parse-failure? Result) (let Result (if (shen.ccons? V2081) (let SynCons (shen.comb (shen.hds V2081) (shen.<-out V2081)) (if (shen.=hd? SynCons +) (let News1862 (shen.tls SynCons) (let Parseshen.<hterm> (shen.<hterm> News1862) (if (shen.parse-failure? Parseshen.<hterm>) (shen.parse-failure) (let Parseshen.<end> (shen.<end> Parseshen.<hterm>) (if (shen.parse-failure? Parseshen.<end>) (shen.parse-failure) (shen.comb (shen.in-> (shen.tlstream V2081)) (cons shen.+m (cons (shen.<-out Parseshen.<hterm>) ())))))))) (shen.parse-failure))) (shen.parse-failure)) (if (shen.parse-failure? Result) (let Result (if (shen.ccons? V2081) (let SynCons (shen.comb (shen.hds V2081) (shen.<-out V2081)) (if (shen.=hd? SynCons -) (let News1863 (shen.tls SynCons) (let Parseshen.<hterm> (shen.<hterm> News1863) (if (shen.parse-failure? Parseshen.<hterm>) (shen.parse-failure) (let Parseshen.<end> (shen.<end> Parseshen.<hterm>) (if (shen.parse-failure? Parseshen.<end>) (shen.parse-failure) (shen.comb (shen.in-> (shen.tlstream V2081)) (cons shen.-m (cons (shen.<-out Parseshen.<hterm>) ())))))))) (shen.parse-failure))) (shen.parse-failure)) (if (shen.parse-failure? Result) (let Result (if (shen.ccons? V2081) (let SynCons (shen.comb (shen.hds V2081) (shen.<-out V2081)) (if (shen.=hd? SynCons mode) (let News1864 (shen.tls SynCons) (let Parseshen.<hterm> (shen.<hterm> News1864) (if (shen.parse-failure? Parseshen.<hterm>) (shen.parse-failure) (if (shen.=hd? Parseshen.<hterm> +) (let News1865 (shen.tls Parseshen.<hterm>) (let Parseshen.<end> (shen.<end> News1865) (if (shen.parse-failure? Parseshen.<end>) (shen.parse-failure) (shen.comb (shen.in-> (shen.tlstream V2081)) (cons shen.+m (cons (shen.<-out Parseshen.<hterm>) ())))))) (shen.parse-failure))))) (shen.parse-failure))) (shen.parse-failure)) (if (shen.parse-failure? Result) (let Result (if (shen.ccons? V2081) (let SynCons (shen.comb (shen.hds V2081) (shen.<-out V2081)) (if (shen.=hd? SynCons mode) (let News1866 (shen.tls SynCons) (let Parseshen.<hterm> (shen.<hterm> News1866) (if (shen.parse-failure? Parseshen.<hterm>) (shen.parse-failure) (if (shen.=hd? Parseshen.<hterm> -) (let News1867 (shen.tls Parseshen.<hterm>) (let Parseshen.<end> (shen.<end> News1867) (if (shen.parse-failure? Parseshen.<end>) (shen.parse-failure) (shen.comb (shen.in-> (shen.tlstream V2081)) (cons shen.-m (cons (shen.<-out Parseshen.<hterm>) ())))))) (shen.parse-failure))))) (shen.parse-failure))) (shen.parse-failure)) (if (shen.parse-failure? Result) (shen.parse-failure) Result)) Result)) Result)) Result)) Result)) Result)) Result)))

(defun shen.prolog-keyword? (V2082) (element? V2082 (cons (intern ";") (cons <-- ()))))

(defun atom? (V2083) (or (symbol? V2083) (or (string? V2083) (or (boolean? V2083) (or (number? V2083) (empty? V2083))))))

(defun shen.<hterm1> (V2084) (let Result (let Parseshen.<hterm> (shen.<hterm> V2084) (if (shen.parse-failure? Parseshen.<hterm>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<hterm>) (shen.<-out Parseshen.<hterm>)))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.<hterm2> (V2085) (let Result (let Parseshen.<hterm> (shen.<hterm> V2085) (if (shen.parse-failure? Parseshen.<hterm>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<hterm>) (shen.<-out Parseshen.<hterm>)))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.<body> (V2086) (let Result (let Parseshen.<literal> (shen.<literal> V2086) (if (shen.parse-failure? Parseshen.<literal>) (shen.parse-failure) (let Parseshen.<body> (shen.<body> Parseshen.<literal>) (if (shen.parse-failure? Parseshen.<body>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<body>) (cons (shen.<-out Parseshen.<literal>) (shen.<-out Parseshen.<body>))))))) (if (shen.parse-failure? Result) (let Result (let Parse<e> (<e> V2086) (if (shen.parse-failure? Parse<e>) (shen.parse-failure) (shen.comb (shen.in-> Parse<e>) ()))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)) Result)))

(defun shen.<literal> (V2087) (let Result (if (shen.=hd? V2087 !) (let News1872 (shen.tls V2087) (shen.comb (shen.in-> News1872) !)) (shen.parse-failure)) (if (shen.parse-failure? Result) (let Result (if (shen.ccons? V2087) (let SynCons (shen.comb (shen.hds V2087) (shen.<-out V2087)) (let Parseshen.<bterms> (shen.<bterms> SynCons) (if (shen.parse-failure? Parseshen.<bterms>) (shen.parse-failure) (let Parseshen.<end> (shen.<end> Parseshen.<bterms>) (if (shen.parse-failure? Parseshen.<end>) (shen.parse-failure) (shen.comb (shen.in-> (shen.tlstream V2087)) (shen.<-out Parseshen.<bterms>))))))) (shen.parse-failure)) (if (shen.parse-failure? Result) (shen.parse-failure) Result)) Result)))

(defun shen.<bterms> (V2088) (let Result (let Parseshen.<bterm> (shen.<bterm> V2088) (if (shen.parse-failure? Parseshen.<bterm>) (shen.parse-failure) (let Parseshen.<bterms> (shen.<bterms> Parseshen.<bterm>) (if (shen.parse-failure? Parseshen.<bterms>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<bterms>) (cons (shen.<-out Parseshen.<bterm>) (shen.<-out Parseshen.<bterms>))))))) (if (shen.parse-failure? Result) (let Result (let Parse<e> (<e> V2088) (if (shen.parse-failure? Parse<e>) (shen.parse-failure) (shen.comb (shen.in-> Parse<e>) ()))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)) Result)))

(defun shen.<bterm> (V2089) (let Result (let Parseshen.<wildcard> (shen.<wildcard> V2089) (if (shen.parse-failure? Parseshen.<wildcard>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<wildcard>) (shen.<-out Parseshen.<wildcard>)))) (if (shen.parse-failure? Result) (let Result (if (shen.non-empty-stream? V2089) (let X (shen.hds V2089) (let News1875 (shen.tls V2089) (if (atom? X) (shen.comb (shen.in-> News1875) X) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? Result) (let Result (if (shen.ccons? V2089) (let SynCons (shen.comb (shen.hds V2089) (shen.<-out V2089)) (let Parseshen.<bterms> (shen.<bterms> SynCons) (if (shen.parse-failure? Parseshen.<bterms>) (shen.parse-failure) (let Parseshen.<end> (shen.<end> Parseshen.<bterms>) (if (shen.parse-failure? Parseshen.<end>) (shen.parse-failure) (shen.comb (shen.in-> (shen.tlstream V2089)) (shen.<-out Parseshen.<bterms>))))))) (shen.parse-failure)) (if (shen.parse-failure? Result) (shen.parse-failure) Result)) Result)) Result)))

(defun shen.<wildcard> (V2090) (let Result (if (shen.non-empty-stream? V2090) (let X (shen.hds V2090) (let News1877 (shen.tls V2090) (if (= X _) (shen.comb (shen.in-> News1877) (gensym (protect Y))) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.<sc> (V2091) (let Result (if (shen.non-empty-stream? V2091) (let X (shen.hds V2091) (let News1879 (shen.tls V2091) (if (shen.semicolon? X) (shen.comb (shen.in-> News1879) X) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.semicolon? (V2092) (= V2092 (intern ";")))

(defun shen.horn-clause-procedure (V2093 V2094) (let Bindings (gensym (protect B)) (let Lock (gensym (protect L)) (let Key (gensym (protect K)) (let Continuation (gensym (protect C)) (let Parameters (shen.prolog-parameters V2094) (let HasCut? (shen.hascut? V2094) (let FBody (shen.prolog-fbody V2094 Parameters Bindings Lock Key Continuation HasCut?) (let CutFBody (if HasCut? (cons let (cons Key (cons (cons + (cons Key (cons 1 ()))) (cons FBody ())))) FBody) (let Shen (cons define (cons V2093 (append Parameters (append (cons Bindings (cons Lock (cons Key (cons Continuation (cons -> ()))))) (cons CutFBody ()))))) Shen))))))))))

(defun shen.hascut? (V2097) (cond ((= ! V2097) true) ((cons? V2097) (or (shen.hascut? (hd V2097)) (shen.hascut? (tl V2097)))) (true false)))

(defun shen.prolog-parameters (V2102) (cond ((and (cons? V2102) (cons? (hd V2102))) (shen.parameters (length (hd (hd V2102))))) (true (shen.f-error shen.prolog-parameters))))

(defun shen.prolog-fbody (V2123 V2124 V2125 V2126 V2127 V2128 V2129) (cond ((and (= () V2123) (= true V2129)) (cons shen.unlock (cons V2126 (cons V2127 ())))) ((and (cons? V2123) (and (cons? (hd V2123)) (and (cons? (tl (hd V2123))) (and (= () (tl (tl (hd V2123)))) (and (= () (tl V2123)) (= false V2129)))))) (let Continue (shen.continue (hd (hd V2123)) (hd (tl (hd V2123))) V2125 V2126 V2127 V2128) (cons if (cons (cons shen.unlocked? (cons V2126 ())) (cons (shen.compile-head shen.+m (hd (hd V2123)) V2124 V2125 Continue) (cons false ())))))) ((and (cons? V2123) (and (cons? (hd V2123)) (and (cons? (tl (hd V2123))) (= () (tl (tl (hd V2123))))))) (let Case (protect (gensym C)) (let Continue (shen.continue (hd (hd V2123)) (hd (tl (hd V2123))) V2125 V2126 V2127 V2128) (cons let (cons Case (cons (cons if (cons (cons shen.unlocked? (cons V2126 ())) (cons (shen.compile-head shen.+m (hd (hd V2123)) V2124 V2125 Continue) (cons false ())))) (cons (cons if (cons (cons = (cons Case (cons false ()))) (cons (shen.prolog-fbody (tl V2123) V2124 V2125 V2126 V2127 V2128 V2129) (cons Case ())))) ()))))))) (true (simple-error "implementation error in shen.prolog-fbody"))))

(defun shen.unlock (V2130 V2131) (if (and (shen.locked? V2130) (shen.fits? V2131 V2130)) (shen.openlock V2130) false))

(defun shen.locked? (V2132) (not (shen.unlocked? V2132)))

(defun shen.unlocked? (V2133) (<-address V2133 1))

(defun shen.openlock (V2134) (do (address-> V2134 1 true) false))

(defun shen.fits? (V2135 V2136) (= V2135 (<-address V2136 2)))

(defun shen.cut (V2139 V2140 V2141 V2142) (let Compute (thaw V2142) (if (and (= Compute false) (shen.unlocked? V2140)) (shen.lock V2141 V2140) Compute)))

(defun shen.lock (V2143 V2144) (let SetLock (address-> V2144 1 false) (let SetKey (address-> V2144 2 V2143) false)))

(defun shen.continue (V2145 V2146 V2147 V2148 V2149 V2150) (let HVs (shen.extract-vars V2145) (let BVs (shen.extract-vars V2146) (let Free (difference BVs HVs) (let ContinuationCode (cons do (cons (cons shen.incinfs ()) (cons (shen.compile-body V2146 V2147 V2148 V2149 V2150) ()))) (shen.stpart Free ContinuationCode V2147))))))

(defun shen.compile-body (V2167 V2168 V2169 V2170 V2171) (cond ((= () V2167) (cons thaw (cons V2171 ()))) ((and (cons? V2167) (= ! (hd V2167))) (shen.compile-body (cons (cons shen.cut ()) (tl V2167)) V2168 V2169 V2170 V2171)) ((and (cons? V2167) (= () (tl V2167))) (append (shen.deref-calls (hd V2167) V2168) (cons V2168 (cons V2169 (cons V2170 (cons V2171 ())))))) ((cons? V2167) (let P* (shen.deref-calls (hd V2167) V2168) (append P* (cons V2168 (cons V2169 (cons V2170 (cons (shen.freeze-literals (tl V2167) V2168 V2169 V2170 V2171) ()))))))) (true (simple-error "implementation error in shen.compile-fbody"))))

(defun shen.freeze-literals (V2188 V2189 V2190 V2191 V2192) (cond ((= () V2188) V2192) ((and (cons? V2188) (= ! (hd V2188))) (shen.freeze-literals (cons (cons shen.cut ()) (tl V2188)) V2189 V2190 V2191 V2192)) ((cons? V2188) (let P* (shen.deref-calls (hd V2188) V2189) (cons freeze (cons (append P* (cons V2189 (cons V2190 (cons V2191 (cons (shen.freeze-literals (tl V2188) V2189 V2190 V2191 V2192) ()))))) ())))) (true (simple-error "implementation error in shen.freeze-literals"))))

(defun shen.deref-calls (V2197 V2198) (cond ((and (cons? V2197) (= fork (hd V2197))) (cons fork (cons (shen.deref-forked-literals (tl V2197) V2198) ()))) ((cons? V2197) (cons (hd V2197) (map (lambda Y (shen.function-calls Y V2198)) (tl V2197)))) (true (simple-error "implementation error in shen.deref-calls"))))

(defun shen.deref-forked-literals (V2205 V2206) (cond ((= () V2205) ()) ((cons? V2205) (cons cons (cons (shen.deref-calls (hd V2205) V2206) (cons (shen.deref-forked-literals (tl V2205) V2206) ())))) (true (simple-error "fork requires a list of literals
"))))

(defun shen.function-calls (V2209 V2210) (cond ((and (cons? V2209) (and (= cons (hd V2209)) (and (cons? (tl V2209)) (and (cons? (tl (tl V2209))) (= () (tl (tl (tl V2209)))))))) (cons cons (cons (shen.function-calls (hd (tl V2209)) V2210) (cons (shen.function-calls (hd (tl (tl V2209))) V2210) ())))) ((cons? V2209) (shen.deref-terms V2209 V2210)) (true V2209)))

(defun shen.deref-terms (V2215 V2216) (cond ((and (cons? V2215) (and (= 0 (hd V2215)) (and (cons? (tl V2215)) (= () (tl (tl V2215)))))) (if (variable? (hd (tl V2215))) (hd (tl V2215)) (simple-error (cn "attempt to optimise a non-variable " (shen.app (hd (tl V2215)) "
" shen.s))))) ((and (cons? V2215) (and (= 1 (hd V2215)) (and (cons? (tl V2215)) (= () (tl (tl V2215)))))) (if (variable? (hd (tl V2215))) (cons shen.lazyderef (cons (hd (tl V2215)) (cons V2216 ()))) (simple-error (cn "attempt to optimise a non-variable " (shen.app (hd (tl V2215)) "
" shen.s))))) ((variable? V2215) (cons shen.deref (cons V2215 (cons V2216 ())))) ((cons? V2215) (map (lambda Z (shen.deref-terms Z V2216)) V2215)) (true V2215)))

(defun shen.compile-head (V2234 V2235 V2236 V2237 V2238) (cond ((and (= () V2235) (= () V2236)) V2238) ((and (cons? V2235) (and (cons? (hd V2235)) (and (= shen.+m (hd (hd V2235))) (and (cons? (tl (hd V2235))) (= () (tl (tl (hd V2235)))))))) (shen.compile-head V2234 (cons shen.+m (cons (hd (tl (hd V2235))) (cons V2234 (tl V2235)))) V2236 V2237 V2238)) ((and (cons? V2235) (and (cons? (hd V2235)) (and (= shen.-m (hd (hd V2235))) (and (cons? (tl (hd V2235))) (= () (tl (tl (hd V2235)))))))) (shen.compile-head V2234 (cons shen.-m (cons (hd (tl (hd V2235))) (cons V2234 (tl V2235)))) V2236 V2237 V2238)) ((and (cons? V2235) (= shen.-m (hd V2235))) (shen.compile-head shen.-m (tl V2235) V2236 V2237 V2238)) ((and (cons? V2235) (= shen.+m (hd V2235))) (shen.compile-head shen.+m (tl V2235) V2236 V2237 V2238)) ((and (cons? V2235) (and (cons? V2236) (shen.wildcard? (hd V2235)))) (shen.compile-head V2234 (tl V2235) (tl V2236) V2237 V2238)) ((and (cons? V2235) (variable? (hd V2235))) (shen.variable-case V2234 V2235 V2236 V2237 V2238)) ((and (= shen.-m V2234) (and (cons? V2235) (atom? (hd V2235)))) (shen.atom-case-minus V2235 V2236 V2237 V2238)) ((and (= shen.-m V2234) (and (cons? V2235) (and (cons? (hd V2235)) (and (= cons (hd (hd V2235))) (and (cons? (tl (hd V2235))) (and (cons? (tl (tl (hd V2235)))) (= () (tl (tl (tl (hd V2235))))))))))) (shen.cons-case-minus V2235 V2236 V2237 V2238)) ((and (= shen.+m V2234) (and (cons? V2235) (atom? (hd V2235)))) (shen.atom-case-plus V2235 V2236 V2237 V2238)) ((and (= shen.+m V2234) (and (cons? V2235) (and (cons? (hd V2235)) (and (= cons (hd (hd V2235))) (and (cons? (tl (hd V2235))) (and (cons? (tl (tl (hd V2235)))) (= () (tl (tl (tl (hd V2235))))))))))) (shen.cons-case-plus V2235 V2236 V2237 V2238)) (true (simple-error "implementation error in shen.compile-head"))))

(defun shen.variable-case (V2249 V2250 V2251 V2252 V2253) (cond ((and (cons? V2250) (cons? V2251)) (if (variable? (hd V2251)) (shen.compile-head V2249 (tl V2250) (tl V2251) V2252 (subst (hd V2251) (hd V2250) V2253)) (cons let (cons (hd V2250) (cons (hd V2251) (cons (shen.compile-head V2249 (tl V2250) (tl V2251) V2252 V2253) ())))))) (true (simple-error "implementation error in shen.variable-case"))))

(defun shen.atom-case-minus (V2262 V2263 V2264 V2265) (cond ((and (cons? V2262) (cons? V2263)) (let Tm (gensym (protect Tm)) (cons let (cons Tm (cons (cons shen.lazyderef (cons (hd V2263) (cons V2264 ()))) (cons (cons if (cons (cons = (cons Tm (cons (hd V2262) ()))) (cons (shen.compile-head shen.-m (tl V2262) (tl V2263) V2264 V2265) (cons false ())))) ())))))) (true (simple-error "implementation error in shen.atom-case-minus"))))

(defun shen.cons-case-minus (V2274 V2275 V2276 V2277) (cond ((and (cons? V2274) (and (cons? (hd V2274)) (and (= cons (hd (hd V2274))) (and (cons? (tl (hd V2274))) (and (cons? (tl (tl (hd V2274)))) (and (= () (tl (tl (tl (hd V2274))))) (cons? V2275))))))) (let Tm (gensym (protect Tm)) (cons let (cons Tm (cons (cons shen.lazyderef (cons (hd V2275) (cons V2276 ()))) (cons (cons if (cons (cons cons? (cons Tm ())) (cons (shen.compile-head shen.-m (cons (hd (tl (hd V2274))) (cons (hd (tl (tl (hd V2274)))) (tl V2274))) (cons (cons hd (cons Tm ())) (cons (cons tl (cons Tm ())) (tl V2275))) V2276 V2277) (cons false ())))) ())))))) (true (simple-error "implementation error in shen.cons-case-minus"))))

(defun shen.atom-case-plus (V2286 V2287 V2288 V2289) (cond ((and (cons? V2286) (cons? V2287)) (let Tm (gensym (protect Tm)) (let GoTo (gensym (protect GoTo)) (cons let (cons Tm (cons (cons shen.lazyderef (cons (hd V2287) (cons V2288 ()))) (cons GoTo (cons (cons freeze (cons (shen.compile-head shen.+m (tl V2286) (tl V2287) V2288 V2289) ())) (cons (cons if (cons (cons = (cons Tm (cons (hd V2286) ()))) (cons (cons thaw (cons GoTo ())) (cons (cons if (cons (cons shen.pvar? (cons Tm ())) (cons (cons shen.bind! (cons Tm (cons (shen.demode (hd V2286)) (cons V2288 (cons GoTo ()))))) (cons false ())))) ())))) ()))))))))) (true (simple-error "implementation error in shen.atom-case-plus"))))

(defun shen.cons-case-plus (V2298 V2299 V2300 V2301) (cond ((and (cons? V2298) (and (cons? (hd V2298)) (and (= cons (hd (hd V2298))) (and (cons? (tl (hd V2298))) (and (cons? (tl (tl (hd V2298)))) (and (= () (tl (tl (tl (hd V2298))))) (cons? V2299))))))) (let Tm (gensym (protect Tm)) (let GoTo (gensym (protect GoTo)) (let Vars (shen.extract-vars (cons (hd (tl (hd V2298))) (hd (tl (tl (hd V2298)))))) (let Tame (shen.tame (hd V2298)) (let TVars (shen.extract-vars Tame) (cons let (cons Tm (cons (cons shen.lazyderef (cons (hd V2299) (cons V2300 ()))) (cons GoTo (cons (shen.goto Vars (shen.compile-head shen.+m (tl V2298) (tl V2299) V2300 V2301)) (cons (cons if (cons (cons cons? (cons Tm ())) (cons (shen.compile-head shen.+m (tl (hd V2298)) (cons (cons hd (cons Tm ())) (cons (cons tl (cons Tm ())) ())) V2300 (shen.invoke GoTo Vars)) (cons (cons if (cons (cons shen.pvar? (cons Tm ())) (cons (shen.stpart TVars (cons shen.bind! (cons Tm (cons (shen.demode Tame) (cons V2300 (cons (cons freeze (cons (shen.invoke GoTo Vars) ())) ()))))) V2300) (cons false ())))) ())))) ())))))))))))) (true (simple-error "implementation error in shen.cons-case-plus"))))

(defun shen.demode (V2302) (cond ((and (cons? V2302) (and (= shen.+m (hd V2302)) (and (cons? (tl V2302)) (= () (tl (tl V2302)))))) (shen.demode (hd (tl V2302)))) ((and (cons? V2302) (and (= shen.-m (hd V2302)) (and (cons? (tl V2302)) (= () (tl (tl V2302)))))) (shen.demode (hd (tl V2302)))) ((cons? V2302) (map (lambda Z (shen.demode Z)) V2302)) (true V2302)))

(defun shen.tame (V2303) (cond ((shen.wildcard? V2303) (gensym (protect Y))) ((cons? V2303) (map (lambda Z (shen.tame Z)) V2303)) (true V2303)))

(defun shen.goto (V2304 V2305) (cond ((= () V2304) (cons freeze (cons V2305 ()))) (true (shen.goto-h V2304 V2305))))

(defun shen.goto-h (V2306 V2307) (cond ((= () V2306) V2307) ((cons? V2306) (cons lambda (cons (hd V2306) (cons (shen.goto-h (tl V2306) V2307) ())))) (true (shen.f-error shen.goto-h))))

(defun shen.invoke (V2308 V2309) (cond ((= () V2309) (cons thaw (cons V2308 ()))) (true (cons V2308 V2309))))

(defun shen.wildcard? (V2310) (= V2310 _))

(defun shen.pvar? (V2311) (trap-error (and (absvector? V2311) (= (<-address V2311 0) shen.pvar)) (lambda E false)))

(defun shen.lazyderef (V2312 V2313) (if (shen.pvar? V2312) (let Value (<-address V2313 (<-address V2312 1)) (if (= Value shen.-null-) V2312 (shen.lazyderef Value V2313))) V2312))

(defun shen.deref (V2314 V2315) (cond ((cons? V2314) (cons (shen.deref (hd V2314) V2315) (shen.deref (tl V2314) V2315))) (true (if (shen.pvar? V2314) (let Value (<-address V2315 (<-address V2314 1)) (if (= Value shen.-null-) V2314 (shen.deref Value V2315))) V2314))))

(defun shen.bind! (V2316 V2317 V2318 V2319) (let Bind (shen.bindv V2316 V2317 V2318) (let Compute (thaw V2319) (if (= Compute false) (shen.unwind V2316 V2318 Compute) Compute))))

(defun shen.bindv (V2320 V2321 V2322) (address-> V2322 (<-address V2320 1) V2321))

(defun shen.unwind (V2323 V2324 V2325) (do (address-> V2324 (<-address V2323 1) shen.-null-) V2325))

(defun shen.stpart (V2334 V2335 V2336) (cond ((= () V2334) V2335) ((cons? V2334) (cons let (cons (hd V2334) (cons (cons shen.newpv (cons V2336 ())) (cons (cons shen.gc (cons V2336 (cons (shen.stpart (tl V2334) V2335 V2336) ()))) ()))))) (true (simple-error "implementation error in shen.stpart"))))

(defun shen.gc (V2337 V2338) (if (= V2338 false) (let N (shen.ticket-number V2337) (do (shen.decrement-ticket N V2337) V2338)) V2338))

(defun shen.decrement-ticket (V2339 V2340) (address-> V2340 1 (- V2339 1)))

(defun shen.newpv (V2341) (let N (shen.ticket-number V2341) (let NewBindings (shen.make-prolog-variable N) (let NextTicket (shen.nextticket V2341 N) NewBindings))))

(defun shen.ticket-number (V2342) (<-address V2342 1))

(defun shen.nextticket (V2343 V2344) (let NewVector (address-> V2343 V2344 shen.-null-) (address-> NewVector 1 (+ V2344 1))))

(defun shen.make-prolog-variable (V2345) (address-> (address-> (absvector 2) 0 shen.pvar) 1 V2345))

(defun shen.pvar (V2346) (cn "Var" (shen.app (<-address V2346 1) "" shen.a)))

(defun shen.incinfs () (set shen.*infs* (+ 1 (value shen.*infs*))))

(defun shen.prolog-vector-size (V2347) (if (and (integer? V2347) (> V2347 0)) (set shen.*size-prolog-vector* V2347) (simple-error (cn "prolog vector size: size should be a positive integer; not " (shen.app V2347 "" shen.a)))))

(defun shen.lzy=! (V2359 V2360 V2361 V2362) (cond ((= V2359 V2360) (thaw V2362)) ((and (shen.pvar? V2359) (not (shen.occurs? V2359 (shen.deref V2360 V2361)))) (shen.bind! V2359 V2360 V2361 V2362)) ((and (shen.pvar? V2360) (not (shen.occurs? V2360 (shen.deref V2359 V2361)))) (shen.bind! V2360 V2359 V2361 V2362)) ((and (cons? V2359) (cons? V2360)) (shen.lzy=! (shen.lazyderef (hd V2359) V2361) (shen.lazyderef (hd V2360) V2361) V2361 (freeze (shen.lzy=! (shen.lazyderef (tl V2359) V2361) (shen.lazyderef (tl V2360) V2361) V2361 V2362)))) (true false)))

(defun shen.lzy= (V2374 V2375 V2376 V2377) (cond ((= V2374 V2375) (thaw V2377)) ((shen.pvar? V2374) (shen.bind! V2374 V2375 V2376 V2377)) ((shen.pvar? V2375) (shen.bind! V2375 V2374 V2376 V2377)) ((and (cons? V2374) (cons? V2375)) (shen.lzy= (shen.lazyderef (hd V2374) V2376) (shen.lazyderef (hd V2375) V2376) V2376 (freeze (shen.lzy= (shen.lazyderef (tl V2374) V2376) (shen.lazyderef (tl V2375) V2376) V2376 V2377)))) (true false)))

(defun shen.occurs? (V2383 V2384) (cond ((= V2383 V2384) true) ((cons? V2384) (or (shen.occurs? V2383 (hd V2384)) (shen.occurs? V2383 (tl V2384)))) (true false)))

(defun call (V2385 V2386 V2387 V2388 V2389) ((((V2385 V2386) V2387) V2388) V2389))

(defun return (V2396 V2397 V2398 V2399 V2400) (shen.deref V2396 V2397))

(defun when (V2407 V2408 V2409 V2410 V2411) (if V2407 (thaw V2411) false))

(defun is (V2412 V2413 V2414 V2415 V2416 V2417) (shen.lzy= (shen.lazyderef V2412 V2414) (shen.lazyderef V2413 V2414) V2414 V2417))

(defun is! (V2418 V2419 V2420 V2421 V2422 V2423) (shen.lzy=! (shen.lazyderef V2418 V2420) (shen.lazyderef V2419 V2420) V2420 V2423))

(defun bind (V2428 V2429 V2430 V2431 V2432 V2433) (shen.bind! V2428 V2429 V2430 V2433))

(defun var? (V2434 V2435 V2436 V2437 V2438) (if (shen.pvar? (shen.lazyderef V2434 V2435)) (thaw V2438) false))

(defun shen.print-prolog-vector (V2441) "|prolog vector|")

(defun fork (V2460 V2461 V2462 V2463 V2464) (cond ((= () V2460) false) ((cons? V2460) (let Case (((((hd V2460) V2461) V2462) V2463) V2464) (if (= Case false) (fork (tl V2460) V2461 V2462 V2463 V2464) Case))) (true (simple-error "fork expects a list of literals
"))))

(defun findall (V2465 V2466 V2467 V2468 V2469 V2470 V2471) (if (shen.unlocked? V2469) (let Store (shen.newpv V2468) (shen.gc V2468 (do (shen.incinfs) (is Store () V2468 V2469 V2470 (freeze (shen.findall-h V2465 V2466 V2467 Store V2468 V2469 V2470 V2471)))))) false))

(defun shen.findall-h (V2472 V2473 V2474 V2475 V2476 V2477 V2478 V2479) (let C1896 (if (shen.unlocked? V2477) (do (shen.incinfs) (call V2473 V2476 V2477 V2478 (freeze (shen.overbind V2472 V2475 V2476 V2477 V2478 V2479)))) false) (if (= C1896 false) (if (shen.unlocked? V2477) (do (shen.incinfs) (is! V2474 V2475 V2476 V2477 V2478 V2479)) false) C1896)))

(defun shen.overbind (V2486 V2487 V2488 V2489 V2490 V2491) (do (shen.bindv V2487 (cons (shen.deref V2486 V2488) (shen.lazyderef V2487 V2488)) V2488) false))

(defun occurs-check (V2494) (cond ((= + V2494) (set shen.*occurs* true)) ((= - V2494) (set shen.*occurs* false)) (true (simple-error "occurs-check expects a + or a -.
"))))

(defun read-file (V2728) (let Bytelist (read-file-as-bytelist V2728) (let S-exprs (trap-error (compile (lambda X (shen.<s-exprs> X)) Bytelist) (lambda E (shen.print-residue (value shen.*residue*)))) (let Process (shen.process-sexprs S-exprs) Process))))

(defun shen.print-residue (V2729) (let Err (pr "syntax error here:
" (stoutput)) (shen.nchars 50 V2729)))

(defun shen.nchars (V2734 V2735) (cond ((= 0 V2734) (do (pr " ..." (stoutput)) (abort))) ((= () V2735) (do (pr " ..." (stoutput)) (abort))) ((cons? V2735) (do (pr (n->string (hd V2735)) (stoutput)) (shen.nchars (- V2734 1) (tl V2735)))) (true (shen.f-error shen.nchars))))

(defun it () (value shen.*it*))

(defun read-file-as-bytelist (V2736) (let Stream (open V2736 in) (let Byte (read-byte Stream) (let Bytes (shen.read-file-as-bytelist-help Stream Byte ()) (let Close (close Stream) (reverse Bytes))))))

(defun shen.read-file-as-bytelist-help (V2737 V2738 V2739) (cond ((= -1 V2738) V2739) (true (shen.read-file-as-bytelist-help V2737 (read-byte V2737) (cons V2738 V2739)))))

(defun read-file-as-string (V2740) (let Stream (open V2740 in) (shen.rfas-h Stream (read-byte Stream) "")))

(defun shen.rfas-h (V2741 V2742 V2743) (cond ((= -1 V2742) (do (close V2741) V2743)) (true (shen.rfas-h V2741 (read-byte V2741) (cn V2743 (n->string V2742))))))

(defun input (V2744) (eval-kl (read V2744)))

(defun input+ (V2745 V2746) (let Mono? (shen.monotype V2745) (let Input (read V2746) (if (= false (shen.typecheck Input (shen.rectify-type V2745))) (simple-error (cn "type error: " (shen.app Input (cn " is not of type " (shen.app V2745 "
" shen.r)) shen.r))) (eval-kl Input)))))

(defun shen.monotype (V2747) (cond ((cons? V2747) (map (lambda Z (shen.monotype Z)) V2747)) (true (if (variable? V2747) (simple-error (cn "input+ expects a monotype: not " (shen.app V2747 "
" shen.a))) V2747))))

(defun lineread (V2748) (shen.read-loop V2748 (shen.my-read-byte V2748) () (lambda X (shen.return? X))))

(defun read-from-string (V2749) (let Bytelist (shen.str->bytes V2749) (let S-exprs (compile (lambda X (shen.<s-exprs> X)) Bytelist) (let Process (shen.process-sexprs S-exprs) Process))))

(defun read-from-string-unprocessed (V2750) (let Bytelist (shen.str->bytes V2750) (let S-exprs (compile (lambda X (shen.<s-exprs> X)) Bytelist) S-exprs)))

(defun shen.str->bytes (V2751) (cond ((= "" V2751) ()) ((shen.+string? V2751) (cons (string->n (hdstr V2751)) (shen.str->bytes (tlstr V2751)))) (true (shen.f-error shen.str->bytes))))

(defun read (V2752) (hd (shen.read-loop V2752 (shen.my-read-byte V2752) () (lambda X (shen.whitespace? X)))))

(defun shen.my-read-byte (V2753) (if (shen.char-stinput? V2753) (string->n (shen.read-unit-string V2753)) (read-byte V2753)))

(defun shen.read-loop (V2758 V2759 V2760 V2761) (cond ((= 94 V2759) (simple-error "read aborted")) ((= -1 V2759) (if (empty? V2760) (simple-error "error: empty stream") (compile (lambda X (shen.<s-exprs> X)) V2760))) ((= 0 V2759) (shen.read-loop V2758 (shen.my-read-byte V2758) V2760 V2761)) (true (if (V2761 V2759) (let Parse (shen.try-parse V2760) (if (shen.nothing-doing? Parse) (shen.read-loop V2758 (shen.my-read-byte V2758) (append V2760 (cons V2759 ())) V2761) (do (shen.record-it V2760) Parse))) (shen.read-loop V2758 (shen.my-read-byte V2758) (append V2760 (cons V2759 ())) V2761)))))

(defun shen.try-parse (V2762) (let S-exprs (trap-error (compile (lambda X (shen.<s-exprs> X)) V2762) (lambda E shen.i-failed!)) (if (shen.nothing-doing? S-exprs) shen.i-failed! (shen.process-sexprs S-exprs))))

(defun shen.nothing-doing? (V2765) (cond ((= shen.i-failed! V2765) true) ((= () V2765) true) (true false)))

(defun shen.record-it (V2766) (set shen.*it* (shen.bytes->string V2766)))

(defun shen.bytes->string (V2767) (cond ((= () V2767) "") ((cons? V2767) (cn (n->string (hd V2767)) (shen.bytes->string (tl V2767)))) (true (shen.f-error shen.bytes->string))))

(defun shen.process-sexprs (V2768) (let Unpack&Expand (shen.unpackage&macroexpand V2768) (let FindArities (shen.find-arities Unpack&Expand) (let Types (shen.find-types Unpack&Expand) (map (lambda X (shen.process-applications X Types)) Unpack&Expand)))))

(defun shen.find-types (V2769) (cond ((and (cons? V2769) (and (cons? (tl V2769)) (= (hd V2769) (intern ":")))) (cons (hd (tl V2769)) (shen.find-types (tl (tl V2769))))) ((cons? V2769) (append (shen.find-types (hd V2769)) (shen.find-types (tl V2769)))) (true ())))

(defun shen.find-arities (V2772) (cond ((and (cons? V2772) (and (= define (hd V2772)) (and (cons? (tl V2772)) (and (cons? (tl (tl V2772))) (= { (hd (tl (tl V2772)))))))) (shen.store-arity (hd (tl V2772)) (shen.find-arity (hd (tl V2772)) 1 (tl (tl (tl V2772)))))) ((and (cons? V2772) (and (= define (hd V2772)) (cons? (tl V2772)))) (shen.store-arity (hd (tl V2772)) (shen.find-arity (hd (tl V2772)) 0 (tl (tl V2772))))) ((cons? V2772) (map (lambda Z (shen.find-arities Z)) V2772)) (true shen.skip)))

(defun shen.store-arity (V2773 V2774) (let ArityF (arity V2773) (if (= ArityF -1) (shen.execute-store-arity V2773 V2774) (if (= ArityF V2774) shen.skip (do (pr (cn "changing the arity of " (shen.app V2773 " may cause errors
" shen.a)) (stoutput)) (shen.execute-store-arity V2773 V2774))))))

(defun shen.execute-store-arity (V2775 V2776) (cond ((= 0 V2776) (put V2775 arity 0 (value *property-vector*))) (true (do (put V2775 arity V2776 (value *property-vector*)) (shen.update-lambdatable V2775 V2776)))))

(defun shen.update-lambdatable (V2777 V2778) (let LambdaTable (value shen.*lambdatable*) (let Lambda (eval-kl (shen.lambda-function (cons V2777 ()) V2778)) (let Insert (shen.assoc-> V2777 Lambda LambdaTable) (let Reset (set shen.*lambdatable* Insert) Reset)))))

(defun shen.lambda-function (V2781 V2782) (cond ((= 0 V2782) shen.skip) ((= 1 V2782) (let X (protect (gensym Y)) (cons lambda (cons X (cons (append V2781 (cons X ())) ()))))) (true (let X (protect (gensym Y)) (cons lambda (cons X (cons (shen.lambda-function (append V2781 (cons X ())) (- V2782 1)) ())))))))

(defun shen.assoc-> (V2792 V2793 V2794) (cond ((= () V2794) (cons (cons V2792 V2793) ())) ((and (cons? V2794) (and (cons? (hd V2794)) (= V2792 (hd (hd V2794))))) (cons (cons (hd (hd V2794)) V2793) (tl V2794))) ((cons? V2794) (cons (hd V2794) (shen.assoc-> V2792 V2793 (tl V2794)))) (true (simple-error "implementation error in shen.assoc->"))))

(defun shen.find-arity (V2809 V2810 V2811) (cond ((and (= 0 V2810) (and (cons? V2811) (= (hd V2811) ->))) 0) ((and (= 0 V2810) (and (cons? V2811) (= (hd V2811) <-))) 0) ((and (= 0 V2810) (cons? V2811)) (+ 1 (shen.find-arity V2809 0 (tl V2811)))) ((and (= 1 V2810) (and (cons? V2811) (= } (hd V2811)))) (shen.find-arity V2809 0 (tl V2811))) ((and (= 1 V2810) (cons? V2811)) (shen.find-arity V2809 1 (tl V2811))) ((= 1 V2810) (simple-error (cn "syntax error in " (shen.app V2809 " definition: missing }
" shen.a)))) (true (simple-error (cn "syntax error in " (shen.app V2809 " definition: missing -> or <-
" shen.a))))))

(defun shen.<s-exprs> (V2812) (let Result (let Parseshen.<lsb> (shen.<lsb> V2812) (if (shen.parse-failure? Parseshen.<lsb>) (shen.parse-failure) (let Parseshen.<s-exprs1> (shen.<s-exprs1> Parseshen.<lsb>) (if (shen.parse-failure? Parseshen.<s-exprs1>) (shen.parse-failure) (let Parseshen.<rsb> (shen.<rsb> Parseshen.<s-exprs1>) (if (shen.parse-failure? Parseshen.<rsb>) (shen.parse-failure) (let Parseshen.<s-exprs2> (shen.<s-exprs2> Parseshen.<rsb>) (if (shen.parse-failure? Parseshen.<s-exprs2>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<s-exprs2>) (cons (shen.cons-form (shen.<-out Parseshen.<s-exprs1>)) (shen.<-out Parseshen.<s-exprs2>))))))))))) (if (shen.parse-failure? Result) (let Result (let Parseshen.<lrb> (shen.<lrb> V2812) (if (shen.parse-failure? Parseshen.<lrb>) (shen.parse-failure) (let Parseshen.<s-exprs1> (shen.<s-exprs1> Parseshen.<lrb>) (if (shen.parse-failure? Parseshen.<s-exprs1>) (shen.parse-failure) (let Parseshen.<rrb> (shen.<rrb> Parseshen.<s-exprs1>) (if (shen.parse-failure? Parseshen.<rrb>) (shen.parse-failure) (let Parseshen.<s-exprs2> (shen.<s-exprs2> Parseshen.<rrb>) (if (shen.parse-failure? Parseshen.<s-exprs2>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<s-exprs2>) (shen.add-sexpr (shen.<-out Parseshen.<s-exprs1>) (shen.<-out Parseshen.<s-exprs2>))))))))))) (if (shen.parse-failure? Result) (let Result (let Parseshen.<lcurly> (shen.<lcurly> V2812) (if (shen.parse-failure? Parseshen.<lcurly>) (shen.parse-failure) (let Parseshen.<s-exprs> (shen.<s-exprs> Parseshen.<lcurly>) (if (shen.parse-failure? Parseshen.<s-exprs>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<s-exprs>) (cons { (shen.<-out Parseshen.<s-exprs>))))))) (if (shen.parse-failure? Result) (let Result (let Parseshen.<rcurly> (shen.<rcurly> V2812) (if (shen.parse-failure? Parseshen.<rcurly>) (shen.parse-failure) (let Parseshen.<s-exprs> (shen.<s-exprs> Parseshen.<rcurly>) (if (shen.parse-failure? Parseshen.<s-exprs>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<s-exprs>) (cons } (shen.<-out Parseshen.<s-exprs>))))))) (if (shen.parse-failure? Result) (let Result (let Parseshen.<bar> (shen.<bar> V2812) (if (shen.parse-failure? Parseshen.<bar>) (shen.parse-failure) (let Parseshen.<s-exprs> (shen.<s-exprs> Parseshen.<bar>) (if (shen.parse-failure? Parseshen.<s-exprs>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<s-exprs>) (cons bar! (shen.<-out Parseshen.<s-exprs>))))))) (if (shen.parse-failure? Result) (let Result (let Parseshen.<semicolon> (shen.<semicolon> V2812) (if (shen.parse-failure? Parseshen.<semicolon>) (shen.parse-failure) (let Parseshen.<s-exprs> (shen.<s-exprs> Parseshen.<semicolon>) (if (shen.parse-failure? Parseshen.<s-exprs>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<s-exprs>) (cons (intern ";") (shen.<-out Parseshen.<s-exprs>))))))) (if (shen.parse-failure? Result) (let Result (let Parseshen.<colon> (shen.<colon> V2812) (if (shen.parse-failure? Parseshen.<colon>) (shen.parse-failure) (let Parseshen.<equal> (shen.<equal> Parseshen.<colon>) (if (shen.parse-failure? Parseshen.<equal>) (shen.parse-failure) (let Parseshen.<s-exprs> (shen.<s-exprs> Parseshen.<equal>) (if (shen.parse-failure? Parseshen.<s-exprs>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<s-exprs>) (cons (intern ":=") (shen.<-out Parseshen.<s-exprs>))))))))) (if (shen.parse-failure? Result) (let Result (let Parseshen.<colon> (shen.<colon> V2812) (if (shen.parse-failure? Parseshen.<colon>) (shen.parse-failure) (let Parseshen.<s-exprs> (shen.<s-exprs> Parseshen.<colon>) (if (shen.parse-failure? Parseshen.<s-exprs>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<s-exprs>) (cons (intern ":") (shen.<-out Parseshen.<s-exprs>))))))) (if (shen.parse-failure? Result) (let Result (let Parseshen.<comma> (shen.<comma> V2812) (if (shen.parse-failure? Parseshen.<comma>) (shen.parse-failure) (let Parseshen.<s-exprs> (shen.<s-exprs> Parseshen.<comma>) (if (shen.parse-failure? Parseshen.<s-exprs>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<s-exprs>) (cons (intern ",") (shen.<-out Parseshen.<s-exprs>))))))) (if (shen.parse-failure? Result) (let Result (let Parseshen.<comment> (shen.<comment> V2812) (if (shen.parse-failure? Parseshen.<comment>) (shen.parse-failure) (let Parseshen.<s-exprs> (shen.<s-exprs> Parseshen.<comment>) (if (shen.parse-failure? Parseshen.<s-exprs>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<s-exprs>) (shen.<-out Parseshen.<s-exprs>)))))) (if (shen.parse-failure? Result) (let Result (let Parseshen.<atom> (shen.<atom> V2812) (if (shen.parse-failure? Parseshen.<atom>) (shen.parse-failure) (let Parseshen.<s-exprs> (shen.<s-exprs> Parseshen.<atom>) (if (shen.parse-failure? Parseshen.<s-exprs>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<s-exprs>) (cons (shen.<-out Parseshen.<atom>) (shen.<-out Parseshen.<s-exprs>))))))) (if (shen.parse-failure? Result) (let Result (let Parseshen.<whitespaces> (shen.<whitespaces> V2812) (if (shen.parse-failure? Parseshen.<whitespaces>) (shen.parse-failure) (let Parseshen.<s-exprs> (shen.<s-exprs> Parseshen.<whitespaces>) (if (shen.parse-failure? Parseshen.<s-exprs>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<s-exprs>) (shen.<-out Parseshen.<s-exprs>)))))) (if (shen.parse-failure? Result) (let Result (let Parse<e> (<e> V2812) (if (shen.parse-failure? Parse<e>) (shen.parse-failure) (shen.comb (shen.in-> Parse<e>) ()))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)) Result)) Result)) Result)) Result)) Result)) Result)) Result)) Result)) Result)) Result)) Result)) Result)))

(defun shen.add-sexpr (V2813 V2814) (cond ((and (cons? V2813) (and (= $ (hd V2813)) (and (cons? (tl V2813)) (= () (tl (tl V2813)))))) (append (explode (hd (tl V2813))) V2814)) (true (cons V2813 V2814))))

(defun shen.<lsb> (V2815) (let Result (if (shen.=hd? V2815 91) (let News2497 (shen.tls V2815) (shen.comb (shen.in-> News2497) shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.<rsb> (V2816) (let Result (if (shen.=hd? V2816 93) (let News2499 (shen.tls V2816) (shen.comb (shen.in-> News2499) shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.<s-exprs1> (V2817) (let Result (let Parseshen.<s-exprs> (shen.<s-exprs> V2817) (if (shen.parse-failure? Parseshen.<s-exprs>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<s-exprs>) (shen.<-out Parseshen.<s-exprs>)))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.<s-exprs2> (V2818) (let Result (let Parseshen.<s-exprs> (shen.<s-exprs> V2818) (if (shen.parse-failure? Parseshen.<s-exprs>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<s-exprs>) (shen.<-out Parseshen.<s-exprs>)))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.cons-form (V2820) (cond ((= () V2820) ()) ((and (cons? V2820) (and (cons? (tl V2820)) (and (cons? (tl (tl V2820))) (and (= () (tl (tl (tl V2820)))) (= (hd (tl V2820)) bar!))))) (cons cons (cons (hd V2820) (tl (tl V2820))))) ((and (cons? V2820) (and (cons? (tl V2820)) (and (cons? (tl (tl V2820))) (and (cons? (tl (tl (tl V2820)))) (= (hd (tl V2820)) bar!))))) (simple-error "misapplication of |
")) ((cons? V2820) (cons cons (cons (hd V2820) (cons (shen.cons-form (tl V2820)) ())))) (true (shen.f-error shen.cons-form))))

(defun shen.<lrb> (V2821) (let Result (if (shen.=hd? V2821 40) (let News2503 (shen.tls V2821) (shen.comb (shen.in-> News2503) shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.<rrb> (V2822) (let Result (if (shen.=hd? V2822 41) (let News2505 (shen.tls V2822) (shen.comb (shen.in-> News2505) shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.<lcurly> (V2823) (let Result (if (shen.=hd? V2823 123) (let News2507 (shen.tls V2823) (shen.comb (shen.in-> News2507) shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.<rcurly> (V2824) (let Result (if (shen.=hd? V2824 125) (let News2509 (shen.tls V2824) (shen.comb (shen.in-> News2509) shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.<bar> (V2825) (let Result (if (shen.=hd? V2825 124) (let News2511 (shen.tls V2825) (shen.comb (shen.in-> News2511) shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.<semicolon> (V2826) (let Result (if (shen.=hd? V2826 59) (let News2513 (shen.tls V2826) (shen.comb (shen.in-> News2513) shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.<colon> (V2827) (let Result (if (shen.=hd? V2827 58) (let News2515 (shen.tls V2827) (shen.comb (shen.in-> News2515) shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.<comma> (V2828) (let Result (if (shen.=hd? V2828 44) (let News2517 (shen.tls V2828) (shen.comb (shen.in-> News2517) shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.<equal> (V2829) (let Result (if (shen.=hd? V2829 61) (let News2519 (shen.tls V2829) (shen.comb (shen.in-> News2519) shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.<comment> (V2830) (let Result (let Parseshen.<singleline> (shen.<singleline> V2830) (if (shen.parse-failure? Parseshen.<singleline>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<singleline>) shen.skip))) (if (shen.parse-failure? Result) (let Result (let Parseshen.<multiline> (shen.<multiline> V2830) (if (shen.parse-failure? Parseshen.<multiline>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<multiline>) shen.skip))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)) Result)))

(defun shen.<singleline> (V2831) (let Result (let Parseshen.<backslash> (shen.<backslash> V2831) (if (shen.parse-failure? Parseshen.<backslash>) (shen.parse-failure) (let Parseshen.<backslash> (shen.<backslash> Parseshen.<backslash>) (if (shen.parse-failure? Parseshen.<backslash>) (shen.parse-failure) (let Parseshen.<shortnatters> (shen.<shortnatters> Parseshen.<backslash>) (if (shen.parse-failure? Parseshen.<shortnatters>) (shen.parse-failure) (let Parseshen.<returns> (shen.<returns> Parseshen.<shortnatters>) (if (shen.parse-failure? Parseshen.<returns>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<returns>) shen.skip))))))))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.<backslash> (V2832) (let Result (if (shen.=hd? V2832 92) (let News2523 (shen.tls V2832) (shen.comb (shen.in-> News2523) shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.<shortnatters> (V2833) (let Result (let Parseshen.<shortnatter> (shen.<shortnatter> V2833) (if (shen.parse-failure? Parseshen.<shortnatter>) (shen.parse-failure) (let Parseshen.<shortnatters> (shen.<shortnatters> Parseshen.<shortnatter>) (if (shen.parse-failure? Parseshen.<shortnatters>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<shortnatters>) shen.skip))))) (if (shen.parse-failure? Result) (let Result (let Parse<e> (<e> V2833) (if (shen.parse-failure? Parse<e>) (shen.parse-failure) (shen.comb (shen.in-> Parse<e>) shen.skip))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)) Result)))

(defun shen.<shortnatter> (V2834) (let Result (if (shen.non-empty-stream? V2834) (let Byte (shen.hds V2834) (let News2526 (shen.tls V2834) (if (not (shen.return? Byte)) (shen.comb (shen.in-> News2526) shen.skip) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.<returns> (V2835) (let Result (let Parseshen.<return> (shen.<return> V2835) (if (shen.parse-failure? Parseshen.<return>) (shen.parse-failure) (let Parseshen.<returns> (shen.<returns> Parseshen.<return>) (if (shen.parse-failure? Parseshen.<returns>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<returns>) shen.skip))))) (if (shen.parse-failure? Result) (let Result (let Parseshen.<return> (shen.<return> V2835) (if (shen.parse-failure? Parseshen.<return>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<return>) shen.skip))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)) Result)))

(defun shen.<return> (V2836) (let Result (if (shen.non-empty-stream? V2836) (let Byte (shen.hds V2836) (let News2529 (shen.tls V2836) (if (shen.return? Byte) (shen.comb (shen.in-> News2529) shen.skip) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.return? (V2837) (element? V2837 (cons 9 (cons 10 (cons 13 ())))))

(defun shen.<multiline> (V2838) (let Result (let Parseshen.<backslash> (shen.<backslash> V2838) (if (shen.parse-failure? Parseshen.<backslash>) (shen.parse-failure) (let Parseshen.<times> (shen.<times> Parseshen.<backslash>) (if (shen.parse-failure? Parseshen.<times>) (shen.parse-failure) (let Parseshen.<longnatter> (shen.<longnatter> Parseshen.<times>) (if (shen.parse-failure? Parseshen.<longnatter>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<longnatter>) shen.skip))))))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.<times> (V2839) (let Result (if (shen.=hd? V2839 42) (let News2532 (shen.tls V2839) (shen.comb (shen.in-> News2532) shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.<longnatter> (V2840) (let Result (let Parseshen.<comment> (shen.<comment> V2840) (if (shen.parse-failure? Parseshen.<comment>) (shen.parse-failure) (let Parseshen.<longnatter> (shen.<longnatter> Parseshen.<comment>) (if (shen.parse-failure? Parseshen.<longnatter>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<longnatter>) shen.skip))))) (if (shen.parse-failure? Result) (let Result (let Parseshen.<times> (shen.<times> V2840) (if (shen.parse-failure? Parseshen.<times>) (shen.parse-failure) (let Parseshen.<backslash> (shen.<backslash> Parseshen.<times>) (if (shen.parse-failure? Parseshen.<backslash>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<backslash>) shen.skip))))) (if (shen.parse-failure? Result) (let Result (if (shen.non-empty-stream? V2840) (let News2534 (shen.tls V2840) (let Parseshen.<longnatter> (shen.<longnatter> News2534) (if (shen.parse-failure? Parseshen.<longnatter>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<longnatter>) shen.skip)))) (shen.parse-failure)) (if (shen.parse-failure? Result) (shen.parse-failure) Result)) Result)) Result)))

(defun shen.<atom> (V2841) (let Result (let Parseshen.<str> (shen.<str> V2841) (if (shen.parse-failure? Parseshen.<str>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<str>) (shen.<-out Parseshen.<str>)))) (if (shen.parse-failure? Result) (let Result (let Parseshen.<number> (shen.<number> V2841) (if (shen.parse-failure? Parseshen.<number>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<number>) (shen.<-out Parseshen.<number>)))) (if (shen.parse-failure? Result) (let Result (let Parseshen.<sym> (shen.<sym> V2841) (if (shen.parse-failure? Parseshen.<sym>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<sym>) (if (= (shen.<-out Parseshen.<sym>) "<>") (cons vector (cons 0 ())) (intern (shen.<-out Parseshen.<sym>)))))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)) Result)) Result)))

(defun shen.<sym> (V2842) (let Result (let Parseshen.<alpha> (shen.<alpha> V2842) (if (shen.parse-failure? Parseshen.<alpha>) (shen.parse-failure) (let Parseshen.<alphanums> (shen.<alphanums> Parseshen.<alpha>) (if (shen.parse-failure? Parseshen.<alphanums>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<alphanums>) (cn (shen.<-out Parseshen.<alpha>) (shen.<-out Parseshen.<alphanums>))))))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.<alpha> (V2843) (let Result (if (shen.non-empty-stream? V2843) (let Byte (shen.hds V2843) (let News2538 (shen.tls V2843) (if (shen.alpha? Byte) (shen.comb (shen.in-> News2538) (n->string Byte)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.alpha? (V2844) (or (shen.lowercase? V2844) (or (shen.uppercase? V2844) (shen.misc? V2844))))

(defun shen.lowercase? (V2845) (and (>= V2845 97) (<= V2845 122)))

(defun shen.uppercase? (V2846) (and (>= V2846 65) (<= V2846 90)))

(defun shen.misc? (V2847) (element? V2847 (cons 61 (cons 45 (cons 42 (cons 47 (cons 43 (cons 95 (cons 63 (cons 36 (cons 33 (cons 64 (cons 126 (cons 46 (cons 62 (cons 60 (cons 38 (cons 37 (cons 39 (cons 35 (cons 96 ())))))))))))))))))))))

(defun shen.<alphanums> (V2848) (let Result (let Parseshen.<alphanum> (shen.<alphanum> V2848) (if (shen.parse-failure? Parseshen.<alphanum>) (shen.parse-failure) (let Parseshen.<alphanums> (shen.<alphanums> Parseshen.<alphanum>) (if (shen.parse-failure? Parseshen.<alphanums>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<alphanums>) (cn (shen.<-out Parseshen.<alphanum>) (shen.<-out Parseshen.<alphanums>))))))) (if (shen.parse-failure? Result) (let Result (let Parse<e> (<e> V2848) (if (shen.parse-failure? Parse<e>) (shen.parse-failure) (shen.comb (shen.in-> Parse<e>) ""))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)) Result)))

(defun shen.<alphanum> (V2849) (let Result (let Parseshen.<alpha> (shen.<alpha> V2849) (if (shen.parse-failure? Parseshen.<alpha>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<alpha>) (shen.<-out Parseshen.<alpha>)))) (if (shen.parse-failure? Result) (let Result (let Parseshen.<numeral> (shen.<numeral> V2849) (if (shen.parse-failure? Parseshen.<numeral>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<numeral>) (shen.<-out Parseshen.<numeral>)))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)) Result)))

(defun shen.<numeral> (V2850) (let Result (if (shen.non-empty-stream? V2850) (let Byte (shen.hds V2850) (let News2542 (shen.tls V2850) (if (shen.digit? Byte) (shen.comb (shen.in-> News2542) (n->string Byte)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.digit? (V2851) (and (>= V2851 48) (<= V2851 57)))

(defun shen.<str> (V2852) (let Result (let Parseshen.<dbq> (shen.<dbq> V2852) (if (shen.parse-failure? Parseshen.<dbq>) (shen.parse-failure) (let Parseshen.<strcontents> (shen.<strcontents> Parseshen.<dbq>) (if (shen.parse-failure? Parseshen.<strcontents>) (shen.parse-failure) (let Parseshen.<dbq> (shen.<dbq> Parseshen.<strcontents>) (if (shen.parse-failure? Parseshen.<dbq>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<dbq>) (shen.<-out Parseshen.<strcontents>)))))))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.<dbq> (V2853) (let Result (if (shen.=hd? V2853 34) (let News2545 (shen.tls V2853) (shen.comb (shen.in-> News2545) shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.<strcontents> (V2854) (let Result (let Parseshen.<strc> (shen.<strc> V2854) (if (shen.parse-failure? Parseshen.<strc>) (shen.parse-failure) (let Parseshen.<strcontents> (shen.<strcontents> Parseshen.<strc>) (if (shen.parse-failure? Parseshen.<strcontents>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<strcontents>) (cn (shen.<-out Parseshen.<strc>) (shen.<-out Parseshen.<strcontents>))))))) (if (shen.parse-failure? Result) (let Result (let Parse<e> (<e> V2854) (if (shen.parse-failure? Parse<e>) (shen.parse-failure) (shen.comb (shen.in-> Parse<e>) ""))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)) Result)))

(defun shen.<strc> (V2855) (let Result (let Parseshen.<control> (shen.<control> V2855) (if (shen.parse-failure? Parseshen.<control>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<control>) (shen.<-out Parseshen.<control>)))) (if (shen.parse-failure? Result) (let Result (let Parseshen.<notdbq> (shen.<notdbq> V2855) (if (shen.parse-failure? Parseshen.<notdbq>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<notdbq>) (shen.<-out Parseshen.<notdbq>)))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)) Result)))

(defun shen.<control> (V2856) (let Result (let Parseshen.<lowC> (shen.<lowC> V2856) (if (shen.parse-failure? Parseshen.<lowC>) (shen.parse-failure) (let Parseshen.<hash> (shen.<hash> Parseshen.<lowC>) (if (shen.parse-failure? Parseshen.<hash>) (shen.parse-failure) (let Parseshen.<integer> (shen.<integer> Parseshen.<hash>) (if (shen.parse-failure? Parseshen.<integer>) (shen.parse-failure) (let Parseshen.<semicolon> (shen.<semicolon> Parseshen.<integer>) (if (shen.parse-failure? Parseshen.<semicolon>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<semicolon>) (n->string (shen.<-out Parseshen.<integer>))))))))))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.<notdbq> (V2857) (let Result (if (shen.non-empty-stream? V2857) (let Byte (shen.hds V2857) (let News2550 (shen.tls V2857) (if (not (= Byte 34)) (shen.comb (shen.in-> News2550) (n->string Byte)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.<lowC> (V2858) (let Result (if (shen.=hd? V2858 99) (let News2552 (shen.tls V2858) (shen.comb (shen.in-> News2552) shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.<hash> (V2859) (let Result (if (shen.=hd? V2859 35) (let News2554 (shen.tls V2859) (shen.comb (shen.in-> News2554) shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.<number> (V2860) (let Result (let Parseshen.<minus> (shen.<minus> V2860) (if (shen.parse-failure? Parseshen.<minus>) (shen.parse-failure) (let Parseshen.<number> (shen.<number> Parseshen.<minus>) (if (shen.parse-failure? Parseshen.<number>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<number>) (- 0 (shen.<-out Parseshen.<number>))))))) (if (shen.parse-failure? Result) (let Result (let Parseshen.<plus> (shen.<plus> V2860) (if (shen.parse-failure? Parseshen.<plus>) (shen.parse-failure) (let Parseshen.<number> (shen.<number> Parseshen.<plus>) (if (shen.parse-failure? Parseshen.<number>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<number>) (shen.<-out Parseshen.<number>)))))) (if (shen.parse-failure? Result) (let Result (let Parseshen.<e-number> (shen.<e-number> V2860) (if (shen.parse-failure? Parseshen.<e-number>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<e-number>) (shen.<-out Parseshen.<e-number>)))) (if (shen.parse-failure? Result) (let Result (let Parseshen.<float> (shen.<float> V2860) (if (shen.parse-failure? Parseshen.<float>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<float>) (shen.<-out Parseshen.<float>)))) (if (shen.parse-failure? Result) (let Result (let Parseshen.<integer> (shen.<integer> V2860) (if (shen.parse-failure? Parseshen.<integer>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<integer>) (shen.<-out Parseshen.<integer>)))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)) Result)) Result)) Result)) Result)))

(defun shen.<minus> (V2861) (let Result (if (shen.=hd? V2861 45) (let News2557 (shen.tls V2861) (shen.comb (shen.in-> News2557) shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.<plus> (V2862) (let Result (if (shen.=hd? V2862 43) (let News2559 (shen.tls V2862) (shen.comb (shen.in-> News2559) shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.<integer> (V2863) (let Result (let Parseshen.<digits> (shen.<digits> V2863) (if (shen.parse-failure? Parseshen.<digits>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<digits>) (shen.compute-integer (shen.<-out Parseshen.<digits>))))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.<digits> (V2864) (let Result (let Parseshen.<digit> (shen.<digit> V2864) (if (shen.parse-failure? Parseshen.<digit>) (shen.parse-failure) (let Parseshen.<digits> (shen.<digits> Parseshen.<digit>) (if (shen.parse-failure? Parseshen.<digits>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<digits>) (cons (shen.<-out Parseshen.<digit>) (shen.<-out Parseshen.<digits>))))))) (if (shen.parse-failure? Result) (let Result (let Parseshen.<digit> (shen.<digit> V2864) (if (shen.parse-failure? Parseshen.<digit>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<digit>) (cons (shen.<-out Parseshen.<digit>) ())))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)) Result)))

(defun shen.<digit> (V2865) (let Result (if (shen.non-empty-stream? V2865) (let Byte (shen.hds V2865) (let News2563 (shen.tls V2865) (if (shen.digit? Byte) (shen.comb (shen.in-> News2563) (shen.byte->digit Byte)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.byte->digit (V2866) (- V2866 48))

(defun shen.compute-integer (V2867) (shen.compute-integer-h (reverse V2867) 0))

(defun shen.compute-integer-h (V2870 V2871) (cond ((= () V2870) 0) ((cons? V2870) (+ (* (shen.expt 10 V2871) (hd V2870)) (shen.compute-integer-h (tl V2870) (+ V2871 1)))) (true (shen.f-error shen.compute-integer-h))))

(defun shen.expt (V2874 V2875) (cond ((= 0 V2875) 1) ((> V2875 0) (* V2874 (shen.expt V2874 (- V2875 1)))) (true (/ (shen.expt V2874 (+ V2875 1)) V2874))))

(defun shen.<float> (V2876) (let Result (let Parseshen.<integer> (shen.<integer> V2876) (if (shen.parse-failure? Parseshen.<integer>) (shen.parse-failure) (let Parseshen.<stop> (shen.<stop> Parseshen.<integer>) (if (shen.parse-failure? Parseshen.<stop>) (shen.parse-failure) (let Parseshen.<fraction> (shen.<fraction> Parseshen.<stop>) (if (shen.parse-failure? Parseshen.<fraction>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<fraction>) (+ (shen.<-out Parseshen.<integer>) (shen.<-out Parseshen.<fraction>))))))))) (if (shen.parse-failure? Result) (let Result (let Parseshen.<stop> (shen.<stop> V2876) (if (shen.parse-failure? Parseshen.<stop>) (shen.parse-failure) (let Parseshen.<fraction> (shen.<fraction> Parseshen.<stop>) (if (shen.parse-failure? Parseshen.<fraction>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<fraction>) (shen.<-out Parseshen.<fraction>)))))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)) Result)))

(defun shen.<stop> (V2877) (let Result (if (shen.=hd? V2877 46) (let News2566 (shen.tls V2877) (shen.comb (shen.in-> News2566) shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.<fraction> (V2878) (let Result (let Parseshen.<digits> (shen.<digits> V2878) (if (shen.parse-failure? Parseshen.<digits>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<digits>) (shen.compute-fraction (shen.<-out Parseshen.<digits>))))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.compute-fraction (V2879) (shen.compute-fraction-h V2879 -1))

(defun shen.compute-fraction-h (V2882 V2883) (cond ((= () V2882) 0) ((cons? V2882) (+ (* (shen.expt 10 V2883) (hd V2882)) (shen.compute-fraction-h (tl V2882) (- V2883 1)))) (true (shen.f-error shen.compute-fraction-h))))

(defun shen.<e-number> (V2884) (let Result (let Parseshen.<float> (shen.<float> V2884) (if (shen.parse-failure? Parseshen.<float>) (shen.parse-failure) (let Parseshen.<lowE> (shen.<lowE> Parseshen.<float>) (if (shen.parse-failure? Parseshen.<lowE>) (shen.parse-failure) (let Parseshen.<log10> (shen.<log10> Parseshen.<lowE>) (if (shen.parse-failure? Parseshen.<log10>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<log10>) (shen.compute-E (shen.<-out Parseshen.<float>) (shen.<-out Parseshen.<log10>))))))))) (if (shen.parse-failure? Result) (let Result (let Parseshen.<integer> (shen.<integer> V2884) (if (shen.parse-failure? Parseshen.<integer>) (shen.parse-failure) (let Parseshen.<lowE> (shen.<lowE> Parseshen.<integer>) (if (shen.parse-failure? Parseshen.<lowE>) (shen.parse-failure) (let Parseshen.<log10> (shen.<log10> Parseshen.<lowE>) (if (shen.parse-failure? Parseshen.<log10>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<log10>) (shen.compute-E (shen.<-out Parseshen.<integer>) (shen.<-out Parseshen.<log10>))))))))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)) Result)))

(defun shen.<log10> (V2885) (let Result (let Parseshen.<plus> (shen.<plus> V2885) (if (shen.parse-failure? Parseshen.<plus>) (shen.parse-failure) (let Parseshen.<log10> (shen.<log10> Parseshen.<plus>) (if (shen.parse-failure? Parseshen.<log10>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<log10>) (shen.<-out Parseshen.<log10>)))))) (if (shen.parse-failure? Result) (let Result (let Parseshen.<minus> (shen.<minus> V2885) (if (shen.parse-failure? Parseshen.<minus>) (shen.parse-failure) (let Parseshen.<log10> (shen.<log10> Parseshen.<minus>) (if (shen.parse-failure? Parseshen.<log10>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<log10>) (- 0 (shen.<-out Parseshen.<log10>))))))) (if (shen.parse-failure? Result) (let Result (let Parseshen.<integer> (shen.<integer> V2885) (if (shen.parse-failure? Parseshen.<integer>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<integer>) (shen.<-out Parseshen.<integer>)))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)) Result)) Result)))

(defun shen.<lowE> (V2886) (let Result (if (shen.=hd? V2886 101) (let News2571 (shen.tls V2886) (shen.comb (shen.in-> News2571) shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.compute-E (V2887 V2888) (* V2887 (shen.expt 10 V2888)))

(defun shen.<whitespaces> (V2889) (let Result (let Parseshen.<whitespace> (shen.<whitespace> V2889) (if (shen.parse-failure? Parseshen.<whitespace>) (shen.parse-failure) (let Parseshen.<whitespaces> (shen.<whitespaces> Parseshen.<whitespace>) (if (shen.parse-failure? Parseshen.<whitespaces>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<whitespaces>) shen.skip))))) (if (shen.parse-failure? Result) (let Result (let Parseshen.<whitespace> (shen.<whitespace> V2889) (if (shen.parse-failure? Parseshen.<whitespace>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<whitespace>) shen.skip))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)) Result)))

(defun shen.<whitespace> (V2890) (let Result (if (shen.non-empty-stream? V2890) (let Byte (shen.hds V2890) (let News2574 (shen.tls V2890) (if (shen.whitespace? Byte) (shen.comb (shen.in-> News2574) shen.skip) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.whitespace? (V2893) (cond ((= 32 V2893) true) ((= 13 V2893) true) ((= 10 V2893) true) ((= 9 V2893) true) (true false)))

(defun shen.unpackage&macroexpand (V2894) (cond ((= () V2894) ()) ((and (cons? V2894) (shen.packaged? (hd V2894))) (shen.unpackage&macroexpand (append (shen.unpackage (hd V2894)) (tl V2894)))) ((cons? V2894) (let M (macroexpand (hd V2894)) (if (shen.packaged? M) (shen.unpackage&macroexpand (cons M (tl V2894))) (cons M (shen.unpackage&macroexpand (tl V2894)))))) (true (shen.f-error shen.unpackage&macroexpand))))

(defun shen.packaged? (V2897) (cond ((and (cons? V2897) (and (= package (hd V2897)) (and (cons? (tl V2897)) (cons? (tl (tl V2897)))))) true) (true false)))

(defun shen.unpackage (V2900) (cond ((and (cons? V2900) (and (= package (hd V2900)) (and (cons? (tl V2900)) (and (= null (hd (tl V2900))) (cons? (tl (tl V2900))))))) (tl (tl (tl V2900)))) ((and (cons? V2900) (and (= package (hd V2900)) (and (cons? (tl V2900)) (cons? (tl (tl V2900)))))) (let External! (eval (hd (tl (tl V2900)))) (let Package (shen.package-symbols (str (hd (tl V2900))) External! (tl (tl (tl V2900)))) (let RecordExternal (shen.record-external (hd (tl V2900)) External!) Package)))) (true (shen.f-error shen.unpackage))))

(defun shen.record-external (V2901 V2902) (let External (trap-error (get V2901 shen.external-symbols (value *property-vector*)) (lambda E ())) (put V2901 shen.external-symbols (union V2902 External) (value *property-vector*))))

(defun shen.package-symbols (V2907 V2908 V2909) (cond ((cons? V2909) (map (lambda X (shen.package-symbols V2907 V2908 X)) V2909)) ((shen.internal? V2909 V2907 V2908) (shen.intern-in-package V2907 V2909)) (true V2909)))

(defun shen.intern-in-package (V2910 V2911) (intern (@s V2910 (@s "." (str V2911)))))

(defun shen.internal? (V2912 V2913 V2914) (and (not (element? V2912 V2914)) (and (not (shen.sng? V2912)) (and (not (shen.dbl? V2912)) (and (symbol? V2912) (and (not (shen.sysfunc? V2912)) (and (not (variable? V2912)) (and (not (shen.internal-to-shen? (str V2912))) (not (shen.internal-to-P? V2913 (str V2912)))))))))))

(defun shen.internal-to-shen? (V2919) (cond ((and (shen.+string? V2919) (and (= "s" (hdstr V2919)) (and (shen.+string? (tlstr V2919)) (and (= "h" (hdstr (tlstr V2919))) (and (shen.+string? (tlstr (tlstr V2919))) (and (= "e" (hdstr (tlstr (tlstr V2919)))) (and (shen.+string? (tlstr (tlstr (tlstr V2919)))) (and (= "n" (hdstr (tlstr (tlstr (tlstr V2919))))) (and (shen.+string? (tlstr (tlstr (tlstr (tlstr V2919))))) (= "." (hdstr (tlstr (tlstr (tlstr (tlstr V2919))))))))))))))) true) (true false)))

(defun shen.sysfunc? (V2920) (element? V2920 (get shen shen.external-symbols (value *property-vector*))))

(defun shen.internal-to-P? (V2928 V2929) (cond ((and (= "" V2928) (and (shen.+string? V2929) (= "." (hdstr V2929)))) true) ((and (shen.+string? V2928) (and (shen.+string? V2929) (= (hdstr V2928) (hdstr V2929)))) (shen.internal-to-P? (tlstr V2928) (tlstr V2929))) (true false)))

(defun shen.process-applications (V2932 V2933) (cond ((element? V2932 V2933) V2932) ((and (cons? V2932) (shen.non-application? (hd V2932))) (shen.special-case (hd V2932) V2932 V2933)) ((cons? V2932) (shen.process-application (map (lambda Y (shen.process-applications Y V2933)) V2932) V2933)) (true V2932)))

(defun shen.non-application? (V2936) (cond ((= define V2936) true) ((= defun V2936) true) ((= synonyms V2936) true) ((shen.special? V2936) true) ((shen.extraspecial? V2936) true) (true false)))

(defun shen.special-case (V2941 V2942 V2943) (cond ((and (= lambda V2941) (and (cons? V2942) (and (= lambda (hd V2942)) (and (cons? (tl V2942)) (and (cons? (tl (tl V2942))) (= () (tl (tl (tl V2942))))))))) (cons lambda (cons (hd (tl V2942)) (cons (shen.process-applications (hd (tl (tl V2942))) V2943) ())))) ((and (= let V2941) (and (cons? V2942) (and (= let (hd V2942)) (and (cons? (tl V2942)) (and (cons? (tl (tl V2942))) (and (cons? (tl (tl (tl V2942)))) (= () (tl (tl (tl (tl V2942))))))))))) (cons let (cons (hd (tl V2942)) (cons (shen.process-applications (hd (tl (tl V2942))) V2943) (cons (shen.process-applications (hd (tl (tl (tl V2942)))) V2943) ()))))) ((and (= defun V2941) (and (cons? V2942) (and (= defun (hd V2942)) (and (cons? (tl V2942)) (and (cons? (tl (tl V2942))) (and (cons? (tl (tl (tl V2942)))) (= () (tl (tl (tl (tl V2942))))))))))) V2942) ((and (= define V2941) (and (cons? V2942) (and (= define (hd V2942)) (and (cons? (tl V2942)) (and (cons? (tl (tl V2942))) (= { (hd (tl (tl V2942))))))))) (cons define (cons (hd (tl V2942)) (cons { (shen.process-after-type (hd (tl V2942)) (tl (tl (tl V2942))) V2943))))) ((and (= define V2941) (and (cons? V2942) (and (= define (hd V2942)) (cons? (tl V2942))))) (cons define (cons (hd (tl V2942)) (map (lambda Y (shen.process-applications Y V2943)) (tl (tl V2942)))))) ((= synonyms V2941) (cons synonyms V2942)) ((and (= type V2941) (and (cons? V2942) (and (= type (hd V2942)) (and (cons? (tl V2942)) (and (cons? (tl (tl V2942))) (= () (tl (tl (tl V2942))))))))) (cons type (cons (shen.process-applications (hd (tl V2942)) V2943) (tl (tl V2942))))) ((and (= input+ V2941) (and (cons? V2942) (and (= input+ (hd V2942)) (and (cons? (tl V2942)) (and (cons? (tl (tl V2942))) (= () (tl (tl (tl V2942))))))))) (cons input+ (cons (hd (tl V2942)) (cons (shen.process-applications (hd (tl (tl V2942))) V2943) ())))) ((and (cons? V2942) (shen.special? (hd V2942))) (cons (hd V2942) (map (lambda Y (shen.process-applications Y V2943)) (tl V2942)))) ((and (cons? V2942) (shen.extraspecial? (hd V2942))) V2942) (true (shen.f-error shen.special-case))))

(defun shen.process-after-type (V2946 V2947 V2948) (cond ((and (cons? V2947) (= } (hd V2947))) (cons } (map (lambda Y (shen.process-applications Y V2948)) (tl V2947)))) ((cons? V2947) (cons (hd V2947) (shen.process-after-type V2946 (tl V2947) V2948))) (true (simple-error (cn "missing } in " (shen.app V2946 "
" shen.a))))))

(defun shen.process-application (V2949 V2950) (cond ((cons? V2949) (let ArityF (arity (hd V2949)) (let N (length (tl V2949)) (if (element? V2949 V2950) V2949 (if (shen.shen-call? (hd V2949)) V2949 (if (shen.fn-call? V2949) (shen.fn-call V2949) (if (shen.zero-place? V2949) V2949 (if (shen.undefined-f? (hd V2949) ArityF) (shen.simple-curry (cons (cons fn (cons (hd V2949) ())) (tl V2949))) (if (variable? (hd V2949)) (shen.simple-curry V2949) (if (shen.application? (hd V2949)) (shen.simple-curry V2949) (if (shen.partial-application*? (hd V2949) ArityF N) (shen.lambda-function V2949 (- ArityF N)) (if (shen.overapplication? (hd V2949) ArityF N) (shen.simple-curry V2949) V2949)))))))))))) (true (shen.f-error shen.process-application))))

(defun shen.zero-place? (V2953) (cond ((and (cons? V2953) (= () (tl V2953))) true) (true false)))

(defun shen.shen-call? (V2954) (and (symbol? V2954) (shen.internal-to-shen? (str V2954))))

(defun shen.internal-to-shen? (V2959) (cond ((and (shen.+string? V2959) (and (= "s" (hdstr V2959)) (and (shen.+string? (tlstr V2959)) (and (= "h" (hdstr (tlstr V2959))) (and (shen.+string? (tlstr (tlstr V2959))) (and (= "e" (hdstr (tlstr (tlstr V2959)))) (and (shen.+string? (tlstr (tlstr (tlstr V2959)))) (and (= "n" (hdstr (tlstr (tlstr (tlstr V2959))))) (and (shen.+string? (tlstr (tlstr (tlstr (tlstr V2959))))) (= "." (hdstr (tlstr (tlstr (tlstr (tlstr V2959))))))))))))))) true) (true false)))

(defun shen.application? (V2962) (cond ((and (cons? V2962) (and (= protect (hd V2962)) (and (cons? (tl V2962)) (= () (tl (tl V2962)))))) false) (true (cons? V2962))))

(defun shen.undefined-f? (V2967 V2968) (cond ((= -1 V2968) (and (shen.lowercase-symbol? V2967) (not (element? V2967 (external shen))))) (true false)))

(defun shen.lowercase-symbol? (V2969) (and (symbol? V2969) (not (variable? V2969))))

(defun shen.simple-curry (V2970) (cond ((and (cons? V2970) (and (cons? (tl V2970)) (= () (tl (tl V2970))))) V2970) ((and (cons? V2970) (and (cons? (tl V2970)) (cons? (tl (tl V2970))))) (shen.simple-curry (cons (cons (hd V2970) (cons (hd (tl V2970)) ())) (tl (tl V2970))))) (true V2970)))

(defun function (V2971) (fn V2971))

(defun fn (V2972) (let LookUp (assoc V2972 (value shen.*lambdatable*)) (if (empty? LookUp) (simple-error (cn "fn: " (shen.app V2972 " is undefined
" shen.a))) (tl LookUp))))

(defun shen.fn-call? (V2975) (cond ((and (cons? V2975) (and (= fn (hd V2975)) (and (cons? (tl V2975)) (= () (tl (tl V2975)))))) true) ((and (cons? V2975) (and (= function (hd V2975)) (and (cons? (tl V2975)) (= () (tl (tl V2975)))))) true) (true false)))

(defun shen.fn-call (V2976) (cond ((and (cons? V2976) (and (= function (hd V2976)) (and (cons? (tl V2976)) (= () (tl (tl V2976)))))) (shen.fn-call (cons fn (tl V2976)))) ((and (cons? V2976) (and (= fn (hd V2976)) (and (cons? (tl V2976)) (= () (tl (tl V2976)))))) (let ArityF (arity (hd (tl V2976))) (if (= ArityF -1) V2976 (if (= ArityF 0) (simple-error "fn cannot be applied to a zero place function
") (shen.lambda-function (tl V2976) ArityF))))) (true (shen.f-error shen.fn-call))))

(defun shen.partial-application*? (V2977 V2978 V2979) (let Verdict (> V2978 V2979) (let Message (if (and Verdict (and (shen.loading?) (not (element? V2977 (cons + (cons - ())))))) (pr (cn "partial application of " (shen.app V2977 "
" shen.a)) (stoutput)) shen.skip) Verdict)))

(defun shen.loading? () (value shen.*loading?*))

(defun shen.overapplication? (V2984 V2985 V2986) (cond ((= -1 V2985) false) (true (let Verdict (< V2985 V2986) (let Message (if (and Verdict (shen.loading?)) (pr (shen.app V2984 (cn " might not like " (shen.app V2986 (cn " argument" (shen.app (if (= V2986 1) "" "s") "
" shen.a)) shen.a)) shen.a) (stoutput)) shen.skip) Verdict)))))

(defun shen.<datatype> (V3127) (let Result (if (shen.non-empty-stream? V3127) (let D (shen.hds V3127) (let News2988 (shen.tls V3127) (let Parseshen.<datatype-rules> (shen.<datatype-rules> News2988) (if (shen.parse-failure? Parseshen.<datatype-rules>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<datatype-rules>) (let Prolog (shen.rules->prolog D (shen.<-out Parseshen.<datatype-rules>)) (shen.remember-datatype D (fn D)))))))) (shen.parse-failure)) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.<datatype-rules> (V3128) (let Result (let Parseshen.<datatype-rule> (shen.<datatype-rule> V3128) (if (shen.parse-failure? Parseshen.<datatype-rule>) (shen.parse-failure) (let Parseshen.<datatype-rules> (shen.<datatype-rules> Parseshen.<datatype-rule>) (if (shen.parse-failure? Parseshen.<datatype-rules>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<datatype-rules>) (append (shen.<-out Parseshen.<datatype-rule>) (shen.<-out Parseshen.<datatype-rules>))))))) (if (shen.parse-failure? Result) (let Result (let Parse<!> (<!> V3128) (if (shen.parse-failure? Parse<!>) (shen.parse-failure) (shen.comb (shen.in-> Parse<!>) (if (empty? (shen.<-out Parse<!>)) () (simple-error (cn "datatype syntax error here:
 " (shen.app (shen.<-out Parse<!>) "
 ..." shen.r))))))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)) Result)))

(defun shen.<datatype-rule> (V3129) (let Result (let Parseshen.<single> (shen.<single> V3129) (if (shen.parse-failure? Parseshen.<single>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<single>) (shen.<-out Parseshen.<single>)))) (if (shen.parse-failure? Result) (let Result (let Parseshen.<double> (shen.<double> V3129) (if (shen.parse-failure? Parseshen.<double>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<double>) (shen.<-out Parseshen.<double>)))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)) Result)))

(defun shen.<single> (V3130) (let Result (let Parseshen.<sides> (shen.<sides> V3130) (if (shen.parse-failure? Parseshen.<sides>) (shen.parse-failure) (let Parseshen.<prems> (shen.<prems> Parseshen.<sides>) (if (shen.parse-failure? Parseshen.<prems>) (shen.parse-failure) (let Parseshen.<sng> (shen.<sng> Parseshen.<prems>) (if (shen.parse-failure? Parseshen.<sng>) (shen.parse-failure) (let Parseshen.<conc> (shen.<conc> Parseshen.<sng>) (if (shen.parse-failure? Parseshen.<conc>) (shen.parse-failure) (let Parseshen.<sc> (shen.<sc> Parseshen.<conc>) (if (shen.parse-failure? Parseshen.<sc>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<sc>) (cons (cons (shen.<-out Parseshen.<sides>) (cons (shen.<-out Parseshen.<prems>) (cons (shen.<-out Parseshen.<conc>) ()))) ())))))))))))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.<double> (V3131) (let Result (let Parseshen.<sides> (shen.<sides> V3131) (if (shen.parse-failure? Parseshen.<sides>) (shen.parse-failure) (let Parseshen.<formulae> (shen.<formulae> Parseshen.<sides>) (if (shen.parse-failure? Parseshen.<formulae>) (shen.parse-failure) (let Parseshen.<dbl> (shen.<dbl> Parseshen.<formulae>) (if (shen.parse-failure? Parseshen.<dbl>) (shen.parse-failure) (let Parseshen.<formula> (shen.<formula> Parseshen.<dbl>) (if (shen.parse-failure? Parseshen.<formula>) (shen.parse-failure) (let Parseshen.<sc> (shen.<sc> Parseshen.<formula>) (if (shen.parse-failure? Parseshen.<sc>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<sc>) (shen.lr-rule (shen.<-out Parseshen.<sides>) (shen.<-out Parseshen.<formulae>) (cons () (cons (shen.<-out Parseshen.<formula>) ())))))))))))))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.<formulae> (V3132) (let Result (let Parseshen.<formula> (shen.<formula> V3132) (if (shen.parse-failure? Parseshen.<formula>) (shen.parse-failure) (let Parseshen.<sc> (shen.<sc> Parseshen.<formula>) (if (shen.parse-failure? Parseshen.<sc>) (shen.parse-failure) (let Parseshen.<formulae> (shen.<formulae> Parseshen.<sc>) (if (shen.parse-failure? Parseshen.<formulae>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<formulae>) (cons (cons () (cons (shen.<-out Parseshen.<formula>) ())) (shen.<-out Parseshen.<formulae>))))))))) (if (shen.parse-failure? Result) (let Result (let Parseshen.<formula> (shen.<formula> V3132) (if (shen.parse-failure? Parseshen.<formula>) (shen.parse-failure) (let Parseshen.<sc> (shen.<sc> Parseshen.<formula>) (if (shen.parse-failure? Parseshen.<sc>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<sc>) (cons (cons () (cons (shen.<-out Parseshen.<formula>) ())) ())))))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)) Result)))

(defun shen.<conc> (V3133) (let Result (let Parseshen.<ass> (shen.<ass> V3133) (if (shen.parse-failure? Parseshen.<ass>) (shen.parse-failure) (if (shen.=hd? Parseshen.<ass> >>) (let News2995 (shen.tls Parseshen.<ass>) (let Parseshen.<formula> (shen.<formula> News2995) (if (shen.parse-failure? Parseshen.<formula>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<formula>) (cons (shen.<-out Parseshen.<ass>) (cons (shen.<-out Parseshen.<formula>) ())))))) (shen.parse-failure)))) (if (shen.parse-failure? Result) (let Result (let Parseshen.<formula> (shen.<formula> V3133) (if (shen.parse-failure? Parseshen.<formula>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<formula>) (cons () (cons (shen.<-out Parseshen.<formula>) ()))))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)) Result)))

(defun shen.<prems> (V3134) (let Result (let Parseshen.<prem> (shen.<prem> V3134) (if (shen.parse-failure? Parseshen.<prem>) (shen.parse-failure) (let Parseshen.<sc> (shen.<sc> Parseshen.<prem>) (if (shen.parse-failure? Parseshen.<sc>) (shen.parse-failure) (let Parseshen.<prems> (shen.<prems> Parseshen.<sc>) (if (shen.parse-failure? Parseshen.<prems>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<prems>) (cons (shen.<-out Parseshen.<prem>) (shen.<-out Parseshen.<prems>))))))))) (if (shen.parse-failure? Result) (let Result (let Parse<e> (<e> V3134) (if (shen.parse-failure? Parse<e>) (shen.parse-failure) (shen.comb (shen.in-> Parse<e>) ()))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)) Result)))

(defun shen.<prem> (V3135) (let Result (if (shen.=hd? V3135 !) (let News2998 (shen.tls V3135) (shen.comb (shen.in-> News2998) !)) (shen.parse-failure)) (if (shen.parse-failure? Result) (let Result (let Parseshen.<ass> (shen.<ass> V3135) (if (shen.parse-failure? Parseshen.<ass>) (shen.parse-failure) (if (shen.=hd? Parseshen.<ass> >>) (let News2999 (shen.tls Parseshen.<ass>) (let Parseshen.<formula> (shen.<formula> News2999) (if (shen.parse-failure? Parseshen.<formula>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<formula>) (cons (shen.<-out Parseshen.<ass>) (cons (shen.<-out Parseshen.<formula>) ())))))) (shen.parse-failure)))) (if (shen.parse-failure? Result) (let Result (let Parseshen.<formula> (shen.<formula> V3135) (if (shen.parse-failure? Parseshen.<formula>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<formula>) (cons () (cons (shen.<-out Parseshen.<formula>) ()))))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)) Result)) Result)))

(defun shen.<ass> (V3136) (let Result (let Parseshen.<formula> (shen.<formula> V3136) (if (shen.parse-failure? Parseshen.<formula>) (shen.parse-failure) (let Parseshen.<iscomma> (shen.<iscomma> Parseshen.<formula>) (if (shen.parse-failure? Parseshen.<iscomma>) (shen.parse-failure) (let Parseshen.<ass> (shen.<ass> Parseshen.<iscomma>) (if (shen.parse-failure? Parseshen.<ass>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<ass>) (cons (shen.<-out Parseshen.<formula>) (shen.<-out Parseshen.<ass>))))))))) (if (shen.parse-failure? Result) (let Result (let Parseshen.<formula> (shen.<formula> V3136) (if (shen.parse-failure? Parseshen.<formula>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<formula>) (cons (shen.<-out Parseshen.<formula>) ())))) (if (shen.parse-failure? Result) (let Result (let Parse<e> (<e> V3136) (if (shen.parse-failure? Parse<e>) (shen.parse-failure) (shen.comb (shen.in-> Parse<e>) ()))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)) Result)) Result)))

(defun shen.<iscomma> (V3137) (let Result (if (shen.non-empty-stream? V3137) (let X (shen.hds V3137) (let News3002 (shen.tls V3137) (if (= X (intern ",")) (shen.comb (shen.in-> News3002) shen.skip) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.<formula> (V3138) (let Result (let Parseshen.<expr> (shen.<expr> V3138) (if (shen.parse-failure? Parseshen.<expr>) (shen.parse-failure) (let Parseshen.<iscolon> (shen.<iscolon> Parseshen.<expr>) (if (shen.parse-failure? Parseshen.<iscolon>) (shen.parse-failure) (let Parseshen.<type> (shen.<type> Parseshen.<iscolon>) (if (shen.parse-failure? Parseshen.<type>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<type>) (cons (shen.curry (shen.<-out Parseshen.<expr>)) (cons (intern ":") (cons (shen.rectify-type (shen.<-out Parseshen.<type>)) ())))))))))) (if (shen.parse-failure? Result) (let Result (let Parseshen.<expr> (shen.<expr> V3138) (if (shen.parse-failure? Parseshen.<expr>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<expr>) (shen.<-out Parseshen.<expr>)))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)) Result)))

(defun shen.<iscolon> (V3139) (let Result (if (shen.non-empty-stream? V3139) (let X (shen.hds V3139) (let News3005 (shen.tls V3139) (if (= X (intern ":")) (shen.comb (shen.in-> News3005) shen.skip) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.<sides> (V3140) (let Result (let Parseshen.<side> (shen.<side> V3140) (if (shen.parse-failure? Parseshen.<side>) (shen.parse-failure) (let Parseshen.<sides> (shen.<sides> Parseshen.<side>) (if (shen.parse-failure? Parseshen.<sides>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<sides>) (cons (shen.<-out Parseshen.<side>) (shen.<-out Parseshen.<sides>))))))) (if (shen.parse-failure? Result) (let Result (let Parse<e> (<e> V3140) (if (shen.parse-failure? Parse<e>) (shen.parse-failure) (shen.comb (shen.in-> Parse<e>) ()))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)) Result)))

(defun shen.<side> (V3141) (let Result (if (shen.=hd? V3141 if) (let News3008 (shen.tls V3141) (if (shen.non-empty-stream? News3008) (let P (shen.hds News3008) (let News3009 (shen.tls News3008) (shen.comb (shen.in-> News3009) (cons if (cons P ()))))) (shen.parse-failure))) (shen.parse-failure)) (if (shen.parse-failure? Result) (let Result (if (shen.=hd? V3141 let) (let News3010 (shen.tls V3141) (if (shen.non-empty-stream? News3010) (let X (shen.hds News3010) (let News3011 (shen.tls News3010) (if (shen.non-empty-stream? News3011) (let Y (shen.hds News3011) (let News3012 (shen.tls News3011) (shen.comb (shen.in-> News3012) (cons let (cons X (cons Y ())))))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)) (if (shen.parse-failure? Result) (let Result (if (shen.=hd? V3141 shen.let!) (let News3013 (shen.tls V3141) (if (shen.non-empty-stream? News3013) (let X (shen.hds News3013) (let News3014 (shen.tls News3013) (if (shen.non-empty-stream? News3014) (let Y (shen.hds News3014) (let News3015 (shen.tls News3014) (shen.comb (shen.in-> News3015) (cons shen.let! (cons X (cons Y ())))))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)) (if (shen.parse-failure? Result) (shen.parse-failure) Result)) Result)) Result)))

(defun shen.lr-rule (V3148 V3149 V3150) (cond ((and (cons? V3150) (and (= () (hd V3150)) (and (cons? (tl V3150)) (= () (tl (tl V3150)))))) (let P (gensym (protect P)) (let LConc (cons (tl V3150) (cons P ())) (let LPrem (cons (shen.coll-formulae V3149) (cons P ())) (let Left (cons V3148 (cons (cons LPrem ()) (cons LConc ()))) (let Right (cons V3148 (cons V3149 (cons V3150 ()))) (cons Right (cons Left ())))))))) (true (simple-error "implementation error in shen.lr-rule"))))

(defun shen.coll-formulae (V3153) (cond ((= () V3153) ()) ((and (cons? V3153) (and (cons? (hd V3153)) (and (= () (hd (hd V3153))) (and (cons? (tl (hd V3153))) (= () (tl (tl (hd V3153)))))))) (cons (hd (tl (hd V3153))) (shen.coll-formulae (tl V3153)))) (true (simple-error "implementation error in shen.coll-formulae"))))

(defun shen.<expr> (V3154) (let Result (if (shen.non-empty-stream? V3154) (let X (shen.hds V3154) (let News3017 (shen.tls V3154) (if (not (shen.key-in-sequent-calculus? X)) (shen.comb (shen.in-> News3017) (macroexpand X)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.key-in-sequent-calculus? (V3155) (or (element? V3155 (cons >> (cons (intern ";") (cons (intern ",") (cons (intern ":") (cons <-- ())))))) (or (shen.sng? V3155) (shen.dbl? V3155))))

(defun shen.<type> (V3156) (let Result (let Parseshen.<expr> (shen.<expr> V3156) (if (shen.parse-failure? Parseshen.<expr>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<expr>) (shen.<-out Parseshen.<expr>)))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.<dbl> (V3157) (let Result (if (shen.non-empty-stream? V3157) (let X (shen.hds V3157) (let News3020 (shen.tls V3157) (if (shen.dbl? X) (shen.comb (shen.in-> News3020) X) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.<sng> (V3158) (let Result (if (shen.non-empty-stream? V3158) (let X (shen.hds V3158) (let News3022 (shen.tls V3158) (if (shen.sng? X) (shen.comb (shen.in-> News3022) X) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.sng? (V3159) (and (symbol? V3159) (shen.sng-h? (str V3159))))

(defun shen.sng-h? (V3162) (cond ((= "___" V3162) true) ((and (shen.+string? V3162) (= "_" (hdstr V3162))) (shen.sng-h? (tlstr V3162))) (true false)))

(defun shen.dbl? (V3163) (and (symbol? V3163) (shen.dbl-h? (str V3163))))

(defun shen.dbl-h? (V3166) (cond ((= "===" V3166) true) ((and (shen.+string? V3166) (= "=" (hdstr V3166))) (shen.dbl-h? (tlstr V3166))) (true false)))

(defun shen.remember-datatype (V3167 V3168) (do (set shen.*datatypes* (shen.assoc-> V3167 V3168 (value shen.*datatypes*))) (do (set shen.*alldatatypes* (shen.assoc-> V3167 V3168 (value shen.*alldatatypes*))) V3167)))

(defun shen.rules->prolog (V3169 V3170) (let Clauses (mapcan (lambda Rule (shen.rule->clause Rule)) V3170) (eval (cons defprolog (cons V3169 Clauses)))))

(defun shen.rule->clause (V3173) (cond ((and (cons? V3173) (and (cons? (tl V3173)) (and (cons? (tl (tl V3173))) (and (cons? (hd (tl (tl V3173)))) (and (cons? (tl (hd (tl (tl V3173))))) (and (= () (tl (tl (hd (tl (tl V3173)))))) (= () (tl (tl (tl V3173)))))))))) (let Constraints (shen.extract-vars V3173) (let HypVs (shen.nvars (+ 1 (length (hd (hd (tl (tl V3173))))))) (let Active (shen.extract-vars (hd (tl (hd (tl (tl V3173)))))) (let Head (shen.compile-consequent (hd (tl (hd (tl (tl V3173))))) HypVs) (let Goals (shen.goals Constraints (hd (hd (tl (tl V3173)))) (hd V3173) (hd (tl V3173)) HypVs Active) (append Head (append (cons <-- ()) (append Goals (cons (intern ";") ())))))))))) (true (simple-error "implementation error in shen.rule->clause"))))

(defun shen.compile-consequent (V3180 V3181) (cond ((cons? V3181) (cons (shen.optimise-typing V3180) (cons (hd V3181) ()))) (true (simple-error "implementation error in shen.compile-consequent"))))

(defun shen.nvars (V3182) (cond ((= 0 V3182) ()) (true (cons (gensym (protect V)) (shen.nvars (- V3182 1))))))

(defun shen.optimise-typing (V3183) (cond ((and (cons? V3183) (and (cons? (tl V3183)) (and (cons? (tl (tl V3183))) (and (= () (tl (tl (tl V3183)))) (= (hd (tl V3183)) (intern ":")))))) (cons - (cons (shen.cons-form-with-modes (cons (hd V3183) (cons (hd (tl V3183)) (cons (cons + (tl (tl V3183))) ())))) ()))) (true (cons + (cons (shen.cons-form-with-modes V3183) ())))))

(defun shen.cons-form-with-modes (V3184) (cond ((and (cons? V3184) (and (= - (hd V3184)) (and (cons? (tl V3184)) (= () (tl (tl V3184)))))) (cons - (cons (shen.cons-form-with-modes (hd (tl V3184))) ()))) ((and (cons? V3184) (and (= + (hd V3184)) (and (cons? (tl V3184)) (= () (tl (tl V3184)))))) (cons + (cons (shen.cons-form-with-modes (hd (tl V3184))) ()))) ((and (cons? V3184) (and (= mode (hd V3184)) (and (cons? (tl V3184)) (and (cons? (tl (tl V3184))) (= () (tl (tl (tl V3184)))))))) (cons (hd (tl (tl V3184))) (cons (shen.cons-form-with-modes (hd (tl V3184))) ()))) ((and (cons? V3184) (and (= bar! (hd V3184)) (and (cons? (tl V3184)) (= () (tl (tl V3184)))))) (hd (tl V3184))) ((cons? V3184) (cons cons (cons (shen.cons-form-with-modes (hd V3184)) (cons (shen.cons-form-with-modes (tl V3184)) ())))) (true V3184)))

(defun shen.goals (V3185 V3186 V3187 V3188 V3189 V3190) (let GoalsAs (shen.compile-assumptions V3186 V3185 V3189 V3190) (let GoalsS (shen.compile-side-conditions V3187) (let GoalsP (shen.compile-premises V3188 V3189) (append GoalsAs (append GoalsS GoalsP))))))

(defun shen.compile-assumptions (V3205 V3206 V3207 V3208) (cond ((= () V3205) ()) ((and (cons? V3205) (and (cons? V3207) (cons? (tl V3207)))) (let NewActive (append (shen.extract-vars (hd V3205)) V3208) (cons (shen.compile-assumption (hd V3205) (hd V3207) (hd (tl V3207)) V3206 V3208) (shen.compile-assumptions (tl V3205) V3206 (tl V3207) NewActive)))) (true (simple-error "implementation error in shen.compile-assumptions"))))

(defun shen.compile-assumption (V3209 V3210 V3211 V3212 V3213) (let F (gensym shen.search) (let Compile (shen.compile-search-procedure F V3209 V3210 V3211 V3212 V3213) (cons F (cons V3210 (cons () (cons V3211 V3212)))))))

(defun shen.compile-search-procedure (V3214 V3215 V3216 V3217 V3218 V3219) (let Past (gensym (protect Previous)) (let Base (shen.foundit! V3215 V3216 Past V3217 V3218 V3219) (let Recursive (shen.keep-looking V3214 V3216 Past V3217 V3218) (eval (cons defprolog (cons V3214 (append Base Recursive))))))))

(defun shen.foundit! (V3220 V3221 V3222 V3223 V3224 V3225) (let Passive (shen.passive V3220 V3225) (let Table (shen.tabulate-passive Passive) (let Head (shen.head-foundit! V3220 V3221 V3222 V3223 V3224 Table) (let Body (shen.body-foundit! V3221 V3222 V3223 Table) (append Head (append (cons <-- ()) (append Body (cons (intern ";") ())))))))))

(defun shen.keep-looking (V3226 V3227 V3228 V3229 V3230) (let X (gensym (protect V)) (let Head (cons (cons - (cons (cons cons (cons X (cons V3227 ()))) ())) (cons V3228 (cons V3229 V3230))) (let Body (cons (cons V3226 (cons V3227 (cons (cons cons (cons X (cons V3228 ()))) (cons V3229 V3230)))) ()) (append Head (append (cons <-- ()) (append Body (cons (intern ";") ()))))))))

(defun shen.passive (V3235 V3236) (cond ((cons? V3235) (union (shen.passive (hd V3235) V3236) (shen.passive (tl V3235) V3236))) ((shen.passive? V3235 V3236) (cons V3235 ())) (true ())))

(defun shen.passive? (V3237 V3238) (and (not (element? V3237 V3238)) (variable? V3237)))

(defun shen.tabulate-passive (V3239) (map (lambda X (cons X (gensym (protect V)))) V3239))

(defun shen.head-foundit! (V3240 V3241 V3242 V3243 V3244 V3245) (let Optimise (shen.optimise-passive V3244 V3245) (cons (cons - (cons (cons cons (cons (shen.optimise-typing V3240) (cons V3241 ()))) ())) (cons V3242 (cons V3243 Optimise)))))

(defun shen.optimise-passive (V3246 V3247) (map (lambda C (shen.optimise-passive-h C V3247)) V3246))

(defun shen.optimise-passive-h (V3248 V3249) (let Entry (assoc V3248 V3249) (if (empty? Entry) V3248 (tl Entry))))

(defun shen.body-foundit! (V3258 V3259 V3260 V3261) (cond ((= () V3261) (cons (cons bind (cons V3260 (cons (cons append (cons (cons 1 (cons V3259 ())) (cons (cons 1 (cons V3258 ())) ()))) ()))) ())) ((and (cons? V3261) (cons? (hd V3261))) (cons (cons bind (cons (tl (hd V3261)) (cons (hd (hd V3261)) ()))) (shen.body-foundit! V3258 V3259 V3260 (tl V3261)))) (true (simple-error "implementation error in shen.body-foundit!"))))

(defun shen.compile-side-conditions (V3262) (map (lambda X (shen.compile-side-condition X)) V3262))

(defun shen.compile-side-condition (V3265) (cond ((and (cons? V3265) (and (= let (hd V3265)) (and (cons? (tl V3265)) (and (cons? (tl (tl V3265))) (= () (tl (tl (tl V3265)))))))) (cons is (tl V3265))) ((and (cons? V3265) (and (= shen.let! (hd V3265)) (and (cons? (tl V3265)) (and (cons? (tl (tl V3265))) (= () (tl (tl (tl V3265)))))))) (cons is! (tl V3265))) ((and (cons? V3265) (and (= if (hd V3265)) (and (cons? (tl V3265)) (= () (tl (tl V3265)))))) (cons when (tl V3265))) (true (simple-error "implementation error in shen.compile-side-condition"))))

(defun shen.compile-premises (V3266 V3267) (let Hyp (hd (reverse V3267)) (map (lambda X (shen.compile-premise X Hyp)) V3266)))

(defun shen.compile-premise (V3274 V3275) (cond ((= ! V3274) !) ((and (cons? V3274) (and (cons? (tl V3274)) (= () (tl (tl V3274))))) (shen.compile-premise-h (reverse (hd V3274)) (hd (tl V3274)) V3275)) (true (simple-error "implementation error in shen.premise"))))

(defun shen.compile-premise-h (V3282 V3283 V3284) (cond ((= () V3282) (cons shen.system-S (cons (shen.cons-form-no-modes V3283) (cons V3284 ())))) ((cons? V3282) (shen.compile-premise-h (tl V3282) V3283 (cons cons (cons (shen.cons-form-no-modes (hd V3282)) (cons V3284 ()))))) (true (simple-error "implementation error in shen.compile-premise-h"))))

(defun shen.cons-form-no-modes (V3285) (cond ((and (cons? V3285) (and (= bar! (hd V3285)) (and (cons? (tl V3285)) (= () (tl (tl V3285)))))) (hd (tl V3285))) ((cons? V3285) (cons cons (cons (shen.cons-form-no-modes (hd V3285)) (cons (shen.cons-form-no-modes (tl V3285)) ())))) (true V3285)))

(defun preclude (V3286) (let InternTypes (map (lambda X (shen.intern-type X)) V3286) (let Datatypes (value shen.*datatypes*) (let Remove (shen.remove-datatypes InternTypes Datatypes) (let NewDatatypes (set shen.*datatypes* Remove) (shen.show-datatypes NewDatatypes))))))

(defun shen.remove-datatypes (V3291 V3292) (cond ((= () V3291) V3292) ((cons? V3291) (shen.remove-datatypes (tl V3291) (shen.unassoc (hd V3291) V3292))) (true (simple-error "implementation error in shen.remove-datatypes"))))

(defun shen.unassoc (V3302 V3303) (cond ((= () V3303) ()) ((and (cons? V3303) (and (cons? (hd V3303)) (= V3302 (hd (hd V3303))))) (tl V3303)) ((cons? V3303) (cons (hd V3303) (shen.unassoc V3302 (tl V3303)))) (true (simple-error "implementation error in shen.unassoc"))))

(defun shen.show-datatypes (V3304) (map (lambda X (hd X)) V3304))

(defun include (V3305) (let InternTypes (map (lambda X (shen.intern-type X)) V3305) (let Remember (map (lambda D (shen.remember-datatype D (fn D))) InternTypes) (let Datatypes (value shen.*datatypes*) (shen.show-datatypes Datatypes)))))

(defun preclude-all-but (V3306) (let Initialise (set shen.*datatypes* ()) (let InternTypes (map (lambda X (shen.intern-type X)) V3306) (let NewDatatypes (map (lambda D (shen.remember-datatype D (fn D))) InternTypes) (shen.show-datatypes (value shen.*datatypes*))))))

(defun include-all-but (V3307) (let InternTypes (map (lambda X (shen.intern-type X)) V3307) (let AllDatatypes (value shen.*alldatatypes*) (let Datatypes (set shen.*datatypes* (shen.remove-datatypes InternTypes AllDatatypes)) (shen.show-datatypes Datatypes)))))

(defun thaw (V3362) (V3362))

(defun eval (V3363) (eval-kl (shen.shen->kl (shen.process-applications (macroexpand V3363) (shen.find-types V3363)))))

(defun external (V3364) (cond ((= null V3364) ()) (true (trap-error (get V3364 shen.external-symbols (value *property-vector*)) (lambda E (simple-error (cn "package " (shen.app V3364 " does not exist.
;" shen.a))))))))

(defun internal (V3365) (cond ((= null V3365) ()) (true (trap-error (get V3365 shen.internal-symbols (value *property-vector*)) (lambda E (simple-error (cn "package " (shen.app V3365 " does not exist.
;" shen.a))))))))

(defun fail-if (V3366 V3367) (if (V3366 V3367) (fail) V3367))

(defun @s (V3368 V3369) (cn V3368 V3369))

(defun tc? () (value shen.*tc*))

(defun ps (V3370) (trap-error (get V3370 shen.source (value *property-vector*)) (lambda E (simple-error (shen.app V3370 " not found.
" shen.a)))))

(defun stinput () (value *stinput*))

(defun vector (V3371) (let Vector (absvector (+ V3371 1)) (let ZeroStamp (address-> Vector 0 V3371) (let Standard (if (= V3371 0) ZeroStamp (shen.fillvector ZeroStamp 1 V3371 (fail))) Standard))))

(defun shen.fillvector (V3373 V3374 V3375 V3376) (cond ((= V3374 V3375) (address-> V3373 V3375 V3376)) (true (shen.fillvector (address-> V3373 V3374 V3376) (+ 1 V3374) V3375 V3376))))

(defun vector? (V3377) (and (absvector? V3377) (trap-error (>= (<-address V3377 0) 0) (lambda E false))))

(defun vector-> (V3378 V3379 V3380) (if (= V3379 0) (simple-error "cannot access 0th element of a vector
") (address-> V3378 V3379 V3380)))

(defun <-vector (V3381 V3382) (if (= V3382 0) (simple-error "cannot access 0th element of a vector
") (let VectorElement (<-address V3381 V3382) (if (= VectorElement (fail)) (simple-error "vector element not found
") VectorElement))))

(defun shen.posint? (V3383) (and (integer? V3383) (>= V3383 0)))

(defun limit (V3384) (<-address V3384 0))

(defun symbol? (V3385) (cond ((or (boolean? V3385) (or (number? V3385) (or (string? V3385) (or (cons? V3385) (or (empty? V3385) (vector? V3385)))))) false) ((element? V3385 (cons { (cons } (cons (intern ":") (cons (intern ";") (cons (intern ",") ())))))) true) (true (trap-error (let String (str V3385) (shen.analyse-symbol? String)) (lambda E false)))))

(defun shen.analyse-symbol? (V3388) (cond ((shen.+string? V3388) (and (shen.alpha? (string->n (hdstr V3388))) (shen.alphanums? (tlstr V3388)))) (true (simple-error "implementation error in shen.analyse-symbol?"))))

(defun shen.alphanums? (V3391) (cond ((= "" V3391) true) ((shen.+string? V3391) (let N (string->n (hdstr V3391)) (and (or (shen.alpha? N) (shen.digit? N)) (shen.alphanums? (tlstr V3391))))) (true (simple-error "implementation error in shen.alphanums?"))))

(defun variable? (V3392) (cond ((or (boolean? V3392) (or (number? V3392) (string? V3392))) false) (true (trap-error (let String (str V3392) (shen.analyse-variable? String)) (lambda E false)))))

(defun shen.analyse-variable? (V3395) (cond ((shen.+string? V3395) (and (shen.uppercase? (string->n (hdstr V3395))) (shen.alphanums? (tlstr V3395)))) (true (simple-error "implementation error in shen.analyse-variable?"))))

(defun gensym (V3396) (concat V3396 (set shen.*gensym* (+ 1 (value shen.*gensym*)))))

(defun concat (V3397 V3398) (intern (cn (str V3397) (str V3398))))

(defun @p (V3399 V3400) (let Vector (absvector 3) (let Tag (address-> Vector 0 shen.tuple) (let Fst (address-> Vector 1 V3399) (let Snd (address-> Vector 2 V3400) Vector)))))

(defun fst (V3401) (<-address V3401 1))

(defun snd (V3402) (<-address V3402 2))

(defun tuple? (V3403) (trap-error (and (absvector? V3403) (= shen.tuple (<-address V3403 0))) (lambda E false)))

(defun append (V3408 V3409) (cond ((= () V3408) V3409) ((cons? V3408) (cons (hd V3408) (append (tl V3408) V3409))) (true (simple-error "attempt to append a non-list"))))

(defun @v (V3410 V3411) (let Limit (limit V3411) (let NewVector (vector (+ Limit 1)) (let X+NewVector (vector-> NewVector 1 V3410) (if (= Limit 0) X+NewVector (shen.@v-help V3411 1 Limit X+NewVector))))))

(defun shen.@v-help (V3413 V3414 V3415 V3416) (cond ((= V3414 V3415) (shen.copyfromvector V3413 V3416 V3415 (+ V3415 1))) (true (shen.@v-help V3413 (+ V3414 1) V3415 (shen.copyfromvector V3413 V3416 V3414 (+ V3414 1))))))

(defun shen.copyfromvector (V3417 V3418 V3419 V3420) (trap-error (vector-> V3418 V3420 (<-vector V3417 V3419)) (lambda E V3418)))

(defun hdv (V3421) (trap-error (<-vector V3421 1) (lambda E (simple-error "hdv needs a non-empty vector as an argument
"))))

(defun tlv (V3422) (let Limit (limit V3422) (if (= Limit 0) (simple-error "cannot take the tail of the empty vector
") (if (= Limit 1) (vector 0) (let NewVector (vector (- Limit 1)) (shen.tlv-help V3422 2 Limit (vector (- Limit 1))))))))

(defun shen.tlv-help (V3424 V3425 V3426 V3427) (cond ((= V3425 V3426) (shen.copyfromvector V3424 V3427 V3426 (- V3426 1))) (true (shen.tlv-help V3424 (+ V3425 1) V3426 (shen.copyfromvector V3424 V3427 V3425 (- V3425 1))))))

(defun assoc (V3439 V3440) (cond ((= () V3440) ()) ((and (cons? V3440) (and (cons? (hd V3440)) (= V3439 (hd (hd V3440))))) (hd V3440)) ((cons? V3440) (assoc V3439 (tl V3440))) (true (simple-error "attempt to search a non-list with assoc
"))))

(defun boolean? (V3443) (cond ((= true V3443) true) ((= false V3443) true) (true false)))

(defun nl (V3444) (cond ((= 0 V3444) 0) (true (do (pr "
" (stoutput)) (nl (- V3444 1))))))

(defun difference (V3451 V3452) (cond ((= () V3451) ()) ((cons? V3451) (if (element? (hd V3451) V3452) (difference (tl V3451) V3452) (cons (hd V3451) (difference (tl V3451) V3452)))) (true (simple-error "attempt to find the difference with a non-list
"))))

(defun do (V3453 V3454) V3454)

(defun element? (V3466 V3467) (cond ((= () V3467) false) ((and (cons? V3467) (= V3466 (hd V3467))) true) ((cons? V3467) (element? V3466 (tl V3467))) (true (simple-error "attempt to find an element in a non-list
"))))

(defun empty? (V3470) (cond ((= () V3470) true) (true false)))

(defun fix (V3471 V3472) (shen.fix-help V3471 V3472 (V3471 V3472)))

(defun shen.fix-help (V3478 V3479 V3480) (cond ((= V3479 V3480) V3480) (true (shen.fix-help V3478 V3480 (V3478 V3480)))))

(defun put (V3481 V3482 V3483 V3484) (let N (hash V3481 (limit V3484)) (let Entry (trap-error (<-vector V3484 N) (lambda E ())) (let Change (vector-> V3484 N (shen.change-pointer-value V3481 V3482 V3483 Entry)) V3483))))

(defun unput (V3485 V3486 V3487) (let N (hash V3485 (limit V3487)) (let Entry (trap-error (<-vector V3487 N) (lambda E ())) (let Change (vector-> V3487 N (shen.remove-pointer V3485 V3486 Entry)) V3485))))

(defun shen.remove-pointer (V3498 V3499 V3500) (cond ((= () V3500) ()) ((and (cons? V3500) (and (cons? (hd V3500)) (and (cons? (hd (hd V3500))) (and (cons? (tl (hd (hd V3500)))) (and (= () (tl (tl (hd (hd V3500))))) (and (= V3499 (hd (tl (hd (hd V3500))))) (= V3498 (hd (hd (hd V3500)))))))))) (tl V3500)) ((cons? V3500) (cons (hd V3500) (shen.remove-pointer V3498 V3499 (tl V3500)))) (true (simple-error "implementation error in shen.remove-pointer"))))

(defun shen.change-pointer-value (V3513 V3514 V3515 V3516) (cond ((= () V3516) (cons (cons (cons V3513 (cons V3514 ())) V3515) ())) ((and (cons? V3516) (and (cons? (hd V3516)) (and (cons? (hd (hd V3516))) (and (cons? (tl (hd (hd V3516)))) (and (= () (tl (tl (hd (hd V3516))))) (and (= V3514 (hd (tl (hd (hd V3516))))) (= V3513 (hd (hd (hd V3516)))))))))) (cons (cons (hd (hd V3516)) V3515) (tl V3516))) ((cons? V3516) (cons (hd V3516) (shen.change-pointer-value V3513 V3514 V3515 (tl V3516)))) (true (simple-error "implementation error in shen.change-pointer-value"))))

(defun get (V3517 V3518 V3519) (let N (hash V3517 (limit V3519)) (let Entry (trap-error (<-vector V3519 N) (lambda E (simple-error (shen.app V3517 (cn " has no attributes: " (shen.app V3518 "
" shen.s)) shen.a)))) (let Result (assoc (cons V3517 (cons V3518 ())) Entry) (if (empty? Result) (simple-error (cn "attribute " (shen.app V3518 (cn " not found for " (shen.app V3517 "
" shen.s)) shen.s))) (tl Result))))))

(defun hash (V3520 V3521) (let Hash (shen.mod (shen.hashkey V3520) V3521) (if (= Hash 0) 1 Hash)))

(defun shen.hashkey (V3522) (let Ns (map (lambda X (string->n X)) (explode V3522)) (shen.prodbutzero Ns 1)))

(defun shen.prodbutzero (V3523 V3524) (cond ((= () V3523) V3524) ((and (cons? V3523) (= 0 (hd V3523))) (shen.prodbutzero (tl V3523) V3524)) ((cons? V3523) (if (> V3524 10000000000) (shen.prodbutzero (tl V3523) (+ V3524 (hd V3523))) (shen.prodbutzero (tl V3523) (* V3524 (hd V3523))))) (true (shen.f-error shen.prodbutzero))))

(defun shen.mod (V3525 V3526) (shen.modh V3525 (shen.multiples V3525 (cons V3526 ()))))

(defun shen.multiples (V3531 V3532) (cond ((and (cons? V3532) (> (hd V3532) V3531)) (tl V3532)) ((cons? V3532) (shen.multiples V3531 (cons (* 2 (hd V3532)) V3532))) (true (simple-error "implementation error in shen.multiples"))))

(defun shen.modh (V3539 V3540) (cond ((= 0 V3539) 0) ((= () V3540) V3539) ((and (cons? V3540) (> (hd V3540) V3539)) (if (empty? (tl V3540)) V3539 (shen.modh V3539 (tl V3540)))) ((cons? V3540) (shen.modh (- V3539 (hd V3540)) V3540)) (true (simple-error "implementation error in shen.modh"))))

(defun sum (V3543) (cond ((= () V3543) 0) ((cons? V3543) (+ (hd V3543) (sum (tl V3543)))) (true (simple-error "attempt to sum a non-list
"))))

(defun head (V3548) (cond ((cons? V3548) (hd V3548)) (true (simple-error "head expects a non-empty list
"))))

(defun tail (V3553) (cond ((cons? V3553) (tl V3553)) (true (simple-error "tail expects a non-empty list
"))))

(defun hdstr (V3554) (pos V3554 0))

(defun intersection (V3561 V3562) (cond ((= () V3561) ()) ((cons? V3561) (if (element? (hd V3561) V3562) (cons (hd V3561) (intersection (tl V3561) V3562)) (intersection (tl V3561) V3562))) (true (simple-error "attempt to find the intersection with a non-list
"))))

(defun reverse (V3563) (shen.reverse-help V3563 ()))

(defun shen.reverse-help (V3568 V3569) (cond ((= () V3568) V3569) ((cons? V3568) (shen.reverse-help (tl V3568) (cons (hd V3568) V3569))) (true (simple-error "attempt to reverse a non-list
"))))

(defun union (V3574 V3575) (cond ((= () V3574) V3575) ((cons? V3574) (if (element? (hd V3574) V3575) (union (tl V3574) V3575) (cons (hd V3574) (union (tl V3574) V3575)))) (true (simple-error "attempt to find the union with a non-list
"))))

(defun y-or-n? (V3576) (let Message (pr (shen.proc-nl V3576) (stoutput)) (let Y-or-N (pr " (y/n) " (stoutput)) (let Input (shen.app (read (stinput)) "" shen.s) (if (= "y" Input) true (if (= "n" Input) false (do (pr "please answer y or n
" (stoutput)) (y-or-n? V3576))))))))

(defun not (V3577) (if V3577 false true))

(defun abort () (simple-error ""))

(defun subst (V3583 V3584 V3585) (cond ((= V3584 V3585) V3583) ((cons? V3585) (cons (subst V3583 V3584 (hd V3585)) (subst V3583 V3584 (tl V3585)))) (true V3585)))

(defun explode (V3586) (shen.explode-h (shen.app V3586 "" shen.a)))

(defun shen.explode-h (V3589) (cond ((= "" V3589) ()) ((shen.+string? V3589) (cons (hdstr V3589) (shen.explode-h (tlstr V3589)))) (true (simple-error "implementation error in explode-h"))))

(defun cd (V3590) (set *home-directory* (if (= V3590 "") "" (shen.app V3590 "/" shen.a))))

(defun map (V3591 V3592) (shen.map-h V3591 V3592 ()))

(defun shen.map-h (V3593 V3594 V3595) (cond ((= () V3594) (reverse V3595)) ((cons? V3594) (shen.map-h V3593 (tl V3594) (cons (V3593 (hd V3594)) V3595))) (true (shen.f-error shen.map-h))))

(defun length (V3596) (shen.length-h V3596 0))

(defun shen.length-h (V3601 V3602) (cond ((= () V3601) V3602) (true (shen.length-h (tl V3601) (+ V3602 1)))))

(defun occurrences (V3608 V3609) (cond ((= V3608 V3609) 1) ((cons? V3609) (+ (occurrences V3608 (hd V3609)) (occurrences V3608 (tl V3609)))) (true 0)))

(defun nth (V3614 V3615) (cond ((and (= 1 V3614) (cons? V3615)) (hd V3615)) ((cons? V3615) (nth (- V3614 1) (tl V3615))) (true (simple-error (cn "nth applied to " (shen.app V3614 (cn ", " (shen.app V3615 "
" shen.a)) shen.a))))))

(defun integer? (V3616) (and (number? V3616) (let Abs (shen.abs V3616) (shen.integer-test? Abs (shen.magless Abs 1)))))

(defun shen.abs (V3617) (if (> V3617 0) V3617 (- 0 V3617)))

(defun shen.magless (V3618 V3619) (let Nx2 (* V3619 2) (if (> Nx2 V3618) V3619 (shen.magless V3618 Nx2))))

(defun shen.integer-test? (V3623 V3624) (cond ((= 0 V3623) true) ((> 1 V3623) false) (true (let Abs-N (- V3623 V3624) (if (> 0 Abs-N) (integer? V3623) (shen.integer-test? Abs-N V3624))))))

(defun mapcan (V3631 V3632) (cond ((= () V3632) ()) ((cons? V3632) (append (V3631 (hd V3632)) (mapcan V3631 (tl V3632)))) (true (simple-error "attempt to mapcan over a non-list
"))))

(defun == (V3638 V3639) (cond ((= V3638 V3639) true) (true false)))

(defun bound? (V3640) (and (symbol? V3640) (let Val (trap-error (value V3640) (lambda E shen.this-symbol-is-unbound)) (if (= Val shen.this-symbol-is-unbound) false true))))

(defun shen.string->bytes (V3641) (cond ((= "" V3641) ()) (true (cons (string->n (pos V3641 0)) (shen.string->bytes (tlstr V3641))))))

(defun maxinferences (V3642) (set shen.*maxinferences* V3642))

(defun inferences () (value shen.*infs*))

(defun protect (V3643) V3643)

(defun stoutput () (value *stoutput*))

(defun string->symbol (V3644) (let Symbol (intern V3644) (if (symbol? Symbol) Symbol (simple-error (cn "cannot intern " (shen.app V3644 " to a symbol" shen.s))))))

(defun optimise (V3647) (cond ((= + V3647) (set shen.*optimise* true)) ((= - V3647) (set shen.*optimise* false)) (true (simple-error "optimise expects a + or a -.
"))))

(defun os () (value *os*))

(defun language () (value *language*))

(defun version () (value *version*))

(defun port () (value *port*))

(defun porters () (value *porters*))

(defun implementation () (value *implementation*))

(defun release () (value *release*))

(defun package? (V3648) (cond ((= null V3648) true) (true (trap-error (do (external V3648) true) (lambda E false)))))

(defun fn (V3649) (let Assoc (assoc V3649 (value shen.*lambdatable*)) (if (empty? Assoc) (simple-error (shen.app V3649 " has no lambda expansion
" shen.a)) (tl Assoc))))

(defun fail () shen.fail!)(defun enable-type-theory (V3652) (cond ((= + V3652) (set shen.*shen-type-theory-enabled?* true)) ((= - V3652) (set shen.*shen-type-theory-enabled?* false)) (true (simple-error "enable-type-theory expects a + or a -
"))))

(defun tc (V3655) (cond ((= + V3655) (set shen.*tc* true)) ((= - V3655) (set shen.*tc* false)) (true (simple-error "tc expects a + or -"))))

(defun destroy (V3656) (do (shen.unassoc V3656 (value shen.*sigf*)) V3656))

(defun shen.unassoc (V3657 V3658) (let Assoc (assoc V3657 V3658) (let Remove (remove Assoc V3658) (set shen.*sigf* Remove))))

(defun in-package (V3659) (if (package? V3659) (set shen.*package* V3659) (simple-error (cn "package " (shen.app V3659 " does not exist
" shen.a)))))

(defun write-to-file (V3660 V3661) (let Stream (open V3660 out) (let String (if (string? V3661) (shen.app V3661 "

" shen.a) (shen.app V3661 "

" shen.s)) (let Write (pr String Stream) (let Close (close Stream) V3661)))))

(defun fresh () (shen.freshterm (gensym shen.t)))

(defun update-lambda-table (V3662 V3663) (let AssertArity (put V3662 arity V3663 (value *property-vector*)) (let LambdaEntry (shen.lambda-entry V3662) (let Update (set shen.*lambdatable* (cons LambdaEntry (value shen.*lambdatable*))) V3662))))

(defun specialise (V3666 V3667) (cond ((= 0 V3667) (do (set shen.*special* (remove V3666 (value shen.*special*))) (do (set shen.*extraspecial* (remove V3666 (value shen.*extraspecial*))) V3666))) ((= 1 V3667) (do (set shen.*special* (adjoin V3666 (value shen.*special*))) (do (set shen.*extraspecial* (remove V3666 (value shen.*extraspecial*))) V3666))) ((= 2 V3667) (do (set shen.*special* (remove V3666 (value shen.*special*))) (do (set shen.*extraspecial* (adjoin V3666 (value shen.*extraspecial*))) V3666))) (true (simple-error "specialise requires values of 0, 1 or 2
"))))

(defun shen.typecheck (V4266 V4267) (let Vs (shen.extract-vars V4267) (let A* (shen.rectify-type V4267) (let Curried (shen.curry V4266) (((((lambda V3668 (lambda L3669 (lambda K3670 (lambda C3671 (let Out (shen.newpv V3668) (shen.gc V3668 (do (shen.incinfs) (shen.insert-prolog-variables (receive (shen.deref Vs V3668)) (receive (shen.deref A* V3668)) Out V3668 L3669 K3670 (freeze (shen.toplevel-forms (receive (shen.deref Curried V3668)) Out V3668 L3669 K3670 (freeze (return Out V3668 L3669 K3670 C3671)))))))))))) (shen.reset-prolog-vector)) (@v true (@v 0 (vector 0)))) 0) (freeze true))))))

(defun shen.insert-prolog-variables (V4268 V4269 V4270 V4271 V4272 V4273 V4274) (let C3680 (if (shen.unlocked? V4272) (let Tm3681 (shen.lazyderef V4268 V4271) (if (= Tm3681 ()) (do (shen.incinfs) (is! V4269 V4270 V4271 V4272 V4273 V4274)) false)) false) (if (= C3680 false) (if (shen.unlocked? V4272) (let Tm3682 (shen.lazyderef V4268 V4271) (if (cons? Tm3682) (let V (hd Tm3682) (let Vs (tl Tm3682) (let X (shen.newpv V4271) (shen.gc V4271 (do (shen.incinfs) (shen.insert-prolog-variables Vs (subst (shen.deref X V4271) V V4269) V4270 V4271 V4272 V4273 V4274)))))) false)) false) C3680)))

(defun shen.toplevel-forms (V4275 V4276 V4277 V4278 V4279 V4280) (let K3685 (+ V4279 1) (let C3689 (if (shen.unlocked? V4278) (let Tm3690 (shen.lazyderef V4275 V4277) (if (cons? Tm3690) (let Tm3691 (shen.lazyderef (hd Tm3690) V4277) (if (= Tm3691 define) (let Tm3692 (shen.lazyderef (tl Tm3690) V4277) (if (cons? Tm3692) (let F (hd Tm3692) (let X (tl Tm3692) (do (shen.incinfs) (shen.cut V4277 V4278 K3685 (freeze (shen.signal-def (value shen.*spy*) F V4277 V4278 K3685 (freeze (shen.t* (cons define (cons F X)) V4276 V4277 V4278 K3685 V4280)))))))) false)) false)) false)) false) (if (= C3689 false) (let C3693 (if (shen.unlocked? V4278) (do (shen.incinfs) (shen.system-S (cons V4275 (cons (intern ":") (cons V4276 ()))) () V4277 V4278 K3685 V4280)) false) (if (= C3693 false) (shen.unlock V4278 K3685) C3693)) C3689))))

(defun shen.signal-def (V4281 V4282 V4283 V4284 V4285 V4286) (let C3700 (if (shen.unlocked? V4284) (let Tm3701 (shen.lazyderef V4281 V4283) (if (= Tm3701 false) (do (shen.incinfs) (thaw V4286)) false)) false) (if (= C3700 false) (if (shen.unlocked? V4284) (let Tm3702 (shen.lazyderef V4281 V4283) (if (= Tm3702 true) (let ShowF (shen.newpv V4283) (shen.gc V4283 (do (shen.incinfs) (is ShowF (pr (cn "
typechecking (fn " (shen.app (shen.deref V4282 V4283) ")
" shen.a)) (stoutput)) V4283 V4284 V4285 V4286)))) false)) false) C3700)))

(defun shen.rectify-type (V4287) (shen.demodulate (shen.curry-type V4287)))

(defun shen.demodulate (V4288) (trap-error (let Demod (shen.walk (lambda Y (shen.demod Y)) V4288) (if (= Demod V4288) V4288 (shen.demodulate Demod))) (lambda E V4288)))

(defun shen.curry-type (V4289) (cond ((and (cons? V4289) (and (cons? (tl V4289)) (and (= --> (hd (tl V4289))) (and (cons? (tl (tl V4289))) (and (cons? (tl (tl (tl V4289)))) (= --> (hd (tl (tl (tl V4289)))))))))) (shen.curry-type (cons (hd V4289) (cons --> (cons (tl (tl V4289)) ()))))) ((and (cons? V4289) (and (cons? (tl V4289)) (and (= ==> (hd (tl V4289))) (and (cons? (tl (tl V4289))) (= () (tl (tl (tl V4289)))))))) (shen.curry-type (cons (cons (hd V4289) (cons * (cons (protect A) ()))) (cons --> (cons (cons (cons vector (cons boolean ())) (cons --> (cons (cons (hd V4289) (cons * (tl (tl V4289)))) ()))) ()))))) ((and (cons? V4289) (and (cons? (tl V4289)) (and (= * (hd (tl V4289))) (and (cons? (tl (tl V4289))) (and (cons? (tl (tl (tl V4289)))) (= * (hd (tl (tl (tl V4289)))))))))) (shen.curry-type (cons (hd V4289) (cons * (cons (tl (tl V4289)) ()))))) ((cons? V4289) (map (lambda Z (shen.curry-type Z)) V4289)) (true V4289)))

(defun shen.curry (V4290) (cond ((and (cons? V4290) (and (= define (hd V4290)) (cons? (tl V4290)))) V4290) ((and (cons? V4290) (and (= type (hd V4290)) (and (cons? (tl V4290)) (and (cons? (tl (tl V4290))) (= () (tl (tl (tl V4290)))))))) (cons type (cons (shen.curry (hd (tl V4290))) (tl (tl V4290))))) ((and (cons? V4290) (and (= input+ (hd V4290)) (and (cons? (tl V4290)) (and (cons? (tl (tl V4290))) (= () (tl (tl (tl V4290)))))))) (cons input+ (cons (hd (tl V4290)) (cons (shen.curry (hd (tl (tl V4290)))) ())))) ((and (cons? V4290) (shen.special? (hd V4290))) (cons (hd V4290) (map (lambda Y (shen.curry Y)) (tl V4290)))) ((and (cons? V4290) (shen.extraspecial? (hd V4290))) V4290) ((and (cons? V4290) (and (cons? (tl V4290)) (cons? (tl (tl V4290))))) (shen.curry (cons (cons (hd V4290) (cons (hd (tl V4290)) ())) (tl (tl V4290))))) ((and (cons? V4290) (and (cons? (tl V4290)) (= () (tl (tl V4290))))) (cons (shen.curry (hd V4290)) (cons (shen.curry (hd (tl V4290))) ()))) (true V4290)))

(defun shen.special? (V4291) (element? V4291 (value shen.*special*)))

(defun shen.extraspecial? (V4292) (element? V4292 (value shen.*extraspecial*)))

(defun shen.system-S (V4293 V4294 V4295 V4296 V4297 V4298) (let K3705 (+ V4297 1) (let C3709 (if (shen.unlocked? V4296) (do (shen.incinfs) (when (shen.maxinfexceeded?) V4295 V4296 K3705 V4298)) false) (if (= C3709 false) (let C3710 (if (shen.unlocked? V4296) (let Tm3711 (shen.lazyderef V4293 V4295) (if (cons? Tm3711) (let X (hd Tm3711) (let Tm3712 (shen.lazyderef (tl Tm3711) V4295) (if (cons? Tm3712) (let Colon (hd Tm3712) (let Tm3713 (shen.lazyderef (tl Tm3712) V4295) (if (cons? Tm3713) (let A (hd Tm3713) (let Tm3714 (shen.lazyderef (tl Tm3713) V4295) (if (= Tm3714 ()) (do (shen.incinfs) (when (= (shen.deref Colon V4295) (intern ":")) V4295 V4296 K3705 (freeze (when (shen.type-theory-enabled?) V4295 V4296 K3705 (freeze (shen.cut V4295 V4296 K3705 (freeze (shen.system-S-h X A V4294 V4295 V4296 K3705 V4298)))))))) false))) false))) false))) false)) false) (if (= C3710 false) (let C3715 (if (shen.unlocked? V4296) (do (shen.incinfs) (when (value shen.*spy*) V4295 V4296 K3705 (freeze (shen.show V4293 V4294 V4295 V4296 K3705 V4298)))) false) (if (= C3715 false) (let C3716 (if (shen.unlocked? V4296) (do (shen.incinfs) (shen.search-user-datatypes V4293 V4294 (value shen.*datatypes*) V4295 V4296 K3705 V4298)) false) (if (= C3716 false) (shen.unlock V4296 K3705) C3716)) C3715)) C3710)) C3709))))

(defun shen.show (V4305 V4306 V4307 V4308 V4309 V4310) (do (shen.line) (do (shen.show-p (shen.deref V4305 V4307)) (do (nl 2) (do (shen.show-assumptions (shen.deref V4306 V4307) 1) (do (shen.pause-for-user) false))))))

(defun shen.line () (let Infs (inferences) (pr (cn "____________________________________________________________ " (shen.app Infs (cn " inference" (shen.app (if (= 1 Infs) "" "s") " 
?- " shen.a)) shen.a)) (stoutput))))

(defun shen.show-p (V4311) (cond ((and (cons? V4311) (and (cons? (tl V4311)) (and (cons? (tl (tl V4311))) (and (= () (tl (tl (tl V4311)))) (= (hd (tl V4311)) (intern ":")))))) (do (shen.prterm (hd V4311)) (do (pr " : " (stoutput)) (pr (shen.app (hd (tl (tl V4311))) "" shen.r) (stoutput))))) (true (shen.prterm V4311))))

(defun shen.prterm (V4312) (cond ((and (cons? V4312) (and (= cons (hd V4312)) (and (cons? (tl V4312)) (and (cons? (tl (tl V4312))) (= () (tl (tl (tl V4312)))))))) (do (pr "[" (stoutput)) (do (shen.prterm (hd (tl V4312))) (do (shen.prtl (hd (tl (tl V4312)))) (pr "]" (stoutput)))))) ((cons? V4312) (do (pr "(" (stoutput)) (do (shen.prterm (hd V4312)) (do (map (lambda Y (do (pr " " (stoutput)) (shen.prterm Y))) (tl V4312)) (pr ")" (stoutput)))))) (true (print V4312))))

(defun shen.prtl (V4313) (cond ((= () V4313) "") ((and (cons? V4313) (and (= cons (hd V4313)) (and (cons? (tl V4313)) (and (cons? (tl (tl V4313))) (= () (tl (tl (tl V4313)))))))) (do (pr " " (stoutput)) (do (shen.prterm (hd (tl V4313))) (shen.prtl (hd (tl (tl V4313))))))) (true (do (pr " | " (stoutput)) (shen.prterm V4313)))))

(defun shen.show-assumptions (V4320 V4321) (cond ((= () V4320) (pr "
> " (stoutput))) ((cons? V4320) (do (pr (shen.app V4321 ". " shen.a) (stoutput)) (do (shen.show-p (hd V4320)) (do (nl 1) (shen.show-assumptions (tl V4320) (+ V4321 1)))))) (true (simple-error "implementation error in shen.show-assumptions"))))

(defun shen.pause-for-user () (let Byte (read-byte (stinput)) (if (= Byte 94) (simple-error "input aborted
") (nl 1))))

(defun shen.type-theory-enabled? () (value shen.*shen-type-theory-enabled?*))

(defun shen.maxinfexceeded? () (if (> (inferences) (value shen.*maxinferences*)) (simple-error "maximum inferences exceeded") false))

(defun shen.system-S-h (V4322 V4323 V4324 V4325 V4326 V4327 V4328) (let K3720 (+ V4327 1) (let C3725 (if (shen.unlocked? V4326) (do (shen.incinfs) (when (value shen.*spy*) V4325 V4326 K3720 (freeze (shen.show (cons V4322 (cons (intern ":") (cons V4323 ()))) V4324 V4325 V4326 K3720 V4328)))) false) (if (= C3725 false) (let C3726 (if (shen.unlocked? V4326) (do (shen.incinfs) (when (not (cons? (shen.lazyderef V4322 V4325))) V4325 V4326 K3720 (freeze (shen.primitive V4322 V4323 V4325 V4326 K3720 V4328)))) false) (if (= C3726 false) (let C3727 (if (shen.unlocked? V4326) (do (shen.incinfs) (shen.by-hypothesis V4322 V4323 V4324 V4325 V4326 K3720 V4328)) false) (if (= C3727 false) (let C3728 (if (shen.unlocked? V4326) (let Tm3729 (shen.lazyderef V4322 V4325) (if (cons? Tm3729) (let F (hd Tm3729) (let Tm3730 (shen.lazyderef (tl Tm3729) V4325) (if (= Tm3730 ()) (do (shen.incinfs) (shen.lookupsig F (cons --> (cons V4323 ())) V4325 V4326 K3720 V4328)) false))) false)) false) (if (= C3728 false) (let C3731 (if (shen.unlocked? V4326) (let Tm3732 (shen.lazyderef V4322 V4325) (if (cons? Tm3732) (let Tm3733 (shen.lazyderef (hd Tm3732) V4325) (if (= Tm3733 fn) (let Tm3734 (shen.lazyderef (tl Tm3732) V4325) (if (cons? Tm3734) (let F (hd Tm3734) (let Tm3735 (shen.lazyderef (tl Tm3734) V4325) (if (= Tm3735 ()) (do (shen.incinfs) (shen.lookupsig F V4323 V4325 V4326 K3720 V4328)) false))) false)) false)) false)) false) (if (= C3731 false) (let C3736 (if (shen.unlocked? V4326) (let Tm3737 (shen.lazyderef V4322 V4325) (if (cons? Tm3737) (let F (hd Tm3737) (let Tm3738 (shen.lazyderef (tl Tm3737) V4325) (if (cons? Tm3738) (let X (hd Tm3738) (let Tm3739 (shen.lazyderef (tl Tm3738) V4325) (if (= Tm3739 ()) (let B (shen.newpv V4325) (shen.gc V4325 (do (shen.incinfs) (when (not (cons? (shen.lazyderef F V4325))) V4325 V4326 K3720 (freeze (shen.lookupsig F (cons B (cons --> (cons V4323 ()))) V4325 V4326 K3720 (freeze (shen.system-S-h X B V4324 V4325 V4326 K3720 V4328)))))))) false))) false))) false)) false) (if (= C3736 false) (let C3740 (if (shen.unlocked? V4326) (let Tm3741 (shen.lazyderef V4322 V4325) (if (cons? Tm3741) (let F (hd Tm3741) (let Tm3742 (shen.lazyderef (tl Tm3741) V4325) (if (cons? Tm3742) (let X (hd Tm3742) (let Tm3743 (shen.lazyderef (tl Tm3742) V4325) (if (= Tm3743 ()) (let B (shen.newpv V4325) (shen.gc V4325 (do (shen.incinfs) (shen.system-S-h F (cons B (cons --> (cons V4323 ()))) V4324 V4325 V4326 K3720 (freeze (shen.system-S-h X B V4324 V4325 V4326 K3720 V4328)))))) false))) false))) false)) false) (if (= C3740 false) (let C3744 (if (shen.unlocked? V4326) (let Tm3745 (shen.lazyderef V4322 V4325) (if (cons? Tm3745) (let Tm3746 (shen.lazyderef (hd Tm3745) V4325) (if (= Tm3746 cons) (let Tm3747 (shen.lazyderef (tl Tm3745) V4325) (if (cons? Tm3747) (let X (hd Tm3747) (let Tm3748 (shen.lazyderef (tl Tm3747) V4325) (if (cons? Tm3748) (let Y (hd Tm3748) (let Tm3749 (shen.lazyderef (tl Tm3748) V4325) (if (= Tm3749 ()) (let Tm3750 (shen.lazyderef V4323 V4325) (let GoTo3751 (lambda A (do (shen.incinfs) (shen.system-S-h X A V4324 V4325 V4326 K3720 (freeze (shen.system-S-h Y (cons list (cons A ())) V4324 V4325 V4326 K3720 V4328))))) (if (cons? Tm3750) (let Tm3752 (shen.lazyderef (hd Tm3750) V4325) (let GoTo3753 (freeze (let Tm3754 (shen.lazyderef (tl Tm3750) V4325) (let GoTo3755 (lambda A (GoTo3751 A)) (if (cons? Tm3754) (let A (hd Tm3754) (let Tm3756 (shen.lazyderef (tl Tm3754) V4325) (let GoTo3757 (freeze (GoTo3755 A)) (if (= Tm3756 ()) (thaw GoTo3757) (if (shen.pvar? Tm3756) (shen.bind! Tm3756 () V4325 GoTo3757) false))))) (if (shen.pvar? Tm3754) (let A (shen.newpv V4325) (shen.gc V4325 (shen.bind! Tm3754 (cons A ()) V4325 (freeze (GoTo3755 A))))) false))))) (if (= Tm3752 list) (thaw GoTo3753) (if (shen.pvar? Tm3752) (shen.bind! Tm3752 list V4325 GoTo3753) false)))) (if (shen.pvar? Tm3750) (let A (shen.newpv V4325) (shen.gc V4325 (shen.bind! Tm3750 (cons list (cons A ())) V4325 (freeze (GoTo3751 A))))) false)))) false))) false))) false)) false)) false)) false) (if (= C3744 false) (let C3758 (if (shen.unlocked? V4326) (let Tm3759 (shen.lazyderef V4322 V4325) (if (cons? Tm3759) (let Tm3760 (shen.lazyderef (hd Tm3759) V4325) (if (= Tm3760 @p) (let Tm3761 (shen.lazyderef (tl Tm3759) V4325) (if (cons? Tm3761) (let X (hd Tm3761) (let Tm3762 (shen.lazyderef (tl Tm3761) V4325) (if (cons? Tm3762) (let Y (hd Tm3762) (let Tm3763 (shen.lazyderef (tl Tm3762) V4325) (if (= Tm3763 ()) (let Tm3764 (shen.lazyderef V4323 V4325) (let GoTo3765 (lambda A (lambda B (do (shen.incinfs) (shen.system-S-h X A V4324 V4325 V4326 K3720 (freeze (shen.system-S-h Y B V4324 V4325 V4326 K3720 V4328)))))) (if (cons? Tm3764) (let A (hd Tm3764) (let Tm3766 (shen.lazyderef (tl Tm3764) V4325) (let GoTo3767 (lambda B ((GoTo3765 A) B)) (if (cons? Tm3766) (let Tm3768 (shen.lazyderef (hd Tm3766) V4325) (let GoTo3769 (freeze (let Tm3770 (shen.lazyderef (tl Tm3766) V4325) (let GoTo3771 (lambda B (GoTo3767 B)) (if (cons? Tm3770) (let B (hd Tm3770) (let Tm3772 (shen.lazyderef (tl Tm3770) V4325) (let GoTo3773 (freeze (GoTo3771 B)) (if (= Tm3772 ()) (thaw GoTo3773) (if (shen.pvar? Tm3772) (shen.bind! Tm3772 () V4325 GoTo3773) false))))) (if (shen.pvar? Tm3770) (let B (shen.newpv V4325) (shen.gc V4325 (shen.bind! Tm3770 (cons B ()) V4325 (freeze (GoTo3771 B))))) false))))) (if (= Tm3768 *) (thaw GoTo3769) (if (shen.pvar? Tm3768) (shen.bind! Tm3768 * V4325 GoTo3769) false)))) (if (shen.pvar? Tm3766) (let B (shen.newpv V4325) (shen.gc V4325 (shen.bind! Tm3766 (cons * (cons B ())) V4325 (freeze (GoTo3767 B))))) false))))) (if (shen.pvar? Tm3764) (let A (shen.newpv V4325) (shen.gc V4325 (let B (shen.newpv V4325) (shen.gc V4325 (shen.bind! Tm3764 (cons A (cons * (cons B ()))) V4325 (freeze ((GoTo3765 A) B))))))) false)))) false))) false))) false)) false)) false)) false) (if (= C3758 false) (let C3774 (if (shen.unlocked? V4326) (let Tm3775 (shen.lazyderef V4322 V4325) (if (cons? Tm3775) (let Tm3776 (shen.lazyderef (hd Tm3775) V4325) (if (= Tm3776 @v) (let Tm3777 (shen.lazyderef (tl Tm3775) V4325) (if (cons? Tm3777) (let X (hd Tm3777) (let Tm3778 (shen.lazyderef (tl Tm3777) V4325) (if (cons? Tm3778) (let Y (hd Tm3778) (let Tm3779 (shen.lazyderef (tl Tm3778) V4325) (if (= Tm3779 ()) (let Tm3780 (shen.lazyderef V4323 V4325) (let GoTo3781 (lambda A (do (shen.incinfs) (shen.system-S-h X A V4324 V4325 V4326 K3720 (freeze (shen.system-S-h Y (cons vector (cons A ())) V4324 V4325 V4326 K3720 V4328))))) (if (cons? Tm3780) (let Tm3782 (shen.lazyderef (hd Tm3780) V4325) (let GoTo3783 (freeze (let Tm3784 (shen.lazyderef (tl Tm3780) V4325) (let GoTo3785 (lambda A (GoTo3781 A)) (if (cons? Tm3784) (let A (hd Tm3784) (let Tm3786 (shen.lazyderef (tl Tm3784) V4325) (let GoTo3787 (freeze (GoTo3785 A)) (if (= Tm3786 ()) (thaw GoTo3787) (if (shen.pvar? Tm3786) (shen.bind! Tm3786 () V4325 GoTo3787) false))))) (if (shen.pvar? Tm3784) (let A (shen.newpv V4325) (shen.gc V4325 (shen.bind! Tm3784 (cons A ()) V4325 (freeze (GoTo3785 A))))) false))))) (if (= Tm3782 vector) (thaw GoTo3783) (if (shen.pvar? Tm3782) (shen.bind! Tm3782 vector V4325 GoTo3783) false)))) (if (shen.pvar? Tm3780) (let A (shen.newpv V4325) (shen.gc V4325 (shen.bind! Tm3780 (cons vector (cons A ())) V4325 (freeze (GoTo3781 A))))) false)))) false))) false))) false)) false)) false)) false) (if (= C3774 false) (let C3788 (if (shen.unlocked? V4326) (let Tm3789 (shen.lazyderef V4322 V4325) (if (cons? Tm3789) (let Tm3790 (shen.lazyderef (hd Tm3789) V4325) (if (= Tm3790 @s) (let Tm3791 (shen.lazyderef (tl Tm3789) V4325) (if (cons? Tm3791) (let X (hd Tm3791) (let Tm3792 (shen.lazyderef (tl Tm3791) V4325) (if (cons? Tm3792) (let Y (hd Tm3792) (let Tm3793 (shen.lazyderef (tl Tm3792) V4325) (if (= Tm3793 ()) (let Tm3794 (shen.lazyderef V4323 V4325) (let GoTo3795 (freeze (do (shen.incinfs) (shen.system-S-h X string V4324 V4325 V4326 K3720 (freeze (shen.system-S-h Y string V4324 V4325 V4326 K3720 V4328))))) (if (= Tm3794 string) (thaw GoTo3795) (if (shen.pvar? Tm3794) (shen.bind! Tm3794 string V4325 GoTo3795) false)))) false))) false))) false)) false)) false)) false) (if (= C3788 false) (let C3796 (if (shen.unlocked? V4326) (let Tm3797 (shen.lazyderef V4322 V4325) (if (cons? Tm3797) (let Tm3798 (shen.lazyderef (hd Tm3797) V4325) (if (= Tm3798 lambda) (let Tm3799 (shen.lazyderef (tl Tm3797) V4325) (if (cons? Tm3799) (let X (hd Tm3799) (let Tm3800 (shen.lazyderef (tl Tm3799) V4325) (if (cons? Tm3800) (let Y (hd Tm3800) (let Tm3801 (shen.lazyderef (tl Tm3800) V4325) (if (= Tm3801 ()) (let Tm3802 (shen.lazyderef V4323 V4325) (let GoTo3803 (lambda A (lambda B (let Z (shen.newpv V4325) (shen.gc V4325 (let New (shen.newpv V4325) (shen.gc V4325 (do (shen.incinfs) (bind New (shen.freshterm (shen.lazyderef X V4325)) V4325 V4326 K3720 (freeze (bind Z (shen.beta (shen.lazyderef X V4325) (shen.deref New V4325) (shen.deref Y V4325)) V4325 V4326 K3720 (freeze (shen.system-S-h Z B (cons (cons New (cons (intern ":") (cons A ()))) V4324) V4325 V4326 K3720 V4328)))))))))))) (if (cons? Tm3802) (let A (hd Tm3802) (let Tm3804 (shen.lazyderef (tl Tm3802) V4325) (let GoTo3805 (lambda B ((GoTo3803 A) B)) (if (cons? Tm3804) (let Tm3806 (shen.lazyderef (hd Tm3804) V4325) (let GoTo3807 (freeze (let Tm3808 (shen.lazyderef (tl Tm3804) V4325) (let GoTo3809 (lambda B (GoTo3805 B)) (if (cons? Tm3808) (let B (hd Tm3808) (let Tm3810 (shen.lazyderef (tl Tm3808) V4325) (let GoTo3811 (freeze (GoTo3809 B)) (if (= Tm3810 ()) (thaw GoTo3811) (if (shen.pvar? Tm3810) (shen.bind! Tm3810 () V4325 GoTo3811) false))))) (if (shen.pvar? Tm3808) (let B (shen.newpv V4325) (shen.gc V4325 (shen.bind! Tm3808 (cons B ()) V4325 (freeze (GoTo3809 B))))) false))))) (if (= Tm3806 -->) (thaw GoTo3807) (if (shen.pvar? Tm3806) (shen.bind! Tm3806 --> V4325 GoTo3807) false)))) (if (shen.pvar? Tm3804) (let B (shen.newpv V4325) (shen.gc V4325 (shen.bind! Tm3804 (cons --> (cons B ())) V4325 (freeze (GoTo3805 B))))) false))))) (if (shen.pvar? Tm3802) (let A (shen.newpv V4325) (shen.gc V4325 (let B (shen.newpv V4325) (shen.gc V4325 (shen.bind! Tm3802 (cons A (cons --> (cons B ()))) V4325 (freeze ((GoTo3803 A) B))))))) false)))) false))) false))) false)) false)) false)) false) (if (= C3796 false) (let C3812 (if (shen.unlocked? V4326) (let Tm3813 (shen.lazyderef V4322 V4325) (if (cons? Tm3813) (let Tm3814 (shen.lazyderef (hd Tm3813) V4325) (if (= Tm3814 let) (let Tm3815 (shen.lazyderef (tl Tm3813) V4325) (if (cons? Tm3815) (let X (hd Tm3815) (let Tm3816 (shen.lazyderef (tl Tm3815) V4325) (if (cons? Tm3816) (let Y (hd Tm3816) (let Tm3817 (shen.lazyderef (tl Tm3816) V4325) (if (cons? Tm3817) (let Z (hd Tm3817) (let Tm3818 (shen.lazyderef (tl Tm3817) V4325) (if (= Tm3818 ()) (let W (shen.newpv V4325) (shen.gc V4325 (let New (shen.newpv V4325) (shen.gc V4325 (let B (shen.newpv V4325) (shen.gc V4325 (do (shen.incinfs) (shen.system-S-h Y B V4324 V4325 V4326 K3720 (freeze (bind New (shen.freshterm (shen.lazyderef X V4325)) V4325 V4326 K3720 (freeze (bind W (shen.beta (shen.lazyderef X V4325) (shen.lazyderef New V4325) (shen.lazyderef Z V4325)) V4325 V4326 K3720 (freeze (shen.system-S-h W V4323 (cons (cons New (cons (intern ":") (cons B ()))) V4324) V4325 V4326 K3720 V4328)))))))))))))) false))) false))) false))) false)) false)) false)) false) (if (= C3812 false) (let C3819 (if (shen.unlocked? V4326) (let Tm3820 (shen.lazyderef V4322 V4325) (if (cons? Tm3820) (let Tm3821 (shen.lazyderef (hd Tm3820) V4325) (if (= Tm3821 open) (let Tm3822 (shen.lazyderef (tl Tm3820) V4325) (if (cons? Tm3822) (let File (hd Tm3822) (let Tm3823 (shen.lazyderef (tl Tm3822) V4325) (if (cons? Tm3823) (let V3717 (hd Tm3823) (let Tm3824 (shen.lazyderef (tl Tm3823) V4325) (if (= Tm3824 ()) (let Tm3825 (shen.lazyderef V4323 V4325) (let GoTo3826 (lambda D (do (shen.incinfs) (is! V3717 D V4325 V4326 K3720 (freeze (when (element? (shen.lazyderef D V4325) (cons in (cons out ()))) V4325 V4326 K3720 (freeze (shen.system-S-h File string V4324 V4325 V4326 K3720 V4328))))))) (if (cons? Tm3825) (let Tm3827 (shen.lazyderef (hd Tm3825) V4325) (let GoTo3828 (freeze (let Tm3829 (shen.lazyderef (tl Tm3825) V4325) (let GoTo3830 (lambda D (GoTo3826 D)) (if (cons? Tm3829) (let D (hd Tm3829) (let Tm3831 (shen.lazyderef (tl Tm3829) V4325) (let GoTo3832 (freeze (GoTo3830 D)) (if (= Tm3831 ()) (thaw GoTo3832) (if (shen.pvar? Tm3831) (shen.bind! Tm3831 () V4325 GoTo3832) false))))) (if (shen.pvar? Tm3829) (let D (shen.newpv V4325) (shen.gc V4325 (shen.bind! Tm3829 (cons D ()) V4325 (freeze (GoTo3830 D))))) false))))) (if (= Tm3827 stream) (thaw GoTo3828) (if (shen.pvar? Tm3827) (shen.bind! Tm3827 stream V4325 GoTo3828) false)))) (if (shen.pvar? Tm3825) (let D (shen.newpv V4325) (shen.gc V4325 (shen.bind! Tm3825 (cons stream (cons D ())) V4325 (freeze (GoTo3826 D))))) false)))) false))) false))) false)) false)) false)) false) (if (= C3819 false) (let C3833 (if (shen.unlocked? V4326) (let Tm3834 (shen.lazyderef V4322 V4325) (if (cons? Tm3834) (let Tm3835 (shen.lazyderef (hd Tm3834) V4325) (if (= Tm3835 type) (let Tm3836 (shen.lazyderef (tl Tm3834) V4325) (if (cons? Tm3836) (let X (hd Tm3836) (let Tm3837 (shen.lazyderef (tl Tm3836) V4325) (if (cons? Tm3837) (let A (hd Tm3837) (let Tm3838 (shen.lazyderef (tl Tm3837) V4325) (if (= Tm3838 ()) (do (shen.incinfs) (shen.cut V4325 V4326 K3720 (freeze (is! (shen.rectify-type (shen.deref A V4325)) V4323 V4325 V4326 K3720 (freeze (shen.system-S-h X V4323 V4324 V4325 V4326 K3720 V4328)))))) false))) false))) false)) false)) false)) false) (if (= C3833 false) (let C3839 (if (shen.unlocked? V4326) (let Tm3840 (shen.lazyderef V4322 V4325) (if (cons? Tm3840) (let Tm3841 (shen.lazyderef (hd Tm3840) V4325) (if (= Tm3841 input+) (let Tm3842 (shen.lazyderef (tl Tm3840) V4325) (if (cons? Tm3842) (let A (hd Tm3842) (let Tm3843 (shen.lazyderef (tl Tm3842) V4325) (if (cons? Tm3843) (let Stream (hd Tm3843) (let Tm3844 (shen.lazyderef (tl Tm3843) V4325) (if (= Tm3844 ()) (do (shen.incinfs) (is! V4323 (shen.rectify-type (shen.deref A V4325)) V4325 V4326 K3720 (freeze (shen.system-S-h Stream (cons stream (cons in ())) V4324 V4325 V4326 K3720 V4328)))) false))) false))) false)) false)) false)) false) (if (= C3839 false) (let C3845 (if (shen.unlocked? V4326) (let Tm3846 (shen.lazyderef V4322 V4325) (if (cons? Tm3846) (let Tm3847 (shen.lazyderef (hd Tm3846) V4325) (if (= Tm3847 set) (let Tm3848 (shen.lazyderef (tl Tm3846) V4325) (if (cons? Tm3848) (let Var (hd Tm3848) (let Tm3849 (shen.lazyderef (tl Tm3848) V4325) (if (cons? Tm3849) (let Val (hd Tm3849) (let Tm3850 (shen.lazyderef (tl Tm3849) V4325) (if (= Tm3850 ()) (do (shen.incinfs) (shen.system-S-h Var symbol V4324 V4325 V4326 K3720 (freeze (shen.system-S-h (cons value (cons Var ())) V4323 V4324 V4325 V4326 K3720 (freeze (shen.system-S-h Val V4323 V4324 V4325 V4326 K3720 V4328)))))) false))) false))) false)) false)) false)) false) (if (= C3845 false) (let C3851 (if (shen.unlocked? V4326) (let Normalised (shen.newpv V4325) (shen.gc V4325 (do (shen.incinfs) (shen.l-rules V4324 Normalised false V4325 V4326 K3720 (freeze (shen.cut V4325 V4326 K3720 (freeze (shen.system-S-h V4322 V4323 Normalised V4325 V4326 K3720 V4328)))))))) false) (if (= C3851 false) (let C3852 (if (shen.unlocked? V4326) (do (shen.incinfs) (shen.search-user-datatypes (cons V4322 (cons (intern ":") (cons V4323 ()))) V4324 (value shen.*datatypes*) V4325 V4326 K3720 V4328)) false) (if (= C3852 false) (shen.unlock V4326 K3720) C3852)) C3851)) C3845)) C3839)) C3833)) C3819)) C3812)) C3796)) C3788)) C3774)) C3758)) C3744)) C3740)) C3736)) C3731)) C3728)) C3727)) C3726)) C3725))))

(defun shen.primitive (V4329 V4330 V4331 V4332 V4333 V4334) (let C3859 (if (shen.unlocked? V4332) (let Tm3860 (shen.lazyderef V4330 V4331) (let GoTo3861 (freeze (do (shen.incinfs) (when (number? (shen.lazyderef V4329 V4331)) V4331 V4332 V4333 V4334))) (if (= Tm3860 number) (thaw GoTo3861) (if (shen.pvar? Tm3860) (shen.bind! Tm3860 number V4331 GoTo3861) false)))) false) (if (= C3859 false) (let C3862 (if (shen.unlocked? V4332) (let Tm3863 (shen.lazyderef V4330 V4331) (let GoTo3864 (freeze (do (shen.incinfs) (when (boolean? (shen.lazyderef V4329 V4331)) V4331 V4332 V4333 V4334))) (if (= Tm3863 boolean) (thaw GoTo3864) (if (shen.pvar? Tm3863) (shen.bind! Tm3863 boolean V4331 GoTo3864) false)))) false) (if (= C3862 false) (let C3865 (if (shen.unlocked? V4332) (let Tm3866 (shen.lazyderef V4330 V4331) (let GoTo3867 (freeze (do (shen.incinfs) (when (string? (shen.lazyderef V4329 V4331)) V4331 V4332 V4333 V4334))) (if (= Tm3866 string) (thaw GoTo3867) (if (shen.pvar? Tm3866) (shen.bind! Tm3866 string V4331 GoTo3867) false)))) false) (if (= C3865 false) (let C3868 (if (shen.unlocked? V4332) (let Tm3869 (shen.lazyderef V4330 V4331) (let GoTo3870 (freeze (do (shen.incinfs) (when (symbol? (shen.lazyderef V4329 V4331)) V4331 V4332 V4333 V4334))) (if (= Tm3869 symbol) (thaw GoTo3870) (if (shen.pvar? Tm3869) (shen.bind! Tm3869 symbol V4331 GoTo3870) false)))) false) (if (= C3868 false) (if (shen.unlocked? V4332) (let Tm3871 (shen.lazyderef V4329 V4331) (if (= Tm3871 ()) (let Tm3872 (shen.lazyderef V4330 V4331) (let GoTo3873 (lambda A (do (shen.incinfs) (thaw V4334))) (if (cons? Tm3872) (let Tm3874 (shen.lazyderef (hd Tm3872) V4331) (let GoTo3875 (freeze (let Tm3876 (shen.lazyderef (tl Tm3872) V4331) (let GoTo3877 (lambda A (GoTo3873 A)) (if (cons? Tm3876) (let A (hd Tm3876) (let Tm3878 (shen.lazyderef (tl Tm3876) V4331) (let GoTo3879 (freeze (GoTo3877 A)) (if (= Tm3878 ()) (thaw GoTo3879) (if (shen.pvar? Tm3878) (shen.bind! Tm3878 () V4331 GoTo3879) false))))) (if (shen.pvar? Tm3876) (let A (shen.newpv V4331) (shen.gc V4331 (shen.bind! Tm3876 (cons A ()) V4331 (freeze (GoTo3877 A))))) false))))) (if (= Tm3874 list) (thaw GoTo3875) (if (shen.pvar? Tm3874) (shen.bind! Tm3874 list V4331 GoTo3875) false)))) (if (shen.pvar? Tm3872) (let A (shen.newpv V4331) (shen.gc V4331 (shen.bind! Tm3872 (cons list (cons A ())) V4331 (freeze (GoTo3873 A))))) false)))) false)) false) C3868)) C3865)) C3862)) C3859)))

(defun shen.by-hypothesis (V4335 V4336 V4337 V4338 V4339 V4340 V4341) (let C3887 (if (shen.unlocked? V4339) (let Tm3888 (shen.lazyderef V4337 V4338) (if (cons? Tm3888) (let Tm3889 (shen.lazyderef (hd Tm3888) V4338) (if (cons? Tm3889) (let Y (hd Tm3889) (let Tm3890 (shen.lazyderef (tl Tm3889) V4338) (if (cons? Tm3890) (let Colon (hd Tm3890) (let Tm3891 (shen.lazyderef (tl Tm3890) V4338) (if (cons? Tm3891) (let B (hd Tm3891) (let Tm3892 (shen.lazyderef (tl Tm3891) V4338) (if (= Tm3892 ()) (do (shen.incinfs) (when (= (shen.deref Colon V4338) (intern ":")) V4338 V4339 V4340 (freeze (when (= (shen.deref V4335 V4338) (shen.deref Y V4338)) V4338 V4339 V4340 (freeze (is! V4336 B V4338 V4339 V4340 V4341)))))) false))) false))) false))) false)) false)) false) (if (= C3887 false) (if (shen.unlocked? V4339) (let Tm3893 (shen.lazyderef V4337 V4338) (if (cons? Tm3893) (let Hyp (tl Tm3893) (do (shen.incinfs) (shen.by-hypothesis V4335 V4336 Hyp V4338 V4339 V4340 V4341))) false)) false) C3887)))

(defun shen.lookupsig (V4342 V4343 V4344 V4345 V4346 V4347) (if (shen.unlocked? V4345) (do (shen.incinfs) (shen.sigf (assoc V4342 (value shen.*sigf*)) V4343 V4344 V4345 V4346 V4347)) false))

(defun shen.sigf (V4362 V4363 V4364 V4365 V4366 V4367) (cond ((cons? V4362) ((((((tl V4362) V4363) V4364) V4365) V4366) V4367)) (true false)))

(defun shen.freshterm (V4368) (let V (absvector 3) (let V0 (address-> V 0 shen.print-freshterm) (let V1 (address-> V0 1 V4368) (let V2 (address-> V1 2 (set shen.*gensym* (+ 1 (value shen.*gensym*)))) V2)))))

(defun shen.print-freshterm (V4369) (cn "&&" (str (<-address V4369 1))))

(defun shen.search-user-datatypes (V4370 V4371 V4372 V4373 V4374 V4375 V4376) (let C3907 (if (shen.unlocked? V4374) (let Tm3908 (shen.lazyderef V4372 V4373) (if (cons? Tm3908) (let Tm3909 (shen.lazyderef (hd Tm3908) V4373) (if (cons? Tm3909) (let Fn (tl Tm3909) (do (shen.incinfs) (call (((shen.deref Fn V4373) (shen.deref V4370 V4373)) (shen.deref V4371 V4373)) V4373 V4374 V4375 V4376))) false)) false)) false) (if (= C3907 false) (if (shen.unlocked? V4374) (let Tm3910 (shen.lazyderef V4372 V4373) (if (cons? Tm3910) (let Ds (tl Tm3910) (do (shen.incinfs) (shen.search-user-datatypes V4370 V4371 Ds V4373 V4374 V4375 V4376))) false)) false) C3907)))

(defun shen.l-rules (V4377 V4378 V4379 V4380 V4381 V4382 V4383) (let K3913 (+ V4382 1) (let C3918 (if (shen.unlocked? V4381) (let Tm3919 (shen.lazyderef V4377 V4380) (if (= Tm3919 ()) (let Tm3920 (shen.lazyderef V4379 V4380) (if (= Tm3920 true) (do (shen.incinfs) (shen.cut V4380 V4381 K3913 (freeze (bind V4378 () V4380 V4381 K3913 V4383)))) false)) false)) false) (if (= C3918 false) (let C3921 (if (shen.unlocked? V4381) (let Tm3922 (shen.lazyderef V4377 V4380) (if (cons? Tm3922) (let Tm3923 (shen.lazyderef (hd Tm3922) V4380) (if (cons? Tm3923) (let Tm3924 (shen.lazyderef (hd Tm3923) V4380) (if (cons? Tm3924) (let Tm3925 (shen.lazyderef (hd Tm3924) V4380) (if (= Tm3925 cons) (let Tm3926 (shen.lazyderef (tl Tm3924) V4380) (if (cons? Tm3926) (let X (hd Tm3926) (let Tm3927 (shen.lazyderef (tl Tm3926) V4380) (if (cons? Tm3927) (let Y (hd Tm3927) (let Tm3928 (shen.lazyderef (tl Tm3927) V4380) (if (= Tm3928 ()) (let Tm3929 (shen.lazyderef (tl Tm3923) V4380) (if (cons? Tm3929) (let Colon (hd Tm3929) (let Tm3930 (shen.lazyderef (tl Tm3929) V4380) (if (cons? Tm3930) (let Tm3931 (shen.lazyderef (hd Tm3930) V4380) (if (cons? Tm3931) (let Tm3932 (shen.lazyderef (hd Tm3931) V4380) (if (= Tm3932 list) (let Tm3933 (shen.lazyderef (tl Tm3931) V4380) (if (cons? Tm3933) (let A (hd Tm3933) (let Tm3934 (shen.lazyderef (tl Tm3933) V4380) (if (= Tm3934 ()) (let Tm3935 (shen.lazyderef (tl Tm3930) V4380) (if (= Tm3935 ()) (let Hyp (tl Tm3922) (do (shen.incinfs) (when (= (shen.deref Colon V4380) (intern ":")) V4380 V4381 K3913 (freeze (shen.cut V4380 V4381 K3913 (freeze (shen.l-rules (cons (cons X (cons Colon (cons A ()))) (cons (cons Y (cons Colon (cons (cons list (cons A ())) ()))) Hyp)) V4378 true V4380 V4381 K3913 V4383))))))) false)) false))) false)) false)) false)) false))) false)) false))) false))) false)) false)) false)) false)) false)) false) (if (= C3921 false) (let C3936 (if (shen.unlocked? V4381) (let Tm3937 (shen.lazyderef V4377 V4380) (if (cons? Tm3937) (let Tm3938 (shen.lazyderef (hd Tm3937) V4380) (if (cons? Tm3938) (let Tm3939 (shen.lazyderef (hd Tm3938) V4380) (if (cons? Tm3939) (let Tm3940 (shen.lazyderef (hd Tm3939) V4380) (if (= Tm3940 @p) (let Tm3941 (shen.lazyderef (tl Tm3939) V4380) (if (cons? Tm3941) (let X (hd Tm3941) (let Tm3942 (shen.lazyderef (tl Tm3941) V4380) (if (cons? Tm3942) (let Y (hd Tm3942) (let Tm3943 (shen.lazyderef (tl Tm3942) V4380) (if (= Tm3943 ()) (let Tm3944 (shen.lazyderef (tl Tm3938) V4380) (if (cons? Tm3944) (let Colon (hd Tm3944) (let Tm3945 (shen.lazyderef (tl Tm3944) V4380) (if (cons? Tm3945) (let Tm3946 (shen.lazyderef (hd Tm3945) V4380) (if (cons? Tm3946) (let A (hd Tm3946) (let Tm3947 (shen.lazyderef (tl Tm3946) V4380) (if (cons? Tm3947) (let Tm3948 (shen.lazyderef (hd Tm3947) V4380) (if (= Tm3948 *) (let Tm3949 (shen.lazyderef (tl Tm3947) V4380) (if (cons? Tm3949) (let B (hd Tm3949) (let Tm3950 (shen.lazyderef (tl Tm3949) V4380) (if (= Tm3950 ()) (let Tm3951 (shen.lazyderef (tl Tm3945) V4380) (if (= Tm3951 ()) (let Hyp (tl Tm3937) (do (shen.incinfs) (when (= (shen.deref Colon V4380) (intern ":")) V4380 V4381 K3913 (freeze (shen.cut V4380 V4381 K3913 (freeze (shen.l-rules (cons (cons X (cons Colon (cons A ()))) (cons (cons Y (cons Colon (cons B ()))) Hyp)) V4378 true V4380 V4381 K3913 V4383))))))) false)) false))) false)) false)) false))) false)) false))) false)) false))) false))) false)) false)) false)) false)) false)) false) (if (= C3936 false) (let C3952 (if (shen.unlocked? V4381) (let Tm3953 (shen.lazyderef V4377 V4380) (if (cons? Tm3953) (let Tm3954 (shen.lazyderef (hd Tm3953) V4380) (if (cons? Tm3954) (let Tm3955 (shen.lazyderef (hd Tm3954) V4380) (if (cons? Tm3955) (let Tm3956 (shen.lazyderef (hd Tm3955) V4380) (if (= Tm3956 @s) (let Tm3957 (shen.lazyderef (tl Tm3955) V4380) (if (cons? Tm3957) (let X (hd Tm3957) (let Tm3958 (shen.lazyderef (tl Tm3957) V4380) (if (cons? Tm3958) (let Y (hd Tm3958) (let Tm3959 (shen.lazyderef (tl Tm3958) V4380) (if (= Tm3959 ()) (let Tm3960 (shen.lazyderef (tl Tm3954) V4380) (if (cons? Tm3960) (let Colon (hd Tm3960) (let Tm3961 (shen.lazyderef (tl Tm3960) V4380) (if (cons? Tm3961) (let Tm3962 (shen.lazyderef (hd Tm3961) V4380) (if (= Tm3962 string) (let Tm3963 (shen.lazyderef (tl Tm3961) V4380) (if (= Tm3963 ()) (let Hyp (tl Tm3953) (do (shen.incinfs) (when (= (shen.deref Colon V4380) (intern ":")) V4380 V4381 K3913 (freeze (shen.cut V4380 V4381 K3913 (freeze (shen.l-rules (cons (cons X (cons Colon (cons string ()))) (cons (cons Y (cons Colon (cons string ()))) Hyp)) V4378 true V4380 V4381 K3913 V4383))))))) false)) false)) false))) false)) false))) false))) false)) false)) false)) false)) false)) false) (if (= C3952 false) (let C3964 (if (shen.unlocked? V4381) (let Tm3965 (shen.lazyderef V4377 V4380) (if (cons? Tm3965) (let Tm3966 (shen.lazyderef (hd Tm3965) V4380) (if (cons? Tm3966) (let Tm3967 (shen.lazyderef (hd Tm3966) V4380) (if (cons? Tm3967) (let Tm3968 (shen.lazyderef (hd Tm3967) V4380) (if (= Tm3968 @v) (let Tm3969 (shen.lazyderef (tl Tm3967) V4380) (if (cons? Tm3969) (let X (hd Tm3969) (let Tm3970 (shen.lazyderef (tl Tm3969) V4380) (if (cons? Tm3970) (let Y (hd Tm3970) (let Tm3971 (shen.lazyderef (tl Tm3970) V4380) (if (= Tm3971 ()) (let Tm3972 (shen.lazyderef (tl Tm3966) V4380) (if (cons? Tm3972) (let Colon (hd Tm3972) (let Tm3973 (shen.lazyderef (tl Tm3972) V4380) (if (cons? Tm3973) (let Tm3974 (shen.lazyderef (hd Tm3973) V4380) (if (cons? Tm3974) (let Tm3975 (shen.lazyderef (hd Tm3974) V4380) (if (= Tm3975 vector) (let Tm3976 (shen.lazyderef (tl Tm3974) V4380) (if (cons? Tm3976) (let A (hd Tm3976) (let Tm3977 (shen.lazyderef (tl Tm3976) V4380) (if (= Tm3977 ()) (let Tm3978 (shen.lazyderef (tl Tm3973) V4380) (if (= Tm3978 ()) (let Hyp (tl Tm3965) (do (shen.incinfs) (when (= (shen.deref Colon V4380) (intern ":")) V4380 V4381 K3913 (freeze (shen.cut V4380 V4381 K3913 (freeze (shen.l-rules (cons (cons X (cons Colon (cons A ()))) (cons (cons Y (cons Colon (cons (cons vector (cons A ())) ()))) Hyp)) V4378 true V4380 V4381 K3913 V4383))))))) false)) false))) false)) false)) false)) false))) false)) false))) false))) false)) false)) false)) false)) false)) false) (if (= C3964 false) (let C3979 (if (shen.unlocked? V4381) (let Tm3980 (shen.lazyderef V4377 V4380) (if (cons? Tm3980) (let P (hd Tm3980) (let Hyp (tl Tm3980) (let Tm3981 (shen.lazyderef V4378 V4380) (let GoTo3982 (lambda Q (lambda Normalised (do (shen.incinfs) (bind Q P V4380 V4381 K3913 (freeze (shen.l-rules Hyp Normalised V4379 V4380 V4381 K3913 V4383)))))) (if (cons? Tm3981) (let Q (hd Tm3981) (let Normalised (tl Tm3981) ((GoTo3982 Q) Normalised))) (if (shen.pvar? Tm3981) (let Q (shen.newpv V4380) (shen.gc V4380 (let Normalised (shen.newpv V4380) (shen.gc V4380 (shen.bind! Tm3981 (cons Q Normalised) V4380 (freeze ((GoTo3982 Q) Normalised))))))) false)))))) false)) false) (if (= C3979 false) (shen.unlock V4381 K3913) C3979)) C3964)) C3952)) C3936)) C3921)) C3918))))

(defun shen.t* (V4384 V4385 V4386 V4387 V4388 V4389) (let K3985 (+ V4388 1) (let C3989 (if (shen.unlocked? V4387) (let Tm3990 (shen.lazyderef V4384 V4386) (if (cons? Tm3990) (let Tm3991 (shen.lazyderef (hd Tm3990) V4386) (if (= Tm3991 define) (let Tm3992 (shen.lazyderef (tl Tm3990) V4386) (if (cons? Tm3992) (let F (hd Tm3992) (let X (tl Tm3992) (let SigxRules (shen.newpv V4386) (shen.gc V4386 (let Rules (shen.newpv V4386) (shen.gc V4386 (let FreshSig (shen.newpv V4386) (shen.gc V4386 (let Sig (shen.newpv V4386) (shen.gc V4386 (do (shen.incinfs) (shen.cut V4386 V4387 K3985 (freeze (bind SigxRules (shen.sigxrules (cons F X)) V4386 V4387 K3985 (freeze (bind Sig (fst (shen.lazyderef SigxRules V4386)) V4386 V4387 K3985 (freeze (bind Rules (snd (shen.lazyderef SigxRules V4386)) V4386 V4387 K3985 (freeze (bind FreshSig (shen.freshen-sig (shen.deref Sig V4386)) V4386 V4387 K3985 (freeze (shen.t*-rules F Rules FreshSig 1 V4386 V4387 K3985 (freeze (is Sig V4385 V4386 V4387 K3985 V4389)))))))))))))))))))))))) false)) false)) false)) false) (if (= C3989 false) (shen.unlock V4387 K3985) C3989))))

(defun shen.sigxrules (V4390) (compile (lambda X (shen.<sig*rules> X)) V4390))

(defun shen.<sig*rules> (V4391) (let Result (if (shen.non-empty-stream? V4391) (let F (shen.hds V4391) (let News3994 (shen.tls V4391) (if (shen.=hd? News3994 {) (let News3995 (shen.tls News3994) (let Parseshen.<signature> (shen.<signature> News3995) (if (shen.parse-failure? Parseshen.<signature>) (shen.parse-failure) (if (shen.=hd? Parseshen.<signature> }) (let News3996 (shen.tls Parseshen.<signature>) (let Parseshen.<rules*> (shen.<rules*> News3996) (if (shen.parse-failure? Parseshen.<rules*>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<rules*>) (let Rectified (shen.rectify-type (shen.<-out Parseshen.<signature>)) (@p Rectified (shen.<-out Parseshen.<rules*>))))))) (shen.parse-failure))))) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.freshen-sig (V4392) (let Vs (shen.extract-vars V4392) (let Assoc (map (lambda V (cons V (shen.freshterm (concat & V)))) Vs) (shen.freshen-type Assoc V4392))))

(defun shen.freshen-type (V4393 V4394) (cond ((= () V4393) V4394) ((and (cons? V4393) (cons? (hd V4393))) (shen.freshen-type (tl V4393) (subst (tl (hd V4393)) (hd (hd V4393)) V4394))) (true (shen.f-error shen.freshen-type))))

(defun shen.<rules*> (V4395) (let Result (let Parseshen.<rule*> (shen.<rule*> V4395) (if (shen.parse-failure? Parseshen.<rule*>) (shen.parse-failure) (let Parseshen.<rules*> (shen.<rules*> Parseshen.<rule*>) (if (shen.parse-failure? Parseshen.<rules*>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<rules*>) (cons (shen.linearise (shen.<-out Parseshen.<rule*>)) (shen.<-out Parseshen.<rules*>))))))) (if (shen.parse-failure? Result) (let Result (let Parseshen.<rule*> (shen.<rule*> V4395) (if (shen.parse-failure? Parseshen.<rule*>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<rule*>) (cons (shen.linearise (shen.<-out Parseshen.<rule*>)) ())))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)) Result)))

(defun shen.<rule*> (V4396) (let Result (let Parseshen.<patterns> (shen.<patterns> V4396) (if (shen.parse-failure? Parseshen.<patterns>) (shen.parse-failure) (if (shen.=hd? Parseshen.<patterns> ->) (let News3999 (shen.tls Parseshen.<patterns>) (if (shen.non-empty-stream? News3999) (let Action (shen.hds News3999) (let News4000 (shen.tls News3999) (if (shen.=hd? News4000 where) (let News4001 (shen.tls News4000) (if (shen.non-empty-stream? News4001) (let Guard (shen.hds News4001) (let News4002 (shen.tls News4001) (shen.comb (shen.in-> News4002) (@p (shen.<-out Parseshen.<patterns>) (cons where (cons Guard (cons Action ()))))))) (shen.parse-failure))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)))) (if (shen.parse-failure? Result) (let Result (let Parseshen.<patterns> (shen.<patterns> V4396) (if (shen.parse-failure? Parseshen.<patterns>) (shen.parse-failure) (if (shen.=hd? Parseshen.<patterns> <-) (let News4003 (shen.tls Parseshen.<patterns>) (if (shen.non-empty-stream? News4003) (let Action (shen.hds News4003) (let News4004 (shen.tls News4003) (if (shen.=hd? News4004 where) (let News4005 (shen.tls News4004) (if (shen.non-empty-stream? News4005) (let Guard (shen.hds News4005) (let News4006 (shen.tls News4005) (shen.comb (shen.in-> News4006) (@p (shen.<-out Parseshen.<patterns>) (shen.correct (cons where (cons Guard (cons Action ())))))))) (shen.parse-failure))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)))) (if (shen.parse-failure? Result) (let Result (let Parseshen.<patterns> (shen.<patterns> V4396) (if (shen.parse-failure? Parseshen.<patterns>) (shen.parse-failure) (if (shen.=hd? Parseshen.<patterns> <-) (let News4007 (shen.tls Parseshen.<patterns>) (if (shen.non-empty-stream? News4007) (let Action (shen.hds News4007) (let News4008 (shen.tls News4007) (shen.comb (shen.in-> News4008) (@p (shen.<-out Parseshen.<patterns>) (shen.correct Action))))) (shen.parse-failure))) (shen.parse-failure)))) (if (shen.parse-failure? Result) (let Result (let Parseshen.<patterns> (shen.<patterns> V4396) (if (shen.parse-failure? Parseshen.<patterns>) (shen.parse-failure) (if (shen.=hd? Parseshen.<patterns> ->) (let News4009 (shen.tls Parseshen.<patterns>) (if (shen.non-empty-stream? News4009) (let Action (shen.hds News4009) (let News4010 (shen.tls News4009) (shen.comb (shen.in-> News4010) (@p (shen.<-out Parseshen.<patterns>) Action)))) (shen.parse-failure))) (shen.parse-failure)))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)) Result)) Result)) Result)))

(defun shen.correct (V4397) (cond ((and (cons? V4397) (and (= where (hd V4397)) (and (cons? (tl V4397)) (and (cons? (tl (tl V4397))) (and (cons? (hd (tl (tl V4397)))) (and (= fail-if (hd (hd (tl (tl V4397))))) (and (cons? (tl (hd (tl (tl V4397))))) (and (cons? (tl (tl (hd (tl (tl V4397)))))) (and (= () (tl (tl (tl (hd (tl (tl V4397))))))) (= () (tl (tl (tl V4397))))))))))))) (cons where (cons (cons and (cons (hd (tl V4397)) (cons (cons not (cons (tl (hd (tl (tl V4397)))) ())) ()))) (tl (tl (hd (tl (tl V4397)))))))) ((and (cons? V4397) (and (= where (hd V4397)) (and (cons? (tl V4397)) (and (cons? (tl (tl V4397))) (= () (tl (tl (tl V4397)))))))) (cons where (cons (cons and (cons (hd (tl V4397)) (cons (cons not (cons (cons = (cons (hd (tl (tl V4397))) (cons (cons fail ()) ()))) ())) ()))) (tl (tl V4397))))) ((and (cons? V4397) (and (= fail-if (hd V4397)) (and (cons? (tl V4397)) (and (cons? (tl (tl V4397))) (= () (tl (tl (tl V4397)))))))) (cons where (cons (cons not (cons (tl V4397) ())) (tl (tl V4397))))) (true (cons where (cons (cons not (cons (cons = (cons V4397 (cons (cons fail ()) ()))) ())) (cons V4397 ()))))))

(defun shen.t*-rules (V4398 V4399 V4400 V4401 V4402 V4403 V4404 V4405) (let K4013 (+ V4404 1) (let C4019 (if (shen.unlocked? V4403) (let Tm4020 (shen.lazyderef V4399 V4402) (if (= Tm4020 ()) (do (shen.incinfs) (thaw V4405)) false)) false) (if (= C4019 false) (let C4021 (if (shen.unlocked? V4403) (let Tm4022 (shen.lazyderef V4399 V4402) (if (cons? Tm4022) (let Rule (hd Tm4022) (let Rules (tl Tm4022) (let Fresh (shen.newpv V4402) (shen.gc V4402 (do (shen.incinfs) (bind Fresh (shen.freshen-rule (shen.deref Rule V4402)) V4402 V4403 K4013 (freeze (shen.t*-rule V4398 V4401 (fst (shen.lazyderef Fresh V4402)) (snd (shen.lazyderef Fresh V4402)) V4400 V4402 V4403 K4013 (freeze (shen.cut V4402 V4403 K4013 (freeze (shen.t*-rules V4398 Rules V4400 (+ V4401 1) V4402 V4403 K4013 V4405)))))))))))) false)) false) (if (= C4021 false) (shen.unlock V4403 K4013) C4021)) C4019))))

(defun shen.freshen-rule (V4406) (cond ((tuple? V4406) (let Vs (shen.extract-vars (fst V4406)) (let Assoc (map (lambda V (cons V (shen.freshterm V))) Vs) (@p (shen.freshen Assoc (fst V4406)) (shen.freshen Assoc (snd V4406)))))) (true (shen.f-error shen.freshen-rule))))

(defun shen.freshen (V4407 V4408) (cond ((= () V4407) V4408) ((and (cons? V4407) (cons? (hd V4407))) (shen.freshen (tl V4407) (shen.beta (hd (hd V4407)) (tl (hd V4407)) V4408))) (true (shen.f-error shen.freshen))))

(defun shen.t*-rule (V4409 V4410 V4411 V4412 V4413 V4414 V4415 V4416 V4417) (let C4032 (if (shen.unlocked? V4415) (do (shen.incinfs) (shen.t*-rule-h V4411 V4412 V4413 V4414 V4415 V4416 V4417)) false) (if (= C4032 false) (if (shen.unlocked? V4415) (let Err (shen.newpv V4414) (shen.gc V4414 (do (shen.incinfs) (bind Err (simple-error (cn "type error in rule " (shen.app V4410 (cn " of " (shen.app V4409 "
" shen.a)) shen.a))) V4414 V4415 V4416 V4417)))) false) C4032)))

(defun shen.t*-rule-h (V4418 V4419 V4420 V4421 V4422 V4423 V4424) (let K4035 (+ V4423 1) (let C4040 (if (shen.unlocked? V4422) (let Tm4041 (shen.lazyderef V4418 V4421) (if (= Tm4041 ()) (let Tm4042 (shen.lazyderef V4420 V4421) (if (cons? Tm4042) (let Tm4043 (shen.lazyderef (hd Tm4042) V4421) (if (= Tm4043 -->) (let Tm4044 (shen.lazyderef (tl Tm4042) V4421) (if (cons? Tm4044) (let A (hd Tm4044) (let Tm4045 (shen.lazyderef (tl Tm4044) V4421) (if (= Tm4045 ()) (do (shen.incinfs) (shen.cut V4421 V4422 K4035 (freeze (shen.t*-correct V4419 A () V4421 V4422 K4035 V4424)))) false))) false)) false)) false)) false)) false) (if (= C4040 false) (let C4046 (if (shen.unlocked? V4422) (let B (shen.newpv V4421) (shen.gc V4421 (let Hyps (shen.newpv V4421) (shen.gc V4421 (do (shen.incinfs) (shen.t*-integrity V4418 V4420 Hyps B V4421 V4422 K4035 (freeze (shen.cut V4421 V4422 K4035 (freeze (shen.t*-correct V4419 B Hyps V4421 V4422 K4035 V4424)))))))))) false) (if (= C4046 false) (shen.unlock V4422 K4035) C4046)) C4040))))

(defun shen.t*-correct (V4425 V4426 V4427 V4428 V4429 V4430 V4431) (let K4049 (+ V4430 1) (let C4054 (if (shen.unlocked? V4429) (let Tm4055 (shen.lazyderef V4425 V4428) (if (cons? Tm4055) (let Tm4056 (shen.lazyderef (hd Tm4055) V4428) (if (= Tm4056 where) (let Tm4057 (shen.lazyderef (tl Tm4055) V4428) (if (cons? Tm4057) (let G (hd Tm4057) (let Tm4058 (shen.lazyderef (tl Tm4057) V4428) (if (cons? Tm4058) (let R (hd Tm4058) (let Tm4059 (shen.lazyderef (tl Tm4058) V4428) (if (= Tm4059 ()) (let CurryG (shen.newpv V4428) (shen.gc V4428 (do (shen.incinfs) (shen.cut V4428 V4429 K4049 (freeze (bind CurryG (shen.curry G) V4428 V4429 K4049 (freeze (shen.system-S-h CurryG boolean V4427 V4428 V4429 K4049 (freeze (shen.cut V4428 V4429 K4049 (freeze (shen.t*-correct R V4426 (cons (cons CurryG (cons (intern ":") (cons verified ()))) V4427) V4428 V4429 K4049 V4431)))))))))))) false))) false))) false)) false)) false)) false) (if (= C4054 false) (let C4060 (if (shen.unlocked? V4429) (do (shen.incinfs) (shen.system-S-h (shen.curry V4425) V4426 V4427 V4428 V4429 K4049 V4431)) false) (if (= C4060 false) (shen.unlock V4429 K4049) C4060)) C4054))))

(defun shen.t*-integrity (V4432 V4433 V4434 V4435 V4436 V4437 V4438 V4439) (let K4064 (+ V4438 1) (let C4070 (if (shen.unlocked? V4437) (let Tm4071 (shen.lazyderef V4432 V4436) (if (= Tm4071 ()) (let Tm4072 (shen.lazyderef V4434 V4436) (let GoTo4073 (freeze (do (shen.incinfs) (is! V4433 V4435 V4436 V4437 K4064 V4439))) (if (= Tm4072 ()) (thaw GoTo4073) (if (shen.pvar? Tm4072) (shen.bind! Tm4072 () V4436 GoTo4073) false)))) false)) false) (if (= C4070 false) (let C4074 (if (shen.unlocked? V4437) (let Tm4075 (shen.lazyderef V4432 V4436) (if (cons? Tm4075) (let P (hd Tm4075) (let Ps (tl Tm4075) (let Tm4076 (shen.lazyderef V4433 V4436) (if (cons? Tm4076) (let A (hd Tm4076) (let Tm4077 (shen.lazyderef (tl Tm4076) V4436) (if (cons? Tm4077) (let Tm4078 (shen.lazyderef (hd Tm4077) V4436) (if (= Tm4078 -->) (let Tm4079 (shen.lazyderef (tl Tm4077) V4436) (if (cons? Tm4079) (let B (hd Tm4079) (let Tm4080 (shen.lazyderef (tl Tm4079) V4436) (if (= Tm4080 ()) (let Tm4081 (shen.lazyderef V4434 V4436) (let GoTo4082 (lambda Hyp (lambda Hyps (let PHyps (shen.newpv V4436) (shen.gc V4436 (do (shen.incinfs) (bind Hyp (cons P (cons (intern ":") (cons A ()))) V4436 V4437 K4064 (freeze (shen.p-hyps P PHyps V4436 V4437 K4064 (freeze (shen.cut V4436 V4437 K4064 (freeze (shen.system-S-h P A PHyps V4436 V4437 K4064 (freeze (shen.cut V4436 V4437 K4064 (freeze (shen.t*-integrity Ps B Hyps V4435 V4436 V4437 K4064 V4439)))))))))))))))) (if (cons? Tm4081) (let Hyp (hd Tm4081) (let Hyps (tl Tm4081) ((GoTo4082 Hyp) Hyps))) (if (shen.pvar? Tm4081) (let Hyp (shen.newpv V4436) (shen.gc V4436 (let Hyps (shen.newpv V4436) (shen.gc V4436 (shen.bind! Tm4081 (cons Hyp Hyps) V4436 (freeze ((GoTo4082 Hyp) Hyps))))))) false)))) false))) false)) false)) false))) false)))) false)) false) (if (= C4074 false) (shen.unlock V4437 K4064) C4074)) C4070))))

(defun shen.p-hyps (V4440 V4441 V4442 V4443 V4444 V4445) (let K4085 (+ V4444 1) (let C4089 (if (shen.unlocked? V4443) (let A (shen.newpv V4442) (shen.gc V4442 (do (shen.incinfs) (when (shen.freshterm? (shen.deref V4440 V4442)) V4442 V4443 K4085 (freeze (shen.cut V4442 V4443 K4085 (freeze (bind V4441 (cons (cons V4440 (cons (intern ":") (cons A ()))) ()) V4442 V4443 K4085 V4445)))))))) false) (if (= C4089 false) (let C4090 (if (shen.unlocked? V4443) (let Tm4091 (shen.lazyderef V4440 V4442) (if (cons? Tm4091) (let X (hd Tm4091) (let Y (tl Tm4091) (let XHyps (shen.newpv V4442) (shen.gc V4442 (let YHyps (shen.newpv V4442) (shen.gc V4442 (do (shen.incinfs) (shen.cut V4442 V4443 K4085 (freeze (shen.p-hyps X XHyps V4442 V4443 K4085 (freeze (shen.p-hyps Y YHyps V4442 V4443 K4085 (freeze (shen.join XHyps YHyps V4441 V4442 V4443 K4085 V4445)))))))))))))) false)) false) (if (= C4090 false) (let C4092 (if (shen.unlocked? V4443) (do (shen.incinfs) (bind V4441 () V4442 V4443 K4085 V4445)) false) (if (= C4092 false) (shen.unlock V4443 K4085) C4092)) C4090)) C4089))))

(defun shen.freshterm? (V4446) (and (absvector? V4446) (and (not (string? V4446)) (= (<-address V4446 0) shen.print-freshterm))))

(defun shen.join (V4447 V4448 V4449 V4450 V4451 V4452 V4453) (let C4100 (if (shen.unlocked? V4451) (let Tm4101 (shen.lazyderef V4447 V4450) (if (= Tm4101 ()) (do (shen.incinfs) (bind V4449 V4448 V4450 V4451 V4452 V4453)) false)) false) (if (= C4100 false) (if (shen.unlocked? V4451) (let Tm4102 (shen.lazyderef V4447 V4450) (if (cons? Tm4102) (let X (hd Tm4102) (let Y (tl Tm4102) (let Tm4103 (shen.lazyderef V4449 V4450) (let GoTo4104 (lambda X* (lambda Z (do (shen.incinfs) (bind X* X V4450 V4451 V4452 (freeze (shen.join Y V4448 Z V4450 V4451 V4452 V4453)))))) (if (cons? Tm4103) (let X* (hd Tm4103) (let Z (tl Tm4103) ((GoTo4104 X*) Z))) (if (shen.pvar? Tm4103) (let X* (shen.newpv V4450) (shen.gc V4450 (let Z (shen.newpv V4450) (shen.gc V4450 (shen.bind! Tm4103 (cons X* Z) V4450 (freeze ((GoTo4104 X*) Z))))))) false)))))) false)) false) C4100)))

(defun shen.shen () (do (shen.credits) (shen.loop)))

(defun shen.loop () (do (shen.initialise_environment) (do (shen.prompt) (do (trap-error (shen.read-evaluate-print) (lambda E (do (pr (error-to-string E) (stoutput)) (nl 0)))) (shen.loop)))))

(defun shen.credits () (do (pr "
Shen, www.shenlanguage.org, copyright (C) 2010-2021, Mark Tarver
" (stoutput)) (do (pr (cn "version: S" (shen.app (value *version*) (cn ", language: " (shen.app (value *language*) (cn ", platform: " (shen.app (value *implementation*) (cn " " (shen.app (value *release*) "
" shen.a)) shen.a)) shen.a)) shen.a)) (stoutput)) (pr (cn "port " (shen.app (value *port*) (cn ", ported by " (shen.app (value *porters*) "

" shen.a)) shen.a)) (stoutput)))))

(defun shen.initialise_environment () (do (set shen.*call* 0) (set shen.*infs* 0)))

(defun shen.prompt () (if (value shen.*tc*) (pr (cn "
(" (shen.app (length (value shen.*history*)) "+) " shen.a)) (stoutput)) (pr (cn "
(" (shen.app (length (value shen.*history*)) "-) " shen.a)) (stoutput))))

(defun shen.read-evaluate-print () (let Package (value shen.*package*) (let Lineread (shen.package-user-input Package (lineread (stinput))) (let History (shen.update-history) (shen.evaluate-lineread Lineread History (value shen.*tc*))))))

(defun shen.package-user-input (V4475 V4476) (cond ((= null V4475) V4476) (true (let Str (str V4475) (let External (external V4475) (map (lambda X (shen.pui-h Str External X)) V4476))))))

(defun shen.pui-h (V4481 V4482 V4483) (cond ((and (cons? V4483) (and (= fn (hd V4483)) (and (cons? (tl V4483)) (= () (tl (tl V4483)))))) (if (shen.internal? (hd (tl V4483)) V4481 V4482) (cons fn (cons (shen.intern-in-package V4481 (hd (tl V4483))) ())) V4483)) ((cons? V4483) (if (shen.internal? (hd V4483) V4481 V4482) (cons (shen.intern-in-package V4481 (hd V4483)) (map (lambda Y (shen.pui-h V4481 V4482 Y)) (tl V4483))) (if (cons? (hd V4483)) (map (lambda Y (shen.pui-h V4481 V4482 Y)) V4483) (cons (hd V4483) (map (lambda Y (shen.pui-h V4481 V4482 Y)) (tl V4483)))))) (true V4483)))

(defun shen.update-history () (set shen.*history* (cons (it) (value shen.*history*))))

(defun shen.evaluate-lineread (V4494 V4495 V4496) (cond ((and (cons? V4494) (and (= () (tl V4494)) (and (cons? V4495) (and (= "!!" (hd V4495)) (cons? (tl V4495)))))) (let Y (read-from-string (hd (tl V4495))) (let NewHistory (set shen.*history* (cons (hd (tl V4495)) (tl V4495))) (let Print (pr (shen.app (hd (tl V4495)) "
" shen.a) (stoutput)) (shen.evaluate-lineread Y NewHistory V4496))))) ((and (cons? V4494) (and (= () (tl V4494)) (and (cons? V4495) (and (shen.+string? (hd V4495)) (= "%" (hdstr (hd V4495))))))) (let Read (hd (read-from-string (tlstr (hd V4495)))) (let Peek (shen.peek-history Read (tlstr (hd V4495)) (tl V4495)) (let NewHistory (set shen.*history* (tl V4495)) (abort))))) ((and (cons? V4494) (and (= () (tl V4494)) (and (cons? V4495) (and (shen.+string? (hd V4495)) (= "!" (hdstr (hd V4495))))))) (let Read (hd (read-from-string (tlstr (hd V4495)))) (let Match (shen.use-history Read (tlstr (hd V4495)) (tl V4495)) (let Print (pr (shen.app Match "
" shen.a) (stoutput)) (let Y (read-from-string Match) (let NewHistory (set shen.*history* (cons Match (tl V4495))) (shen.evaluate-lineread Y NewHistory V4496))))))) ((and (cons? V4494) (and (= () (tl V4494)) (and (cons? V4495) (and (shen.+string? (hd V4495)) (= "%" (hdstr (hd V4495))))))) (let Read (hd (read-from-string (tlstr (hd V4495)))) (let Peek (shen.peek-history Read (tlstr (hd V4495)) (tl V4495)) (let NewHistory (set shen.*history* (tl V4495)) (abort))))) ((= true V4496) (shen.check-eval-and-print V4494)) ((= false V4496) (shen.eval-and-print V4494)) (true (simple-error "implementation error in shen.evaluate-lineread"))))

(defun shen.use-history (V4497 V4498 V4499) (if (integer? V4497) (nth (+ 1 V4497) (reverse V4499)) (if (symbol? V4497) (shen.string-match V4498 V4499) (simple-error "! expects a number or a symbol
"))))

(defun shen.peek-history (V4500 V4501 V4502) (if (integer? V4500) (pr (cn "
" (shen.app (nth (+ 1 V4500) (reverse V4502)) "" shen.a)) (stoutput)) (if (or (= V4501 "") (symbol? V4500)) (shen.recursive-string-match 0 V4501 (reverse V4502)) (simple-error "% expects a number or a symbol
"))))

(defun shen.string-match (V4512 V4513) (cond ((= () V4513) (simple-error "
input not found")) ((and (cons? V4513) (shen.string-prefix? V4512 (hd V4513))) (hd V4513)) ((cons? V4513) (shen.string-match V4512 (tl V4513))) (true (simple-error "implementation error in shen.string-match"))))

(defun shen.string-prefix? (V4521 V4522) (cond ((= "" V4521) true) ((and (shen.+string? V4521) (shen.whitespace? (string->n (hdstr V4521)))) (shen.string-prefix? (tlstr V4521) V4522)) ((and (shen.+string? V4522) (shen.whitespace? (string->n (hdstr V4522)))) (shen.string-prefix? V4521 (tlstr V4522))) ((and (shen.+string? V4522) (= "(" (hdstr V4522))) (shen.string-prefix? V4521 (tlstr V4522))) ((and (shen.+string? V4521) (and (shen.+string? V4522) (= (hdstr V4521) (hdstr V4522)))) (shen.string-prefix? (tlstr V4521) (tlstr V4522))) (true false)))

(defun shen.recursive-string-match (V4533 V4534 V4535) (cond ((= () V4535) shen.skip) ((cons? V4535) (do (if (shen.string-prefix? V4534 (hd V4535)) (pr (shen.app V4533 (cn ". " (shen.app (hd V4535) "
" shen.a)) shen.a) (stoutput)) shen.skip) (shen.recursive-string-match (+ V4533 1) V4534 (tl V4535)))) (true (simple-error "implementation error in shen.recursive-string-match"))))

(defun shen.f-error (V4567) (do (pr (cn "partial function " (shen.app V4567 ";
" shen.a)) (stoutput)) (do (if (and (not (shen.tracked? V4567)) (y-or-n? (cn "track " (shen.app V4567 "? " shen.a)))) (shen.track-function (ps V4567)) shen.ok) (simple-error "aborted"))))

(defun shen.tracked? (V4568) (element? V4568 (value shen.*tracking*)))

(defun track (V4569) (let Source (ps V4569) (shen.track-function Source)))

(defun shen.track-function (V4572) (cond ((and (cons? V4572) (and (= defun (hd V4572)) (and (cons? (tl V4572)) (and (cons? (tl (tl V4572))) (and (cons? (tl (tl (tl V4572)))) (= () (tl (tl (tl (tl V4572)))))))))) (let KL (cons defun (cons (hd (tl V4572)) (cons (hd (tl (tl V4572))) (cons (shen.insert-tracking-code (hd (tl V4572)) (hd (tl (tl V4572))) (hd (tl (tl (tl V4572))))) ())))) (let Ob (eval-kl KL) (let Tr (set shen.*tracking* (cons Ob (value shen.*tracking*))) Ob)))) (true (simple-error "implementation error in shen.track-function"))))

(defun shen.insert-tracking-code (V4573 V4574 V4575) (cons do (cons (cons set (cons shen.*call* (cons (cons + (cons (cons value (cons shen.*call* ())) (cons 1 ()))) ()))) (cons (cons do (cons (cons shen.input-track (cons (cons value (cons shen.*call* ())) (cons V4573 (cons (shen.cons-form (shen.prolog-track V4575 V4574)) ())))) (cons (cons do (cons (cons shen.terpri-or-read-char ()) (cons (cons let (cons (protect Result) (cons V4575 (cons (cons do (cons (cons shen.output-track (cons (cons value (cons shen.*call* ())) (cons V4573 (cons (protect Result) ())))) (cons (cons do (cons (cons set (cons shen.*call* (cons (cons - (cons (cons value (cons shen.*call* ())) (cons 1 ()))) ()))) (cons (cons do (cons (cons shen.terpri-or-read-char ()) (cons (protect Result) ()))) ()))) ()))) ())))) ()))) ()))) ()))))

(defun shen.prolog-track (V4576 V4577) (cond ((= (occurrences shen.incinfs V4576) 0) V4577) (true (shen.vector-dereference V4577 (shen.vector-parameter V4577)))))

(defun shen.vector-parameter (V4580) (cond ((= () V4580) ()) ((and (cons? V4580) (and (cons? (tl V4580)) (and (cons? (tl (tl V4580))) (and (cons? (tl (tl (tl V4580)))) (= () (tl (tl (tl (tl V4580))))))))) (hd V4580)) ((cons? V4580) (shen.vector-parameter (tl V4580))) (true (shen.f-error shen.vector-parameter))))

(defun shen.vector-dereference (V4583 V4584) (cond ((= () V4584) V4583) ((and (cons? V4583) (and (cons? (tl V4583)) (and (cons? (tl (tl V4583))) (and (cons? (tl (tl (tl V4583)))) (= () (tl (tl (tl (tl V4583))))))))) V4583) ((cons? V4583) (cons (cons shen.deref (cons (hd V4583) (cons V4584 ()))) (shen.vector-dereference (tl V4583) V4584))) (true (shen.f-error shen.vector-dereference))))

(defun step (V4587) (cond ((= + V4587) (set shen.*step* true)) ((= - V4587) (set shen.*step* false)) (true (simple-error "step expects a + or a -.
"))))

(defun spy (V4590) (cond ((= + V4590) (set shen.*spy* true)) ((= - V4590) (set shen.*spy* false)) (true (simple-error "spy expects a + or a -.
"))))

(defun shen.terpri-or-read-char () (if (value shen.*step*) (shen.check-byte (read-byte (value *stinput*))) (nl 1)))

(defun shen.check-byte (V4593) (cond ((= 94 V4593) (simple-error "aborted")) (true true)))

(defun shen.input-track (V4594 V4595 V4596) (do (pr (cn "
" (shen.app (shen.spaces V4594) (cn "<" (shen.app V4594 (cn "> Inputs to " (shen.app V4595 (cn " 
" (shen.app (shen.spaces V4594) "" shen.a)) shen.a)) shen.a)) shen.a)) (stoutput)) (shen.recursively-print V4596)))

(defun shen.recursively-print (V4599) (cond ((= () V4599) (pr " ==>" (stoutput))) ((cons? V4599) (do (print (hd V4599)) (do (pr ", " (stoutput)) (shen.recursively-print (tl V4599))))) (true (simple-error "implementation error in shen.recursively-print"))))

(defun shen.spaces (V4600) (cond ((= 0 V4600) "") (true (cn " " (shen.spaces (- V4600 1))))))

(defun shen.output-track (V4601 V4602 V4603) (pr (cn "
" (shen.app (shen.spaces V4601) (cn "<" (shen.app V4601 (cn "> Output from " (shen.app V4602 (cn " 
" (shen.app (shen.spaces V4601) (cn "==> " (shen.app V4603 "" shen.s)) shen.a)) shen.a)) shen.a)) shen.a)) (stoutput)))

(defun untrack (V4604) (do (set shen.*tracking* (remove V4604 (value shen.*tracking*))) (trap-error (eval (ps V4604)) (lambda E V4604))))

(defun remove (V4605 V4606) (shen.remove-h V4605 V4606 ()))

(defun shen.remove-h (V4616 V4617 V4618) (cond ((= () V4617) (reverse V4618)) ((and (cons? V4617) (= V4616 (hd V4617))) (shen.remove-h (hd V4617) (tl V4617) V4618)) ((cons? V4617) (shen.remove-h V4616 (tl V4617) (cons (hd V4617) V4618))) (true (simple-error "implementation error in shen.remove-h"))))

(defun profile (V4619) (do (set shen.*profiled* (cons V4619 (value shen.*profiled*))) (shen.profile-help (ps V4619))))

(defun shen.profile-help (V4622) (cond ((and (cons? V4622) (and (= defun (hd V4622)) (and (cons? (tl V4622)) (and (cons? (tl (tl V4622))) (and (cons? (tl (tl (tl V4622)))) (= () (tl (tl (tl (tl V4622)))))))))) (let G (gensym shen.f) (let Profile (cons defun (cons (hd (tl V4622)) (cons (hd (tl (tl V4622))) (cons (shen.profile-func (hd (tl V4622)) (hd (tl (tl V4622))) (cons G (hd (tl (tl V4622))))) ())))) (let Def (cons defun (cons G (cons (hd (tl (tl V4622))) (cons (subst G (hd (tl V4622)) (hd (tl (tl (tl V4622))))) ())))) (let CompileProfile (eval-kl Profile) (let CompileG (eval-kl Def) (hd (tl V4622)))))))) (true (simple-error "Cannot profile.
"))))

(defun unprofile (V4623) (do (set shen.*profiled* (remove V4623 (value shen.*profiled*))) (trap-error (eval (ps V4623)) (lambda E V4623))))

(defun shen.profiled? (V4624) (element? V4624 (value shen.*profiled*)))

(defun shen.profile-func (V4625 V4626 V4627) (cons let (cons (protect Start) (cons (cons get-time (cons run ())) (cons (cons let (cons (protect Result) (cons V4627 (cons (cons let (cons (protect Finish) (cons (cons - (cons (cons get-time (cons run ())) (cons (protect Start) ()))) (cons (cons let (cons (protect Record) (cons (cons shen.put-profile (cons V4625 (cons (cons + (cons (cons shen.get-profile (cons V4625 ())) (cons (protect Finish) ()))) ()))) (cons (protect Result) ())))) ())))) ())))) ())))))

(defun profile-results (V4628) (let Results (shen.get-profile V4628) (let Initialise (shen.put-profile V4628 0) (@p V4628 Results))))

(defun shen.get-profile (V4629) (trap-error (get V4629 profile (value *property-vector*)) (lambda E 0)))

(defun shen.put-profile (V4630 V4631) (put V4630 profile V4631 (value *property-vector*)))

(defun declare (V4670 V4671) (let Rectify (shen.rectify-type V4671) (let Variant? (((((lambda V4632 (lambda L4633 (lambda K4634 (lambda C4635 (do (shen.incinfs) (shen.variancy (receive (shen.deref V4670 V4632)) (receive (shen.deref Rectify V4632)) V4632 L4633 K4634 C4635)))))) (shen.reset-prolog-vector)) (@v true (@v 0 (vector 0)))) 0) (freeze true)) (let Abstraction (eval-kl (shen.prolog-abstraction V4671)) (let UpDate (set shen.*sigf* (shen.assoc-> V4670 Abstraction (value shen.*sigf*))) V4670)))))

(defun shen.variancy (V4672 V4673 V4674 V4675 V4676 V4677) (if (shen.unlocked? V4675) (let A (shen.newpv V4674) (shen.gc V4674 (do (shen.incinfs) (shen.system-S-h V4672 A () V4674 V4675 V4676 (freeze (shen.variants? V4672 A V4673 V4674 V4675 V4676 V4677)))))) false))

(defun shen.variants? (V4678 V4679 V4680 V4681 V4682 V4683 V4684) (let K4645 (+ V4683 1) (let C4650 (if (shen.unlocked? V4682) (let Tm4651 (shen.lazyderef V4679 V4681) (let GoTo4652 (freeze (do (shen.incinfs) (shen.cut V4681 V4682 K4645 V4684))) (if (= Tm4651 symbol) (thaw GoTo4652) (if (shen.pvar? Tm4651) (shen.bind! Tm4651 symbol V4681 GoTo4652) false)))) false) (if (= C4650 false) (let C4653 (if (shen.unlocked? V4682) (do (shen.incinfs) (is! V4679 V4680 V4681 V4682 K4645 V4684)) false) (if (= C4653 false) (let C4654 (if (shen.unlocked? V4682) (let Warning (shen.newpv V4681) (shen.gc V4681 (do (shen.incinfs) (is Warning (pr (cn "warning: changing the type of " (shen.app (shen.deref V4678 V4681) " may create errors
" shen.a)) (stoutput)) V4681 V4682 K4645 V4684)))) false) (if (= C4654 false) (shen.unlock V4682 K4645) C4654)) C4653)) C4650))))

(defun shen.prolog-abstraction (V4685) (let Bindings (gensym (protect B)) (let Lock (gensym (protect L)) (let Key (gensym (protect Key)) (let Continuation (gensym (protect C)) (let V (gensym (protect V)) (let Vs (shen.extract-vars V4685) (cons lambda (cons V (cons (cons lambda (cons Bindings (cons (cons lambda (cons Lock (cons (cons lambda (cons Key (cons (cons lambda (cons Continuation (cons (shen.stpart Vs (cons is! (cons V (cons (shen.rcons_form V4685) (cons Bindings (cons Lock (cons Key (cons Continuation ()))))))) Bindings) ()))) ()))) ()))) ()))) ()))))))))))

(defun shen.demod (V4686) V4686)

(declare abort (cons --> (cons A ())))

(declare absvector? (cons A (cons --> (cons boolean ()))))

(declare adjoin (cons A (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))))

(declare and (cons boolean (cons --> (cons (cons boolean (cons --> (cons boolean ()))) ()))))

(declare shen.app (cons A (cons --> (cons (cons string (cons --> (cons (cons symbol (cons --> (cons string ()))) ()))) ()))))

(declare append (cons (cons list (cons A ())) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))))

(declare arity (cons A (cons --> (cons number ()))))

(declare assoc (cons A (cons --> (cons (cons (cons list (cons (cons list (cons A ())) ())) (cons --> (cons (cons list (cons A ())) ()))) ()))))

(declare atom? (cons A (cons --> (cons boolean ()))))

(declare boolean? (cons A (cons --> (cons boolean ()))))

(declare bootstrap (cons string (cons --> (cons string ()))))

(declare bound? (cons symbol (cons --> (cons boolean ()))))

(declare cd (cons string (cons --> (cons string ()))))

(declare close (cons (cons stream (cons A ())) (cons --> (cons (cons list (cons B ())) ()))))

(declare cn (cons string (cons --> (cons (cons string (cons --> (cons string ()))) ()))))

(declare compile (cons (cons (cons str (cons (cons list (cons A ())) (cons B ()))) (cons --> (cons (cons str (cons (cons list (cons A ())) (cons C ()))) ()))) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons C ()))) ()))))

(declare cons? (cons A (cons --> (cons boolean ()))))

(declare destroy (cons (cons A (cons --> (cons B ()))) (cons --> (cons symbol ()))))

(declare difference (cons (cons list (cons A ())) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))))

(declare do (cons A (cons --> (cons (cons B (cons --> (cons B ()))) ()))))

(declare <e> (cons (cons str (cons (cons list (cons A ())) (cons B ()))) (cons --> (cons (cons str (cons (cons list (cons A ())) (cons (cons list (cons C ())) ()))) ()))))

(declare <!> (cons (cons str (cons (cons list (cons A ())) (cons B ()))) (cons --> (cons (cons str (cons (cons list (cons A ())) (cons (cons list (cons A ())) ()))) ()))))

(declare shen.<end> (cons (cons str (cons (cons list (cons A ())) (cons B ()))) (cons --> (cons (cons str (cons (cons list (cons A ())) (cons B ()))) ()))))

(declare shen.=hd? (cons (cons str (cons (cons list (cons A ())) (cons B ()))) (cons --> (cons (cons A (cons --> (cons boolean ()))) ()))))

(declare shen.hds (cons (cons str (cons (cons list (cons A ())) (cons B ()))) (cons --> (cons A ()))))

(declare shen.tls (cons (cons str (cons (cons list (cons A ())) (cons B ()))) (cons --> (cons (cons str (cons (cons list (cons A ())) (cons B ()))) ()))))

(declare shen.parse-failure? (cons (cons str (cons (cons list (cons A ())) (cons B ()))) (cons --> (cons boolean ()))))

(declare shen.parse-failure (cons --> (cons (cons str (cons (cons list (cons A ())) (cons B ()))) ())))

(declare shen.<-out (cons (cons str (cons (cons list (cons A ())) (cons B ()))) (cons --> (cons B ()))))

(declare shen.in-> (cons (cons str (cons (cons list (cons A ())) (cons B ()))) (cons --> (cons (cons list (cons A ())) ()))))

(declare shen.non-empty-stream? (cons (cons str (cons (cons list (cons A ())) (cons B ()))) (cons --> (cons boolean ()))))

(declare shen.comb (cons (cons list (cons A ())) (cons --> (cons (cons B (cons --> (cons (cons str (cons (cons list (cons A ())) (cons B ()))) ()))) ()))))

(declare shen.headstream (cons (cons str (cons A (cons B ()))) (cons --> (cons (cons (cons str (cons C (cons D ()))) (cons --> (cons (cons str (cons A (cons (cons str (cons C (cons D ()))) ()))) ()))) ()))))

(declare shen.tlstream (cons (cons str (cons (cons list (cons A ())) (cons B ()))) (cons --> (cons (cons str (cons (cons list (cons A ())) (cons B ()))) ()))))

(declare element? (cons A (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons boolean ()))) ()))))

(declare empty? (cons A (cons --> (cons boolean ()))))

(declare enable-type-theory (cons symbol (cons --> (cons boolean ()))))

(declare external (cons symbol (cons --> (cons (cons list (cons symbol ())) ()))))

(declare error-to-string (cons exception (cons --> (cons string ()))))

(declare explode (cons A (cons --> (cons (cons list (cons string ())) ()))))

(declare factorise (cons symbol (cons --> (cons symbol ()))))

(declare fail (cons --> (cons symbol ())))

(declare fix (cons (cons A (cons --> (cons A ()))) (cons --> (cons (cons A (cons --> (cons A ()))) ()))))

(declare freeze (cons A (cons --> (cons (cons lazy (cons A ())) ()))))

(declare fst (cons (cons A (cons * (cons B ()))) (cons --> (cons A ()))))

(declare gensym (cons symbol (cons --> (cons symbol ()))))

(declare <-vector (cons (cons vector (cons A ())) (cons --> (cons (cons number (cons --> (cons A ()))) ()))))

(declare vector-> (cons (cons vector (cons A ())) (cons --> (cons (cons number (cons --> (cons (cons A (cons --> (cons (cons vector (cons A ())) ()))) ()))) ()))))

(declare vector (cons number (cons --> (cons (cons vector (cons A ())) ()))))

(declare get-time (cons symbol (cons --> (cons number ()))))

(declare hash (cons A (cons --> (cons (cons number (cons --> (cons number ()))) ()))))

(declare head (cons (cons list (cons A ())) (cons --> (cons A ()))))

(declare hdv (cons (cons vector (cons A ())) (cons --> (cons A ()))))

(declare hdstr (cons string (cons --> (cons string ()))))

(declare if (cons boolean (cons --> (cons (cons A (cons --> (cons (cons A (cons --> (cons A ()))) ()))) ()))))

(declare in-package (cons symbol (cons --> (cons symbol ()))))

(declare it (cons --> (cons string ())))

(declare implementation (cons --> (cons string ())))

(declare include (cons (cons list (cons symbol ())) (cons --> (cons (cons list (cons symbol ())) ()))))

(declare include-all-but (cons (cons list (cons symbol ())) (cons --> (cons (cons list (cons symbol ())) ()))))

(declare inferences (cons --> (cons number ())))

(declare shen.insert (cons A (cons --> (cons (cons string (cons --> (cons string ()))) ()))))

(declare integer? (cons A (cons --> (cons boolean ()))))

(declare internal (cons symbol (cons --> (cons (cons list (cons symbol ())) ()))))

(declare intersection (cons (cons list (cons A ())) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))))

(declare language (cons --> (cons string ())))

(declare length (cons (cons list (cons A ())) (cons --> (cons number ()))))

(declare limit (cons (cons vector (cons A ())) (cons --> (cons number ()))))

(declare lineread (cons (cons stream (cons in ())) (cons --> (cons (cons list (cons unit ())) ()))))

(declare load (cons string (cons --> (cons symbol ()))))

(declare map (cons (cons A (cons --> (cons B ()))) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons B ())) ()))) ()))))

(declare mapcan (cons (cons A (cons --> (cons (cons list (cons B ())) ()))) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons B ())) ()))) ()))))

(declare maxinferences (cons number (cons --> (cons number ()))))

(declare n->string (cons number (cons --> (cons string ()))))

(declare nl (cons number (cons --> (cons number ()))))

(declare not (cons boolean (cons --> (cons boolean ()))))

(declare nth (cons number (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons A ()))) ()))))

(declare number? (cons A (cons --> (cons boolean ()))))

(declare occurrences (cons A (cons --> (cons (cons B (cons --> (cons number ()))) ()))))

(declare occurs-check (cons symbol (cons --> (cons boolean ()))))

(declare optimise (cons symbol (cons --> (cons boolean ()))))

(declare or (cons boolean (cons --> (cons (cons boolean (cons --> (cons boolean ()))) ()))))

(declare os (cons --> (cons string ())))

(declare package? (cons symbol (cons --> (cons boolean ()))))

(declare port (cons --> (cons string ())))

(declare porters (cons --> (cons string ())))

(declare pos (cons string (cons --> (cons (cons number (cons --> (cons string ()))) ()))))

(declare pr (cons string (cons --> (cons (cons (cons stream (cons out ())) (cons --> (cons string ()))) ()))))

(declare print (cons A (cons --> (cons A ()))))

(declare profile (cons symbol (cons --> (cons symbol ()))))

(declare preclude (cons (cons list (cons symbol ())) (cons --> (cons (cons list (cons symbol ())) ()))))

(declare shen.proc-nl (cons string (cons --> (cons string ()))))

(declare profile-results (cons symbol (cons --> (cons (cons symbol (cons * (cons number ()))) ()))))

(declare protect (cons A (cons --> (cons A ()))))

(declare preclude-all-but (cons (cons list (cons symbol ())) (cons --> (cons (cons list (cons symbol ())) ()))))

(declare shen.prhush (cons string (cons --> (cons (cons (cons stream (cons out ())) (cons --> (cons string ()))) ()))))

(declare prolog-memory (cons number (cons --> (cons number ()))))

(declare ps (cons symbol (cons --> (cons (cons list (cons unit ())) ()))))

(declare read (cons (cons stream (cons in ())) (cons --> (cons unit ()))))

(declare read-byte (cons (cons stream (cons in ())) (cons --> (cons number ()))))

(declare read-file-as-bytelist (cons string (cons --> (cons (cons list (cons number ())) ()))))

(declare read-file-as-string (cons string (cons --> (cons string ()))))

(declare read-file (cons string (cons --> (cons (cons list (cons unit ())) ()))))

(declare read-from-string (cons string (cons --> (cons (cons list (cons unit ())) ()))))

(declare read-from-string-unprocessed (cons string (cons --> (cons (cons list (cons unit ())) ()))))

(declare release (cons --> (cons string ())))

(declare remove (cons A (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))))

(declare reverse (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))))

(declare simple-error (cons string (cons --> (cons A ()))))

(declare snd (cons (cons A (cons * (cons B ()))) (cons --> (cons B ()))))

(declare specialise (cons symbol (cons --> (cons (cons number (cons --> (cons symbol ()))) ()))))

(declare spy (cons symbol (cons --> (cons boolean ()))))

(declare step (cons symbol (cons --> (cons boolean ()))))

(declare stinput (cons --> (cons (cons stream (cons in ())) ())))

(declare stoutput (cons --> (cons (cons stream (cons out ())) ())))

(declare string? (cons A (cons --> (cons boolean ()))))

(declare str (cons A (cons --> (cons string ()))))

(declare string->n (cons string (cons --> (cons number ()))))

(declare string->symbol (cons string (cons --> (cons symbol ()))))

(declare sum (cons (cons list (cons number ())) (cons --> (cons number ()))))

(declare symbol? (cons A (cons --> (cons boolean ()))))

(declare systemf (cons symbol (cons --> (cons symbol ()))))

(declare tail (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))))

(declare tlstr (cons string (cons --> (cons string ()))))

(declare tlv (cons (cons vector (cons A ())) (cons --> (cons (cons vector (cons A ())) ()))))

(declare tc (cons symbol (cons --> (cons boolean ()))))

(declare tc? (cons --> (cons boolean ())))

(declare thaw (cons (cons lazy (cons A ())) (cons --> (cons A ()))))

(declare track (cons symbol (cons --> (cons symbol ()))))

(declare trap-error (cons A (cons --> (cons (cons (cons exception (cons --> (cons A ()))) (cons --> (cons A ()))) ()))))

(declare tuple? (cons A (cons --> (cons boolean ()))))

(declare undefmacro (cons symbol (cons --> (cons symbol ()))))

(declare union (cons (cons list (cons A ())) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))))

(declare unprofile (cons symbol (cons --> (cons symbol ()))))

(declare untrack (cons symbol (cons --> (cons symbol ()))))

(declare variable? (cons A (cons --> (cons boolean ()))))

(declare vector? (cons A (cons --> (cons boolean ()))))

(declare version (cons --> (cons string ())))

(declare write-to-file (cons string (cons --> (cons (cons A (cons --> (cons A ()))) ()))))

(declare write-byte (cons number (cons --> (cons (cons (cons stream (cons out ())) (cons --> (cons number ()))) ()))))

(declare y-or-n? (cons string (cons --> (cons boolean ()))))

(declare > (cons number (cons --> (cons (cons number (cons --> (cons boolean ()))) ()))))

(declare < (cons number (cons --> (cons (cons number (cons --> (cons boolean ()))) ()))))

(declare >= (cons number (cons --> (cons (cons number (cons --> (cons boolean ()))) ()))))

(declare <= (cons number (cons --> (cons (cons number (cons --> (cons boolean ()))) ()))))

(declare = (cons A (cons --> (cons (cons A (cons --> (cons boolean ()))) ()))))

(declare + (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ()))))

(declare / (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ()))))

(declare - (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ()))))

(declare * (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ()))))

(declare == (cons A (cons --> (cons (cons B (cons --> (cons boolean ()))) ()))))

(defun print (V4731) (let String (shen.insert V4731 "~S") (let Print (pr String (stoutput)) V4731)))

(defun pr (V4732 V4733) (if (value *hush*) V4732 (if (shen.char-stoutput? V4733) (shen.write-string V4732 V4733) (shen.write-chars V4732 V4733 (shen.string->byte V4732 0) 1))))

(defun shen.string->byte (V4734 V4735) (trap-error (string->n (pos V4734 V4735)) (lambda E shen.eos)))

(defun shen.write-chars (V4736 V4737 V4738 V4739) (cond ((= shen.eos V4738) V4736) (true (shen.write-chars V4736 V4737 (do (write-byte V4738 V4737) (shen.string->byte V4736 V4739)) (+ V4739 1)))))

(defun shen.mkstr (V4740 V4741) (cond ((string? V4740) (shen.mkstr-l (shen.proc-nl V4740) V4741)) (true (shen.mkstr-r (cons shen.proc-nl (cons V4740 ())) V4741))))

(defun shen.mkstr-l (V4746 V4747) (cond ((= () V4747) V4746) ((cons? V4747) (shen.mkstr-l (shen.insert-l (hd V4747) V4746) (tl V4747))) (true (simple-error "implementation error in shen.mkstr-l"))))

(defun shen.insert-l (V4754 V4755) (cond ((= "" V4755) "") ((and (shen.+string? V4755) (and (= "~" (hdstr V4755)) (and (shen.+string? (tlstr V4755)) (= "A" (hdstr (tlstr V4755)))))) (cons shen.app (cons V4754 (cons (tlstr (tlstr V4755)) (cons shen.a ()))))) ((and (shen.+string? V4755) (and (= "~" (hdstr V4755)) (and (shen.+string? (tlstr V4755)) (= "R" (hdstr (tlstr V4755)))))) (cons shen.app (cons V4754 (cons (tlstr (tlstr V4755)) (cons shen.r ()))))) ((and (shen.+string? V4755) (and (= "~" (hdstr V4755)) (and (shen.+string? (tlstr V4755)) (= "S" (hdstr (tlstr V4755)))))) (cons shen.app (cons V4754 (cons (tlstr (tlstr V4755)) (cons shen.s ()))))) ((shen.+string? V4755) (shen.factor-cn (cons cn (cons (hdstr V4755) (cons (shen.insert-l V4754 (tlstr V4755)) ()))))) ((and (cons? V4755) (and (= cn (hd V4755)) (and (cons? (tl V4755)) (and (cons? (tl (tl V4755))) (= () (tl (tl (tl V4755)))))))) (cons cn (cons (hd (tl V4755)) (cons (shen.insert-l V4754 (hd (tl (tl V4755)))) ())))) ((and (cons? V4755) (and (= shen.app (hd V4755)) (and (cons? (tl V4755)) (and (cons? (tl (tl V4755))) (and (cons? (tl (tl (tl V4755)))) (= () (tl (tl (tl (tl V4755)))))))))) (cons shen.app (cons (hd (tl V4755)) (cons (shen.insert-l V4754 (hd (tl (tl V4755)))) (tl (tl (tl V4755))))))) (true (simple-error "implementation error in shen.insert-l"))))

(defun shen.factor-cn (V4756) (cond ((and (cons? V4756) (and (= cn (hd V4756)) (and (cons? (tl V4756)) (and (cons? (tl (tl V4756))) (and (cons? (hd (tl (tl V4756)))) (and (= cn (hd (hd (tl (tl V4756))))) (and (cons? (tl (hd (tl (tl V4756))))) (and (cons? (tl (tl (hd (tl (tl V4756)))))) (and (= () (tl (tl (tl (hd (tl (tl V4756))))))) (and (= () (tl (tl (tl V4756)))) (and (string? (hd (tl V4756))) (string? (hd (tl (hd (tl (tl V4756))))))))))))))))) (cons cn (cons (cn (hd (tl V4756)) (hd (tl (hd (tl (tl V4756)))))) (tl (tl (hd (tl (tl V4756)))))))) (true V4756)))

(defun shen.proc-nl (V4759) (cond ((= "" V4759) "") ((and (shen.+string? V4759) (and (= "~" (hdstr V4759)) (and (shen.+string? (tlstr V4759)) (= "%" (hdstr (tlstr V4759)))))) (cn (n->string 10) (shen.proc-nl (tlstr (tlstr V4759))))) ((shen.+string? V4759) (cn (hdstr V4759) (shen.proc-nl (tlstr V4759)))) (true (simple-error "implementation error in shen.proc-nl"))))

(defun shen.mkstr-r (V4764 V4765) (cond ((= () V4765) V4764) ((cons? V4765) (shen.mkstr-r (cons shen.insert (cons (hd V4765) (cons V4764 ()))) (tl V4765))) (true (simple-error "implementation error in shen.mkstr-r"))))

(defun shen.insert (V4766 V4767) (shen.insert-h V4766 V4767 ""))

(defun shen.insert-h (V4776 V4777 V4778) (cond ((= "" V4777) V4778) ((and (shen.+string? V4777) (and (= "~" (hdstr V4777)) (and (shen.+string? (tlstr V4777)) (= "A" (hdstr (tlstr V4777)))))) (cn V4778 (shen.app V4776 (tlstr (tlstr V4777)) shen.a))) ((and (shen.+string? V4777) (and (= "~" (hdstr V4777)) (and (shen.+string? (tlstr V4777)) (= "R" (hdstr (tlstr V4777)))))) (cn V4778 (shen.app V4776 (tlstr (tlstr V4777)) shen.r))) ((and (shen.+string? V4777) (and (= "~" (hdstr V4777)) (and (shen.+string? (tlstr V4777)) (= "S" (hdstr (tlstr V4777)))))) (cn V4778 (shen.app V4776 (tlstr (tlstr V4777)) shen.s))) ((shen.+string? V4777) (shen.insert-h V4776 (tlstr V4777) (cn V4778 (hdstr V4777)))) (true (simple-error "implementation error in shen.insert-h"))))

(defun shen.app (V4779 V4780 V4781) (cn (shen.arg->str V4779 V4781) V4780))

(defun shen.arg->str (V4785 V4786) (cond ((= V4785 (fail)) "...") ((shen.list? V4785) (shen.list->str V4785 V4786)) ((string? V4785) (shen.str->str V4785 V4786)) ((absvector? V4785) (shen.vector->str V4785 V4786)) (true (shen.atom->str V4785))))

(defun shen.list->str (V4787 V4788) (cond ((= shen.r V4788) (@s "(" (@s (shen.iter-list V4787 shen.r (shen.maxseq)) ")"))) (true (@s "[" (@s (shen.iter-list V4787 V4788 (shen.maxseq)) "]")))))

(defun shen.maxseq () (value *maximum-print-sequence-size*))

(defun shen.iter-list (V4799 V4800 V4801) (cond ((= () V4799) "") ((= 0 V4801) "... etc") ((and (cons? V4799) (= () (tl V4799))) (shen.arg->str (hd V4799) V4800)) ((cons? V4799) (@s (shen.arg->str (hd V4799) V4800) (@s " " (shen.iter-list (tl V4799) V4800 (- V4801 1))))) (true (@s "|" (@s " " (shen.arg->str V4799 V4800))))))

(defun shen.str->str (V4804 V4805) (cond ((= shen.a V4805) V4804) (true (@s (n->string 34) (@s V4804 (n->string 34))))))

(defun shen.vector->str (V4806 V4807) (if (shen.print-vector? V4806) ((fn (<-address V4806 0)) V4806) (if (vector? V4806) (@s "<" (@s (shen.iter-vector V4806 1 V4807 (shen.maxseq)) ">")) (@s "<" (@s "<" (@s (shen.iter-vector V4806 0 V4807 (shen.maxseq)) ">>"))))))

(defun shen.print-vector? (V4808) (let Zero (<-address V4808 0) (if (= Zero shen.tuple) true (if (= Zero shen.pvar) true (if (not (number? Zero)) (shen.fbound? Zero) false)))))

(defun shen.fbound? (V4809) (not (= (arity V4809) -1)))

(defun shen.tuple (V4810) (cn "(@p " (shen.app (<-address V4810 1) (cn " " (shen.app (<-address V4810 2) ")" shen.s)) shen.s)))

(defun shen.iter-vector (V4817 V4818 V4819 V4820) (cond ((= 0 V4820) "... etc") (true (let Item (trap-error (<-address V4817 V4818) (lambda E shen.out-of-bounds)) (let Next (trap-error (<-address V4817 (+ V4818 1)) (lambda E shen.out-of-bounds)) (if (= Item shen.out-of-bounds) "" (if (= Next shen.out-of-bounds) (shen.arg->str Item V4819) (@s (shen.arg->str Item V4819) (@s " " (shen.iter-vector V4817 (+ V4818 1) V4819 (- V4820 1)))))))))))

(defun shen.atom->str (V4821) (trap-error (str V4821) (lambda E (shen.funexstring))))

(defun shen.funexstring () (@s "" (@s "f" (@s "u" (@s "n" (@s "e" (@s (shen.arg->str (gensym (intern "x")) shen.a) "")))))))

(defun shen.list? (V4822) (or (empty? V4822) (cons? V4822)))

(defun compile (V1141 V1142) (let Compile (V1141 (cons V1142 (cons shen.no-action ()))) (if (shen.parsed? Compile) (shen.objectcode Compile) (simple-error "parse failure
"))))

(defun shen.parsed? (V1147) (cond ((shen.parse-failure? V1147) false) ((and (cons? V1147) (cons? (hd V1147))) (do (set shen.*residue* (hd V1147)) (simple-error (cn "syntax error here: " (shen.app (hd V1147) "
 ..." shen.r))))) (true true)))

(defun shen.parse-failure? (V1148) (= V1148 (fail)))

(defun shen.objectcode (V1151) (cond ((and (cons? V1151) (and (cons? (tl V1151)) (= () (tl (tl V1151))))) (hd (tl V1151))) (true (simple-error (shen.app V1151 " is not a YACC stream
" shen.s)))))

(defun shen.yacc->shen (V1152) (compile (lambda X (shen.<yacc> X)) V1152))

(defun shen.<yacc> (V1153) (let Result (if (shen.non-empty-stream? V1153) (let F (shen.hds V1153) (let News1034 (shen.tls V1153) (let Parseshen.<yaccsig> (shen.<yaccsig> News1034) (if (shen.parse-failure? Parseshen.<yaccsig>) (shen.parse-failure) (let Parseshen.<c-rules> (shen.<c-rules> Parseshen.<yaccsig>) (if (shen.parse-failure? Parseshen.<c-rules>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<c-rules>) (let Stream (gensym (protect S)) (let Def (append (cons define (cons F ())) (append (shen.<-out Parseshen.<yaccsig>) (cons Stream (cons -> (cons (shen.c-rules->shen (shen.<-out Parseshen.<yaccsig>) Stream (shen.<-out Parseshen.<c-rules>)) ()))))) Def))))))))) (shen.parse-failure)) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.<yaccsig> (V1154) (let Result (if (shen.non-empty-stream? V1154) (let LC (shen.hds V1154) (let News1036 (shen.tls V1154) (if (shen.ccons? News1036) (let SynCons (shen.comb (shen.hds News1036) (shen.<-out News1036)) (if (shen.=hd? SynCons list) (let News1037 (shen.tls SynCons) (if (shen.non-empty-stream? News1037) (let A (shen.hds News1037) (let News1038 (shen.tls News1037) (let Parseshen.<end> (shen.<end> News1038) (if (shen.parse-failure? Parseshen.<end>) (shen.parse-failure) (if (shen.=hd? (shen.tlstream News1036) ==>) (let News1039 (shen.tls (shen.tlstream News1036)) (if (shen.non-empty-stream? News1039) (let B (shen.hds News1039) (let News1040 (shen.tls News1039) (if (shen.non-empty-stream? News1040) (let RC (shen.hds News1040) (let News1041 (shen.tls News1040) (if (and (= { LC) (= } RC)) (shen.comb (shen.in-> News1041) (let C (protect (gensym C)) (cons { (cons (cons str (cons (cons list (cons A ())) (cons (protect C) ()))) (cons --> (cons (cons str (cons (cons list (cons A ())) (cons B ()))) (cons } ()))))))) (shen.parse-failure)))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)))))) (shen.parse-failure))) (shen.parse-failure))) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? Result) (let Result (let Parse<e> (<e> V1154) (if (shen.parse-failure? Parse<e>) (shen.parse-failure) (shen.comb (shen.in-> Parse<e>) ()))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)) Result)))

(defun shen.<c-rules> (V1155) (let Result (let Parseshen.<c-rule> (shen.<c-rule> V1155) (if (shen.parse-failure? Parseshen.<c-rule>) (shen.parse-failure) (let Parseshen.<c-rules> (shen.<c-rules> Parseshen.<c-rule>) (if (shen.parse-failure? Parseshen.<c-rules>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<c-rules>) (cons (shen.<-out Parseshen.<c-rule>) (shen.<-out Parseshen.<c-rules>))))))) (if (shen.parse-failure? Result) (let Result (let Parse<!> (<!> V1155) (if (shen.parse-failure? Parse<!>) (shen.parse-failure) (shen.comb (shen.in-> Parse<!>) (if (empty? (shen.<-out Parse<!>)) () (simple-error (cn "YACC syntax error here:
 " (shen.app (shen.<-out Parse<!>) "
 ..." shen.r))))))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)) Result)))

(defun shen.<c-rule> (V1156) (let Result (let Parseshen.<syntax> (shen.<syntax> V1156) (if (shen.parse-failure? Parseshen.<syntax>) (shen.parse-failure) (let Parseshen.<semantics> (shen.<semantics> Parseshen.<syntax>) (if (shen.parse-failure? Parseshen.<semantics>) (shen.parse-failure) (let Parseshen.<sc> (shen.<sc> Parseshen.<semantics>) (if (shen.parse-failure? Parseshen.<sc>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<sc>) (cons (shen.<-out Parseshen.<syntax>) (cons (shen.<-out Parseshen.<semantics>) ()))))))))) (if (shen.parse-failure? Result) (let Result (let Parseshen.<syntax> (shen.<syntax> V1156) (if (shen.parse-failure? Parseshen.<syntax>) (shen.parse-failure) (let Parseshen.<sc> (shen.<sc> Parseshen.<syntax>) (if (shen.parse-failure? Parseshen.<sc>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<sc>) (cons (shen.<-out Parseshen.<syntax>) (cons (shen.autocomplete (shen.<-out Parseshen.<syntax>)) ()))))))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)) Result)))

(defun shen.autocomplete (V1157) (cond ((and (cons? V1157) (and (= () (tl V1157)) (shen.non-terminal? (hd V1157)))) (hd V1157)) ((and (cons? V1157) (shen.non-terminal? (hd V1157))) (cons append (cons (hd V1157) (cons (shen.autocomplete (tl V1157)) ())))) ((cons? V1157) (cons cons (cons (shen.autocomplete (hd V1157)) (cons (shen.autocomplete (tl V1157)) ())))) (true V1157)))

(defun shen.non-terminal? (V1158) (and (symbol? V1158) (let Explode (explode V1158) (compile (lambda X (shen.<non-terminal?> X)) Explode))))

(defun shen.<non-terminal?> (V1159) (let Result (let Parseshen.<packagenames> (shen.<packagenames> V1159) (if (shen.parse-failure? Parseshen.<packagenames>) (shen.parse-failure) (let Parseshen.<non-terminal-name> (shen.<non-terminal-name> Parseshen.<packagenames>) (if (shen.parse-failure? Parseshen.<non-terminal-name>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<non-terminal-name>) true))))) (if (shen.parse-failure? Result) (let Result (let Parseshen.<non-terminal-name> (shen.<non-terminal-name> V1159) (if (shen.parse-failure? Parseshen.<non-terminal-name>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<non-terminal-name>) true))) (if (shen.parse-failure? Result) (let Result (let Parse<!> (<!> V1159) (if (shen.parse-failure? Parse<!>) (shen.parse-failure) (shen.comb (shen.in-> Parse<!>) false))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)) Result)) Result)))

(defun shen.<packagenames> (V1160) (let Result (let Parseshen.<packagename> (shen.<packagename> V1160) (if (shen.parse-failure? Parseshen.<packagename>) (shen.parse-failure) (if (shen.=hd? Parseshen.<packagename> ".") (let News1046 (shen.tls Parseshen.<packagename>) (let Parseshen.<packagenames> (shen.<packagenames> News1046) (if (shen.parse-failure? Parseshen.<packagenames>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<packagenames>) shen.skip)))) (shen.parse-failure)))) (if (shen.parse-failure? Result) (let Result (let Parseshen.<packagename> (shen.<packagename> V1160) (if (shen.parse-failure? Parseshen.<packagename>) (shen.parse-failure) (if (shen.=hd? Parseshen.<packagename> ".") (let News1047 (shen.tls Parseshen.<packagename>) (shen.comb (shen.in-> News1047) shen.skip)) (shen.parse-failure)))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)) Result)))

(defun shen.<packagename> (V1161) (let Result (let Parseshen.<packagechar> (shen.<packagechar> V1161) (if (shen.parse-failure? Parseshen.<packagechar>) (shen.parse-failure) (let Parseshen.<packagename> (shen.<packagename> Parseshen.<packagechar>) (if (shen.parse-failure? Parseshen.<packagename>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<packagename>) shen.skip))))) (if (shen.parse-failure? Result) (let Result (let Parse<e> (<e> V1161) (if (shen.parse-failure? Parse<e>) (shen.parse-failure) (shen.comb (shen.in-> Parse<e>) shen.skip))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)) Result)))

(defun shen.<packagechar> (V1162) (let Result (if (shen.non-empty-stream? V1162) (let X (shen.hds V1162) (let News1050 (shen.tls V1162) (if (not (= X ".")) (shen.comb (shen.in-> News1050) shen.skip) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.<non-terminal-name> (V1163) (let Result (if (shen.=hd? V1163 "<") (let News1052 (shen.tls V1163) (let Parse<!> (<!> News1052) (if (shen.parse-failure? Parse<!>) (shen.parse-failure) (if (let Reverse (reverse (shen.<-out Parse<!>)) (and (cons? Reverse) (= (hd Reverse) ">"))) (shen.comb (shen.in-> Parse<!>) shen.skip) (shen.parse-failure))))) (shen.parse-failure)) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.semicolon? (V1164) (= V1164 (intern ";")))

(defun shen.<colon-equal> (V1165) (let Result (if (shen.non-empty-stream? V1165) (let X (shen.hds V1165) (let News1054 (shen.tls V1165) (if (shen.colon-equal? X) (shen.comb (shen.in-> News1054) shen.skip) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.colon-equal? (V1166) (= (intern ":=") V1166))

(defun shen.<syntax> (V1167) (let Result (let Parseshen.<syntax-item> (shen.<syntax-item> V1167) (if (shen.parse-failure? Parseshen.<syntax-item>) (shen.parse-failure) (let Parseshen.<syntax> (shen.<syntax> Parseshen.<syntax-item>) (if (shen.parse-failure? Parseshen.<syntax>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<syntax>) (cons (shen.<-out Parseshen.<syntax-item>) (shen.<-out Parseshen.<syntax>))))))) (if (shen.parse-failure? Result) (let Result (let Parseshen.<syntax-item> (shen.<syntax-item> V1167) (if (shen.parse-failure? Parseshen.<syntax-item>) (shen.parse-failure) (shen.comb (shen.in-> Parseshen.<syntax-item>) (cons (shen.<-out Parseshen.<syntax-item>) ())))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)) Result)))

(defun shen.<syntax-item> (V1168) (let Result (if (shen.non-empty-stream? V1168) (let X (shen.hds V1168) (let News1057 (shen.tls V1168) (if (shen.syntax-item? X) (shen.comb (shen.in-> News1057) X) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? Result) (shen.parse-failure) Result)))

(defun shen.syntax-item? (V1171) (cond ((shen.colon-equal? V1171) false) ((shen.semicolon? V1171) false) ((atom? V1171) true) ((and (cons? V1171) (and (= cons (hd V1171)) (and (cons? (tl V1171)) (and (cons? (tl (tl V1171))) (= () (tl (tl (tl V1171)))))))) (and (shen.syntax-item? (hd (tl V1171))) (shen.syntax-item? (hd (tl (tl V1171)))))) (true false)))

(defun shen.<semantics> (V1172) (let Result (let Parseshen.<colon-equal> (shen.<colon-equal> V1172) (if (shen.parse-failure? Parseshen.<colon-equal>) (shen.parse-failure) (if (shen.non-empty-stream? Parseshen.<colon-equal>) (let Semantics (shen.hds Parseshen.<colon-equal>) (let News1059 (shen.tls Parseshen.<colon-equal>) (if (shen.=hd? News1059 where) (let News1060 (shen.tls News1059) (if (shen.non-empty-stream? News1060) (let Guard (shen.hds News1060) (let News1061 (shen.tls News1060) (if (not (shen.semicolon? Semantics)) (shen.comb (shen.in-> News1061) (cons where (cons Guard (cons Semantics ())))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)))) (shen.parse-failure)))) (if (shen.parse-failure? Result) (let Result (let Parseshen.<colon-equal> (shen.<colon-equal> V1172) (if (shen.parse-failure? Parseshen.<colon-equal>) (shen.parse-failure) (if (shen.non-empty-stream? Parseshen.<colon-equal>) (let Semantics (shen.hds Parseshen.<colon-equal>) (let News1062 (shen.tls Parseshen.<colon-equal>) (if (not (shen.semicolon? Semantics)) (shen.comb (shen.in-> News1062) Semantics) (shen.parse-failure)))) (shen.parse-failure)))) (if (shen.parse-failure? Result) (shen.parse-failure) Result)) Result)))

(defun shen.c-rules->shen (V1181 V1182 V1183) (cond ((= () V1183) (cons shen.parse-failure ())) ((cons? V1183) (shen.combine-c-code (shen.c-rule->shen V1181 (hd V1183) V1182) (shen.c-rules->shen V1181 V1182 (tl V1183)))) (true (simple-error "implementation error in shen.c-rules->shen
"))))

(defun shen.parse-failure () (fail))

(defun shen.combine-c-code (V1184 V1185) (cons let (cons (protect Result) (cons V1184 (cons (cons if (cons (cons shen.parse-failure? (cons (protect Result) ())) (cons V1185 (cons (protect Result) ())))) ())))))

(defun shen.c-rule->shen (V1192 V1193 V1194) (cond ((and (cons? V1193) (and (cons? (tl V1193)) (= () (tl (tl V1193))))) (shen.yacc-syntax V1192 V1194 (hd V1193) (hd (tl V1193)))) (true (simple-error "implementation error in shen.c-rule->shen
"))))

(defun shen.yacc-syntax (V1203 V1204 V1205 V1206) (cond ((and (= () V1205) (and (cons? V1206) (and (= where (hd V1206)) (and (cons? (tl V1206)) (and (cons? (tl (tl V1206))) (= () (tl (tl (tl V1206))))))))) (cons if (cons (shen.process-yacc-semantics (hd (tl V1206))) (cons (shen.yacc-syntax V1203 V1204 () (hd (tl (tl V1206)))) (cons (cons shen.parse-failure ()) ()))))) ((= () V1205) (shen.yacc-semantics V1203 V1204 V1206)) ((cons? V1205) (if (shen.non-terminal? (hd V1205)) (shen.non-terminalcode V1203 V1204 (hd V1205) (tl V1205) V1206) (if (variable? (hd V1205)) (shen.variablecode V1203 V1204 (hd V1205) (tl V1205) V1206) (if (= _ (hd V1205)) (shen.wildcardcode V1203 V1204 (hd V1205) (tl V1205) V1206) (if (atom? (hd V1205)) (shen.terminalcode V1203 V1204 (hd V1205) (tl V1205) V1206) (if (cons? (hd V1205)) (shen.conscode V1203 V1204 (hd V1205) (tl V1205) V1206) (simple-error "implementation error in shen.yacc-syntax
"))))))) (true (simple-error "implementation error in shen.yacc-syntax
"))))

(defun shen.non-terminalcode (V1207 V1208 V1209 V1210 V1211) (let ApplyNonTerminal (concat (protect Parse) V1209) (cons let (cons ApplyNonTerminal (cons (cons V1209 (cons V1208 ())) (cons (cons if (cons (cons shen.parse-failure? (cons ApplyNonTerminal ())) (cons (cons shen.parse-failure ()) (cons (shen.yacc-syntax V1207 ApplyNonTerminal V1210 V1211) ())))) ()))))))

(defun shen.variablecode (V1212 V1213 V1214 V1215 V1216) (let NewStream (gensym (protect News)) (cons if (cons (cons shen.non-empty-stream? (cons V1213 ())) (cons (cons let (cons V1214 (cons (cons shen.hds (cons V1213 ())) (cons NewStream (cons (cons shen.tls (cons V1213 ())) (cons (shen.yacc-syntax V1212 NewStream V1215 V1216) ())))))) (cons (cons shen.parse-failure ()) ()))))))

(defun shen.wildcardcode (V1217 V1218 V1219 V1220 V1221) (let NewStream (gensym (protect News)) (cons if (cons (cons shen.non-empty-stream? (cons V1218 ())) (cons (cons let (cons NewStream (cons (cons shen.tls (cons V1218 ())) (cons (shen.yacc-syntax V1217 NewStream V1220 V1221) ())))) (cons (cons shen.parse-failure ()) ()))))))

(defun shen.terminalcode (V1222 V1223 V1224 V1225 V1226) (let NewStream (gensym (protect News)) (cons if (cons (cons shen.=hd? (cons V1223 (cons V1224 ()))) (cons (cons let (cons NewStream (cons (cons shen.tls (cons V1223 ())) (cons (shen.yacc-syntax V1222 NewStream V1225 V1226) ())))) (cons (cons shen.parse-failure ()) ()))))))

(defun shen.conscode (V1227 V1228 V1229 V1230 V1231) (cons if (cons (cons shen.ccons? (cons V1228 ())) (cons (cons let (cons (protect SynCons) (cons (cons shen.comb (cons (cons shen.hds (cons V1228 ())) (cons (cons shen.<-out (cons V1228 ())) ()))) (cons (shen.yacc-syntax V1227 (protect SynCons) (append (shen.decons V1229) (cons shen.<end> ())) (cons shen.pushsemantics (cons (cons shen.tlstream (cons V1228 ())) (cons V1230 (cons V1231 ()))))) ())))) (cons (cons shen.parse-failure ()) ())))))

(defun shen.decons (V1232) (cond ((and (cons? V1232) (and (= cons (hd V1232)) (and (cons? (tl V1232)) (and (cons? (tl (tl V1232))) (= () (tl (tl (tl V1232)))))))) (cons (hd (tl V1232)) (shen.decons (hd (tl (tl V1232)))))) (true V1232)))

(defun shen.ccons? (V1239) (cond ((and (cons? V1239) (and (cons? (hd V1239)) (and (cons? (tl V1239)) (= () (tl (tl V1239)))))) (cons? (hd (hd V1239)))) (true false)))

(defun shen.non-empty-stream? (V1248) (cond ((and (cons? V1248) (cons? (hd V1248))) true) (true false)))

(defun shen.hds (V1249) (hd (hd V1249)))

(defun shen.hdstream (V1254) (cond ((and (cons? V1254) (and (cons? (hd V1254)) (and (cons? (tl V1254)) (= () (tl (tl V1254)))))) (cons (hd (hd V1254)) (tl V1254))) (true (simple-error "implementation error in shen.hdstream
"))))

(defun shen.comb (V1255 V1256) (cons V1255 (cons V1256 ())))

(defun shen.tlstream (V1261) (cond ((and (cons? V1261) (and (cons? (hd V1261)) (and (cons? (tl V1261)) (= () (tl (tl V1261)))))) (cons (tl (hd V1261)) (tl V1261))) (true (simple-error "implementation error in shen.tlstream
"))))

(defun shen.=hd? (V1271 V1272) (cond ((and (cons? V1271) (and (cons? (hd V1271)) (= (hd (hd V1271)) V1272))) true) (true false)))

(defun shen.tls (V1277) (cond ((and (cons? V1277) (and (cons? (hd V1277)) (and (cons? (tl V1277)) (= () (tl (tl V1277)))))) (cons (tl (hd V1277)) (tl V1277))) (true (simple-error "implementation error in shen.tls
"))))

(defun shen.yacc-semantics (V1280 V1281 V1282) (cond ((and (cons? V1282) (and (= shen.pushsemantics (hd V1282)) (and (cons? (tl V1282)) (and (cons? (tl (tl V1282))) (and (cons? (tl (tl (tl V1282)))) (= () (tl (tl (tl (tl V1282)))))))))) (shen.yacc-syntax V1280 (hd (tl V1282)) (hd (tl (tl V1282))) (hd (tl (tl (tl V1282)))))) (true (let Process (shen.process-yacc-semantics V1282) (let Annotate (shen.use-type-info V1280 Process) (cons shen.comb (cons (cons shen.in-> (cons V1281 ())) (cons Annotate ()))))))))

(defun shen.use-type-info (V1286 V1287) (cond ((and (cons? V1286) (and (= { (hd V1286)) (and (cons? (tl V1286)) (and (cons? (hd (tl V1286))) (and (= str (hd (hd (tl V1286)))) (and (cons? (tl (hd (tl V1286)))) (and (cons? (hd (tl (hd (tl V1286))))) (and (= list (hd (hd (tl (hd (tl V1286)))))) (and (cons? (tl (hd (tl (hd (tl V1286)))))) (and (= () (tl (tl (hd (tl (hd (tl V1286))))))) (and (cons? (tl (tl (hd (tl V1286))))) (and (= () (tl (tl (tl (hd (tl V1286)))))) (and (cons? (tl (tl V1286))) (and (= --> (hd (tl (tl V1286)))) (and (cons? (tl (tl (tl V1286)))) (and (cons? (hd (tl (tl (tl V1286))))) (and (= str (hd (hd (tl (tl (tl V1286)))))) (and (cons? (tl (hd (tl (tl (tl V1286)))))) (and (cons? (hd (tl (hd (tl (tl (tl V1286))))))) (and (= list (hd (hd (tl (hd (tl (tl (tl V1286)))))))) (and (cons? (tl (hd (tl (hd (tl (tl (tl V1286)))))))) (and (= () (tl (tl (hd (tl (hd (tl (tl (tl V1286))))))))) (and (cons? (tl (tl (hd (tl (tl (tl V1286))))))) (and (= () (tl (tl (tl (hd (tl (tl (tl V1286)))))))) (and (cons? (tl (tl (tl (tl V1286))))) (and (= } (hd (tl (tl (tl (tl V1286)))))) (and (= () (tl (tl (tl (tl (tl V1286)))))) (= (hd (tl (hd (tl (hd (tl V1286)))))) (hd (tl (hd (tl (hd (tl (tl (tl V1286)))))))))))))))))))))))))))))))))))) (cons type (cons V1287 (tl (tl (hd (tl (tl (tl V1286))))))))) (true V1287)))

(defun shen.process-yacc-semantics (V1288) (cond ((cons? V1288) (map (lambda Z (shen.process-yacc-semantics Z)) V1288)) ((shen.non-terminal? V1288) (cons shen.<-out (cons (concat (protect Parse) V1288) ()))) (true V1288)))

(defun shen.<-out (V1293) (cond ((and (cons? V1293) (and (cons? (tl V1293)) (= () (tl (tl V1293))))) (hd (tl V1293))) (true (simple-error "implementation error in shen.<-out
"))))

(defun shen.in-> (V1298) (cond ((and (cons? V1298) (and (cons? (tl V1298)) (= () (tl (tl V1298))))) (hd V1298)) (true (simple-error "implementation error in shen.in->
"))))

(defun <!> (V1303) (cond ((and (cons? V1303) (and (cons? (tl V1303)) (= () (tl (tl V1303))))) (cons () (cons (hd V1303) ()))) (true (simple-error "implementation error in <!>
"))))

(defun <e> (V1308) (cond ((and (cons? V1308) (and (cons? (tl V1308)) (= () (tl (tl V1308))))) (cons (hd V1308) (cons () ()))) (true (simple-error "implementation error in <e>
"))))

(defun shen.<end> (V1311) (cond ((and (cons? V1311) (and (= () (hd V1311)) (and (cons? (tl V1311)) (= () (tl (tl V1311)))))) V1311) (true (shen.parse-failure))))

