mirror of
https://github.com/false-schemers/skint.git
synced 2024-11-16 07:47:54 +01:00
current ports refactoring -- still working
This commit is contained in:
ESL
parent
ac11df30ac
commit
6b463a9480
4 changed files with 141 additions and 26 deletions
23
i.c
23
i.c
|
|
@ -3101,6 +3101,25 @@ define_instruction(cerr) {
|
|||
gonexti();
|
||||
}
|
||||
|
||||
define_instruction(setcin) {
|
||||
ckr(ac);
|
||||
cx__2Acurrent_2Dinput_2A = ac;
|
||||
gonexti();
|
||||
}
|
||||
|
||||
define_instruction(setcout) {
|
||||
ckw(ac);
|
||||
cx__2Acurrent_2Doutput_2A = ac;
|
||||
gonexti();
|
||||
}
|
||||
|
||||
define_instruction(setcerr) {
|
||||
ckw(ac);
|
||||
cx__2Acurrent_2Derror_2A = ac;
|
||||
gonexti();
|
||||
gonexti();
|
||||
}
|
||||
/*
|
||||
define_instruction(cinv) {
|
||||
if (ac == void_obj()) {
|
||||
ac = cx__2Acurrent_2Dinput_2A;
|
||||
|
|
@ -3133,7 +3152,7 @@ define_instruction(cerrv) {
|
|||
}
|
||||
gonexti();
|
||||
}
|
||||
|
||||
*/
|
||||
|
||||
define_instruction(sip) {
|
||||
ac = iport_file_obj(stdin);
|
||||
|
|
@ -4673,7 +4692,7 @@ char *i_code[] = {
|
|||
|
||||
/* initialize current port variables */
|
||||
"C", 0,
|
||||
"P10Pi!" "P11Po!" "P12Pe!",
|
||||
"P10Psi" "P11Pso" "P12Pse",
|
||||
|
||||
/* internal continuation switch code */
|
||||
"P", "%dynamic-state-reroot!",
|
||||
|
|
|
|||
9
i.h
9
i.h
|
|
@ -470,9 +470,12 @@ declare_instruction(void, "Y9", 0, "void",
|
|||
declare_instruction(cin, "Pi", 0, "%current-input-port", '0', AUTOGL)
|
||||
declare_instruction(cout, "Po", 0, "%current-output-port", '0', AUTOGL)
|
||||
declare_instruction(cerr, "Pe", 0, "%current-error-port", '0', AUTOGL)
|
||||
declare_instruction(cinv, "Pi!\0Y9", 0, "current-input-port", 'u', AUTOGL)
|
||||
declare_instruction(coutv, "Po!\0Y9", 0, "current-output-port", 'u', AUTOGL)
|
||||
declare_instruction(cerrv, "Pe!\0Y9", 0, "current-error-port", 'u', AUTOGL)
|
||||
declare_instruction(setcin, "Psi", 0, "%set-current-input-port!", '0', AUTOGL)
|
||||
declare_instruction(setcout, "Pso", 0, "%set-current-output-port!",'0', AUTOGL)
|
||||
declare_instruction(setcerr, "Pse", 0, "%set-current-error-port!", '0', AUTOGL)
|
||||
//declare_instruction(cinv, "Pi!\0Y9", 0, "current-input-port", 'u', AUTOGL)
|
||||
//declare_instruction(coutv, "Po!\0Y9", 0, "current-output-port", 'u', AUTOGL)
|
||||
//declare_instruction(cerrv, "Pe!\0Y9", 0, "current-error-port", 'u', AUTOGL)
|
||||
declare_instruction(funp, "K0", 0, "procedure?", '1', AUTOGL)
|
||||
declare_instruction(ipp, "P00", 0, "input-port?", '1', AUTOGL)
|
||||
declare_instruction(opp, "P01", 0, "output-port?", '1', AUTOGL)
|
||||
|
|
|
|||
59
s.c
59
s.c
|
|
@ -621,12 +621,12 @@ char *s_code[] = {
|
|||
"rror),@(y12:write-string)[02}}${.7,.7,.4^[02}.5W6]6",
|
||||
|
||||
"P", "simple-error",
|
||||
"%!0Pe,.0W6${.2,.4,'(s5:Error),@(y19:print-error-message)[03}@(y5:reset"
|
||||
")[20",
|
||||
"%!0Y9Pe!,.0W6${.2,.4,'(s5:Error),@(y19:print-error-message)[03}@(y5:re"
|
||||
"set)[20",
|
||||
|
||||
"P", "assertion-violation",
|
||||
"%!0Pe,.0W6${.2,.4,'(s19:Assertion violation),@(y19:print-error-message"
|
||||
")[03}'1Z9]2",
|
||||
"%!0Y9Pe!,.0W6${.2,.4,'(s19:Assertion violation),@(y19:print-error-mess"
|
||||
"age)[03}'1Z9]2",
|
||||
|
||||
"C", 0,
|
||||
"${'(l3:y4:kind;y7:message;y9:irritants;),'(y14:<error-object>),@(y15:n"
|
||||
|
|
@ -728,6 +728,39 @@ char *s_code[] = {
|
|||
"C", 0,
|
||||
"@(y5:port?)@!(y12:binary-port?)",
|
||||
|
||||
"C", 0,
|
||||
"&0{%2.1?{.0,@(y24:%25set-current-input-port!)[21}.0]2}%x,&0{%1.0,@(y24"
|
||||
":%25set-current-input-port!)[11}%x,&0{%0Pi]0}%x,&3{|00|11|22%%}@!(y29:"
|
||||
"%25current-input-port-parameter)",
|
||||
|
||||
"S", "current-input-port",
|
||||
"l6:y12:syntax-rules;n;l2:l1:y1:_;;l1:y19:%25current-input-port;;;l2:l2"
|
||||
":y1:_;y1:p;;l2:y24:%25set-current-input-port!;y1:p;;;l2:py1:_;y1:r;;py"
|
||||
"29:%25current-input-port-parameter;y1:r;;;l2:y1:_;y29:%25current-input"
|
||||
"-port-parameter;;",
|
||||
|
||||
"C", 0,
|
||||
"&0{%2.1?{.0,@(y25:%25set-current-output-port!)[21}.0]2}%x,&0{%1.0,@(y2"
|
||||
"5:%25set-current-output-port!)[11}%x,&0{%0Po]0}%x,&3{|00|11|22%%}@!(y3"
|
||||
"0:%25current-output-port-parameter)",
|
||||
|
||||
"S", "current-output-port",
|
||||
"l6:y12:syntax-rules;n;l2:l1:y1:_;;l1:y20:%25current-output-port;;;l2:l"
|
||||
"2:y1:_;y1:p;;l2:y25:%25set-current-output-port!;y1:p;;;l2:py1:_;y1:r;;"
|
||||
"py30:%25current-output-port-parameter;y1:r;;;l2:y1:_;y30:%25current-ou"
|
||||
"tput-port-parameter;;",
|
||||
|
||||
"C", 0,
|
||||
"&0{%2.1?{.0,@(y24:%25set-current-error-port!)[21}.0]2}%x,&0{%1.0,@(y24"
|
||||
":%25set-current-error-port!)[11}%x,&0{%0Pe]0}%x,&3{|00|11|22%%}@!(y29:"
|
||||
"%25current-error-port-parameter)",
|
||||
|
||||
"S", "current-error-port",
|
||||
"l6:y12:syntax-rules;n;l2:l1:y1:_;;l1:y19:%25current-error-port;;;l2:l2"
|
||||
":y1:_;y1:p;;l2:y24:%25set-current-error-port!;y1:p;;;l2:py1:_;y1:r;;py"
|
||||
"29:%25current-error-port-parameter;y1:r;;;l2:y1:_;y29:%25current-error"
|
||||
"-port-parameter;;",
|
||||
|
||||
"P", "open-input-file",
|
||||
"%1.0P40,.0?{.0]2}.1,'(s22:cannot open input file),@(y10:file-error)[22",
|
||||
|
||||
|
|
@ -756,6 +789,24 @@ char *s_code[] = {
|
|||
"P", "call-with-output-file",
|
||||
"%2.1,${.3,@(y16:open-output-file)[01},@(y14:call-with-port)[22",
|
||||
|
||||
"P", "with-input-from-port",
|
||||
"%2@(y29:%25current-input-port-parameter),${f,.4,.4[02},${.3[00},.0,.3,"
|
||||
"&2{%0t,:1,:0[02},.5,&1{%0:0[00},.3,.5,&2{%0t,:1,:0[02},@(y12:dynamic-w"
|
||||
"ind)[53",
|
||||
|
||||
"P", "with-output-to-port",
|
||||
"%2@(y30:%25current-output-port-parameter),${f,.4,.4[02},${.3[00},.0,.3"
|
||||
",&2{%0t,:1,:0[02},.5,&1{%0:0[00},.3,.5,&2{%0t,:1,:0[02},@(y12:dynamic-"
|
||||
"wind)[53",
|
||||
|
||||
"P", "with-input-from-file",
|
||||
"%2.1,&1{%1:0,.1,@(y20:with-input-from-port)[12},.1,@(y20:call-with-inp"
|
||||
"ut-file)[22",
|
||||
|
||||
"P", "with-output-to-file",
|
||||
"%2.1,&1{%1:0,.1,@(y19:with-output-to-port)[12},.1,@(y21:call-with-outp"
|
||||
"ut-file)[22",
|
||||
|
||||
"P", "read-line",
|
||||
"%!0P51,.1u?{Pi}{.1a},t,,#0.2,.4,.2,&3{%1:2R0,.0R8,.0?{.0}{'(c%0a),.2C="
|
||||
"}_1?{.0R8?{.1}{f}?{.0]2}:1P90,:1P61.0]3}'(c%0d),.1C=?{f,:0^[21}:1,.1W0"
|
||||
|
|
|
|||
76
src/s.scm
76
src/s.scm
|
|
@ -1178,18 +1178,6 @@
|
|||
; Exceptions
|
||||
;---------------------------------------------------------------------------------------------
|
||||
|
||||
;TBD:
|
||||
;
|
||||
; (with-exception-handler handler thunk)
|
||||
; (raise obj)
|
||||
; (raise-continuable obj)
|
||||
; (error-object? x)
|
||||
; (error-object-message e)
|
||||
; (error-object-irritants e)
|
||||
;read-error?
|
||||
;file-error?
|
||||
|
||||
|
||||
(define (abort) (%abort))
|
||||
|
||||
(define (reset) (%exit 1))
|
||||
|
|
@ -1356,9 +1344,15 @@
|
|||
; (output-port? x)
|
||||
; (input-port-open? p)
|
||||
; (output-port-open? p)
|
||||
; (current-input-port) ; need to be made into a parameter
|
||||
; (current-output-port) ; need to be made into a parameter
|
||||
; (current-error-port) ; need to be made into a parameter
|
||||
; (%current-input-port) +
|
||||
; (%current-output-port) +
|
||||
; (%current-error-port) +
|
||||
; (%set-current-input-port! p) +
|
||||
; (%set-current-output-port! p) +
|
||||
; (%set-current-error-port! p) +
|
||||
; (standard-input-port) +
|
||||
; (standard-output-port) +
|
||||
; (standard-error-port) +
|
||||
; (%open-input-file s) +
|
||||
; (%open-binary-input-file s) +
|
||||
; (%open-output-file x) +
|
||||
|
|
@ -1376,6 +1370,45 @@
|
|||
(define textual-port? port?) ; all ports are bimodal
|
||||
(define binary-port? port?) ; all ports are bimodal
|
||||
|
||||
(define %current-input-port-parameter
|
||||
(case-lambda
|
||||
[() (%current-input-port)]
|
||||
[(p) (%set-current-input-port! p)]
|
||||
[(p s) (if s (%set-current-input-port! p) p)]))
|
||||
|
||||
(define-syntax current-input-port
|
||||
(syntax-rules ()
|
||||
[(_) (%current-input-port)]
|
||||
[(_ p) (%set-current-input-port! p)]
|
||||
[(_ . r) (%current-input-port-parameter . r)]
|
||||
[_ %current-input-port-parameter]))
|
||||
|
||||
(define %current-output-port-parameter
|
||||
(case-lambda
|
||||
[() (%current-output-port)]
|
||||
[(p) (%set-current-output-port! p)]
|
||||
[(p s) (if s (%set-current-output-port! p) p)]))
|
||||
|
||||
(define-syntax current-output-port
|
||||
(syntax-rules ()
|
||||
[(_) (%current-output-port)]
|
||||
[(_ p) (%set-current-output-port! p)]
|
||||
[(_ . r) (%current-output-port-parameter . r)]
|
||||
[_ %current-output-port-parameter]))
|
||||
|
||||
(define %current-error-port-parameter
|
||||
(case-lambda
|
||||
[() (%current-error-port)]
|
||||
[(p) (%set-current-error-port! p)]
|
||||
[(p s) (if s (%set-current-error-port! p) p)]))
|
||||
|
||||
(define-syntax current-error-port
|
||||
(syntax-rules ()
|
||||
[(_) (%current-error-port)]
|
||||
[(_ p) (%set-current-error-port! p)]
|
||||
[(_ . r) (%current-error-port-parameter . r)]
|
||||
[_ %current-error-port-parameter]))
|
||||
|
||||
(define (open-input-file fn)
|
||||
(or (%open-input-file fn)
|
||||
(file-error "cannot open input file" fn)))
|
||||
|
|
@ -1406,8 +1439,17 @@
|
|||
(define (call-with-output-file fname proc)
|
||||
(call-with-port (open-output-file fname) proc))
|
||||
|
||||
;with-input-from-file -- requires parameterize
|
||||
;with-output-to-file -- requires parameterize
|
||||
(define (with-input-from-port port thunk) ; +
|
||||
(parameterize ([current-input-port port]) (thunk)))
|
||||
|
||||
(define (with-output-to-port port thunk) ; +
|
||||
(parameterize ([current-output-port port]) (thunk)))
|
||||
|
||||
(define (with-input-from-file fname thunk)
|
||||
(call-with-input-file fname (lambda (p) (with-input-from-port p thunk))))
|
||||
|
||||
(define (with-output-to-file fname thunk)
|
||||
(call-with-output-file fname (lambda (p) (with-output-to-port p thunk))))
|
||||
|
||||
|
||||
;---------------------------------------------------------------------------------------------
|
||||
|
|
|
|||
Loading…
Reference in a new issue