reassure, evaluation of functions #1

- add reassure() function with useful error
  messages
- format code, with 65 cols max
- don't allow multiple definitions in one
	environment
- prepare eval of defined symbols
- prepare eval of lambda/functions
This commit is contained in:
Christian Barthel 2019-07-04 10:19:37 +02:00
parent 7ace1d6fe9
commit 1e22fb868b
1 changed files with 250 additions and 134 deletions

View File

@ -3,34 +3,41 @@
* Copyright (c) 2019 Christian Barthel <bch@online.de>
* All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions
* Redistribution and use in source and binary forms, with or
* without modification, are permitted provided that the
* following conditions
* are met:
* 1. Redistributions of source code must retain the above copyright
* notice, this list of conditions and the following disclaimer.
* 2. Redistributions in binary form must reproduce the above copyright
* notice, this list of conditions and the following disclaimer in the
* documentation and/or other materials provided with the distribution.
* 1. Redistributions of source code must retain the above
* copyright * notice, this list of conditions and the
* following disclaimer.
* 2. Redistributions in binary form must reproduce the above
* copyright notice, this list of conditions and the following
* disclaimer in the documentation and/or other materials
* provided with the distribution.
*
* THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
* ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
* ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
* OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
* HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
* LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
* OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
* SUCH DAMAGE.
* THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS
* IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
* FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT
* SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
* INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
* SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
* OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
* LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF
* THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY
* OF SUCH DAMAGE.
*
*
* Compile: flex tokenize.l
* cc lex.yy.c -lfl
*/
%{
#include <assert.h>
#define _POSIX_C_SOURCE 200809L
#define _XOPEN_SOURCE 600
#include <stdio.h>
#include <stdarg.h>
#include <string.h>
#include <err.h>
struct token;
@ -43,7 +50,7 @@ struct token {
struct token *next;
};
struct ast;
struct ast;
struct ast {
int type;
union {
@ -117,6 +124,19 @@ nil { yylval = 0; return BOOL; }
* (quote a) -> a
*/
void
reassure(int promised, const char *fmt, ...)
{
va_list ap;
va_start(ap, fmt);
if (!promised) {
vfprintf(stderr, fmt, ap);
fputc('\n', stderr);
exit(1);
}
va_end(ap);
}
void
debug_token(struct token *x, int indent) {
for (int i = 0; i < indent; i++) putc(' ', stderr);
@ -132,7 +152,8 @@ debug_ast(struct ast *a, int indent)
{
while (a) {
for (int i = 0; i < indent; i++) putc(' ', stderr);
fprintf(stderr, "AST: %s,a=%p,list=%p,token=%p,next=%p", (a->type == AST_TOK) ? "AST_TOK" :
fprintf(stderr, "AST: %s,a=%p,list=%p,token=%p,next=%p",
(a->type == AST_TOK) ? "AST_TOK" :
"AST_LIST", a, a->v.list, a->v.token, a->next);
putc('\n', stderr);
if (a->type == AST_LIST) {
@ -150,7 +171,7 @@ debug_ast(struct ast *a, int indent)
struct token*
make_token(enum yytokentype type, int num, char* str)
{
struct token *t =
struct token *t =
(struct token*) calloc(1, sizeof(struct token));
if (t == NULL)
err(1, "malloc failed");
@ -165,23 +186,21 @@ make_token(enum yytokentype type, int num, char* str)
struct ast*
make_ast(enum asttype type, struct token *t)
{
struct ast *a =
(struct ast*) calloc(1, sizeof(struct ast));
struct ast *a = (struct ast*) calloc(1, sizeof(struct ast));
if (a == NULL)
err(1, "malloc failed");
a->type = type;
if (type == AST_TOK)
a->v.token = t;
/* else if (type == AST_LIST) */
/* a->v.list = n; */
/* a->v.list = n; */
return a;
}
struct env*
make_env(char *name, struct ast *a)
{
struct env *e =
(struct env*) calloc(1, sizeof(struct env));
struct env *e = (struct env*) calloc(1, sizeof(struct env));
if (e == NULL)
err(1, "malloc failed");
e->name = name;
@ -210,8 +229,8 @@ int token_is_internal(struct token *t) {
/* upon parsing a list of tokens like:
* "(" -> "def" -> "(" -> "b" -> ")" -> "c" -> ")"
* care must be taken when entering a new sub-list (b),
* because the processing in the upper level must continue
* where the sub-list ended, i.e. "c" must be the next
* because the processing in the upper level must continue
* where the sub-list ended, i.e. "c" must be the next
* token on this level.
*/
struct token *next;
@ -226,7 +245,8 @@ parse(struct token *t)
struct ast *a, *p;
t = t->next;
while (t->type != RPAR) {
assert (t != NULL);
reassure(t != NULL,
"%s: unexpected NULL", __func__);
a = parse(t);
if (a == NULL)
err(1, "syntax error");
@ -236,9 +256,12 @@ parse(struct token *t)
p->next = a;
p = a;
t = next; /* skip all tokens that are processed */
assert(t != NULL);
reassure(t != NULL,
"%s: unexpected NULL(2)", __func__);
}
assert(t->type == RPAR);
reassure(t->type == RPAR,
"%s: RPAR expected but given: %d",
__func__, t->type);
t = t->next;
next = t;
return head;
@ -264,7 +287,7 @@ append(struct env *e, struct env *a)
if (e->next == NULL) {
e->next = a;
return;
} else
} else
append(e->next, a);
}
@ -283,20 +306,35 @@ lookup(struct env *e, char *name)
struct ast *
eval_def(struct ast *a, struct env *e)
{
a = a->next; /* skrip `def` */
assert((a->next->type == AST_TOK &&
a->next->v.token->type== STR) ||
(a->next->type == AST_TOK &&
a->next->v.token->type == BOOL) ||
(a->next->type == AST_TOK &&
a->next->v.token->type == NUM) ||
(a->next->type == AST_LIST) ||
(a->next->type == AST_TOK &&
a->next->v.token->type== SYM));
append(e, make_env(a->v.token->v.str, eval(a->next, e)));
a = a->next; /* skip `def` */
reassure(a->v.token->type == SYM, /* must be a symbol */
"%s: expected SYM, given: %d",
__func__, a->v.token->type);
reassure(a != NULL && a->next != NULL, /* need sth to bind..*/
"%s: unexpected NULL", __func__);
assert(a->next->next == NULL);
reassure((a->next->type == AST_TOK && /* check type */
a->next->v.token->type== STR) ||
(a->next->type == AST_TOK &&
a->next->v.token->type == BOOL) ||
(a->next->type == AST_TOK &&
a->next->v.token->type == NUM) ||
(a->next->type == AST_LIST) ||
(a->next->type == AST_TOK &&
a->next->v.token->type== SYM),
"%s: expected STR,BOOL,NUM,SYM as assigned expression",
__func__);
char *new = a->v.token->v.str;
for (struct env *x = e; x; x = x->next)
reassure(strcmp(x->name, new) != 0,
"%s: %s already assigned in env=%p",
__func__, new, e);
append(e, make_env(new, eval(a->next, e)));
reassure(a->next->next == NULL,
"%s: ended with unexpected token", __func__);
return NULL;
}
@ -306,16 +344,19 @@ eval_if(struct ast *a, struct env *e)
{
a = a->next;
assert(a != NULL && a->next != NULL);
reassure(a != NULL && a->next != NULL,
"%s: unexpected NULL", __func__);
struct ast *condition = eval(a, e);
assert(condition != NULL &&
condition->type == AST_TOK &&
condition->v.token->type == BOOL);
assert(a->next != NULL &&
a->next->next != NULL);
reassure(condition != NULL &&
condition->type == AST_TOK &&
condition->v.token->type == BOOL,
"%s: expected boolean token", __func__);
reassure(a->next != NULL && a->next->next != NULL,
"%s: unexpected expressions",
__func__);
if (condition->v.token->v.num == 1)
return eval(a->next, e);
@ -327,22 +368,24 @@ eval_if(struct ast *a, struct env *e)
struct ast *
eval_nand(struct ast *a, struct env *e)
{
assert (a != NULL &&
a->next != NULL &&
a->next->next != NULL &&
a->next->next->next == NULL);
reassure(a != NULL &&
a->next != NULL &&
a->next->next != NULL &&
a->next->next->next == NULL,
"%s: unexpected NULL", __func__);
struct ast *op1 = eval(a->next, e);
struct ast *op2 = eval(a->next->next, e);
assert (op1 != NULL &&
op1->type == AST_TOK &&
op1->v.token->type == BOOL &&
op2 != NULL &&
op2->type == AST_TOK &&
op2->v.token->type == BOOL );
return make_ast(AST_TOK,
make_token(BOOL,
reassure(op1 != NULL &&
op1->type == AST_TOK &&
op1->v.token->type == BOOL &&
op2 != NULL &&
op2->type == AST_TOK &&
op2->v.token->type == BOOL,
"%s: expected <bool> <bool> operands", __func__);
return make_ast(AST_TOK,
make_token(BOOL,
!(
op1->v.token->v.num &
op2->v.token->v.num) ,
@ -353,23 +396,25 @@ eval_nand(struct ast *a, struct env *e)
struct ast *
eval_add(struct ast *a, struct env *e)
{
assert (a != NULL &&
a->next != NULL &&
a->next->next != NULL &&
a->next->next->next == NULL);
reassure(a != NULL &&
a->next != NULL &&
a->next->next != NULL &&
a->next->next->next == NULL,
"%s: expected 2 operands", __func__);
struct ast *op1 = eval(a->next, e);
struct ast *op2 = eval(a->next->next, e);
assert (op1 != NULL &&
op1->type == AST_TOK &&
op1->v.token->type == NUM &&
op2 != NULL &&
op2->type == AST_TOK &&
op2->v.token->type == NUM);
return make_ast(AST_TOK,
make_token(NUM,
op1->v.token->v.num +
reassure(op1 != NULL &&
op1->type == AST_TOK &&
op1->v.token->type == NUM &&
op2 != NULL &&
op2->type == AST_TOK &&
op2->v.token->type == NUM,
"%s: expected <num> <num> operands", __func__);
return make_ast(AST_TOK,
make_token(NUM,
op1->v.token->v.num +
op2->v.token->v.num,
NULL));
}
@ -378,22 +423,24 @@ eval_add(struct ast *a, struct env *e)
struct ast *
eval_lt(struct ast *a, struct env *e)
{
assert (a != NULL &&
a->next != NULL &&
a->next->next != NULL &&
a->next->next->next == NULL);
reassure (a != NULL &&
a->next != NULL &&
a->next->next != NULL &&
a->next->next->next == NULL,
"%s: expected 2 operands", __func__);
struct ast *op1 = eval(a->next, e);
struct ast *op2 = eval(a->next->next, e);
assert (op1 != NULL &&
op1->type == AST_TOK &&
op1->v.token->type == NUM &&
op2 != NULL &&
op2->type == AST_TOK &&
op2->v.token->type == NUM);
return make_ast(AST_TOK,
make_token(BOOL,
reassure(op1 != NULL &&
op1->type == AST_TOK &&
op1->v.token->type == NUM &&
op2 != NULL &&
op2->type == AST_TOK &&
op2->v.token->type == NUM,
"%s: expected <NUM> <NUM> operands", __func__);
return make_ast(AST_TOK,
make_token(BOOL,
op1->v.token->v.num <
op2->v.token->v.num,
NULL));
@ -403,18 +450,19 @@ eval_lt(struct ast *a, struct env *e)
struct ast *
eval_inv(struct ast *a, struct env *e)
{
assert(a != NULL &&
a->next != NULL &&
a->next->next == NULL);
reassure(a != NULL &&
a->next != NULL &&
a->next->next == NULL,
"%s: expected one argument", __func__);
struct ast *op = eval(a->next, e);
assert(op != NULL &&
op->type == AST_TOK &&
op->v.token->type == NUM &&
op->next == NULL);
return make_ast(AST_TOK,
make_token(NUM,
0 -
op->v.token->v.num,
reassure(op != NULL &&
op->type == AST_TOK &&
op->v.token->type == NUM &&
op->next == NULL,
"%s: expected <NUM> argument", __func__);
return make_ast(AST_TOK,
make_token(NUM,
0 - op->v.token->v.num,
NULL));
}
@ -422,16 +470,18 @@ eval_inv(struct ast *a, struct env *e)
struct ast *
eval_num2bool(struct ast *a, struct env *e)
{
assert(a != NULL &&
a->next != NULL &&
a->next->next == NULL);
reassure(a != NULL &&
a->next != NULL &&
a->next->next == NULL,
"%s: expected one operand", __func__);
struct ast *op = eval(a->next, e);
assert(op != NULL &&
op->type == AST_TOK &&
op->v.token->type == NUM &&
op->next == NULL);
return make_ast(AST_TOK,
make_token(BOOL,
reassure(op != NULL &&
op->type == AST_TOK &&
op->v.token->type == NUM &&
op->next == NULL,
"%s: expected <num> operand", __func__);
return make_ast(AST_TOK,
make_token(BOOL,
op->v.token->v.num != 0,
NULL));
}
@ -442,6 +492,21 @@ eval_internal_sym(struct ast *a, struct env *e)
if (strcmp(a->v.token->v.str, "def") == 0)
return eval_def(a, e);
else if (strcmp(a->v.token->v.str, "lm") == 0) {
//new->v.token = a->v.token;
struct ast *l = make_ast(AST_LIST, NULL);
struct ast *head = make_ast(AST_TOK, NULL);
l->v.list = head;
head->v.token = a->v.token;
return l;
/* fprintf(stderr, "%d\n", a->type); */
/* fprintf(stderr, "%s\n", a->v.token->v.str); */
/* fprintf(stderr, "%d\n", a->v.token->next->type); */
/* fprintf(stderr, "%d\n", a->v.token->next->next->type); */
/* fprintf(stderr, "%d\n", a->v.token->next->next->next->type); */
/* fprintf(stderr, "%d\n", a->v.token->next->next->next->next->type); */
} else if (strcmp(a->v.token->v.str, "if") == 0) {
return eval_if(a, e);
} else if (strcmp(a->v.token->v.str, "inv") == 0) {
@ -465,15 +530,67 @@ struct ast *
eval_defined_sym(struct ast *a, struct env *e)
{
struct ast *var = lookup(e, a->v.token->v.str);
assert(var != NULL); /* variable found? */
reassure(var != NULL,
"%s: symbol %s not found",
__func__, a->v.token->v.str);
return var;
}
struct ast *
eval_defined_function(struct ast *a, struct env *e)
{
reassure((AST_TOK == a->type) &&
a->v.token->type == SYM,
"%s: expected SYM", __func__);
fprintf(stderr, "lookup: %d\n", a->type);
fprintf(stderr, "lookup: %s\n", a->v.token->v.str);
struct ast *fn = lookup(e, a->v.token->v.str);
fprintf(stderr, "type: %d\n", fn->type);
fprintf(stderr, "token p: %p\n", fn->v.token);
fprintf(stderr, "list p:%p\n", fn->v.list);
fprintf(stderr, "list: nxt type: %d\n", fn->v.list->type); /* sym */
fprintf(stderr, "list: nxt token type: %d\n", fn->v.list->v.token->type); /* sym */
fprintf(stderr, "list: nxt token type: %s\n", fn->v.list->v.token->v.str); /* sym */
/* fprintf(stderr, "nxt tok p: %p\n", fn->list->v.token); /\* sym *\/ */
/* fprintf(stderr, "nxt list p: %s\n", fn->list->v.list); /\* sym *\/ */
/* fprintf(stderr, "nxt type: %d\n", fn->next->type); /\* sym *\/ */
/* fprintf(stderr, "nxt tok p: %p\n", fn->next->v.token); /\* sym *\/ */
/* fprintf(stderr, "nxt list p: %s\n", fn->next->v.list); /\* sym *\/ */
reassure(fn != NULL &&
fn->type == AST_LIST &&
fn->v.list != NULL &&
fn->v.list->type == AST_TOK &&
fn->v.list->v.token->type == SYM &&
(strcmp(fn->v.list->v.token->v.str, "lm") == 0), "broken");
/* fprintf(stderr, "type %d\n", a->type); */
/* fprintf(stderr, "type %s\n", a->v.list->v.token->v.str); */
a = a->next; /* skip "lm" */
}
struct ast *
eval_list(struct ast *a, struct env *e)
{
if (token_is_internal(a->v.list->v.token))
return eval_internal_sym(a->v.list, e);
else
return eval_defined_function(a->v.list, e);
}
struct ast *
eval(struct ast *a, struct env *e)
{
if (a == NULL) return NULL;
if (a == NULL)
return NULL;
switch (a->type) {
case AST_TOK:
if (token_is_num(a->v.token))
@ -485,19 +602,17 @@ eval(struct ast *a, struct env *e)
else if (token_is_bool(a->v.token))
return make_ast(AST_TOK, a->v.token);
case AST_LIST:
/* XXX either it's an internal function, a custom defined function
* or an lambda expression ((lm (x) (* x x)) 2) */
assert ((a->v.list->type == AST_TOK &&
a->v.list->v.token->type == SYM) ||
(a->v.list->type == AST_LIST));
if (token_is_internal(a->v.list->v.token))
return eval_internal_sym(a->v.list, e);
/* else if ((r = eval_defined_function(a->v.list, e)) != NULL) */
/* return r; */
assert(0);
/* XXX either it's an internal function, a custom
* defined function or an lambda expression
* ((lm (x) (* x x)) 2)
*/
reassure ((a->v.list->type == AST_TOK &&
a->v.list->v.token->type == SYM) ||
(a->v.list->type == AST_LIST),
"%s: expected LIST or TOK", __func__);
return eval_list(a, e);
default:
fprintf(stderr, "%d\n", a->type);
assert(0);
reassure(0, "%s: wrong AST Type", __func__);
}
return NULL;
}
@ -506,7 +621,7 @@ void
pr(struct ast *a)
{
if (a == NULL) {
fprintf(stderr, "null %p\n", a);
fprintf(stderr, "nil %p\n", a);
return;
}
switch (a->type) {
@ -526,6 +641,7 @@ pr(struct ast *a)
break;
case AST_LIST:
printf("#fn\n");
break;
default:
err(1, "don't know how to print");
}
@ -546,7 +662,7 @@ read_form()
if (u == NULL) u = t;
else u->next = t;
u = t;
if (!open) {
return start;
}
@ -558,8 +674,8 @@ int main(void)
{
struct env default_env = { 0 }, *env;
env = &default_env;
env->name = "__dummy";
env->name = "__llm";
while (1)
pr(eval(parse(read_form()), env));
return 0;
@ -570,7 +686,7 @@ int main(void)
* Local Variables:
* mode: c;
* eval: (message "main()")
* fill-column: 80
* fill-column: 65
* comment-column: 40
* indent-tabs-mode: nil
* tab-width: 2