ref: 94273146b28f8860f017859f9a154b2804850324
parent: 4862587eaad8359a2471bcf4b7c8e7f735568ee7
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Tue Mar 28 22:42:36 EDT 2023
generate and use a full list of builtin functions
--- a/.gitignore
+++ b/.gitignore
@@ -12,3 +12,4 @@
boot.h
instructions.lsp
builtins.lsp
+builtin_fns.h
--- a/Makefile
+++ b/Makefile
@@ -33,11 +33,14 @@
.c.o:
${CC} -o $@ -c $< ${CFLAGS} -Iposix -Illt-flisp.o: flisp.c cvalues.c operators.c types.c flisp.h print.c read.c equal.c maxstack.inc opcodes.h
+flisp.o: flisp.c cvalues.c operators.c types.c flisp.h print.c read.c equal.c maxstack.inc opcodes.h builtin_fns.h
flmain.o: flmain.c boot.h flisp.h
boot.h: flisp.boot
sed 's,\\,\\\\,g;s,",\\",g;s,^,",g;s,$$,\\n",g' flisp.boot >$@
+
+builtin_fns.h:
+ sed -n 's/^BUILTIN[_]?\((".*\)/BUILTIN_FN\1/gp' *.c >$@ ${LLT}: ${MAKE} -C llt CFLAGS="${CFLAGS} -I../posix" CC="${CC}"--- a/builtins.c
+++ b/builtins.c
@@ -15,7 +15,7 @@
return n;
}
-static value_t fl_nconc(value_t *args, uint32_t nargs)
+BUILTIN("nconc", nconc) {if (nargs == 0)
return FL_NIL;
@@ -22,7 +22,7 @@
value_t lst, first=FL_NIL;
value_t *pcdr = &first;
cons_t *c;
- uint32_t i=0;
+ int i=0;
while (1) {lst = args[i++];
if (i >= nargs) break;
@@ -41,7 +41,7 @@
return first;
}
-static value_t fl_assq(value_t *args, uint32_t nargs)
+BUILTIN("assq", assq) { argcount("assq", nargs, 2);value_t item = args[0];
@@ -57,7 +57,7 @@
return FL_F;
}
-static value_t fl_memq(value_t *args, uint32_t nargs)
+BUILTIN("memq", memq) {value_t v;
cons_t *c;
@@ -69,7 +69,7 @@
return FL_F;
}
-static value_t fl_length(value_t *args, uint32_t nargs)
+BUILTIN("length", length) { argcount("length", nargs, 1);value_t a = args[0];
@@ -98,13 +98,13 @@
type_error("length", "sequence", a);}
-static value_t fl_f_raise(value_t *args, uint32_t nargs)
+BUILTIN("raise", raise) { argcount("raise", nargs, 1);fl_raise(args[0]);
}
-static value_t fl_exit(value_t *args, uint32_t nargs)
+BUILTIN("exit", exit) {if (nargs > 0)
exit(tofixnum(args[0], "exit"));
@@ -112,7 +112,7 @@
return FL_NIL;
}
-static value_t fl_symbol(value_t *args, uint32_t nargs)
+BUILTIN("symbol", symbol) { argcount("symbol", nargs, 1);if (!fl_isstring(args[0]))
@@ -120,7 +120,7 @@
return symbol(cvalue_data(args[0]));
}
-static value_t fl_keywordp(value_t *args, uint32_t nargs)
+BUILTIN("keyword?", keywordp) { argcount("keyword?", nargs, 1);return (issymbol(args[0]) &&
@@ -127,7 +127,7 @@
iskeyword((symbol_t*)ptr(args[0]))) ? FL_T : FL_F;
}
-static value_t fl_top_level_value(value_t *args, uint32_t nargs)
+BUILTIN("top-level-value", top_level_value) { argcount("top-level-value", nargs, 1);symbol_t *sym = tosymbol(args[0], "top-level-value");
@@ -136,7 +136,7 @@
return sym->binding;
}
-static value_t fl_set_top_level_value(value_t *args, uint32_t nargs)
+BUILTIN("set-top-level-value!", set_top_level_value) { argcount("set-top-level-value!", nargs, 2);symbol_t *sym = tosymbol(args[0], "set-top-level-value!");
@@ -158,7 +158,7 @@
extern symbol_t *symtab;
-value_t fl_global_env(value_t *args, uint32_t nargs)
+BUILTIN("environment", environment) {USED(args);
argcount("environment", nargs, 0);@@ -171,7 +171,7 @@
extern value_t QUOTE;
-static value_t fl_constantp(value_t *args, uint32_t nargs)
+BUILTIN("constant?", constantp) { argcount("constant?", nargs, 1);if (issymbol(args[0]))
@@ -184,7 +184,7 @@
return FL_T;
}
-static value_t fl_integer_valuedp(value_t *args, uint32_t nargs)
+BUILTIN("integer-valued?", integer_valuedp) { argcount("integer-valued?", nargs, 1);value_t v = args[0];
@@ -213,7 +213,7 @@
return FL_F;
}
-static value_t fl_integerp(value_t *args, uint32_t nargs)
+BUILTIN("integer?", integerp) { argcount("integer?", nargs, 1);value_t v = args[0];
@@ -222,7 +222,7 @@
FL_T : FL_F;
}
-static value_t fl_fixnum(value_t *args, uint32_t nargs)
+BUILTIN("fixnum", fixnum) { argcount("fixnum", nargs, 1); if (isfixnum(args[0])) {@@ -237,7 +237,7 @@
double trunc(double x);
-static value_t fl_truncate(value_t *args, uint32_t nargs)
+BUILTIN("truncate", truncate) { argcount("truncate", nargs, 1);if (isfixnum(args[0]))
@@ -266,7 +266,7 @@
type_error("truncate", "number", args[0]);}
-static value_t fl_vector_alloc(value_t *args, uint32_t nargs)
+BUILTIN("vector.alloc", vector_alloc) {fixnum_t i;
value_t f, v;
@@ -286,7 +286,7 @@
return v;
}
-static value_t fl_time_now(value_t *args, uint32_t nargs)
+BUILTIN("time.now", time_now) { argcount("time.now", nargs, 0);USED(args);
@@ -305,7 +305,7 @@
type_error(fname, "number", a);
}
-static value_t fl_time_string(value_t *args, uint32_t nargs)
+BUILTIN("time.string", time_string) { argcount("time.string", nargs, 1);double t = todouble(args[0], "time.string");
@@ -314,7 +314,7 @@
return string_from_cstr(buf);
}
-static value_t fl_time_fromstring(value_t *args, uint32_t nargs)
+BUILTIN("time.fromstring", time_fromstring) { argcount("time.fromstring", nargs, 1);char *ptr = tostring(args[0], "time.fromstring");
@@ -325,7 +325,7 @@
return mk_double(t);
}
-static value_t fl_path_cwd(value_t *args, uint32_t nargs)
+BUILTIN("path.cwd", path_cwd) {if (nargs > 1)
argcount("path.cwd", nargs, 1);@@ -340,7 +340,7 @@
return FL_T;
}
-static value_t fl_path_exists(value_t *args, uint32_t nargs)
+BUILTIN("path.exists?", path_existsp) { argcount("path.exists?", nargs, 1);char *path = tostring(args[0], "path.exists?");
@@ -347,7 +347,7 @@
return access(path, F_OK) == 0 ? FL_T : FL_F;
}
-static value_t fl_os_getenv(value_t *args, uint32_t nargs)
+BUILTIN("os.getenv", os_getenv) { argcount("os.getenv", nargs, 1);char *name = tostring(args[0], "os.getenv");
@@ -358,7 +358,7 @@
return cvalue_static_cstring(val);
}
-static value_t fl_os_setenv(value_t *args, uint32_t nargs)
+BUILTIN("os.setenv", os_setenv) { argcount("os.setenv", nargs, 2);char *name = tostring(args[0], "os.setenv");
@@ -375,7 +375,7 @@
return FL_T;
}
-static value_t fl_rand(value_t *args, uint32_t nargs)
+BUILTIN("rand", rand) {USED(args); USED(nargs);
fixnum_t r;
@@ -386,7 +386,7 @@
#endif
return fixnum(r);
}
-static value_t fl_rand32(value_t *args, uint32_t nargs)
+BUILTIN("rand.uint32", rand_uint32) {USED(args); USED(nargs);
uint32_t r = random();
@@ -396,104 +396,51 @@
return mk_uint32(r);
#endif
}
-static value_t fl_rand64(value_t *args, uint32_t nargs)
+BUILTIN("rand.uint64", rand_uint64) {USED(args); USED(nargs);
uint64_t r = (((uint64_t)random())<<32) | random();
return mk_uint64(r);
}
-static value_t fl_randd(value_t *args, uint32_t nargs)
+BUILTIN("rand.double", rand_double) {USED(args); USED(nargs);
return mk_double(rand_double());
}
-static value_t fl_randf(value_t *args, uint32_t nargs)
+BUILTIN("rand.float", rand_float) {USED(args); USED(nargs);
return mk_float(rand_float());
}
-#define MATH_FUNC_1ARG(name) \
-static value_t fl_##name(value_t *args, uint32_t nargs) \
+#define BUILTIN_(lname, cname) \
+BUILTIN(lname, cname) \
{ \- argcount(#name, nargs, 1); \
+ argcount(lname, nargs, 1); \
if (iscprim(args[0])) { \cprim_t *cp = (cprim_t*)ptr(args[0]); \
numerictype_t nt = cp_numtype(cp); \
if (nt == T_FLOAT) \
- return mk_float(name##f(*(float*)cp_data(cp))); \
+ return mk_float(cname##f(*(float*)cp_data(cp))); \
} \
- return mk_double(name(todouble(args[0], #name))); \
+ return mk_double(cname(todouble(args[0], lname))); \
}
-MATH_FUNC_1ARG(sqrt)
-MATH_FUNC_1ARG(exp)
-MATH_FUNC_1ARG(log)
-MATH_FUNC_1ARG(sin)
-MATH_FUNC_1ARG(cos)
-MATH_FUNC_1ARG(tan)
-MATH_FUNC_1ARG(asin)
-MATH_FUNC_1ARG(acos)
-MATH_FUNC_1ARG(atan)
+BUILTIN_("sqrt", sqrt)+BUILTIN_("exp", exp)+BUILTIN_("log", log)+BUILTIN_("sin", sin)+BUILTIN_("cos", cos)+BUILTIN_("tan", tan)+BUILTIN_("asin", asin)+BUILTIN_("acos", acos)+BUILTIN_("atan", atan)-extern void stringfuncs_init(void);
extern void table_init(void);
extern void iostream_init(void);
-static builtinspec_t builtin_info[] = {- { "environment", fl_global_env },- { "constant?", fl_constantp },- { "top-level-value", fl_top_level_value },- { "set-top-level-value!", fl_set_top_level_value },- { "raise", fl_f_raise },- { "exit", fl_exit },- { "symbol", fl_symbol },- { "keyword?", fl_keywordp },-
- { "fixnum", fl_fixnum },- { "truncate", fl_truncate },- { "integer?", fl_integerp },- { "integer-valued?", fl_integer_valuedp },- { "nconc", fl_nconc },- { "append!", fl_nconc },- { "assq", fl_assq },- { "memq", fl_memq },- { "length", fl_length },-
- { "vector.alloc", fl_vector_alloc },-
- { "time.now", fl_time_now },- { "time.string", fl_time_string },- { "time.fromstring", fl_time_fromstring },-
- { "rand", fl_rand },- { "rand.uint32", fl_rand32 },- { "rand.uint64", fl_rand64 },- { "rand.double", fl_randd },- { "rand.float", fl_randf },-
- { "sqrt", fl_sqrt },- { "exp", fl_exp },- { "log", fl_log },- { "sin", fl_sin },- { "cos", fl_cos },- { "tan", fl_tan },- { "asin", fl_asin },- { "acos", fl_acos },- { "atan", fl_atan },-
- { "path.cwd", fl_path_cwd },- { "path.exists?", fl_path_exists },-
- { "os.getenv", fl_os_getenv },- { "os.setenv", fl_os_setenv },- { nil, nil }-};
-
void builtins_init(void)
{- assign_global_builtins(builtin_info);
- stringfuncs_init();
table_init();
iostream_init();
}
--- a/cvalues.c
+++ b/cvalues.c
@@ -30,11 +30,6 @@
static void cvalue_init(fltype_t *type, value_t v, void *dest);
-// cvalues-specific builtins
-value_t cvalue_new(value_t *args, uint32_t nargs);
-value_t cvalue_sizeof(value_t *args, uint32_t nargs);
-value_t cvalue_typeof(value_t *args, uint32_t nargs);
-
// trigger unconditional GC after this many bytes are allocated
#define ALLOC_LIMIT_TRIGGER 67108864
@@ -271,7 +266,7 @@
num_init(double, double, T_DOUBLE)
#define num_ctor_init(typenam, ctype, tag) \
-value_t cvalue_##typenam(value_t *args, uint32_t nargs) \
+BUILTIN(#typenam, typenam) \
{ \ if (nargs==0) { PUSH(fixnum(0)); args = &Stack[SP-1]; } \value_t cp = cprim(typenam##type, sizeof(ctype)); \
@@ -377,7 +372,7 @@
return 0;
}
-value_t cvalue_enum(value_t *args, uint32_t nargs)
+BUILTIN("enum", enum) { argcount("enum", nargs, 2);value_t type = fl_list2(enumsym, args[0]);
@@ -467,10 +462,11 @@
return 0;
}
-value_t cvalue_array(value_t *args, uint32_t nargs)
+BUILTIN("array", array) {- size_t elsize, cnt, sz, i;
+ size_t elsize, cnt, sz;
value_t arg;
+ int i;
if (nargs < 1)
argcount("array", nargs, 1);@@ -605,7 +601,7 @@
type_error(fname, "plain-old-data", v);
}
-value_t cvalue_sizeof(value_t *args, uint32_t nargs)
+BUILTIN("sizeof", sizeof) { argcount("sizeof", nargs, 1); if (issymbol(args[0]) || iscons(args[0])) {@@ -617,7 +613,7 @@
return size_wrap(n);
}
-value_t cvalue_typeof(value_t *args, uint32_t nargs)
+BUILTIN("typeof", typeof) { argcount("typeof", nargs, 1); switch(tag(args[0])) {@@ -687,7 +683,7 @@
return tagptr(ncv, TAG_CVALUE);
}
-value_t fl_copy(value_t *args, uint32_t nargs)
+BUILTIN("copy", copy) { argcount("copy", nargs, 1);if (iscons(args[0]) || isvector(args[0]))
@@ -699,7 +695,7 @@
return cvalue_copy(args[0]);
}
-value_t fl_podp(value_t *args, uint32_t nargs)
+BUILTIN("plain-old-data?", plain_old_datap) { argcount("plain-old-data?", nargs, 1);return (iscprim(args[0]) ||
@@ -721,7 +717,7 @@
// this provides (1) a way to allocate values with a shared type for
// efficiency, (2) a uniform interface for allocating cvalues of any
// type, including user-defined.
-value_t cvalue_new(value_t *args, uint32_t nargs)
+BUILTIN("c-value", c_value) {if (nargs < 1 || nargs > 2)
argcount("c-value", nargs, 2);@@ -826,7 +822,7 @@
return args[2];
}
-value_t fl_builtin(value_t *args, uint32_t nargs)
+BUILTIN("builtin", builtin) { argcount("builtin", nargs, 1);symbol_t *name = tosymbol(args[0], "builtin");
@@ -852,43 +848,21 @@
return tagptr(cv, TAG_CVALUE);
}
-static value_t fl_logand(value_t *args, uint32_t nargs);
-static value_t fl_logior(value_t *args, uint32_t nargs);
-static value_t fl_logxor(value_t *args, uint32_t nargs);
-static value_t fl_lognot(value_t *args, uint32_t nargs);
-static value_t fl_ash(value_t *args, uint32_t nargs);
-
-static builtinspec_t cvalues_builtin_info[] = {- { "c-value", cvalue_new },- { "typeof", cvalue_typeof },- { "sizeof", cvalue_sizeof },- { "builtin", fl_builtin },- { "copy", fl_copy },- { "plain-old-data?", fl_podp },-
- { "logand", fl_logand },- { "logior", fl_logior },- { "logxor", fl_logxor },- { "lognot", fl_lognot },- { "ash", fl_ash },- // todo: autorelease
- { nil, nil }-};
-
#define cv_intern(tok) \
do{ \tok##sym = symbol(#tok); \
}while(0)
-#define ctor_cv_intern(tok, nt, ctype) \
- do{ \- symbol_t *s; \
- cv_intern(tok); \
- set(tok##sym, cbuiltin(#tok, cvalue_##tok)); \
- if (valid_numtype(nt)) { \- s = ptr(tok##sym); \
- s->numtype = nt; \
- s->size = sizeof(ctype); \
- s->align = sizeof(struct{char c; ctype x;}) - sizeof(ctype); \+
+#define ctor_cv_intern(tok, nt, ctype) \
+ do{ \+ symbol_t *s; \
+ cv_intern(tok); \
+ set(tok##sym, cbuiltin(#tok, fn_builtin_##tok)); \
+ if (valid_numtype(nt)) { \+ s = ptr(tok##sym); \
+ s->numtype = nt; \
+ s->size = sizeof(ctype); \
+ s->align = offsetof(struct{char c; ctype x;}, x); \} \
}while(0)
@@ -898,76 +872,6 @@
name##type->init = cvalue_##ctype##_init; \
}while(0)
-static void cvalues_init(void)
-{- htable_new(&TypeTable, 256);
- htable_new(&reverse_dlsym_lookup_table, 256);
-
- builtintype = define_opaque_type(builtinsym, sizeof(builtin_t), nil, nil);
-
- ctor_cv_intern(int8, T_INT8, int8_t);
- ctor_cv_intern(uint8, T_UINT8, uint8_t);
- ctor_cv_intern(int16, T_INT16, int16_t);
- ctor_cv_intern(uint16, T_UINT16, uint16_t);
- ctor_cv_intern(int32, T_INT32, int32_t);
- ctor_cv_intern(uint32, T_UINT32, uint32_t);
- ctor_cv_intern(int64, T_INT64, int64_t);
- ctor_cv_intern(uint64, T_UINT64, uint64_t);
- ctor_cv_intern(byte, T_UINT8, uint8_t);
- ctor_cv_intern(wchar, T_INT32, int32_t);
-#if defined(ULONG64)
- ctor_cv_intern(long, T_INT64, int64_t);
- ctor_cv_intern(ulong, T_UINT64, uint64_t);
-#else
- ctor_cv_intern(long, T_INT32, int32_t);
- ctor_cv_intern(ulong, T_UINT32, uint32_t);
-#endif
- ctor_cv_intern(float, T_FLOAT, float);
- ctor_cv_intern(double, T_DOUBLE, double);
-
- ctor_cv_intern(array, NONNUMERIC, int);
- ctor_cv_intern(enum, NONNUMERIC, int);
- cv_intern(pointer);
- cv_intern(struct);
- cv_intern(union);
- cv_intern(void);
- cfunctionsym = symbol("c-function");-
- assign_global_builtins(cvalues_builtin_info);
-
- stringtypesym = symbol("*string-type*");- setc(stringtypesym, fl_list2(arraysym, bytesym));
-
- wcstringtypesym = symbol("*wcstring-type*");- setc(wcstringtypesym, fl_list2(arraysym, wcharsym));
-
- mk_primtype(int8, int8_t);
- mk_primtype(uint8, uint8_t);
- mk_primtype(int16, int16_t);
- mk_primtype(uint16, uint16_t);
- mk_primtype(int32, int32_t);
- mk_primtype(uint32, uint32_t);
- mk_primtype(int64, int64_t);
- mk_primtype(uint64, uint64_t);
-#if defined(ULONG64)
- mk_primtype(long, int64_t);
- mk_primtype(ulong, uint64_t);
-#else
- mk_primtype(long, int32_t);
- mk_primtype(ulong, uint32_t);
-#endif
- mk_primtype(byte, uint8_t);
- mk_primtype(wchar, int32_t);
- mk_primtype(float, float);
- mk_primtype(double, double);
-
- stringtype = get_type(symbol_value(stringtypesym));
- wcstringtype = get_type(symbol_value(wcstringtypesym));
-
- emptystringsym = symbol("*empty-string*");- setc(emptystringsym, cvalue_static_cstring(""));-}
-
#define RETURN_NUM_AS(var, type) return(mk_##type(var))
value_t return_from_uint64(uint64_t Uaccum)
@@ -1370,7 +1274,7 @@
return NIL;
}
-static value_t fl_logand(value_t *args, uint32_t nargs)
+BUILTIN("logand", logand) {value_t v, e;
int i;
@@ -1386,7 +1290,7 @@
return v;
}
-static value_t fl_logior(value_t *args, uint32_t nargs)
+BUILTIN("logior", logior) {value_t v, e;
int i;
@@ -1402,7 +1306,7 @@
return v;
}
-static value_t fl_logxor(value_t *args, uint32_t nargs)
+BUILTIN("logxor", logxor) {value_t v, e;
int i;
@@ -1418,7 +1322,7 @@
return v;
}
-static value_t fl_lognot(value_t *args, uint32_t nargs)
+BUILTIN("lognot", lognot) { argcount("lognot", nargs, 1);value_t a = args[0];
@@ -1446,7 +1350,7 @@
type_error("lognot", "integer", a);}
-static value_t fl_ash(value_t *args, uint32_t nargs)
+BUILTIN("ash", ash) {fixnum_t n;
int64_t accum;
@@ -1493,4 +1397,72 @@
}
}
type_error("ash", "integer", a);+}
+
+static void cvalues_init(void)
+{+ htable_new(&TypeTable, 256);
+ htable_new(&reverse_dlsym_lookup_table, 256);
+
+ builtintype = define_opaque_type(builtinsym, sizeof(builtin_t), nil, nil);
+
+ ctor_cv_intern(int8, T_INT8, int8_t);
+ ctor_cv_intern(uint8, T_UINT8, uint8_t);
+ ctor_cv_intern(int16, T_INT16, int16_t);
+ ctor_cv_intern(uint16, T_UINT16, uint16_t);
+ ctor_cv_intern(int32, T_INT32, int32_t);
+ ctor_cv_intern(uint32, T_UINT32, uint32_t);
+ ctor_cv_intern(int64, T_INT64, int64_t);
+ ctor_cv_intern(uint64, T_UINT64, uint64_t);
+ ctor_cv_intern(byte, T_UINT8, uint8_t);
+ ctor_cv_intern(wchar, T_INT32, int32_t);
+#if defined(ULONG64)
+ ctor_cv_intern(long, T_INT64, int64_t);
+ ctor_cv_intern(ulong, T_UINT64, uint64_t);
+#else
+ ctor_cv_intern(long, T_INT32, int32_t);
+ ctor_cv_intern(ulong, T_UINT32, uint32_t);
+#endif
+ ctor_cv_intern(float, T_FLOAT, float);
+ ctor_cv_intern(double, T_DOUBLE, double);
+
+ ctor_cv_intern(array, NONNUMERIC, int);
+ ctor_cv_intern(enum, NONNUMERIC, int);
+ cv_intern(pointer);
+ cv_intern(struct);
+ cv_intern(union);
+ cv_intern(void);
+ cfunctionsym = symbol("c-function");+
+ stringtypesym = symbol("*string-type*");+ setc(stringtypesym, fl_list2(arraysym, bytesym));
+
+ wcstringtypesym = symbol("*wcstring-type*");+ setc(wcstringtypesym, fl_list2(arraysym, wcharsym));
+
+ mk_primtype(int8, int8_t);
+ mk_primtype(uint8, uint8_t);
+ mk_primtype(int16, int16_t);
+ mk_primtype(uint16, uint16_t);
+ mk_primtype(int32, int32_t);
+ mk_primtype(uint32, uint32_t);
+ mk_primtype(int64, int64_t);
+ mk_primtype(uint64, uint64_t);
+#if defined(ULONG64)
+ mk_primtype(long, int64_t);
+ mk_primtype(ulong, uint64_t);
+#else
+ mk_primtype(long, int32_t);
+ mk_primtype(ulong, uint32_t);
+#endif
+ mk_primtype(byte, uint8_t);
+ mk_primtype(wchar, int32_t);
+ mk_primtype(float, float);
+ mk_primtype(double, double);
+
+ stringtype = get_type(symbol_value(stringtypesym));
+ wcstringtype = get_type(symbol_value(wcstringtypesym));
+
+ emptystringsym = symbol("*empty-string*");+ setc(emptystringsym, cvalue_static_cstring(""));}
--- a/equal.c
+++ b/equal.c
@@ -384,7 +384,7 @@
return n;
}
-value_t fl_hash(value_t *args, uint32_t nargs)
+BUILTIN("hash", hash) { argcount("hash", nargs, 1);return fixnum(hash_lispvalue(args[0]));
--- a/flisp.c
+++ b/flisp.c
@@ -238,7 +238,7 @@
// gensym names available at a time, mostly for compare()
static char gsname[2][16];
static int gsnameno=0;
-value_t fl_gensym(value_t *args, uint32_t nargs)
+BUILTIN("gensym", gensym) { argcount("gensym", nargs, 0);USED(args);
@@ -250,12 +250,12 @@
return tagptr(gs, TAG_SYM);
}
-int fl_isgensym(value_t v)
+value_t gensym(void)
{- return isgensym(v);
+ return fn_builtin_gensym(nil, 0);
}
-static value_t fl_gensymp(value_t *args, uint32_t nargs)
+BUILTIN("gensym?", gensymp) { argcount("gensym?", nargs, 1);return isgensym(args[0]) ? FL_T : FL_F;
@@ -1793,18 +1793,10 @@
// builtins -------------------------------------------------------------------
-void assign_global_builtins(builtinspec_t *b)
+BUILTIN("function", function) {- while (b->name != nil) {- setc(symbol(b->name), cbuiltin(b->name, b->fptr));
- b++;
- }
-}
-
-static value_t fl_function(value_t *args, uint32_t nargs)
-{if (nargs == 1 && issymbol(args[0]))
- return fl_builtin(args, nargs);
+ return fn_builtin_builtin(args, nargs);
if (nargs < 2 || nargs > 4)
argcount("function", nargs, 2);if (!fl_isstring(args[0]))
@@ -1856,7 +1848,7 @@
return fv;
}
-static value_t fl_function_code(value_t *args, uint32_t nargs)
+BUILTIN("function:code", function_code) { argcount("function:code", nargs, 1);value_t v = args[0];
@@ -1863,7 +1855,7 @@
if (!isclosure(v)) type_error("function:code", "function", v);return fn_bcode(v);
}
-static value_t fl_function_vals(value_t *args, uint32_t nargs)
+BUILTIN("function:vals", function_vals) { argcount("function:vals", nargs, 1);value_t v = args[0];
@@ -1870,7 +1862,7 @@
if (!isclosure(v)) type_error("function:vals", "function", v);return fn_vals(v);
}
-static value_t fl_function_env(value_t *args, uint32_t nargs)
+BUILTIN("function:env", function_env) { argcount("function:env", nargs, 1);value_t v = args[0];
@@ -1877,7 +1869,7 @@
if (!isclosure(v)) type_error("function:env", "function", v);return fn_env(v);
}
-static value_t fl_function_name(value_t *args, uint32_t nargs)
+BUILTIN("function:name", function_name) { argcount("function:name", nargs, 1);value_t v = args[0];
@@ -1885,13 +1877,13 @@
return fn_name(v);
}
-value_t fl_copylist(value_t *args, uint32_t nargs)
+BUILTIN("copy-list", copy_list) { argcount("copy-list", nargs, 1);return copy_list(args[0]);
}
-value_t fl_append(value_t *args, uint32_t nargs)
+BUILTIN("append", append) {if (nargs == 0)
return NIL;
@@ -1898,7 +1890,7 @@
value_t first=NIL, lst, lastcons=NIL;
fl_gc_handle(&first);
fl_gc_handle(&lastcons);
- uint32_t i=0;
+ int i = 0;
while (1) {lst = args[i++];
if (i >= nargs) break;
@@ -1922,7 +1914,7 @@
return first;
}
-value_t fl_liststar(value_t *args, uint32_t nargs)
+BUILTIN("list*", liststar) {if (nargs == 1) return args[0];
else if (nargs == 0) argcount("list*", nargs, 1);@@ -1929,7 +1921,7 @@
return list(args, nargs, 1);
}
-value_t fl_stacktrace(value_t *args, uint32_t nargs)
+BUILTIN("stacktrace", stacktrace) {USED(args);
argcount("stacktrace", nargs, 0);@@ -1936,7 +1928,7 @@
return _stacktrace(fl_throwing_frame ? fl_throwing_frame : curr_frame);
}
-value_t fl_map1(value_t *args, uint32_t nargs)
+BUILTIN("map", map) {if (nargs < 2)
lerrorf(ArgError, "map: too few arguments");
@@ -1971,7 +1963,7 @@
fl_free_gc_handles(2);
}
else {- size_t i;
+ int i;
while (SP+nargs+1 > N_STACK) grow_stack();
PUSH(Stack[argSP]);
for(i=1; i < nargs; i++) {@@ -2005,21 +1997,14 @@
return first;
}
-static builtinspec_t core_builtin_info[] = {- { "function", fl_function },- { "function:code", fl_function_code },- { "function:vals", fl_function_vals },- { "function:env", fl_function_env },- { "function:name", fl_function_name },- { "stacktrace", fl_stacktrace },- { "gensym", fl_gensym },- { "gensym?", fl_gensymp },- { "hash", fl_hash },- { "copy-list", fl_copylist },- { "append", fl_append },- { "list*", fl_liststar },- { "map", fl_map1 },- { nil, nil }+#define BUILTIN_FN(l,c) extern BUILTIN(l,c);
+#include "builtin_fns.h"
+#undef BUILTIN_FN
+
+static const builtinspec_t builtin_fns[] = {+#define BUILTIN_FN(l,c) {l,fn_builtin_##c},+#include "builtin_fns.h"
+#undef BUILTIN_FN
};
// initialization -------------------------------------------------------------
@@ -2113,8 +2098,9 @@
memory_exception_value = fl_list2(MemoryError,
cvalue_static_cstring("out of memory"));-
- assign_global_builtins(core_builtin_info);
+ const builtinspec_t *b;
+ for(i = 0, b = builtin_fns; i < nelem(builtin_fns); i++, b++)
+ setc(symbol(b->name), cbuiltin(b->name, b->fptr));
builtins_init();
}
--- a/flisp.h
+++ b/flisp.h
@@ -127,6 +127,7 @@
#define ismanaged(v) ((((uint8_t*)ptr(v)) >= fromspace) && \
(((uint8_t*)ptr(v)) < fromspace+heapsize))
#define isgensym(x) (issymbol(x) && ismanaged(x))
+value_t gensym(void);
#define isfunction(x) (tag(x) == TAG_FUNCTION && (x) > (N_BUILTINS<<3))
#define isclosure(x) isfunction(x)
@@ -139,7 +140,7 @@
// i=index, i0=start index, arg = var for each arg, args = arg array
// assumes "nargs" is the argument count
#define FOR_ARGS(i, i0, arg, args) \
- for(i=i0; ((size_t)i)<nargs && ((arg=args[i]) || 1); i++)
+ for(i=i0; i<nargs && ((arg=args[i]) || 1); i++)
#define N_BUILTINS ((int)N_OPCODES)
@@ -309,8 +310,11 @@
#define cptr(v) \
(iscprim(v) ? cp_data((cprim_t*)ptr(v)) : cv_data((cvalue_t*)ptr(v)))
-typedef value_t (*builtin_t)(value_t*, uint32_t);
+#define BUILTIN(lname, cname) \
+ value_t fn_builtin_##cname(value_t *args, int nargs)
+typedef value_t (*builtin_t)(value_t*, int);
+
extern value_t QUOTE;
extern value_t int8sym, uint8sym, int16sym, uint16sym, int32sym, uint32sym;
extern value_t int64sym, uint64sym;
@@ -341,7 +345,6 @@
value_t string_from_cstrn(char *str, size_t n);
int fl_isstring(value_t v);
int fl_isnumber(value_t v);
-int fl_isgensym(value_t v);
int fl_isiostream(value_t v);
ios_t *fl_toiostream(value_t v, char *fname);
value_t cvalue_compare(value_t a, value_t b);
@@ -382,8 +385,6 @@
char *name;
builtin_t fptr;
} builtinspec_t;
-
-void assign_global_builtins(builtinspec_t *b);
void fl_init(size_t initial_heapsize);
int fl_load_system_image(value_t ios);
--- a/iostream.c
+++ b/iostream.c
@@ -34,13 +34,13 @@
return iscvalue(v) && cv_class((cvalue_t*)ptr(v)) == iostreamtype;
}
-value_t fl_iostreamp(value_t *args, uint32_t nargs)
+BUILTIN("iostream?", iostreamp) { argcount("iostream?", nargs, 1);return fl_isiostream(args[0]) ? FL_T : FL_F;
}
-value_t fl_eof_object(value_t *args, uint32_t nargs)
+BUILTIN("eof-object", eof_object) {USED(args);
argcount("eof-object", nargs, 0);@@ -47,7 +47,7 @@
return FL_EOF;
}
-value_t fl_eof_objectp(value_t *args, uint32_t nargs)
+BUILTIN("eof-object?", eof_objectp) { argcount("eof-object?", nargs, 1);return (FL_EOF == args[0]) ? FL_T : FL_F;
@@ -65,7 +65,7 @@
return toiostream(v, fname);
}
-value_t fl_file(value_t *args, uint32_t nargs)
+BUILTIN("file", file) {if (nargs < 1)
argcount("file", nargs, 1);@@ -87,7 +87,7 @@
return f;
}
-value_t fl_buffer(value_t *args, uint32_t nargs)
+BUILTIN("buffer", buffer) { argcount("buffer", nargs, 0);USED(args);
@@ -98,7 +98,7 @@
return f;
}
-value_t fl_read(value_t *args, uint32_t nargs)
+BUILTIN("read", read) {value_t arg = 0;
if (nargs > 1) {@@ -119,7 +119,7 @@
return v;
}
-value_t fl_iogetc(value_t *args, uint32_t nargs)
+BUILTIN("io.getc", io_getc) { argcount("io.getc", nargs, 1);ios_t *s = toiostream(args[0], "io.getc");
@@ -133,7 +133,7 @@
return mk_wchar(wc);
}
-value_t fl_iopeekc(value_t *args, uint32_t nargs)
+BUILTIN("io.peekc", io_peekc) { argcount("io.peekc", nargs, 1);ios_t *s = toiostream(args[0], "io.peekc");
@@ -146,7 +146,7 @@
return mk_wchar(wc);
}
-value_t fl_ioputc(value_t *args, uint32_t nargs)
+BUILTIN("io.putc", io_putc) { argcount("io.putc", nargs, 2);ios_t *s = toiostream(args[0], "io.putc");
@@ -156,7 +156,7 @@
return fixnum(ios_pututf8(s, wc));
}
-value_t fl_ioskip(value_t *args, uint32_t nargs)
+BUILTIN("io.skip", io_skip) { argcount("io.skip", nargs, 2);ios_t *s = toiostream(args[0], "io.skip");
@@ -167,7 +167,7 @@
return sizeof(res) == sizeof(int64_t) ? mk_int64(res) : mk_int32(res);
}
-value_t fl_ioflush(value_t *args, uint32_t nargs)
+BUILTIN("io.flush", io_flush) { argcount("io.flush", nargs, 1);ios_t *s = toiostream(args[0], "io.flush");
@@ -176,7 +176,7 @@
return FL_T;
}
-value_t fl_ioclose(value_t *args, uint32_t nargs)
+BUILTIN("io.close", io_close) { argcount("io.close", nargs, 1);ios_t *s = toiostream(args[0], "io.close");
@@ -184,7 +184,7 @@
return FL_T;
}
-value_t fl_iopurge(value_t *args, uint32_t nargs)
+BUILTIN("io.discardbuffer", io_discardbuffer) { argcount("io.discardbuffer", nargs, 1);ios_t *s = toiostream(args[0], "io.discardbuffer");
@@ -192,7 +192,7 @@
return FL_T;
}
-value_t fl_ioeof(value_t *args, uint32_t nargs)
+BUILTIN("io.eof?", io_eofp) { argcount("io.eof?", nargs, 1);ios_t *s = toiostream(args[0], "io.eof?");
@@ -199,7 +199,7 @@
return (ios_eof(s) ? FL_T : FL_F);
}
-value_t fl_ioseek(value_t *args, uint32_t nargs)
+BUILTIN("io.seek", io_seek) { argcount("io.seek", nargs, 2);ios_t *s = toiostream(args[0], "io.seek");
@@ -210,7 +210,7 @@
return FL_T;
}
-value_t fl_iopos(value_t *args, uint32_t nargs)
+BUILTIN("io.pos", io_pos) { argcount("io.pos", nargs, 1);ios_t *s = toiostream(args[0], "io.pos");
@@ -220,7 +220,7 @@
return size_wrap((size_t)res);
}
-value_t fl_write(value_t *args, uint32_t nargs)
+BUILTIN("write", write) {if (nargs < 1 || nargs > 2)
argcount("write", nargs, 1);@@ -233,7 +233,7 @@
return args[0];
}
-value_t fl_ioread(value_t *args, uint32_t nargs)
+BUILTIN("io.read", io_read) {if (nargs != 3)
argcount("io.read", nargs, 2);@@ -277,7 +277,7 @@
}
}
-value_t fl_iowrite(value_t *args, uint32_t nargs)
+BUILTIN("io.write", io_write) {if (nargs < 2 || nargs > 4)
argcount("io.write", nargs, 2);@@ -300,7 +300,7 @@
return size_wrap(ios_write(s, data, nb));
}
-value_t fl_dump(value_t *args, uint32_t nargs)
+BUILTIN("dump", dump) {if (nargs < 1 || nargs > 3)
argcount("dump", nargs, 1);@@ -329,7 +329,7 @@
return (char)uldelim;
}
-value_t fl_ioreaduntil(value_t *args, uint32_t nargs)
+BUILTIN("io.readuntil", io_readuntil) { argcount("io.readuntil", nargs, 2);value_t str = cvalue_string(80);
@@ -357,7 +357,7 @@
return str;
}
-value_t fl_iocopyuntil(value_t *args, uint32_t nargs)
+BUILTIN("io.copyuntil", io_copyuntil) { argcount("io.copyuntil", nargs, 3);ios_t *dest = toiostream(args[0], "io.copyuntil");
@@ -366,7 +366,7 @@
return size_wrap(ios_copyuntil(dest, src, delim));
}
-value_t fl_iocopy(value_t *args, uint32_t nargs)
+BUILTIN("io.copy", io_copy) {if (nargs < 2 || nargs > 3)
argcount("io.copy", nargs, 2);@@ -401,7 +401,7 @@
return str;
}
-value_t fl_iotostring(value_t *args, uint32_t nargs)
+BUILTIN("io.tostring!", io_tostring) { argcount("io.tostring!", nargs, 1);ios_t *src = toiostream(args[0], "io.tostring!");
@@ -410,35 +410,6 @@
return stream_to_string(&args[0]);
}
-static builtinspec_t iostreamfunc_info[] = {- { "iostream?", fl_iostreamp },- { "eof-object", fl_eof_object },- { "eof-object?", fl_eof_objectp },- { "dump", fl_dump },- { "file", fl_file },- { "buffer", fl_buffer },- { "read", fl_read },- { "write", fl_write },- { "io.flush", fl_ioflush },- { "io.close", fl_ioclose },- { "io.eof?" , fl_ioeof },- { "io.seek" , fl_ioseek },- { "io.pos", fl_iopos },- { "io.getc" , fl_iogetc },- { "io.skip", fl_ioskip },- { "io.putc" , fl_ioputc },- { "io.peekc" , fl_iopeekc },- { "io.discardbuffer", fl_iopurge },- { "io.read", fl_ioread },- { "io.write", fl_iowrite },- { "io.copy", fl_iocopy },- { "io.readuntil", fl_ioreaduntil },- { "io.copyuntil", fl_iocopyuntil },- { "io.tostring!", fl_iotostring },-
- { nil, nil }-};
-
void iostream_init(void)
{ iostreamsym = symbol("iostream");@@ -451,8 +422,6 @@
outstrsym = symbol("*output-stream*");iostreamtype = define_opaque_type(iostreamsym, sizeof(ios_t),
&iostream_vtable, nil);
- assign_global_builtins(iostreamfunc_info);
-
setc(symbol("*stdout*"), cvalue_from_ref(iostreamtype, ios_stdout,sizeof(ios_t), FL_NIL));
setc(symbol("*stderr*"), cvalue_from_ref(iostreamtype, ios_stderr,--- a/mkfile
+++ b/mkfile
@@ -3,7 +3,7 @@
BIN=/$objtype/bin
TARG=flisp
CFLAGS=$CFLAGS -p -D__plan9__ -D__${objtype}__ -Iplan9 -Illt-CLEANFILES=boot.h
+CLEANFILES=boot.h builtin_fns.h
HFILES=\
cvalues.c\
@@ -36,9 +36,12 @@
boot.h: flisp.boot
sed 's,\\,\\\\,g;s,",\\",g;s,^,",g;s,$,\\n",g' $prereq >$target
+builtin_fns.h:
+ sed -n 's/^BUILTIN[_]?(\(".*)/BUILTIN_FN\1/gp' *.c >$target+
flmain.$O: boot.h
-flisp.$O: maxstack.inc opcodes.h
+flisp.$O: maxstack.inc opcodes.h builtin_fns.h
bootstrap:V: $O.out
./$O.out gen.lsp && \
--- a/opaque_type_template.c
+++ /dev/null
@@ -1,57 +1,0 @@
-#include "llt.h"
-#include "flisp.h"
-
-// global replace TYPE with your type name to make your very own type!
-
-static value_t TYPEsym;
-static fltype_t *TYPEtype;
-
-void print_TYPE(value_t v, ios_t *f, int princ)
-{-}
-
-void print_traverse_TYPE(value_t self)
-{-}
-
-void free_TYPE(value_t self)
-{-}
-
-void relocate_TYPE(value_t oldv, value_t newv)
-{-}
-
-cvtable_t TYPE_vtable = { print_TYPE, relocate_TYPE, free_TYPE,- print_traverse_TYPE };
-
-int isTYPE(value_t v)
-{- return iscvalue(v) && cv_class((cvalue_t*)ptr(v)) == TYPEtype;
-}
-
-value_t fl_TYPEp(value_t *args, uint32_t nargs)
-{- argcount("TYPE?", nargs, 1);- return isTYPE(args[0]) ? FL_T : FL_F;
-}
-
-static TYPE_t *toTYPE(value_t v, char *fname)
-{- if (!isTYPE(v))
- type_error(fname, "TYPE", v);
- return (TYPE_t*)cv_data((cvalue_t*)ptr(v));
-}
-
-static builtinspec_t TYPEfunc_info[] = {- { "TYPE?", fl_TYPEp },- { nil, nil }-};
-
-void TYPE_init()
-{- TYPEsym = symbol("TYPE");- TYPEtype = define_opaque_type(TYPEsym, sizeof(TYPE_t),
- &TYPE_vtable, nil);
- assign_global_builtins(TYPEfunc_info);
-}
--- a/posix/platform.h
+++ b/posix/platform.h
@@ -11,6 +11,7 @@
#include <math.h>
#include <setjmp.h>
#include <stdarg.h>
+#include <stddef.h>
#include <stdint.h>
#include <stdio.h>
#include <stdlib.h>
--- a/read.c
+++ b/read.c
@@ -727,7 +727,7 @@
case TOK_GENSYM:
pv = (value_t*)ptrhash_bp(&readstate->gensyms, (void*)tokval);
if (*pv == (value_t)HT_NOTFOUND)
- *pv = fl_gensym(nil, 0);
+ *pv = gensym();
return *pv;
case TOK_DOUBLEQUOTE:
return read_string();
--- a/string.c
+++ b/string.c
@@ -4,13 +4,13 @@
#include "llt.h"
#include "flisp.h"
-value_t fl_stringp(value_t *args, uint32_t nargs)
+BUILTIN("string?", stringp) { argcount("string?", nargs, 1);return fl_isstring(args[0]) ? FL_T : FL_F;
}
-value_t fl_string_count(value_t *args, uint32_t nargs)
+BUILTIN("string.count", string_count) {size_t start = 0;
if (nargs < 1 || nargs > 3)
@@ -35,7 +35,7 @@
return size_wrap(u8_charnum(str+start, stop-start));
}
-value_t fl_string_width(value_t *args, uint32_t nargs)
+BUILTIN("string.width", string_width) { argcount("string.width", nargs, 1); if (iscprim(args[0])) {@@ -51,7 +51,7 @@
return size_wrap(u8_strwidth(s));
}
-value_t fl_string_reverse(value_t *args, uint32_t nargs)
+BUILTIN("string.reverse", string_reverse) { argcount("string.reverse", nargs, 1);if (!fl_isstring(args[0]))
@@ -62,7 +62,7 @@
return ns;
}
-value_t fl_string_encode(value_t *args, uint32_t nargs)
+BUILTIN("string.encode", string_encode) { argcount("string.encode", nargs, 1); if (iscvalue(args[0])) {@@ -81,7 +81,7 @@
type_error("string.encode", "wchar array", args[0]);}
-value_t fl_string_decode(value_t *args, uint32_t nargs)
+BUILTIN("string.decode", string_decode) {int term=0;
if (nargs == 2) {@@ -106,17 +106,17 @@
return wcstr;
}
-extern value_t fl_buffer(value_t *args, uint32_t nargs);
+extern BUILTIN("buffer", buffer);extern value_t stream_to_string(value_t *ps);
-value_t fl_string(value_t *args, uint32_t nargs)
+BUILTIN("string", string) {if (nargs == 1 && fl_isstring(args[0]))
return args[0];
- value_t arg, buf = fl_buffer(nil, 0);
+ value_t arg, buf = fn_builtin_buffer(nil, 0);
fl_gc_handle(&buf);
ios_t *s = value2c(ios_t*,buf);
- uint32_t i;
+ int i;
value_t oldpr = symbol_value(printreadablysym);
value_t oldpp = symbol_value(printprettysym);
set(printreadablysym, FL_F);
@@ -132,7 +132,7 @@
return outp;
}
-value_t fl_string_split(value_t *args, uint32_t nargs)
+BUILTIN("string.split", string_split) { argcount("string.split", nargs, 2);char *s = tostring(args[0], "string.split");
@@ -175,7 +175,7 @@
return first;
}
-value_t fl_string_sub(value_t *args, uint32_t nargs)
+BUILTIN("string.sub", string_sub) {if (nargs != 2)
argcount("string.sub", nargs, 3);@@ -200,7 +200,7 @@
return ns;
}
-value_t fl_string_char(value_t *args, uint32_t nargs)
+BUILTIN("string.char", string_char) { argcount("string.char", nargs, 2);char *s = tostring(args[0], "string.char");
@@ -214,7 +214,7 @@
return mk_wchar(u8_nextchar(s, &i));
}
-value_t fl_char_upcase(value_t *args, uint32_t nargs)
+BUILTIN("char.upcase", char_upcase) { argcount("char.upcase", nargs, 1);cprim_t *cp = (cprim_t*)ptr(args[0]);
@@ -222,7 +222,7 @@
type_error("char.upcase", "wchar", args[0]);return mk_wchar(towupper(*(int32_t*)cp_data(cp)));
}
-value_t fl_char_downcase(value_t *args, uint32_t nargs)
+BUILTIN("char.downcase", char_downcase) { argcount("char.downcase", nargs, 1);cprim_t *cp = (cprim_t*)ptr(args[0]);
@@ -231,7 +231,7 @@
return mk_wchar(towlower(*(int32_t*)cp_data(cp)));
}
-value_t fl_char_alpha(value_t *args, uint32_t nargs)
+BUILTIN("char-alphabetic?", char_alphabeticp) { argcount("char-alphabetic?", nargs, 1);cprim_t *cp = (cprim_t*)ptr(args[0]);
@@ -248,7 +248,7 @@
return size_wrap((size_t)(p - s));
}
-value_t fl_string_find(value_t *args, uint32_t nargs)
+BUILTIN("string.find", string_find) {char cbuf[8];
size_t start = 0;
@@ -298,7 +298,7 @@
return FL_F;
}
-value_t fl_string_inc(value_t *args, uint32_t nargs)
+BUILTIN("string.inc", string_inc) {if (nargs < 2 || nargs > 3)
argcount("string.inc", nargs, 2);@@ -316,7 +316,7 @@
return size_wrap(i);
}
-value_t fl_string_dec(value_t *args, uint32_t nargs)
+BUILTIN("string.dec", string_dec) {if (nargs < 2 || nargs > 3)
argcount("string.dec", nargs, 2);@@ -345,7 +345,7 @@
return radix;
}
-value_t fl_numbertostring(value_t *args, uint32_t nargs)
+BUILTIN("number->string", number_2_string) {if (nargs < 1 || nargs > 2)
argcount("number->string", nargs, 2);@@ -370,7 +370,7 @@
return string_from_cstr(str);
}
-value_t fl_stringtonumber(value_t *args, uint32_t nargs)
+BUILTIN("string->number", string_2_number) {if (nargs < 1 || nargs > 2)
argcount("string->number", nargs, 2);@@ -384,41 +384,10 @@
return n;
}
-value_t fl_string_isutf8(value_t *args, uint32_t nargs)
+BUILTIN("string.isutf8", string_isutf8) { argcount("string.isutf8", nargs, 1);char *s = tostring(args[0], "string.isutf8");
size_t len = cv_len((cvalue_t*)ptr(args[0]));
return u8_isvalid(s, len) ? FL_T : FL_F;
-}
-
-static builtinspec_t stringfunc_info[] = {- { "string", fl_string },- { "string?", fl_stringp },- { "string.count", fl_string_count },- { "string.width", fl_string_width },- { "string.split", fl_string_split },- { "string.sub", fl_string_sub },- { "string.find", fl_string_find },- { "string.char", fl_string_char },- { "string.inc", fl_string_inc },- { "string.dec", fl_string_dec },- { "string.reverse", fl_string_reverse },- { "string.encode", fl_string_encode },- { "string.decode", fl_string_decode },- { "string.isutf8", fl_string_isutf8 },-
- { "char.upcase", fl_char_upcase },- { "char.downcase", fl_char_downcase },- { "char-alphabetic?", fl_char_alpha },-
- { "number->string", fl_numbertostring },- { "string->number", fl_stringtonumber },-
- { nil, nil }-};
-
-void stringfuncs_init(void)
-{- assign_global_builtins(stringfunc_info);
}
--- a/table.c
+++ b/table.c
@@ -62,7 +62,7 @@
return iscvalue(v) && cv_class((cvalue_t*)ptr(v)) == tabletype;
}
-value_t fl_tablep(value_t *args, uint32_t nargs)
+BUILTIN("table?", tablep) { argcount("table?", nargs, 1);return ishashtable(args[0]) ? FL_T : FL_F;
@@ -75,7 +75,7 @@
return (htable_t*)cv_data((cvalue_t*)ptr(v));
}
-value_t fl_table(value_t *args, uint32_t nargs)
+BUILTIN("table", table) {size_t cnt = (size_t)nargs;
if (cnt & 1)
@@ -92,7 +92,7 @@
}
htable_t *h = (htable_t*)cv_data((cvalue_t*)ptr(nt));
htable_new(h, cnt/2);
- uint32_t i;
+ int i;
value_t k=FL_NIL, arg;
FOR_ARGS(i,0,arg,args) {if (i&1)
@@ -104,7 +104,7 @@
}
// (put! table key value)
-value_t fl_table_put(value_t *args, uint32_t nargs)
+BUILTIN("put!", put) { argcount("put!", nargs, 3);htable_t *h = totable(args[0], "put!");
@@ -125,7 +125,7 @@
}
// (get table key [default])
-value_t fl_table_get(value_t *args, uint32_t nargs)
+BUILTIN("get", get) {if (nargs != 3)
argcount("get", nargs, 2);@@ -140,15 +140,15 @@
}
// (has? table key)
-value_t fl_table_has(value_t *args, uint32_t nargs)
+BUILTIN("has?", has) {- argcount("has", nargs, 2);- htable_t *h = totable(args[0], "has");
+ argcount("has?", nargs, 2);+ htable_t *h = totable(args[0], "has?");
return equalhash_has(h, (void*)args[1]) ? FL_T : FL_F;
}
// (del! table key)
-value_t fl_table_del(value_t *args, uint32_t nargs)
+BUILTIN("del!", del) { argcount("del!", nargs, 2);htable_t *h = totable(args[0], "del!");
@@ -157,7 +157,7 @@
return args[0];
}
-value_t fl_table_foldl(value_t *args, uint32_t nargs)
+BUILTIN("table.foldl", table_foldl) { argcount("table.foldl", nargs, 3);value_t f=args[0], zero=args[1], t=args[2];
@@ -184,21 +184,9 @@
return zero;
}
-static builtinspec_t tablefunc_info[] = {- { "table", fl_table },- { "table?", fl_tablep },- { "put!", fl_table_put },- { "get", fl_table_get },- { "has?", fl_table_has },- { "del!", fl_table_del },- { "table.foldl", fl_table_foldl },- { nil, nil }-};
-
void table_init(void)
{ tablesym = symbol("table");tabletype = define_opaque_type(tablesym, sizeof(htable_t),
&table_vtable, nil);
- assign_global_builtins(tablefunc_info);
}