toplevel.kl in shen-ruby-0.6.0

- old
+ new

@@ -49,13 +49,13 @@
 *****************************************************************************************
 "(defun shen.shen () (do (shen.credits) (shen.loop)))
 
 (defun shen.loop () (do (shen.initialise_environment) (do (shen.prompt) (do (trap-error (shen.read-evaluate-print) (lambda E (pr (error-to-string E) (stoutput)))) (shen.loop)))))
 
-(defun version (V2308) (set *version* V2308))
+(defun version (V2280) (set *version* V2280))
 
-(version "version 11")
+(version "version 12")
 
 (defun shen.credits () (do (shen.prhush "
 Shen 2010, copyright (C) 2010 Mark Tarver
 " (stoutput)) (do (shen.prhush "released under the Shen license
 " (stoutput)) (do (shen.prhush (cn "www.shenlanguage.org, " (shen.app (value *version*) "
@@ -63,77 +63,77 @@
 port " (shen.app (value *port*) (cn " ported by " (shen.app (value *porters*) "
 " shen.a)) shen.a)) (stoutput)))))))
 
 (defun shen.initialise_environment () (shen.multiple-set (cons shen.*call* (cons 0 (cons shen.*infs* (cons 0 (cons shen.*process-counter* (cons 0 (cons shen.*catch* (cons 0 ()))))))))))
 
-(defun shen.multiple-set (V2309) (cond ((= () V2309) ()) ((and (cons? V2309) (cons? (tl V2309))) (do (set (hd V2309) (hd (tl V2309))) (shen.multiple-set (tl (tl V2309))))) (true (shen.sys-error shen.multiple-set))))
+(defun shen.multiple-set (V2281) (cond ((= () V2281) ()) ((and (cons? V2281) (cons? (tl V2281))) (do (set (hd V2281) (hd (tl V2281))) (shen.multiple-set (tl (tl V2281))))) (true (shen.sys-error shen.multiple-set))))
 
-(defun destroy (V2310) (declare V2310 ()))
+(defun destroy (V2282) (declare V2282 ()))
 
 (set shen.*history* ())
 
 (defun shen.read-evaluate-print () (let Lineread (shen.toplineread) (let History (value shen.*history*) (let NewLineread (shen.retrieve-from-history-if-needed Lineread History) (let NewHistory (shen.update_history NewLineread History) (let Parsed (fst NewLineread) (shen.toplevel Parsed)))))))
 
-(defun shen.retrieve-from-history-if-needed (V2320 V2321) (cond ((and (tuple? V2320) (and (cons? (snd V2320)) (and (cons? (tl (snd V2320))) (and (= () (tl (tl (snd V2320)))) (and (cons? V2321) (and (= (hd (snd V2320)) (shen.exclamation)) (= (hd (tl (snd V2320))) (shen.exclamation)))))))) (let PastPrint (shen.prbytes (snd (hd V2321))) (hd V2321))) ((and (tuple? V2320) (and (cons? (snd V2320)) (= (hd (snd V2320)) (shen.exclamation)))) (let Key? (shen.make-key (tl (snd V2320)) V2321) (let Find (head (shen.find-past-inputs Key? V2321)) (let PastPrint (shen.prbytes (snd Find)) Find)))) ((and (tuple? V2320) (and (cons? (snd V2320)) (and (= () (tl (snd V2320))) (= (hd (snd V2320)) (shen.percent))))) (do (shen.print-past-inputs (lambda X true) (reverse V2321) 0) (abort))) ((and (tuple? V2320) (and (cons? (snd V2320)) (= (hd (snd V2320)) (shen.percent)))) (let Key? (shen.make-key (tl (snd V2320)) V2321) (let Pastprint (shen.print-past-inputs Key? (reverse V2321) 0) (abort)))) (true V2320)))
+(defun shen.retrieve-from-history-if-needed (V2292 V2293) (cond ((and (tuple? V2292) (and (cons? (snd V2292)) (and (cons? (tl (snd V2292))) (and (= () (tl (tl (snd V2292)))) (and (cons? V2293) (and (= (hd (snd V2292)) (shen.exclamation)) (= (hd (tl (snd V2292))) (shen.exclamation)))))))) (let PastPrint (shen.prbytes (snd (hd V2293))) (hd V2293))) ((and (tuple? V2292) (and (cons? (snd V2292)) (= (hd (snd V2292)) (shen.exclamation)))) (let Key? (shen.make-key (tl (snd V2292)) V2293) (let Find (head (shen.find-past-inputs Key? V2293)) (let PastPrint (shen.prbytes (snd Find)) Find)))) ((and (tuple? V2292) (and (cons? (snd V2292)) (and (= () (tl (snd V2292))) (= (hd (snd V2292)) (shen.percent))))) (do (shen.print-past-inputs (lambda X true) (reverse V2293) 0) (abort))) ((and (tuple? V2292) (and (cons? (snd V2292)) (= (hd (snd V2292)) (shen.percent)))) (let Key? (shen.make-key (tl (snd V2292)) V2293) (let Pastprint (shen.print-past-inputs Key? (reverse V2293) 0) (abort)))) (true V2292)))
 
 (defun shen.percent () 37)
 
 (defun shen.exclamation () 33)
 
-(defun shen.prbytes (V2322) (do (map (lambda Byte (pr (n->string Byte) (stoutput))) V2322) (nl 1)))
+(defun shen.prbytes (V2294) (do (map (lambda Byte (pr (n->string Byte) (stoutput))) V2294) (nl 1)))
 
-(defun shen.update_history (V2323 V2324) (set shen.*history* (cons V2323 V2324)))
+(defun shen.update_history (V2295 V2296) (set shen.*history* (cons V2295 V2296)))
 
 (defun shen.toplineread () (shen.toplineread_loop (read-byte (stinput)) ()))
 
-(defun shen.toplineread_loop (V2326 V2327) (cond ((= V2326 (shen.hat)) (simple-error "line read aborted")) ((element? V2326 (cons (shen.newline) (cons (shen.carriage-return) ()))) (let Line (compile shen.<st_input> V2327 (lambda E shen.nextline)) (if (or (= Line shen.nextline) (empty? Line)) (shen.toplineread_loop (read-byte (stinput)) (append V2327 (cons V2326 ()))) (@p Line V2327)))) (true (shen.toplineread_loop (read-byte (stinput)) (append V2327 (cons V2326 ()))))))
+(defun shen.toplineread_loop (V2298 V2299) (cond ((= V2298 (shen.hat)) (simple-error "line read aborted")) ((element? V2298 (cons (shen.newline) (cons (shen.carriage-return) ()))) (let Line (compile shen.<st_input> V2299 (lambda E shen.nextline)) (if (or (= Line shen.nextline) (empty? Line)) (shen.toplineread_loop (read-byte (stinput)) (append V2299 (cons V2298 ()))) (@p Line V2299)))) (true (shen.toplineread_loop (read-byte (stinput)) (append V2299 (cons V2298 ()))))))
 
 (defun shen.hat () 94)
 
 (defun shen.newline () 10)
 
 (defun shen.carriage-return () 13)
 
-(defun tc (V2332) (cond ((= + V2332) (set shen.*tc* true)) ((= - V2332) (set shen.*tc* false)) (true (simple-error "tc expects a + or -"))))
+(defun tc (V2304) (cond ((= + V2304) (set shen.*tc* true)) ((= - V2304) (set shen.*tc* false)) (true (simple-error "tc expects a + or -"))))
 
 (defun shen.prompt () (if (value shen.*tc*) (shen.prhush (cn "
 
 (" (shen.app (length (value shen.*history*)) "+) " shen.a)) (stoutput)) (shen.prhush (cn "
 
 (" (shen.app (length (value shen.*history*)) "-) " shen.a)) (stoutput))))
 
-(defun shen.toplevel (V2333) (shen.toplevel_evaluate V2333 (value shen.*tc*)))
+(defun shen.toplevel (V2305) (shen.toplevel_evaluate V2305 (value shen.*tc*)))
 
-(defun shen.find-past-inputs (V2334 V2335) (let F (shen.find V2334 V2335) (if (empty? F) (simple-error "input not found
+(defun shen.find-past-inputs (V2306 V2307) (let F (shen.find V2306 V2307) (if (empty? F) (simple-error "input not found
 ") F)))
 
-(defun shen.make-key (V2336 V2337) (let Atom (hd (compile shen.<st_input> V2336 (lambda E (if (cons? E) (simple-error (cn "parse error here: " (shen.app E "
+(defun shen.make-key (V2308 V2309) (let Atom (hd (compile shen.<st_input> V2308 (lambda E (if (cons? E) (simple-error (cn "parse error here: " (shen.app E "
 " shen.s))) (simple-error "parse error
-"))))) (if (integer? Atom) (lambda X (= X (nth (+ Atom 1) (reverse V2337)))) (lambda X (shen.prefix? V2336 (shen.trim-gubbins (snd X)))))))
+"))))) (if (integer? Atom) (lambda X (= X (nth (+ Atom 1) (reverse V2309)))) (lambda X (shen.prefix? V2308 (shen.trim-gubbins (snd X)))))))
 
-(defun shen.trim-gubbins (V2338) (cond ((and (cons? V2338) (= (hd V2338) (shen.space))) (shen.trim-gubbins (tl V2338))) ((and (cons? V2338) (= (hd V2338) (shen.newline))) (shen.trim-gubbins (tl V2338))) ((and (cons? V2338) (= (hd V2338) (shen.carriage-return))) (shen.trim-gubbins (tl V2338))) ((and (cons? V2338) (= (hd V2338) (shen.tab))) (shen.trim-gubbins (tl V2338))) ((and (cons? V2338) (= (hd V2338) (shen.left-round))) (shen.trim-gubbins (tl V2338))) (true V2338)))
+(defun shen.trim-gubbins (V2310) (cond ((and (cons? V2310) (= (hd V2310) (shen.space))) (shen.trim-gubbins (tl V2310))) ((and (cons? V2310) (= (hd V2310) (shen.newline))) (shen.trim-gubbins (tl V2310))) ((and (cons? V2310) (= (hd V2310) (shen.carriage-return))) (shen.trim-gubbins (tl V2310))) ((and (cons? V2310) (= (hd V2310) (shen.tab))) (shen.trim-gubbins (tl V2310))) ((and (cons? V2310) (= (hd V2310) (shen.left-round))) (shen.trim-gubbins (tl V2310))) (true V2310)))
 
 (defun shen.space () 32)
 
 (defun shen.tab () 9)
 
 (defun shen.left-round () 40)
 
-(defun shen.find (V2345 V2346) (cond ((= () V2346) ()) ((and (cons? V2346) (V2345 (hd V2346))) (cons (hd V2346) (shen.find V2345 (tl V2346)))) ((cons? V2346) (shen.find V2345 (tl V2346))) (true (shen.sys-error shen.find))))
+(defun shen.find (V2317 V2318) (cond ((= () V2318) ()) ((and (cons? V2318) (V2317 (hd V2318))) (cons (hd V2318) (shen.find V2317 (tl V2318)))) ((cons? V2318) (shen.find V2317 (tl V2318))) (true (shen.sys-error shen.find))))
 
-(defun shen.prefix? (V2357 V2358) (cond ((= () V2357) true) ((and (cons? V2357) (and (cons? V2358) (= (hd V2358) (hd V2357)))) (shen.prefix? (tl V2357) (tl V2358))) (true false)))
+(defun shen.prefix? (V2329 V2330) (cond ((= () V2329) true) ((and (cons? V2329) (and (cons? V2330) (= (hd V2330) (hd V2329)))) (shen.prefix? (tl V2329) (tl V2330))) (true false)))
 
-(defun shen.print-past-inputs (V2368 V2369 V2370) (cond ((= () V2369) _) ((and (cons? V2369) (not (V2368 (hd V2369)))) (shen.print-past-inputs V2368 (tl V2369) (+ V2370 1))) ((and (cons? V2369) (tuple? (hd V2369))) (do (shen.prhush (shen.app V2370 ". " shen.a) (stoutput)) (do (shen.prbytes (snd (hd V2369))) (shen.print-past-inputs V2368 (tl V2369) (+ V2370 1))))) (true (shen.sys-error shen.print-past-inputs))))
+(defun shen.print-past-inputs (V2340 V2341 V2342) (cond ((= () V2341) _) ((and (cons? V2341) (not (V2340 (hd V2341)))) (shen.print-past-inputs V2340 (tl V2341) (+ V2342 1))) ((and (cons? V2341) (tuple? (hd V2341))) (do (shen.prhush (shen.app V2342 ". " shen.a) (stoutput)) (do (shen.prbytes (snd (hd V2341))) (shen.print-past-inputs V2340 (tl V2341) (+ V2342 1))))) (true (shen.sys-error shen.print-past-inputs))))
 
-(defun shen.toplevel_evaluate (V2371 V2372) (cond ((and (cons? V2371) (and (cons? (tl V2371)) (and (= : (hd (tl V2371))) (and (cons? (tl (tl V2371))) (and (= () (tl (tl (tl V2371)))) (= true V2372)))))) (shen.typecheck-and-evaluate (hd V2371) (hd (tl (tl V2371))))) ((and (cons? V2371) (cons? (tl V2371))) (do (shen.toplevel_evaluate (cons (hd V2371) ()) V2372) (do (nl 1) (shen.toplevel_evaluate (tl V2371) V2372)))) ((and (cons? V2371) (and (= () (tl V2371)) (= true V2372))) (shen.typecheck-and-evaluate (hd V2371) (gensym A))) ((and (cons? V2371) (and (= () (tl V2371)) (= false V2372))) (let Eval (shen.eval-without-macros (hd V2371)) (print Eval))) (true (shen.sys-error shen.toplevel_evaluate))))
+(defun shen.toplevel_evaluate (V2343 V2344) (cond ((and (cons? V2343) (and (cons? (tl V2343)) (and (= : (hd (tl V2343))) (and (cons? (tl (tl V2343))) (and (= () (tl (tl (tl V2343)))) (= true V2344)))))) (shen.typecheck-and-evaluate (hd V2343) (hd (tl (tl V2343))))) ((and (cons? V2343) (cons? (tl V2343))) (do (shen.toplevel_evaluate (cons (hd V2343) ()) V2344) (do (nl 1) (shen.toplevel_evaluate (tl V2343) V2344)))) ((and (cons? V2343) (and (= () (tl V2343)) (= true V2344))) (shen.typecheck-and-evaluate (hd V2343) (gensym A))) ((and (cons? V2343) (and (= () (tl V2343)) (= false V2344))) (let Eval (shen.eval-without-macros (hd V2343)) (print Eval))) (true (shen.sys-error shen.toplevel_evaluate))))
 
-(defun shen.typecheck-and-evaluate (V2373 V2374) (let Typecheck (shen.typecheck V2373 V2374) (if (= Typecheck false) (simple-error "type error
-") (let Eval (shen.eval-without-macros V2373) (let Type (shen.pretty-type Typecheck) (shen.prhush (shen.app Eval (cn " : " (shen.app Type "" shen.r)) shen.s) (stoutput)))))))
+(defun shen.typecheck-and-evaluate (V2345 V2346) (let Typecheck (shen.typecheck V2345 V2346) (if (= Typecheck false) (simple-error "type error
+") (let Eval (shen.eval-without-macros V2345) (let Type (shen.pretty-type Typecheck) (shen.prhush (shen.app Eval (cn " : " (shen.app Type "" shen.r)) shen.s) (stoutput)))))))
 
-(defun shen.pretty-type (V2375) (shen.mult_subst (value shen.*alphabet*) (shen.extract-pvars V2375) V2375))
+(defun shen.pretty-type (V2347) (shen.mult_subst (value shen.*alphabet*) (shen.extract-pvars V2347) V2347))
 
-(defun shen.extract-pvars (V2380) (cond ((shen.pvar? V2380) (cons V2380 ())) ((cons? V2380) (union (shen.extract-pvars (hd V2380)) (shen.extract-pvars (tl V2380)))) (true ())))
+(defun shen.extract-pvars (V2352) (cond ((shen.pvar? V2352) (cons V2352 ())) ((cons? V2352) (union (shen.extract-pvars (hd V2352)) (shen.extract-pvars (tl V2352)))) (true ())))
 
-(defun shen.mult_subst (V2385 V2386 V2387) (cond ((= () V2385) V2387) ((= () V2386) V2387) ((and (cons? V2385) (cons? V2386)) (shen.mult_subst (tl V2385) (tl V2386) (subst (hd V2385) (hd V2386) V2387))) (true (shen.sys-error shen.mult_subst))))
+(defun shen.mult_subst (V2357 V2358 V2359) (cond ((= () V2357) V2359) ((= () V2358) V2359) ((and (cons? V2357) (cons? V2358)) (shen.mult_subst (tl V2357) (tl V2358) (subst (hd V2357) (hd V2358) V2359))) (true (shen.sys-error shen.mult_subst))))
 
 
 