diff options
| -rw-r--r-- | README | 2 | ||||
| -rw-r--r-- | examples/math.c | 70 | ||||
| -rw-r--r-- | examples/strfib.c | 53 | ||||
| -rw-r--r-- | include/csx/csx.h | 25 | ||||
| -rw-r--r-- | src/csx.c | 167 |
5 files changed, 246 insertions, 71 deletions
@@ -16,4 +16,4 @@ Descriptions and details are in corresponding source files. ... Motivation -You can do such things in C, this fact should be more known. +You can do such things in C and this fact should be better known. diff --git a/examples/math.c b/examples/math.c deleted file mode 100644 index df0aabc..0000000 --- a/examples/math.c +++ /dev/null @@ -1,70 +0,0 @@ -#include <csx.h> - - -v def_rat_sum(v construct, v numer, v denom) -{ - v a = atom("a"); - v b = atom("b"); - return el(define, l(atom("rat_sum"), a, b), - l(construct, l(sum, l(mul, l(numer, a), l(denom, b)), - l(mul, l(numer, b), l(denom, a))), - l(mul, l(denom, a), l(denom, b))) - ); -} - -v def_rat_sum(v construct, v numer, v denom) -{ - v a = atom("a"); - v b = atom("b"); - return el(define, l(atom("rat_sub"), a, b), - l(construct, l(sub, l(mul, l(numer, a), l(denom, b)), - l(mul, l(numer, b), l(denom, a))), - l(mul, l(denom, a), l(denom, b))) - ); -} - -v def_rat_equ(v construct, v numer, v denom) -{ - v a = atom("a"); - v b = atom("b"); - return el(define, l(atom("rat_equ"), a, b), - l(equ, l(mul, l(numer, a), l(denom, b)), - l(mul, l(numer, b), l(denom, a))) - ); -} - -void printres(v a, v b, v absum, v absub, int *are_equ, v numer, v denom) -{ - int an = *(int *)el(numer, a); - int ad = *(int *)el(denom, a); - int bn = *(int *)el(numer, b); - int bd = *(int *)el(denom, b); - int sumn = *(int *)el(numer, absum); - int sumd = *(int *)el(denom, absum); - int subn = *(int *)el(numer, absub); - int subd = *(int *)el(denom, absub); - printf("%d/%d + %d/%d = %d/%d\n", an, ad, bn, bd, sumn, sumd); - printf("%d/%d - %d/%d = %d/%d\n", an, ad, bn, bd, subn, subd); - if (*are_equ) { - puts("And they are equal.\n"); - } else { - puts("And they are not equal.\n"); - } -} - -int main() -{ - v rat = l(define, atom("rat"), cons); - v rat_numer = l(define, atom("rat_numer"), car); - v rat_denom = l(define, atom("rat_denom"), cdr); - v rat_sum = def_rat_sum(rat, rat_numer, rat_denom); - v rat_sub = def_rat_sub(rat, rat_numer, rat_denom); - v rat_equ = def_rat_equ(rat, rat_numer, rat_denom); - v number_a = el(rat, n(19), n(99)); - v number_b = el(rat, n(7), n(3)); - v absum = el(rat_sum, number_a, number_b); - v absub = el(rat_sub, number_a, number_b); - v are_equ = el(rat_equ, number_a, number_b); - printres(number_a, number_b, sum, sub, are_equ, numer, denom); - return 0; -} diff --git a/examples/strfib.c b/examples/strfib.c new file mode 100644 index 0000000..6e22c7f --- /dev/null +++ b/examples/strfib.c @@ -0,0 +1,53 @@ +#include <csx/csx.h> +#include <stdio.h> + + +static csx_type_function_list *l; +static csx_type_function_string *s; +static csx_type_function_atom *a; +static csx_type_function_evaluate *e; + +static char *append; +static char *define; +static char *cdr; +static char *ifx; +static char *not; + +void printfibs(char *strfib) +{ + const char *input = "oooooooooo" + 9; + int i; + for (i = 0; i != 10; ++i) + puts(e(l(strfib, s(input - i), 0))); +} + +void process() +{ + char *strfib = a("strfib"); + char *n = a("n"); + e(l(define, l(strfib, n, 0), + l(ifx, l(not, n, 0), s(""), + l(ifx, l(not, l(cdr, n, 0), 0), s("o"), + l(append, l(strfib, l(cdr, n, 0), 0), + l(strfib, l(cdr, l(cdr, n, 0), 0), 0), 0), + 0), + 0), + 0)); + printfibs(strfib); +} + +int main() +{ + l = csx_list; + s = csx_string; + a = csx_atom; + e = csx_evaluate; + append = a("append"); + define = a("define"); + cdr = a("cdr"); + ifx = a("ifx"); + not = a("not"); + process(); + csx_free(); + return 0; +} diff --git a/include/csx/csx.h b/include/csx/csx.h new file mode 100644 index 0000000..db2d1b3 --- /dev/null +++ b/include/csx/csx.h @@ -0,0 +1,25 @@ +#ifndef CSX_INCLUDED +#define CSX_INCLUDED + + +struct csx_pair { + void *car; + void *cdr; +}; + +typedef struct csx_pair *(csx_type_function_list)(void *head, ...); +struct csx_pair *csx_list(void *head, ...); + +typedef char *(csx_type_function_string)(const char *string); +char *csx_string(const char *string); + +typedef char *(csx_type_function_atom)(const char *name); +char *csx_atom(const char *name); + +typedef void *(csx_type_function_evaluate)(void *expression); +void *csx_evaluate(void *expression); + +void csx_free(); + + +#endif diff --git a/src/csx.c b/src/csx.c new file mode 100644 index 0000000..b6b0d38 --- /dev/null +++ b/src/csx.c @@ -0,0 +1,167 @@ +#include "csx.h" + +#include <stdlib.h> +#include <stdarg.h> +#include <string.h> + + +enum { type_nil, type_pair, type_string, type_atom, type_fn }; +static int *type(char *p) { return (int *) (p - sizeof(int)); } +static void type_shift(void *p) { *(char **)p += sizeof(int); } +static void *type_alloc(int t, int content_size) +{ + int *res = malloc(sizeof(int) + content_size); + *res = t; + type_shift(&res); + return res; +} + + +struct deflist { + char *atom; + void *data; + struct deflist *next; +}; + +static struct state { + struct deflist *atoms; +} csx; +static int csx_to_init = 0; + +static void *nil; + + +static void adddef(struct deflist **l, const char *atom, void *data) +{ + struct deflist *old = *l; + *l = malloc(sizeof(**l)); + (*l)->next = old; + (*l)->atom = scopy(atom); + (*l)->data = data; +} + +static void *csx_fn_new(void *fn, void *userdata, int size) +{ + void *res = malloc(sizeof(fn) + sizeof(int) + size); + *(void **)res = fn; + (char *)res += sizeof(fn); + *(int *)res = type_fn; + typeshift(&res); + if (userdata && size) memcpy(res, userdata, size); + return res; +} + +static void *define(void *userdata, struct csx_pair *data) +{ /* TODO! */ + int t = *type(data); + if (t != type_pair) return nil; + t = *type(data->car); + if (t == type_atom) { + struct csx_pair *cdr = data->cdr; + if (*type(cdr) != type_pair || *type(cdr->cdr) != type_nil) + return nil; + return define_constant(data->car, cdr->cdr); + } + return define_function(data->car, data->cdr); +} + +/* TODO append, cdr, ... */ + +static void csx_init() +{ + if (!csx_to_init) csx_free(); + csx.atoms = 0; + + nil = type_alloc(type_nil, 0); + adddef(csx.atoms, "append", csx_fn_new(append, 0, 0)); + adddef(csx.atoms, "define", csx_fn_new(define, 0, 0)); + adddef(csx.atoms, "cdr", csx_fn_new(cdr, 0, 0)); + adddef(csx.atoms, "ifx", csx_fn_new(ifx, 0, 0)); + adddef(csx.atoms, "not", csx_fn_new(not, 0, 0)); +} + +void csx_free() +{ + free(nil); + /* free everything allocated */ + csx_to_init = 0; +} + + +struct csx_pair *csx_pair_new(void *car, void *cdr) +{ + struct csx_pair *res =type_alloc(type_pair, sizeof(*res)); + res->car = car; + res->cdr = cdr; + return res; +} + + +struct csx_pair *csx_list(void *head, ...) +{ + struct csx_pair *res; + va_list args; + if (csx_to_init) csx_init(); + if (!head) return nil; + + res = csx_pair_new(head, nil); + va_start(args, head); + for (head = va_arg(args, void *); head; head = va_arg(args, void *)) { + res->cdr = csx_pair_new(head, nil); + } + va_end(args); + return res; +} + +char *csx_string(const char *string) +{ + int strsize; + void *res; + if (csx_to_init) csx_init(); + strsize = strlen(string) + 1; + res = type_alloc(type_string, strsize); + memcpy(res, string, strsize); + return res; +} + +char *csx_atom(const char *name) +{ + int namesize; + void *res; + if (csx_to_init) csx_init(); + namesize = strlen(name) + 1; + res = type_alloc(type_atom, namesize); + memcpy(res, name, namesize); + return res; +} + + +static void *lookup(struct deflist *d, char *atom) +{ + if (!d) return nil; + if (!strcmp(d->atom, atom)) return d->data; + return lookup(d->next, atom); +} + +void *eval_fn(void *fn, void *args) +{ /* TODO! */ + /* function : type :> userdata */ + return 0; +} + +static void *eval_pair(struct csx_pair *pair) +{ + void *fn; + int t = *type(pair->car); + if (t == type_fn) fn = pair->car; + else fn = csx_evaluate(pair->car); + return eval_fn(fn, pair->cdr); +} + +void *csx_evaluate(void *expression) +{ + int t = *type(expression); + if (t == type_atom) return lookup(csx.atoms, expression); + if (t != type_pair) return nil; + return eval_pair(expression); +} |