llm/tokenize.l

836 lines
22 KiB
Plaintext

/* llm - litle lisp machinery:
*
* 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
* 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.
*
* 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
*/
%{
#define _POSIX_C_SOURCE 200809L
#define _XOPEN_SOURCE 600
#include <stdio.h>
#include <stdarg.h>
#include <string.h>
#include <err.h>
struct token;
struct token {
int type;
union {
char *str;
int num;
} v;
struct token *next;
};
struct ast;
struct ast {
int type;
union {
struct token *token;
struct ast *list;
} v;
struct ast *next;
};
struct env;
struct env {
char *name;
struct ast *a;
struct env *parent;
struct env *next;
};
enum asttype {
AST_TOK = 400,
AST_LIST = 401,
AST_QUOTE = 402
};
enum yytokentype {
NUM = 258,
LPAR = 259,
RPAR = 260,
SYM = 261,
STR = 262,
EOL = 263,
BOOL = 264
};
struct token* make_token(enum yytokentype, int, char*);
struct ast* eval(struct ast *a, struct env *e, struct env **w);
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; }
[a-zA-Z][_a-zA-Z0-9]* { return SYM; }
. { err(1, "invalid symbol: %s\n", yytext); }
%%
/*
* Goal: evaluate simple LISP forms in an
* read-eval-print stylized loop. supports:
*
* Data types:
* # Functions
* t,nil boolean (nand <bool> <bool>) -> boolean
* "str" Strings (streq <string> <string>) -> boolean
* abc Symboles (symeq <sym> <sym>) -> boolean
* 1234 Number/Integer (inv <num>) -> -num
* (add <num> <num>) -> num
* (lt <num> <num>) -> boolean
* (num2bool <num>) -> boolean
*
* Special Forms:
* (def <var> <symbol,number,#function)
* Bind symbol <var> in the current environment to
* the evaluated form.
* (lm (<symbol> ..) (<sym..> ))
* (if <bool> <body> <else>)
* (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);
if (x == NULL) {
fprintf(stderr, "NULL TOKEN\n");
return;
}
fprintf(stderr, "%d: (%p)", x->type, 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);
}
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",
(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) {
fprintf(stderr, "enter %p\n", a->v.list);
fprintf(stderr, "==\n");
debug_ast(a->v.list, indent+4);
fprintf(stderr, "==\n");
}
else if(a->type == AST_TOK)
debug_token(a->v.token, indent);
a = a->next;
}
}
struct token*
make_token(enum yytokentype type, int num, char* str)
{
struct token *t =
(struct token*) calloc(1, sizeof(struct token));
if (t == NULL)
err(1, "malloc failed");
t->type = type;
if (type == NUM || type == BOOL)
t->v.num = num;
else if (type == SYM || type == STR)
t->v.str = strdup(str);
return t;
}
struct ast*
make_ast(enum asttype type, struct token *t)
{
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; */
return a;
}
struct env*
make_env(char *name, struct ast *a)
{
struct env *e = (struct env*) calloc(1, sizeof(struct env));
if (e == NULL)
err(1, "malloc failed");
e->name = name;
e->a = 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;}
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)
{
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:
* "(" -> "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.
*/
struct token *next;
struct ast*
parse(struct token *t)
{
if (t == NULL)
err(1, "Unexpected token: <NULL>");
if (t->type == LPAR) {
struct ast *head = make_ast(AST_LIST, NULL);
struct ast *a, *p;
t = t->next;
while (t->type != RPAR) {
reassure(t != NULL,
"%s: unexpected NULL", __func__);
a = parse(t);
if (a == NULL)
err(1, "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->type == RPAR,
"%s: RPAR expected but given: %d",
__func__, t->type);
t = t->next;
next = t;
return head;
} else if (t->type == NUM) {
next = t->next;
return make_ast(AST_TOK, t);
} else if (t->type == BOOL) {
next = t->next;
return make_ast(AST_TOK, t);
} else if (t->type == SYM) {
next = t->next;
return make_ast(AST_TOK, t);
} else if (t->type == STR) {
next = t->next;
return make_ast(AST_TOK, t);
}
return NULL;
}
void
append(struct env *e, struct env *a)
{
if (e->next == NULL) {
e->next = a;
return;
} else
append(e->next, a);
}
struct ast *
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); */
if (strcmp(t->name, name) == 0)
return t->a;
}
//fprintf(stderr, "====\n");
return lookup(e->parent, name);
}
/* (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);
reassure(a != NULL && a->next != NULL, /* need sth to bind..*/
"%s: unexpected NULL", __func__);
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, NULL)));
reassure(a->next->next == NULL,
"%s: ended with unexpected token", __func__);
return NULL;
}
/* (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);
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, NULL);
else
return eval(a->next->next, e, NULL);
}
/* (nand <ausdruck::bool> <audsruck::bool>) -> BOOL */
struct ast *
eval_nand(struct ast *a, struct env *e)
{
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, NULL);
struct ast *op2 = eval(a->next->next, e, NULL);
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) ,
NULL));
}
/* (add <ausdruck::NUM> <audsruck::NUM>) -> NUM */
struct ast *
eval_add(struct ast *a, struct env *e)
{
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, NULL);
struct ast *op2 = eval(a->next->next, e, NULL);
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));
}
/* (lt <ausdruck::NUM> <audsruck::NUM>) -> BOOL*/
struct ast *
eval_lt(struct ast *a, struct env *e)
{
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, NULL);
struct ast *op2 = eval(a->next->next, e, NULL);
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));
}
/* (inv <ausdruck::NUM>) -> NUM */
struct ast *
eval_inv(struct ast *a, struct env *e)
{
reassure(a != NULL &&
a->next != NULL &&
a->next->next == NULL,
"%s: expected one argument", __func__);
struct ast *op = eval(a->next, e, NULL);
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));
}
/* (num2bool <ausdruck::NUM>) -> bool */
struct ast *
eval_num2bool(struct ast *a, struct env *e)
{
reassure(a != NULL &&
a->next != NULL &&
a->next->next == NULL,
"%s: expected one operand", __func__);
struct ast *op = eval(a->next, e, NULL);
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));
}
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) {
return eval_if(a, e);
} 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) {
return eval_add(a, e);
} 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) {
return eval_nand(a, e);
} else if (strcmp(a->v.token->v.str, "q") == 0) {
//return make_ast(AST_QUOTE, a->next);
return a->next;
} else if (strcmp(a->v.token->v.str, "num2bool") == 0) {
return eval_num2bool(a, e);
}
return NULL;
}
struct ast *
eval_defined_sym(struct ast *a, struct env *e)
{
struct ast *var = lookup(e, a->v.token->v.str);
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)
{
reassure(args && args->type == LPAR,
"%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));
newenv->name = strdup("__fn");
newenv->parent = e;
lastenv = newenv;
while (t != NULL && t->type != RPAR) {
reassure(t != NULL &&
t->type == SYM &&
t->v.str != NULL,
"%s: wrong args param found: %s",
__func__, t->v.str);
reassure(a != NULL &&
(a->type == AST_TOK || a->type == AST_LIST),
"%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));
t = t->next;
a = a->next;
}
reassure (t->type == RPAR,
"%s: args formulation suspicious: %d",
__func__, args->type);
reassure (a == NULL,
"%s: actual value given but no arg left",
__func__);
return newenv;
}
struct ast *
eval_fn_name(struct ast *a, struct env *e, struct env **w)
{
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 *
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)
{
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);
}
struct ast *
eval(struct ast *a, struct env *e, struct env **w)
{
if (a == NULL)
return NULL;
switch (a->type) {
case AST_TOK:
if (token_is_num(a->v.token))
return make_ast(AST_TOK, a->v.token);
else if (token_is_sym(a->v.token))
return eval_defined_sym(a, e);
else if (token_is_str(a->v.token))
return make_ast(AST_TOK, a->v.token);
else if (token_is_bool(a->v.token))
return make_ast(AST_TOK, a->v.token);
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);
default:
reassure(0, "%s: wrong AST Type", __func__);
}
return NULL;
}
void
pr(struct ast *a)
{
if (a == NULL) {
//fprintf(stderr, "nil %p\n", a);
return;
}
switch (a->type) {
case AST_TOK:
if (a->v.token->type == NUM)
printf("%d\n", a->v.token->v.num);
else if (a->v.token->type == STR)
printf("%s\n", a->v.token->v.str);
else if (a->v.token->type == SYM)
printf("%s\n", a->v.token->v.str);
else if (a->v.token->type == BOOL) {
if (a->v.token->v.num)
printf("t\n");
else
printf("nil\n");
}
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');
break;
default:
err(1, "don't know how to print");
}
}
struct token*
read_form()
{
int tok, open = 0;
struct token *t, *u = NULL, *start = NULL;
while((tok = yylex())) {
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) {
return start;
}
}
exit(0);
}
int main(void)
{
struct env default_env = { 0 }, *env;
env = &default_env;
env->name = "__llm";
while (1)
pr(eval(parse(read_form()), env, NULL));
return 0;
}
/*
* Local Variables:
* mode: c;
* eval: (message "main()")
* fill-column: 65
* comment-column: 40
* indent-tabs-mode: nil
* tab-width: 2
* c-basic-offset: 2
* End:
*/