ref: 26c804c008cf7c94bdb3eee4d22a5ff793d7baa8
parent: 1087dc1c5655914ea33507733bff7bd4535597e2
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Mon Apr 7 11:10:12 EDT 2025
combine cprims and cvalues, free up another tag value Clean up and refactor a bit. Implements: https://todo.sr.ht/~ft/sl/55
--- a/src/builtins.c
+++ b/src/builtins.c
@@ -83,8 +83,6 @@
argcount(nargs, 1);
sl_v a = args[0];
- sl_cv *cv;
-
if(iscons(a)){usize n = 0;
sl_v v = a, v2 = a;
@@ -102,11 +100,6 @@
}
if(isrune(a))
return fixnum(runelen(torune(a)));
- if(iscprim(a)){- cv = ptr(a);
- if(cp_class(cv) == sl_utf8type)
- return fixnum(1);
- }
if(iscvalue(a) && cv_class(ptr(a))->eltype != nil)
return size_wrap(cvalue_arrlen(a));
if(isvec(a))
@@ -226,13 +219,13 @@
{argcount(nargs, 1);
sl_v v = args[0];
- if(isfixnum(v) || isubnum(v) || ismp(v))
+ if(isfixnum(v) || isubnum(v))
return sl_t;
- if(iscprim(v)){- sl_numtype nt = cp_numtype(ptr(v));
+ if(iscvalue(v)){+ sl_numtype nt = cv_numtype(ptr(v));
if(nt < T_FLOAT)
return sl_t;
- void *data = cp_data(ptr(v));
+ void *data = cv_data(ptr(v));
if(nt == T_FLOAT){float f = *(float*)data;
if(f < 0)
@@ -256,8 +249,8 @@
{argcount(nargs, 1);
sl_v v = args[0];
- return (isfixnum(v) || isubnum(v) || ismp(v) ||
- (iscprim(v) && cp_numtype(ptr(v)) < T_FLOAT)) ?
+ return (isfixnum(v) || isubnum(v) ||
+ (iscvalue(v) && cv_numtype(ptr(v)) < T_FLOAT)) ?
sl_t : sl_nil;
}
@@ -276,16 +269,10 @@
return v;
if(isubnum(v))
return fixnum(ubnumval(v));
- if(iscprim(v)){- void *p = ptr(v);
- return fixnum(conv_to_s64(cp_data(p), cp_numtype(p)));
+ if(iscvalue(v)){+ sl_cv *p = ptr(v);
+ return fixnum(conv_to_s64(v, cv_data(p), cv_numtype(p)));
}
- if(ismp(v))
-#ifdef BITS64
- return fixnum(mptov(tomp(v)));
-#else
- return fixnum(mptoi(tomp(v)));
-#endif
type_error("num", v);}
@@ -293,28 +280,30 @@
{argcount(nargs, 1);
sl_v v = args[0];
- if(isfixnum(v) || isubnum(v) || ismp(v))
+ if(isfixnum(v) || isubnum(v))
return v;
- if(iscprim(v)){- sl_cprim *cp = ptr(v);
- void *data = cp_data(cp);
- sl_numtype nt = cp_numtype(cp);
+ if(iscvalue(v)){+ sl_cv *cv = ptr(v);
+ void *data = cv_data(cv);
+ sl_numtype nt = cv_numtype(cv);
double d;
- if(nt == T_FLOAT)
- d = (double)*(float*)data;
- else if(nt == T_DOUBLE)
- d = *(double*)data;
- else
- return v;
-
- if(d > 0){- if(d > (double)INT64_MAX)
+ if(valid_numtype(nt)){+ if(nt == T_FLOAT)
+ d = (double)*(float*)data;
+ else if(nt == T_DOUBLE)
+ d = *(double*)data;
+ else
return v;
- return return_from_u64((u64int)d);
+
+ if(d > 0){+ if(d > (double)INT64_MAX)
+ return v;
+ return return_from_u64((u64int)d);
+ }
+ if(d > (double)INT64_MAX || d < (double)INT64_MIN)
+ return args[0];
+ return return_from_s64((s64int)d);
}
- if(d > (double)INT64_MAX || d < (double)INT64_MIN)
- return args[0];
- return return_from_s64((s64int)d);
}
type_error("num", v);}
@@ -356,13 +345,11 @@
return numval(a);
if(isubnum(a))
return ubnumval(a);
- if(iscprim(a)){- sl_cprim *cp = ptr(a);
- sl_numtype nt = cp_numtype(cp);
- return conv_to_double(cp_data(cp), nt);
+ if(iscvalue(a)){+ sl_cv *cv = ptr(a);
+ sl_numtype nt = cv_numtype(cv);
+ return conv_to_double(a, cv_data(cv), nt);
}
- if(ismp(a))
- return conv_to_double(cv_data(ptr(a)), T_MP);
type_error("num", a);}
--- a/src/cvalues.c
+++ b/src/cvalues.c
@@ -80,22 +80,10 @@
add_finalizer(cv);
}
-static sl_v
-cprim(sl_type *type, usize sz)
-{- assert(!ismanaged((uintptr)type));
- assert(sz == type->size);
- sl_cprim *pcp = alloc_words(CPRIM_NWORDS+NWORDS(sz));
- pcp->type = type;
- return tagptr(pcp, TAG_CPRIM);
-}
-
sl_v
cvalue_(sl_type *type, usize sz, bool nofinalize)
{assert(type != nil);
- if(valid_numtype(type->numtype) && type->numtype != T_MP)
- return cprim(type, sz);
bool str = false;
if(type->eltype == sl_utf8type){@@ -205,18 +193,15 @@
{Rune r;
USED(type);
- if(isfixnum(a)){+ if(isfixnum(a))
r = numval(a);
- }else if(isrune(a)){+ else if(isrune(a))
r = torune(a);
- }else if(isubnum(a)){+ else if(iscvalue(a))
+ r = conv_to_u32(a, cv_data(ptr(a)), T_MP);
+ else if(isubnum(a)){sl_fx v = ubnumval(a);
- r = conv_to_u32(&v, ubnumtype(a));
- }else if(iscprim(a)){- sl_cprim *cp = ptr(a);
- r = conv_to_u32(cp_data(cp), cp_numtype(cp));
- }else if(ismp(a)){- r = conv_to_u32(cv_data(ptr(a)), T_MP);
+ r = conv_to_u32(a, &v, ubnumtype(a));
}else
type_error("num", a);*((Rune*)dest) = r;
@@ -232,12 +217,9 @@
n = (ctype)numval(a); \
}else if(isubnum(a)){ \sl_fx v = ubnumval(a); \
- n = (ctype)conv_to_##cnvt(&v, ubnumtype(a)); \
- }else if(iscprim(a)){ \- sl_cprim *cp = ptr(a); \
- n = (ctype)conv_to_##cnvt(cp_data(cp), cp_numtype(cp)); \
- }else if(ismp(a)){ \- n = (ctype)conv_to_##cnvt(cv_data(ptr(a)), T_MP); \
+ n = (ctype)conv_to_##cnvt(a, &v, ubnumtype(a)); \
+ }else if(iscvalue(a)){ \+ n = (ctype)conv_to_##cnvt(a, cv_data(ptr(a)), cv_numtype(ptr(a))); \
}else \
type_error("num", a); \*((ctype*)dest) = n; \
@@ -275,8 +257,8 @@
args = sl.sp-1; \
}else \
argcount(nargs, 1); \
- sl_v v = cprim(sl_##typenam##type, sizeof(ctype)); \
- cvalue_##ctype##_init(sl_##typenam##type, args[0], cp_data(ptr(v))); \
+ sl_v v = cvalue(sl_##typenam##type, sizeof(ctype)); \
+ cvalue_##ctype##_init(sl_##typenam##type, args[0], cvalue_data(v)); \
return v; \
}
@@ -296,8 +278,8 @@
cvalue_##ctype##_init(sl_##typenam##type, args[0], &u); \
v = (sl_fx)u<<TAG_EXT_BITS | tag<<4 | TAG_UNBOXED; \
}else{ \- v = cprim(sl_##typenam##type, sizeof(ctype)); \
- cvalue_##ctype##_init(sl_##typenam##type, args[0], cp_data(ptr(v))); \
+ v = cvalue(sl_##typenam##type, sizeof(ctype)); \
+ cvalue_##ctype##_init(sl_##typenam##type, args[0], cvalue_data(v)); \
} \
return v; \
}
@@ -306,8 +288,8 @@
sl_v \
mk_##typenam(ctype n) \
{ \- sl_v v = cprim(sl_##typenam##type, sizeof(n)); \
- *(ctype*)cp_data(ptr(v)) = n; \
+ sl_v v = cvalue(sl_##typenam##type, sizeof(n)); \
+ *(ctype*)cvalue_data(v) = n; \
return v; \
}
@@ -321,8 +303,8 @@
(sizeof(n) < sizeof(sl_v) || fits_bits(n, UNBOXED_BITS-1))){ \v = (sl_fx)n<<TAG_EXT_BITS | tag<<4 | TAG_UNBOXED; \
}else{ \- v = cprim(sl_##typenam##type, sizeof(n)); \
- *(ctype*)cp_data(ptr(v)) = n; \
+ v = cvalue(sl_##typenam##type, sizeof(n)); \
+ *(ctype*)cvalue_data(v) = n; \
} \
return v; \
}
@@ -356,15 +338,11 @@
n = vtomp(numval(a), nil);
else if(isubnum(a)){uintptr v = ubnumval(a);
- n = conv_to_mp(&v, ubnumtype(a));
+ n = conv_to_mp(a, &v, ubnumtype(a));
}else if(iscvalue(a)){sl_cv *cv = ptr(a);
void *p = cv_data(cv);
- n = conv_to_mp(p, cv_numtype(cv));
- }else if(iscprim(a)){- sl_cprim *cp = ptr(a);
- void *p = cp_data(cp);
- n = conv_to_mp(p, cp_numtype(cp));
+ n = conv_to_mp(a, p, cv_numtype(cv));
}else
type_error("num", a);*((mpint**)dest) = n;
@@ -418,11 +396,11 @@
return numval(n);
if(isubnum(n))
return ubnumval(n);
- if(iscprim(n)){- sl_cprim *cp = ptr(n);
+ if(iscvalue(n)){+ sl_cv *cv = ptr(n);
if(sizeof(usize) > 4)
- return conv_to_u64(cp_data(cp), cp_numtype(cp));
- return conv_to_u32(cp_data(cp), cp_numtype(cp));
+ return conv_to_u64(n, cv_data(cv), cv_numtype(cv));
+ return conv_to_u32(n, cv_data(cv), cv_numtype(cv));
}
type_error("num", n);}
@@ -434,11 +412,11 @@
return numval(n);
if(isubnum(n))
return ubnumval(n);
- if(iscprim(n)){- sl_cprim *cp = ptr(n);
+ if(iscvalue(n)){+ sl_cv *cv = ptr(n);
if(sizeof(usize) > 4)
- return conv_to_s64(cp_data(cp), cp_numtype(cp));
- return conv_to_s32(cp_data(cp), cp_numtype(cp));
+ return conv_to_s64(n, cv_data(cv), cv_numtype(cv));
+ return conv_to_s32(n, cv_data(cv), cv_numtype(cv));
}
type_error("num", n);}
@@ -644,12 +622,6 @@
return;
}
}
- if(iscprim(v)){- sl_cprim *pcp = ptr(v);
- *pdata = cp_data(pcp);
- *psz = cp_class(pcp)->size;
- return;
- }
type_error("plain-old-data", v);}
@@ -762,7 +734,6 @@
{argcount(nargs, 1);
return (isubnum(args[0]) ||
- iscprim(args[0]) ||
isrune(args[0]) ||
(iscvalue(args[0]) && cv_isPOD(ptr(args[0])))) ?
sl_t : sl_nil;
@@ -805,7 +776,7 @@
}else{cv = cvalue(ft, ft->size);
if(nargs == 2)
- cvalue_init(ft, args[1], cptr(cv));
+ cvalue_init(ft, args[1], cvalue_data(cv));
}
return cv;
}
@@ -869,7 +840,7 @@
return mk_rune(((Rune*)data)[index]);
sl_v el = cvalue(eltype, eltype->size);
- u8int *dest = cptr(el);
+ u8int *dest = cvalue_data(el);
memcpy(dest, data + index*eltype->size, eltype->size);
return el;
}
@@ -1033,7 +1004,6 @@
bool
num_to_ptr(sl_v a, sl_fx *pi, sl_numtype *pt, void **pp)
{- sl_cprim *cp;
sl_cv *cv;
if(isfixnum(a)){*pi = numval(a);
@@ -1045,11 +1015,6 @@
*pp = pi;
*pt = ubnumtype(a);
return true;
- }else if(iscprim(a)){- cp = ptr(a);
- *pp = cp_data(cp);
- *pt = cp_numtype(cp);
- return true;
}else if(iscvalue(a)){cv = ptr(a);
*pp = cv_data(cv);
@@ -1121,8 +1086,8 @@
if(!num_to_ptr(b, &bi, &tb, &bptr))
type_error("num", b);- da = conv_to_double(aptr, ta);
- db = conv_to_double(bptr, tb);
+ da = conv_to_double(a, aptr, ta);
+ db = conv_to_double(b, bptr, tb);
if(db == 0 && tb < T_FLOAT) // exact 0
divide_by_0_error();
@@ -1156,7 +1121,7 @@
mpdiv(*(mpint**)aptr, *(mpint**)bptr, x, nil);
return mk_mp(x);
}else{- b64 = conv_to_s64(bptr, tb);
+ b64 = conv_to_s64(b, bptr, tb);
if(b64 == 0)
goto div_error;
x = tb == T_U64 ? uvtomp(b64, nil) : vtomp(b64, nil);
@@ -1170,7 +1135,7 @@
goto div_error;
return return_from_u64(*(u64int*)aptr / *(u64int*)bptr);
}
- b64 = conv_to_s64(bptr, tb);
+ b64 = conv_to_s64(b, bptr, tb);
if(b64 < 0)
return return_from_s64(-(s64int)(*(u64int*)aptr / (u64int)(-b64)));
if(b64 == 0)
@@ -1180,17 +1145,17 @@
if(tb == T_U64){if(*(u64int*)bptr == 0)
goto div_error;
- a64 = conv_to_s64(aptr, ta);
+ a64 = conv_to_s64(a, aptr, ta);
if(a64 < 0)
return return_from_s64(-((s64int)((u64int)(-a64) / *(u64int*)bptr)));
return return_from_u64((u64int)a64 / *(u64int*)bptr);
}
- b64 = conv_to_s64(bptr, tb);
+ b64 = conv_to_s64(b, bptr, tb);
if(b64 == 0)
goto div_error;
- return return_from_s64(conv_to_s64(aptr, ta) / b64);
+ return return_from_s64(conv_to_s64(a, aptr, ta) / b64);
div_error:
divide_by_0_error();
}
@@ -1219,60 +1184,59 @@
bmp = *(mpint**)bptr;
resmp = mpnew(0);
}else{- bmp = conv_to_mp(bptr, tb);
+ bmp = conv_to_mp(b, bptr, tb);
resmp = bmp;
}
b64 = 0;
}else
- b64 = conv_to_s64(bptr, tb);
+ b64 = conv_to_s64(b, bptr, tb);
switch(opcode){case 0:
- switch(ta){- case T_S8: return fixnum(*(s8int *)aptr & (s8int )b64);
- case T_U8: return fixnum(*(u8int *)aptr & (u8int )b64);
- case T_S16: return fixnum(*(s16int*)aptr & (s16int)b64);
- case T_U16: return fixnum(*(u16int*)aptr & (u16int)b64);
- case T_S32: return mk_s32(*(s32int*)aptr & (s32int)b64);
- case T_U32: return mk_u32(*(u32int*)aptr & (u32int)b64);
- case T_S64: return mk_s64(*(s64int*)aptr & (s64int)b64);
- case T_U64: return mk_u64(*(u64int*)aptr & (u64int)b64);
- case T_MP: mpand(*(mpint**)aptr, bmp, resmp); return mk_mp(resmp);
- case T_FLOAT:
- case T_DOUBLE: assert(0);
+ switch(ta){+ case T_S8: return fixnum(*(s8int *)aptr & (s8int )b64);
+ case T_U8: return fixnum(*(u8int *)aptr & (u8int )b64);
+ case T_S16: return fixnum(*(s16int*)aptr & (s16int)b64);
+ case T_U16: return fixnum(*(u16int*)aptr & (u16int)b64);
+ case T_S32: return mk_s32(*(s32int*)aptr & (s32int)b64);
+ case T_U32: return mk_u32(*(u32int*)aptr & (u32int)b64);
+ case T_S64: return mk_s64(*(s64int*)aptr & (s64int)b64);
+ case T_U64: return mk_u64(*(u64int*)aptr & (u64int)b64);
+ case T_MP: mpand(*(mpint**)aptr, bmp, resmp); return mk_mp(resmp);
+ case T_FLOAT:
+ case T_DOUBLE: break;
}
break;
case 1:
- switch(ta){- case T_S8: return fixnum(*(s8int *)aptr | (s8int )b64);
- case T_U8: return fixnum(*(u8int *)aptr | (u8int )b64);
- case T_S16: return fixnum(*(s16int*)aptr | (s16int)b64);
- case T_U16: return fixnum(*(u16int*)aptr | (u16int)b64);
- case T_S32: return mk_s32(*(s32int*)aptr | (s32int)b64);
- case T_U32: return mk_u32(*(u32int*)aptr | (u32int)b64);
- case T_S64: return mk_s64(*(s64int*)aptr | (s64int)b64);
- case T_U64: return mk_u64(*(u64int*)aptr | (u64int)b64);
- case T_MP: mpor(*(mpint**)aptr, bmp, resmp); return mk_mp(resmp);
- case T_FLOAT:
- case T_DOUBLE: assert(0);
- }
+ switch(ta){+ case T_S8: return fixnum(*(s8int *)aptr | (s8int )b64);
+ case T_U8: return fixnum(*(u8int *)aptr | (u8int )b64);
+ case T_S16: return fixnum(*(s16int*)aptr | (s16int)b64);
+ case T_U16: return fixnum(*(u16int*)aptr | (u16int)b64);
+ case T_S32: return mk_s32(*(s32int*)aptr | (s32int)b64);
+ case T_U32: return mk_u32(*(u32int*)aptr | (u32int)b64);
+ case T_S64: return mk_s64(*(s64int*)aptr | (s64int)b64);
+ case T_U64: return mk_u64(*(u64int*)aptr | (u64int)b64);
+ case T_MP: mpor(*(mpint**)aptr, bmp, resmp); return mk_mp(resmp);
+ case T_FLOAT:
+ case T_DOUBLE: break;
+ }
break;
case 2:
- switch(ta){- case T_S8: return fixnum(*(s8int *)aptr ^ (s8int )b64);
- case T_U8: return fixnum(*(u8int *)aptr ^ (u8int )b64);
- case T_S16: return fixnum(*(s16int*)aptr ^ (s16int)b64);
- case T_U16: return fixnum(*(u16int*)aptr ^ (u16int)b64);
- case T_S32: return mk_s32(*(s32int*)aptr ^ (s32int)b64);
- case T_U32: return mk_u32(*(u32int*)aptr ^ (u32int)b64);
- case T_S64: return mk_s64(*(s64int*)aptr ^ (s64int)b64);
- case T_U64: return mk_u64(*(u64int*)aptr ^ (u64int)b64);
- case T_MP: mpxor(*(mpint**)aptr, bmp, resmp); return mk_mp(resmp);
- case T_FLOAT:
- case T_DOUBLE: assert(0);
+ switch(ta){+ case T_S8: return fixnum(*(s8int *)aptr ^ (s8int )b64);
+ case T_U8: return fixnum(*(u8int *)aptr ^ (u8int )b64);
+ case T_S16: return fixnum(*(s16int*)aptr ^ (s16int)b64);
+ case T_U16: return fixnum(*(u16int*)aptr ^ (u16int)b64);
+ case T_S32: return mk_s32(*(s32int*)aptr ^ (s32int)b64);
+ case T_U32: return mk_u32(*(u32int*)aptr ^ (u32int)b64);
+ case T_S64: return mk_s64(*(s64int*)aptr ^ (s64int)b64);
+ case T_U64: return mk_u64(*(u64int*)aptr ^ (u64int)b64);
+ case T_MP: mpxor(*(mpint**)aptr, bmp, resmp); return mk_mp(resmp);
+ case T_FLOAT:
+ case T_DOUBLE: break;
+ }
}
- }
- assert(0);
- return sl_nil;
+ abort();
}
BUILTIN("logand", logand)@@ -1327,8 +1291,6 @@
{argcount(nargs, 1);
sl_v a = args[0];
- sl_cprim *cp;
- int ta;
void *aptr;
if(isfixnum(a))
@@ -1335,21 +1297,18 @@
return fixnum(~numval(a));
if(isubnum(a))
return (~ubnumval(a) & ~0xff) | (a & 0xff);
- if(iscprim(a)){- cp = ptr(a);
- ta = cp_numtype(cp);
- aptr = cp_data(cp);
+ if(iscvalue(a)){+ sl_cv *cv = ptr(a);
+ sl_numtype ta = cv_numtype(cv);
+ aptr = cv_data(cv);
switch(ta){case T_S32: return mk_s32(~*(s32int*)aptr);
case T_U32: return mk_u32(~*(u32int*)aptr);
case T_S64: return mk_s64(~*(s64int*)aptr);
case T_U64: return mk_u64(~*(u64int*)aptr);
+ case T_MP:; mpint *m = mpnew(0); mpnot(*(mpint**)aptr, m); return mk_mp(m);
+ default: abort();
}
- }else if(ismp(a)){- aptr = cv_data(ptr(a));
- mpint *m = mpnew(0);
- mpnot(*(mpint**)aptr, m);
- return mk_mp(m);
}
type_error("int", a);}
@@ -1364,8 +1323,6 @@
{sl_fx n;
s64int accum;
- sl_cprim *cp;
- int ta;
mpint *mp;
void *aptr;
@@ -1385,10 +1342,14 @@
}else
return fits_fixnum(accum) ? fixnum(accum) : return_from_s64(accum);
}
- if(iscprim(a)){- cp = ptr(a);
- ta = cp_numtype(cp);
- aptr = cp_data(cp);
+ if(ismp(a)){+ aptr = cv_data(ptr(a));
+ mp = mpnew(0);
+ mpleft(*(mpint**)aptr, n, mp);
+ }else if(iscvalue(a)){+ sl_cv *cv = ptr(a);
+ sl_numtype ta = cv_numtype(cv);
+ aptr = cv_data(cv);
if(n < 0){n = -n;
switch(ta){@@ -1396,15 +1357,12 @@
case T_U32: return mk_u32((*(u32int*)aptr) >> n);
case T_S64: return mk_s64((*(s64int*)aptr) >> n);
case T_U64: return mk_u64((*(u64int*)aptr) >> n);
+ default: abort();
}
}else if(ta == T_U64)
return return_from_u64((*(u64int*)aptr)<<n);
else if(ta < T_FLOAT)
- return return_from_s64(conv_to_s64(aptr, ta)<<n);
- }else if(ismp(a)){- aptr = cv_data(ptr(a));
- mp = mpnew(0);
- mpleft(*(mpint**)aptr, n, mp);
+ return return_from_s64(conv_to_s64(a, aptr, ta)<<n);
}
if(mp != nil){n = mpsignif(mp);
--- a/src/equal.c
+++ b/src/equal.c
@@ -61,7 +61,7 @@
}
// strange comparisons are resolved arbitrarily but consistently.
-// ordering: num < cprim < function < vec < cvalue < symbol < cons
+// ordering: num < function < vec < cvalue < symbol < cons
static sl_v
bounded_compare(sl_v a, sl_v b, int bound, bool eq)
{@@ -80,7 +80,7 @@
case TAG_FIXNUM:
if(isfixnum(b))
return (sl_fx)a < (sl_fx)b ? fixnum(-1) : fixnum(1);
- if(isubnum(b) || iscprim(b) || (iscvalue(b) && (cv = ptr(b), valid_numtype(cv_numtype(cv)))))
+ if(isubnum(b) || (iscvalue(b) && (cv = ptr(b), valid_numtype(cv_numtype(cv)))))
return fixnum(numeric_compare(a, b, eq, true, false));
if(isrune(b))
return fixnum(1);
@@ -90,7 +90,7 @@
return fixnum(isrune(b) && a == b ? 0 : -1);
if(isrune(b))
return fixnum(1);
- if(isfixnum(b) || isubnum(b) || iscprim(b) || (iscvalue(b) && (cv = ptr(b), valid_numtype(cv_numtype(cv)))))
+ if(isfixnum(b) || isubnum(b) || (iscvalue(b) && (cv = ptr(b), valid_numtype(cv_numtype(cv)))))
return fixnum(numeric_compare(a, b, eq, true, false));
return fixnum(-1);
case TAG_SYM:
@@ -103,11 +103,6 @@
if(isvec(b))
return bounded_vec_compare(a, b, bound, eq);
break;
- case TAG_CPRIM:
- c = numeric_compare(a, b, eq, true, false);
- if(c != 2)
- return fixnum(c);
- break;
case TAG_CVALUE:
cv = ptr(a);
if(valid_numtype(cv_numtype(cv))){@@ -314,10 +309,8 @@
double d;
s64int i64;
}u;
- sl_numtype nt;
usize i, len;
sl_cv *cv;
- sl_cprim *cp;
void *data;
uintptr h = 0;
int tg = tag(a);
@@ -342,12 +335,6 @@
return inthash(a);
case TAG_SYM:
return ((sl_sym*)ptr(a))->hash;
- case TAG_CPRIM:
- cp = ptr(a);
- data = cp_data(cp);
- nt = cp_numtype(cp);
- u.d = conv_to_double(data, nt);
- return doublehash(u.i64);
case TAG_CVALUE:
cv = ptr(a);
data = cv_data(cv);
--- a/src/io.c
+++ b/src/io.c
@@ -297,7 +297,7 @@
n = ft->size;
}
sl_v cv = cvalue(ft, n);
- u8int *data = cptr(cv);
+ u8int *data = cvalue_data(cv);
usize got = ios_read(s, data, n);
if(got < n)
//lerrorf(sl_errio, "end of input reached");
--- a/src/operators.c
+++ b/src/operators.c
@@ -2,7 +2,7 @@
#include "operators.h"
mpint *
-conv_to_mp(void *data, sl_numtype tag)
+conv_to_mp(sl_v v, void *data, sl_numtype tag)
{ switch(tag){case T_S8: return itomp(*(s8int*)data, nil);
@@ -17,12 +17,12 @@
case T_FLOAT: return dtomp(*(float*)data, nil);
case T_DOUBLE: return dtomp(*(double*)data, nil);
}
- return mpzero;
+ type_error("num", v);}
sl_purefn
double
-conv_to_double(void *data, sl_numtype tag)
+conv_to_double(sl_v v, void *data, sl_numtype tag)
{double d;
switch(tag){@@ -42,7 +42,7 @@
case T_FLOAT: return *(float*)data;
case T_DOUBLE: return *(double*)data;
}
- return 0;
+ type_error("num", v);}
// FIXME sign with mpint
@@ -49,7 +49,7 @@
#define CONV_TO_INTTYPE(name, ctype) \
sl_purefn \
ctype \
-conv_to_##name(void *data, sl_numtype tag) \
+conv_to_##name(sl_v v, void *data, sl_numtype tag) \
{ \ switch(tag){ \case T_S8: return (ctype)*(s8int*)data; \
@@ -64,7 +64,7 @@
case T_FLOAT: return (ctype)*(float*)data; \
case T_DOUBLE: return (ctype)*(double*)data; \
} \
- return 0; \
+ type_error("num", v); \}
CONV_TO_INTTYPE(s64, s64int)
@@ -76,7 +76,7 @@
// first.
sl_purefn
u64int
-conv_to_u64(void *data, sl_numtype tag)
+conv_to_u64(sl_v v, void *data, sl_numtype tag)
{s64int s;
switch(tag){@@ -100,7 +100,7 @@
s = *(double*)data;
return s;
}
- return 0;
+ type_error("num", v);}
sl_purefn
@@ -152,8 +152,8 @@
if(atag == btag)
return cmp_same_lt(a, b, atag);
- double da = conv_to_double(a, atag);
- double db = conv_to_double(b, btag);
+ double da = conv_to_double(sl_nil, a, atag);
+ double db = conv_to_double(sl_nil, b, btag);
if(isnan(da) || isnan(db))
return false;
@@ -210,8 +210,8 @@
if(atag == btag && (!equalnans || atag < T_FLOAT))
return cmp_same_eq(a, b, atag);
- double da = conv_to_double(a, atag);
- double db = conv_to_double(b, btag);
+ double da = conv_to_double(sl_nil, a, atag);
+ double db = conv_to_double(sl_nil, b, btag);
if((int)atag >= T_FLOAT && (int)btag >= T_FLOAT){ if(equalnans){--- a/src/operators.h
+++ b/src/operators.h
@@ -1,15 +1,13 @@
#pragma once
-mpint *conv_to_mp(void *data, sl_numtype tag);
-double conv_to_double(void *data, sl_numtype tag);
+mpint *conv_to_mp(sl_v v, void *data, sl_numtype tag);
+double conv_to_double(sl_v v, void *data, sl_numtype tag);
+s64int conv_to_s64(sl_v v, void *data, sl_numtype tag);
+u64int conv_to_u64(sl_v v, void *data, sl_numtype tag);
+s32int conv_to_s32(sl_v v, void *data, sl_numtype tag);
+u32int conv_to_u32(sl_v v, void *data, sl_numtype tag);
bool cmp_same_lt(void *a, void *b, sl_numtype tag);
bool cmp_same_eq(void *a, void *b, sl_numtype tag);
bool cmp_lt(void *a, sl_numtype atag, void *b, sl_numtype btag);
bool cmp_eq(void *a, sl_numtype atag, void *b, sl_numtype btag, bool equalnans);
-
-s64int conv_to_s64(void *data, sl_numtype tag);
-u64int conv_to_u64(void *data, sl_numtype tag);
-s32int conv_to_s32(void *data, sl_numtype tag);
-u32int conv_to_u32(void *data, sl_numtype tag);
-Rune conv_to_Rune(void *data, sl_numtype tag);
--- a/src/print.c
+++ b/src/print.c
@@ -105,8 +105,6 @@
unsigned int i;
for(i = 0; i < vec_size(v); i++)
print_traverse(vec_elt(v, i));
- }else if(iscprim(v)){- // don't consider shared references to e.g. chars
}else if(isfn(v)){mark_cons(v);
sl_fn *f = ptr(v);
@@ -187,7 +185,7 @@
if(sl_isstr(v))
return cv_len(ptr(v)) < SMALL_STR_LEN;
return (
- isfixnum(v) || isunboxed(v) || isbuiltin(v) || iscprim(v) ||
+ isfixnum(v) || isunboxed(v) || isbuiltin(v) ||
v == sl_t || v == sl_nil || v == sl_eof || v == sl_void
);
}
@@ -487,12 +485,6 @@
}
}
break;
- case TAG_CPRIM:
- if(v == UNBOUND)
- outs(f, "#<undefined>");
- else
- cvalue_print(f, v);
- break;
case TAG_CVALUE:
case TAG_VEC:
case TAG_CONS:
@@ -787,7 +779,7 @@
// at this point, so int64 is big enough to capture everything.
sl_numtype nt = sym_to_numtype(type);
if(valid_numtype(nt)){- s64int i64 = conv_to_s64(data, nt);
+ s64int i64 = conv_to_s64(sl_nil, data, nt);
n = (weak || sl.print_princ)
? ios_printf(f, "%"PRId64, i64)
: ios_printf(f, "#%s(%"PRId64")", sym_name(type), i64);
@@ -880,7 +872,7 @@
cvalue_print(sl_ios *f, sl_v v)
{sl_cv *cv = ptr(v);
- void *data = cptr(v);
+ void *data = cvalue_data(v);
sl_v label;
if(cv_class(cv) == sl_builtintype){@@ -897,7 +889,7 @@
cv_class(cv)->vtable->print(v, f);
}else{sl_v type = cv_type(cv);
- usize len = iscprim(v) ? cv_class(cv)->size : cv_len(cv);
+ usize len = cv_len(cv);
cvalue_printdata(f, data, len, type, false);
}
}
--- a/src/sl.c
+++ b/src/sl.c
@@ -463,16 +463,6 @@
ng->binding = sl_relocate(ng->binding);
return nc;
}
- if(t == TAG_CPRIM){- sl_cprim *pcp = ptr(v);
- usize nw = CPRIM_NWORDS+NWORDS(cp_class(pcp)->size);
- sl_cprim *ncp = alloc_words(nw);
- while(nw--)
- ((sl_v*)ncp)[nw] = ((sl_v*)pcp)[nw];
- nc = tagptr(ncp, TAG_CPRIM);
- forward(v, nc);
- return nc;
- }
return v;
}
@@ -696,12 +686,10 @@
return true;
if(isubnum(v))
return true;
- if(iscprim(v)){- sl_cprim *c = ptr(v);
- return valid_numtype(c->type->numtype);
+ if(iscvalue(v)){+ sl_cv *cv = ptr(v);
+ return valid_numtype(cv->type->numtype);
}
- if(ismp(v))
- return true;
return false;
}
--- a/src/sl.h
+++ b/src/sl.h
@@ -12,7 +12,7 @@
enum {TAG_FIXNUM,
- TAG_CPRIM,
+ TAG_UNUSED,
TAG_FN,
TAG_VEC,
TAG_UNBOXED,
@@ -119,7 +119,6 @@
#define bothfixnums(x, y) (isfixnum(x) && isfixnum(y))
#define isvec(x) (tag(x) == TAG_VEC)
#define iscvalue(x) (tag(x) == TAG_CVALUE)
-#define iscprim(x) (tag(x) == TAG_CPRIM)
#define isunboxed(x) (tag(x) == TAG_UNBOXED)
// doesn't lead to other values
#define leafp(a) (((a)&TAG_NONLEAF_MASK) != TAG_NONLEAF_MASK)
@@ -327,11 +326,6 @@
}sl_aligned(8) sl_cv;
typedef struct {- sl_type *type;
- u8int _space[];
-}sl_aligned(8) sl_cprim;
-
-typedef struct {sl_v vals;
sl_v bcode;
sl_v env;
@@ -338,7 +332,6 @@
sl_v name;
}sl_aligned(8) sl_fn;
-#define CPRIM_NWORDS sizeof(sl_cprim)/sizeof(sl_v)
#define cv_class(cv) ((sl_type*)(((uintptr)((sl_cv*)cv)->type)&~(uintptr)3))
#define cv_len(cv) (((sl_cv*)(cv))->len)
#define cv_type(cv) (cv_class(cv)->type)
@@ -348,12 +341,6 @@
#define cvalue_data(v) cv_data((sl_cv*)ptr(v))
#define cvalue_len(v) cv_len((sl_cv*)ptr(v))
#define value2c(type, v) ((type)cvalue_data(v))
-#define cp_class(cp) (((sl_cprim*)(cp))->type)
-#define cp_type(cp) (cp_class(cp)->type)
-#define cp_numtype(cp) (cp_class(cp)->numtype)
-#define cp_data(cp) (((sl_cprim*)(cp))->_space)
-// WARNING: multiple evaluation!
-#define cptr(v) (iscprim(v) ? cp_data(ptr(v)) : cvalue_data(v))
#define cv_numtype(cv) (cv_class(cv)->numtype)
#define ismp(v) (iscvalue(v) && cv_numtype(ptr(v)) == T_MP)
--- a/src/sl_arith_any.h
+++ b/src/sl_arith_any.h
@@ -12,7 +12,6 @@
sl_v arg;
sl_numtype pt;
void *a;
- sl_cprim *cp;
sl_cv *cv;
u32int i, j;
@@ -24,10 +23,6 @@
u64 = ubnumval(arg);
a = &u64;
pt = ubnumtype(arg);
- }else if(iscprim(arg)){- cp = ptr(arg);
- a = cp_data(cp);
- pt = cp_numtype(cp);
}else if(iscvalue(arg)){cv = ptr(arg);
a = cv_data(cv);
@@ -96,12 +91,7 @@
MP_OP(Maccum, m, Maccum);
continue;
}
-
- if(iscprim(arg)){- cp = ptr(arg);
- a = cp_data(cp);
- pt = cp_numtype(cp);
- }else if(iscvalue(arg)){+ if(iscvalue(arg)){cv = ptr(arg);
a = cv_data(cv);
pt = cv_numtype(cv);
--- a/src/str.c
+++ b/src/str.c
@@ -350,15 +350,7 @@
num = numval(n);
else if(isubnum(n))
num = ubnumval(n);
- else if(iscprim(n)){- void *data = ptr(n);
- if(cp_numtype(data) < T_FLOAT)
- num = conv_to_u64(cp_data(data), cp_numtype(data));
- else if(radix != 10)
- lerrorf(sl_errarg, "invalid radix with floating point");
- else
- return fn_builtin_str(args, nargs);
- }else if(ismp(n)){+ else if(ismp(n)){if(radix != 16 && radix != 10 && radix != 8 && radix != 4 && radix != 2)
lerrorf(sl_errarg, "invalid radix with bignum");
mpint *i = tomp(n);
@@ -371,6 +363,14 @@
n = str_from_cstr(s);
MEM_FREE(s);
return n;
+ }else if(iscvalue(n)){+ sl_cv *data = ptr(n);
+ if(cv_numtype(data) < T_FLOAT)
+ num = conv_to_u64(n, cv_data(data), cv_numtype(data));
+ else if(radix != 10)
+ lerrorf(sl_errarg, "invalid radix with floating point");
+ else
+ return fn_builtin_str(args, nargs);
}else{ type_error("int", n);}
--- a/src/types.c
+++ b/src/types.c
@@ -20,12 +20,11 @@
bool isarr = iscons(t) && car_(t) == sl_arrsym && iscons(cdr_(t));
usize sz;
- if(isarr && !iscons(cdr_(cdr_(t)))){+ if(isarr && !iscons(cdr_(cdr_(t))))
// special case: incomplete array type
sz = 0;
- }else{+ else
sz = ctype_sizeof(t);
- }
ft = MEM_CALLOC(1, sizeof(sl_type));
assert(ft != nil);
--- a/src/vm.h
+++ b/src/vm.h
@@ -461,16 +461,16 @@
OP(OP_NANP) {sl_v v = sp[-1];
- if(!iscprim(v))
+ if(!iscvalue(v))
v = sl_nil;
else{- void *p = ptr(v);
- switch(cp_numtype(p)){+ sl_cv *p = ptr(v);
+ switch(cv_numtype(p)){case T_DOUBLE:
- v = isnan(*(double*)cp_data(p)) ? sl_t : sl_nil;
+ v = isnan(*(double*)cv_data(p)) ? sl_t : sl_nil;
break;
case T_FLOAT:
- v = isnan(*(float*)cp_data(p)) ? sl_t : sl_nil;
+ v = isnan(*(float*)cv_data(p)) ? sl_t : sl_nil;
break;
default:
v = sl_nil;
--
⑨