tisp

tiny lisp
git clone git://edryd.org/tisp
Log | Files | Refs | README | LICENSE

tisp.h (5920B)


      1 /* zlib License
      2  *
      3  * Copyright (c) 2017-2022 Ed van Bruggen
      4  *
      5  * This software is provided 'as-is', without any express or implied
      6  * warranty.  In no event will the authors be held liable for any damages
      7  * arising from the use of this software.
      8  *
      9  * Permission is granted to anyone to use this software for any purpose,
     10  * including commercial applications, and to alter it and redistribute it
     11  * freely, subject to the following restrictions:
     12  *
     13  * 1. The origin of this software must not be misrepresented; you must not
     14  *    claim that you wrote the original software. If you use this software
     15  *    in a product, an acknowledgment in the product documentation would be
     16  *    appreciated but is not required.
     17  * 2. Altered source versions must be plainly marked as such, and must not be
     18  *    misrepresented as being the original software.
     19  * 3. This notice may not be removed or altered from any source distribution.
     20  */
     21 
     22 #define tsp_warnf(M, ...) do {                                  \
     23 	fprintf(stderr, "; tisp: error: " M "\n", ##__VA_ARGS__); \
     24 	return NULL;                                            \
     25 } while(0)
     26 #define tsp_warn(M) do {                         \
     27 	fprintf(stderr, "; tisp: error: " M "\n"); \
     28 	return NULL;                             \
     29 } while(0)
     30 
     31 /* TODO test general condition */
     32 #define tsp_arg_min(ARGS, NAME, NARGS) do {                                    \
     33 	if (list_len(ARGS) < NARGS)                                            \
     34 		tsp_warnf("%s: expected at least %d argument%s, received %d",  \
     35 		           NAME, NARGS, NARGS > 1 ? "s" : "", list_len(ARGS)); \
     36 } while(0)
     37 #define tsp_arg_max(ARGS, NAME, NARGS) do {                                          \
     38 	if (list_len(ARGS) > NARGS)                                                  \
     39 		tsp_warnf("%s: expected at no more than %d argument%s, received %d", \
     40 		           NAME, NARGS, NARGS > 1 ? "s" : "", list_len(ARGS));       \
     41 } while(0)
     42 #define tsp_arg_num(ARGS, NAME, NARGS) do {                                    \
     43 	if (list_len(ARGS) != NARGS && NARGS != -1)                            \
     44 		tsp_warnf("%s: expected %d argument%s, received %d",           \
     45 		           NAME, NARGS, NARGS > 1 ? "s" : "", list_len(ARGS)); \
     46 } while(0)
     47 #define tsp_arg_type(ARG, NAME, TYPE) do {                                     \
     48 	if (!(ARG->t & (TYPE)))                                                \
     49 		tsp_warnf(NAME ": expected %s, received %s",                   \
     50 		                type_str(TYPE), type_str(ARG->t));             \
     51 } while(0)
     52 
     53 #define tsp_env_name_prim(NAME, FN) tisp_env_add(st, #NAME, mk_prim(TSP_PRIM, prim_##FN, #NAME))
     54 #define tsp_env_prim(NAME)          tsp_env_name_prim(NAME, NAME)
     55 #define tsp_env_name_form(NAME, FN) tisp_env_add(st, #NAME, mk_prim(TSP_FORM, form_##FN, #NAME))
     56 #define tsp_env_form(NAME)          tsp_env_name_form(NAME, NAME)
     57 #define tsp_include_tib(NAME)       void tib_env_##NAME(Tsp)
     58 
     59 #define tsp_finc(ST) ST->filec++
     60 #define tsp_fincn(ST, N) ST->filec += N
     61 #define tsp_fgetat(ST, O) ST->file[ST->filec+O]
     62 #define tsp_fget(ST) tsp_fgetat(ST,0)
     63 
     64 #define car(P)  ((P)->v.p.car)
     65 #define cdr(P)  ((P)->v.p.cdr)
     66 #define caar(P) car(car(P))
     67 #define cadr(P) car(cdr(P))
     68 #define cdar(P) cdr(car(P))
     69 #define cddr(P) cdr(cdr(P))
     70 #define nilp(P) ((P)->t == TSP_NIL)
     71 #define num(P)  ((P)->v.n.num)
     72 #define den(P)  ((P)->v.n.den)
     73 
     74 struct Val;
     75 typedef struct Val *Val;
     76 typedef struct Tsp *Tsp;
     77 
     78 typedef struct Entry *Entry;
     79 
     80 typedef struct Hash {
     81 	int size, cap;
     82 	struct Entry {
     83 		char *key;
     84 		Val val;
     85 	} *items;
     86 	struct Hash *next;
     87 } *Hash;
     88 
     89 /* possible tisp object types */
     90 typedef enum {
     91 	TSP_NONE  = 1 << 0,  /* void */
     92 	TSP_NIL   = 1 << 1,  /* nil: false, empty list */
     93 	TSP_INT   = 1 << 2,  /* integer: whole number */
     94 	TSP_DEC   = 1 << 3,  /* decimal: floating point number */
     95 	TSP_RATIO = 1 << 4,  /* ratio: numerator/denominator */
     96 	TSP_STR   = 1 << 5,  /* string: immutable characters */
     97 	TSP_SYM   = 1 << 6,  /* symbol: variable names */
     98 	TSP_PRIM  = 1 << 7,  /* primitive: built-in function */
     99 	TSP_FORM  = 1 << 8,  /* special form: built-in macro */
    100 	TSP_FUNC  = 1 << 9,  /* function: procedure written is tisp */
    101 	TSP_MACRO = 1 << 10, /* macro: function without evaluated arguments */
    102 	TSP_PAIR  = 1 << 11, /* pair: building block for lists */
    103 } TspType;
    104 #define TSP_RATIONAL (TSP_INT | TSP_RATIO)
    105 #define TSP_NUM      (TSP_RATIONAL | TSP_DEC)
    106 /* TODO rename to expr type to math ? */
    107 #define TSP_EXPR     (TSP_NUM | TSP_SYM | TSP_PAIR)
    108 
    109 /* bultin function written in C, not tisp */
    110 typedef Val (*Prim)(Tsp, Hash, Val);
    111 
    112 /* tisp object */
    113 struct Val {
    114 	TspType t; /* NONE, NIL */
    115 	union {
    116 		char *s;                                            /* STRING, SYMBOL */
    117 		struct { double num, den; } n;                      /* NUMBER */
    118 		struct { char *name; Prim pr; } pr;                 /* PRIMITIVE, FORM */
    119 		struct { char *name; Val args, body; Hash env; } f; /* FUNCTION, MACRO */
    120 		struct { Val car, cdr; } p;                         /* PAIR */
    121 	} v;
    122 };
    123 
    124 /* tisp state and global environment */
    125 struct Tsp {
    126 	char *file;
    127 	size_t filec;
    128 	Val none, nil, t;
    129 	Hash global, strs, syms;
    130 	void **libh;
    131 	size_t libhc;
    132 };
    133 
    134 char *type_str(TspType t);
    135 int list_len(Val v);
    136 
    137 Val mk_int(int i);
    138 Val mk_dec(double d);
    139 Val mk_rat(int num, int den);
    140 Val mk_str(Tsp st, char *s);
    141 Val mk_sym(Tsp st, char *s);
    142 Val mk_prim(TspType t, Prim prim, char *name);
    143 Val mk_func(TspType t, char *name, Val args, Val body, Hash env);
    144 Val mk_pair(Val a, Val b);
    145 Val mk_list(Tsp st, int n, ...);
    146 
    147 Val tisp_read(Tsp st);
    148 Val tisp_read_line(Tsp st);
    149 Val tisp_eval_list(Tsp st, Hash env, Val v);
    150 Val tisp_eval_seq(Tsp st, Hash env, Val v);
    151 Val tisp_eval(Tsp st, Hash env, Val v);
    152 void tisp_print(FILE *f, Val v);
    153 
    154 char *tisp_read_file(char *fname);
    155 Val tisp_parse_file(Tsp st, char *fname);
    156 
    157 void tisp_env_add(Tsp st, char *key, Val v);
    158 Tsp  tisp_env_init(size_t cap);
    159 void tisp_env_lib(Tsp st, char* lib);