Miroirs/skint
1
0
Fork 0
mirror of https://github.com/false-schemers/skint.git synced 2024-12-26 21:58:51 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

void/tuples in values, call-with-values

Browse source 
(values) in improper context returns void, call-with-values breaks apart void and tuples
This commit is contained in:
ESL 2023-03-28 19:32:54 -04:00
parent 149827f452
commit 8002d8c7d0
3 changed files with 2118 additions and 2072 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

27
i.c
View file

@ -226,6 +226,8 @@ static void _sck(obj *s) {
#define box_ref(o) boxref(o) #define box_ref(o) boxref(o)
#define is_proc(o) isvmclo(o) #define is_proc(o) isvmclo(o)
#define is_tuple(o) (isrecord(o) && recordrtd(o) == 0) #define is_tuple(o) (isrecord(o) && recordrtd(o) == 0)
#define tuple_len(o) tuplelen(o)
#define tuple_ref(o, i) tupleref(o, i)
#define is_record(o) (isrecord(o) && recordrtd(o) != 0) #define is_record(o) (isrecord(o) && recordrtd(o) != 0)
#define record_rtd(o) recordrtd(o) #define record_rtd(o) recordrtd(o)
#define record_len(o) recordlen(o) #define record_len(o) recordlen(o)
@ -682,8 +684,16 @@ define_instruction(cwmv) {
define_instruction(rcmv) { define_instruction(rcmv) {
/* single-value producer call returns here with result in ac, cns on stack */ /* single-value producer call returns here with result in ac, cns on stack */
obj val = ac, x = spop(); obj val = ac, x = spop();
/* tail-call the consumer with the returned value */ /* tail-call the consumer with the returned value(s) */
spush(val); ac = fixnum_obj(1); if (is_void(val)) { /* (values) in improper context */
ac = fixnum_obj(0);
} else if (is_tuple(val)) { /* (values a1 a2 a ...) in improper context */
int n = tuple_len(val), i;
for (i = n-1; i >= 0; --i) spush(tuple_ref(val, i));
ac = fixnum_obj(n);
} else { /* regular single value */
spush(val); ac = fixnum_obj(1);
}
rd = x; rx = fixnum_obj(0); rd = x; rx = fixnum_obj(0);
callsubi(); callsubi();
} }
@ -705,7 +715,12 @@ define_instruction(sdmv) {
/* NB: can be sped up for popular cases: n == 0, n == 2 */ /* 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)); memmove((void*)(sp-n-m), (void*)(sp-n), (size_t)n*sizeof(obj));
sdrop(m); callsubi(); sdrop(m); callsubi();
} else { /* return args as a tuple (n != 1) */ } else if (n == 0) { /* return void (n = 0) */
ac = void_obj();
rx = spop();
rd = spop();
retfromi();
} else { /* return args as void (n = 0) or tuple (n > 1) */
hp_reserve(tuplebsz(n)); hp_reserve(tuplebsz(n));
for (i = n-1; i >= 0; --i) *--hp = sref(i); for (i = n-1; i >= 0; --i) *--hp = sref(i);
ac = hend_tuple(n); ac = hend_tuple(n);
@ -783,7 +798,11 @@ define_instruction(rck) {
if (c) memmove(sb+n, sp-c, c*sizeof(obj)); if (c) memmove(sb+n, sp-c, c*sizeof(obj));
memcpy(sb, ks, n*sizeof(obj)); memcpy(sb, ks, n*sizeof(obj));
sp = sb+n+c; callsubi(); sp = sb+n+c; callsubi();
} else { /* return args as a tuple (c != 1) */ } else if (c == 0) { /* return void (n = 0) */
spush(void_obj());
ac = rd;
goi(wckr);
} else { /* return args as tuple (n > 1) */
hp_reserve(tuplebsz(c)); hp_reserve(tuplebsz(c));
for (i = c-1; i >= 0; --i) *--hp = sref(i); for (i = c-1; i >= 0; --i) *--hp = sref(i);
ac = hend_tuple(c); ac = hend_tuple(c);

4151
n.c
View file

File diff suppressed because it is too large Load diff

12
src/n.sf
View file

@ -362,7 +362,7 @@ void *getnative(obj o, cxtype_t *tp) {
; but we don't really care. ; but we don't really care.
(define-inline (void) (%prim "void(0)")) (define-inline (void) (%prim "void(0)"))
(define-inline (void? x) (%prim "bool(obj_from_$arg == obj_from_void(0))" x))
; booleans ; booleans
@ -3402,6 +3402,8 @@ static void wrdatum(obj o, wenv_t *e) {
wrs(buf, e); wrs(buf, e);
} else if (iseof(o)) { } else if (iseof(o)) {
wrs(\"#<eof>\", e); wrs(\"#<eof>\", e);
} else if (o == obj_from_void(0)) {
wrs(\"#<void>\", e);
} else if (isiport(o)) { } else if (isiport(o)) {
char buf[60]; sprintf(buf, \"#<%s>\", ckiportvt(o)->tname); wrs(buf, e); char buf[60]; sprintf(buf, \"#<%s>\", ckiportvt(o)->tname); wrs(buf, e);
} else if (isoport(o)) { } else if (isoport(o)) {
@ -3478,8 +3480,12 @@ static void wrdatum(obj o, wenv_t *e) {
wrs(\"#&\", e); o = boxref(o); goto tail; wrs(\"#&\", e); o = boxref(o); goto tail;
} else if (isrecord(o)) { } else if (isrecord(o)) {
int i, n = recordlen(o); int i, n = recordlen(o);
wrs(\"#<record \", e); obj rtd = recordrtd(o);
wrdatum(recordrtd(o), e); // TODO: no need to show as shared! if (rtd == bool_from_obj(0)) {
wrs(\"#<tuple\", e);
} else {
wrs(\"#<record \", e); wrdatum(rtd, e); // TODO: no need to show as shared!
}
for (i = 0; i < n; ++i) { for (i = 0; i < n; ++i) {
wrc(' ', e); wrdatum(recordref(o, i), e); wrc(' ', e); wrdatum(recordref(o, i), e);
} }