/* classes: h_files */

#ifndef GUILEH
#define GUILEH

/*	Copyright (C) 1994 Free Software Foundation, Inc.

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this software; see the file COPYING.  If not, write to
the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
/*  t. lord	Mon Jan 16 15:22:28 1995	*/


#ifndef GUILE
#define GUILE
#endif
#ifndef HAVE_CONFIG_H
#define HAVE_CONFIG_H
#endif

#include "scm.h"

typedef int GSCM_top_level;
typedef int GSCM_status;

#define GSCM_OK 			0
#define GSCM_QUIT 			(GSCM_OK + 1)
#define GSCM_RESTART 			(GSCM_QUIT + 1)
#define GSCM_ILLEGALLY_REENTERED 	(GSCM_RESTART + 1)
#define GSCM_OUT_OF_MEM 		(GSCM_ILLEGALLY_REENTERED + 1)
#define GSCM_ERROR_OPENING_FILE		(GSCM_OUT_OF_MEM + 1)
#define GSCM_ERROR_OPENING_INIT_FILE	(GSCM_ERROR_OPENING_FILE + 1)

typedef int (*gscm_equal_fn) P((SCM a, SCM b));
typedef int (*gscm_print_fn) P((SCM obj, SCM port, int writingp));
typedef void (*gscm_die_fn) P((SCM obj));

struct gscm_type
{
  char * name;
  gscm_equal_fn equal;
  gscm_print_fn print;
  gscm_die_fn die;
};


#define GSCM_DEFER_INTS			DEFER_INTS
#define GSCM_ALLOW_INTS			ALLOW_INTS

#define GSCM_EOL			EOL
#define GSCM_FALSE			BOOL_F
#define GSCM_TRUE			BOOL_T


#define gscm_cons 		scm_cons
#define gscm_list 		scm_listify
#define gscm_ilength		scm_ilength
#define GSCM_EOL_MARKER 	SCM_UNDEFINED

#define gscm_set_car(OBJ, VAL) \
   ((NIMP(OBJ) && CONSP(OBJ)) \
		   ? (CAR(OBJ) = VAL) \
		   : scm_wta ((OBJ), ARG1, "set-car!"))

#define gscm_set_cdr(OBJ, VAL) \
   ((NIMP(OBJ) && CONSP(OBJ)) \
		   ? (CDR(OBJ) = VAL) \
		   : scm_wta ((OBJ), ARG1, "set-cdr!"))


#define SCAR(X)   ((NIMP(X) && CONSP(X)) \
		   ? CAR(X) \
		   : scm_wta ((X), ARG1, "car"))

#define SCDR(X)   ((NIMP(X) && CONSP(X)) \
		   ? CDR(X) \
		   : scm_wta ((X), ARG1, "cdr"))

#define gscm_car(OBJ)		SCAR (OBJ)
#define gscm_cdr(OBJ)		SCDR (OBJ)

#define gscm_caar(OBJ)		SCAR (SCAR (OBJ))
#define gscm_cdar(OBJ)		SCDR (SCAR (OBJ))
#define gscm_cadr(OBJ)		SCAR (SCDR (OBJ))
#define gscm_cddr(OBJ)		SCDR (SCDR (OBJ))

#define gscm_caaar(OBJ)		SCAR (SCAR (SCAR (OBJ)))
#define gscm_cdaar(OBJ)		SCDR (SCAR (SCAR (OBJ)))
#define gscm_cadar(OBJ)		SCAR (SCDR (SCAR (OBJ)))
#define gscm_cddar(OBJ)		SCDR (SCDR (SCAR (OBJ)))
#define gscm_caadr(OBJ)		SCAR (SCAR (SCDR (OBJ)))
#define gscm_cdadr(OBJ)		SCDR (SCAR (SCDR (OBJ)))
#define gscm_caddr(OBJ)		SCAR (SCDR (SCDR (OBJ)))
#define gscm_cdddr(OBJ)		SCDR (SCDR (SCDR (OBJ)))

#define gscm_caaaar(OBJ)	SCAR (SCAR (SCAR (SCAR (OBJ))))
#define gscm_cdaaar(OBJ)	SCDR (SCAR (SCAR (SCAR (OBJ))))
#define gscm_cadaar(OBJ)	SCAR (SCDR (SCAR (SCAR (OBJ))))
#define gscm_cddaar(OBJ)	SCDR (SCDR (SCAR (SCAR (OBJ))))
#define gscm_caadar(OBJ)	SCAR (SCAR (SCDR (SCAR (OBJ))))
#define gscm_cdadar(OBJ)	SCDR (SCAR (SCDR (SCAR (OBJ))))
#define gscm_caddar(OBJ)	SCAR (SCDR (SCDR (SCAR (OBJ))))
#define gscm_cdddar(OBJ)	SCDR (SCDR (SCDR (SCAR (OBJ))))
#define gscm_caaadr(OBJ)	SCAR (SCAR (SCAR (SCDR (OBJ))))
#define gscm_cdaadr(OBJ)	SCDR (SCAR (SCAR (SCDR (OBJ))))
#define gscm_cadadr(OBJ)	SCAR (SCDR (SCAR (SCDR (OBJ))))
#define gscm_cddadr(OBJ)	SCDR (SCDR (SCAR (SCDR (OBJ))))
#define gscm_caaddr(OBJ)	SCAR (SCAR (SCDR (SCDR (OBJ))))
#define gscm_cdaddr(OBJ)	SCDR (SCAR (SCDR (SCDR (OBJ))))
#define gscm_cadddr(OBJ)	SCAR (SCDR (SCDR (SCDR (OBJ))))
#define gscm_cddddr(OBJ)	SCDR (SCDR (SCDR (SCDR (OBJ))))

#define gscm_ulong 		scm_ulong2num
#define gscm_long 		scm_long2num
#define gscm_double(X)		scm_makdbl ((X), 0.0)
#define gscm_char(C)		MAKICHR(C)

#define gscm_2_ulong(OBJ)	scm_num2ulong((OBJ), ARG1, "gscm_2_ulong")
#define gscm_2_long(OBJ)	scm_num2long((OBJ), ARG1, "gscm_2_long")
extern double gscm_2_double P((SCM));
extern int gscm_2_char P((SCM));

#define gscm_str(SRC, LEN)	scm_makfromstr (SRC, LEN, 0)
#define gscm_str0		makfrom0str
extern void gscm_2_str P((char ** str_out, int * len_out, SCM * obj_in));

#define gscm_eq(OBJ)		(BOOL_F != scm_eq (OBJ))
#define gscm_eqv(OBJ)		(BOOL_F != scm_eqv (OBJ))
#define gscm_equal(OBJ)		(BOOL_F != scm_equal (OBJ))

#define gscm_bool(CBOOL)	((CBOOL) ? BOOL_T : BOOL_F)
#define gscm_2_bool(BOOL)	(((BOOL) == BOOL_F) ? 0 : 1)

#define gscm_symbol(STR, LEN) 	 CAR(scm_intern (STR, LEN))
#define gscm_tmp_symbol(STR, LEN) CAR(scm_intern_obarray (STR, LEN, BOOL_F))

#define gscm_vector(N, FILL)	scm_make_vector (INUM(N), (FILL))
#define gscm_vref(V, I)		scm_vector_ref ((V), INUM(I))
#define gscm_vset(V, I, VAL)	scm_vector_set ((V), INUM(I), (VAL))

extern SCM gscm_make_subr P((SCM (*fn)(),
			     int req, int opt, int varp, char * doc));
extern SCM gscm_curry P((SCM procedure, SCM first_arg));


#define gscm_catch(T, TH, H)		scm_catch ((T), (TH), (H))
#define gscm_throw(T, V)		scm_throw ((T), (V))
#define gscm_dynamic_wind(E, T, L)	scm_dynwind ((E), (T), (L))

#define gscm_apply(PROC, ARGS)		scm_apply ((PROC), (ARGS), EOL)

extern void gscm_error P((char * message, SCM args));
extern SCM gscm_alloc P((struct gscm_type *, int size));
extern char * gscm_unwrap_obj P((struct gscm_type *, SCM * obj));
extern struct gscm_type * gscm_get_type P((SCM * obj));

#define gscm_print_obj			scm_iprin1
#define gscm_putc			scm_lputc
#define gscm_puts			scm_lputs
#define gscm_fwrite			scm_lfwrite
#define gscm_flush			scm_lflush
#define gscm_mkarray(SIZE)		scm_mkarray((SIZE), 1)





#endif  /* GUILEH */
