shithub: mlisp

ref: 962acb87f81bc9ccdd5428c6561dd9cf6f696895
dir: /lisp.h/

#ifdef PLAN9
#include <u.h>
#include <libc.h>
#include <stdio.h>
#include <ctype.h>
typedef uintptr uintptr_t;
typedef u32int uint32_t;
typedef s32int int32_t;
typedef u64int uint64_t;
typedef s64int int64_t;
#else
#include <stdio.h>
#include <stdlib.h>
#include <stdint.h>
#include <stdarg.h>
#include <string.h>
#include <ctype.h>
#include <math.h>
#include <setjmp.h>
#include <assert.h>

#define nil NULL
#endif

#define FIXMIN (-FIXMAX-1)

/* basic data types */
typedef uintptr_t P;
#ifdef LISP32
/* assume we're running on 32 bits!!! */
typedef uint32_t word;
typedef int32_t fixnum;
typedef float flonum;
#define FIXMAX ((fixnum)0x7FFFFFFF)
#define FLOMAX 3.40282347E+38f
enum
{
	B2W = 32,	/* bits per word */
	C2W = B2W/8,	/* character per word */
};
#else
/* assume we're running on 64 bits!!! */
typedef uint64_t word;
typedef int64_t fixnum;
typedef double flonum;
#define FIXMAX ((fixnum)0x7FFFFFFFFFFFFFFF)
#define FLOMAX 1.7976931348623157E+308
enum
{
	B2W = 64,	/* bits per word */
	C2W = B2W/8,	/* character per word */
};
#endif

/* static storage sizes */
enum
{
	NUMCONS = 32*1024,
	NUMFW = 32*1024,
	PDLSZ = 1024,
};


typedef struct C C;
typedef union F F;

/* A cons cell */
struct C
{
	union {
		C *a;
		F *af;
		P ap;
	};
	union {
		C *d;
		F *df;
		P dp;

		fixnum fix;
		flonum flo;
		char *str;
	};
};

/* CAR bits */
enum
{
	CAR_MARK = 1,
	CAR_ATOM = 2,
	CAR_FIX  = 4,
	CAR_FLO  = 8,
	CAR_NUM  = CAR_FIX | CAR_FLO,
	CAR_STR = 16
};


/* A full word */
union F
{
	word fw;
	char c[C2W];
	F *p;
	fixnum n;
	C *(*subr)(void);
};


/* free storage */
extern C *fclist;
extern F *fflist;

/* push down list */
extern C *pdl[PDLSZ];
extern int pdp;

/* Temporary variables automatically saved */
typedef struct Temlis Temlis;
struct Temlis
{
	/* temp */
	void *a, *b, *c;
	/* arguments to cons */
	void *ca;
	void *cd;
	/* uninterned symbol for unbound symbols */
	C *unbound;
};
extern Temlis temlis;
extern C **alist;
extern int nargs;
extern C *oblist;

typedef struct Arglist Arglist;
struct Arglist {
	int nargs;
	C **alist;
	int pdp;
};
extern Arglist largs;	/* LEXPR/LSUBR args */

typedef struct Prog Prog;
struct Prog
{
	C *prog;
	C *pc;
	C *ret;
};
extern Prog prog;

extern C *noval;
extern C *pname;
extern C *value;
extern C *unbound;
extern C *expr;
extern C *subr;
extern C *lsubr;
extern C *fexpr;
extern C *fsubr;
extern C *macro;
extern C *t;
extern C *quote;
extern C *function;
extern C *funarg;
extern C *cond;
extern C *set;
extern C *setq;
extern C *go;
extern C *retrn;

extern jmp_buf errlabel[10];
extern int errsp;
void err(char *fmt, ...);
void panic(char *fmt, ...);
void *emalloc(ulong size);
void *erealloc(void *p, ulong size);
char *estrdup(char *s);

typedef struct Strbuf Strbuf;
struct Strbuf
{
	char *buf;
	int pos;
	int len;
};
void initbuf(Strbuf *buf);
void freebuf(Strbuf *buf);
void pushchar(Strbuf *buf, char c);

enum {
	IO_FILE,
	IO_BUF
};
typedef struct Stream Stream;
struct Stream
{
	int type;
	FILE *file;
	Strbuf strbuf;
	int nextc;
};
extern Stream sysout, sysin;
void initio(void);
void prf(char *fmt, ...);
void tyo(char c);

C **push(C *c);
C *pop(void);

C *cons(void *a, C *d);
F *consw(word fw);
C *mkfix(fixnum fix);
C *mkflo(flonum flo);
C *mkstr(char *s);
C *mksubr(C *(*subr)(void), int n);
C *mksym(char *name);

int atom(C *c);
int symbolp(C *c);
int fixnump(C *c);
int flonump(C *c);
int numberp(C *c);
int listp(C *c);
int stringp(C *c);

fixnum length(C *c);
C *get(C *l, C *p);
C *getpname(C *a);
C *symeval(C *s);
C *assq(C *x, C *y);
C *putprop(C *l, C *p, C *ind);
C *findsym(char *name);
C *intern(char *name);
C *readsxp(int eofok);
void lprint(C *c);
void princ(C *c);
void printatom(C *c, int x);
C *eval(C *form, C *a);
C *evlis(C *m, C *a);
C *apply(C *fn, C *args, C *a);

int cellp(C *c);
int fwp(C *c);
void gc(void);

void initsubr(void);