"********************************************************************************** * 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 shen.f_error (V2086) (do (shen.prhush (cn "partial function " (shen.app V2086 "; " shen.a)) (stoutput)) (do (if (and (not (shen.tracked? V2086)) (y-or-n? (cn "track " (shen.app V2086 "? " shen.a)))) (shen.track-function (ps V2086)) shen.ok) (simple-error "aborted")))) (defun shen.tracked? (V2087) (element? V2087 (value shen.*tracking*))) (defun track (V2088) (let Source (ps V2088) (shen.track-function Source))) (defun shen.track-function (V2089) (cond ((and (cons? V2089) (and (= defun (hd V2089)) (and (cons? (tl V2089)) (and (cons? (tl (tl V2089))) (and (cons? (tl (tl (tl V2089)))) (= () (tl (tl (tl (tl V2089)))))))))) (let KL (cons defun (cons (hd (tl V2089)) (cons (hd (tl (tl V2089))) (cons (shen.insert-tracking-code (hd (tl V2089)) (hd (tl (tl V2089))) (hd (tl (tl (tl V2089))))) ())))) (let Ob (eval KL) (let Tr (set shen.*tracking* (cons Ob (value shen.*tracking*))) Ob)))) (true (shen.sys-error shen.track-function)))) (defun shen.insert-tracking-code (V2090 V2091 V2092) (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 V2090 (cons (shen.cons_form V2091) ())))) (cons (cons do (cons (cons shen.terpri-or-read-char ()) (cons (cons let (cons Result (cons V2092 (cons (cons do (cons (cons shen.output-track (cons (cons value (cons shen.*call* ())) (cons V2090 (cons 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 Result ()))) ()))) ()))) ())))) ()))) ()))) ())))) (set shen.*step* false) (defun step (V2097) (cond ((= + V2097) (set shen.*step* true)) ((= - V2097) (set shen.*step* false)) (true (simple-error "step expects a + or a -. ")))) (defun spy (V2102) (cond ((= + V2102) (set shen.*spy* true)) ((= - V2102) (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 (V2107) (cond ((= V2107 (shen.hat)) (simple-error "aborted")) (true true))) (defun shen.input-track (V2108 V2109 V2110) (do (shen.prhush (cn " " (shen.app (shen.spaces V2108) (cn "<" (shen.app V2108 (cn "> Inputs to " (shen.app V2109 (cn " " (shen.app (shen.spaces V2108) "" shen.a)) shen.a)) shen.a)) shen.a)) (stoutput)) (shen.recursively-print V2110))) (defun shen.recursively-print (V2111) (cond ((= () V2111) (shen.prhush " ==>" (stoutput))) ((cons? V2111) (do (print (hd V2111)) (do (shen.prhush ", " (stoutput)) (shen.recursively-print (tl V2111))))) (true (shen.sys-error shen.recursively-print)))) (defun shen.spaces (V2112) (cond ((= 0 V2112) "") (true (cn " " (shen.spaces (- V2112 1)))))) (defun shen.output-track (V2113 V2114 V2115) (shen.prhush (cn " " (shen.app (shen.spaces V2113) (cn "<" (shen.app V2113 (cn "> Output from " (shen.app V2114 (cn " " (shen.app (shen.spaces V2113) (cn "==> " (shen.app V2115 "" shen.s)) shen.a)) shen.a)) shen.a)) shen.a)) (stoutput))) (defun untrack (V2116) (eval (ps V2116))) (defun profile (V2117) (shen.profile-help (ps V2117))) (defun shen.profile-help (V2122) (cond ((and (cons? V2122) (and (= defun (hd V2122)) (and (cons? (tl V2122)) (and (cons? (tl (tl V2122))) (and (cons? (tl (tl (tl V2122)))) (= () (tl (tl (tl (tl V2122)))))))))) (let G (gensym shen.f) (let Profile (cons defun (cons (hd (tl V2122)) (cons (hd (tl (tl V2122))) (cons (shen.profile-func (hd (tl V2122)) (hd (tl (tl V2122))) (cons G (hd (tl (tl V2122))))) ())))) (let Def (cons defun (cons G (cons (hd (tl (tl V2122))) (cons (subst G (hd (tl V2122)) (hd (tl (tl (tl V2122))))) ())))) (let CompileProfile (shen.eval-without-macros Profile) (let CompileG (shen.eval-without-macros Def) (hd (tl V2122)))))))) (true (simple-error "Cannot profile. ")))) (defun unprofile (V2123) (untrack V2123)) (defun shen.profile-func (V2124 V2125 V2126) (cons let (cons Start (cons (cons get-time (cons run ())) (cons (cons let (cons Result (cons V2126 (cons (cons let (cons Finish (cons (cons - (cons (cons get-time (cons run ())) (cons Start ()))) (cons (cons let (cons Record (cons (cons shen.put-profile (cons V2124 (cons (cons + (cons (cons shen.get-profile (cons V2124 ())) (cons Finish ()))) ()))) (cons Result ())))) ())))) ())))) ()))))) (defun profile-results (V2127) (let Results (shen.get-profile V2127) (let Initialise (shen.put-profile V2127 0) (@p V2127 Results)))) (defun shen.get-profile (V2128) (trap-error (get V2128 profile (value *property-vector*)) (lambda E 0))) (defun shen.put-profile (V2129 V2130) (put V2129 profile V2130 (value *property-vector*)))