/* Scheme In One Defun, but in C this time.
 
 *                   COPYRIGHT (c) 1988-1994 BY                             *
 *        PARADIGM ASSOCIATES INCORPORATED, CAMBRIDGE, MASSACHUSETTS.       *
 *        See the source file SLIB.C for more information.                  *

*/

/*===========================================================*/
/*                                                           */
/* Public LISP functions                                     */
/*                                                           */
/*===========================================================*/
#ifndef __SIOD_H__
#define __SIOD_H__

#include "EST_String.h"
#include "EST_string_aux.h"
#include "EST_error.h"

#define DEFAULT_HEAP_SIZE 210000

int siod_init(int heap_size=DEFAULT_HEAP_SIZE);
int siod_repl(int interactive);

struct obj
{union {struct {struct obj * car;
		struct obj * cdr;} cons;
	struct {double data;} flonum;
	struct {char *pname;
		struct obj * vcell;} symbol;
	struct {char *name;
		struct obj * (*f)(void);} subr0;
  	struct {char *name;
 		struct obj * (*f)(struct obj *);} subr1;
 	struct {char *name;
 		struct obj * (*f)(struct obj *, struct obj *);} subr2;
 	struct {char *name;
 		struct obj * (*f)(struct obj *, struct obj *, struct obj *);
 	      } subr3;
 	struct {char *name;
 		struct obj * (*f)(struct obj *, struct obj *, 
				  struct obj *, struct obj *);
 	      } subr4;
 	struct {char *name;
 		struct obj * (*f)(struct obj **, struct obj **);} subrm;
	struct {char *name;
		struct obj * (*f)(void *,...);} subr;
	struct {struct obj *env;
		struct obj *code;} closure;
	struct {long dim;
		long *data;} long_array;
	struct {long dim;
		double *data;} double_array;
	struct {long dim;
		char *data;} string;
	struct {long dim;
		struct obj **data;} lisp_array;
	struct {FILE *f;
		char *name;} c_file;
    	struct {void *p;} user;
}
 storage_as;
 char *pname;  // This is currently only used by FLONM
 short gc_mark;
 short type;
};

#define CAR(x) ((*x).storage_as.cons.car)
#define CDR(x) ((*x).storage_as.cons.cdr)
#define PNAME(x) ((*x).storage_as.symbol.pname)
#define VCELL(x) ((*x).storage_as.symbol.vcell)
#define SUBR0(x) (*((*x).storage_as.subr0.f))
#define SUBR1(x) (*((*x).storage_as.subr1.f))
#define SUBR2(x) (*((*x).storage_as.subr2.f))
#define SUBR3(x) (*((*x).storage_as.subr3.f))
#define SUBR4(x) (*((*x).storage_as.subr4.f))
#define SUBRM(x) (*((*x).storage_as.subrm.f))
#define SUBRF(x) (*((*x).storage_as.subr.f))
#define FLONM(x) ((*x).storage_as.flonum.data)
#define FLONMPNAME(x) ((*x).pname)
#define USERVAL(x) ((*x).storage_as.user.p)
#define UNTYPEDVAL(x) ((*x).storage_as.user.p)

#define NIL ((struct obj *) 0)
#define EQ(x,y) ((x) == (y))
#define NEQ(x,y) ((x) != (y))
#define NULLP(x) EQ(x,NIL)
#define NNULLP(x) NEQ(x,NIL)

#define TYPE(x) (((x) == NIL) ? 0 : ((*(x)).type))

#define TYPEP(x,y) (TYPE(x) == (y))
#define NTYPEP(x,y) (TYPE(x) != (y))

#define tc_nil    0
#define tc_cons   1
#define tc_flonum 2
#define tc_symbol 3
#define tc_subr_0 4
#define tc_subr_1 5
#define tc_subr_2 6
#define tc_subr_3 7
#define tc_lsubr  8
#define tc_fsubr  9
#define tc_msubr  10
#define tc_closure 11
#define tc_free_cell 12
#define tc_string       13
#define tc_double_array 14
#define tc_long_array   15
#define tc_lisp_array   16
#define tc_c_file       17
#define tc_untyped      18
#define tc_subr_4       19

#define tc_sys_1 31
#define tc_sys_2 32
#define tc_sys_3 33
#define tc_sys_4 34
#define tc_sys_5 35

// older method for adding application specific types
#define tc_application_1 41
#define tc_application_2 42
#define tc_application_3 43
#define tc_application_4 44
#define tc_application_5 45
#define tc_application_6 46
#define tc_application_7 47

// Application specific types may be added using siod_register_user_type()
// WIll increment from tc_first_user_type to tc_table_dim
#define tc_first_user_type 50

#define tc_table_dim 100

#define FO_fetch 127
#define FO_store 126
#define FO_list  125
#define FO_listd 124

typedef struct obj* LISP;
typedef LISP (*SUBR_FUNC)(void); 

#define CONSP(x)   TYPEP(x,tc_cons)
#define FLONUMP(x) TYPEP(x,tc_flonum)
#define SYMBOLP(x) TYPEP(x,tc_symbol)
#define STRINGP(x) TYPEP(x,tc_string)

#define NCONSP(x)   NTYPEP(x,tc_cons)
#define NFLONUMP(x) NTYPEP(x,tc_flonum)
#define NSYMBOLP(x) NTYPEP(x,tc_symbol)

// Not for the pureists, but I find these more readable than the eqivalent
// code inline.

#define CAR1(x) CAR(x)
#define CDR1(x) CDR(x)
#define CAR2(x) CAR(CDR1(x))
#define CDR2(x) CDR(CDR1(x))
#define CAR3(x) CAR(CDR2(x))
#define CDR3(x) CDR(CDR2(x))
#define CAR4(x) CAR(CDR3(x))
#define CDR4(x) CDR(CDR3(x))
#define CAR5(x) CAR(CDR4(x))
#define CDR5(x) CDR(CDR4(x))

#define LISTP(x) (NULLP(x) || CONSP(x))
#define LIST1P(x) (CONSP(x) && NULLP(CDR(x)))
#define LIST2P(x) (CONSP(x) && CONSP(CDR1(x)) && NULLP(CDR2(x)))
#define LIST3P(x) (CONSP(x) && CONSP(CDR1(x)) && CONSP(CDR2(x)) && NULLP(CDR3(x)))
#define LIST4P(x) (CONSP(x) && CONSP(CDR1(x)) && CONSP(CDR2(x)) && CONSP(CDR3(x)) && NULLP(CDR4(x)))
#define LIST5P(x) (CONSP(x) && CONSP(CDR1(x)) && CONSP(CDR2(x)) && CONSP(CDR3(x)) && CONSP(CDR4(x)) &&  NULLP(CDR5(x)))

#define MKPTR(x) (siod_make_ptr((void *)x))

struct gen_readio
{int (*getc_fcn)(char *);
 void (*ungetc_fcn)(int, char *);
 char *cb_argument;};

#define GETC_FCN(x) (*((*x).getc_fcn))((*x).cb_argument)
#define UNGETC_FCN(c,x) (*((*x).ungetc_fcn))(c,(*x).cb_argument)

struct repl_hooks
{void (*repl_puts)(char *);
 LISP (*repl_read)(void);
 LISP (*repl_eval)(LISP);
 void (*repl_print)(LISP);};

void process_cla(int argc,char **argv,int warnflag);
void print_welcome(void);
void print_hs_1(void);
void print_hs_2(void);
long no_interrupt(long n);
LISP get_eof_val(void);
long repl_driver(long want_sigint,long want_init,struct repl_hooks *);
void set_repl_hooks(void (*puts_f)(char *),
		    LISP (*read_f)(void),
		    LISP (*eval_f)(LISP),
		    void (*print_f)(LISP));
long repl_from_socket(int fd);
long repl(struct repl_hooks *);
LISP err(const char *message, LISP x);
LISP err(const char *message, const char *s);
LISP errswitch(void);
char *get_c_string(LISP x);
int get_c_int(LISP x);
double get_c_double(LISP x);
float get_c_float(LISP x);
FILE *get_c_file(LISP p,FILE *deflt);
LISP lerr(LISP message, LISP x);
LISP newcell(long type);
LISP cons(LISP x,LISP y);
LISP string_cell(const char *s, int len);
LISP consp(LISP x);
LISP atomp(LISP x);
LISP car(LISP x);
LISP cdr(LISP x);
LISP setcar(LISP cell, LISP value);
LISP setcdr(LISP cell, LISP value);
LISP flocons(double x);
LISP numberp(LISP x);
LISP plus(LISP args);
LISP ltimes(LISP args);
LISP difference(LISP x,LISP y);
LISP quotient(LISP x,LISP y);
LISP greaterp(LISP x,LISP y);
LISP lessp(LISP x,LISP y);
LISP eq(LISP x,LISP y);
LISP eql(LISP x,LISP y);
LISP symcons(char *pname,LISP vcell);
LISP symbolp(LISP x);
LISP symbol_boundp(LISP x,LISP env);
LISP symbol_value(LISP x,LISP env);
LISP symbol_value_p(LISP x,LISP env,int *set);
LISP cintern(char *name);
LISP rintern(const char *name);
LISP subrcons(long type, char *name, SUBR_FUNC f);
LISP closure(LISP env,LISP code);
void gc_protect(LISP *location);
void gc_unprotect(LISP *location);
void gc_protect_n(LISP *location,long n);
void gc_protect_sym(LISP *location,char *st);

void init_storage(int heap_size=DEFAULT_HEAP_SIZE);

void init_subr(char *name, long type, SUBR_FUNC fcn, char *doc);
void init_subr_0(char *name, LISP (*fcn)(void), char *doc);
void init_subr_1(char *name, LISP (*fcn)(LISP), char *doc);
void init_subr_2(char *name, LISP (*fcn)(LISP,LISP), char *doc);
void init_subr_3(char *name, LISP (*fcn)(LISP,LISP,LISP), char *doc);
void init_subr_4(char *name, LISP (*fcn)(LISP,LISP,LISP,LISP), char *doc);
void init_lsubr(char *name, LISP (*fcn)(LISP), char *doc);
void init_fsubr(char *name, LISP (*fcn)(LISP,LISP), char *doc);
void init_msubr(char *name, LISP (*fcn)(LISP *,LISP *), char *doc);
void setdoc(LISP name,LISP doc);
LISP siod_doc(LISP args,LISP penv);

LISP assq(LISP x,LISP alist);
LISP delq(LISP elem,LISP l);
LISP gc_relocate(LISP x);
LISP user_gc(LISP args);
LISP gc_status(LISP args);
LISP leval(LISP x,LISP env);
LISP symbolconc(LISP args);
LISP symbolexplode(LISP symbol);
LISP stringexplode(LISP symbol);

/* For user defined types in OBJ */
int siod_register_user_type(const char *name);
void set_gc_hooks(long type,
		  int gc_free_once,
		  LISP (*rel)(LISP),
		  LISP (*mark)(LISP),
		  void (*scan)(LISP),
		  void (*free)(LISP),
		  void (*clear)(LISP),
		  long *kind);
void set_eval_hooks(long type,LISP (*fcn)(LISP, LISP *, LISP *));
void set_type_hooks(long type, long (*c_sxhash)(LISP,long), LISP (*equal)(LISP,LISP));
void set_print_hooks(long type,void (*prin1)(LISP, FILE *), void (*print_string)(LISP, char *));
void set_io_hooks(long type, LISP (*fast_print)(LISP,LISP), LISP (*fast_read)(int,LISP));

LISP lprin1f(LISP exp,FILE *f);
LISP lprint(LISP exp);
void pprint(LISP exp);
void pprint_to_fd(FILE *fd,LISP exp);
LISP lread(void);
LISP lreadtk(long j);
LISP lreadf(FILE *f);
void set_read_hooks(char *all_set,char *end_set,
		    LISP (*fcn1)(int, struct gen_readio *),
		    LISP (*fcn2)(char *,long, int *));
LISP oblistfn(void);
LISP vload(const char *fname,long cflag);
LISP load(LISP fname,LISP cflag);
LISP save_forms(LISP fname,LISP forms,LISP how);
LISP siod_quit(void);
LISP nullp(LISP x);
LISP strcons(long length,const char *data);
LISP strintern(const char *data);
LISP cstrcons(char *data);
LISP read_from_lstring(LISP x);
LISP read_from_string(char *);
LISP aref1(LISP a,LISP i);
LISP aset1(LISP a,LISP i,LISP v);
LISP cons_array(LISP dim,LISP kind);
LISP string_append(LISP args);
LISP string_length(LISP string);
void init_subrs(void);
LISP copy_list(LISP);
long c_sxhash(LISP,long);
LISP sxhash(LISP,LISP);
LISP href(LISP,LISP);
LISP hset(LISP,LISP,LISP);
LISP fast_print(LISP,LISP);
LISP fast_read(LISP);
LISP equal(LISP,LISP);
LISP assoc(LISP x,LISP alist);
LISP make_list(LISP x,LISP v);
void set_fatal_exit_hook(void (*fcn)(void));
LISP parse_number(LISP x);
LISP intern(LISP x);
void init_trace(void);
long repl_c_string(char *,long want_sigint,long want_init,long want_print);
char *siod_version(void);
LISP setvar(LISP var,LISP val,LISP env);
LISP llength(LISP obj);
LISP reverse(LISP obj);
LISP l_append(LISP l1, LISP l2);
LISP siod_fdopen_c(int fd,const char *name,char *how);
LISP siod_make_typed_cell(long type, void *s);

void siod_est_init();
class EST_Utterance *get_c_utt(LISP x);
int siod_utterance_p(LISP x);
LISP siod_make_utt(class EST_Utterance *u);
class EST_Item *get_c_item(LISP x);
int siod_item_p(LISP x);
LISP siod_make_item(class EST_Item *u);
class EST_Wave *get_c_wave(LISP x);
int siod_wave_p(LISP x);
LISP siod_make_wave(class EST_Wave *u);
class EST_Track *get_c_track(LISP x);
int siod_track_p(LISP x);
LISP siod_make_track(class EST_Track *u);

extern long nointerrupt;
extern LISP current_env;
extern LISP truth;
extern int audsp_mode;
extern char *siod_prog_name;

void siod_reset_prompt(void);

LISP siod_get_lval(const char *name,const char *message);
LISP siod_set_lval(const char *name,LISP val);
LISP siod_assoc_str(const char *key,LISP alist);
LISP siod_member_str(const char *key,LISP list);
LISP siod_regex_member_str(const EST_String &key,LISP list);
EST_Regex &make_regex(const char *r);
LISP siod_member_int(const int key,LISP list);
LISP siod_nth(int nth,LISP list);
LISP siod_last(LISP list);
int siod_llength(LISP list);
int siod_atomic_list(LISP list);
LISP siod_flatten(LISP tree);
int siod_eof(LISP item);
LISP siod_quote(LISP item);
EST_String siod_sprint(LISP exp);
LISP probe_file(LISP fname);
LISP lisp_to_string(LISP l);
LISP get_param_lisp(const char *name, LISP params, LISP defval);
int get_param_int(const char *name, LISP params, int defval);
float get_param_float(const char *name, LISP params, float defval);
const char *get_param_str(const char *name, LISP params,const char *defval);
LISP make_param_int(const char *name, int val);
LISP make_param_float(const char *name, float val);
LISP make_param_str(const char *name,const char *val);
LISP make_param_lisp(const char *name,LISP val);
LISP apply_hooks(LISP hook,LISP arg);
LISP siod_sort_and_dump_docstrings(LISP docstrings,LISP filefp);
LISP stringexplode(const char *str);
void fput_st(FILE *f,const char *st);
void siod_list_to_strlist(LISP l, EST_StrList &a);
LISP siod_strlist_to_list(EST_StrList &a);
void siod_tidy_up();

LISP fopen_c(const char *name, const char *how);
LISP fopen_l(LISP name,LISP how);
LISP fopen_l(LISP name,const char *how);
LISP fclose_l(LISP p);

int parse_url(const EST_String &url,
	      EST_String &protocol, 
	      EST_String &host, 
	      EST_String &port, 
	      EST_String &path);

#define siod_error()  (errjmp_ok ? longjmp(*est_errjmp,1) : exit(-1))

#endif