shen/release/k_lambda/track.kl in shen-ruby-0.4.1 vs shen/release/k_lambda/track.kl in shen-ruby-0.5.0
- old
+ new
@@ -45,59 +45,59 @@
* *
* For an explication of this license see www.shenlanguage.org/license.htm which *
* explains this license in full. *
* *
*****************************************************************************************
-"(defun shen.f_error (V2032) (do (pr (cn "partial function " (shen.app V2032 ";
-" shen.a)) (stoutput)) (do (if (and (not (shen.tracked? V2032)) (y-or-n? (cn "track " (shen.app V2032 "? " shen.a)))) (shen.track-function (ps V2032)) shen.ok) (simple-error "aborted"))))
+"(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? (V2033) (element? V2033 (value shen.*tracking*)))
+(defun shen.tracked? (V2087) (element? V2087 (value shen.*tracking*)))
-(defun track (V2034) (let Source (ps V2034) (shen.track-function Source)))
+(defun track (V2088) (let Source (ps V2088) (shen.track-function Source)))
-(defun shen.track-function (V2035) (cond ((and (cons? V2035) (and (= defun (hd V2035)) (and (cons? (tl V2035)) (and (cons? (tl (tl V2035))) (and (cons? (tl (tl (tl V2035)))) (= () (tl (tl (tl (tl V2035)))))))))) (let KL (cons defun (cons (hd (tl V2035)) (cons (hd (tl (tl V2035))) (cons (shen.insert-tracking-code (hd (tl V2035)) (hd (tl (tl V2035))) (hd (tl (tl (tl V2035))))) ())))) (let Ob (eval KL) (let Tr (set shen.*tracking* (cons Ob (value shen.*tracking*))) Ob)))) (true (shen.sys-error shen.track-function))))
+(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 (V2036 V2037 V2038) (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 V2036 (cons (shen.cons_form V2037) ())))) (cons (cons do (cons (cons shen.terpri-or-read-char ()) (cons (cons let (cons Result (cons V2038 (cons (cons do (cons (cons shen.output-track (cons (cons value (cons shen.*call* ())) (cons V2036 (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 ()))) ()))) ()))) ())))) ()))) ()))) ()))))
+(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 (V2043) (cond ((= + V2043) (set shen.*step* true)) ((= - V2043) (set shen.*step* false)) (true (simple-error "step expects a + or a -.
+(defun step (V2097) (cond ((= + V2097) (set shen.*step* true)) ((= - V2097) (set shen.*step* false)) (true (simple-error "step expects a + or a -.
"))))
-(defun spy (V2048) (cond ((= + V2048) (set shen.*spy* true)) ((= - V2048) (set shen.*spy* false)) (true (simple-error "spy 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 (V2053) (cond ((= V2053 (shen.hat)) (simple-error "aborted")) (true true)))
+(defun shen.check-byte (V2107) (cond ((= V2107 (shen.hat)) (simple-error "aborted")) (true true)))
-(defun shen.input-track (V2054 V2055 V2056) (do (pr (cn "
-" (shen.app (shen.spaces V2054) (cn "<" (shen.app V2054 (cn "> Inputs to " (shen.app V2055 (cn "
-" (shen.app (shen.spaces V2054) "" shen.a)) shen.a)) shen.a)) shen.a)) (stoutput)) (shen.recursively-print V2056)))
+(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 (V2057) (cond ((= () V2057) (pr " ==>" (stoutput))) ((cons? V2057) (do (print (hd V2057)) (do (pr ", " (stoutput)) (shen.recursively-print (tl V2057))))) (true (shen.sys-error shen.recursively-print))))
+(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 (V2058) (cond ((= 0 V2058) "") (true (cn " " (shen.spaces (- V2058 1))))))
+(defun shen.spaces (V2112) (cond ((= 0 V2112) "") (true (cn " " (shen.spaces (- V2112 1))))))
-(defun shen.output-track (V2059 V2060 V2061) (pr (cn "
-" (shen.app (shen.spaces V2059) (cn "<" (shen.app V2059 (cn "> Output from " (shen.app V2060 (cn "
-" (shen.app (shen.spaces V2059) (cn "==> " (shen.app V2061 "" shen.s)) shen.a)) shen.a)) shen.a)) shen.a)) (stoutput)))
+(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 (V2062) (eval (ps V2062)))
+(defun untrack (V2116) (eval (ps V2116)))
-(defun profile (V2063) (shen.profile-help (ps V2063)))
+(defun profile (V2117) (shen.profile-help (ps V2117)))
-(defun shen.profile-help (V2068) (cond ((and (cons? V2068) (and (= defun (hd V2068)) (and (cons? (tl V2068)) (and (cons? (tl (tl V2068))) (and (cons? (tl (tl (tl V2068)))) (= () (tl (tl (tl (tl V2068)))))))))) (let G (gensym shen.f) (let Profile (cons defun (cons (hd (tl V2068)) (cons (hd (tl (tl V2068))) (cons (shen.profile-func (hd (tl V2068)) (hd (tl (tl V2068))) (cons G (hd (tl (tl V2068))))) ())))) (let Def (cons defun (cons G (cons (hd (tl (tl V2068))) (cons (subst G (hd (tl V2068)) (hd (tl (tl (tl V2068))))) ())))) (let CompileProfile (shen.eval-without-macros Profile) (let CompileG (shen.eval-without-macros Def) (hd (tl V2068)))))))) (true (simple-error "Cannot profile.
+(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 (V2069) (untrack V2069))
+(defun unprofile (V2123) (untrack V2123))
-(defun shen.profile-func (V2070 V2071 V2072) (cons let (cons Start (cons (cons get-time (cons run ())) (cons (cons let (cons Result (cons V2072 (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 V2070 (cons (cons + (cons (cons shen.get-profile (cons V2070 ())) (cons Finish ()))) ()))) (cons Result ())))) ())))) ())))) ())))))
+(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 (V2073) (let Results (shen.get-profile V2073) (let Initialise (shen.put-profile V2073 0) (@p V2073 Results))))
+(defun profile-results (V2127) (let Results (shen.get-profile V2127) (let Initialise (shen.put-profile V2127 0) (@p V2127 Results))))
-(defun shen.get-profile (V2074) (trap-error (get V2074 profile (value *property-vector*)) (lambda E 0)))
+(defun shen.get-profile (V2128) (trap-error (get V2128 profile (value *property-vector*)) (lambda E 0)))
-(defun shen.put-profile (V2075 V2076) (put V2075 profile V2076 (value *property-vector*)))
+(defun shen.put-profile (V2129 V2130) (put V2129 profile V2130 (value *property-vector*)))