shen-ruby 0.12.1 → 0.13.0

data/shen/release/klambda/writer.kl

@@ -0,0 +1,81 @@
+"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 pr (V2338 V2339) (trap-error (shen.prh V2338 V2339 0) (lambda E V2338)))
+
+(defun shen.prh (V2340 V2341 V2342) (shen.prh V2340 V2341 (shen.write-char-and-inc V2340 V2341 V2342)))
+
+(defun shen.write-char-and-inc (V2343 V2344 V2345) (do (write-byte (string->n (pos V2343 V2345)) V2344) (+ V2345 1)))
+
+(defun print (V2346) (let String (shen.insert V2346 "~S") (let Print (shen.prhush String (stoutput)) V2346)))
+
+(defun shen.prhush (V2347 V2348) (if (value *hush*) V2347 (pr V2347 V2348)))
+
+(defun shen.mkstr (V2349 V2350) (cond ((string? V2349) (shen.mkstr-l (shen.proc-nl V2349) V2350)) (true (shen.mkstr-r (cons shen.proc-nl (cons V2349 ())) V2350))))
+
+(defun shen.mkstr-l (V2351 V2352) (cond ((= () V2352) V2351) ((cons? V2352) (shen.mkstr-l (shen.insert-l (hd V2352) V2351) (tl V2352))) (true (shen.f_error shen.mkstr-l))))
+
+(defun shen.insert-l (V2355 V2356) (cond ((= "" V2356) "") ((and (shen.+string? V2356) (and (= "~" (pos V2356 0)) (and (shen.+string? (tlstr V2356)) (= "A" (pos (tlstr V2356) 0))))) (cons shen.app (cons V2355 (cons (tlstr (tlstr V2356)) (cons shen.a ()))))) ((and (shen.+string? V2356) (and (= "~" (pos V2356 0)) (and (shen.+string? (tlstr V2356)) (= "R" (pos (tlstr V2356) 0))))) (cons shen.app (cons V2355 (cons (tlstr (tlstr V2356)) (cons shen.r ()))))) ((and (shen.+string? V2356) (and (= "~" (pos V2356 0)) (and (shen.+string? (tlstr V2356)) (= "S" (pos (tlstr V2356) 0))))) (cons shen.app (cons V2355 (cons (tlstr (tlstr V2356)) (cons shen.s ()))))) ((shen.+string? V2356) (shen.factor-cn (cons cn (cons (pos V2356 0) (cons (shen.insert-l V2355 (tlstr V2356)) ()))))) ((and (cons? V2356) (and (= cn (hd V2356)) (and (cons? (tl V2356)) (and (cons? (tl (tl V2356))) (= () (tl (tl (tl V2356)))))))) (cons cn (cons (hd (tl V2356)) (cons (shen.insert-l V2355 (hd (tl (tl V2356)))) ())))) ((and (cons? V2356) (and (= shen.app (hd V2356)) (and (cons? (tl V2356)) (and (cons? (tl (tl V2356))) (and (cons? (tl (tl (tl V2356)))) (= () (tl (tl (tl (tl V2356)))))))))) (cons shen.app (cons (hd (tl V2356)) (cons (shen.insert-l V2355 (hd (tl (tl V2356)))) (tl (tl (tl V2356))))))) (true (shen.f_error shen.insert-l))))
+
+(defun shen.factor-cn (V2357) (cond ((and (cons? V2357) (and (= cn (hd V2357)) (and (cons? (tl V2357)) (and (cons? (tl (tl V2357))) (and (cons? (hd (tl (tl V2357)))) (and (= cn (hd (hd (tl (tl V2357))))) (and (cons? (tl (hd (tl (tl V2357))))) (and (cons? (tl (tl (hd (tl (tl V2357)))))) (and (= () (tl (tl (tl (hd (tl (tl V2357))))))) (and (= () (tl (tl (tl V2357)))) (and (string? (hd (tl V2357))) (string? (hd (tl (hd (tl (tl V2357))))))))))))))))) (cons cn (cons (cn (hd (tl V2357)) (hd (tl (hd (tl (tl V2357)))))) (tl (tl (hd (tl (tl V2357)))))))) (true V2357)))
+
+(defun shen.proc-nl (V2358) (cond ((= "" V2358) "") ((and (shen.+string? V2358) (and (= "~" (pos V2358 0)) (and (shen.+string? (tlstr V2358)) (= "%" (pos (tlstr V2358) 0))))) (cn (n->string 10) (shen.proc-nl (tlstr (tlstr V2358))))) ((shen.+string? V2358) (cn (pos V2358 0) (shen.proc-nl (tlstr V2358)))) (true (shen.f_error shen.proc-nl))))
+
+(defun shen.mkstr-r (V2359 V2360) (cond ((= () V2360) V2359) ((cons? V2360) (shen.mkstr-r (cons shen.insert (cons (hd V2360) (cons V2359 ()))) (tl V2360))) (true (shen.f_error shen.mkstr-r))))
+
+(defun shen.insert (V2361 V2362) (shen.insert-h V2361 V2362 ""))
+
+(defun shen.insert-h (V2365 V2366 V2367) (cond ((= "" V2366) V2367) ((and (shen.+string? V2366) (and (= "~" (pos V2366 0)) (and (shen.+string? (tlstr V2366)) (= "A" (pos (tlstr V2366) 0))))) (cn V2367 (shen.app V2365 (tlstr (tlstr V2366)) shen.a))) ((and (shen.+string? V2366) (and (= "~" (pos V2366 0)) (and (shen.+string? (tlstr V2366)) (= "R" (pos (tlstr V2366) 0))))) (cn V2367 (shen.app V2365 (tlstr (tlstr V2366)) shen.r))) ((and (shen.+string? V2366) (and (= "~" (pos V2366 0)) (and (shen.+string? (tlstr V2366)) (= "S" (pos (tlstr V2366) 0))))) (cn V2367 (shen.app V2365 (tlstr (tlstr V2366)) shen.s))) ((shen.+string? V2366) (shen.insert-h V2365 (tlstr V2366) (cn V2367 (pos V2366 0)))) (true (shen.f_error shen.insert-h))))
+
+(defun shen.app (V2368 V2369 V2370) (cn (shen.arg->str V2368 V2370) V2369))
+
+(defun shen.arg->str (V2376 V2377) (cond ((= V2376 (fail)) "...") ((shen.list? V2376) (shen.list->str V2376 V2377)) ((string? V2376) (shen.str->str V2376 V2377)) ((absvector? V2376) (shen.vector->str V2376 V2377)) (true (shen.atom->str V2376))))
+
+(defun shen.list->str (V2378 V2379) (cond ((= shen.r V2379) (@s "(" (@s (shen.iter-list V2378 shen.r (shen.maxseq)) ")"))) (true (@s "[" (@s (shen.iter-list V2378 V2379 (shen.maxseq)) "]")))))
+
+(defun shen.maxseq () (value *maximum-print-sequence-size*))
+
+(defun shen.iter-list (V2390 V2391 V2392) (cond ((= () V2390) "") ((= 0 V2392) "... etc") ((and (cons? V2390) (= () (tl V2390))) (shen.arg->str (hd V2390) V2391)) ((cons? V2390) (@s (shen.arg->str (hd V2390) V2391) (@s " " (shen.iter-list (tl V2390) V2391 (- V2392 1))))) (true (@s "|" (@s " " (shen.arg->str V2390 V2391))))))
+
+(defun shen.str->str (V2397 V2398) (cond ((= shen.a V2398) V2397) (true (@s (n->string 34) (@s V2397 (n->string 34))))))
+
+(defun shen.vector->str (V2399 V2400) (if (shen.print-vector? V2399) ((<-address V2399 0) V2399) (if (vector? V2399) (@s "<" (@s (shen.iter-vector V2399 1 V2400 (shen.maxseq)) ">")) (@s "<" (@s "<" (@s (shen.iter-vector V2399 0 V2400 (shen.maxseq)) ">>"))))))
+
+(defun shen.print-vector? (V2401) (let Zero (<-address V2401 0) (if (= Zero shen.tuple) true (if (= Zero shen.pvar) true (if (not (number? Zero)) (shen.fbound? Zero) false)))))
+
+(defun shen.fbound? (V2402) (trap-error (do (ps V2402) true) (lambda E false)))
+
+(defun shen.tuple (V2403) (cn "(@p " (shen.app (<-address V2403 1) (cn " " (shen.app (<-address V2403 2) ")" shen.s)) shen.s)))
+
+(defun shen.iter-vector (V2410 V2411 V2412 V2413) (cond ((= 0 V2413) "... etc") (true (let Item (trap-error (<-address V2410 V2411) (lambda E shen.out-of-bounds)) (let Next (trap-error (<-address V2410 (+ V2411 1)) (lambda E shen.out-of-bounds)) (if (= Item shen.out-of-bounds) "" (if (= Next shen.out-of-bounds) (shen.arg->str Item V2412) (@s (shen.arg->str Item V2412) (@s " " (shen.iter-vector V2410 (+ V2411 1) V2412 (- V2413 1)))))))))))
+
+(defun shen.atom->str (V2414) (trap-error (str V2414) (lambda E (shen.funexstring))))
+
+(defun shen.funexstring () (@s "" (@s "f" (@s "u" (@s "n" (@s "e" (@s (shen.arg->str (gensym (intern "x")) shen.a) "")))))))
+
+(defun shen.list? (V2415) (or (empty? V2415) (cons? V2415)))
+
+
+

data/shen/release/klambda/yacc.kl

@@ -0,0 +1,87 @@
+"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 shen.yacc (V2416) (cond ((and (cons? V2416) (and (= defcc (hd V2416)) (cons? (tl V2416)))) (shen.yacc->shen (hd (tl V2416)) (tl (tl V2416)))) (true (shen.f_error shen.yacc))))
+
+(defun shen.yacc->shen (V2417 V2418) (let CCRules (shen.split_cc_rules true V2418 ()) (let CCBody (map shen.cc_body CCRules) (let YaccCases (shen.yacc_cases CCBody) (cons define (cons V2417 (cons Stream (cons -> (cons (shen.kill-code YaccCases) ())))))))))
+
+(defun shen.kill-code (V2419) (cond ((> (occurrences kill V2419) 0) (cons trap-error (cons V2419 (cons (cons lambda (cons E (cons (cons shen.analyse-kill (cons E ())) ()))) ())))) (true V2419)))
+
+(defun kill () (simple-error "yacc kill"))
+
+(defun shen.analyse-kill (V2420) (let String (error-to-string V2420) (if (= String "yacc kill") (fail) V2420)))
+
+(defun shen.split_cc_rules (V2423 V2424 V2425) (cond ((and (= () V2424) (= () V2425)) ()) ((= () V2424) (cons (shen.split_cc_rule V2423 (reverse V2425) ()) ())) ((and (cons? V2424) (= ; (hd V2424))) (cons (shen.split_cc_rule V2423 (reverse V2425) ()) (shen.split_cc_rules V2423 (tl V2424) ()))) ((cons? V2424) (shen.split_cc_rules V2423 (tl V2424) (cons (hd V2424) V2425))) (true (shen.f_error shen.split_cc_rules))))
+
+(defun shen.split_cc_rule (V2430 V2431 V2432) (cond ((and (cons? V2431) (and (= := (hd V2431)) (and (cons? (tl V2431)) (= () (tl (tl V2431)))))) (cons (reverse V2432) (tl V2431))) ((and (cons? V2431) (and (= := (hd V2431)) (and (cons? (tl V2431)) (and (cons? (tl (tl V2431))) (and (= where (hd (tl (tl V2431)))) (and (cons? (tl (tl (tl V2431)))) (= () (tl (tl (tl (tl V2431))))))))))) (cons (reverse V2432) (cons (cons where (cons (hd (tl (tl (tl V2431)))) (cons (hd (tl V2431)) ()))) ()))) ((= () V2431) (do (shen.semantic-completion-warning V2430 V2432) (shen.split_cc_rule V2430 (cons := (cons (shen.default_semantics (reverse V2432)) ())) V2432))) ((cons? V2431) (shen.split_cc_rule V2430 (tl V2431) (cons (hd V2431) V2432))) (true (shen.f_error shen.split_cc_rule))))
+
+(defun shen.semantic-completion-warning (V2441 V2442) (cond ((= true V2441) (do (shen.prhush "warning: " (stoutput)) (do (map (lambda X (shen.prhush (shen.app X " " shen.a) (stoutput))) (reverse V2442)) (shen.prhush "has no semantics.
+" (stoutput))))) (true shen.skip)))
+
+(defun shen.default_semantics (V2443) (cond ((= () V2443) ()) ((and (cons? V2443) (and (= () (tl V2443)) (shen.grammar_symbol? (hd V2443)))) (hd V2443)) ((and (cons? V2443) (shen.grammar_symbol? (hd V2443))) (cons append (cons (hd V2443) (cons (shen.default_semantics (tl V2443)) ())))) ((cons? V2443) (cons cons (cons (hd V2443) (cons (shen.default_semantics (tl V2443)) ())))) (true (shen.f_error shen.default_semantics))))
+
+(defun shen.grammar_symbol? (V2444) (and (symbol? V2444) (let Cs (shen.strip-pathname (explode V2444)) (and (= (hd Cs) "<") (= (hd (reverse Cs)) ">")))))
+
+(defun shen.yacc_cases (V2445) (cond ((and (cons? V2445) (= () (tl V2445))) (hd V2445)) ((cons? V2445) (let P YaccParse (cons let (cons P (cons (hd V2445) (cons (cons if (cons (cons = (cons P (cons (cons fail ()) ()))) (cons (shen.yacc_cases (tl V2445)) (cons P ())))) ())))))) (true (shen.f_error shen.yacc_cases))))
+
+(defun shen.cc_body (V2446) (cond ((and (cons? V2446) (and (cons? (tl V2446)) (= () (tl (tl V2446))))) (shen.syntax (hd V2446) Stream (hd (tl V2446)))) (true (shen.f_error shen.cc_body))))
+
+(defun shen.syntax (V2447 V2448 V2449) (cond ((and (= () V2447) (and (cons? V2449) (and (= where (hd V2449)) (and (cons? (tl V2449)) (and (cons? (tl (tl V2449))) (= () (tl (tl (tl V2449))))))))) (cons if (cons (shen.semantics (hd (tl V2449))) (cons (cons shen.pair (cons (cons hd (cons V2448 ())) (cons (shen.semantics (hd (tl (tl V2449)))) ()))) (cons (cons fail ()) ()))))) ((= () V2447) (cons shen.pair (cons (cons hd (cons V2448 ())) (cons (shen.semantics V2449) ())))) ((cons? V2447) (if (shen.grammar_symbol? (hd V2447)) (shen.recursive_descent V2447 V2448 V2449) (if (variable? (hd V2447)) (shen.variable-match V2447 V2448 V2449) (if (shen.jump_stream? (hd V2447)) (shen.jump_stream V2447 V2448 V2449) (if (shen.terminal? (hd V2447)) (shen.check_stream V2447 V2448 V2449) (if (cons? (hd V2447)) (shen.list-stream (shen.decons (hd V2447)) (tl V2447) V2448 V2449) (simple-error (shen.app (hd V2447) " is not legal syntax
+" shen.a)))))))) (true (shen.f_error shen.syntax))))
+
+(defun shen.list-stream (V2450 V2451 V2452 V2453) (let Test (cons and (cons (cons cons? (cons (cons hd (cons V2452 ())) ())) (cons (cons cons? (cons (cons hd (cons (cons hd (cons V2452 ())) ())) ())) ()))) (let Placeholder (gensym shen.place) (let RunOn (shen.syntax V2451 (cons shen.pair (cons (cons tl (cons (cons hd (cons V2452 ())) ())) (cons (cons hd (cons (cons tl (cons V2452 ())) ())) ()))) V2453) (let Action (shen.insert-runon RunOn Placeholder (shen.syntax V2450 (cons shen.pair (cons (cons hd (cons (cons hd (cons V2452 ())) ())) (cons (cons hd (cons (cons tl (cons V2452 ())) ())) ()))) Placeholder)) (cons if (cons Test (cons Action (cons (cons fail ()) ())))))))))
+
+(defun shen.decons (V2454) (cond ((and (cons? V2454) (and (= cons (hd V2454)) (and (cons? (tl V2454)) (and (cons? (tl (tl V2454))) (and (= () (hd (tl (tl V2454)))) (= () (tl (tl (tl V2454))))))))) (cons (hd (tl V2454)) ())) ((and (cons? V2454) (and (= cons (hd V2454)) (and (cons? (tl V2454)) (and (cons? (tl (tl V2454))) (= () (tl (tl (tl V2454)))))))) (cons (hd (tl V2454)) (shen.decons (hd (tl (tl V2454)))))) (true V2454)))
+
+(defun shen.insert-runon (V2466 V2467 V2468) (cond ((and (cons? V2468) (and (= shen.pair (hd V2468)) (and (cons? (tl V2468)) (and (cons? (tl (tl V2468))) (and (= () (tl (tl (tl V2468)))) (= (hd (tl (tl V2468))) V2467)))))) V2466) ((cons? V2468) (map (lambda Z (shen.insert-runon V2466 V2467 Z)) V2468)) (true V2468)))
+
+(defun shen.strip-pathname (V2473) (cond ((not (element? "." V2473)) V2473) ((cons? V2473) (shen.strip-pathname (tl V2473))) (true (shen.f_error shen.strip-pathname))))
+
+(defun shen.recursive_descent (V2474 V2475 V2476) (cond ((cons? V2474) (let Test (cons (hd V2474) (cons V2475 ())) (let Action (shen.syntax (tl V2474) (concat Parse_ (hd V2474)) V2476) (let Else (cons fail ()) (cons let (cons (concat Parse_ (hd V2474)) (cons Test (cons (cons if (cons (cons not (cons (cons = (cons (cons fail ()) (cons (concat Parse_ (hd V2474)) ()))) ())) (cons Action (cons Else ())))) ())))))))) (true (shen.f_error shen.recursive_descent))))
+
+(defun shen.variable-match (V2477 V2478 V2479) (cond ((cons? V2477) (let Test (cons cons? (cons (cons hd (cons V2478 ())) ())) (let Action (cons let (cons (concat Parse_ (hd V2477)) (cons (cons hd (cons (cons hd (cons V2478 ())) ())) (cons (shen.syntax (tl V2477) (cons shen.pair (cons (cons tl (cons (cons hd (cons V2478 ())) ())) (cons (cons shen.hdtl (cons V2478 ())) ()))) V2479) ())))) (let Else (cons fail ()) (cons if (cons Test (cons Action (cons Else ())))))))) (true (shen.f_error shen.variable-match))))
+
+(defun shen.terminal? (V2488) (cond ((cons? V2488) false) ((variable? V2488) false) (true true)))
+
+(defun shen.jump_stream? (V2493) (cond ((= V2493 _) true) (true false)))
+
+(defun shen.check_stream (V2494 V2495 V2496) (cond ((cons? V2494) (let Test (cons and (cons (cons cons? (cons (cons hd (cons V2495 ())) ())) (cons (cons = (cons (hd V2494) (cons (cons hd (cons (cons hd (cons V2495 ())) ())) ()))) ()))) (let Action (shen.syntax (tl V2494) (cons shen.pair (cons (cons tl (cons (cons hd (cons V2495 ())) ())) (cons (cons shen.hdtl (cons V2495 ())) ()))) V2496) (let Else (cons fail ()) (cons if (cons Test (cons Action (cons Else ())))))))) (true (shen.f_error shen.check_stream))))
+
+(defun shen.jump_stream (V2497 V2498 V2499) (cond ((cons? V2497) (let Test (cons cons? (cons (cons hd (cons V2498 ())) ())) (let Action (shen.syntax (tl V2497) (cons shen.pair (cons (cons tl (cons (cons hd (cons V2498 ())) ())) (cons (cons shen.hdtl (cons V2498 ())) ()))) V2499) (let Else (cons fail ()) (cons if (cons Test (cons Action (cons Else ())))))))) (true (shen.f_error shen.jump_stream))))
+
+(defun shen.semantics (V2500) (cond ((= () V2500) ()) ((shen.grammar_symbol? V2500) (cons shen.hdtl (cons (concat Parse_ V2500) ()))) ((variable? V2500) (concat Parse_ V2500)) ((cons? V2500) (map shen.semantics V2500)) (true V2500)))
+
+(defun shen.snd-or-fail (V2507) (cond ((and (cons? V2507) (and (cons? (tl V2507)) (= () (tl (tl V2507))))) (hd (tl V2507))) (true (fail))))
+
+(defun fail () shen.fail!)(defun shen.pair (V2508 V2509) (cons V2508 (cons V2509 ())))
+
+(defun shen.hdtl (V2510) (hd (tl V2510)))
+
+(defun shen.<!> (V2517) (cond ((and (cons? V2517) (and (cons? (tl V2517)) (= () (tl (tl V2517))))) (cons () (cons (hd V2517) ()))) (true (fail))))
+
+(defun <e> (V2522) (cond ((and (cons? V2522) (and (cons? (tl V2522)) (= () (tl (tl V2522))))) (cons (hd V2522) (cons () ()))) (true (shen.f_error <e>))))
+
+
+

data/shen/release/test_programs/Chap13/problems.txt

@@ -1,26 +1,26 @@
-
-[[[y-combinator [/. ADD [/. X [/. Y [if [= X 0] Y [[ADD [-- X]] [++ Y]]]]]]]  2] 3]
-
-
-[[[y-combinator [/. ADD [/. X [/. Y [if [= X 0] Y [[ADD [-- X]] [++ Y]]]]]]] 33] 4]
-
-[[[/. [@p X Y] X] 
-[y-combinator  [/. T 
-[@p [/. A [cases [[/. 1 false] A]
-                 [[/. X [[[/. [@p X Y] Y] T] [-- X]]] A]]]
-    [/. A [cases [[/. 1 true] A]
-                 [[/. X [[[/. [@p X Y] X] T] [-- X]]] A]]]]]]] 6]
-
-
-
-
-
-
-
-
-
-
-
-  
-
-  
+
+[[[y-combinator [/. ADD [/. X [/. Y [if [= X 0] Y [[ADD [-- X]] [++ Y]]]]]]]  2] 3]
+
+
+[[[y-combinator [/. ADD [/. X [/. Y [if [= X 0] Y [[ADD [-- X]] [++ Y]]]]]]] 33] 4]
+
+[[[/. [@p X Y] X] 
+[y-combinator  [/. T 
+[@p [/. A [cases [[/. 1 false] A]
+                 [[/. X [[[/. [@p X Y] Y] T] [-- X]]] A]]]
+    [/. A [cases [[/. 1 true] A]
+                 [[/. X [[[/. [@p X Y] X] T] [-- X]]] A]]]]]]] 6]
+
+
+
+
+
+
+
+
+
+
+
+  
+
+  

data/shen/release/test_programs/README.shen

@@ -1,53 +1,53 @@
-\* 
-
-This is the test harness for Shen.  Assuming your port to Blub is in the directory Platforms/Blub; do the
-following.
-
-(cd "../../Test Programs")
-(load "README.shen")
-(load "tests.shen")
-
-  *\
-
-(package test-harness [report reset ok passed failed]
-
-(define reset
-  -> (set *passed* (set *failed* 0)))
-
-(defmacro exec-macro
-  [exec Name Expr Prediction] -> [trap-error [let (protect Output) [output "~%~A: ~R = ~S" Name (rcons Expr) Prediction]
-                                                  (protect Result) [time Expr]
-                                                  [if [= (protect Result) Prediction] [passed] [failed (protect Result)]]] 
-                                                      [/. (protect E) [err (protect E)]]])
-                                              
-(define rcons
-  [X | Y] -> [cons (rcons X) (rcons Y)] 
-  X -> X)                                             
-                                              
-(define passed
-  -> (do (trap-error (set *passed* (+ 1 (value *passed*))) (/. E (set *passed* 1)))
-          (print passed)))
-          
-(define failed
-  Result -> (let Fail+ (trap-error (set *failed* (+ 1 (value *failed*))) (/. E (set *failed* 1)))
-                 ShowResult (output "~S returned~%" Result)
-                 (if (y-or-n? "failed; continue?") ok (error "kill"))))  
-
-(define err
-  E -> (error "")  where (= (error-to-string E) "kill")
-  E -> (do (trap-error (set *failed* (+ 1 (value *failed*))) (/. E (set *failed* 1)))
-           (output "~%failed with error ~A~%" (error-to-string E))))
-
-(defmacro report-results-macro
-  [report Name | Tests] -> (let NewTests (create-tests Name Tests)
-                                         [do | NewTests]))
-                                         
-(define create-tests
-  Name [] -> [[results] ok]  
-  Name [Test Prediction | Tests] -> [[exec Name Test Prediction] | (create-tests Name Tests)])                 
-                                         
-(define results
-  -> (let Passed (trap-error (value *passed*) (/. E 0))
-          Failed (trap-error (value *failed*) (/. E 0))
-          Percent (* (/ Passed (+ Passed Failed)) 100)
+\*     					Standard Test Suite 1.0
+
+This is the test harness for Shen.  Assuming your port to Blub is in the directory Platforms/Blub; do the
+following.
+
+(cd "../../Test Programs")
+(load "README.shen")
+(load "tests.shen")
+
+  *\
+
+(package test-harness [report reset ok passed failed]
+
+(define reset
+  -> (set *passed* (set *failed* 0)))
+
+(defmacro exec-macro
+  [exec Name Expr Prediction] -> [trap-error [let (protect Output) [output "~%~A: ~R = ~S" Name (rcons Expr) Prediction]
+                                                  (protect Result) [time Expr]
+                                                  [if [= (protect Result) Prediction] [passed] [failed (protect Result)]]] 
+                                                      [/. (protect E) [err (protect E)]]])
+                                              
+(define rcons
+  [X | Y] -> [cons (rcons X) (rcons Y)] 
+  X -> X)                                             
+                                              
+(define passed
+  -> (do (trap-error (set *passed* (+ 1 (value *passed*))) (/. E (set *passed* 1)))
+          (print passed)))
+          
+(define failed
+  Result -> (let Fail+ (trap-error (set *failed* (+ 1 (value *failed*))) (/. E (set *failed* 1)))
+                 ShowResult (output "~S returned~%" Result)
+                 (if (y-or-n? "failed; continue?") ok (error "kill"))))  
+
+(define err
+  E -> (error "")  where (= (error-to-string E) "kill")
+  E -> (do (trap-error (set *failed* (+ 1 (value *failed*))) (/. E (set *failed* 1)))
+           (output "~%failed with error ~A~%" (error-to-string E))))
+
+(defmacro report-results-macro
+  [report Name | Tests] -> (let NewTests (create-tests Name Tests)
+                                         [do | NewTests]))
+                                         
+(define create-tests
+  Name [] -> [[results] ok]  
+  Name [Test Prediction | Tests] -> [[exec Name Test Prediction] | (create-tests Name Tests)])                 
+                                         
+(define results
+  -> (let Passed (trap-error (value *passed*) (/. E 0))
+          Failed (trap-error (value *failed*) (/. E 0))
+          Percent (* (/ Passed (+ Passed Failed)) 100)
           (output "~%passed ... ~A~%failed ...~A~%pass rate ...~A%~%~%" Passed Failed Percent)))     )

data/shen/release/test_programs/TinyLispFunctions.txt

@@ -1,16 +1,16 @@
-(defun plus (x y)
-  (lispif (equal x 0) 
-           y
-           (plus (prec x) (succ y))))
-
-(defun member (x y)
-   (lispif (equal y (empty!)) 
-           (empty!)
-           (lispif (equal x (car y)) 
-                   y
-                   (member x (cdr y)))))
-
-(defun join (x y)
-   (lispif (equal x (empty!))
-            y
+(defun plus (x y)
+  (lispif (equal x 0) 
+           y
+           (plus (prec x) (succ y))))
+
+(defun member (x y)
+   (lispif (equal y (empty!)) 
+           (empty!)
+           (lispif (equal x (car y)) 
+                   y
+                   (member x (cdr y)))))
+
+(defun join (x y)
+   (lispif (equal x (empty!))
+            y
             (lispcons (car x) (join (cdr x) y))))

data/shen/release/test_programs/TinyTypes.shen

@@ -1,55 +1,55 @@
-(specialise defun)
-(specialise lambda')
-
-(datatype tiny_lisp_type_theory
-
-  let Lambda (mk_lambda Xs Body)
-  F : A >> Lambda : A;
-  __________________
-  (defun F Xs Body) : A;
-
-  let X* (gensym &&x)
-  let Y* (subst X* X Y)
-  X* : A >> Y* : B;
-  _____________________
-  (lambda' (X) Y) : (A --> B);
-
-  F : (A --> B); X : A;
-  ________________
-  (F X) : B;
-
-  ____________________________
-  lispif : (bool --> (A --> (A --> A)));
-
-  ________________________
-  equal : (A --> (A --> bool));
-
-  ___________________________
-  lispcons : (A --> ((list A) --> (list A)));
-
-  ______________
-  car : ((list A) --> A);
-
-  _______________
-  cdr : ((list A) --> (list A));
-
-  if (element? F [succ prec])
-  ____________________
-  F : (number --> number);
-
-  ___________
-  (tee!) : bool;
-
-  ____________
-  (empty!) : (list A);
-
-  ________
-  (empty!) : bool;
-
-  if (symbol? X)
-  ____________
-  (quote X) : symbol;)
-
-(define mk_lambda
-   [X] Body -> [lambda' [X] Body]
-   [X | Y] Body -> [lambda' [X] (mk_lambda Y Body)])
+(specialise defun)
+(specialise lambda')
+
+(datatype tiny_lisp_type_theory
+
+  let Lambda (mk_lambda Xs Body)
+  F : A >> Lambda : A;
+  __________________
+  (defun F Xs Body) : A;
+
+  let X* (gensym &&x)
+  let Y* (subst X* X Y)
+  X* : A >> Y* : B;
+  _____________________
+  (lambda' (X) Y) : (A --> B);
+
+  F : (A --> B); X : A;
+  ________________
+  (F X) : B;
+
+  ____________________________
+  lispif : (bool --> (A --> (A --> A)));
+
+  ________________________
+  equal : (A --> (A --> bool));
+
+  ___________________________
+  lispcons : (A --> ((list A) --> (list A)));
+
+  ______________
+  car : ((list A) --> A);
+
+  _______________
+  cdr : ((list A) --> (list A));
+
+  if (element? F [succ prec])
+  ____________________
+  F : (number --> number);
+
+  ___________
+  (tee!) : bool;
+
+  ____________
+  (empty!) : (list A);
+
+  ________
+  (empty!) : bool;
+
+  if (symbol? X)
+  ____________
+  (quote X) : symbol;)
+
+(define mk_lambda
+   [X] Body -> [lambda' [X] Body]
+   [X | Y] Body -> [lambda' [X] (mk_lambda Y Body)])