prim.h

#ifndef PRIM_INCLUDED
#define PRIM_INCLUDED

#include "interval.h"
#include "obj.h"
#include "obj_cont.h"
#include "obj_proc.h"
#include "uniq.h"

#ifndef DEBUG_EVAL
    #define DEBUG_EVAL 0
#endif

/*
 * Primitives.
 *
 * We can classify primitives as either procedures or special forms.
 * A procedure is invoked after its arguments are evaluated.  A
 * special form is invoked with unevaluated arguments.  (As well as
 * primitive procedures, there are also user-defined procedures,
 * created by lambda.  There are no user-defined special forms.)
 *
 * We can also classify primitives as raw or cooked.  Those are my own
 * terms, not standard Lisp/Scheme terminology.  A raw primitive is
 * called the same way as an eval trampoline routine, and returns the
 * same value.  A cooked primitive is called in a simpler way.  Both
 * are described in detail below.
 *
 * Finally, we can classify primitives by storage class.  The C
 * function itself is either extern, static, or anonymous.  Extern and
 * static mean what they do in C.  Anonymous means it has an
 * autogenerated name and static scope.  Anonymous is the most
 * common case by far.
 *
 * Raw.  A raw primitive takes two arguments and returns two values.
 * The first argument is a continuation.  The second is the value
 * stack.  The return values are the same: a continuation (whatever
 * trampoline or primitive should be evaluated next) and a value
 * stack.  This is messy but the primitive has full access to the
 * evaluator's internal state.  Note that both the continuation stack
 * and the value stack are immutable.  Create new items and push them
 * on, but don't modify what's already there.
 *
 * Cooked.  A cooked primitive declares how many arguments it takes
 * with an arg range.  An arg range may be a single number, N, meaning
 * the primitive takes exactly N args; a hyphenated pair of numbers,
 * M-N, meaning it takes from M to N args; or a number followed by a
 * hyphen, M-, meaning it takes M or more args.  The evaluator checks
 * that the procedure is called with a legal number of args.  A cooked
 * procedure returns one obj_t which is pushed onto the value stack.
 *
 * A primitive always declares its C arg list immediately after the
 * DEFINE_* macro.
 *
 * Here's an example.
 *
 *     DEFINE_PROC(L"foo", 2-3)(obj_t a, obj_t b, obj_t c)
 *     {
 *         if (c == MISSING_ARG)
 *             return CONS(a, b);
 *         else
 *	       return CONS(a, CONS(b, c));
 *     }
 *
 * This primitive is a procedure, is anonymous, is bound to foo, and
 * uses the cooked API.  It accepts either two or three args.  If it's
 * called with only 2, its third arg is set to MISSING_ARG.
 *
 * Here's another example.
 *
 *     DEFINE_COOKED_SPECIAL_FORM(L"bar", 1-)(obj_t first, obj_t rest)
 *     {
 *         return CONS(first, list_length(rest));
 *     }
 * 
 * This is a special form.  It's anonymous.  It's bound to bar.  It
 * uses the cooked API and expects one or more args.  The first arg is
 * passed separately, and the rest of the args are in a list (which
 * may be empty).
 */

/*
 * IMPORTANT RULE.
 *
 * If a primitive mutates existing heap data, then it MUST do so after
 * completing all memory allocations.  That's because any allocation
 * may fail and trigger a garbage collection cycle, after which the
 * primitive is retried.  Newly allocated objects are not reachable
 * from a root, so they are reclaimed.  If an old object points to
 * a reclaimed object, the heap is corrupted.
 *
 * Objects allocated by the primitive may be mutated in any order.
 * They will all be reclaimed during GC if the primitive triggers GC.
 *
 * Similarly, if a primitive has side-effects such as I/O, then
 * it must do all allocations before committing the I/O.
 *
 * Examples of heap modifying primitives: define, set!, set-car!.
 */

/* abbreviations */
#define DEFINE_PROC                DEFINE_ANONYMOUS_PROC
#define DEFINE_RAW_PROC            DEFINE_ANONYMOUS_RAW_PROC
#define DEFINE_SPECIAL_FORM        DEFINE_ANONYMOUS_SPECIAL_FORM
#define DEFINE_COOKED_SPECIAL_FORM DEFINE_ANONYMOUS_COOKED_SPECIAL_FORM

#define DEFINE_EXTERN_PROC(C_name, scheme_name, args)			\
    DEFINE_GENERAL_PRIM_(extern,					\
			C_name,						\
			scheme_name,					\
			obj_t,						\
			args,						\
			create_proc)

#define DEFINE_STATIC_PROC(C_name, scheme_name, args)			\
    DEFINE_GENERAL_PRIM_(static,					\
			C_name,						\
			scheme_name,					\
			obj_t,						\
			args,						\
			create_proc)

#define DEFINE_ANONYMOUS_PROC(scheme_name, args)			\
    DEFINE_GENERAL_PRIM_(static,					\
			UNIQ_IDENT(anonymous_),				\
			scheme_name,					\
			obj_t,						\
			args,						\
			create_proc)

#define DEFINE_EXTERN_RAW_PROC(C_name, scheme_name)			\
    DEFINE_GENERAL_PRIM_(extern,					\
			 C_name,					\
			 scheme_name,					\
			 cv_t,						\
			 0,						\
			 create_raw_proc)

#define DEFINE_STATIC_RAW_PROC(C_name, scheme_name)			\
    DEFINE_GENERAL_PRIM_(static,					\
			 C_name,					\
			 scheme_name,					\
			 cv_t,						\
			 0,						\
			 create_raw_proc)

#define DEFINE_ANONYMOUS_RAW_PROC(scheme_name)				\
    DEFINE_GENERAL_PRIM_(static,					\
                         UNIQ_IDENT(anonymous_),			\
                         scheme_name,					\
			 cv_t,						\
			 0,						\
			 create_raw_proc)

#define DEFINE_EXTERN_SPECIAL_FORM(C_name, scheme_name)			\
    DEFINE_GENERAL_PRIM_(extern,					\
			 C_name,					\
			 scheme_name,					\
	 		 cv_t,						\
			 0,						\
			 create_special_form)

#define DEFINE_STATIC_SPECIAL_FORM(C_name, scheme_name)			\
    DEFINE_GENERAL_PRIM_(static,					\
			 C_name,					\
			 scheme_name,					\
	 		 cv_t,						\
			 0,						\
			 create_special_form)

#define DEFINE_ANONYMOUS_SPECIAL_FORM(scheme_name)			\
    DEFINE_GENERAL_PRIM_(static,					\
                         UNIQ_IDENT(anonymous_),			\
                         scheme_name,					\
			 cv_t,						\
			 0,						\
			 create_special_form)

#define DEFINE_EXTERN_COOKED_SPECIAL_FORM(C_name, scheme_name, args)	\
    DEFINE_GENERAL_PRIM_(extern,					\
			C_name,						\
			scheme_name,					\
			obj_t,						\
			args,						\
			create_cooked_special_form)

#define DEFINE_STATIC_COOKED_SPECIAL_FORM(C_name, scheme_name, args)	\
    DEFINE_GENERAL_PRIM_(static,					\
			C_name,						\
			scheme_name,					\
			obj_t,						\
			args,						\
			create_cooked_special_form)

#define DEFINE_ANONYMOUS_COOKED_SPECIAL_FORM(scheme_name, args)		\
    DEFINE_GENERAL_PRIM_(static,					\
			UNIQ_IDENT(anonymous_),				\
			scheme_name,					\
			obj_t,						\
			args,						\
			create_cooked_special_form)

#define ALIAS_NAME(old_name, new_name)					\
    __attribute__((constructor))					\
    static void UNIQ_IDENT(alias_proc_)(void)				\
    {									\
	static alias_descriptor_t desc = {				\
	    old_name,							\
	    new_name,							\
	    NULL							\
	};								\
	register_alias(&desc);						\
    }

#define DEFINE_GENERAL_PRIM_(storage_class,				\
			     C_name,					\
			     scheme_name,				\
			     return_type,				\
			     arg_range,					\
			     binder)					\
    storage_class return_type C_name();					\
    __attribute__((constructor))					\
    static void UNIQ_IDENT(bind_prim_)(void)				\
    {									\
	static prim_descriptor_t desc = {				\
	    (obj_t (*)())C_name,					\
	    scheme_name,						\
	    COMPILE_INTERVAL(arg_range),				\
	    binder,							\
	    NULL							\
	};								\
	register_prim(&desc);						\
    }									\
    storage_class return_type C_name

typedef struct prim_descriptor  prim_descriptor_t;
typedef struct alias_descriptor alias_descriptor_t;
typedef obj_t                   creator_t(const prim_descriptor_t *);

struct prim_descriptor {
    obj_t               (*pd_code)();
    const wchar_t        *pd_name;
    interval_t            pd_arg_range;
    creator_t            *pd_creator;
    prim_descriptor_t    *pd_next;
};

struct alias_descriptor {
    const wchar_t        *ad_old_name;
    const wchar_t        *ad_new_name;
    alias_descriptor_t   *ad_next;
};

extern void  register_prim             (prim_descriptor_t *);
extern void  register_primitives       (void);
extern void  register_alias            (alias_descriptor_t *);

extern obj_t create_proc               (const prim_descriptor_t *);
extern obj_t create_raw_proc           (const prim_descriptor_t *);
extern obj_t create_special_form       (const prim_descriptor_t *);
extern obj_t create_cooked_special_form(const prim_descriptor_t *);

extern cv_t  c_eval                    (obj_t cont, obj_t values);
extern cv_t  c_apply_proc              (obj_t cont, obj_t values);
extern cv_t  c_peek_char               (obj_t cont, obj_t values);
extern cv_t  c_read_char               (obj_t cont, obj_t values);

#if DEBUG_EVAL
    #include "oprintf.h"
    #define EVAL_LOG(fmt, ...) \
	(oprintf("%-18s " fmt "\n", __func__, __VA_ARGS__))
#else
    #define EVAL_LOG(fmt, ...) ((void)0)
#endif

#endif /* !PROC_INCLUDED */