shen/release/k_lambda/toplevel.kl in shen-ruby-0.8.0 vs shen/release/k_lambda/toplevel.kl in shen-ruby-0.8.1

- 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 (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 shen.multiple-set (V2316) (cond ((= () V2316) ()) ((and (cons? V2316) (cons? (tl V2316))) (do (set (hd V2316) (hd (tl V2316))) (shen.multiple-set (tl (tl V2316))))) (true (shen.sys-error shen.multiple-set)))) -(defun destroy (V2299) (declare V2299 symbol)) +(defun destroy (V2317) (declare V2317 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 (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.retrieve-from-history-if-needed (V2327 V2328) (cond ((and (tuple? V2327) (and (cons? (snd V2327)) (element? (hd (snd V2327)) (cons (shen.space) (cons (shen.newline) ()))))) (shen.retrieve-from-history-if-needed (@p (fst V2327) (tl (snd V2327))) V2328)) ((and (tuple? V2327) (and (cons? (snd V2327)) (and (cons? (tl (snd V2327))) (and (= () (tl (tl (snd V2327)))) (and (cons? V2328) (and (= (hd (snd V2327)) (shen.exclamation)) (= (hd (tl (snd V2327))) (shen.exclamation)))))))) (let PastPrint (shen.prbytes (snd (hd V2328))) (hd V2328))) ((and (tuple? V2327) (and (cons? (snd V2327)) (= (hd (snd V2327)) (shen.exclamation)))) (let Key? (shen.make-key (tl (snd V2327)) V2328) (let Find (head (shen.find-past-inputs Key? V2328)) (let PastPrint (shen.prbytes (snd Find)) Find)))) ((and (tuple? V2327) (and (cons? (snd V2327)) (and (= () (tl (snd V2327))) (= (hd (snd V2327)) (shen.percent))))) (do (shen.print-past-inputs (lambda X true) (reverse V2328) 0) (abort))) ((and (tuple? V2327) (and (cons? (snd V2327)) (= (hd (snd V2327)) (shen.percent)))) (let Key? (shen.make-key (tl (snd V2327)) V2328) (let Pastprint (shen.print-past-inputs Key? (reverse V2328) 0) (abort)))) (true V2327))) (defun shen.percent () 37) (defun shen.exclamation () 33) -(defun shen.prbytes (V2311) (do (map (lambda Byte (pr (n->string Byte) (stoutput))) V2311) (nl 1))) +(defun shen.prbytes (V2329) (do (map (lambda Byte (pr (n->string Byte) (stoutput))) V2329) (nl 1))) -(defun shen.update_history (V2312 V2313) (set shen.*history* (cons V2312 V2313))) +(defun shen.update_history (V2330 V2331) (set shen.*history* (cons V2330 V2331))) (defun shen.toplineread () (shen.toplineread_loop (read-byte (stinput)) ())) -(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.toplineread_loop (V2333 V2334) (cond ((= V2333 (shen.hat)) (simple-error "line read aborted")) ((element? V2333 (cons (shen.newline) (cons (shen.carriage-return) ()))) (let Line (compile shen.<st_input> V2334 (lambda E shen.nextline)) (if (or (= Line shen.nextline) (empty? Line)) (shen.toplineread_loop (read-byte (stinput)) (append V2334 (cons V2333 ()))) (@p Line V2334)))) (true (shen.toplineread_loop (read-byte (stinput)) (append V2334 (cons V2333 ())))))) (defun shen.hat () 94) (defun shen.newline () 10) (defun shen.carriage-return () 13) -(defun tc (V2321) (cond ((= + V2321) (set shen.*tc* true)) ((= - V2321) (set shen.*tc* false)) (true (simple-error "tc expects a + or -")))) +(defun tc (V2339) (cond ((= + V2339) (set shen.*tc* true)) ((= - V2339) (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 (V2322) (shen.toplevel_evaluate V2322 (value shen.*tc*))) +(defun shen.toplevel (V2340) (shen.toplevel_evaluate V2340 (value shen.*tc*))) -(defun shen.find-past-inputs (V2323 V2324) (let F (shen.find V2323 V2324) (if (empty? F) (simple-error "input not found +(defun shen.find-past-inputs (V2341 V2342) (let F (shen.find V2341 V2342) (if (empty? F) (simple-error "input not found ") F))) -(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 " +(defun shen.make-key (V2343 V2344) (let Atom (hd (compile shen.<st_input> V2343 (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 V2326)))) (lambda X (shen.prefix? V2325 (shen.trim-gubbins (snd X))))))) +"))))) (if (integer? Atom) (lambda X (= X (nth (+ Atom 1) (reverse V2344)))) (lambda X (shen.prefix? V2343 (shen.trim-gubbins (snd X))))))) -(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.trim-gubbins (V2345) (cond ((and (cons? V2345) (= (hd V2345) (shen.space))) (shen.trim-gubbins (tl V2345))) ((and (cons? V2345) (= (hd V2345) (shen.newline))) (shen.trim-gubbins (tl V2345))) ((and (cons? V2345) (= (hd V2345) (shen.carriage-return))) (shen.trim-gubbins (tl V2345))) ((and (cons? V2345) (= (hd V2345) (shen.tab))) (shen.trim-gubbins (tl V2345))) ((and (cons? V2345) (= (hd V2345) (shen.left-round))) (shen.trim-gubbins (tl V2345))) (true V2345))) (defun shen.space () 32) (defun shen.tab () 9) (defun shen.left-round () 40) -(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.find (V2352 V2353) (cond ((= () V2353) ()) ((and (cons? V2353) (V2352 (hd V2353))) (cons (hd V2353) (shen.find V2352 (tl V2353)))) ((cons? V2353) (shen.find V2352 (tl V2353))) (true (shen.sys-error shen.find)))) -(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.prefix? (V2364 V2365) (cond ((= () V2364) true) ((and (cons? V2364) (and (cons? V2365) (= (hd V2365) (hd V2364)))) (shen.prefix? (tl V2364) (tl V2365))) (true false))) -(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.print-past-inputs (V2375 V2376 V2377) (cond ((= () V2376) _) ((and (cons? V2376) (not (V2375 (hd V2376)))) (shen.print-past-inputs V2375 (tl V2376) (+ V2377 1))) ((and (cons? V2376) (tuple? (hd V2376))) (do (shen.prhush (shen.app V2377 ". " shen.a) (stoutput)) (do (shen.prbytes (snd (hd V2376))) (shen.print-past-inputs V2375 (tl V2376) (+ V2377 1))))) (true (shen.sys-error shen.print-past-inputs)))) -(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.toplevel_evaluate (V2378 V2379) (cond ((and (cons? V2378) (and (cons? (tl V2378)) (and (= : (hd (tl V2378))) (and (cons? (tl (tl V2378))) (and (= () (tl (tl (tl V2378)))) (= true V2379)))))) (shen.typecheck-and-evaluate (hd V2378) (hd (tl (tl V2378))))) ((and (cons? V2378) (cons? (tl V2378))) (do (shen.toplevel_evaluate (cons (hd V2378) ()) V2379) (do (nl 1) (shen.toplevel_evaluate (tl V2378) V2379)))) ((and (cons? V2378) (and (= () (tl V2378)) (= true V2379))) (shen.typecheck-and-evaluate (hd V2378) (gensym A))) ((and (cons? V2378) (and (= () (tl V2378)) (= false V2379))) (let Eval (shen.eval-without-macros (hd V2378)) (print Eval))) (true (shen.sys-error shen.toplevel_evaluate)))) -(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.typecheck-and-evaluate (V2380 V2381) (let Typecheck (shen.typecheck V2380 V2381) (if (= Typecheck false) (simple-error "type error +") (let Eval (shen.eval-without-macros V2380) (let Type (shen.pretty-type Typecheck) (shen.prhush (shen.app Eval (cn " : " (shen.app Type "" shen.r)) shen.s) (stoutput))))))) -(defun shen.pretty-type (V2364) (shen.mult_subst (value shen.*alphabet*) (shen.extract-pvars V2364) V2364)) +(defun shen.pretty-type (V2382) (shen.mult_subst (value shen.*alphabet*) (shen.extract-pvars V2382) V2382)) -(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.extract-pvars (V2387) (cond ((shen.pvar? V2387) (cons V2387 ())) ((cons? V2387) (union (shen.extract-pvars (hd V2387)) (shen.extract-pvars (tl V2387)))) (true ()))) -(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)))) +(defun shen.mult_subst (V2392 V2393 V2394) (cond ((= () V2392) V2394) ((= () V2393) V2394) ((and (cons? V2392) (cons? V2393)) (shen.mult_subst (tl V2392) (tl V2393) (subst (hd V2392) (hd V2393) V2394))) (true (shen.sys-error shen.mult_subst))))