p/ell
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Add "eq?" and "lt?"

Browse Source
This commit is contained in:
Přemysl Eric Janouch 2017-05-21 11:26:59 +02:00
parent c8e3e2eed6
commit 04364b75ea
Signed by: p
GPG Key ID: B715679E3A361BE6
2 changed files with 34 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
README.adoc
View File

@ -29,7 +29,7 @@ The parser, however, does a bunch of transformations:
As an example, consider the following snippet:
print (if { = @var foo } {
print (if { eq? @var foo } {
quote 'Hello world\n'
} else {
quote 'Error\n'
@ -37,7 +37,7 @@ As an example, consider the following snippet:
which gets expanded to the following:
((print (if (quote ((= (set var) foo)))
((print (if (quote ((eq? (set var) foo)))
(quote ((quote 'Hello world\n')))
else
(quote ((quote 'Error\n'))))))

33
ell.c
View File

@ -1159,6 +1159,35 @@ defn (fn_or) {
return check (ctx, (*result = new_boolean (res)));
}
defn (fn_eq) {
struct item *etalon = args;
if (!etalon || etalon->type != ITEM_STRING)
return set_error (ctx, "first argument must be string");
bool res = true;
for (args = etalon->next; args; args = args->next) {
if (args->type != ITEM_STRING)
return set_error (ctx, "arguments must be strings");
if (!(res &= !strcmp (etalon->value, args->value)))
break;
}
return check (ctx, (*result = new_boolean (res)));
}
defn (fn_lt) {
struct item *etalon = args;
if (!etalon || etalon->type != ITEM_STRING)
return set_error (ctx, "first argument must be string");
bool res = true;
for (args = etalon->next; args; args = args->next) {
if (args->type != ITEM_STRING)
return set_error (ctx, "arguments must be strings");
if (!(res &= strcmp (etalon->value, args->value) < 0))
break;
etalon = args;
}
return check (ctx, (*result = new_boolean (res)));
}
// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
static bool
@ -1209,7 +1238,9 @@ init_runtime_library (struct context *ctx) {
&& native_register (ctx, "/", fn_divide)
&& native_register (ctx, "not", fn_not)
&& native_register (ctx, "and", fn_and)
&& native_register (ctx, "or", fn_or);
&& native_register (ctx, "or", fn_or)
&& native_register (ctx, "eq?", fn_eq)
&& native_register (ctx, "lt?", fn_lt);
}
// --- Main --------------------------------------------------------------------