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

Remove suck 

struct context::arguments stank, the "arg" special form stank.

The amount of lines this adds can be counted on one hand.
This commit is contained in:
Přemysl Eric Janouch 2017-05-26 19:44:03 +02:00
parent 8414e07010
commit 3e68a09ae1
Signed by: p
GPG Key ID: B715679E3A361BE6
5 changed files with 99 additions and 102 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
README.adoc
View File

@ -52,8 +52,8 @@ For a slightly more realistic example have a look at 'greet.ell'.
Runtime Runtime
------- -------
Variables use per-block dynamic scoping. Arguments to a block (which is a list Variables use per-block dynamic scoping. Arguments to a block (which is a list
of lists) must be assigned to variables first using the `arg` special form, and of lists) are assigned to local variables named `1`, `2`, etc., and the full
that must happen before they get overriden by execution of a different block. list of them is stored in `*`.
When evaluating a command, the first argument is typically a string with its When evaluating a command, the first argument is typically a string with its
name and it is resolved as if `set` was called on it. name and it is resolved as if `set` was called on it.
@ -64,19 +64,18 @@ Special Forms
------------- -------------
`quote [<arg>]...` `quote [<arg>]...`
Returns the arguments without any evaluation. Like `values` but returns the arguments without any evaluation.
`arg [<name>]...`
Assigns arguments to the current block in order to given names. Names for which
there are no values left default to `[]`. This form can effectively be used to
declare local variables.
Standard library Standard library
---------------- ----------------
The standard library interprets the empty list and the empty string as false The standard library interprets the empty list and the empty string as false
values, everything else is taken as true. values, everything else is taken as true.
`local <names> [<value>]...`
Create local variables in the current block. Names for which there are no
values left default to `()`.
`set <name> [<value>]` `set <name> [<value>]`
Retrieve or set a named variable. The syntax sugar for retrieval is `@`. Retrieve or set a named variable. The syntax sugar for retrieval is `@`.
@ -167,6 +166,7 @@ Install development packages for GNU Readline to get a REPL for toying around:
Possible Ways of Complicating Possible Ways of Complicating
----------------------------- -----------------------------
* `local [_a _b _rest] @*` would elegantly solve the problem of varargs
* reference counting: currently all values are always copied as needed, which * reference counting: currently all values are always copied as needed, which
is good enough for all imaginable use cases, simpler and less error-prone is good enough for all imaginable use cases, simpler and less error-prone

166
ell.c
View File

@ -641,7 +641,6 @@ struct context {
struct item *globals; ///< List of global variables struct item *globals; ///< List of global variables
struct item *scopes; ///< Dynamic scopes from newest struct item *scopes; ///< Dynamic scopes from newest
struct native_fn *native; ///< Maps strings to C functions struct native_fn *native; ///< Maps strings to C functions
struct item *arguments; ///< Arguments to last executed block
char *error; ///< Error information char *error; ///< Error information
bool memory_failure; ///< Memory allocation failure bool memory_failure; ///< Memory allocation failure
@ -670,7 +669,6 @@ context_free (struct context *ctx) {
} }
item_free_list (ctx->globals); item_free_list (ctx->globals);
item_free_list (ctx->scopes); item_free_list (ctx->scopes);
item_free_list (ctx->arguments);
free (ctx->error); free (ctx->error);
} }
@ -779,34 +777,12 @@ can_modify_error (struct context *ctx) {
return !ctx->memory_failure && ctx->error[0] != '_'; return !ctx->memory_failure && ctx->error[0] != '_';
} }
static bool
assign_arguments (struct context *ctx, struct item *names) {
struct item **scope = &ctx->scopes->head;
item_free_list (*scope);
*scope = NULL;
struct item *arg = ctx->arguments;
for (; names; names = names->next) {
if (names->type != ITEM_STRING)
return set_error (ctx, "argument names must be strings");
struct item *value = NULL;
if (arg && !check (ctx, (value = new_clone (arg))))
return false;
// Duplicates don't really matter to us, user's problem
if (!scope_prepend (ctx, scope, names->value, value))
return false;
if (arg)
arg = arg->next;
}
return true;
}
static bool execute_statement (struct context *, struct item *, struct item **); static bool execute_statement (struct context *, struct item *, struct item **);
static bool execute (struct context *ctx, struct item *body, struct item **); static bool execute_block (struct context *,
struct item *, struct item *, struct item **);
static bool static bool
execute_args (struct context *ctx, struct item *args) { execute_args (struct context *ctx, struct item *args, struct item **result) {
size_t i = 0; size_t i = 0;
struct item *res = NULL, **out = &res; struct item *res = NULL, **out = &res;
for (; args; args = args->next) { for (; args; args = args->next) {
@ -820,8 +796,7 @@ execute_args (struct context *ctx, struct item *args) {
out = &(*out = evaluated)->next; out = &(*out = evaluated)->next;
i++; i++;
} }
item_free_list (ctx->arguments); *result = res;
ctx->arguments = res;
return true; return true;
error: error:
@ -842,14 +817,13 @@ execute_native (struct context *ctx, const char *name, struct item *args,
struct native_fn *fn = native_find (ctx, name); struct native_fn *fn = native_find (ctx, name);
if (!fn) if (!fn)
return set_error (ctx, "unknown function"); return set_error (ctx, "unknown function");
if (!execute_args (ctx, args))
struct item *arguments = NULL;
if (!execute_args (ctx, args, &arguments))
return false; return false;
// "ctx->arguments" is for assign_arguments() only bool ok = fn->handler (ctx, arguments, result);
args = ctx->arguments; item_free_list (arguments);
ctx->arguments = NULL;
bool ok = fn->handler (ctx, args, result);
item_free_list (args);
return ok; return ok;
} }
@ -859,8 +833,9 @@ execute_resolved (struct context *ctx, struct item *body, struct item *args,
// Resolving names ecursively could be pretty fatal, let's not do that // Resolving names ecursively could be pretty fatal, let's not do that
if (body->type == ITEM_STRING) if (body->type == ITEM_STRING)
return check (ctx, (*result = new_clone (body))); return check (ctx, (*result = new_clone (body)));
return execute_args (ctx, args) struct item *arguments = NULL;
&& execute (ctx, body->head, result); return execute_args (ctx, args, &arguments)
&& execute_block (ctx, body->head, arguments, result);
} }
static bool static bool
@ -868,11 +843,8 @@ execute_item (struct context *ctx, struct item *body, struct item **result) {
struct item *args = body->next; struct item *args = body->next;
if (body->type == ITEM_STRING) { if (body->type == ITEM_STRING) {
const char *name = body->value; const char *name = body->value;
// These could be just regular handlers, only top priority
if (!strcmp (name, "quote")) if (!strcmp (name, "quote"))
return !args || check (ctx, (*result = new_clone_list (args))); return !args || check (ctx, (*result = new_clone_list (args)));
if (!strcmp (name, "arg"))
return assign_arguments (ctx, args);
if ((body = get (ctx, name))) if ((body = get (ctx, name)))
return execute_resolved (ctx, body, args, result); return execute_resolved (ctx, body, args, result);
return execute_native (ctx, name, args, result); return execute_native (ctx, name, args, result);
@ -922,13 +894,34 @@ execute_statement
return false; return false;
} }
/// Execute a block and return whatever the last statement returned
static bool static bool
execute (struct context *ctx, struct item *body, struct item **result) { args_to_scope (struct context *ctx, struct item *args, struct item **scope) {
struct item *scope; if (!check (ctx, (args = new_list (args)))
if (!check (ctx, (scope = new_list (NULL)))) || !scope_prepend (ctx, scope, "*", args))
return false; return false;
size_t i = 0;
for (args = args->head; args; args = args->next) {
char buf[16] = "";
(void) snprintf (buf, sizeof buf, "%zu", ++i);
struct item *copy = NULL;
if ((args && !check (ctx, (copy = new_clone (args))))
|| !scope_prepend (ctx, scope, buf, copy))
return false;
}
return check (ctx, (*scope = new_list (*scope)));
}
/// Execute a block and return whatever the last statement returned, eats args
static bool
execute_block (struct context *ctx, struct item *body, struct item *args,
struct item **result) {
struct item *scope = NULL;
if (!args_to_scope (ctx, args, &scope)) {
item_free_list (scope);
return false;
}
scope->next = ctx->scopes; scope->next = ctx->scopes;
ctx->scopes = scope; ctx->scopes = scope;
@ -951,20 +944,13 @@ execute (struct context *ctx, struct item *body, struct item **result) {
(struct context *ctx, struct item *args, struct item **result) (struct context *ctx, struct item *args, struct item **result)
static bool static bool
set_single_argument (struct context *ctx, struct item *item) { execute_any (struct context *ctx, struct item *body, struct item *arg,
struct item *single; struct item **result) {
if (!check (ctx, (single = new_clone (item))))
return false;
item_free_list (ctx->arguments);
ctx->arguments = single;
return true;
}
static bool
execute_any (struct context *ctx, struct item *body, struct item **result) {
if (body->type == ITEM_STRING) if (body->type == ITEM_STRING)
return check (ctx, (*result = new_clone (body))); return check (ctx, (*result = new_clone (body)));
return execute (ctx, body->head, result); if (arg && !check (ctx, (arg = new_clone (arg))))
return false;
return execute_block (ctx, body->head, arg, result);
} }
static struct item * static struct item *
@ -993,6 +979,27 @@ static struct item * new_boolean (bool b) { return new_string ("1", b); }
// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - // - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
defn (fn_local) {
struct item *names = args;
if (!names || names->type != ITEM_LIST)
return set_error (ctx, "first argument must be a list");
// Duplicates or non-strings don't really matter to us, user's problem
struct item **scope = &ctx->scopes->head;
(void) result;
struct item *values = names->next;
for (names = names->head; names; names = names->next) {
struct item *value = NULL;
if ((values && !check (ctx, (value = new_clone (values))))
|| !scope_prepend (ctx, scope, names->value, value))
return false;
if (values)
values = values->next;
}
return true;
}
defn (fn_set) { defn (fn_set) {
struct item *name = args; struct item *name = args;
if (!name || name->type != ITEM_STRING) if (!name || name->type != ITEM_STRING)
@ -1030,12 +1037,12 @@ defn (fn_if) {
return set_error (ctx, "missing body"); return set_error (ctx, "missing body");
struct item *res = NULL; struct item *res = NULL;
if (!execute_any (ctx, cond, &res)) if (!execute_any (ctx, cond, NULL, &res))
return false; return false;
bool match = truthy (res); bool match = truthy (res);
item_free_list (res); item_free_list (res);
if (match) if (match)
return execute_any (ctx, body, result); return execute_any (ctx, body, NULL, result);
if (!(keyword = body->next)) if (!(keyword = body->next))
break; break;
@ -1045,7 +1052,7 @@ defn (fn_if) {
if (!strcmp (keyword->value, "else")) { if (!strcmp (keyword->value, "else")) {
if (!(body = keyword->next)) if (!(body = keyword->next))
return set_error (ctx, "missing body"); return set_error (ctx, "missing body");
return execute_any (ctx, body, result); return execute_any (ctx, body, NULL, result);
} }
if (strcmp (keyword->value, "elif")) if (strcmp (keyword->value, "elif"))
return set_error (ctx, "invalid keyword: %s", keyword->value); return set_error (ctx, "invalid keyword: %s", keyword->value);
@ -1062,8 +1069,7 @@ defn (fn_map) {
struct item *res = NULL, **out = &res; struct item *res = NULL, **out = &res;
for (struct item *v = values->head; v; v = v->next) { for (struct item *v = values->head; v; v = v->next) {
if (!set_single_argument (ctx, v) if (!execute_any (ctx, body, v, out)) {
|| !execute_any (ctx, body, out)) {
item_free_list (res); item_free_list (res);
return false; return false;
} }
@ -1129,7 +1135,7 @@ defn (fn_try) {
return set_error (ctx, "first argument must be a function"); return set_error (ctx, "first argument must be a function");
if (!(handler = body->next)) if (!(handler = body->next))
return set_error (ctx, "second argument must be a function"); return set_error (ctx, "second argument must be a function");
if (execute_any (ctx, body, result)) if (execute_any (ctx, body, NULL, result))
return true; return true;
struct item *message; struct item *message;
@ -1140,8 +1146,7 @@ defn (fn_try) {
free (ctx->error); ctx->error = NULL; free (ctx->error); ctx->error = NULL;
item_free_list (*result); *result = NULL; item_free_list (*result); *result = NULL;
bool ok = set_single_argument (ctx, message) bool ok = execute_any (ctx, handler, message, result);
&& execute_any (ctx, handler, result);
item_free (message); item_free (message);
return ok; return ok;
} }
@ -1217,7 +1222,7 @@ defn (fn_and) {
item_free_list (*result); item_free_list (*result);
*result = NULL; *result = NULL;
if (!execute_any (ctx, args, result)) if (!execute_any (ctx, args, NULL, result))
return false; return false;
if (!truthy (*result)) if (!truthy (*result))
return check (ctx, (*result = new_boolean (false))); return check (ctx, (*result = new_boolean (false)));
@ -1227,7 +1232,7 @@ defn (fn_and) {
defn (fn_or) { defn (fn_or) {
for (; args; args = args->next) { for (; args; args = args->next) {
if (!execute_any (ctx, args, result)) if (!execute_any (ctx, args, NULL, result))
return false; return false;
if (truthy (*result)) if (truthy (*result))
return true; return true;
@ -1300,27 +1305,24 @@ defn (fn_less) {
// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - // - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
const char init_program[] = const char init_program[] =
"set unless { arg _cond _body; if (not (@_cond)) @_body }\n" "set unless { if (not (@1)) @2 }\n"
"set filter { arg _body _list\n" "set filter { local [_body _list] @1 @2\n"
" map { arg _i; if (@_body @_i) { @_i } } @_list }\n" " map { if (@_body @1) { @1 } } @_list }\n"
"set for { arg _list _body\n" "set for { local [_list _body] @1 @2\n"
" try { map { arg _i; @_body @_i } @_list } {\n" " try { map { @_body @1 } @_list } {\n"
" arg _e; if (ne? @_e _break) { throw @e } } }\n" " if (ne? @1 _break) { throw @1 } } }\n"
"set break { throw _break }\n" "set break { throw _break }\n"
// TODO: we should be able to apply them to all arguments // TODO: we should be able to apply them to all arguments
"set ne? { arg _1 _2; not (eq? @_1 @_2) }\n" "set ne? { not (eq? @1 @2) }\n" "set le? { ge? @2 @1 }\n"
"set ge? { arg _1 _2; not (lt? @_1 @_2) }\n" "set ge? { not (lt? @1 @2) }\n" "set gt? { lt? @2 @1 }\n"
"set le? { arg _1 _2; ge? @_2 @_1 }\n" "set <> { not (= @1 @2) }\n" "set <= { >= @2 @1 }\n"
"set gt? { arg _1 _2; lt? @_2 @_1 }\n" "set >= { not (< @1 @2) }\n" "set > { < @2 @1 }\n";
"set <> { arg _1 _2; not (= @_1 @_2) }\n"
"set >= { arg _1 _2; not (< @_1 @_2) }\n"
"set <= { arg _1 _2; >= @_2 @_1 }\n"
"set > { arg _1 _2; < @_2 @_1 }\n";
static bool static bool
init_runtime_library (struct context *ctx) { init_runtime_library (struct context *ctx) {
if (!native_register (ctx, "set", fn_set) if (!native_register (ctx, "local", fn_local)
|| !native_register (ctx, "set", fn_set)
|| !native_register (ctx, "list", fn_list) || !native_register (ctx, "list", fn_list)
|| !native_register (ctx, "values", fn_values) || !native_register (ctx, "values", fn_values)
|| !native_register (ctx, "if", fn_if) || !native_register (ctx, "if", fn_if)
@ -1350,7 +1352,7 @@ init_runtime_library (struct context *ctx) {
const char *e = NULL; const char *e = NULL;
struct item *result = NULL; struct item *result = NULL;
struct item *program = parser_run (&parser, &e); struct item *program = parser_run (&parser, &e);
bool ok = !e && execute (ctx, program, &result); bool ok = !e && execute_block (ctx, program, NULL, &result);
parser_free (&parser); parser_free (&parser);
item_free_list (program); item_free_list (program);
item_free_list (result); item_free_list (result);

12
greet.ell
View File

@ -1,19 +1,13 @@
set greet {
arg _name
print 'hello ' @_name '\n'
}
set decr { set decr {
arg _name set @1 (- @@1 1)
set @_name (- @@_name 1)
} }
set limit 2 set limit 2
for (map { arg _x; .. @_x ! } [ for (map { .. @1 ! } [
world world
creator creator
'darkness, my old friend' 'darkness, my old friend'
]) { ]) {
arg _whom { print 'hello ' @1 '\n' } @1
greet @_whom
if (= 0 (decr limit)) { break } if (= 0 (decr limit)) { break }
} }

3
interpreter.c
View File

@ -51,7 +51,8 @@ main (int argc, char *argv[]) {
printf ("%s\n", "runtime library initialization failed"); printf ("%s\n", "runtime library initialization failed");
struct item *result = NULL; struct item *result = NULL;
(void) execute (&ctx, program, &result); // TODO: pass argv as the list of arguments
(void) execute_block (&ctx, program, NULL, &result);
item_free_list (result); item_free_list (result);
item_free_list (program); item_free_list (program);

2
repl.c
View File

@ -24,7 +24,7 @@
static void static void
run (struct context *ctx, struct item *program) { run (struct context *ctx, struct item *program) {
struct item *result = NULL; struct item *result = NULL;
(void) execute (ctx, program, &result); (void) execute_block (ctx, program, NULL, &result);
item_free_list (program); item_free_list (program);
const char *failure = ctx->error; const char *failure = ctx->error;