"********************************************************************************** * The License * * * * The user is free to produce commercial applications with the software, to * * distribute these applications in source or binary form, and to charge monies * * for them as he sees fit and in concordance with the laws of the land subject * * to the following license. * * * * 1. The license applies to all the software and all derived software and * * must appear on such. * * * * 2. It is illegal to distribute the software without this license attached * * to it and use of the software implies agreement with the license as such. * * It is illegal for anyone who is not the copyright holder to tamper with * * or change the license. * * * * 3. Neither the names of Lambda Associates or the copyright holder may be used * * to endorse or promote products built using the software without specific * * prior written permission from the copyright holder. * * * * 4. That possession of this license does not confer on the copyright holder * * any special contractual obligation towards the user. That in no event * * shall the copyright holder 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, * * interruption), however caused and on any theory of liability, whether in * * contract, strict liability or tort (including negligence) arising in any * * way out of the use of the software, even if advised of the possibility of * * such damage. * * * * 5. It is permitted for the user to change the software, for the purpose of * * improving performance, correcting an error, or porting to a new platform, * * and distribute the derived version of Shen provided the resulting program * * conforms in all respects to the Shen standard and is issued under that * * title. The user must make it clear with his distribution that he/she is * * the author of the changes and what these changes are and why. * * * * 6. Derived versions of this software in whatever form are subject to the same * * restrictions. In particular it is not permitted to make derived copies of * * this software which do not conform to the Shen standard or appear under a * * different title. * * * * It is permitted to distribute versions of Shen which incorporate libraries, * * graphics or other facilities which are not part of the Shen standard. * * * * For an explication of this license see www.shenlanguage.org/license.htm which * * explains this license in full. * * * ***************************************************************************************** "(defun macroexpand (V882) (let Y (shen.compose (value *macros*) V882) (if (= V882 Y) V882 (shen.walk (lambda X879 (macroexpand X879)) Y)))) (set *macros* (cons shen.timer-macro (cons shen.cases-macro (cons shen.abs-macro (cons shen.put/get-macro (cons shen.compile-macro (cons shen.datatype-macro (cons shen.let-macro (cons shen.assoc-macro (cons shen.make-string-macro (cons shen.output-macro (cons shen.input-macro (cons shen.error-macro (cons shen.prolog-macro (cons shen.synonyms-macro (cons shen.nl-macro (cons shen.@s-macro (cons shen.defprolog-macro (cons shen.function-macro ()))))))))))))))))))) (defun shen.error-macro (V883) (cond ((and (cons? V883) (and (= error (hd V883)) (cons? (tl V883)))) (cons simple-error (cons (shen.mkstr (hd (tl V883)) (tl (tl V883))) ()))) (true V883))) (defun shen.output-macro (V884) (cond ((and (cons? V884) (and (= output (hd V884)) (cons? (tl V884)))) (cons shen.prhush (cons (shen.mkstr (hd (tl V884)) (tl (tl V884))) (cons (cons stoutput ()) ())))) ((and (cons? V884) (and (= pr (hd V884)) (and (cons? (tl V884)) (= () (tl (tl V884)))))) (cons pr (cons (hd (tl V884)) (cons (cons stoutput ()) ())))) (true V884))) (defun shen.make-string-macro (V885) (cond ((and (cons? V885) (and (= make-string (hd V885)) (cons? (tl V885)))) (shen.mkstr (hd (tl V885)) (tl (tl V885)))) (true V885))) (defun shen.input-macro (V886) (cond ((and (cons? V886) (and (= lineread (hd V886)) (= () (tl V886)))) (cons lineread (cons (cons stinput ()) ()))) ((and (cons? V886) (and (= input (hd V886)) (= () (tl V886)))) (cons input (cons (cons stinput ()) ()))) ((and (cons? V886) (and (= read (hd V886)) (= () (tl V886)))) (cons read (cons (cons stinput ()) ()))) ((and (cons? V886) (and (= input+ (hd V886)) (and (cons? (tl V886)) (= () (tl (tl V886)))))) (cons input+ (cons (hd (tl V886)) (cons (cons stinput ()) ())))) ((and (cons? V886) (and (= read-byte (hd V886)) (= () (tl V886)))) (cons read-byte (cons (cons stinput ()) ()))) (true V886))) (defun shen.compose (V887 V888) (cond ((= () V887) V888) ((cons? V887) (shen.compose (tl V887) ((hd V887) V888))) (true (shen.sys-error shen.compose)))) (defun shen.compile-macro (V889) (cond ((and (cons? V889) (and (= compile (hd V889)) (and (cons? (tl V889)) (and (cons? (tl (tl V889))) (= () (tl (tl (tl V889)))))))) (cons compile (cons (hd (tl V889)) (cons (hd (tl (tl V889))) (cons (cons lambda (cons E (cons (cons if (cons (cons cons? (cons E ())) (cons (cons error (cons "parse error here: ~S~%" (cons E ()))) (cons (cons error (cons "parse error~%" ())) ())))) ()))) ()))))) (true V889))) (defun shen.prolog-macro (V890) (cond ((and (cons? V890) (= prolog? (hd V890))) (let F (gensym shen.f) (let Receive (shen.receive-terms (tl V890)) (let PrologDef (eval (append (cons defprolog (cons F ())) (append Receive (append (cons <-- ()) (append (shen.pass-literals (tl V890)) (cons ; ())))))) (let Query (cons F (append Receive (cons (cons shen.start-new-prolog-process ()) (cons (cons freeze (cons true ())) ())))) Query))))) (true V890))) (defun shen.receive-terms (V895) (cond ((= () V895) ()) ((and (cons? V895) (and (cons? (hd V895)) (and (= receive (hd (hd V895))) (and (cons? (tl (hd V895))) (= () (tl (tl (hd V895)))))))) (cons (hd (tl (hd V895))) (shen.receive-terms (tl V895)))) ((cons? V895) (shen.receive-terms (tl V895))) (true (shen.sys-error shen.receive-terms)))) (defun shen.pass-literals (V898) (cond ((= () V898) ()) ((and (cons? V898) (and (cons? (hd V898)) (and (= receive (hd (hd V898))) (and (cons? (tl (hd V898))) (= () (tl (tl (hd V898)))))))) (shen.pass-literals (tl V898))) ((cons? V898) (cons (hd V898) (shen.pass-literals (tl V898)))) (true (shen.sys-error shen.pass-literals)))) (defun shen.defprolog-macro (V899) (cond ((and (cons? V899) (and (= defprolog (hd V899)) (cons? (tl V899)))) (compile (lambda X880 (shen. X880)) (tl V899) (lambda Y (shen.prolog-error (hd (tl V899)) Y)))) (true V899))) (defun shen.datatype-macro (V900) (cond ((and (cons? V900) (and (= datatype (hd V900)) (cons? (tl V900)))) (cons shen.process-datatype (cons (shen.intern-type (hd (tl V900))) (cons (cons compile (cons (cons function (cons shen. ())) (cons (shen.rcons_form (tl (tl V900))) (cons (cons function (cons shen.datatype-error ())) ())))) ())))) (true V900))) (defun shen.intern-type (V901) (intern (cn "type#" (str V901)))) "(defcc := [define | ];) (defcc ; := (append [(protect X) -> (protect X)]);) (defcc -> where ; -> ; <- where ; <- ;) (defcc := [[walk [function macroexpand] ]];)" (defun shen.@s-macro (V902) (cond ((and (cons? V902) (and (= @s (hd V902)) (and (cons? (tl V902)) (and (cons? (tl (tl V902))) (cons? (tl (tl (tl V902)))))))) (cons @s (cons (hd (tl V902)) (cons (shen.@s-macro (cons @s (tl (tl V902)))) ())))) ((and (cons? V902) (and (= @s (hd V902)) (and (cons? (tl V902)) (and (cons? (tl (tl V902))) (and (= () (tl (tl (tl V902)))) (string? (hd (tl V902)))))))) (let E (explode (hd (tl V902))) (if (> (length E) 1) (shen.@s-macro (cons @s (append E (tl (tl V902))))) V902))) (true V902))) (defun shen.synonyms-macro (V903) (cond ((and (cons? V903) (= synonyms (hd V903))) (cons shen.synonyms-help (cons (shen.rcons_form (shen.curry-synonyms (tl V903))) ()))) (true V903))) (defun shen.curry-synonyms (V904) (map (lambda X881 (shen.curry-type X881)) V904)) (defun shen.nl-macro (V905) (cond ((and (cons? V905) (and (= nl (hd V905)) (= () (tl V905)))) (cons nl (cons 1 ()))) (true V905))) (defun shen.assoc-macro (V906) (cond ((and (cons? V906) (and (cons? (tl V906)) (and (cons? (tl (tl V906))) (and (cons? (tl (tl (tl V906)))) (element? (hd V906) (cons @p (cons @v (cons append (cons and (cons or (cons + (cons * (cons do ()))))))))))))) (cons (hd V906) (cons (hd (tl V906)) (cons (shen.assoc-macro (cons (hd V906) (tl (tl V906)))) ())))) (true V906))) (defun shen.let-macro (V907) (cond ((and (cons? V907) (and (= let (hd V907)) (and (cons? (tl V907)) (and (cons? (tl (tl V907))) (and (cons? (tl (tl (tl V907)))) (cons? (tl (tl (tl (tl V907)))))))))) (cons let (cons (hd (tl V907)) (cons (hd (tl (tl V907))) (cons (shen.let-macro (cons let (tl (tl (tl V907))))) ()))))) (true V907))) (defun shen.abs-macro (V908) (cond ((and (cons? V908) (and (= /. (hd V908)) (and (cons? (tl V908)) (and (cons? (tl (tl V908))) (cons? (tl (tl (tl V908)))))))) (cons lambda (cons (hd (tl V908)) (cons (shen.abs-macro (cons /. (tl (tl V908)))) ())))) ((and (cons? V908) (and (= /. (hd V908)) (and (cons? (tl V908)) (and (cons? (tl (tl V908))) (= () (tl (tl (tl V908)))))))) (cons lambda (tl V908))) (true V908))) (defun shen.cases-macro (V911) (cond ((and (cons? V911) (and (= cases (hd V911)) (and (cons? (tl V911)) (and (= true (hd (tl V911))) (cons? (tl (tl V911))))))) (hd (tl (tl V911)))) ((and (cons? V911) (and (= cases (hd V911)) (and (cons? (tl V911)) (and (cons? (tl (tl V911))) (= () (tl (tl (tl V911)))))))) (cons if (cons (hd (tl V911)) (cons (hd (tl (tl V911))) (cons (cons simple-error (cons "error: cases exhausted" ())) ()))))) ((and (cons? V911) (and (= cases (hd V911)) (and (cons? (tl V911)) (cons? (tl (tl V911)))))) (cons if (cons (hd (tl V911)) (cons (hd (tl (tl V911))) (cons (shen.cases-macro (cons cases (tl (tl (tl V911))))) ()))))) ((and (cons? V911) (and (= cases (hd V911)) (and (cons? (tl V911)) (= () (tl (tl V911)))))) (simple-error "error: odd number of case elements ")) (true V911))) (defun shen.timer-macro (V912) (cond ((and (cons? V912) (and (= time (hd V912)) (and (cons? (tl V912)) (= () (tl (tl V912)))))) (shen.let-macro (cons let (cons Start (cons (cons get-time (cons run ())) (cons Result (cons (hd (tl V912)) (cons Finish (cons (cons get-time (cons run ())) (cons Time (cons (cons - (cons Finish (cons Start ()))) (cons Message (cons (cons shen.prhush (cons (cons cn (cons " run time: " (cons (cons cn (cons (cons str (cons Time ())) (cons " secs " ()))) ()))) (cons (cons stoutput ()) ()))) (cons Result ())))))))))))))) (true V912))) (defun shen.tuple-up (V913) (cond ((cons? V913) (cons @p (cons (hd V913) (cons (shen.tuple-up (tl V913)) ())))) (true V913))) (defun shen.put/get-macro (V914) (cond ((and (cons? V914) (and (= put (hd V914)) (and (cons? (tl V914)) (and (cons? (tl (tl V914))) (and (cons? (tl (tl (tl V914)))) (= () (tl (tl (tl (tl V914)))))))))) (cons put (cons (hd (tl V914)) (cons (hd (tl (tl V914))) (cons (hd (tl (tl (tl V914)))) (cons (cons value (cons *property-vector* ())) ())))))) ((and (cons? V914) (and (= get (hd V914)) (and (cons? (tl V914)) (and (cons? (tl (tl V914))) (= () (tl (tl (tl V914)))))))) (cons get (cons (hd (tl V914)) (cons (hd (tl (tl V914))) (cons (cons value (cons *property-vector* ())) ()))))) (true V914))) (defun shen.function-macro (V915) (cond ((and (cons? V915) (and (= function (hd V915)) (and (cons? (tl V915)) (= () (tl (tl V915)))))) (shen.function-abstraction (hd (tl V915)) (arity (hd (tl V915))))) (true V915))) (defun shen.function-abstraction (V916 V917) (cond ((= 0 V917) (cons freeze (cons V916 ()))) ((= -1 V917) V916) (true (shen.function-abstraction-help V916 V917 ())))) (defun shen.function-abstraction-help (V918 V919 V920) (cond ((= 0 V919) (cons V918 V920)) (true (let X (gensym V) (cons /. (cons X (cons (shen.function-abstraction-help V918 (- V919 1) (append V920 (cons X ()))) ()))))))) (defun undefmacro (V921) (do (set *macros* (remove V921 (value *macros*))) V921))