sjs/lake
1
0
Fork 0
mirror of https://github.com/samsonjs/lake.git synced 2026-03-25 08:55:49 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

add a few more primitives: display, set-car!, type predicates

Browse source
This commit is contained in:
Sami Samhuri 2011-06-11 02:12:22 -07:00
parent 792fcd879f
commit 78f6ab543f
2 changed files with 61 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
Readme.md
View file

@ -138,7 +138,6 @@ TODO
Lake still needs:
* primitive functions:
* display values
* compare values
* eval and apply
* native type operations on:

70
src/primitive.c
View file

@ -264,6 +264,55 @@ static LakeVal *_int_gt(LakeCtx *ctx, LakeList *args)
return VAL(lk_bool_from_int(ctx, result));
}
static LakeVal *_set_carB(LakeCtx *ctx, LakeList *args)
{
LakeList *list = LIST(LIST_VAL(args, 0));
if (lk_is_type(TYPE_LIST, list)) {
LakeVal *new_car = LIST_VAL(args, 1);
if (LIST_N(list) == 0) {
list_append(list, new_car);
}
else {
list_set(list, 0, new_car);
}
return VAL(list);
}
ERR("not a pair: %s", lake_repr(list));
return NULL;
}
static LakeVal *_display(LakeCtx *ctx, LakeList *args)
{
size_t n = LIST_N(args);
size_t i;
int space = 0;
for (i = 0; i < n; ++i) {
if (space) putchar(' ');
printf("%s", lake_repr(LIST_VAL(args, i)));
space = 1;
}
putchar('\n');
return NULL;
}
#define DEFINE_PREDICATE(name, type) \
static LakeVal *_## name ##P(LakeCtx *ctx, LakeList *args) \
{ \
return VAL(lk_bool_from_int(ctx, lk_is_type(type, LIST_VAL(args, 0)))); \
}
DEFINE_PREDICATE(symbol, TYPE_SYM)
DEFINE_PREDICATE(list, TYPE_LIST)
DEFINE_PREDICATE(dotted_list, TYPE_DLIST)
DEFINE_PREDICATE(number, TYPE_INT)
DEFINE_PREDICATE(integer, TYPE_INT)
DEFINE_PREDICATE(string, TYPE_STR)
DEFINE_PREDICATE(bool, TYPE_BOOL)
DEFINE_PREDICATE(function, TYPE_FN)
DEFINE_PREDICATE(primitive, TYPE_PRIM)
#undef DEFINE_PREDICATE
void bind_primitives(LakeCtx *ctx)
{
#define DEFINE(name, fn, arity) env_define(ctx->toplevel, \
@ -285,16 +334,19 @@ void bind_primitives(LakeCtx *ctx)
DEFINE("=", _int_eq, ARITY_VARARGS);
DEFINE("<", _int_lt, ARITY_VARARGS);
DEFINE(">", _int_gt, ARITY_VARARGS);
DEFINE("set-car!", _set_carB, 2);
/* symbol? */
/* list? */
/* dotted-list? */
/* number? */
/* integer? */
/* string? */
/* bool? */
/* function? */
/* primitive? */
DEFINE("display", _display, ARITY_VARARGS);
DEFINE("symbol?", _symbolP, 1);
DEFINE("list?", _listP, 1);
DEFINE("dotted-list?", _dotted_listP, 1);
DEFINE("number?", _numberP, 1);
DEFINE("integer?", _integerP, 1);
DEFINE("string?", _stringP, 1);
DEFINE("bool?", _boolP, 1);
DEFINE("function?", _functionP, 1);
DEFINE("primitive?", _primitiveP, 1);
/* string=? */
/* string< */