"Copyright (c) 2015, Mark Tarver

All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
1. Redistributions of source code must retain the above copyright
   notice, this list of conditions and the following disclaimer.
2. Redistributions in binary form must reproduce the above copyright
   notice, this list of conditions and the following disclaimer in the
   documentation and/or other materials provided with the distribution.
3. The name of Mark Tarver may not be used to endorse or promote products
   derived from this software without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY Mark Tarver ''AS IS'' AND ANY
EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL Mark Tarver BE LIABLE FOR ANY
DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE."

(defun declare (V4007 V4008) (let Record (set shen.*signedfuncs* (cons (cons V4007 V4008) (value shen.*signedfuncs*))) (let Variancy (trap-error (shen.variancy-test V4007 V4008) (lambda E shen.skip)) (let Type (shen.rcons_form (shen.demodulate V4008)) (let F* (concat shen.type-signature-of- V4007) (let Parameters (shen.parameters 1) (let Clause (cons (cons F* (cons X ())) (cons :- (cons (cons (cons unify! (cons X (cons Type ()))) ()) ()))) (let AUM_instruction (shen.aum Clause Parameters) (let Code (shen.aum_to_shen AUM_instruction) (let ShenDef (cons define (cons F* (append Parameters (append (cons ProcessN (cons Continuation ())) (cons -> (cons Code ())))))) (let Eval (shen.eval-without-macros ShenDef) V4007)))))))))))

(defun shen.demodulate (V4010) (let Demod (shen.walk (value shen.*demodulation-function*) V4010) (if (= Demod V4010) V4010 (shen.demodulate Demod))))

(defun shen.variancy-test (V4013 V4014) (let TypeF (shen.typecheck V4013 B) (let Check (if (= symbol TypeF) shen.skip (if (shen.variant? TypeF V4014) shen.skip (shen.prhush (cn "warning: changing the type of " (shen.app V4013 " may create errors
" shen.a)) (stoutput)))) shen.skip)))

(defun shen.variant? (V4027 V4028) (cond ((= V4028 V4027) true) ((and (cons? V4027) (and (cons? V4028) (= (hd V4028) (hd V4027)))) (shen.variant? (tl V4027) (tl V4028))) ((and (cons? V4027) (and (cons? V4028) (and (shen.pvar? (hd V4027)) (variable? (hd V4028))))) (shen.variant? (subst shen.a (hd V4027) (tl V4027)) (subst shen.a (hd V4028) (tl V4028)))) ((and (cons? V4027) (and (cons? (hd V4027)) (and (cons? V4028) (cons? (hd V4028))))) (shen.variant? (append (hd V4027) (tl V4027)) (append (hd V4028) (tl V4028)))) (true false)))

(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 boolean? (cons A (cons --> (cons boolean ()))))

(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 A (cons shen.==> (cons B ()))) (cons --> (cons (cons A (cons --> (cons (cons (cons A (cons --> (cons B ()))) (cons --> (cons B ()))) ()))) ()))))

(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 list (cons A ())) (cons shen.==> (cons (cons list (cons B ())) ()))))

(declare <!> (cons (cons list (cons A ())) (cons shen.==> (cons (cons list (cons A ())) ()))))

(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 fail (cons --> (cons symbol ())))

(declare fail-if (cons (cons symbol (cons --> (cons boolean ()))) (cons --> (cons (cons symbol (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 function (cons (cons A (cons --> (cons B ()))) (cons --> (cons (cons A (cons --> (cons B ()))) ()))))

(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 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 kill (cons --> (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 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 (cons A (cons --> (cons B ()))) (cons --> (cons (cons A (cons --> (cons B ()))) ()))))

(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 (cons A (cons --> (cons B ()))) (cons --> (cons (cons (cons A (cons --> (cons B ()))) (cons * (cons number ()))) ()))))

(declare protect (cons symbol (cons --> (cons symbol ()))))

(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 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 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 symbol ()))))

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

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

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

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

(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 (cons A (cons --> (cons B ()))) (cons --> (cons (cons A (cons --> (cons B ()))) ()))))

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

(declare unspecialise (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 ()))) ()))))