/*
     libscheme	
     Copyright (C) 1994 Brent Benson

     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 1, 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 program; if not, write to the Free Software
     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
*/

#ifndef SCHEME_H
#define SCHEME_H

#include "scheme_hash.h"
#include <stdio.h>
#include <setjmp.h>
#include <stdarg.h>
#include <stdlib.h>
#include <X11/Intrinsic.h>
#include <X11/StringDefs.h>
#include <X11/Xaw/Text.h>

struct Scheme_Env
{
  int num_bindings;
  struct Scheme_Object **symbols;
  struct Scheme_Object **values;
  Scheme_Hash_Table *globals;
  struct Scheme_Env *next;
};
typedef struct Scheme_Env Scheme_Env;

struct Scheme_Object
{
  struct Scheme_Object *type;
  union
    {
      char char_val;
      int int_val;
      double double_val;
      char *c_char_val;
      int *c_int_val;
      double *c_double_val;
      char *string_val;
      void *ptr_val;
      struct { int x; int y; } coord_val;
      struct { struct Scheme_Object *lu; struct Scheme_Object *rl; } range_val;
      struct Scheme_Object *(*prim_val)
	(int argc, struct Scheme_Object *argv[]);
      struct Scheme_Object *(*syntax_val)
	(struct Scheme_Object *form, struct Scheme_Env *env);
      struct { struct Scheme_Object *car, *cdr; } pair_val;
      struct { int size; struct Scheme_Object **els; } vector_val;
      struct { struct Scheme_Env *env; struct Scheme_Object *code; } closure_val;
      struct { struct Scheme_Object *def; struct Scheme_Method *meths; } methods_val;
    } u;
};
typedef struct Scheme_Object Scheme_Object;

/* access macros */
#define SCHEME_TYPE(obj)     ((obj)->type)
#define SCHEME_CHAR_VAL(obj) (SCHEME_C_CHARP(obj) ? *(obj)->u.c_char_val \
			                          : (obj)->u.char_val)
#define SCHEME_INT_VAL(obj)  (SCHEME_C_INTP(obj) ? *(obj)->u.c_int_val \
			                         : (obj)->u.int_val)
#define SCHEME_DBL_VAL(obj)  (SCHEME_C_DOUBLEP(obj) ? *(obj)->u.c_double_val \
                                                    : (obj)->u.double_val)
#define SCHEME_STR_VAL(obj)  ((obj)->u.string_val)
#define SCHEME_PTR_VAL(obj)  ((obj)->u.ptr_val)
#define SCHEME_C_CHAR_VAL(obj) ((obj)->u.c_char_val)
#define SCHEME_C_INT_VAL(obj) ((obj)->u.c_int_val)
#define SCHEME_C_DOUBLE_VAL(obj) ((obj)->u.c_double_val)
#define SCHEME_COORD_VAL_X(obj) ((obj)->u.coord_val.x)
#define SCHEME_COORD_VAL_Y(obj) ((obj)->u.coord_val.y)
#define SCHEME_RANGE_VAL_LU(obj) ((obj)->u.range_val.lu)
#define SCHEME_RANGE_VAL_RL(obj) ((obj)->u.range_val.rl)
#define SCHEME_SYNTAX(obj)   ((obj)->u.syntax_val)
#define SCHEME_PRIM(obj)     ((obj)->u.prim_val)
#define SCHEME_CAR(obj)      ((obj)->u.pair_val.car)
#define SCHEME_CDR(obj)      ((obj)->u.pair_val.cdr)
#define SCHEME_VEC_SIZE(obj) ((obj)->u.vector_val.size)
#define SCHEME_VEC_ELS(obj)  ((obj)->u.vector_val.els)
#define SCHEME_CLOS_ENV(obj) ((obj)->u.closure_val.env)
#define SCHEME_CLOS_CODE(obj)((obj)->u.closure_val.code)
#define SCHEME_METH_DEF(obj) ((obj)->u.methods_val.def)
#define SCHEME_METHS(obj)    ((obj)->u.methods_val.meths)

struct Scheme_Method
{
  Scheme_Object *type;
  Scheme_Object *fun;
  struct Scheme_Method *next;
};
typedef struct Scheme_Method Scheme_Method;

typedef struct Scheme_Object *
(Scheme_Prim) (int argc, struct Scheme_Object *argv[]);

typedef struct Scheme_Object *
(Scheme_Syntax) (struct Scheme_Object *form, struct Scheme_Env *env);

/* error handling */
extern jmp_buf scheme_error_buf;
void scheme_signal_error (char *msg, ...);
void scheme_default_handler (void);
#define SCHEME_CATCH_ERROR(try_expr, err_expr) \
  (setjmp(scheme_error_buf) ? (err_expr) : (try_expr))
#define SCHEME_ASSERT(expr,msg,args...) \
  ((expr) ? 0 : (scheme_signal_error(msg, ## args), 1))

/* types */
extern Scheme_Object *scheme_type_type;
extern Scheme_Object *scheme_char_type;
extern Scheme_Object *scheme_integer_type, *scheme_double_type;
extern Scheme_Object *scheme_c_char_type;
extern Scheme_Object *scheme_c_integer_type, *scheme_c_double_type;
extern Scheme_Object *scheme_string_type, *scheme_symbol_type;
extern Scheme_Object *scheme_null_type, *scheme_pair_type;
extern Scheme_Object *scheme_coord_type, *scheme_range_type;
extern Scheme_Object *scheme_vector_type;
extern Scheme_Object *scheme_prim_type, *scheme_closure_type;
extern Scheme_Object *scheme_cont_type;
extern Scheme_Object *scheme_input_port_type, *scheme_output_port_type;
extern Scheme_Object *scheme_eof_type;
extern Scheme_Object *scheme_eos_type;
extern Scheme_Object *scheme_true_type, *scheme_false_type;
extern Scheme_Object *scheme_syntax_type, *scheme_macro_type;
extern Scheme_Object *scheme_promise_type, *scheme_struct_proc_type;

/* common symbols */
extern Scheme_Object *scheme_quote_symbol;
extern Scheme_Object *scheme_quasiquote_symbol;
extern Scheme_Object *scheme_unquote_symbol;
extern Scheme_Object *scheme_unquote_splicing_symbol;

/* constants */
extern Scheme_Object *scheme_eof;
extern Scheme_Object *scheme_eos;
extern Scheme_Object *scheme_null;
extern Scheme_Object *scheme_true;
extern Scheme_Object *scheme_false;

/* basics */
Scheme_Object *scheme_read (FILE *fp);
Scheme_Object *scheme_read_str (char **CP);
Scheme_Object *scheme_eval (Scheme_Object *obj, Scheme_Env *env);
void scheme_write (FILE *fp, Scheme_Object *obj);
void scheme_display (FILE *fp, Scheme_Object *obj);
Scheme_Object *display (int argc, Scheme_Object *argv[]);
void scheme_debug_print (Scheme_Object *obj);
void scheme_tprint(void (*editAdd)(Bool, XawTextBlock *, Bool),
		   Scheme_Object *obj, int escaped, char *postfix);
Scheme_Object *scheme_apply (Scheme_Object *rator, Scheme_Object *rands);
Scheme_Object *scheme_apply_struct_proc (Scheme_Object *rator, Scheme_Object *rands);
Scheme_Object *scheme_alloc_object (void);
void *scheme_malloc (size_t size);
void *scheme_calloc (size_t num, size_t size);
char *scheme_strdup (char *str);

/* garbage collected heap interface */
extern void *GC_malloc (size_t size_in_bytes);
extern int GC_expand_hp (int num_4k_blocks);

/* constructors */
Scheme_Object *scheme_make_prim (Scheme_Prim *prim);
Scheme_Object *scheme_make_closure (Scheme_Env *env, Scheme_Object *code);
Scheme_Object *scheme_make_cont (jmp_buf buf);
Scheme_Object *scheme_make_type (char *name);
Scheme_Object *scheme_make_pair (Scheme_Object *car, Scheme_Object *cdr);
Scheme_Object *scheme_make_string (char *chars);
Scheme_Object *scheme_alloc_string (int size, char fill);
Scheme_Object *scheme_make_coord (int x, int y);
Scheme_Object *scheme_make_range (int xlu, int ylu, int xrl, int yrl);
Scheme_Object *scheme_make_vector (int size, Scheme_Object *fill);
Scheme_Object *scheme_make_integer (int i);
Scheme_Object *scheme_make_double (double d);
Scheme_Object *scheme_make_char (char ch);
Scheme_Object *scheme_make_c_char (char *ch);
Scheme_Object *scheme_make_c_integer (int *i);
Scheme_Object *scheme_make_c_double (double *d);
Scheme_Object *scheme_make_syntax (Scheme_Syntax *syntax);
Scheme_Object *scheme_make_input_port (FILE *fp);
Scheme_Object *scheme_make_output_port (FILE *fp);
Scheme_Object *scheme_make_promise (Scheme_Object *expr, Scheme_Env *env);

/* environment */
void scheme_add_global (char *name, Scheme_Object *val, Scheme_Env *env);
Scheme_Env *scheme_add_frame (Scheme_Object *syms, Scheme_Object *vals, Scheme_Env *env);
Scheme_Env *scheme_pop_frame (Scheme_Env *env);
void scheme_set_value (Scheme_Object *var, Scheme_Object *val, Scheme_Env *env);
Scheme_Object *scheme_lookup_value (Scheme_Object *symbol, Scheme_Env *env);
Scheme_Object *scheme_lookup_global (Scheme_Object *symbol, Scheme_Env *env);
extern Scheme_Env *scheme_env;

/* symbols */
Scheme_Object *scheme_intern_symbol (char *name);

/* initialization */
Scheme_Env *scheme_basic_env (void);
void scheme_init_type (Scheme_Env *env);
void scheme_init_list (Scheme_Env *env);
void scheme_init_port (Scheme_Env *env);
void scheme_init_proc (Scheme_Env *env);
void scheme_init_coord (Scheme_Env *env);
void scheme_init_ctype (Scheme_Env *env);
void scheme_init_vector (Scheme_Env *env);
void scheme_init_string (Scheme_Env *env);
void scheme_init_number (Scheme_Env *env);
void scheme_init_eval (Scheme_Env *env);
void scheme_init_promise (Scheme_Env *env);
void scheme_init_struct (Scheme_Env *env);
void scheme_init_buffer (Scheme_Env *env);
void scheme_init_empcommand (Scheme_Env *env);
void scheme_init_vtport (Scheme_Env *env);
void scheme_init_edit (Scheme_Env *env);
void scheme_init_save (Scheme_Env *env);
void scheme_init_select (Scheme_Env *env);

/* misc */
int scheme_eq (Scheme_Object *obj1, Scheme_Object *obj2);
int scheme_eqv (Scheme_Object *obj1, Scheme_Object *obj2);
int scheme_equal (Scheme_Object *obj1, Scheme_Object *obj2);
int scheme_list_length (Scheme_Object *list);
Scheme_Object *scheme_alloc_list (int size);
Scheme_Object *scheme_map_1 (Scheme_Object *(*fun)(Scheme_Object*), Scheme_Object *lst);
Scheme_Object *scheme_car (Scheme_Object *pair);
Scheme_Object *scheme_cdr (Scheme_Object *pair);
Scheme_Object *scheme_cadr (Scheme_Object *pair);
Scheme_Object *scheme_caddr (Scheme_Object *pair);
Scheme_Object *scheme_vector_to_list (Scheme_Object *vec);
Scheme_Object *scheme_list_to_vector (Scheme_Object *list);
Scheme_Object *scheme_hilit(int argc, Scheme_Object *argv[]);

/* convenience macros */
#define SCHEME_CHARP(obj)    (SCHEME_TYPE(obj) == scheme_char_type || \
                              SCHEME_TYPE(obj) == scheme_c_char_type)
#define SCHEME_INTP(obj)     (SCHEME_TYPE(obj) == scheme_integer_type || \
                              SCHEME_TYPE(obj) == scheme_c_integer_type)
#define SCHEME_DBLP(obj)     (SCHEME_TYPE(obj) == scheme_double_type || \
                              SCHEME_TYPE(obj) == scheme_c_double_type)
#define SCHEME_C_CHARP(obj)  (SCHEME_TYPE(obj) == scheme_c_char_type)
#define SCHEME_C_INTP(obj)   (SCHEME_TYPE(obj) == scheme_c_integer_type)
#define SCHEME_C_DOUBLEP(obj) (SCHEME_TYPE(obj) == scheme_c_double_type)
#define SCHEME_NUMBERP(obj)  (SCHEME_INTP(obj) || SCHEME_DBLP(obj))
#define SCHEME_STRINGP(obj)  (SCHEME_TYPE(obj) == scheme_string_type)
#define SCHEME_SYMBOLP(obj)  (SCHEME_TYPE(obj) == scheme_symbol_type)
#define SCHEME_BOOLP(obj)    ((obj == scheme_true) || (obj == scheme_false))
#define SCHEME_SYNTAXP(obj)  (SCHEME_TYPE(obj) == scheme_syntax_type)
#define SCHEME_PRIMP(obj)    (SCHEME_TYPE(obj) == scheme_prim_type)
#define SCHEME_CONTP(obj)    (SCHEME_TYPE(obj) == scheme_cont_type)
#define SCHEME_NULLP(obj)    (obj == scheme_null)
#define SCHEME_COORDP(obj)   (SCHEME_TYPE(obj) == scheme_coord_type)
#define SCHEME_RANGEP(obj)   ((SCHEME_TYPE(obj) == scheme_range_type) || SCHEME_COORDP(obj))
#define SCHEME_PAIRP(obj)    (SCHEME_TYPE(obj) == scheme_pair_type)
#define SCHEME_LISTP(obj)    (SCHEME_NULLP(obj) || SCHEME_PAIRP(obj))
#define SCHEME_VECTORP(obj)  (SCHEME_TYPE(obj) == scheme_vector_type)
#define SCHEME_CLOSUREP(obj) (SCHEME_TYPE(obj) == scheme_closure_type)
#define SCHEME_PROCP(obj)    (SCHEME_PRIMP(obj) || SCHEME_CLOSUREP(obj) || SCHEME_CONTP(obj))
#define SCHEME_INPORTP(obj)  (SCHEME_TYPE(obj) == scheme_input_port_type)
#define SCHEME_OUTPORTP(obj) (SCHEME_TYPE(obj) == scheme_output_port_type)
#define SCHEME_EOFP(obj)     (SCHEME_TYPE(obj) == scheme_eof_type)
#define SCHEME_EOSP(obj)     (SCHEME_TYPE(obj) == scheme_eos_type)
#define SCHEME_PROMP(obj)    (SCHEME_TYPE(obj) == scheme_promise_type)

#endif /* ! SCHEME_H */


