mirror of
https://github.com/false-schemers/skint.git
synced 2024-11-16 07:47:54 +01:00
values/call-with-values implemented
This commit is contained in:
ESL
parent
1c5a6d0f45
commit
39c6a2bd34
6 changed files with 697 additions and 548 deletions
46
i.c
46
i.c
|
|
@ -4,9 +4,10 @@
|
|||
#include "i.h"
|
||||
|
||||
/* imports */
|
||||
extern obj cx_continuation_2Dclosure_2Dcode;
|
||||
extern obj cx__2Aglobals_2A;
|
||||
extern obj cx__2Atransformers_2A;
|
||||
extern obj cx_continuation_2Dclosure_2Dcode;
|
||||
extern obj cx_callmv_2Dadapter_2Dclosure;
|
||||
|
||||
#define istagged(o, t) istagged_inlined(o, t)
|
||||
|
||||
|
|
@ -391,6 +392,49 @@ define_instruction(appl) {
|
|||
callsubi();
|
||||
}
|
||||
|
||||
define_instruction(cwmv) {
|
||||
obj prd = ac, cns = spop();
|
||||
/* arrange return to cwmv code w/cns */
|
||||
spush(cns);
|
||||
spush(cx_callmv_2Dadapter_2Dclosure);
|
||||
spush(obj_from_fixnum(0));
|
||||
/* call the producer */
|
||||
rd = prd; rx = obj_from_fixnum(0); ac = obj_from_fixnum(0);
|
||||
callsubi();
|
||||
}
|
||||
|
||||
define_instruction(rcmv) {
|
||||
/* single-value producer call returns here with result in ac, cns on stack */
|
||||
obj val = ac, cns = spop();
|
||||
/* tail-call the consumer with the returned value */
|
||||
spush(val); ac = obj_from_fixnum(1);
|
||||
rd = cns; rx = obj_from_fixnum(0);
|
||||
callsubi();
|
||||
}
|
||||
|
||||
define_instruction(sdmv) {
|
||||
/* sending values on stack, ac contains argc */
|
||||
if (ac == obj_from_fixnum(1)) {
|
||||
/* can return anywhere, including rcmv */
|
||||
ac = spop();
|
||||
rx = spop();
|
||||
rd = spop();
|
||||
retfromi();
|
||||
} else {
|
||||
/* can only pseudo-return to rcmv */
|
||||
int n = fixnum_from_obj(ac), m = 3;
|
||||
if (sref(n) == obj_from_fixnum(0) && sref(n+1) == cx_callmv_2Dadapter_2Dclosure) {
|
||||
/* tail-call the consumer with the produced values */
|
||||
rd = sref(n+2); rx = obj_from_fixnum(0); /* cns */
|
||||
/* NB: can be sped up for popular cases: n == 0, n == 2 */
|
||||
memmove((void*)(sp-n-m), (void*)(sp-n), (size_t)n*sizeof(obj));
|
||||
sdrop(m); callsubi();
|
||||
} else {
|
||||
fail("multiple values returned to single value context");
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
define_instruction(save) {
|
||||
int dx = fixnum_from_obj(*ip++);
|
||||
spush(rd);
|
||||
|
|
|
|||
5
i.h
5
i.h
|
|
@ -57,6 +57,9 @@ declare_instruction(gset, "@!", 'g', NULL, 0, NULL)
|
|||
declare_instruction(conti, "K1", 0, NULL, 0, NULL)
|
||||
declare_instruction(nuate, "K2", 0, NULL, 0, NULL)
|
||||
declare_instruction(appl, "K3", 0, NULL, 0, NULL)
|
||||
declare_instruction(cwmv, "K4", 0, NULL, 0, NULL)
|
||||
declare_instruction(rcmv, "K5", 0, NULL, 0, NULL)
|
||||
declare_instruction(sdmv, "K6", 0, NULL, 0, NULL)
|
||||
declare_instruction(save, "$", 's', NULL, 0, NULL)
|
||||
declare_instruction(push, ",", 0, NULL, 0, NULL)
|
||||
declare_instruction(call, "[0", 1, NULL, 0, NULL)
|
||||
|
|
@ -470,6 +473,8 @@ declare_integrable(NULL, "dddd", 0, "%cddddr", 1, INLINED)
|
|||
/* globals */
|
||||
declare_integrable(NULL, NULL, 0, "%ccc", 1, "%1K1,.1[11")
|
||||
declare_integrable(NULL, NULL, 0, "%appl", 2, "%2_!K3")
|
||||
declare_integrable(NULL, NULL, 0, "%cwmv", 2, "%2_!K4")
|
||||
declare_integrable(NULL, NULL, 0, "%sdmv", -1, "K6")
|
||||
|
||||
#undef declare_instruction
|
||||
#undef declare_instrshadow
|
||||
|
|
|
|||
108
s.c
108
s.c
|
|
@ -1309,20 +1309,6 @@ char *s_code[] = {
|
|||
"l4:y12:syntax-rules;n;l2:py1:_;y4:args;;py5:list*;y4:args;;;l2:y1:_;y5"
|
||||
":list*;;",
|
||||
|
||||
"map",
|
||||
"l5:y12:syntax-rules;n;l2:l3:y1:_;y3:fun;y3:lst;;l3:y3:let;l1:l2:y1:f;y"
|
||||
"3:fun;;;l4:y3:let;y4:loop;l1:l2:y1:l;y3:lst;;;l4:y2:if;l2:y5:pair?;y1:"
|
||||
"l;;l3:y4:cons;l2:y1:f;l2:y4:%25car;y1:l;;;l2:y4:loop;l2:y4:%25cdr;y1:l"
|
||||
";;;;l2:y5:quote;n;;;;;;l2:py1:_;y4:args;;py13:%25residual-map;y4:args;"
|
||||
";;l2:y1:_;y13:%25residual-map;;",
|
||||
|
||||
"for-each",
|
||||
"l5:y12:syntax-rules;n;l2:l3:y1:_;y3:fun;y3:lst;;l3:y3:let;l1:l2:y1:f;y"
|
||||
"3:fun;;;l4:y3:let;y4:loop;l1:l2:y1:l;y3:lst;;;l3:y2:if;l2:y5:pair?;y1:"
|
||||
"l;;l3:y5:begin;l2:y1:f;l2:y4:%25car;y1:l;;;l2:y4:loop;l2:y4:%25cdr;y1:"
|
||||
"l;;;;;;;;l2:py1:_;y4:args;;py18:%25residual-for-each;y4:args;;;l2:y1:_"
|
||||
";y18:%25residual-for-each;;",
|
||||
|
||||
"vector?",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25vecp;y1:x;;;l2:py1:_;y"
|
||||
"12:syntax-rules;;py17:%25residual-vector?;y12:syntax-rules;;;l2:y1:_;y"
|
||||
|
|
@ -1628,6 +1614,56 @@ char *s_code[] = {
|
|||
"l4:y12:syntax-rules;n;l2:py1:_;y4:args;;py7:call/cc;y4:args;;;l2:y1:_;"
|
||||
"y7:call/cc;;",
|
||||
|
||||
"values",
|
||||
"l4:y12:syntax-rules;n;l2:py1:_;y4:args;;py5:%25sdmv;y4:args;;;l2:y1:_;"
|
||||
"y5:%25sdmv;;",
|
||||
|
||||
"call-with-values",
|
||||
"l4:y12:syntax-rules;n;l2:py1:_;y4:args;;py5:%25cwmv;y4:args;;;l2:y1:_;"
|
||||
"y5:%25cwmv;;",
|
||||
|
||||
"map",
|
||||
"l5:y12:syntax-rules;n;l2:l3:y1:_;y3:fun;y3:lst;;l3:y3:let;l1:l2:y1:f;y"
|
||||
"3:fun;;;l4:y3:let;y4:loop;l1:l2:y1:l;y3:lst;;;l4:y2:if;l2:y5:pair?;y1:"
|
||||
"l;;l3:y4:cons;l2:y1:f;l2:y4:%25car;y1:l;;;l2:y4:loop;l2:y4:%25cdr;y1:l"
|
||||
";;;;l2:y5:quote;n;;;;;;l2:py1:_;y4:args;;py13:%25residual-map;y4:args;"
|
||||
";;l2:y1:_;y13:%25residual-map;;",
|
||||
|
||||
"for-each",
|
||||
"l5:y12:syntax-rules;n;l2:l3:y1:_;y3:fun;y3:lst;;l3:y3:let;l1:l2:y1:f;y"
|
||||
"3:fun;;;l4:y3:let;y4:loop;l1:l2:y1:l;y3:lst;;;l3:y2:if;l2:y5:pair?;y1:"
|
||||
"l;;l3:y5:begin;l2:y1:f;l2:y4:%25car;y1:l;;;l2:y4:loop;l2:y4:%25cdr;y1:"
|
||||
"l;;;;;;;;l2:py1:_;y4:args;;py18:%25residual-for-each;y4:args;;;l2:y1:_"
|
||||
";y18:%25residual-for-each;;",
|
||||
|
||||
0,
|
||||
"&0{%!2.0u?{.2%sS3,'(c ),.1%kS2,'0,,#0.0,.3,.7,.9,.7,&5{%1:0%i,.1%iI<!?"
|
||||
"{:3]1}${.2%i,:1%sS4,:2[01}%c,.1%i,:3%sS5.0'1%i,.1%iI+,:4^[11}.!0.0^_1["
|
||||
"51}${@(y22:%25residual-string->list),${.5,.8c,,#0.4,.1,&2{%1.0p?{${.2d"
|
||||
",:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1,.4c,@(y13:%25residual-map)"
|
||||
",@(y5:%25appl)[02}%lX3]3}@!(y10:string-map)",
|
||||
|
||||
0,
|
||||
"&0{%!2.0u?{.2%vV3,f,.1%kV2,'0,,#0.0,.3,.8,.8,.7,&5{%1:0%i,.1%iI<!?{:3]"
|
||||
"1}${.2%i,:2%vV4,:1[01},.1%i,:3%vV5.0'1%i,.1%iI+,:4^[11}.!0.0^_1[51}${@"
|
||||
"(y22:%25residual-vector->list),${.5,.8c,,#0.4,.1,&2{%1.0p?{${.2d,:0^[0"
|
||||
"1},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1,.4c,@(y13:%25residual-map),@(y5:"
|
||||
"%25appl)[02}%lX1]3}@!(y10:vector-map)",
|
||||
|
||||
0,
|
||||
"&0{%!2.0u?{.2%sS3,'0,,#0.2,.6,.6,.3,&4{%1:3%i,.1%iI<!,.0?{.0]2}${.3%i,"
|
||||
":2%sS4,:1[01}.1'1%i,.2%iI+,:0^[21}.!0.0^_1[41}@(y22:%25residual-string"
|
||||
"->list),${.3,.6c,,#0.4,.1,&2{%1.0p?{${.2d,:0^[01},${.3a,:1[01}c]1}n]1}"
|
||||
".!0.0^_1[01}_1,.2c,@(y18:%25residual-for-each),@(y5:%25appl)[32}@!(y15"
|
||||
":string-for-each)",
|
||||
|
||||
0,
|
||||
"&0{%!2.0u?{.2%vV3,'0,,#0.2,.6,.6,.3,&4{%1:3%i,.1%iI<!,.0?{.0]2}${.3%i,"
|
||||
":2%vV4,:1[01}.1'1%i,.2%iI+,:0^[21}.!0.0^_1[41}@(y22:%25residual-vector"
|
||||
"->list),${.3,.6c,,#0.4,.1,&2{%1.0p?{${.2d,:0^[01},${.3a,:1[01}c]1}n]1}"
|
||||
".!0.0^_1[01}_1,.2c,@(y18:%25residual-for-each),@(y5:%25appl)[32}@!(y15"
|
||||
":vector-for-each)",
|
||||
|
||||
"input-port?",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y4:%25ipp;y1:x;;;l2:py1:_;y1"
|
||||
"2:syntax-rules;;py21:%25residual-input-port?;y12:syntax-rules;;;l2:y1:"
|
||||
|
|
@ -1644,14 +1680,6 @@ char *s_code[] = {
|
|||
0,
|
||||
"&0{%1.0P01]1}@!(y22:%25residual-output-port?)",
|
||||
|
||||
"eof-object?",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25eofp;y1:x;;;l2:py1:_;y"
|
||||
"12:syntax-rules;;py21:%25residual-eof-object?;y12:syntax-rules;;;l2:y1"
|
||||
":_;y21:%25residual-eof-object?;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0Y9]1}@!(y21:%25residual-eof-object?)",
|
||||
|
||||
"current-input-port",
|
||||
"l5:y12:syntax-rules;n;l2:l1:y1:_;;l1:y4:%25sip;;;l2:py1:_;y12:syntax-r"
|
||||
"ules;;py28:%25residual-current-input-port;y12:syntax-rules;;;l2:y1:_;y"
|
||||
|
|
@ -1732,6 +1760,14 @@ char *s_code[] = {
|
|||
0,
|
||||
"&0{%1.0%wP9]1}@!(y27:%25residual-get-output-string)",
|
||||
|
||||
"eof-object?",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25eofp;y1:x;;;l2:py1:_;y"
|
||||
"12:syntax-rules;;py21:%25residual-eof-object?;y12:syntax-rules;;;l2:y1"
|
||||
":_;y21:%25residual-eof-object?;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0Y9]1}@!(y21:%25residual-eof-object?)",
|
||||
|
||||
"write-char",
|
||||
"l6:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l3:y4:%25wrc;l2:y4:%25ckc;y1:x;"
|
||||
";l1:y4:%25sop;;;;l2:l3:y1:_;y1:x;y1:p;;l3:y4:%25wrc;l2:y4:%25ckc;y1:x;"
|
||||
|
|
@ -1871,34 +1907,6 @@ char *s_code[] = {
|
|||
",:1[01}c]1}n]1}.!0.0^_1[01}_1,:0^[11}]1}.!0.0^_1[31}@!(y18:%25residual"
|
||||
"-for-each)",
|
||||
|
||||
0,
|
||||
"&0{%!2.0u?{.2%sS3,'(c ),.1%kS2,'0,,#0.0,.3,.7,.9,.7,&5{%1:0%i,.1%iI<!?"
|
||||
"{:3]1}${.2%i,:1%sS4,:2[01}%c,.1%i,:3%sS5.0'1%i,.1%iI+,:4^[11}.!0.0^_1["
|
||||
"51}${@(y22:%25residual-string->list),${.5,.8c,,#0.4,.1,&2{%1.0p?{${.2d"
|
||||
",:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1,.4c,@(y13:%25residual-map)"
|
||||
",@(y5:%25appl)[02}%lX3]3}@!(y10:string-map)",
|
||||
|
||||
0,
|
||||
"&0{%!2.0u?{.2%vV3,f,.1%kV2,'0,,#0.0,.3,.8,.8,.7,&5{%1:0%i,.1%iI<!?{:3]"
|
||||
"1}${.2%i,:2%vV4,:1[01},.1%i,:3%vV5.0'1%i,.1%iI+,:4^[11}.!0.0^_1[51}${@"
|
||||
"(y22:%25residual-vector->list),${.5,.8c,,#0.4,.1,&2{%1.0p?{${.2d,:0^[0"
|
||||
"1},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1,.4c,@(y13:%25residual-map),@(y5:"
|
||||
"%25appl)[02}%lX1]3}@!(y10:vector-map)",
|
||||
|
||||
0,
|
||||
"&0{%!2.0u?{.2%sS3,'0,,#0.2,.6,.6,.3,&4{%1:3%i,.1%iI<!,.0?{.0]2}${.3%i,"
|
||||
":2%sS4,:1[01}.1'1%i,.2%iI+,:0^[21}.!0.0^_1[41}@(y22:%25residual-string"
|
||||
"->list),${.3,.6c,,#0.4,.1,&2{%1.0p?{${.2d,:0^[01},${.3a,:1[01}c]1}n]1}"
|
||||
".!0.0^_1[01}_1,.2c,@(y18:%25residual-for-each),@(y5:%25appl)[32}@!(y15"
|
||||
":string-for-each)",
|
||||
|
||||
0,
|
||||
"&0{%!2.0u?{.2%vV3,'0,,#0.2,.6,.6,.3,&4{%1:3%i,.1%iI<!,.0?{.0]2}${.3%i,"
|
||||
":2%vV4,:1[01}.1'1%i,.2%iI+,:0^[21}.!0.0^_1[41}@(y22:%25residual-vector"
|
||||
"->list),${.3,.6c,,#0.4,.1,&2{%1.0p?{${.2d,:0^[01},${.3a,:1[01}c]1}n]1}"
|
||||
".!0.0^_1[01}_1,.2c,@(y18:%25residual-for-each),@(y5:%25appl)[32}@!(y15"
|
||||
":vector-for-each)",
|
||||
|
||||
0,
|
||||
"&0{%!0.0,,#0.0,&1{%1.0u?{n]1}.0%pdu?{.0%pa]1}${.2%pd,:0^[01},.1%pa%lL6"
|
||||
"]1}.!0.0^_1[11}@!(y16:%25residual-append)",
|
||||
|
|
|
|||
3
src/k.sf
3
src/k.sf
|
|
@ -1133,6 +1133,9 @@
|
|||
; NB: 'nuate' restores stack with fn arg on top of return triple
|
||||
(define continuation-closure-code (decode "%1.0K2]1"))
|
||||
|
||||
; adapter closure for values/call-with-values pair
|
||||
(define callmv-adapter-closure (make-closure (decode "K5")))
|
||||
|
||||
(define install-global-lambdas
|
||||
(%prim "{ /* define install-global-lambdas */
|
||||
static obj c[] = { obj_from_objptr(vmcases+6) };
|
||||
|
|
|
|||
155
src/s.scm
155
src/s.scm
|
|
@ -463,24 +463,6 @@
|
|||
|
||||
(define-syntax cons* list*)
|
||||
|
||||
(define-syntax map
|
||||
(syntax-rules ()
|
||||
[(_ fun lst)
|
||||
(let ([f fun])
|
||||
(let loop ([l lst])
|
||||
(if (pair? l) (cons (f (%car l)) (loop (%cdr l))) '())))]
|
||||
[(_ . args) (%residual-map . args)]
|
||||
[_ %residual-map]))
|
||||
|
||||
(define-syntax for-each
|
||||
(syntax-rules ()
|
||||
[(_ fun lst)
|
||||
(let ([f fun])
|
||||
(let loop ([l lst])
|
||||
(if (pair? l) (begin (f (%car l)) (loop (%cdr l))))))]
|
||||
[(_ . args) (%residual-for-each . args)]
|
||||
[_ %residual-for-each]))
|
||||
|
||||
|
||||
;---------------------------------------------------------------------------------------------
|
||||
; Vectors
|
||||
|
|
@ -621,19 +603,57 @@
|
|||
[(_ . args) (%residual-apply . args)]
|
||||
[_ %residual-apply]))
|
||||
|
||||
|
||||
(define-syntax call/cc %ccc) ; (%ccc (%ckr1 k)) -- check for 1-arg proc?
|
||||
|
||||
(define-syntax call-with-current-continuation call/cc)
|
||||
|
||||
;map
|
||||
;string-map
|
||||
;vector-map
|
||||
;for-each
|
||||
;string-for-each
|
||||
;vector-for-each
|
||||
;values
|
||||
;call-with-values
|
||||
(define-syntax values %sdmv)
|
||||
|
||||
(define-syntax call-with-values %cwmv)
|
||||
|
||||
(define-syntax map
|
||||
(syntax-rules ()
|
||||
[(_ fun lst)
|
||||
(let ([f fun])
|
||||
(let loop ([l lst])
|
||||
(if (pair? l) (cons (f (%car l)) (loop (%cdr l))) '())))]
|
||||
[(_ . args) (%residual-map . args)]
|
||||
[_ %residual-map]))
|
||||
|
||||
(define-syntax for-each
|
||||
(syntax-rules ()
|
||||
[(_ fun lst)
|
||||
(let ([f fun])
|
||||
(let loop ([l lst])
|
||||
(if (pair? l) (begin (f (%car l)) (loop (%cdr l))))))]
|
||||
[(_ . args) (%residual-for-each . args)]
|
||||
[_ %residual-for-each]))
|
||||
|
||||
(define (string-map p s . s*)
|
||||
(if (null? s*)
|
||||
(let* ([len (string-length s)] [res (make-string len)])
|
||||
(do ([i 0 (fx+ i 1)]) [(fx>=? i len) res]
|
||||
(string-set! res i (p (string-ref s i)))))
|
||||
(list->string (apply map p (map string->list (cons s s*))))))
|
||||
|
||||
(define (vector-map p v . v*)
|
||||
(if (null? v*)
|
||||
(let* ([len (vector-length v)] [res (make-vector len)])
|
||||
(do ([i 0 (fx+ i 1)]) [(fx>=? i len) res]
|
||||
(vector-set! res i (p (vector-ref v i)))))
|
||||
(list->vector (apply map p (map vector->list (cons v v*))))))
|
||||
|
||||
(define (string-for-each p s . s*)
|
||||
(if (null? s*)
|
||||
(let ([len (string-length s)])
|
||||
(do ([i 0 (fx+ i 1)]) [(fx>=? i len)] (p (string-ref s i))))
|
||||
(apply for-each p (map string->list (cons s s*)))))
|
||||
|
||||
(define (vector-for-each p v . v*)
|
||||
(if (null? v*)
|
||||
(let ([len (vector-length v)])
|
||||
(do ([i 0 (fx+ i 1)]) [(fx>=? i len)] (p (vector-ref v i))))
|
||||
(apply for-each p (map vector->list (cons v v*)))))
|
||||
|
||||
|
||||
;---------------------------------------------------------------------------------------------
|
||||
|
|
@ -644,8 +664,6 @@
|
|||
|
||||
(define-inline (output-port? x) %residual-output-port? (%opp x))
|
||||
|
||||
(define-inline (eof-object? x) %residual-eof-object? (%eofp x))
|
||||
|
||||
(define-inline (current-input-port) %residual-current-input-port (%sip))
|
||||
|
||||
(define-inline (current-output-port) %residual-current-output-port (%sop))
|
||||
|
|
@ -666,6 +684,41 @@
|
|||
|
||||
(define-inline (get-output-string x) %residual-get-output-string (%gos (%ckw x)))
|
||||
|
||||
;call-with-port
|
||||
;call-with-input-file
|
||||
;call-with-output-file
|
||||
;port?
|
||||
;input-port-open?
|
||||
;output-port-open?
|
||||
;with-input-from-file
|
||||
;with-output-to-file
|
||||
;open-binary-input-file
|
||||
;open-binary-output-file
|
||||
;close-port
|
||||
;open-input-bytevector
|
||||
;open-output-bytevector
|
||||
;get-output-bytevector
|
||||
|
||||
|
||||
;---------------------------------------------------------------------------------------------
|
||||
; Input
|
||||
;---------------------------------------------------------------------------------------------
|
||||
|
||||
;read
|
||||
;read-char
|
||||
;peek-char
|
||||
;read-line
|
||||
;char-ready?
|
||||
;read-string
|
||||
;read-u8
|
||||
;peek-u8
|
||||
;u8-ready?
|
||||
;read-bytevector
|
||||
;read-bytevector!
|
||||
|
||||
(define-inline (eof-object? x) %residual-eof-object? (%eofp x))
|
||||
;eof-object
|
||||
|
||||
|
||||
;---------------------------------------------------------------------------------------------
|
||||
; Output
|
||||
|
|
@ -721,6 +774,24 @@
|
|||
[_ %residual-write-simple]))
|
||||
|
||||
|
||||
;---------------------------------------------------------------------------------------------
|
||||
; System interface
|
||||
;---------------------------------------------------------------------------------------------
|
||||
|
||||
;load
|
||||
;file-exists?
|
||||
;delete-file
|
||||
;command-line
|
||||
;exit
|
||||
;emergency-exit
|
||||
;get-environment-variable
|
||||
;get-environment-variables
|
||||
;current-second
|
||||
;current-jiffy
|
||||
;jiffies-per-second
|
||||
;features
|
||||
|
||||
|
||||
;---------------------------------------------------------------------------------------------
|
||||
; Residual versions of vararg procedures
|
||||
;---------------------------------------------------------------------------------------------
|
||||
|
|
@ -852,32 +923,6 @@
|
|||
(if (let lp ([l* l*]) (or (null? l*) (and (pair? (car l*)) (lp (cdr l*)))))
|
||||
(begin (apply p (map car l*)) (loop (map cdr l*)))))))
|
||||
|
||||
(define (string-map p s . s*)
|
||||
(if (null? s*)
|
||||
(let* ([len (string-length s)] [res (make-string len)])
|
||||
(do ([i 0 (fx+ i 1)]) [(fx>=? i len) res]
|
||||
(string-set! res i (p (string-ref s i)))))
|
||||
(list->string (apply map p (map string->list (cons s s*))))))
|
||||
|
||||
(define (vector-map p v . v*)
|
||||
(if (null? v*)
|
||||
(let* ([len (vector-length v)] [res (make-vector len)])
|
||||
(do ([i 0 (fx+ i 1)]) [(fx>=? i len) res]
|
||||
(vector-set! res i (p (vector-ref v i)))))
|
||||
(list->vector (apply map p (map vector->list (cons v v*))))))
|
||||
|
||||
(define (string-for-each p s . s*)
|
||||
(if (null? s*)
|
||||
(let ([len (string-length s)])
|
||||
(do ([i 0 (fx+ i 1)]) [(fx>=? i len)] (p (string-ref s i))))
|
||||
(apply for-each p (map string->list (cons s s*)))))
|
||||
|
||||
(define (vector-for-each p v . v*)
|
||||
(if (null? v*)
|
||||
(let ([len (vector-length v)])
|
||||
(do ([i 0 (fx+ i 1)]) [(fx>=? i len)] (p (vector-ref v i))))
|
||||
(apply for-each p (map vector->list (cons v v*)))))
|
||||
|
||||
(define-syntax append-reducer
|
||||
(syntax-rules ()
|
||||
[(_ f s)
|
||||
|
|
|
|||
Loading…
Reference in a new issue