toplevel.kl in shen-ruby-0.10.0

- old
+ new
@@ -59,77 +59,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 (V2367) (cond ((= () V2367) ()) ((and (cons? V2367) (cons? (tl V2367))) (do (set (hd V2367) (hd (tl V2367))) (shen.multiple-set (tl (tl V2367))))) (true (shen.sys-error shen.multiple-set))))
+(defun shen.multiple-set (V2374) (cond ((= () V2374) ()) ((and (cons? V2374) (cons? (tl V2374))) (do (set (hd V2374) (hd (tl V2374))) (shen.multiple-set (tl (tl V2374))))) (true (shen.sys-error shen.multiple-set))))
 
-(defun destroy (V2368) (declare V2368 symbol))
+(defun destroy (V2375) (declare V2375 symbol))
 
 (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 (V2378 V2379) (cond ((and (tuple? V2378) (and (cons? (snd V2378)) (element? (hd (snd V2378)) (cons (shen.space) (cons (shen.newline) ()))))) (shen.retrieve-from-history-if-needed (@p (fst V2378) (tl (snd V2378))) V2379)) ((and (tuple? V2378) (and (cons? (snd V2378)) (and (cons? (tl (snd V2378))) (and (= () (tl (tl (snd V2378)))) (and (cons? V2379) (and (= (hd (snd V2378)) (shen.exclamation)) (= (hd (tl (snd V2378))) (shen.exclamation)))))))) (let PastPrint (shen.prbytes (snd (hd V2379))) (hd V2379))) ((and (tuple? V2378) (and (cons? (snd V2378)) (= (hd (snd V2378)) (shen.exclamation)))) (let Key? (shen.make-key (tl (snd V2378)) V2379) (let Find (head (shen.find-past-inputs Key? V2379)) (let PastPrint (shen.prbytes (snd Find)) Find)))) ((and (tuple? V2378) (and (cons? (snd V2378)) (and (= () (tl (snd V2378))) (= (hd (snd V2378)) (shen.percent))))) (do (shen.print-past-inputs (lambda X true) (reverse V2379) 0) (abort))) ((and (tuple? V2378) (and (cons? (snd V2378)) (= (hd (snd V2378)) (shen.percent)))) (let Key? (shen.make-key (tl (snd V2378)) V2379) (let Pastprint (shen.print-past-inputs Key? (reverse V2379) 0) (abort)))) (true V2378)))
+(defun shen.retrieve-from-history-if-needed (V2385 V2386) (cond ((and (tuple? V2385) (and (cons? (snd V2385)) (element? (hd (snd V2385)) (cons (shen.space) (cons (shen.newline) ()))))) (shen.retrieve-from-history-if-needed (@p (fst V2385) (tl (snd V2385))) V2386)) ((and (tuple? V2385) (and (cons? (snd V2385)) (and (cons? (tl (snd V2385))) (and (= () (tl (tl (snd V2385)))) (and (cons? V2386) (and (= (hd (snd V2385)) (shen.exclamation)) (= (hd (tl (snd V2385))) (shen.exclamation)))))))) (let PastPrint (shen.prbytes (snd (hd V2386))) (hd V2386))) ((and (tuple? V2385) (and (cons? (snd V2385)) (= (hd (snd V2385)) (shen.exclamation)))) (let Key? (shen.make-key (tl (snd V2385)) V2386) (let Find (head (shen.find-past-inputs Key? V2386)) (let PastPrint (shen.prbytes (snd Find)) Find)))) ((and (tuple? V2385) (and (cons? (snd V2385)) (and (= () (tl (snd V2385))) (= (hd (snd V2385)) (shen.percent))))) (do (shen.print-past-inputs (lambda X true) (reverse V2386) 0) (abort))) ((and (tuple? V2385) (and (cons? (snd V2385)) (= (hd (snd V2385)) (shen.percent)))) (let Key? (shen.make-key (tl (snd V2385)) V2386) (let Pastprint (shen.print-past-inputs Key? (reverse V2386) 0) (abort)))) (true V2385)))
 
 (defun shen.percent () 37)
 
 (defun shen.exclamation () 33)
 
-(defun shen.prbytes (V2380) (do (map (lambda Byte (pr (n->string Byte) (stoutput))) V2380) (nl 1)))
+(defun shen.prbytes (V2387) (do (map (lambda Byte (pr (n->string Byte) (stoutput))) V2387) (nl 1)))
 
-(defun shen.update_history (V2381 V2382) (set shen.*history* (cons V2381 V2382)))
+(defun shen.update_history (V2388 V2389) (set shen.*history* (cons V2388 V2389)))
 
 (defun shen.toplineread () (shen.toplineread_loop (read-byte (stinput)) ()))
 
-(defun shen.toplineread_loop (V2384 V2385) (cond ((= V2384 (shen.hat)) (simple-error "line read aborted")) ((element? V2384 (cons (shen.newline) (cons (shen.carriage-return) ()))) (let Line (compile (lambda X2365 (shen.<st_input> X2365)) V2385 (lambda E shen.nextline)) (if (or (= Line shen.nextline) (empty? Line)) (shen.toplineread_loop (read-byte (stinput)) (append V2385 (cons V2384 ()))) (@p Line V2385)))) (true (shen.toplineread_loop (read-byte (stinput)) (append V2385 (cons V2384 ()))))))
+(defun shen.toplineread_loop (V2391 V2392) (cond ((= V2391 (shen.hat)) (simple-error "line read aborted")) ((element? V2391 (cons (shen.newline) (cons (shen.carriage-return) ()))) (let Line (compile (lambda X2372 (shen.<st_input> X2372)) V2392 (lambda E shen.nextline)) (let It (shen.record-it V2392) (if (or (= Line shen.nextline) (empty? Line)) (shen.toplineread_loop (read-byte (stinput)) (append V2392 (cons V2391 ()))) (@p Line V2392))))) (true (shen.toplineread_loop (read-byte (stinput)) (append V2392 (cons V2391 ()))))))
 
 (defun shen.hat () 94)
 
 (defun shen.newline () 10)
 
 (defun shen.carriage-return () 13)
 
-(defun tc (V2390) (cond ((= + V2390) (set shen.*tc* true)) ((= - V2390) (set shen.*tc* false)) (true (simple-error "tc expects a + or -"))))
+(defun tc (V2397) (cond ((= + V2397) (set shen.*tc* true)) ((= - V2397) (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 (V2391) (shen.toplevel_evaluate V2391 (value shen.*tc*)))
+(defun shen.toplevel (V2398) (shen.toplevel_evaluate V2398 (value shen.*tc*)))
 
-(defun shen.find-past-inputs (V2392 V2393) (let F (shen.find V2392 V2393) (if (empty? F) (simple-error "input not found
+(defun shen.find-past-inputs (V2399 V2400) (let F (shen.find V2399 V2400) (if (empty? F) (simple-error "input not found
 ") F)))
 
-(defun shen.make-key (V2394 V2395) (let Atom (hd (compile (lambda X2366 (shen.<st_input> X2366)) V2394 (lambda E (if (cons? E) (simple-error (cn "parse error here: " (shen.app E "
+(defun shen.make-key (V2401 V2402) (let Atom (hd (compile (lambda X2373 (shen.<st_input> X2373)) V2401 (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 V2395)))) (lambda X (shen.prefix? V2394 (shen.trim-gubbins (snd X)))))))
+"))))) (if (integer? Atom) (lambda X (= X (nth (+ Atom 1) (reverse V2402)))) (lambda X (shen.prefix? V2401 (shen.trim-gubbins (snd X)))))))
 
-(defun shen.trim-gubbins (V2396) (cond ((and (cons? V2396) (= (hd V2396) (shen.space))) (shen.trim-gubbins (tl V2396))) ((and (cons? V2396) (= (hd V2396) (shen.newline))) (shen.trim-gubbins (tl V2396))) ((and (cons? V2396) (= (hd V2396) (shen.carriage-return))) (shen.trim-gubbins (tl V2396))) ((and (cons? V2396) (= (hd V2396) (shen.tab))) (shen.trim-gubbins (tl V2396))) ((and (cons? V2396) (= (hd V2396) (shen.left-round))) (shen.trim-gubbins (tl V2396))) (true V2396)))
+(defun shen.trim-gubbins (V2403) (cond ((and (cons? V2403) (= (hd V2403) (shen.space))) (shen.trim-gubbins (tl V2403))) ((and (cons? V2403) (= (hd V2403) (shen.newline))) (shen.trim-gubbins (tl V2403))) ((and (cons? V2403) (= (hd V2403) (shen.carriage-return))) (shen.trim-gubbins (tl V2403))) ((and (cons? V2403) (= (hd V2403) (shen.tab))) (shen.trim-gubbins (tl V2403))) ((and (cons? V2403) (= (hd V2403) (shen.left-round))) (shen.trim-gubbins (tl V2403))) (true V2403)))
 
 (defun shen.space () 32)
 
 (defun shen.tab () 9)
 
 (defun shen.left-round () 40)
 
-(defun shen.find (V2403 V2404) (cond ((= () V2404) ()) ((and (cons? V2404) (V2403 (hd V2404))) (cons (hd V2404) (shen.find V2403 (tl V2404)))) ((cons? V2404) (shen.find V2403 (tl V2404))) (true (shen.sys-error shen.find))))
+(defun shen.find (V2410 V2411) (cond ((= () V2411) ()) ((and (cons? V2411) (V2410 (hd V2411))) (cons (hd V2411) (shen.find V2410 (tl V2411)))) ((cons? V2411) (shen.find V2410 (tl V2411))) (true (shen.sys-error shen.find))))
 
-(defun shen.prefix? (V2415 V2416) (cond ((= () V2415) true) ((and (cons? V2415) (and (cons? V2416) (= (hd V2416) (hd V2415)))) (shen.prefix? (tl V2415) (tl V2416))) (true false)))
+(defun shen.prefix? (V2422 V2423) (cond ((= () V2422) true) ((and (cons? V2422) (and (cons? V2423) (= (hd V2423) (hd V2422)))) (shen.prefix? (tl V2422) (tl V2423))) (true false)))
 
-(defun shen.print-past-inputs (V2426 V2427 V2428) (cond ((= () V2427) _) ((and (cons? V2427) (not (V2426 (hd V2427)))) (shen.print-past-inputs V2426 (tl V2427) (+ V2428 1))) ((and (cons? V2427) (tuple? (hd V2427))) (do (shen.prhush (shen.app V2428 ". " shen.a) (stoutput)) (do (shen.prbytes (snd (hd V2427))) (shen.print-past-inputs V2426 (tl V2427) (+ V2428 1))))) (true (shen.sys-error shen.print-past-inputs))))
+(defun shen.print-past-inputs (V2433 V2434 V2435) (cond ((= () V2434) _) ((and (cons? V2434) (not (V2433 (hd V2434)))) (shen.print-past-inputs V2433 (tl V2434) (+ V2435 1))) ((and (cons? V2434) (tuple? (hd V2434))) (do (shen.prhush (shen.app V2435 ". " shen.a) (stoutput)) (do (shen.prbytes (snd (hd V2434))) (shen.print-past-inputs V2433 (tl V2434) (+ V2435 1))))) (true (shen.sys-error shen.print-past-inputs))))
 
-(defun shen.toplevel_evaluate (V2429 V2430) (cond ((and (cons? V2429) (and (cons? (tl V2429)) (and (= : (hd (tl V2429))) (and (cons? (tl (tl V2429))) (and (= () (tl (tl (tl V2429)))) (= true V2430)))))) (shen.typecheck-and-evaluate (hd V2429) (hd (tl (tl V2429))))) ((and (cons? V2429) (cons? (tl V2429))) (do (shen.toplevel_evaluate (cons (hd V2429) ()) V2430) (do (nl 1) (shen.toplevel_evaluate (tl V2429) V2430)))) ((and (cons? V2429) (and (= () (tl V2429)) (= true V2430))) (shen.typecheck-and-evaluate (hd V2429) (gensym A))) ((and (cons? V2429) (and (= () (tl V2429)) (= false V2430))) (let Eval (shen.eval-without-macros (hd V2429)) (print Eval))) (true (shen.sys-error shen.toplevel_evaluate))))
+(defun shen.toplevel_evaluate (V2436 V2437) (cond ((and (cons? V2436) (and (cons? (tl V2436)) (and (= : (hd (tl V2436))) (and (cons? (tl (tl V2436))) (and (= () (tl (tl (tl V2436)))) (= true V2437)))))) (shen.typecheck-and-evaluate (hd V2436) (hd (tl (tl V2436))))) ((and (cons? V2436) (cons? (tl V2436))) (do (shen.toplevel_evaluate (cons (hd V2436) ()) V2437) (do (nl 1) (shen.toplevel_evaluate (tl V2436) V2437)))) ((and (cons? V2436) (and (= () (tl V2436)) (= true V2437))) (shen.typecheck-and-evaluate (hd V2436) (gensym A))) ((and (cons? V2436) (and (= () (tl V2436)) (= false V2437))) (let Eval (shen.eval-without-macros (hd V2436)) (print Eval))) (true (shen.sys-error shen.toplevel_evaluate))))
 
-(defun shen.typecheck-and-evaluate (V2431 V2432) (let Typecheck (shen.typecheck V2431 V2432) (if (= Typecheck false) (simple-error "type error
-") (let Eval (shen.eval-without-macros V2431) (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 (V2438 V2439) (let Typecheck (shen.typecheck V2438 V2439) (if (= Typecheck false) (simple-error "type error
+") (let Eval (shen.eval-without-macros V2438) (let Type (shen.pretty-type Typecheck) (shen.prhush (shen.app Eval (cn " : " (shen.app Type "" shen.r)) shen.s) (stoutput)))))))
 
-(defun shen.pretty-type (V2433) (shen.mult_subst (value shen.*alphabet*) (shen.extract-pvars V2433) V2433))
+(defun shen.pretty-type (V2440) (shen.mult_subst (value shen.*alphabet*) (shen.extract-pvars V2440) V2440))
 
-(defun shen.extract-pvars (V2438) (cond ((shen.pvar? V2438) (cons V2438 ())) ((cons? V2438) (union (shen.extract-pvars (hd V2438)) (shen.extract-pvars (tl V2438)))) (true ())))
+(defun shen.extract-pvars (V2445) (cond ((shen.pvar? V2445) (cons V2445 ())) ((cons? V2445) (union (shen.extract-pvars (hd V2445)) (shen.extract-pvars (tl V2445)))) (true ())))
 
-(defun shen.mult_subst (V2443 V2444 V2445) (cond ((= () V2443) V2445) ((= () V2444) V2445) ((and (cons? V2443) (cons? V2444)) (shen.mult_subst (tl V2443) (tl V2444) (subst (hd V2443) (hd V2444) V2445))) (true (shen.sys-error shen.mult_subst))))
+(defun shen.mult_subst (V2450 V2451 V2452) (cond ((= () V2450) V2452) ((= () V2451) V2452) ((and (cons? V2450) (cons? V2451)) (shen.mult_subst (tl V2450) (tl V2451) (subst (hd V2450) (hd V2451) V2452))) (true (shen.sys-error shen.mult_subst))))
 
 
 