From a9d27325c58eaebc70b277077df696d68a8f428f Mon Sep 17 00:00:00 2001 From: yoyo Date: Thu, 29 Aug 2024 19:56:05 +0900 Subject: [PATCH] first commit --- bltin.c | 53 ++++++++++++++++ dat.h | 65 ++++++++++++++++++++ error.c | 32 ++++++++++ eval.c | 167 ++++++++++++++++++++++++++++++++++++++++++++++++++ fn.h | 37 +++++++++++ gc.c | 182 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ main.c | 79 ++++++++++++++++++++++++ makefile | 26 ++++++++ obj.c | 76 +++++++++++++++++++++++ parser.c | 183 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ str.c | 41 +++++++++++++ 11 files changed, 941 insertions(+) create mode 100644 bltin.c create mode 100644 dat.h create mode 100644 error.c create mode 100644 eval.c create mode 100644 fn.h create mode 100644 gc.c create mode 100644 main.c create mode 100644 makefile create mode 100644 obj.c create mode 100644 parser.c create mode 100644 str.c diff --git a/bltin.c b/bltin.c new file mode 100644 index 0000000..4e2fb93 --- /dev/null +++ b/bltin.c @@ -0,0 +1,53 @@ +#include "dat.h" +#include "fn.h" + +Object Nil = (Object){.type=OSYMBOL, .sym="nil"}; +Object True = (Object){.type=OSYMBOL, .sym="true"}; +Object False= (Object){.type=OSYMBOL, .sym="false"}; +Object Minus= (Object){.type=OBLTIN, .sym="-"}; +Object Plus = (Object){.type=OBLTIN, .sym="+"}; +Object Lambda= (Object){.type=OBLTIN, .sym="lambda"}; +Object Car = (Object){.type=OBLTIN, .sym="car"}; +Object Cdr = (Object){.type=OBLTIN, .sym="cdr"}; +Object Quote= (Object){.type=OBLTIN, .sym="'"}; +Object Cons = (Object){.type=OBLTIN, .sym="cons"}; +Object Define= (Object){.type=OBLTIN, .sym="define"}; +Object Setq = (Object){.type=OBLTIN, .sym="setq"}; + +extern Object* fnplus(Object *, Object *); +extern Object* fnlambda(Object *, Object *); +extern Object* fndefine(Object *, Object *); +extern Object* fnsetq(Object *, Object *); +extern Object* fnundef(Object *, Object *); +/*extern Object* fnminus(Object *, Object *);*/ +/*extern Object* fncons(Object *, Object *);*/ +/*extern Object* fnquote(Object *, Object *);*/ +/*extern Object* fncar(Object *, Object *);*/ +/*extern Object* fncdr(Object *, Object *);*/ + +Bltinfn +bltinlookup(Object *obj) +{ + static struct + { + Object *sym; + Bltinfn fn; + }bltins[] = { + {&Lambda , fnlambda}, + {&Plus , fnplus}, + {&Define ,fndefine}, + {&Setq ,fnsetq}, + {&Minus ,0}, + {&Cons ,0}, + {&Quote ,0}, + {&Car ,0}, + {&Cdr ,0}, + 0, + }; + + for(int i = 0; bltins[i].sym; ++i){ + if(obj == bltins[i].sym) + return bltins[i].fn; + } + return 0; +} diff --git a/dat.h b/dat.h new file mode 100644 index 0000000..43e9a6f --- /dev/null +++ b/dat.h @@ -0,0 +1,65 @@ +typedef struct Object Object; +typedef Object* (*Bltinfn)(Object *env, Object *args); +typedef struct Object Object; + +enum OType +{ + OERROR, + OCELL, + OSYMBOL, + OIDENT, + OINT, + OSTRING, + OLAMBDA, + OBLTIN, + OFUNC, + OENV, +}; + +struct Object +{ + enum OType type; /* type */ + int flag; /* flag */ + Object *next; /* for gc */ + union{ + /* int */ + long num; + /* cell */ + struct{ + Object *car; + Object *cdr; + }; + /* string & ident */ + char *sym; + struct{ + char *beg; + char *ptr; + char *end; + }; + /* function */ + struct{ + Object *params; + Object *body; + Object *env; + }; + /* env */ + struct{ + Object *name; + Object *up; + Object *vars; + }; + }; +}; + +extern Object Nil; +extern Object True; +extern Object False; +extern Object Minus; +extern Object Plus; +extern Object Lambda; +extern Object Car; +extern Object Cdr; +extern Object Quote; +extern Object Cons; +extern Object Define; +extern Object Setq; diff --git a/error.c b/error.c new file mode 100644 index 0000000..f5ccf88 --- /dev/null +++ b/error.c @@ -0,0 +1,32 @@ +#include "dat.h" +#include "fn.h" +#include +#include +#include +#include + +void +panic(char *fmt, ...) +{ + va_list ap; + va_start(ap, fmt); + vfprintf(stderr, fmt, ap); + va_end(ap); + fprintf(stderr, "\n"); + exit(1); +} + +void +error(char *fmt, ...) +{ + extern jmp_buf err; + va_list ap; + + va_start(ap, fmt); + fprintf(stderr, "ERROR => "); + vfprintf(stderr, fmt, ap); + va_end(ap); + fprintf(stderr, "\n"); + longjmp(err, 1); + exit(1); +} diff --git a/eval.c b/eval.c new file mode 100644 index 0000000..fceea69 --- /dev/null +++ b/eval.c @@ -0,0 +1,167 @@ +#include "dat.h" +#include "fn.h" + +static Object* evallist(Object *env, Object *list); + +static int +exprlen(Object *expr) +{ + int l = 0; + for(;expr->type==OCELL; expr=expr->cdr) + ++l; + if(expr != &Nil) + error("Not list type"); + return l; +} + +static int +islist(Object *obj) +{ + return obj == &Nil || obj->type == OCELL; +} + +static Object* +find(Object *env, Object *obj) +{ + for(Object *cur=env; cur!=&Nil; cur=cur->up){ + for(Object *p=cur->vars; p!=&Nil; p=p->cdr) + if(strequal(obj, p->car->car)) + return p->car; + } + return 0; +} + +static Object* +enter(Object *env, Object *vars, Object *args) +{ + Object *map = &Nil; + for(;vars->type==OCELL; vars=vars->cdr,args=args->cdr){ + if(args->type!=OCELL) + error("Cna't apply function argment dose not match"); + Object *id = vars->car; + Object *val = args->car; + map = newacons(id, val, map); + } + return newenv(&Nil, map, env); +} + +Object* +fnlambda(Object *env, Object *l) +{ + if(l->type!=OCELL || islist(l->car)==0 || l->cdr->type!=OCELL) + error("malformed function"); + for(Object *p=l->car; p->type==OCELL; p=p->cdr){ + if(p->car->type!=OIDENT) + error("parameter is not IDNET"); + } + Object *params = l->car; + Object *body = l->cdr; + return newfn(env, params, body); +} + +Object* +fnsetq(Object *env, Object *list) +{ + if(exprlen(list)!=2 || list->car->type!=OIDENT) + error("Malformed setq"); + Object *obj = find(env, list->car); + if(obj == 0) + error("Not exist variable"); + return obj->cdr = eval(env, list->cdr->car); +} + +Object* +fndefine(Object *env, Object *list) +{ + if(exprlen(list)!=2 || list->car->type!=OIDENT) + error("Malformed define"); + Object *val = eval(env, list->cdr->car); + Object *obj = find(env, list->car); + if(obj) + return obj->cdr = val; + return env->vars = newacons(list->car, val, env->vars); +} + +Object* +fnplus(Object *env, Object *list) +{ + long sum = 0; + for(Object *p=evallist(env, list); p!=&Nil; p=p->cdr){ + if(p->car->type != OINT) + error("+ take only number"); + sum += p->car->num; + } + return newint(sum); +} + +static Object* +evallist(Object *env, Object *list) +{ + if(list == &Nil) + return &Nil; + if(list->type != OCELL) + error("type is not list"); + Object *car = eval(env, list->car); + Object *cdr = evallist(env, list->cdr); + return newcons(car, cdr); +} + +static Object* +applyfn(Object *fn, Object *args) +{ + Object *env = enter(fn->env, fn->params, args); + Object *r = 0; + for(Object *p=fn->body; p!=&Nil; p=p->cdr){ + r = p->car; + r = eval(env, r); + } + return r; +} + +static Object* +apply(Object *env, Object *fn, Object *args) +{ + if(islist(args) == 0) + error("args is not list type"); + switch(fn->type){ + case OBLTIN: + Bltinfn blt = bltinlookup(fn); + if(blt==0) + error("not builtin type!"); + return blt(env, args); + case OFUNC:{ + Object *elist = evallist(env, args); + Object*res = applyfn(fn, elist); + return res; + } + } + error("can't apply"); + return 0; +} + +Object* +eval(Object *env, Object *obj) +{ + switch(obj->type){ + case OINT: + case OSTRING: + case OBLTIN: + case OSYMBOL: + return obj; + case OIDENT:{ + Object* val = find(env, obj); + if(val == 0) + error("not exist '%s'", obj->beg); + return val->cdr; + } + case OCELL:{ + Object *fn = eval(env, obj->car); + if(fn->type!=OFUNC&&fn->type!=OBLTIN) + error("expected function type"); + Object *res = apply(env, fn, obj->cdr); + return res; + } + } + error("can't apply"); + return 0; +} diff --git a/fn.h b/fn.h new file mode 100644 index 0000000..e634bd2 --- /dev/null +++ b/fn.h @@ -0,0 +1,37 @@ +/* parser.c */ +Object* nextexpr(void); +void skipline(void); + +/* eval.c */ +Object* eval(Object *env, Object *expr); + +/* new */ + +Object* newint(long); +Object* newcons(Object*,Object*); +Object* newenv(Object*name, Object *vars, Object *up); +Object* newacons(Object*, Object*, Object*); +Object* newsymbol(char*, int); +Object* newstr(int); +Object* newfn(Object *env, Object *params, Object *body); + +/* gc.c */ +void gcstatus(void); +Object* newobj(enum OType); +void* xalloc(int); +void* xralloc(void*, int); +void gcinit(void *top, int cap); +void gcrun(void); + +/* str.c */ +void strputc(Object*, int); +void strputs(Object*, char*); +int strequal(Object*, Object*); + +/* error.c */ +void panic(char *fmt, ...); +void error(char *fmt, ...); + +/* builtin */ +Bltinfn bltinlookup(Object *obj); +void printexpr(Object *obj); diff --git a/gc.c b/gc.c new file mode 100644 index 0000000..cdb796d --- /dev/null +++ b/gc.c @@ -0,0 +1,182 @@ +#include "dat.h" +#include "fn.h" +#include +#include +#include +#include +#include + +enum +{ + USING = 1 << 1, +}; + +typedef struct +{ + int total; + int using; + uintptr_t top; + uintptr_t beg; + uintptr_t end; + Object objs; + Object freed; +}GC; + +GC gc = {0}; + +static void +pushobj(Object *list, Object *obj) +{ + Object *l = list; + Object *c = l->next; + while(c){ + l = c; + c=c->next; + } + l->next = obj; +} + +static void +mark(Object *obj) +{ + if(obj == 0 || obj->flag & USING) + return; + obj->flag = USING; + switch(obj->type){ + case OCELL: + mark(obj->car); + mark(obj->cdr); + break; + case OENV: + mark(obj->name); + mark(obj->vars); + mark(obj->up); + break; + case OFUNC: + mark(obj->params); + mark(obj->body); + mark(obj->env); + break; + } +} + +static int +isobj(uintptr_t val) +{ + if(val < gc.beg || val >= gc.end) + return 0; + val -= gc.beg; + uintptr_t mod = val % sizeof(Object); + return mod == 0; +} + +static void +freeobj(Object *obj) +{ + switch(obj->type){ + case OSTRING: + case OIDENT: + printf("freed => '%s'\n", obj->beg); + free(obj->beg); + break; + } + memset(obj, 0, sizeof(*obj)); + pushobj(&gc.freed, obj); + gc.using -= sizeof(Object); +} + +static void +gcsweep(void) +{ + Object *l = &gc.objs; + Object *c = l->next; + while(c){ + if(c->flag&USING){ + c->flag = 0; + l = c; + c = c->next; + continue; + } + Object *t = c; + l->next = c->next; + c = c->next; + freeobj(t); + } +} + +static void +gcmark(void) +{ + void *_ = 0; + uintptr_t bot = (uintptr_t)&_; + for(; bot < gc.top; bot += sizeof(bot)){ + uintptr_t val = (uintptr_t)*(void**)bot; + if(isobj(val)) + mark((Object*)val); + } +} + +void +gcrun(void) +{ + jmp_buf reg; + setjmp(reg); + gcmark(); + gcsweep(); + gcstatus(); +} + +void +gcstatus(void) +{ + printf("curren=> total:%d using:%d remain:%d\n", gc.total, gc.using, gc.total-gc.using); +} + +void* +xalloc(int sz) +{ + int *res = calloc(1, sz); + if(res == 0) + panic("Can't allocated %d byte", sz); + return res; +} + +void* +xralloc(void *src, int sz) +{ + int *p = realloc(src, sz); + if(p == 0) + panic("Can't allocated %d byte", sz); + return p; +} + +Object* +newobj(enum OType type) +{ + gcrun(); + Object *obj = 0; + if(gc.freed.next){ + obj = gc.freed.next; + gc.freed.next = obj->next; + obj->next = 0; + }else + panic("not impl yet"); + obj->type = type; + pushobj(&gc.objs, obj); + gc.using += sizeof(Object); + return obj; +} + +void +gcinit(void *top, int cap) +{ + gc.total = cap; + gc.using = 0; + gc.top = (uintptr_t)top; + gc.beg = (uintptr_t)xalloc(cap); + gc.end = gc.beg + cap; + Object *p = &gc.freed; + for(uintptr_t i = gc.beg; i < gc.end; i+=sizeof(Object)){ + p = p->next = (Object*)i; + } +} diff --git a/main.c b/main.c new file mode 100644 index 0000000..9ddca10 --- /dev/null +++ b/main.c @@ -0,0 +1,79 @@ +#include "dat.h" +#include "fn.h" +#include +#include + +jmp_buf err; + +static void +SExprint(Object *obj) +{ + if(obj == 0) + return; + switch(obj->type){ + case OCELL: + printf("("); + SExprint(obj->car); + printf(" . "); + SExprint(obj->cdr); + printf(")"); + break; + case OINT: + printf("%ld", obj->num); + break; + case OIDENT: + printf("%s", obj->beg); + break; + case OSTRING: + printf("\"%s\"", obj->beg); + break; + case OBLTIN: + case OSYMBOL: + printf("%s", obj->sym); + break; + case OENV: + printf(""); + break; + case OLAMBDA: + printf(""); + goto func; + case OFUNC: + printf(""); +func: + printf("<"); + SExprint(obj->params); + SExprint(obj->body); + printf(">"); + break; + } +} + +void +printexpr(Object *obj) +{ + SExprint(obj); + printf("\n"); +} + +static void +loop(void) +{ + Object *root = newenv(&Nil, &Nil, &Nil); + if(setjmp(err) == 1){ + skipline(); + gcrun(); + } + while(1){ + gcstatus(); + Object *res = nextexpr(); + res = eval(root, res); + printexpr(res); + } +} + +int +main(int argc, char *argv[]) +{ + gcinit(&argc, 3000); + loop(); +} diff --git a/makefile b/makefile new file mode 100644 index 0000000..72c9989 --- /dev/null +++ b/makefile @@ -0,0 +1,26 @@ +NAME=lisp +OFILES=\ + bltin.o\ + error.o\ + eval.o\ + main.o\ + gc.o\ + obj.o\ + str.o\ + parser.o + +AS=$(CC) -c +CFLAGS=-c -g -O2 + +all: $(NAME) + +%.o: %.c + $(CC) $(CFLAGS) $*.c + +$(NAME): $(OFILES) + $(CC) -o $(NAME) $(OFILES) + +$(OFILES): dat.h fn.h + +clean: + rm -f $(NAME) $(OFILES) diff --git a/obj.c b/obj.c new file mode 100644 index 0000000..f889f84 --- /dev/null +++ b/obj.c @@ -0,0 +1,76 @@ +#include "dat.h" +#include "fn.h" +#include +#include + +Object* +newint(long val) +{ + Object *obj = newobj(OINT); + obj->num = val; + return obj; +} + +Object* +newcons(Object *car, Object *cdr) +{ + Object *obj = newobj(OCELL); + obj->car = car; + obj->cdr = cdr; + return obj; +} + +Object* +newenv(Object* name, Object *vars, Object *up) +{ + Object *obj = newobj(OENV); + obj->name = name; + obj->up = up; + obj->vars = vars; + return obj; +} + +Object* +newacons(Object *x, Object *y, Object *z) +{ + Object *cons = newcons(x, y); + return newcons(cons, z); +} + +Object* +newfn(Object *env, Object *params, Object *body) +{ + Object *fn = newobj(OFUNC); + fn->params = params; + fn->body = body; + fn->env = env; + return fn; +} + +Object* +newsymbol(char *str, int len) +{ + static Object *syms[] = { + &Nil, &True, &False, &Minus, &Plus, + &Lambda, &Car, &Cdr, &Quote, &Cons, &Define, &Setq, + }; + for(int i = 0; i < sizeof(syms)/sizeof(syms[0]); ++i){ + Object *c = syms[i]; + if(strlen(c->sym)==len && memcmp(c->sym, str, len) == 0) + return c; + } + Object *obj = newobj(OIDENT); + obj->beg = xalloc(len + 1); + obj->end = obj->ptr = obj->beg + len; + memcpy(obj->beg, str, len+1); + return obj; +} + +Object* +newstr(int len) +{ + Object *obj = newobj(OSTRING); + obj->ptr = obj->beg = xalloc(len + 1); + obj->end = obj->beg + len; + return obj; +} diff --git a/parser.c b/parser.c new file mode 100644 index 0000000..8c347f3 --- /dev/null +++ b/parser.c @@ -0,0 +1,183 @@ +#include "dat.h" +#include "fn.h" +#include +#include +#include + +#define SYMBOL_LEN 64 + +const char symbolchars[] = "*-=+<>"; + +static Object* lparlist(void); +static Object* list(void); + +static char +get(void) +{ + char c = getchar(); + if(c == EOF) + panic("EOF"); + return c; +} + +static void +expect(char x) +{ + char y = get(); + if(x != y) + error("expected '%c', actual '%c'", x, y); +} + +static char +lookup(void) +{ + char c = get(); + ungetc(c, stdin); + return c; +} + +/* skip space */ +static char +slookup(void) +{ + char c = -1; + while(1){ + c = get(); + if(isspace(c) == 0) + break; + } + ungetc(c, stdin); + return c; +} + +static Object* +symbol(char c) +{ + char buf[SYMBOL_LEN+1] = {0,}; + int len = 0; + buf[len++] = c; + while(isalnum(lookup()) || strchr(symbolchars, lookup())){ + if(len >= sizeof(buf)-1) + error("Symbol too long"); + buf[len++] = get(); + } + buf[len] = 0; + return newsymbol(buf, len); +} + +static long +number(void) +{ + long val = get() - '0'; + while(isdigit(lookup())) + val = val * 10 + (get() - '0'); + return val; +} + +static Object* +quote(void) +{ + Object *car = &Quote; + Object *ccdr = list(); + Object *cdr = newcons(ccdr, &Nil); + return newcons(car, cdr); +} + +static Object* +string(void) +{ + Object *str = newstr(16); + while(lookup() != '\"'){ + strputc(str, get()); + } + expect('\"'); + return str; +} + +static Object* +atom(char c) +{ + if(isdigit(c)) + return newint(number()); + get(); + if(c == '-'){ + if(isdigit(lookup())) + return newint(-number()); + else + return symbol('-'); + } + if(c == '"'){ + return string(); + } + if(isalpha(c) || strchr(symbolchars, c)){ + return symbol(c); + } + error("bad char in list '%c'", c); +} + +static Object* +lparlist(void) +{ + Object *car = 0; + Object *cdr = 0; + char c = slookup(); + switch(c){ + case '\'': + get(); + car = quote(); + cdr = lparlist(); + return newcons(car, cdr); + case '.': + get(); + return list(); + case '(': + car = list(); + cdr = lparlist(); + return newcons(car, cdr); + case ')': + return &Nil; + } + car = atom(c); + cdr = lparlist(); + return newcons(car ,cdr); +} + +static Object* +list(void) +{ + char c = slookup(); + switch(c){ + case '\'': + get(); + return quote(); + case '(':{ + get(); + Object *obj = lparlist(); + slookup(); + expect(')'); + return obj; + } + } + return atom(c); +} + +void +skipline(void) +{ + for(;;){ + switch(get()){ + case '\n': + return; + case '\r': + if(lookup() == '\n') + get(); + return; + } + } +} + +Object* +nextexpr(void) +{ + return list(); +} diff --git a/str.c b/str.c new file mode 100644 index 0000000..d138bbe --- /dev/null +++ b/str.c @@ -0,0 +1,41 @@ +#include "dat.h" +#include "fn.h" +#include + +static void +raise(Object *s, int ns) +{ + int pos = s->ptr - s->beg; + char *ptr = xralloc(s->beg, ns + 1); + s->beg = ptr; + s->ptr = s->beg + pos; + s->end = s->beg + ns; +} + +void +strputc(Object *s, int c) +{ + if(s->ptr >= s->end) + raise(s, (s->end - s->beg) * 2); + *s->ptr++ = c; + *s->ptr = 0; +} + +void +strputs(Object *s, char *ptr) +{ + int l = strlen(ptr); + if(s->ptr + l >= s->end) + raise(s, s->end - s->beg + l); + memcpy(s->ptr, ptr, l); + s->ptr += l; + s->ptr[0] = 0; +} + +int +strequal(Object *a, Object *b) +{ + int la = a->ptr - a->beg; + int lb = b->ptr - b->beg; + return la == lb && memcmp(a->beg, b->beg, la) == 0; +}