shen/release/k_lambda/load.kl in shen-ruby-0.4.1 vs shen/release/k_lambda/load.kl in shen-ruby-0.5.0

- old
+ new

@@ -45,38 +45,40 @@ * * * For an explication of this license see www.shenlanguage.org/license.htm which * * explains this license in full. * * * ***************************************************************************************** -"(defun load (V808) (let Load (let Start (get-time run) (let Result (shen.load-help (value shen.*tc*) (read-file V808)) (let Finish (get-time run) (let Time (- Finish Start) (let Message (pr (cn " +"(defun load (V829) (let Load (let Start (get-time run) (let Result (shen.load-help (value shen.*tc*) (read-file V829)) (let Finish (get-time run) (let Time (- Finish Start) (let Message (shen.prhush (cn " run time: " (cn (str Time) " secs -")) (stoutput)) Result))))) (let Infs (if (value shen.*tc*) (pr (cn " +")) (stoutput)) Result))))) (let Infs (if (value shen.*tc*) (shen.prhush (cn " typechecked in " (shen.app (inferences) " inferences " shen.a)) (stoutput)) shen.skip) loaded))) -(defun shen.load-help (V813 V814) (cond ((= false V813) (map (lambda X (pr (shen.app (shen.eval-without-macros X) " -" shen.s) (stoutput))) V814)) (true (let RemoveSynonyms (mapcan shen.remove-synonyms V814) (let Table (mapcan shen.typetable RemoveSynonyms) (let Assume (map shen.assumetype Table) (trap-error (map shen.typecheck-and-load RemoveSynonyms) (lambda E (shen.unwind-types E Table))))))))) +(defun shen.load-help (V834 V835) (cond ((= false V834) (map (lambda X (shen.prhush (shen.app (shen.eval-without-macros X) " +" shen.s) (stoutput))) V835)) (true (let RemoveSynonyms (mapcan shen.remove-synonyms V835) (let Table (mapcan shen.typetable RemoveSynonyms) (let Assume (map shen.assumetype Table) (trap-error (map shen.typecheck-and-load RemoveSynonyms) (lambda E (shen.unwind-types E Table))))))))) -(defun shen.remove-synonyms (V815) (cond ((and (cons? V815) (= shen.synonyms-help (hd V815))) (do (eval V815) ())) (true (cons V815 ())))) +(defun shen.remove-synonyms (V836) (cond ((and (cons? V836) (= shen.synonyms-help (hd V836))) (do (eval V836) ())) (true (cons V836 ())))) -(defun shen.typecheck-and-load (V816) (do (nl 1) (shen.typecheck-and-evaluate V816 (gensym A)))) +(defun shen.typecheck-and-load (V837) (do (nl 1) (shen.typecheck-and-evaluate V837 (gensym A)))) -(defun shen.typetable (V825) (cond ((and (cons? V825) (and (= define (hd V825)) (cons? (tl V825)))) (let Sig (compile shen.<sig+rest> (tl (tl V825)) ()) (if (= Sig (fail)) (simple-error (shen.app (hd (tl V825)) " lacks a proper signature. -" shen.a)) (cons (cons (hd (tl V825)) Sig) ())))) ((and (cons? V825) (and (= defcc (hd V825)) (and (cons? (tl V825)) (and (cons? (tl (tl V825))) (and (= { (hd (tl (tl V825)))) (and (cons? (tl (tl (tl V825)))) (and (cons? (hd (tl (tl (tl V825))))) (and (= list (hd (hd (tl (tl (tl V825)))))) (and (cons? (tl (hd (tl (tl (tl V825)))))) (and (= () (tl (tl (hd (tl (tl (tl V825))))))) (and (cons? (tl (tl (tl (tl V825))))) (and (= ==> (hd (tl (tl (tl (tl V825)))))) (and (cons? (tl (tl (tl (tl (tl V825)))))) (and (cons? (tl (tl (tl (tl (tl (tl V825))))))) (= } (hd (tl (tl (tl (tl (tl (tl V825)))))))))))))))))))))) (cons (cons (hd (tl V825)) (cons (hd (tl (tl (tl V825)))) (cons ==> (cons (hd (tl (tl (tl (tl (tl V825)))))) ())))) ())) ((and (cons? V825) (and (= defcc (hd V825)) (cons? (tl V825)))) (simple-error (shen.app (hd (tl V825)) " lacks a proper signature. +(defun shen.typetable (V846) (cond ((and (cons? V846) (and (= define (hd V846)) (cons? (tl V846)))) (let Sig (compile shen.<sig+rest> (tl (tl V846)) ()) (if (= Sig (fail)) (simple-error (shen.app (hd (tl V846)) " lacks a proper signature. +" shen.a)) (cons (cons (hd (tl V846)) Sig) ())))) ((and (cons? V846) (and (= defcc (hd V846)) (and (cons? (tl V846)) (and (cons? (tl (tl V846))) (and (= { (hd (tl (tl V846)))) (and (cons? (tl (tl (tl V846)))) (and (cons? (hd (tl (tl (tl V846))))) (and (= list (hd (hd (tl (tl (tl V846)))))) (and (cons? (tl (hd (tl (tl (tl V846)))))) (and (= () (tl (tl (hd (tl (tl (tl V846))))))) (and (cons? (tl (tl (tl (tl V846))))) (and (= ==> (hd (tl (tl (tl (tl V846)))))) (and (cons? (tl (tl (tl (tl (tl V846)))))) (and (cons? (tl (tl (tl (tl (tl (tl V846))))))) (= } (hd (tl (tl (tl (tl (tl (tl V846)))))))))))))))))))))) (cons (cons (hd (tl V846)) (cons (hd (tl (tl (tl V846)))) (cons ==> (cons (hd (tl (tl (tl (tl (tl V846)))))) ())))) ())) ((and (cons? V846) (and (= defcc (hd V846)) (cons? (tl V846)))) (simple-error (shen.app (hd (tl V846)) " lacks a proper signature. " shen.a))) (true ()))) -(defun shen.assumetype (V826) (cond ((cons? V826) (declare (hd V826) (tl V826))) (true (shen.sys-error shen.assumetype)))) +(defun shen.assumetype (V847) (cond ((cons? V847) (declare (hd V847) (tl V847))) (true (shen.sys-error shen.assumetype)))) -(defun shen.unwind-types (V831 V832) (cond ((= () V832) (simple-error (error-to-string V831))) ((and (cons? V832) (cons? (hd V832))) (do (shen.remtype (hd (hd V832))) (shen.unwind-types V831 (tl V832)))) (true (shen.sys-error shen.unwind-types)))) +(defun shen.unwind-types (V852 V853) (cond ((= () V853) (simple-error (error-to-string V852))) ((and (cons? V853) (cons? (hd V853))) (do (shen.remtype (hd (hd V853))) (shen.unwind-types V852 (tl V853)))) (true (shen.sys-error shen.unwind-types)))) -(defun shen.remtype (V833) (do (set shen.*signedfuncs* (remove V833 (value shen.*signedfuncs*))) V833)) +(defun shen.remtype (V854) (set shen.*signedfuncs* (shen.removetype V854 (value shen.*signedfuncs*)))) -(defun shen.<sig+rest> (V838) (let Result (let Parse_shen.<signature> (shen.<signature> V838) (if (not (= (fail) Parse_shen.<signature>)) (let Parse_shen.<any> (shen.<any> Parse_shen.<signature>) (if (not (= (fail) Parse_shen.<any>)) (shen.pair (hd Parse_shen.<any>) (shen.hdtl Parse_shen.<signature>)) (fail))) (fail))) (if (= Result (fail)) (fail) Result))) +(defun shen.removetype (V859 V860) (cond ((= () V860) ()) ((and (cons? V860) (and (cons? (hd V860)) (= (hd (hd V860)) V859))) (shen.removetype (hd (hd V860)) (tl V860))) ((cons? V860) (cons (hd V860) (shen.removetype V859 (tl V860)))) (true (shen.sys-error shen.removetype)))) -(defun write-to-file (V839 V840) (let Stream (open file V839 out) (let String (if (string? V840) (shen.app V840 " +(defun shen.<sig+rest> (V866) (let Result (let Parse_shen.<signature> (shen.<signature> V866) (if (not (= (fail) Parse_shen.<signature>)) (let Parse_<!> (<!> Parse_shen.<signature>) (if (not (= (fail) Parse_<!>)) (shen.pair (hd Parse_<!>) (shen.hdtl Parse_shen.<signature>)) (fail))) (fail))) (if (= Result (fail)) (fail) Result))) -" shen.a) (shen.app V840 " +(defun write-to-file (V867 V868) (let Stream (open file V867 out) (let String (if (string? V868) (shen.app V868 " -" shen.s)) (let Write (pr String Stream) (let Close (close Stream) V840))))) +" shen.a) (shen.app V868 " + +" shen.s)) (let Write (pr String Stream) (let Close (close Stream) V868)))))