adding copy and string.count

This commit is contained in:
JeffBezanson 2009-02-24 04:12:33 +00:00
parent 6c56120669
commit 115b2843fb
4 changed files with 66 additions and 26 deletions

View File

@ -633,19 +633,35 @@ value_t cvalue_copy(value_t v)
PUSH(v);
cvalue_t *cv = (cvalue_t*)ptr(v);
size_t nw = cv_nwords(cv);
value_t *pnv = alloc_words(nw);
cvalue_t *ncv = (cvalue_t*)alloc_words(nw);
v = POP(); cv = (cvalue_t*)ptr(v);
memcpy(pnv, cv, nw * sizeof(value_t));
memcpy(ncv, cv, nw * sizeof(value_t));
if (!isinlined(cv)) {
size_t len = cv_len(cv);
if (cv_isstr(cv)) len++;
void *data = malloc(len);
memcpy(data, cv_data(cv), len);
((cvalue_t*)pnv)->data = data;
autorelease((cvalue_t*)pnv);
ncv->data = malloc(len);
memcpy(ncv->data, cv_data(cv), len);
autorelease(ncv);
if (hasparent(cv)) {
ncv->type = (fltype_t*)(((uptrint_t)ncv->type) & ~CV_PARENT_BIT);
ncv->parent = NIL;
}
}
else {
ncv->data = &ncv->_space[0];
}
return tagptr(pnv, TAG_CVALUE);
return tagptr(ncv, TAG_CVALUE);
}
value_t fl_copy(value_t *args, u_int32_t nargs)
{
argcount("copy", nargs, 1);
if (iscons(args[0]) || isvector(args[0]))
lerror(ArgError, "copy: argument must be a leaf atom");
if (!iscvalue(args[0]))
return args[0];
return cvalue_copy(args[0]);
}
static void cvalue_init(fltype_t *type, value_t v, void *dest)
@ -828,6 +844,16 @@ value_t cbuiltin(char *name, builtin_t f)
*/
}
static builtinspec_t cvalues_builtin_info[] = {
{ "c-value", cvalue_new },
{ "typeof", cvalue_typeof },
{ "sizeof", cvalue_sizeof },
{ "builtin", fl_builtin },
{ "copy", fl_copy },
// todo: autorelease
{ NULL, NULL }
};
#define cv_intern(tok) tok##sym = symbol(#tok)
#define ctor_cv_intern(tok) \
cv_intern(tok);set(tok##sym, cbuiltin(#tok, cvalue_##tok))
@ -873,11 +899,7 @@ void cvalues_init()
cv_intern(union);
cv_intern(void);
set(symbol("c-value"), cbuiltin("c-value", cvalue_new));
set(symbol("typeof"), cbuiltin("typeof", cvalue_typeof));
set(symbol("sizeof"), cbuiltin("sizeof", cvalue_sizeof));
set(symbol("builtin"), cbuiltin("builtin", fl_builtin));
// todo: autorelease
assign_global_builtins(cvalues_builtin_info);
stringtypesym = symbol("*string-type*");
setc(stringtypesym, list2(arraysym, bytesym));

View File

@ -41,13 +41,29 @@ value_t fl_stringp(value_t *args, u_int32_t nargs)
return isstring(args[0]) ? FL_T : FL_F;
}
value_t fl_string_length(value_t *args, u_int32_t nargs)
value_t fl_string_count(value_t *args, u_int32_t nargs)
{
argcount("string.length", nargs, 1);
size_t start = 0;
if (nargs < 1 || nargs > 3)
argcount("string.count", nargs, 1);
if (!isstring(args[0]))
type_error("string.length", "string", args[0]);
type_error("string.count", "string", args[0]);
size_t len = cv_len((cvalue_t*)ptr(args[0]));
return size_wrap(u8_charnum(cvalue_data(args[0]), len));
size_t stop = len;
if (nargs > 1) {
start = toulong(args[1], "string.count");
if (start > len)
bounds_error("string.count", args[0], args[1]);
if (nargs > 2) {
stop = toulong(args[2], "string.count");
if (stop > len)
bounds_error("string.count", args[0], args[2]);
if (stop <= start)
return fixnum(0);
}
}
char *str = cvalue_data(args[0]);
return size_wrap(u8_charnum(str+start, stop-start));
}
value_t fl_string_reverse(value_t *args, u_int32_t nargs)
@ -371,7 +387,7 @@ value_t fl_numbertostring(value_t *args, u_int32_t nargs)
static builtinspec_t stringfunc_info[] = {
{ "string", fl_string },
{ "string?", fl_stringp },
{ "string.length", fl_string_length },
{ "string.count", fl_string_count },
{ "string.split", fl_string_split },
{ "string.sub", fl_string_sub },
{ "string.find", fl_string_find },

View File

@ -196,6 +196,8 @@
(get-defined-vars B)))
(f-body- e)))
(define-macro (body . forms) (f-body forms))
(define = eqv)
(define eql eqv)
(define (/= a b) (not (equal a b)))
@ -527,13 +529,13 @@
(define (load filename)
(let ((F (file filename :read)))
(trycatch
(prog1
(let next (E v)
(if (not (io.eof? F))
(next (read F)
(eval E))
v))
(io.close F))
(let next (prev E v)
(if (not (io.eof? F))
(next (read F)
prev
(eval E))
(begin (io.close F)
(eval E)))) ; evaluate last form in almost-tail position
(lambda (e)
(begin
(io.close F)

View File

@ -629,7 +629,7 @@ low-level functions:
- (cset cvalue key value) ; key is field name, index, or struct offset
. write&use conv_from_long to put fixnums into typed locations
. aset is the same
- (copy cv)
* (copy cv)
- (offset type|cvalue field [field ...])
- (eltype type field [field ...])
- (memcpy dest-cv src-cv)
@ -814,7 +814,7 @@ String API
*string - append/construct
*string.inc - (string.inc s i [nchars])
*string.dec
string.count - # of chars between 2 byte offsets
*string.count - # of chars between 2 byte offsets
string.width - # columns
*string.char - char at byte offset
*string.sub - substring between 2 byte offsets