toplevel.kl in shen-ruby-0.8.0

- old
+ new
@@ -49,91 +49,87 @@
 *****************************************************************************************
 "(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 (V2288) (set *version* V2288))
-
-(version "version 13")
-
 (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*) "
 " shen.a)) (stoutput)) (do (shen.prhush (cn "running under " (shen.app (value *language*) (cn ", implementation: " (shen.app (value *implementation*) "" shen.a)) shen.a)) (stoutput)) (shen.prhush (cn "
 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 (V2289) (cond ((= () V2289) ()) ((and (cons? V2289) (cons? (tl V2289))) (do (set (hd V2289) (hd (tl V2289))) (shen.multiple-set (tl (tl V2289))))) (true (shen.sys-error shen.multiple-set))))
+(defun shen.multiple-set (V2298) (cond ((= () V2298) ()) ((and (cons? V2298) (cons? (tl V2298))) (do (set (hd V2298) (hd (tl V2298))) (shen.multiple-set (tl (tl V2298))))) (true (shen.sys-error shen.multiple-set))))
 
-(defun destroy (V2290) (declare V2290 ()))
+(defun destroy (V2299) (declare V2299 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 (V2300 V2301) (cond ((and (tuple? V2300) (and (cons? (snd V2300)) (element? (hd (snd V2300)) (cons (shen.space) (cons (shen.newline) ()))))) (shen.retrieve-from-history-if-needed (@p (fst V2300) (tl (snd V2300))) V2301)) ((and (tuple? V2300) (and (cons? (snd V2300)) (and (cons? (tl (snd V2300))) (and (= () (tl (tl (snd V2300)))) (and (cons? V2301) (and (= (hd (snd V2300)) (shen.exclamation)) (= (hd (tl (snd V2300))) (shen.exclamation)))))))) (let PastPrint (shen.prbytes (snd (hd V2301))) (hd V2301))) ((and (tuple? V2300) (and (cons? (snd V2300)) (= (hd (snd V2300)) (shen.exclamation)))) (let Key? (shen.make-key (tl (snd V2300)) V2301) (let Find (head (shen.find-past-inputs Key? V2301)) (let PastPrint (shen.prbytes (snd Find)) Find)))) ((and (tuple? V2300) (and (cons? (snd V2300)) (and (= () (tl (snd V2300))) (= (hd (snd V2300)) (shen.percent))))) (do (shen.print-past-inputs (lambda X true) (reverse V2301) 0) (abort))) ((and (tuple? V2300) (and (cons? (snd V2300)) (= (hd (snd V2300)) (shen.percent)))) (let Key? (shen.make-key (tl (snd V2300)) V2301) (let Pastprint (shen.print-past-inputs Key? (reverse V2301) 0) (abort)))) (true V2300)))
+(defun shen.retrieve-from-history-if-needed (V2309 V2310) (cond ((and (tuple? V2309) (and (cons? (snd V2309)) (element? (hd (snd V2309)) (cons (shen.space) (cons (shen.newline) ()))))) (shen.retrieve-from-history-if-needed (@p (fst V2309) (tl (snd V2309))) V2310)) ((and (tuple? V2309) (and (cons? (snd V2309)) (and (cons? (tl (snd V2309))) (and (= () (tl (tl (snd V2309)))) (and (cons? V2310) (and (= (hd (snd V2309)) (shen.exclamation)) (= (hd (tl (snd V2309))) (shen.exclamation)))))))) (let PastPrint (shen.prbytes (snd (hd V2310))) (hd V2310))) ((and (tuple? V2309) (and (cons? (snd V2309)) (= (hd (snd V2309)) (shen.exclamation)))) (let Key? (shen.make-key (tl (snd V2309)) V2310) (let Find (head (shen.find-past-inputs Key? V2310)) (let PastPrint (shen.prbytes (snd Find)) Find)))) ((and (tuple? V2309) (and (cons? (snd V2309)) (and (= () (tl (snd V2309))) (= (hd (snd V2309)) (shen.percent))))) (do (shen.print-past-inputs (lambda X true) (reverse V2310) 0) (abort))) ((and (tuple? V2309) (and (cons? (snd V2309)) (= (hd (snd V2309)) (shen.percent)))) (let Key? (shen.make-key (tl (snd V2309)) V2310) (let Pastprint (shen.print-past-inputs Key? (reverse V2310) 0) (abort)))) (true V2309)))
 
 (defun shen.percent () 37)
 
 (defun shen.exclamation () 33)
 
-(defun shen.prbytes (V2302) (do (map (lambda Byte (pr (n->string Byte) (stoutput))) V2302) (nl 1)))
+(defun shen.prbytes (V2311) (do (map (lambda Byte (pr (n->string Byte) (stoutput))) V2311) (nl 1)))
 
-(defun shen.update_history (V2303 V2304) (set shen.*history* (cons V2303 V2304)))
+(defun shen.update_history (V2312 V2313) (set shen.*history* (cons V2312 V2313)))
 
 (defun shen.toplineread () (shen.toplineread_loop (read-byte (stinput)) ()))
 
-(defun shen.toplineread_loop (V2306 V2307) (cond ((= V2306 (shen.hat)) (simple-error "line read aborted")) ((element? V2306 (cons (shen.newline) (cons (shen.carriage-return) ()))) (let Line (compile shen.<st_input> V2307 (lambda E shen.nextline)) (if (or (= Line shen.nextline) (empty? Line)) (shen.toplineread_loop (read-byte (stinput)) (append V2307 (cons V2306 ()))) (@p Line V2307)))) (true (shen.toplineread_loop (read-byte (stinput)) (append V2307 (cons V2306 ()))))))
+(defun shen.toplineread_loop (V2315 V2316) (cond ((= V2315 (shen.hat)) (simple-error "line read aborted")) ((element? V2315 (cons (shen.newline) (cons (shen.carriage-return) ()))) (let Line (compile shen.<st_input> V2316 (lambda E shen.nextline)) (if (or (= Line shen.nextline) (empty? Line)) (shen.toplineread_loop (read-byte (stinput)) (append V2316 (cons V2315 ()))) (@p Line V2316)))) (true (shen.toplineread_loop (read-byte (stinput)) (append V2316 (cons V2315 ()))))))
 
 (defun shen.hat () 94)
 
 (defun shen.newline () 10)
 
 (defun shen.carriage-return () 13)
 
-(defun tc (V2312) (cond ((= + V2312) (set shen.*tc* true)) ((= - V2312) (set shen.*tc* false)) (true (simple-error "tc expects a + or -"))))
+(defun tc (V2321) (cond ((= + V2321) (set shen.*tc* true)) ((= - V2321) (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 (V2313) (shen.toplevel_evaluate V2313 (value shen.*tc*)))
+(defun shen.toplevel (V2322) (shen.toplevel_evaluate V2322 (value shen.*tc*)))
 
-(defun shen.find-past-inputs (V2314 V2315) (let F (shen.find V2314 V2315) (if (empty? F) (simple-error "input not found
+(defun shen.find-past-inputs (V2323 V2324) (let F (shen.find V2323 V2324) (if (empty? F) (simple-error "input not found
 ") F)))
 
-(defun shen.make-key (V2316 V2317) (let Atom (hd (compile shen.<st_input> V2316 (lambda E (if (cons? E) (simple-error (cn "parse error here: " (shen.app E "
+(defun shen.make-key (V2325 V2326) (let Atom (hd (compile shen.<st_input> V2325 (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 V2317)))) (lambda X (shen.prefix? V2316 (shen.trim-gubbins (snd X)))))))
+"))))) (if (integer? Atom) (lambda X (= X (nth (+ Atom 1) (reverse V2326)))) (lambda X (shen.prefix? V2325 (shen.trim-gubbins (snd X)))))))
 
-(defun shen.trim-gubbins (V2318) (cond ((and (cons? V2318) (= (hd V2318) (shen.space))) (shen.trim-gubbins (tl V2318))) ((and (cons? V2318) (= (hd V2318) (shen.newline))) (shen.trim-gubbins (tl V2318))) ((and (cons? V2318) (= (hd V2318) (shen.carriage-return))) (shen.trim-gubbins (tl V2318))) ((and (cons? V2318) (= (hd V2318) (shen.tab))) (shen.trim-gubbins (tl V2318))) ((and (cons? V2318) (= (hd V2318) (shen.left-round))) (shen.trim-gubbins (tl V2318))) (true V2318)))
+(defun shen.trim-gubbins (V2327) (cond ((and (cons? V2327) (= (hd V2327) (shen.space))) (shen.trim-gubbins (tl V2327))) ((and (cons? V2327) (= (hd V2327) (shen.newline))) (shen.trim-gubbins (tl V2327))) ((and (cons? V2327) (= (hd V2327) (shen.carriage-return))) (shen.trim-gubbins (tl V2327))) ((and (cons? V2327) (= (hd V2327) (shen.tab))) (shen.trim-gubbins (tl V2327))) ((and (cons? V2327) (= (hd V2327) (shen.left-round))) (shen.trim-gubbins (tl V2327))) (true V2327)))
 
 (defun shen.space () 32)
 
 (defun shen.tab () 9)
 
 (defun shen.left-round () 40)
 
-(defun shen.find (V2325 V2326) (cond ((= () V2326) ()) ((and (cons? V2326) (V2325 (hd V2326))) (cons (hd V2326) (shen.find V2325 (tl V2326)))) ((cons? V2326) (shen.find V2325 (tl V2326))) (true (shen.sys-error shen.find))))
+(defun shen.find (V2334 V2335) (cond ((= () V2335) ()) ((and (cons? V2335) (V2334 (hd V2335))) (cons (hd V2335) (shen.find V2334 (tl V2335)))) ((cons? V2335) (shen.find V2334 (tl V2335))) (true (shen.sys-error shen.find))))
 
-(defun shen.prefix? (V2337 V2338) (cond ((= () V2337) true) ((and (cons? V2337) (and (cons? V2338) (= (hd V2338) (hd V2337)))) (shen.prefix? (tl V2337) (tl V2338))) (true false)))
+(defun shen.prefix? (V2346 V2347) (cond ((= () V2346) true) ((and (cons? V2346) (and (cons? V2347) (= (hd V2347) (hd V2346)))) (shen.prefix? (tl V2346) (tl V2347))) (true false)))
 
-(defun shen.print-past-inputs (V2348 V2349 V2350) (cond ((= () V2349) _) ((and (cons? V2349) (not (V2348 (hd V2349)))) (shen.print-past-inputs V2348 (tl V2349) (+ V2350 1))) ((and (cons? V2349) (tuple? (hd V2349))) (do (shen.prhush (shen.app V2350 ". " shen.a) (stoutput)) (do (shen.prbytes (snd (hd V2349))) (shen.print-past-inputs V2348 (tl V2349) (+ V2350 1))))) (true (shen.sys-error shen.print-past-inputs))))
+(defun shen.print-past-inputs (V2357 V2358 V2359) (cond ((= () V2358) _) ((and (cons? V2358) (not (V2357 (hd V2358)))) (shen.print-past-inputs V2357 (tl V2358) (+ V2359 1))) ((and (cons? V2358) (tuple? (hd V2358))) (do (shen.prhush (shen.app V2359 ". " shen.a) (stoutput)) (do (shen.prbytes (snd (hd V2358))) (shen.print-past-inputs V2357 (tl V2358) (+ V2359 1))))) (true (shen.sys-error shen.print-past-inputs))))
 
-(defun shen.toplevel_evaluate (V2351 V2352) (cond ((and (cons? V2351) (and (cons? (tl V2351)) (and (= : (hd (tl V2351))) (and (cons? (tl (tl V2351))) (and (= () (tl (tl (tl V2351)))) (= true V2352)))))) (shen.typecheck-and-evaluate (hd V2351) (hd (tl (tl V2351))))) ((and (cons? V2351) (cons? (tl V2351))) (do (shen.toplevel_evaluate (cons (hd V2351) ()) V2352) (do (nl 1) (shen.toplevel_evaluate (tl V2351) V2352)))) ((and (cons? V2351) (and (= () (tl V2351)) (= true V2352))) (shen.typecheck-and-evaluate (hd V2351) (gensym A))) ((and (cons? V2351) (and (= () (tl V2351)) (= false V2352))) (let Eval (shen.eval-without-macros (hd V2351)) (print Eval))) (true (shen.sys-error shen.toplevel_evaluate))))
+(defun shen.toplevel_evaluate (V2360 V2361) (cond ((and (cons? V2360) (and (cons? (tl V2360)) (and (= : (hd (tl V2360))) (and (cons? (tl (tl V2360))) (and (= () (tl (tl (tl V2360)))) (= true V2361)))))) (shen.typecheck-and-evaluate (hd V2360) (hd (tl (tl V2360))))) ((and (cons? V2360) (cons? (tl V2360))) (do (shen.toplevel_evaluate (cons (hd V2360) ()) V2361) (do (nl 1) (shen.toplevel_evaluate (tl V2360) V2361)))) ((and (cons? V2360) (and (= () (tl V2360)) (= true V2361))) (shen.typecheck-and-evaluate (hd V2360) (gensym A))) ((and (cons? V2360) (and (= () (tl V2360)) (= false V2361))) (let Eval (shen.eval-without-macros (hd V2360)) (print Eval))) (true (shen.sys-error shen.toplevel_evaluate))))
 
-(defun shen.typecheck-and-evaluate (V2353 V2354) (let Typecheck (shen.typecheck V2353 V2354) (if (= Typecheck false) (simple-error "type error
-") (let Eval (shen.eval-without-macros V2353) (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 (V2362 V2363) (let Typecheck (shen.typecheck V2362 V2363) (if (= Typecheck false) (simple-error "type error
+") (let Eval (shen.eval-without-macros V2362) (let Type (shen.pretty-type Typecheck) (shen.prhush (shen.app Eval (cn " : " (shen.app Type "" shen.r)) shen.s) (stoutput)))))))
 
-(defun shen.pretty-type (V2355) (shen.mult_subst (value shen.*alphabet*) (shen.extract-pvars V2355) V2355))
+(defun shen.pretty-type (V2364) (shen.mult_subst (value shen.*alphabet*) (shen.extract-pvars V2364) V2364))
 
-(defun shen.extract-pvars (V2360) (cond ((shen.pvar? V2360) (cons V2360 ())) ((cons? V2360) (union (shen.extract-pvars (hd V2360)) (shen.extract-pvars (tl V2360)))) (true ())))
+(defun shen.extract-pvars (V2369) (cond ((shen.pvar? V2369) (cons V2369 ())) ((cons? V2369) (union (shen.extract-pvars (hd V2369)) (shen.extract-pvars (tl V2369)))) (true ())))
 
-(defun shen.mult_subst (V2365 V2366 V2367) (cond ((= () V2365) V2367) ((= () V2366) V2367) ((and (cons? V2365) (cons? V2366)) (shen.mult_subst (tl V2365) (tl V2366) (subst (hd V2365) (hd V2366) V2367))) (true (shen.sys-error shen.mult_subst))))
+(defun shen.mult_subst (V2374 V2375 V2376) (cond ((= () V2374) V2376) ((= () V2375) V2376) ((and (cons? V2374) (cons? V2375)) (shen.mult_subst (tl V2374) (tl V2375) (subst (hd V2374) (hd V2375) V2376))) (true (shen.sys-error shen.mult_subst))))
 
 
 