function evaluation added
- `struct env` moved and `struct env` stores a pointer to an environment now as well. this is necessary to correctly evaluate functions at a later point in time. consider (cons 1 2) which returns a function that binds arg1=1 and arg2=2. later, either arg1 or arg2 will be accessed when doing (car (cons 1 2)) -> 1 (cdr (cons 1 2)) -> 2 - debug_tval and debug_env has been added to show token or environments. - add several reassure statements to verify the validity of the code. - remove unnecessary 2nd environmental flag for eval(). [ i thought this might be necessary to properly evaluate function calls but it turns out it's not necessary ] - add new function eval_lm(). this one should make the code structure cleaner and other custom forms have their own function as well. while there, remove debugging code as well - remove eval_fn_name function (this one is actually not necessary) - cleanup and implement eval_fn_call to call custom defined functions. most of the former code has been removed and newly implemented. some examples that work now: (def cons (lm (x y) (lm (z) (if z x y)))) (def cell (cons 1 2)) (def cell2 (cons 3 cell)) (cell2 t) -> 3 (cell2 nil) -> #fn ((cell2 nil) t) -> 1 (cell2 nil) nil) -> 2 (def inc (lm (x) (add x 1))) (inc 1) ; -> 2 (def inc2 (lm (x) (inc (inc x)))) (inc2 2) -> 4 [ more testing is still necessary ] - BUGS section added - small formatting updates here and there, whitespace removal etc.
This commit is contained in:
parent
293e6b80e4
commit
4b640bd275
429
tokenize.l
429
tokenize.l
|
@ -1,6 +1,6 @@
|
|||
/* ~~~~~~~~~~~~~~~~ llm - The little LISP machinery ~~~~~~~~~~~~~
|
||||
*
|
||||
* Copyright (c) 2019 Christian Barthel <bch@online.de>
|
||||
* Copyright (c) 2019 Christian Barthel <bch@online.de>
|
||||
* All rights reserved.
|
||||
*
|
||||
* Redistribution and use in source and binary forms, with or
|
||||
|
@ -29,11 +29,11 @@
|
|||
* THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY
|
||||
* OF SUCH DAMAGE.
|
||||
*
|
||||
* Goal: evaluate simple LISP forms in an
|
||||
* read-eval-print stylized loop. supports:
|
||||
* Goal: evaluate simple LISP forms (strong type checking)
|
||||
* with a read-eval-print loop.
|
||||
*
|
||||
* Data types:
|
||||
* # Functions
|
||||
* #fn Functions
|
||||
* t,nil boolean (nand <bool> <bool>) -> boolean
|
||||
* "str" Strings (streq <string> <string>) -> boolean
|
||||
* abc Symboles (symeq <sym> <sym>) -> boolean
|
||||
|
@ -43,14 +43,23 @@
|
|||
* (num2bool <num>) -> boolean
|
||||
*
|
||||
* Special Forms:
|
||||
* (def <var> <symbol,number,#function)
|
||||
* (lm (<symbol> ..) (<symbol>))
|
||||
* (if <bool> <eval if true> <eval if false>)
|
||||
* (def <SYM> <ARG:symbol,number,#function>)
|
||||
* Bind ARG to name SYM in current environment.
|
||||
* (lm (<PARAM>) (<BODY>))
|
||||
* create function with one or more PARAMs and
|
||||
* BODY.
|
||||
* (if <BOOL> <CASETRUE> <CASEFALSE>)
|
||||
* Evaluate BOOL and execute CASETRUE if true,
|
||||
* otherwise evaulate CASEFALSE
|
||||
* (quote a)
|
||||
*
|
||||
* Return a.
|
||||
*
|
||||
* Compile: flex tokenize.l && cc lex.yy.c -lfl -o llm
|
||||
* Or: make; ./llm
|
||||
* (tested on FreeBSD, should run on most POSIX
|
||||
* systems)
|
||||
* BUGS:
|
||||
* no freeing of memory (yet)
|
||||
*/
|
||||
%{
|
||||
#define _POSIX_C_SOURCE 200809L
|
||||
|
@ -72,6 +81,14 @@ struct token {
|
|||
};
|
||||
|
||||
struct ast;
|
||||
struct env;
|
||||
struct env {
|
||||
char *name;
|
||||
struct ast *a;
|
||||
struct env *parent;
|
||||
struct env *next;
|
||||
};
|
||||
|
||||
struct ast {
|
||||
int type;
|
||||
union {
|
||||
|
@ -79,14 +96,7 @@ struct ast {
|
|||
struct ast *list;
|
||||
} v;
|
||||
struct ast *next;
|
||||
};
|
||||
|
||||
struct env;
|
||||
struct env {
|
||||
char *name;
|
||||
struct ast *a;
|
||||
struct env *parent;
|
||||
struct env *next;
|
||||
struct env *env;
|
||||
};
|
||||
|
||||
enum asttype {
|
||||
|
@ -105,25 +115,28 @@ enum yytokentype {
|
|||
};
|
||||
|
||||
struct token* make_token(enum yytokentype, int, char*);
|
||||
struct ast* eval(struct ast *a, struct env *e, struct env **w);
|
||||
struct ast* eval(struct ast *a, struct env *e);
|
||||
struct ast * lookup(struct env *e, char *name);
|
||||
void debug_ast(struct ast *a, int indent);
|
||||
|
||||
int yylval;
|
||||
char *yystr;
|
||||
%}
|
||||
|
||||
%%
|
||||
"(" { return LPAR; }
|
||||
")" { return RPAR; }
|
||||
t { yylval = 1; return BOOL;}
|
||||
nil { yylval = 0; return BOOL; }
|
||||
[0-9]+ { yylval = atoi(yytext); return NUM; }
|
||||
;.* { /* comment */ }
|
||||
[ \t\n] { /* ignore white space */ }
|
||||
\"[^\"]*\" { return STR; }
|
||||
"(" { return LPAR; }
|
||||
")" { return RPAR; }
|
||||
t { yylval = 1; return BOOL;}
|
||||
nil { yylval = 0; return BOOL; }
|
||||
[0-9]+ { yylval = atoi(yytext); return NUM; }
|
||||
;.* { /* comment */ }
|
||||
[ \t\n] { /* ignore white space */ }
|
||||
\"[^\"]*\" { return STR; }
|
||||
[a-zA-Z][_a-zA-Z0-9]* { return SYM; }
|
||||
. { err(1, "invalid symbol: %s\n", yytext); }
|
||||
. { err(1, "invalid symbol: %s\n", yytext); }
|
||||
%%
|
||||
|
||||
|
||||
/* ------------------------------------------------------------ */
|
||||
void
|
||||
reassure(int promised, const char *fmt, ...)
|
||||
{
|
||||
|
@ -146,21 +159,43 @@ debug_token(struct token *x, int indent)
|
|||
return;
|
||||
}
|
||||
fprintf(stderr, "%d: (%p)", x->type, x);
|
||||
if (x->type == NUM) fprintf(stderr, "%d @ %p", x->v.num, x);
|
||||
if (x->type == NUM)
|
||||
fprintf(stderr, "%d @ %p", x->v.num, x);
|
||||
if (x->type == STR || x->type == SYM)
|
||||
fprintf(stderr, "%s", x->v.str);
|
||||
putc('\n', stderr);
|
||||
}
|
||||
|
||||
int debug_tval(struct env *e, char *name)
|
||||
{
|
||||
struct ast *a = lookup(e, name);
|
||||
if (a != NULL && a->type == AST_TOK)
|
||||
return a->v.token->v.num;
|
||||
else
|
||||
return -1;
|
||||
}
|
||||
|
||||
void
|
||||
debug_env(struct env* e) {
|
||||
if (e== NULL) return;
|
||||
for (struct env* cu = e; cu; cu = cu->next)
|
||||
fprintf(stderr, "e: %s %d %p|%p\n",
|
||||
cu->name, debug_tval(e,cu->name), cu, e);
|
||||
fprintf(stderr, "-p-\n");
|
||||
debug_env(e->parent);
|
||||
}
|
||||
|
||||
void
|
||||
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",
|
||||
fprintf(stderr, "AST: %s,a=%p,list=%p,to=%p,next=%p,env=%p",
|
||||
(a->type == AST_TOK) ? "AST_TOK" :
|
||||
"AST_LIST", a, a->v.list, a->v.token, a->next);
|
||||
"AST_LST", a, a->v.list, a->v.token, a->next, a->env);
|
||||
putc('\n', stderr);
|
||||
if (a->env != NULL)
|
||||
debug_env(a->env);
|
||||
if (a->type == AST_LIST) {
|
||||
fprintf(stderr, "enter %p\n", a->v.list);
|
||||
fprintf(stderr, "==\n");
|
||||
|
@ -173,6 +208,7 @@ debug_ast(struct ast *a, int indent)
|
|||
}
|
||||
}
|
||||
|
||||
/* ------------------------------------------------------------ */
|
||||
struct token*
|
||||
make_token(enum yytokentype type, int num, char* str)
|
||||
{
|
||||
|
@ -197,8 +233,8 @@ make_ast(enum asttype type, struct token *t)
|
|||
a->type = type;
|
||||
if (type == AST_TOK)
|
||||
a->v.token = t;
|
||||
/* else if (type == AST_LIST) */
|
||||
/* a->v.list = n; */
|
||||
else if (type == AST_LIST)
|
||||
return a;//reassure(0, "XXX unexpected state /*a->v.list=n*/");
|
||||
return a;
|
||||
}
|
||||
|
||||
|
@ -213,6 +249,7 @@ make_env(char *name, struct ast *a)
|
|||
return e;
|
||||
}
|
||||
|
||||
/* ------------------------------------------------------------ */
|
||||
int token_is_num(struct token *t) {return t->type == NUM;}
|
||||
|
||||
int token_is_sym(struct token *t) {return t->type == SYM;}
|
||||
|
@ -221,29 +258,31 @@ int token_is_str(struct token *t) {return t->type == STR;}
|
|||
|
||||
int token_is_bool(struct token *t) {return t->type == BOOL;}
|
||||
|
||||
int token_is_internal(struct token *t)
|
||||
int
|
||||
token_is_internal(struct token *t)
|
||||
{
|
||||
if (strcmp(t->v.str, "def") == 0) return 1;
|
||||
else if (strcmp(t->v.str, "lm") == 0) return 1;
|
||||
else if (strcmp(t->v.str, "if") == 0) return 1;
|
||||
else if (strcmp(t->v.str, "inv") == 0) return 1;
|
||||
else if (strcmp(t->v.str, "add") == 0) return 1;
|
||||
else if (strcmp(t->v.str, "lt") == 0) return 1;
|
||||
else if (strcmp(t->v.str, "nand") == 0) return 1;
|
||||
else if (strcmp(t->v.str, "q") == 0) return 1;
|
||||
if (strcmp(t->v.str, "def") == 0) return 1;
|
||||
else if (strcmp(t->v.str, "lm") == 0) return 1;
|
||||
else if (strcmp(t->v.str, "if") == 0) return 1;
|
||||
else if (strcmp(t->v.str, "inv") == 0) return 1;
|
||||
else if (strcmp(t->v.str, "add") == 0) return 1;
|
||||
else if (strcmp(t->v.str, "lt") == 0) return 1;
|
||||
else if (strcmp(t->v.str, "nand") == 0) return 1;
|
||||
else if (strcmp(t->v.str, "q") == 0) return 1;
|
||||
else if (strcmp(t->v.str, "num2bool") == 0) return 1;
|
||||
else return 0;
|
||||
}
|
||||
|
||||
|
||||
/* upon parsing a list of tokens like:
|
||||
/* ------------------------------------------------------------ */
|
||||
/* Global Variable alarm:
|
||||
* 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
|
||||
* token on this level. I've solved this with a global
|
||||
* variable `next` and reset the current symbol after
|
||||
* creating a sublist.
|
||||
* creating a sublist. Not the ideal way, though.
|
||||
*/
|
||||
struct token *next;
|
||||
struct ast*
|
||||
|
@ -257,19 +296,16 @@ parse(struct token *t)
|
|||
struct ast *a, *p;
|
||||
t = t->next;
|
||||
while (t->type != RPAR) {
|
||||
reassure(t != NULL,
|
||||
"%s: unexpected NULL", __func__);
|
||||
reassure(t != NULL, "%s: unexpected NULL", __func__);
|
||||
a = parse(t);
|
||||
if (a == NULL)
|
||||
err(1, "syntax error");
|
||||
reassure(a != NULL, "syntax error");
|
||||
if (head->v.list == NULL)
|
||||
p = head->v.list = a;
|
||||
else
|
||||
p->next = a;
|
||||
p = a;
|
||||
t = next; /* skip all tokens that are processed */
|
||||
reassure(t != NULL,
|
||||
"%s: unexpected NULL(2)", __func__);
|
||||
reassure(t != NULL, "%s: unexpected NULL(2)", __func__);
|
||||
}
|
||||
reassure(t->type == RPAR,
|
||||
"%s: RPAR expected but given: %d",
|
||||
|
@ -308,21 +344,18 @@ lookup(struct env *e, char *name)
|
|||
{
|
||||
if (e == NULL)
|
||||
return NULL;
|
||||
for (struct env *t = e; t != NULL; t = t->next) {
|
||||
/* fprintf(stderr, "env: %s\n", t->name); */
|
||||
for (struct env *t = e; t != NULL; t = t->next)
|
||||
if (strcmp(t->name, name) == 0)
|
||||
return t->a;
|
||||
}
|
||||
//fprintf(stderr, "====\n");
|
||||
return lookup(e->parent, name);
|
||||
}
|
||||
|
||||
/* (def a <ausdruck>) */
|
||||
/* LISP Form: (def a <ausdruck>) */
|
||||
struct ast *
|
||||
eval_def(struct ast *a, struct env *e)
|
||||
{
|
||||
a = a->next; /* skip `def` */
|
||||
//debug_ast(a, 0);
|
||||
|
||||
reassure(a->v.token->type == SYM, /* must be a symbol */
|
||||
"%s: expected SYM, given: %d",
|
||||
__func__, a->v.token->type);
|
||||
|
@ -347,24 +380,23 @@ eval_def(struct ast *a, struct env *e)
|
|||
"%s: %s already assigned in env=%p",
|
||||
__func__, new, e);
|
||||
|
||||
append(e, make_env(new, eval(a->next, e, NULL)));
|
||||
append(e, make_env(new, eval(a->next, e)));
|
||||
|
||||
reassure(a->next->next == NULL,
|
||||
"%s: ended with unexpected token", __func__);
|
||||
return NULL;
|
||||
}
|
||||
|
||||
/* (if <cond:bool> <expression> <expression>) */
|
||||
/* LISP form: (if <cond:bool> <expression> <expression>) */
|
||||
struct ast *
|
||||
eval_if(struct ast *a, struct env *e)
|
||||
{
|
||||
//debug_ast(a, 0);
|
||||
a = a->next;
|
||||
|
||||
reassure(a != NULL && a->next != NULL,
|
||||
"%s: unexpected NULL", __func__);
|
||||
|
||||
struct ast *condition = eval(a, e, NULL);
|
||||
struct ast *condition = eval(a, e);
|
||||
|
||||
reassure(condition != NULL &&
|
||||
condition->type == AST_TOK &&
|
||||
|
@ -376,12 +408,12 @@ eval_if(struct ast *a, struct env *e)
|
|||
__func__);
|
||||
|
||||
if (condition->v.token->v.num == 1)
|
||||
return eval(a->next, e, NULL);
|
||||
return eval(a->next, e);
|
||||
else
|
||||
return eval(a->next->next, e, NULL);
|
||||
return eval(a->next->next, e);
|
||||
}
|
||||
|
||||
/* (nand <ausdruck::bool> <audsruck::bool>) -> BOOL */
|
||||
/* LISP form: (nand <ausdruck::bool> <audsruck::bool>) -> BOOL */
|
||||
struct ast *
|
||||
eval_nand(struct ast *a, struct env *e)
|
||||
{
|
||||
|
@ -391,8 +423,8 @@ eval_nand(struct ast *a, struct env *e)
|
|||
a->next->next->next == NULL,
|
||||
"%s: unexpected NULL", __func__);
|
||||
|
||||
struct ast *op1 = eval(a->next, e, NULL);
|
||||
struct ast *op2 = eval(a->next->next, e, NULL);
|
||||
struct ast *op1 = eval(a->next, e);
|
||||
struct ast *op2 = eval(a->next->next, e);
|
||||
|
||||
reassure(op1 != NULL &&
|
||||
op1->type == AST_TOK &&
|
||||
|
@ -403,13 +435,12 @@ eval_nand(struct ast *a, struct env *e)
|
|||
"%s: expected <bool> <bool> operands", __func__);
|
||||
return make_ast(AST_TOK,
|
||||
make_token(BOOL,
|
||||
!(
|
||||
op1->v.token->v.num &
|
||||
op2->v.token->v.num) ,
|
||||
!(op1->v.token->v.num &
|
||||
op2->v.token->v.num),
|
||||
NULL));
|
||||
}
|
||||
|
||||
/* (add <ausdruck::NUM> <audsruck::NUM>) -> NUM */
|
||||
/* LISP form (add <ausdruck::NUM> <audsruck::NUM>) -> NUM */
|
||||
struct ast *
|
||||
eval_add(struct ast *a, struct env *e)
|
||||
{
|
||||
|
@ -419,8 +450,8 @@ eval_add(struct ast *a, struct env *e)
|
|||
a->next->next->next == NULL,
|
||||
"%s: expected 2 operands", __func__);
|
||||
|
||||
struct ast *op1 = eval(a->next, e, NULL);
|
||||
struct ast *op2 = eval(a->next->next, e, NULL);
|
||||
struct ast *op1 = eval(a->next, e);
|
||||
struct ast *op2 = eval(a->next->next, e);
|
||||
|
||||
reassure(op1 != NULL &&
|
||||
op1->type == AST_TOK &&
|
||||
|
@ -446,8 +477,8 @@ eval_lt(struct ast *a, struct env *e)
|
|||
a->next->next->next == NULL,
|
||||
"%s: expected 2 operands", __func__);
|
||||
|
||||
struct ast *op1 = eval(a->next, e, NULL);
|
||||
struct ast *op2 = eval(a->next->next, e, NULL);
|
||||
struct ast *op1 = eval(a->next, e);
|
||||
struct ast *op2 = eval(a->next->next, e);
|
||||
|
||||
reassure(op1 != NULL &&
|
||||
op1->type == AST_TOK &&
|
||||
|
@ -463,7 +494,7 @@ eval_lt(struct ast *a, struct env *e)
|
|||
NULL));
|
||||
}
|
||||
|
||||
/* (inv <ausdruck::NUM>) -> NUM */
|
||||
/* LISP form: (inv <ausdruck::NUM>) -> NUM */
|
||||
struct ast *
|
||||
eval_inv(struct ast *a, struct env *e)
|
||||
{
|
||||
|
@ -471,7 +502,7 @@ eval_inv(struct ast *a, struct env *e)
|
|||
a->next != NULL &&
|
||||
a->next->next == NULL,
|
||||
"%s: expected one argument", __func__);
|
||||
struct ast *op = eval(a->next, e, NULL);
|
||||
struct ast *op = eval(a->next, e);
|
||||
reassure(op != NULL &&
|
||||
op->type == AST_TOK &&
|
||||
op->v.token->type == NUM &&
|
||||
|
@ -491,7 +522,7 @@ eval_num2bool(struct ast *a, struct env *e)
|
|||
a->next != NULL &&
|
||||
a->next->next == NULL,
|
||||
"%s: expected one operand", __func__);
|
||||
struct ast *op = eval(a->next, e, NULL);
|
||||
struct ast *op = eval(a->next, e);
|
||||
reassure(op != NULL &&
|
||||
op->type == AST_TOK &&
|
||||
op->v.token->type == NUM &&
|
||||
|
@ -503,44 +534,55 @@ eval_num2bool(struct ast *a, struct env *e)
|
|||
NULL));
|
||||
}
|
||||
|
||||
struct ast * /* */
|
||||
eval_lm(struct ast *x, struct env *e)
|
||||
{
|
||||
//debug_ast(x, 0);
|
||||
reassure(x != NULL &&
|
||||
x->type == AST_TOK &&
|
||||
x->v.token != NULL &&
|
||||
x->v.token->type == SYM,
|
||||
"%s: expected lambda lm", __func__);
|
||||
|
||||
struct ast *l = make_ast(AST_LIST, NULL);
|
||||
l->v.list = x;
|
||||
l->env = e;
|
||||
|
||||
// l->next = x->next; /* body */
|
||||
// l->v.list = x->v.list; /* args */
|
||||
|
||||
// XXX fprintf(stderr, "internal lm sym with env: \n");
|
||||
// fprintf(stderr, "==========================\n");
|
||||
// debug_env(l->env);
|
||||
// fprintf(stderr, "==========================\n");
|
||||
// debug_ast(l,0);
|
||||
|
||||
return l;
|
||||
}
|
||||
|
||||
struct ast *
|
||||
eval_internal_sym(struct ast *x, struct env *e)
|
||||
{
|
||||
struct ast *a = x->v.list;
|
||||
|
||||
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;
|
||||
return x;
|
||||
struct ast *l = make_ast(AST_LIST, NULL);
|
||||
struct ast *head = make_ast(AST_TOK, NULL);
|
||||
l->v.list = head;
|
||||
l->next = a->next;
|
||||
fprintf(stderr, "%p, %p\n", l->next, a->next);
|
||||
l->next->next = a->next->next;
|
||||
//debug_ast(l, 0);
|
||||
head->v.token = a->v.token;
|
||||
//fprintf(stderr, "returning AST:\n");
|
||||
//fprintf(stderr, "------------------------\n");
|
||||
//debug_ast(l, 0);
|
||||
//fprintf(stderr, "------------------------\n");
|
||||
return l;
|
||||
} else if (strcmp(a->v.token->v.str, "if") == 0) {
|
||||
else if (strcmp(a->v.token->v.str, "lm") == 0)
|
||||
return eval_lm(a, e);
|
||||
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) {
|
||||
else if (strcmp(a->v.token->v.str, "inv") == 0)
|
||||
return eval_inv(a, e);
|
||||
} else if (strcmp(a->v.token->v.str, "add") == 0) {
|
||||
else if (strcmp(a->v.token->v.str, "add") == 0)
|
||||
return eval_add(a, e);
|
||||
} else if (strcmp(a->v.token->v.str, "lt") == 0) {
|
||||
else if (strcmp(a->v.token->v.str, "lt") == 0)
|
||||
return eval_lt(a, e);
|
||||
} else if (strcmp(a->v.token->v.str, "nand") == 0) {
|
||||
else if (strcmp(a->v.token->v.str, "nand") == 0)
|
||||
return eval_nand(a, e);
|
||||
} else if (strcmp(a->v.token->v.str, "q") == 0) {
|
||||
//return make_ast(AST_QUOTE, a->next);
|
||||
else if (strcmp(a->v.token->v.str, "q") == 0)
|
||||
return a->next;
|
||||
} else if (strcmp(a->v.token->v.str, "num2bool") == 0) {
|
||||
else if (strcmp(a->v.token->v.str, "num2bool") == 0)
|
||||
return eval_num2bool(a, e);
|
||||
}
|
||||
return NULL;
|
||||
}
|
||||
|
||||
|
@ -548,28 +590,32 @@ struct ast *
|
|||
eval_defined_sym(struct ast *a, struct env *e)
|
||||
{
|
||||
struct ast *var = lookup(e, a->v.token->v.str);
|
||||
if (var == NULL)
|
||||
debug_env(e);
|
||||
reassure(var != NULL,
|
||||
"%s: symbol %s not found",
|
||||
__func__, a->v.token->v.str);
|
||||
return var;
|
||||
}
|
||||
struct env *lastenv;
|
||||
|
||||
struct env *
|
||||
bind_args(struct token *args,
|
||||
struct ast *fnargs_values, struct env *e)
|
||||
struct ast *fnargs_values, struct env *e1, struct env *e)
|
||||
{
|
||||
reassure(args && args->type == LPAR,
|
||||
"%s: first argument: %d %s", __func__, args->type, args->v.str);
|
||||
"%s: first argument: %d %s", __func__,
|
||||
args->type, args->v.str);
|
||||
args = args->next;
|
||||
|
||||
struct ast *a = fnargs_values;
|
||||
struct token *t = args;
|
||||
struct env *newenv = (struct env*)
|
||||
calloc(1, sizeof(struct env));
|
||||
struct env *newenv = (struct env*)calloc(1, sizeof(struct env));
|
||||
|
||||
reassure(newenv != NULL,
|
||||
"%s: allocation failed for newenv", __func__);
|
||||
|
||||
newenv->name = strdup("__fn");
|
||||
newenv->parent = e;
|
||||
lastenv = newenv;
|
||||
|
||||
while (t != NULL && t->type != RPAR) {
|
||||
reassure(t != NULL &&
|
||||
|
@ -582,9 +628,8 @@ bind_args(struct token *args,
|
|||
"%s: arg=%s given, but no value present",
|
||||
__func__, t->v.str);
|
||||
|
||||
struct ast *new = eval(a, e, NULL);
|
||||
|
||||
append(newenv, make_env(t->v.str, new));
|
||||
append(newenv,
|
||||
make_env(t->v.str, eval(a, e1)));
|
||||
|
||||
t = t->next;
|
||||
a = a->next;
|
||||
|
@ -600,128 +645,43 @@ bind_args(struct token *args,
|
|||
}
|
||||
|
||||
struct ast *
|
||||
eval_fn_name(struct ast *a, struct env *e, struct env **w)
|
||||
eval_fn_call(struct ast *a, struct env *e)
|
||||
{
|
||||
if (a->type == AST_LIST) {
|
||||
//fprintf(stderr, "eval list\n");
|
||||
//debug_ast(a, 0);
|
||||
//reassure(0, "not implemented\n");
|
||||
//return eval(a, e, NULL);
|
||||
return a;
|
||||
} else if (a->type == AST_TOK) {
|
||||
//fprintf(stderr, "eval token: %s\n", a->v.token->v.str);
|
||||
struct ast *fn = lookup(e, a->v.token->v.str);
|
||||
return eval(fn, e, NULL);
|
||||
}
|
||||
struct ast *fn = eval(a, e);
|
||||
|
||||
reassure(fn != NULL &&
|
||||
fn->type == AST_LIST &&
|
||||
fn->v.list != NULL &&
|
||||
fn->v.list->next != NULL &&
|
||||
fn->v.list->next->next != NULL &&
|
||||
fn->v.list->type == AST_TOK &&
|
||||
fn->v.list->v.token != NULL &&
|
||||
fn->v.list->v.token->next != NULL,
|
||||
"%s: function evaluation returned <NULL> or"
|
||||
"wrong form, expected: (lm <param> <body>)", __func__);
|
||||
|
||||
//struct ast *fn_args = fn->v.list->next;
|
||||
struct ast *fn_body = fn->v.list->next->next;
|
||||
struct token *args_head = fn->v.list->v.token->next;
|
||||
struct ast *fn_args_values = a->next;
|
||||
|
||||
struct env *newenv =
|
||||
bind_args(args_head, fn_args_values, e, fn->env);
|
||||
|
||||
return eval(fn_body, newenv);
|
||||
}
|
||||
|
||||
struct ast *
|
||||
eval_fn_call(struct ast *a, struct env *e, struct env **w)
|
||||
{
|
||||
//fprintf(stderr, "~~~~~~~~~~~~~~~~~~~~~~~~ eval call\n");
|
||||
|
||||
struct ast *fn = eval_fn_name(a, e, NULL);
|
||||
struct ast *fn_body = fn->v.list->next->next;
|
||||
struct ast *fn_args = fn->v.list->next;
|
||||
struct token *args_head = fn->v.list->v.token->next;
|
||||
struct ast *fn_args_values = a->next;
|
||||
//debug_ast(fn, 0);
|
||||
|
||||
struct env *newenv = bind_args(args_head, fn_args_values, e);
|
||||
return eval(fn_body, newenv, NULL);
|
||||
}
|
||||
|
||||
struct ast *
|
||||
eval_fn_call_old(struct ast *a, struct env *e, struct env **w)
|
||||
{
|
||||
struct ast *fnargs_values;
|
||||
struct ast *fn_head;
|
||||
struct ast *fn_body;
|
||||
struct env *wanted = NULL;
|
||||
|
||||
fnargs_values = a->next;
|
||||
reassure(fnargs_values != NULL,
|
||||
"%s: expected RPAR or function args", __func__);
|
||||
|
||||
if (a->type == AST_TOK) {
|
||||
reassure((AST_TOK == a->type) &&
|
||||
a->v.token->type == SYM,
|
||||
"%s: expected SYM, is: %d",
|
||||
__func__, a->type);
|
||||
|
||||
char *fnstr = a->v.token->v.str;
|
||||
struct ast *fn = lookup(e, fnstr);
|
||||
debug_ast(fn, 0);
|
||||
|
||||
reassure(fn != NULL && fn->type == AST_LIST,
|
||||
"%s: lookup on `%s` failed", __func__, fnstr);
|
||||
|
||||
/* struct ast *fn2 = eval(fn, e, &wanted); */
|
||||
/* fprintf(stderr, "===========\n"); */
|
||||
debug_ast(fn, 0);
|
||||
/* fn_head = fn2->v.list; */
|
||||
/* fn_body = fn2->next->next; */
|
||||
fn_head = fn->v.list;
|
||||
fn_body = fn->next->next;
|
||||
} else if (a->type == AST_LIST
|
||||
&& strcmp(a->v.list->v.token->v.str, "lm") == 0) {
|
||||
/* ((lm (<param>) <body>) args) */
|
||||
fn_head = a->v.list;
|
||||
fn_body = a->v.list->next->next;
|
||||
} else {
|
||||
/* */
|
||||
struct ast *fn = eval(a, e, &wanted);
|
||||
fn_head = fn->v.list;
|
||||
fn_body = fn->next->next;
|
||||
}
|
||||
|
||||
reassure(fn_body != NULL && fn_body->type == AST_LIST,
|
||||
"%s: expected function body as list", __func__);
|
||||
|
||||
reassure(fn_head != NULL &&
|
||||
fn_head->type == AST_TOK &&
|
||||
fn_head->v.token->type == SYM &&
|
||||
strcmp(fn_head->v.token->v.str, "lm") == 0,
|
||||
"%s: expected #fn", __func__);
|
||||
|
||||
struct token *fnargs = fn_head->v.token->next;
|
||||
|
||||
reassure(fnargs != NULL &&
|
||||
fnargs->type == LPAR,
|
||||
"%s: args expected to be a list", __func__);
|
||||
|
||||
struct env *newenv = bind_args(fnargs, fnargs_values, e);
|
||||
if (wanted != NULL) {
|
||||
/* fprintf(stderr, "==lastenv\n"); */
|
||||
/* for (struct env *e = lastenv; e; e=e->next) */
|
||||
/* fprintf(stderr, "e: %s\n", e->name); */
|
||||
|
||||
/* fprintf(stderr, "==newenv:\n"); */
|
||||
/* for (struct env *e = newenv; e; e=e->next) */
|
||||
/* fprintf(stderr, "e: %s\n", e->name); */
|
||||
|
||||
newenv->parent = wanted;
|
||||
}
|
||||
if (w != NULL) {
|
||||
*w = newenv;
|
||||
}
|
||||
|
||||
reassure(newenv != NULL,
|
||||
"%s: setup for newenv failed", __func__);
|
||||
return eval(fn_body, newenv, NULL);
|
||||
}
|
||||
|
||||
struct ast *
|
||||
eval_list(struct ast *a, struct env *e, struct env **w)
|
||||
eval_list(struct ast *a, struct env *e)
|
||||
{
|
||||
if (token_is_internal(a->v.list->v.token))
|
||||
return eval_internal_sym(a, e);
|
||||
else
|
||||
return eval_fn_call(a->v.list, e, w);
|
||||
return eval_fn_call(a->v.list, e);
|
||||
}
|
||||
|
||||
struct ast *
|
||||
eval(struct ast *a, struct env *e, struct env **w)
|
||||
eval(struct ast *a, struct env *e)
|
||||
{
|
||||
if (a == NULL)
|
||||
return NULL;
|
||||
|
@ -736,12 +696,13 @@ eval(struct ast *a, struct env *e, struct env **w)
|
|||
return make_ast(AST_TOK, a->v.token);
|
||||
else if (token_is_bool(a->v.token))
|
||||
return make_ast(AST_TOK, a->v.token);
|
||||
reassure(0, "Unexptected token found");
|
||||
case AST_LIST:
|
||||
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, w);
|
||||
return eval_list(a, e);
|
||||
default:
|
||||
reassure(0, "%s: wrong AST Type", __func__);
|
||||
}
|
||||
|
@ -751,10 +712,9 @@ eval(struct ast *a, struct env *e, struct env **w)
|
|||
void
|
||||
pr(struct ast *a)
|
||||
{
|
||||
if (a == NULL) {
|
||||
//fprintf(stderr, "nil %p\n", a);
|
||||
if (a == NULL)
|
||||
return;
|
||||
}
|
||||
|
||||
switch (a->type) {
|
||||
case AST_TOK:
|
||||
if (a->v.token->type == NUM)
|
||||
|
@ -772,13 +732,7 @@ pr(struct ast *a)
|
|||
break;
|
||||
case AST_LIST:
|
||||
printf("#fn\n");
|
||||
struct token *t = a->v.list->v.token;
|
||||
debug_ast(a, 0);
|
||||
while (t != NULL) {
|
||||
printf("%d ", t->type);
|
||||
t = t->next;
|
||||
}
|
||||
putchar('\n');
|
||||
debug_env(a->env);
|
||||
break;
|
||||
default:
|
||||
err(1, "don't know how to print");
|
||||
|
@ -792,30 +746,31 @@ read_form()
|
|||
struct token *t, *u = NULL, *start = NULL;
|
||||
|
||||
while((tok = yylex())) {
|
||||
if (tok == LPAR) open++;
|
||||
if (tok == LPAR) open++;
|
||||
else if (tok == RPAR) open--;
|
||||
|
||||
t = make_token(tok, yylval, yytext);
|
||||
|
||||
if (start == NULL) start = t;
|
||||
if (u == NULL) u = t;
|
||||
else u->next = t;
|
||||
u = t;
|
||||
|
||||
if (!open) {
|
||||
if (!open)
|
||||
return start;
|
||||
}
|
||||
}
|
||||
exit(0);
|
||||
}
|
||||
|
||||
int main(void)
|
||||
int
|
||||
main(void)
|
||||
{
|
||||
struct env default_env = { 0 }, *env;
|
||||
env = &default_env;
|
||||
env->name = "__llm";
|
||||
|
||||
while (1)
|
||||
pr(eval(parse(read_form()), env, NULL));
|
||||
pr(eval(parse(read_form()), env));
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
|
Loading…
Reference in New Issue