mirror of
https://github.com/false-schemers/skint.git
synced 2024-11-16 07:47:54 +01:00
... write and others; 'u' and 'b' ig types
This commit is contained in:
ESL
parent
0a94172bbd
commit
ad3b6f9844
6 changed files with 1322 additions and 1174 deletions
12
i.c
12
i.c
|
|
@ -1223,7 +1223,7 @@ define_instruction(itos) {
|
|||
}
|
||||
|
||||
define_instruction(stoi) {
|
||||
char *e, *s; int radix = fixnum_from_obj(spop()); long l;
|
||||
char *e, *s; long l, radix;
|
||||
obj x = ac, y = spop(); cks(x); ckk(y);
|
||||
s = stringchars(x); radix = fixnum_from_obj(y);
|
||||
if (radix < 2 || radix > 10 + 'z' - 'a') failtype(y, "valid radix");
|
||||
|
|
@ -3594,6 +3594,16 @@ static obj *rds_intgtab(obj *r, obj *sp, obj *hp)
|
|||
lcode = lbuf; assert(pe->enc);
|
||||
sprintf(lbuf, "%%!1.0,.2,,#0.0,&1{%%2.1u?{.0]2}.1d,.2a,.2%s,:0^[22}.!0.0^_1[22}", pe->enc);
|
||||
} break;
|
||||
case 'u': {
|
||||
lcode = lbuf; assert(pe->enc);
|
||||
pe0 = pe->enc; pe1 = pe0 + strlen(pe0) + 1; assert(*pe1);
|
||||
sprintf(lbuf, "%%!0.0u?{%s%s]1}.0du?{.0a%s]1}%%%%", pe1, pe0, pe0);
|
||||
} break;
|
||||
case 'b': {
|
||||
lcode = lbuf; assert(pe->enc);
|
||||
pe0 = pe->enc; pe1 = pe0 + strlen(pe0) + 1; assert(*pe1);
|
||||
sprintf(lbuf, "%%!1.0u?{%s,.2%s]2}.0du?{.0a,.2%s]2}%%%%", pe1, pe0, pe0);
|
||||
} break;
|
||||
default: assert(0);
|
||||
}
|
||||
if (!lcode || *lcode == 0) continue;
|
||||
|
|
|
|||
26
i.h
26
i.h
|
|
@ -413,14 +413,14 @@ declare_instruction(stol, "X2", 0, "%stol", 1, INLINED)
|
|||
declare_instruction(ltos, "X3", 0, "%ltos", 1, INLINED)
|
||||
declare_instruction(ytos, "X4", 0, "%ytos", 1, INLINED)
|
||||
declare_instruction(stoy, "X5", 0, "%stoy", 1, INLINED)
|
||||
declare_instruction(itos, "X6", 0, "%itos", 2, INLINED)
|
||||
declare_instruction(stoi, "X7", 0, "%stoi", 2, INLINED)
|
||||
declare_instruction(itos, "X6\0'(i10)", 0, "fixnum->string", 'b', AUTOGL)
|
||||
declare_instruction(stoi, "X7\0'(i10)", 0, "string->fixnum", 'b', AUTOGL)
|
||||
declare_instruction(ctoi, "X8", 0, "%ctoi", 1, INLINED)
|
||||
declare_instruction(itoc, "X9", 0, "%itoc", 1, INLINED)
|
||||
declare_instruction(jtos, "E6", 0, "%jtos", 1, INLINED)
|
||||
declare_instruction(stoj, "E7", 0, "%stoj", 1, INLINED)
|
||||
declare_instruction(ntos, "E8", 0, "%ntos", 2, INLINED)
|
||||
declare_instruction(ston, "E9", 0, "%ston", 2, INLINED)
|
||||
declare_instruction(jtos, "E6", 0, "flonum->string", '1', AUTOGL)
|
||||
declare_instruction(stoj, "E7", 0, "string->flonum", '1', AUTOGL)
|
||||
declare_instruction(ntos, "E8\0'(i10)", 0, "number->string", 'b', AUTOGL)
|
||||
declare_instruction(ston, "E9\0'(i10)", 0, "string->number", 'b', AUTOGL)
|
||||
declare_instruction(ccmp, "O0", 0, "%ccmp", 2, INLINED)
|
||||
declare_instruction(cicmp, "O1", 0, "%cicmp", 2, INLINED)
|
||||
declare_instruction(scmp, "O2", 0, "%scmp", 2, INLINED)
|
||||
|
|
@ -448,13 +448,13 @@ declare_instruction(rdac, "R1", 0, "%rdac", 1, INLINED)
|
|||
declare_instruction(rdcr, "R2", 0, "%rdcr", 1, INLINED)
|
||||
declare_instruction(eofp, "R8", 0, "%eofp", 1, INLINED)
|
||||
declare_instruction(eof, "R9", 0, "%eof", 0, INLINED)
|
||||
declare_instruction(wrc, "W0", 0, "%wrc", 2, INLINED)
|
||||
declare_instruction(wrs, "W1", 0, "%wrs", 2, INLINED)
|
||||
declare_instruction(wrcd, "W4", 0, "%wrcd", 2, INLINED)
|
||||
declare_instruction(wrcw, "W5", 0, "%wrcw", 2, INLINED)
|
||||
declare_instruction(wrnl, "W6", 0, "%wrnl", 1, INLINED)
|
||||
declare_instruction(wrhw, "W7", 0, "%wrhw", 2, INLINED)
|
||||
declare_instruction(wriw, "W8", 0, "%wriw", 2, INLINED)
|
||||
declare_instruction(wrc, "W0\0P11", 0, "write-char", 'b', AUTOGL)
|
||||
declare_instruction(wrs, "W1\0P11", 0, "write-string", 'b', AUTOGL)
|
||||
declare_instruction(wrcd, "W4\0P11", 0, "display", 'b', AUTOGL)
|
||||
declare_instruction(wrcw, "W5\0P11", 0, "write", 'b', AUTOGL)
|
||||
declare_instruction(wrnl, "W6\0P11", 0, "newline", 'u', AUTOGL)
|
||||
declare_instruction(wrhw, "W7\0P11", 0, "write-shared", 'b', AUTOGL)
|
||||
declare_instruction(wriw, "W8\0P11", 0, "write-simple", 'b', AUTOGL)
|
||||
|
||||
/* serialization and deserialization instructions */
|
||||
declare_instruction(igp, "U0", 0, "integrable?", '1', AUTOGL)
|
||||
|
|
|
|||
114
s.c
114
s.c
|
|
@ -766,50 +766,6 @@ char *s_code[] = {
|
|||
0,
|
||||
"&0{%2.1,.1Si<!]2}@!(y19:%25residual-string>=?)",
|
||||
|
||||
"fixnum->string",
|
||||
"l5:y12:syntax-rules;n;l2:l3:y1:_;y1:x;y1:r;;l3:y5:%25itos;y1:x;y1:r;;;"
|
||||
"l2:py1:_;y12:syntax-rules;;py24:%25residual-fixnum->string;y12:syntax-"
|
||||
"rules;;;l2:y1:_;y24:%25residual-fixnum->string;;",
|
||||
|
||||
0,
|
||||
"&0{%2.1,.1X6]2}@!(y24:%25residual-fixnum->string)",
|
||||
|
||||
"string->fixnum",
|
||||
"l5:y12:syntax-rules;n;l2:l3:y1:_;y1:x;y1:r;;l3:y5:%25stoi;y1:x;y1:r;;;"
|
||||
"l2:py1:_;y12:syntax-rules;;py24:%25residual-string->fixnum;y12:syntax-"
|
||||
"rules;;;l2:y1:_;y24:%25residual-string->fixnum;;",
|
||||
|
||||
0,
|
||||
"&0{%2.1,.1X7]2}@!(y24:%25residual-string->fixnum)",
|
||||
|
||||
"flonum->string",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25jtos;y1:x;;;l2:py1:_;y"
|
||||
"12:syntax-rules;;py24:%25residual-flonum->string;y12:syntax-rules;;;l2"
|
||||
":y1:_;y24:%25residual-flonum->string;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0E6]1}@!(y24:%25residual-flonum->string)",
|
||||
|
||||
"string->flonum",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25stoj;y1:x;;;l2:py1:_;y"
|
||||
"12:syntax-rules;;py24:%25residual-string->flonum;y12:syntax-rules;;;l2"
|
||||
":y1:_;y24:%25residual-string->flonum;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0E7]1}@!(y24:%25residual-string->flonum)",
|
||||
|
||||
"number->string",
|
||||
"l6:y12:syntax-rules;n;l2:l3:y1:_;y1:x;y1:r;;l3:y5:%25ntos;y1:x;y1:r;;;"
|
||||
"l2:l2:y1:_;y1:x;;l3:y5:%25ntos;y1:x;i10;;;l2:py1:_;y4:args;;py24:%25re"
|
||||
"sidual-number->string;y4:args;;;l2:y1:_;y24:%25residual-number->string"
|
||||
";;",
|
||||
|
||||
"string->number",
|
||||
"l6:y12:syntax-rules;n;l2:l3:y1:_;y1:x;y1:r;;l3:y5:%25ston;y1:x;y1:r;;;"
|
||||
"l2:l2:y1:_;y1:x;;l3:y5:%25ston;y1:x;i10;;;l2:py1:_;y4:args;;py24:%25re"
|
||||
"sidual-string->number;y4:args;;;l2:y1:_;y24:%25residual-string->number"
|
||||
";;",
|
||||
|
||||
"procedure?",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25funp;y1:x;;;l2:py1:_;y"
|
||||
"12:syntax-rules;;py20:%25residual-procedure?;y12:syntax-rules;;;l2:y1:"
|
||||
|
|
@ -1030,8 +986,8 @@ char *s_code[] = {
|
|||
|
||||
0,
|
||||
"&0{%1P51,t,,#0.3,.3,.2,&3{%1:2R0,.0R8,.0?{.0}{'(c%0a),.2C=}_1?{.0R8?{."
|
||||
"1}{f}?{.0]2}:1P9,:1P61.0]3}'(c%0d),.1C=?{f,:0^[21}:1,.1W0f,:0^[21}.!0."
|
||||
"0^_1[21}@!(y10:%25read-line)",
|
||||
"1}{f}?{.0]2}:1P9,:1P61.0]3}'(c%0d),.1C=?{f,:0^[21}${:1,.3,@(y4:%25wrc)"
|
||||
"[02}f,:0^[21}.!0.0^_1[21}@!(y10:%25read-line)",
|
||||
|
||||
"read-line",
|
||||
"l5:y12:syntax-rules;n;l2:l1:y1:_;;l2:y10:%25read-line;l1:y4:%25sip;;;;"
|
||||
|
|
@ -1054,45 +1010,6 @@ char *s_code[] = {
|
|||
0,
|
||||
"&0{%0R9]0}@!(y20:%25residual-eof-object)",
|
||||
|
||||
"write-char",
|
||||
"l6:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l3:y4:%25wrc;y1:x;l1:y4:%25sop;"
|
||||
";;;l2:l3:y1:_;y1:x;y1:p;;l3:y4:%25wrc;y1:x;y1:p;;;l2:py1:_;y4:args;;py"
|
||||
"20:%25residual-write-char;y4:args;;;l2:y1:_;y20:%25residual-write-char"
|
||||
";;",
|
||||
|
||||
"write-string",
|
||||
"l6:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l3:y4:%25wrs;y1:x;l1:y4:%25sop;"
|
||||
";;;l2:l3:y1:_;y1:x;y1:p;;l3:y4:%25wrs;y1:x;y1:p;;;l2:py1:_;y4:args;;py"
|
||||
"22:%25residual-write-string;y4:args;;;l2:y1:_;y22:%25residual-write-st"
|
||||
"ring;;",
|
||||
|
||||
"display",
|
||||
"l6:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l3:y5:%25wrcd;y1:x;l1:y4:%25sop"
|
||||
";;;;l2:l3:y1:_;y1:x;y1:p;;l3:y5:%25wrcd;y1:x;y1:p;;;l2:py1:_;y4:args;;"
|
||||
"py17:%25residual-display;y4:args;;;l2:y1:_;y17:%25residual-display;;",
|
||||
|
||||
"write",
|
||||
"l6:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l3:y5:%25wrcw;y1:x;l1:y4:%25sop"
|
||||
";;;;l2:l3:y1:_;y1:x;y1:p;;l3:y5:%25wrcw;y1:x;y1:p;;;l2:py1:_;y4:args;;"
|
||||
"py15:%25residual-write;y4:args;;;l2:y1:_;y15:%25residual-write;;",
|
||||
|
||||
"newline",
|
||||
"l6:y12:syntax-rules;n;l2:l1:y1:_;;l2:y5:%25wrnl;l1:y4:%25sop;;;;l2:l2:"
|
||||
"y1:_;y1:p;;l2:y5:%25wrnl;y1:p;;;l2:py1:_;y4:args;;py17:%25residual-new"
|
||||
"line;y4:args;;;l2:y1:_;y17:%25residual-newline;;",
|
||||
|
||||
"write-shared",
|
||||
"l6:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l3:y5:%25wrhw;y1:x;l1:y4:%25sop"
|
||||
";;;;l2:l3:y1:_;y1:x;y1:p;;l3:y5:%25wrhw;y1:x;y1:p;;;l2:py1:_;y4:args;;"
|
||||
"py22:%25residual-write-shared;y4:args;;;l2:y1:_;y22:%25residual-write-"
|
||||
"shared;;",
|
||||
|
||||
"write-simple",
|
||||
"l6:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l3:y5:%25wriw;y1:x;l1:y4:%25sop"
|
||||
";;;;l2:l3:y1:_;y1:x;y1:p;;l3:y5:%25wriw;y1:x;y1:p;;;l2:py1:_;y4:args;;"
|
||||
"py22:%25residual-write-simple;y4:args;;;l2:y1:_;y22:%25residual-write-"
|
||||
"simple;;",
|
||||
|
||||
0,
|
||||
"&0{%!0.0]1}@!(y14:%25residual-list)",
|
||||
|
||||
|
|
@ -1156,12 +1073,6 @@ char *s_code[] = {
|
|||
"&0{%!0.0,,#0.0,&1{%1.0u?{'(v0:)]1}.0du?{.0a]1}${.2d,:0^[01},.1aV6]1}.!"
|
||||
"0.0^_1[11}@!(y23:%25residual-vector-append)",
|
||||
|
||||
0,
|
||||
"&0{%!1.0u?{'(i10),.2E8]2}.0a,.2E8]2}@!(y24:%25residual-number->string)",
|
||||
|
||||
0,
|
||||
"&0{%!1.0u?{'(i10),.2E9]2}.0a,.2E9]2}@!(y24:%25residual-string->number)",
|
||||
|
||||
0,
|
||||
"&0{%!0.0u?{P10R0]1}.0aR0]1}@!(y19:%25residual-read-char)",
|
||||
|
||||
|
|
@ -1175,26 +1086,5 @@ char *s_code[] = {
|
|||
"&0{%!0.0u?{P10,@(y10:%25read-line)[11}.0a,@(y10:%25read-line)[11}@!(y1"
|
||||
"9:%25residual-read-line)",
|
||||
|
||||
0,
|
||||
"&0{%!1.0u?{P11,.2W0]2}.0a,.2W0]2}@!(y20:%25residual-write-char)",
|
||||
|
||||
0,
|
||||
"&0{%!1.0u?{P11,.2W1]2}.0a,.2W1]2}@!(y22:%25residual-write-string)",
|
||||
|
||||
0,
|
||||
"&0{%!0.0u?{P11W6]1}.0aW6]1}@!(y17:%25residual-newline)",
|
||||
|
||||
0,
|
||||
"&0{%!1.0u?{P11,.2W4]2}.0a,.2W4]2}@!(y17:%25residual-display)",
|
||||
|
||||
0,
|
||||
"&0{%!1.0u?{P11,.2W5]2}.0a,.2W5]2}@!(y15:%25residual-write)",
|
||||
|
||||
0,
|
||||
"&0{%!1.0u?{P11,.2W8]2}.0a,.2W8]2}@!(y22:%25residual-write-simple)",
|
||||
|
||||
0,
|
||||
"&0{%!1.0u?{P11,.2W7]2}.0a,.2W7]2}@!(y22:%25residual-write-shared)",
|
||||
|
||||
0, 0
|
||||
};
|
||||
|
|
|
|||
17
src/k.sf
17
src/k.sf
|
|
@ -356,8 +356,9 @@
|
|||
|
||||
(define (integrable-argc-match? igt n)
|
||||
(case igt
|
||||
[(#\0) (= n 0)] [(#\1) (= n 1)] [(#\2) (= n 2)] [(#\3) (= n 3)]
|
||||
[(#\p) (>= n 0)] [(#\m) (>= n 1)] [(#\c) (>= n 2)] [(#\x) (>= n 1)]
|
||||
[(#\0) (= n 0)] [(#\1) (= n 1)] [(#\2) (= n 2)] [(#\3) (= n 3)]
|
||||
[(#\p) (>= n 0)] [(#\m) (>= n 1)] [(#\c) (>= n 2)] [(#\x) (>= n 1)]
|
||||
[(#\u) (<= 0 n 1)] [(#\b) (<= 1 n 2)]
|
||||
[else #f]))
|
||||
|
||||
(define (xform-integrable ig tail env)
|
||||
|
|
@ -1143,6 +1144,18 @@
|
|||
(unless (null? (cdr args)) (write-char #\, port)))
|
||||
(do ([i 0 (fx+ i 1)]) [(fx>=? i opc)]
|
||||
(write-string igc0 port)))]
|
||||
[(#\u) ; 0 <= (length args) <= 1
|
||||
(if (null? args)
|
||||
(write-string (integrable-code ig 1) port)
|
||||
(codegen (car args) l f s g #f port))
|
||||
(write-string igc0 port)]
|
||||
[(#\b) ; 1 <= (length args) <= 2
|
||||
(if (null? (cdr args))
|
||||
(write-string (integrable-code ig 1) port)
|
||||
(codegen (cadr args) l f s g #f port))
|
||||
(write-char #\, port)
|
||||
(codegen (car args) (cons #f l) f s g #f port)
|
||||
(write-string igc0 port)]
|
||||
[else (error 'codegen "NYI: unsupported integrable type" igty)]))
|
||||
(when k (write-char #\] port) (write-serialized-arg k port))]
|
||||
[call (exp . args)
|
||||
|
|
|
|||
20
src/s.scm
20
src/s.scm
|
|
@ -608,14 +608,12 @@
|
|||
; Conversions
|
||||
;---------------------------------------------------------------------------------------------
|
||||
|
||||
(define-inline (fixnum->string x r) %residual-fixnum->string (%itos x r))
|
||||
|
||||
(define-inline (string->fixnum x r) %residual-string->fixnum (%stoi x r))
|
||||
|
||||
(define-inline (flonum->string x) %residual-flonum->string (%jtos x))
|
||||
|
||||
(define-inline (string->flonum x) %residual-string->flonum (%stoj x))
|
||||
; (fixnum->string x (r 10))
|
||||
; (string->fixnum x (r 10))
|
||||
; (flonum->string x)
|
||||
; (string->flonum x)
|
||||
|
||||
#|
|
||||
(define-syntax number->string
|
||||
(syntax-rules ()
|
||||
[(_ x r) (%ntos x r)]
|
||||
|
|
@ -629,7 +627,7 @@
|
|||
[(_ x) (%ston x 10)]
|
||||
[(_ . args) (%residual-string->number . args)]
|
||||
[_ %residual-string->number]))
|
||||
|
||||
|#
|
||||
|
||||
;---------------------------------------------------------------------------------------------
|
||||
; Control features
|
||||
|
|
@ -811,6 +809,7 @@
|
|||
; Output
|
||||
;---------------------------------------------------------------------------------------------
|
||||
|
||||
#|
|
||||
(define-syntax write-char
|
||||
(syntax-rules ()
|
||||
[(_ x) (%wrc x (%sop))]
|
||||
|
|
@ -859,6 +858,7 @@
|
|||
[(_ x p) (%wriw x p)]
|
||||
[(_ . args) (%residual-write-simple . args)]
|
||||
[_ %residual-write-simple]))
|
||||
|#
|
||||
|
||||
;flush-output-port
|
||||
|
||||
|
|
@ -1010,14 +1010,17 @@
|
|||
(define %residual-string-append (append-reducer string-append ""))
|
||||
(define %residual-vector-append (append-reducer vector-append '#()))
|
||||
|
||||
#|
|
||||
(define %residual-number->string (unary-binary-adaptor number->string))
|
||||
(define %residual-string->number (unary-binary-adaptor string->number))
|
||||
|#
|
||||
|
||||
(define %residual-read-char (nullary-unary-adaptor read-char))
|
||||
(define %residual-peek-char (nullary-unary-adaptor peek-char))
|
||||
(define %residual-char-ready? (nullary-unary-adaptor char-ready?))
|
||||
(define %residual-read-line (nullary-unary-adaptor read-line))
|
||||
|
||||
#|
|
||||
(define %residual-write-char (unary-binary-adaptor write-char))
|
||||
(define %residual-write-string (unary-binary-adaptor write-string))
|
||||
(define %residual-newline (nullary-unary-adaptor newline))
|
||||
|
|
@ -1025,3 +1028,4 @@
|
|||
(define %residual-write (unary-binary-adaptor write))
|
||||
(define %residual-write-simple (unary-binary-adaptor write-simple))
|
||||
(define %residual-write-shared (unary-binary-adaptor write-shared))
|
||||
|#
|
||||
|
|
|
|||
Loading…
Reference in a new issue