"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 thaw (V17359) (V17359))

(defun eval (V17361) (let Macroexpand (shen.walk (lambda Y (macroexpand Y)) V17361) (if (shen.packaged? Macroexpand) (map (lambda Z (shen.eval-without-macros Z)) (shen.package-contents Macroexpand)) (shen.eval-without-macros Macroexpand))))

(defun shen.eval-without-macros (V17363) (eval-kl (shen.elim-def (shen.proc-input+ V17363))))

(defun shen.proc-input+ (V17365) (cond ((and (cons? V17365) (and (= input+ (hd V17365)) (and (cons? (tl V17365)) (and (cons? (tl (tl V17365))) (= () (tl (tl (tl V17365)))))))) (cons input+ (cons (shen.rcons_form (hd (tl V17365))) (tl (tl V17365))))) ((and (cons? V17365) (and (= shen.read+ (hd V17365)) (and (cons? (tl V17365)) (and (cons? (tl (tl V17365))) (= () (tl (tl (tl V17365)))))))) (cons shen.read+ (cons (shen.rcons_form (hd (tl V17365))) (tl (tl V17365))))) ((cons? V17365) (map (lambda Z (shen.proc-input+ Z)) V17365)) (true V17365)))

(defun shen.elim-def (V17367) (cond ((and (cons? V17367) (and (= define (hd V17367)) (cons? (tl V17367)))) (shen.shen->kl (hd (tl V17367)) (tl (tl V17367)))) ((and (cons? V17367) (and (= defmacro (hd V17367)) (cons? (tl V17367)))) (let Default (cons X (cons -> (cons X ()))) (let Def (shen.elim-def (cons define (cons (hd (tl V17367)) (append (tl (tl V17367)) Default)))) (let MacroAdd (shen.add-macro (hd (tl V17367))) Def)))) ((and (cons? V17367) (and (= defcc (hd V17367)) (cons? (tl V17367)))) (shen.elim-def (shen.yacc V17367))) ((cons? V17367) (map (lambda Z (shen.elim-def Z)) V17367)) (true V17367)))

(defun shen.add-macro (V17369) (let MacroReg (value shen.*macroreg*) (let NewMacroReg (set shen.*macroreg* (adjoin V17369 (value shen.*macroreg*))) (if (= MacroReg NewMacroReg) shen.skip (set *macros* (cons (function V17369) (value *macros*)))))))

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

(defun external (V17379) (trap-error (get V17379 shen.external-symbols (value *property-vector*)) (lambda E (simple-error (cn "package " (shen.app V17379 " has not been used.
" shen.a))))))

(defun shen.package-contents (V17383) (cond ((and (cons? V17383) (and (= package (hd V17383)) (and (cons? (tl V17383)) (and (= null (hd (tl V17383))) (cons? (tl (tl V17383))))))) (tl (tl (tl V17383)))) ((and (cons? V17383) (and (= package (hd V17383)) (and (cons? (tl V17383)) (cons? (tl (tl V17383)))))) (shen.packageh (hd (tl V17383)) (hd (tl (tl V17383))) (tl (tl (tl V17383))))) (true (shen.f_error shen.package-contents))))

(defun shen.walk (V17386 V17387) (cond ((cons? V17387) (V17386 (map (lambda Z (shen.walk V17386 Z)) V17387))) (true (V17386 V17387))))

(defun compile (V17391 V17392 V17393) (let O (V17391 (cons V17392 (cons () ()))) (if (or (= (fail) O) (not (empty? (hd O)))) (V17393 O) (shen.hdtl O))))

(defun fail-if (V17396 V17397) (if (V17396 V17397) (fail) V17397))

(defun @s (V17400 V17401) (cn V17400 V17401))

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

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

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

(defun shen.+vector? (V17405) (and (absvector? V17405) (> (<-address V17405 0) 0)))

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

(defun shen.fillvector (V17413 V17414 V17415 V17416) (cond ((= V17415 V17414) (address-> V17413 V17415 V17416)) (true (shen.fillvector (address-> V17413 V17414 V17416) (+ 1 V17414) V17415 V17416))))

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

(defun vector-> (V17422 V17423 V17424) (if (= V17423 0) (simple-error "cannot access 0th element of a vector
") (address-> V17422 V17423 V17424)))

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

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

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

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

(defun shen.analyse-symbol? (V17436) (cond ((shen.+string? V17436) (and (shen.alpha? (pos V17436 0)) (shen.alphanums? (tlstr V17436)))) (true (shen.f_error shen.analyse-symbol?))))

(defun shen.alpha? (V17438) (element? V17438 (cons "A" (cons "B" (cons "C" (cons "D" (cons "E" (cons "F" (cons "G" (cons "H" (cons "I" (cons "J" (cons "K" (cons "L" (cons "M" (cons "N" (cons "O" (cons "P" (cons "Q" (cons "R" (cons "S" (cons "T" (cons "U" (cons "V" (cons "W" (cons "X" (cons "Y" (cons "Z" (cons "a" (cons "b" (cons "c" (cons "d" (cons "e" (cons "f" (cons "g" (cons "h" (cons "i" (cons "j" (cons "k" (cons "l" (cons "m" (cons "n" (cons "o" (cons "p" (cons "q" (cons "r" (cons "s" (cons "t" (cons "u" (cons "v" (cons "w" (cons "x" (cons "y" (cons "z" (cons "=" (cons "*" (cons "/" (cons "+" (cons "-" (cons "_" (cons "?" (cons "$" (cons "!" (cons "@" (cons "~" (cons ">" (cons "<" (cons "&" (cons "%" (cons "{" (cons "}" (cons ":" (cons ";" (cons "`" (cons "#" (cons "'" (cons "." ())))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))

(defun shen.alphanums? (V17440) (cond ((= "" V17440) true) ((shen.+string? V17440) (and (shen.alphanum? (pos V17440 0)) (shen.alphanums? (tlstr V17440)))) (true (shen.f_error shen.alphanums?))))

(defun shen.alphanum? (V17442) (or (shen.alpha? V17442) (shen.digit? V17442)))

(defun shen.digit? (V17444) (element? V17444 (cons "1" (cons "2" (cons "3" (cons "4" (cons "5" (cons "6" (cons "7" (cons "8" (cons "9" (cons "0" ()))))))))))))

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

(defun shen.analyse-variable? (V17448) (cond ((shen.+string? V17448) (and (shen.uppercase? (pos V17448 0)) (shen.alphanums? (tlstr V17448)))) (true (shen.f_error shen.analyse-variable?))))

(defun shen.uppercase? (V17450) (element? V17450 (cons "A" (cons "B" (cons "C" (cons "D" (cons "E" (cons "F" (cons "G" (cons "H" (cons "I" (cons "J" (cons "K" (cons "L" (cons "M" (cons "N" (cons "O" (cons "P" (cons "Q" (cons "R" (cons "S" (cons "T" (cons "U" (cons "V" (cons "W" (cons "X" (cons "Y" (cons "Z" ()))))))))))))))))))))))))))))

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

(defun concat (V17455 V17456) (intern (cn (str V17455) (str V17456))))

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

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

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

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

(defun append (V17469 V17470) (cond ((= () V17469) V17470) ((cons? V17469) (cons (hd V17469) (append (tl V17469) V17470))) (true (shen.f_error append))))

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

(defun shen.@v-help (V17480 V17481 V17482 V17483) (cond ((= V17482 V17481) (shen.copyfromvector V17480 V17483 V17482 (+ V17482 1))) (true (shen.@v-help V17480 (+ V17481 1) V17482 (shen.copyfromvector V17480 V17483 V17481 (+ V17481 1))))))

(defun shen.copyfromvector (V17488 V17489 V17490 V17491) (trap-error (vector-> V17489 V17491 (<-vector V17488 V17490)) (lambda E V17489)))

(defun hdv (V17493) (trap-error (<-vector V17493 1) (lambda E (simple-error (cn "hdv needs a non-empty vector as an argument; not " (shen.app V17493 "
" shen.s))))))

(defun tlv (V17495) (let Limit (limit V17495) (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 V17495 2 Limit (vector (- Limit 1))))))))

(defun shen.tlv-help (V17501 V17502 V17503 V17504) (cond ((= V17503 V17502) (shen.copyfromvector V17501 V17504 V17503 (- V17503 1))) (true (shen.tlv-help V17501 (+ V17502 1) V17503 (shen.copyfromvector V17501 V17504 V17502 (- V17502 1))))))

(defun assoc (V17516 V17517) (cond ((= () V17517) ()) ((and (cons? V17517) (and (cons? (hd V17517)) (= (hd (hd V17517)) V17516))) (hd V17517)) ((cons? V17517) (assoc V17516 (tl V17517))) (true (shen.f_error assoc))))

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

(defun nl (V17525) (cond ((= 0 V17525) 0) (true (do (shen.prhush "
" (stoutput)) (nl (- V17525 1))))))

(defun difference (V17530 V17531) (cond ((= () V17530) ()) ((cons? V17530) (if (element? (hd V17530) V17531) (difference (tl V17530) V17531) (cons (hd V17530) (difference (tl V17530) V17531)))) (true (shen.f_error difference))))

(defun do (V17534 V17535) V17535)

(defun element? (V17547 V17548) (cond ((= () V17548) false) ((and (cons? V17548) (= (hd V17548) V17547)) true) ((cons? V17548) (element? V17547 (tl V17548))) (true (shen.f_error element?))))

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

(defun fix (V17557 V17558) (shen.fix-help V17557 V17558 (V17557 V17558)))

(defun shen.fix-help (V17569 V17570 V17571) (cond ((= V17571 V17570) V17571) (true (shen.fix-help V17569 V17571 (V17569 V17571)))))

(defun put (V17576 V17577 V17578 V17579) (let N (hash V17576 (limit V17579)) (let Entry (trap-error (<-vector V17579 N) (lambda E ())) (let Change (vector-> V17579 N (shen.change-pointer-value V17576 V17577 V17578 Entry)) V17578))))

(defun unput (V17583 V17584 V17585) (let N (hash V17583 (limit V17585)) (let Entry (trap-error (<-vector V17585 N) (lambda E ())) (let Change (vector-> V17585 N (shen.remove-pointer V17583 V17584 Entry)) V17583))))

(defun shen.remove-pointer (V17593 V17594 V17595) (cond ((= () V17595) ()) ((and (cons? V17595) (and (cons? (hd V17595)) (and (cons? (hd (hd V17595))) (and (cons? (tl (hd (hd V17595)))) (and (= () (tl (tl (hd (hd V17595))))) (and (= (hd (tl (hd (hd V17595)))) V17594) (= (hd (hd (hd V17595))) V17593))))))) (tl V17595)) ((cons? V17595) (cons (hd V17595) (shen.remove-pointer V17593 V17594 (tl V17595)))) (true (shen.f_error shen.remove-pointer))))

(defun shen.change-pointer-value (V17604 V17605 V17606 V17607) (cond ((= () V17607) (cons (cons (cons V17604 (cons V17605 ())) V17606) ())) ((and (cons? V17607) (and (cons? (hd V17607)) (and (cons? (hd (hd V17607))) (and (cons? (tl (hd (hd V17607)))) (and (= () (tl (tl (hd (hd V17607))))) (and (= (hd (tl (hd (hd V17607)))) V17605) (= (hd (hd (hd V17607))) V17604))))))) (cons (cons (hd (hd V17607)) V17606) (tl V17607))) ((cons? V17607) (cons (hd V17607) (shen.change-pointer-value V17604 V17605 V17606 (tl V17607)))) (true (shen.f_error shen.change-pointer-value))))

(defun get (V17611 V17612 V17613) (let N (hash V17611 (limit V17613)) (let Entry (trap-error (<-vector V17613 N) (lambda E (simple-error "pointer not found
"))) (let Result (assoc (cons V17611 (cons V17612 ())) Entry) (if (empty? Result) (simple-error "value not found
") (tl Result))))))

(defun hash (V17616 V17617) (let Hash (shen.mod (sum (map (lambda X (string->n X)) (explode V17616))) V17617) (if (= 0 Hash) 1 Hash)))

(defun shen.mod (V17620 V17621) (shen.modh V17620 (shen.multiples V17620 (cons V17621 ()))))

(defun shen.multiples (V17624 V17625) (cond ((and (cons? V17625) (> (hd V17625) V17624)) (tl V17625)) ((cons? V17625) (shen.multiples V17624 (cons (* 2 (hd V17625)) V17625))) (true (shen.f_error shen.multiples))))

(defun shen.modh (V17630 V17631) (cond ((= 0 V17630) 0) ((= () V17631) V17630) ((and (cons? V17631) (> (hd V17631) V17630)) (if (empty? (tl V17631)) V17630 (shen.modh V17630 (tl V17631)))) ((cons? V17631) (shen.modh (- V17630 (hd V17631)) V17631)) (true (shen.f_error shen.modh))))

(defun sum (V17633) (cond ((= () V17633) 0) ((cons? V17633) (+ (hd V17633) (sum (tl V17633)))) (true (shen.f_error sum))))

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

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

(defun hdstr (V17651) (pos V17651 0))

(defun intersection (V17656 V17657) (cond ((= () V17656) ()) ((cons? V17656) (if (element? (hd V17656) V17657) (cons (hd V17656) (intersection (tl V17656) V17657)) (intersection (tl V17656) V17657))) (true (shen.f_error intersection))))

(defun reverse (V17659) (shen.reverse_help V17659 ()))

(defun shen.reverse_help (V17662 V17663) (cond ((= () V17662) V17663) ((cons? V17662) (shen.reverse_help (tl V17662) (cons (hd V17662) V17663))) (true (shen.f_error shen.reverse_help))))

(defun union (V17666 V17667) (cond ((= () V17666) V17667) ((cons? V17666) (if (element? (hd V17666) V17667) (union (tl V17666) V17667) (cons (hd V17666) (union (tl V17666) V17667)))) (true (shen.f_error union))))

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

(defun not (V17671) (if V17671 false true))

(defun subst (V17684 V17685 V17686) (cond ((= V17686 V17685) V17684) ((cons? V17686) (map (lambda W (subst V17684 V17685 W)) V17686)) (true V17686)))

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

(defun shen.explode-h (V17690) (cond ((= "" V17690) ()) ((shen.+string? V17690) (cons (pos V17690 0) (shen.explode-h (tlstr V17690)))) (true (shen.f_error shen.explode-h))))

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

(defun map (V17695 V17696) (shen.map-h V17695 V17696 ()))

(defun shen.map-h (V17702 V17703 V17704) (cond ((= () V17703) (reverse V17704)) ((cons? V17703) (shen.map-h V17702 (tl V17703) (cons (V17702 (hd V17703)) V17704))) (true (shen.f_error shen.map-h))))

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

(defun shen.length-h (V17709 V17710) (cond ((= () V17709) V17710) (true (shen.length-h (tl V17709) (+ V17710 1)))))

(defun occurrences (V17722 V17723) (cond ((= V17723 V17722) 1) ((cons? V17723) (+ (occurrences V17722 (hd V17723)) (occurrences V17722 (tl V17723)))) (true 0)))

(defun nth (V17732 V17733) (cond ((and (= 1 V17732) (cons? V17733)) (hd V17733)) ((cons? V17733) (nth (- V17732 1) (tl V17733))) (true (shen.f_error nth))))

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

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

(defun shen.magless (V17740 V17741) (let Nx2 (* V17741 2) (if (> Nx2 V17740) V17741 (shen.magless V17740 Nx2))))

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

(defun mapcan (V17753 V17754) (cond ((= () V17754) ()) ((cons? V17754) (append (V17753 (hd V17754)) (mapcan V17753 (tl V17754)))) (true (shen.f_error mapcan))))

(defun == (V17766 V17767) (cond ((= V17767 V17766) true) (true false)))

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

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

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

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

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

(defun protect (V17775) V17775)

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

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

(defun optimise (V17783) (cond ((= + V17783) (set shen.*optimise* true)) ((= - V17783) (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? (V17785) (trap-error (do (external V17785) true) (lambda E false)))

(defun function (V17787) (shen.lookup-func V17787 (value shen.*symbol-table*)))

(defun shen.lookup-func (V17797 V17798) (cond ((= () V17798) (simple-error (shen.app V17797 " has no lambda expansion
" shen.a))) ((and (cons? V17798) (and (cons? (hd V17798)) (= (hd (hd V17798)) V17797))) (tl (hd V17798))) ((cons? V17798) (shen.lookup-func V17797 (tl V17798))) (true (shen.f_error shen.lookup-func))))