diff options
author | Greg J. Badros <gjb@cs.washington.edu> | 1999-12-12 02:36:16 +0000 |
---|---|---|
committer | Greg J. Badros <gjb@cs.washington.edu> | 1999-12-12 02:36:16 +0000 |
commit | 1bbd0b849f6b90f1ffe57e586e4ee5a884f84a11 (patch) | |
tree | 79120a96365e0fa3324174bfd08d731ca8311d64 /libguile/eval.c | |
parent | 6e7069385db8cf96dfbe51cf65ace161942a32c9 (diff) | |
download | guile-1bbd0b849f6b90f1ffe57e586e4ee5a884f84a11.tar.gz |
* *.c: Pervasive software-engineering-motivated rewrite of
function headers and argument checking. Switched SCM_PROC,
SCM_PROC1 macros to be GUILE_PROC, GUILE_PROC1 (may change names
later, but was useful to keep old versions around while migrate)
that has docstrings and argument lists embedded in the GUILE_PROC
macro invocations that expand into a function header. Use lots of
new SCM_VALIDATE_* macros to simplify error checking and reduce
tons of redundancy. This is very similar to what I did for Scwm.
Note that none of the extraction of the docstrings, nor software
engineering checks of Scwm is yet added to Guile. I'll work on
that tomorrow, I expect.
* Makefile.am: Added scm_validate.h to modinclude_HEADERS.
* chars.c: Added docstrings for the primitives defined in here.
* snarf.h: Added GUILE_PROC, GUILE_PROC1. Added
SCM_REGISTER_PROC to be like old SCM_PROC, though old SCM_PROC
still remains for now. Changed naming convention for the s_foo
string name of the primitive to be s_scm_foo for ease of use with
the macro.
* scm_validate.h: Lots of new SCM_VALIDATE macros to simplify
argument checking through guile. Maybe some of these should be
folded into the header file for the types they check, but for now
it was easiest to just stick them all in one place.
Diffstat (limited to 'libguile/eval.c')
-rw-r--r-- | libguile/eval.c | 170 |
1 files changed, 72 insertions, 98 deletions
diff --git a/libguile/eval.c b/libguile/eval.c index 586c884c2..f92a3c8de 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -38,6 +38,10 @@ * If you write modifications of your own for GUILE, it is your choice * whether to permit this exception to apply to your modifications. * If you do not wish that, delete this exception notice. */ + +/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999, + gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */ + /* This file is read twice in order to produce debugging versions of @@ -92,6 +96,7 @@ char *alloca (); #include "feature.h" #include "modules.h" +#include "scm_validate.h" #include "eval.h" SCM (*scm_memoize_method) (SCM, SCM); @@ -831,7 +836,7 @@ scm_m_do (xorig, env) #define evalcar scm_eval_car -static SCM iqq SCM_P ((SCM form, SCM env, int depth)); +static SCM iqq (SCM form, SCM env, int depth); SCM_SYNTAX(s_quasiquote, "quasiquote", scm_makacro, scm_m_quasiquote); SCM_GLOBAL_SYMBOL(scm_sym_quasiquote, s_quasiquote); @@ -848,10 +853,7 @@ scm_m_quasiquote (xorig, env) static SCM -iqq (form, env, depth) - SCM form; - SCM env; - int depth; +iqq (SCM form,SCM env,int depth) { SCM tmp; int edepth = depth; @@ -1350,12 +1352,8 @@ scm_macroexp (SCM x, SCM env) * readable style... :) */ -static SCM unmemocopy SCM_P ((SCM x, SCM env)); - static SCM -unmemocopy (x, env) - SCM x; - SCM env; +unmemocopy (SCM x, SCM env) { SCM ls, z; #ifdef DEBUG_EXTENSIONS @@ -1714,7 +1712,7 @@ scm_eval_body (SCM code, SCM env) */ -SCM (*scm_ceval_ptr) SCM_P ((SCM x, SCM env)); +SCM (*scm_ceval_ptr) (SCM x, SCM env); /* scm_last_debug_frame contains a pointer to the last debugging * information stack frame. It is accessed very often from the @@ -1769,38 +1767,39 @@ scm_option scm_evaluator_trap_table[] = { { SCM_OPTION_BOOLEAN, "exit-frame", 0, "Trap when exiting eval or apply." } }; -SCM_PROC (s_eval_options_interface, "eval-options-interface", 0, 1, 0, scm_eval_options_interface); - -SCM -scm_eval_options_interface (SCM setting) +GUILE_PROC (scm_eval_options_interface, "eval-options-interface", 0, 1, 0, + (SCM setting), +"") +#define FUNC_NAME s_scm_eval_options_interface { SCM ans; SCM_DEFER_INTS; ans = scm_options (setting, scm_eval_opts, SCM_N_EVAL_OPTIONS, - s_eval_options_interface); + FUNC_NAME); scm_eval_stack = SCM_EVAL_STACK * sizeof (void *); SCM_ALLOW_INTS; return ans; } +#undef FUNC_NAME -SCM_PROC (s_evaluator_traps, "evaluator-traps-interface", 0, 1, 0, scm_evaluator_traps); - -SCM -scm_evaluator_traps (setting) - SCM setting; +GUILE_PROC (scm_evaluator_traps, "evaluator-traps-interface", 0, 1, 0, + (SCM setting), +"") +#define FUNC_NAME s_scm_evaluator_traps { SCM ans; SCM_DEFER_INTS; ans = scm_options (setting, scm_evaluator_trap_table, SCM_N_EVALUATOR_TRAPS, - s_evaluator_traps); + FUNC_NAME); SCM_RESET_DEBUG_MODE; SCM_ALLOW_INTS; return ans; } +#undef FUNC_NAME SCM scm_deval_args (l, env, proc, lloc) @@ -1866,24 +1865,18 @@ scm_deval_args (l, env, proc, lloc) #if 0 SCM -scm_ceval (x, env) - SCM x; - SCM env; +scm_ceval (SCM x, SCM env) {} #endif #if 0 SCM -scm_deval (x, env) - SCM x; - SCM env; +scm_deval (SCM x, SCM env) {} #endif SCM -SCM_CEVAL (x, env) - SCM x; - SCM env; +SCM_CEVAL (SCM x, SCM env) { union { @@ -3256,21 +3249,21 @@ ret: you if you do (scm_apply scm_apply '( ... ))" If you know what they're referring to, send me a patch to this comment. */ -SCM_PROC(s_nconc2last, "apply:nconc2last", 1, 0, 0, scm_nconc2last); - -SCM -scm_nconc2last (lst) - SCM lst; +GUILE_PROC(scm_nconc2last, "apply:nconc2last", 1, 0, 0, + (SCM lst), +"") +#define FUNC_NAME s_scm_nconc2last { SCM *lloc; - SCM_ASSERT (scm_ilength (lst) > 0, lst, SCM_ARG1, s_nconc2last); + SCM_VALIDATE_LIST(1,lst); lloc = &lst; while (SCM_NNULLP (SCM_CDR (*lloc))) lloc = SCM_CDRLOC (*lloc); - SCM_ASSERT (scm_ilength (SCM_CAR (*lloc)) >= 0, lst, SCM_ARG1, s_nconc2last); + SCM_ASSERT (scm_ilength (SCM_CAR (*lloc)) >= 0, lst, SCM_ARG1, FUNC_NAME); *lloc = SCM_CAR (*lloc); return lst; } +#undef FUNC_NAME #endif /* !DEVAL */ @@ -3311,10 +3304,7 @@ scm_dapply (proc, arg1, args) onto the front of your argument list, and pass that as ARGS. */ SCM -SCM_APPLY (proc, arg1, args) - SCM proc; - SCM arg1; - SCM args; +SCM_APPLY (SCM proc, SCM arg1, SCM args) { #ifdef DEBUG_EXTENSIONS #ifdef DEVAL @@ -3662,10 +3652,7 @@ SCM_GPROC (s_map, "map", 2, 0, 1, scm_map, g_map); */ SCM -scm_map (proc, arg1, args) - SCM proc; - SCM arg1; - SCM args; +scm_map (SCM proc, SCM arg1, SCM args) { long i, len; SCM res = SCM_EOL; @@ -3713,10 +3700,7 @@ scm_map (proc, arg1, args) SCM_GPROC (s_for_each, "for-each", 2, 0, 1, scm_for_each, g_for_each); SCM -scm_for_each (proc, arg1, args) - SCM proc; - SCM arg1; - SCM args; +scm_for_each (SCM proc, SCM arg1, SCM args) { SCM *ve = &args; /* Keep args from being optimized away. */ long i, len; @@ -3781,13 +3765,8 @@ scm_makprom (code) -static int prinprom SCM_P ((SCM exp, SCM port, scm_print_state *pstate)); - static int -prinprom (exp, port, pstate) - SCM exp; - SCM port; - scm_print_state *pstate; +prinprom (SCM exp,SCM port,scm_print_state *pstate) { int writingp = SCM_WRITINGP (pstate); scm_puts ("#<promise ", port); @@ -3799,14 +3778,12 @@ prinprom (exp, port, pstate) } -SCM_PROC(s_force, "force", 1, 0, 0, scm_force); - -SCM -scm_force (x) - SCM x; +GUILE_PROC(scm_force, "force", 1, 0, 0, + (SCM x), +"") +#define FUNC_NAME s_scm_force { - SCM_ASSERT (SCM_NIMP(x) && SCM_TYP16 (x) == scm_tc16_promise, - x, SCM_ARG1, s_force); + SCM_VALIDATE_SMOB(1,x,promise); if (!((1L << 16) & SCM_CAR (x))) { SCM ans = scm_apply (SCM_CDR (x), SCM_EOL, SCM_EOL); @@ -3820,22 +3797,21 @@ scm_force (x) } return SCM_CDR (x); } +#undef FUNC_NAME -SCM_PROC (s_promise_p, "promise?", 1, 0, 0, scm_promise_p); - -SCM -scm_promise_p (x) - SCM x; +GUILE_PROC (scm_promise_p, "promise?", 1, 0, 0, + (SCM x), +"") +#define FUNC_NAME s_scm_promise_p { - return ((SCM_NIMP (x) && (SCM_TYP16 (x) == scm_tc16_promise)) - ? SCM_BOOL_T - : SCM_BOOL_F); + return SCM_BOOL(SCM_NIMP (x) && (SCM_TYP16 (x) == scm_tc16_promise)); } +#undef FUNC_NAME -SCM_PROC (s_cons_source, "cons-source", 3, 0, 0, scm_cons_source); - -SCM -scm_cons_source (SCM xorig, SCM x, SCM y) +GUILE_PROC (scm_cons_source, "cons-source", 3, 0, 0, + (SCM xorig, SCM x, SCM y), +"") +#define FUNC_NAME s_scm_cons_source { SCM p, z; SCM_NEWCELL (z); @@ -3847,12 +3823,12 @@ scm_cons_source (SCM xorig, SCM x, SCM y) scm_whash_insert (scm_source_whash, z, p); return z; } +#undef FUNC_NAME -SCM_PROC (s_copy_tree, "copy-tree", 1, 0, 0, scm_copy_tree); - -SCM -scm_copy_tree (obj) - SCM obj; +GUILE_PROC (scm_copy_tree, "copy-tree", 1, 0, 0, + (SCM obj), +"") +#define FUNC_NAME s_scm_copy_tree { SCM ans, tl; if (SCM_IMP (obj)) @@ -3880,13 +3856,11 @@ scm_copy_tree (obj) SCM_SETCDR (tl, obj); return ans; } +#undef FUNC_NAME SCM -scm_eval_3 (obj, copyp, env) - SCM obj; - int copyp; - SCM env; +scm_eval_3 (SCM obj, int copyp, SCM env) { if (SCM_NIMP (SCM_CDR (scm_system_transformer))) obj = scm_apply (SCM_CDR (scm_system_transformer), obj, scm_listofnull); @@ -3895,33 +3869,33 @@ scm_eval_3 (obj, copyp, env) return SCM_XEVAL (obj, env); } -SCM_PROC(s_eval2, "eval2", 2, 0, 0, scm_eval2); - -SCM -scm_eval2 (obj, env_thunk) - SCM obj; - SCM env_thunk; +GUILE_PROC(scm_eval2, "eval2", 2, 0, 0, + (SCM obj, SCM env_thunk), +"") +#define FUNC_NAME s_scm_eval2 { return scm_eval_3 (obj, 1, scm_top_level_env (env_thunk)); } +#undef FUNC_NAME -SCM_PROC(s_eval, "eval", 1, 0, 0, scm_eval); - -SCM -scm_eval (obj) - SCM obj; +GUILE_PROC(scm_eval, "eval", 1, 0, 0, + (SCM obj), +"") +#define FUNC_NAME s_scm_eval { return scm_eval_3 (obj, 1, scm_top_level_env (SCM_CDR (scm_top_level_lookup_closure_var))); } +#undef FUNC_NAME -/* SCM_PROC(s_eval_x, "eval!", 1, 0, 0, scm_eval_x); */ +/* +SCM_REGISTER_PROC(s_eval_x, "eval!", 1, 0, 0, scm_eval_x); +*/ SCM -scm_eval_x (obj) - SCM obj; +scm_eval_x (SCM obj) { return scm_eval_3 (obj, 0, |