From 1bbd0b849f6b90f1ffe57e586e4ee5a884f84a11 Mon Sep 17 00:00:00 2001 From: "Greg J. Badros" Date: Sun, 12 Dec 1999 02:36:16 +0000 Subject: * *.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. --- libguile/random.c | 141 +++++++++++++++++++++++++----------------------------- 1 file changed, 66 insertions(+), 75 deletions(-) (limited to 'libguile/random.c') diff --git a/libguile/random.c b/libguile/random.c index de4c6a797..cdfbb0b83 100644 --- a/libguile/random.c +++ b/libguile/random.c @@ -38,6 +38,10 @@ * 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 */ + + /* Author: Mikael Djurfeldt */ #include "_scm.h" @@ -49,6 +53,7 @@ #include "numbers.h" #include "feature.h" +#include "scm_validate.h" #include "random.h" @@ -345,85 +350,77 @@ free_rstate (SCM rstate) SCM_GLOBAL_VCELL_INIT (scm_var_random_state, "*random-state*", scm_seed_to_random_state (scm_makfrom0str ("URL:http://stat.fsu.edu/~geo/diehard.html"))); -SCM_PROC (s_random, "random", 1, 1, 0, scm_random); - -SCM -scm_random (SCM n, SCM state) +GUILE_PROC (scm_random, "random", 1, 1, 0, + (SCM n, SCM state), + "") +#define FUNC_NAME s_scm_random { if (SCM_UNBNDP (state)) state = SCM_CDR (scm_var_random_state); - SCM_ASSERT (SCM_NIMP (state) && SCM_RSTATEP (state), - state, SCM_ARG2, s_random); + SCM_VALIDATE_RSTATE(2,state); if (SCM_INUMP (n)) { unsigned long m = SCM_INUM (n); - SCM_ASSERT (m > 0, n, SCM_ARG1, s_random); + SCM_ASSERT_RANGE (1,n,m > 0); return SCM_MAKINUM (scm_c_random (SCM_RSTATE (state), m)); } - SCM_ASSERT (SCM_NIMP (n), n, SCM_ARG1, s_random); + SCM_VALIDATE_NIMP(1,n); if (SCM_REALP (n)) return scm_makdbl (SCM_REALPART (n) * scm_c_uniform01 (SCM_RSTATE (state)), 0.0); - SCM_ASSERT (SCM_TYP16 (n) == scm_tc16_bigpos, n, SCM_ARG1, s_random); + SCM_VALIDATE_SMOB (1,n,bigpos); return scm_c_random_bignum (SCM_RSTATE (state), n); } +#undef FUNC_NAME -SCM_PROC (s_copy_random_state, "copy-random-state", 0, 1, 0, scm_copy_random_state); - -SCM -scm_copy_random_state (SCM state) +GUILE_PROC (scm_copy_random_state, "copy-random-state", 0, 1, 0, + (SCM state), + "") +#define FUNC_NAME s_scm_copy_random_state { if (SCM_UNBNDP (state)) state = SCM_CDR (scm_var_random_state); - SCM_ASSERT (SCM_NIMP (state) && SCM_RSTATEP (state), - state, - SCM_ARG1, - s_copy_random_state); + SCM_VALIDATE_RSTATE(2,state); return make_rstate (scm_the_rng.copy_rstate (SCM_RSTATE (state))); } +#undef FUNC_NAME -SCM_PROC (s_seed_to_random_state, "seed->random-state", 1, 0, 0, scm_seed_to_random_state); - -SCM -scm_seed_to_random_state (SCM seed) +GUILE_PROC (scm_seed_to_random_state, "seed->random-state", 1, 0, 0, + (SCM seed), + "") +#define FUNC_NAME s_scm_seed_to_random_state { if (SCM_NUMBERP (seed)) seed = scm_number_to_string (seed, SCM_UNDEFINED); - SCM_ASSERT (SCM_NIMP (seed) && SCM_STRINGP (seed), - seed, - SCM_ARG1, - s_seed_to_random_state); + SCM_VALIDATE_STRING(1,seed); return make_rstate (scm_c_make_rstate (SCM_ROCHARS (seed), SCM_LENGTH (seed))); } +#undef FUNC_NAME -SCM_PROC (s_random_uniform, "random:uniform", 0, 1, 0, scm_random_uniform); - -SCM -scm_random_uniform (SCM state) +GUILE_PROC (scm_random_uniform, "random:uniform", 0, 1, 0, + (SCM state), + "") +#define FUNC_NAME s_scm_random_uniform { if (SCM_UNBNDP (state)) state = SCM_CDR (scm_var_random_state); - SCM_ASSERT (SCM_NIMP (state) && SCM_RSTATEP (state), - state, - SCM_ARG1, - s_random_uniform); + SCM_VALIDATE_RSTATE(1,state); return scm_makdbl (scm_c_uniform01 (SCM_RSTATE (state)), 0.0); } +#undef FUNC_NAME -SCM_PROC (s_random_normal, "random:normal", 0, 1, 0, scm_random_normal); - -SCM -scm_random_normal (SCM state) +GUILE_PROC (scm_random_normal, "random:normal", 0, 1, 0, + (SCM state), + "") +#define FUNC_NAME s_scm_random_normal { if (SCM_UNBNDP (state)) state = SCM_CDR (scm_var_random_state); - SCM_ASSERT (SCM_NIMP (state) && SCM_RSTATEP (state), - state, - SCM_ARG1, - s_random_normal); + SCM_VALIDATE_RSTATE(1,state); return scm_makdbl (scm_c_normal01 (SCM_RSTATE (state)), 0.0); } +#undef FUNC_NAME #ifdef HAVE_ARRAYS @@ -464,20 +461,17 @@ vector_sum_squares (SCM v) * distribution r^n; i.e., u=r^n is uniform [0,1], so r can be * generated as r=u^(1/n). */ -SCM_PROC (s_random_solid_sphere_x, "random:solid-sphere!", 1, 1, 0, scm_random_solid_sphere_x); - -SCM -scm_random_solid_sphere_x (SCM v, SCM state) +GUILE_PROC (scm_random_solid_sphere_x, "random:solid-sphere!", 1, 1, 0, + (SCM v, SCM state), + "") +#define FUNC_NAME s_scm_random_solid_sphere_x { SCM_ASSERT (SCM_NIMP (v) && (SCM_VECTORP (v) || SCM_TYP7 (v) == scm_tc7_dvect), - v, SCM_ARG1, s_random_solid_sphere_x); + v, SCM_ARG1, FUNC_NAME); if (SCM_UNBNDP (state)) state = SCM_CDR (scm_var_random_state); - SCM_ASSERT (SCM_NIMP (state) && SCM_RSTATEP (state), - state, - SCM_ARG2, - s_random_solid_sphere_x); + SCM_VALIDATE_RSTATE(2,state); scm_random_normal_vector_x (v, state); vector_scale (v, pow (scm_c_uniform01 (SCM_RSTATE (state)), @@ -485,40 +479,38 @@ scm_random_solid_sphere_x (SCM v, SCM state) / sqrt (vector_sum_squares (v))); return SCM_UNSPECIFIED; } +#undef FUNC_NAME -SCM_PROC (s_random_hollow_sphere_x, "random:hollow-sphere!", 1, 1, 0, scm_random_hollow_sphere_x); - -SCM -scm_random_hollow_sphere_x (SCM v, SCM state) +GUILE_PROC (scm_random_hollow_sphere_x, "random:hollow-sphere!", 1, 1, 0, + (SCM v, SCM state), + "") +#define FUNC_NAME s_scm_random_hollow_sphere_x { SCM_ASSERT (SCM_NIMP (v) && (SCM_VECTORP (v) || SCM_TYP7 (v) == scm_tc7_dvect), - v, SCM_ARG1, s_random_solid_sphere_x); + v, SCM_ARG1, FUNC_NAME); if (SCM_UNBNDP (state)) state = SCM_CDR (scm_var_random_state); - SCM_ASSERT (SCM_NIMP (state) && SCM_RSTATEP (state), - state, - SCM_ARG2, - s_random_hollow_sphere_x); + SCM_VALIDATE_RSTATE(2,state); scm_random_normal_vector_x (v, state); vector_scale (v, 1 / sqrt (vector_sum_squares (v))); return SCM_UNSPECIFIED; } -SCM_PROC (s_random_normal_vector_x, "random:normal-vector!", 1, 1, 0, scm_random_normal_vector_x); +#undef FUNC_NAME -SCM -scm_random_normal_vector_x (SCM v, SCM state) + +GUILE_PROC (scm_random_normal_vector_x, "random:normal-vector!", 1, 1, 0, + (SCM v, SCM state), +"") +#define FUNC_NAME s_scm_random_normal_vector_x { int n; SCM_ASSERT (SCM_NIMP (v) && (SCM_VECTORP (v) || SCM_TYP7 (v) == scm_tc7_dvect), - v, SCM_ARG1, s_random_solid_sphere_x); + v, SCM_ARG1, FUNC_NAME); if (SCM_UNBNDP (state)) state = SCM_CDR (scm_var_random_state); - SCM_ASSERT (SCM_NIMP (state) && SCM_RSTATEP (state), - state, - SCM_ARG2, - s_random_normal_vector_x); + SCM_VALIDATE_RSTATE(2,state); n = SCM_LENGTH (v); if (SCM_VECTORP (v)) while (--n >= 0) @@ -528,22 +520,21 @@ scm_random_normal_vector_x (SCM v, SCM state) ((double *) SCM_VELTS (v))[n] = scm_c_normal01 (SCM_RSTATE (state)); return SCM_UNSPECIFIED; } +#undef FUNC_NAME #endif /* HAVE_ARRAYS */ -SCM_PROC (s_random_exp, "random:exp", 0, 1, 0, scm_random_exp); - -SCM -scm_random_exp (SCM state) +GUILE_PROC (scm_random_exp, "random:exp", 0, 1, 0, + (SCM state), + "") +#define FUNC_NAME s_scm_random_exp { if (SCM_UNBNDP (state)) state = SCM_CDR (scm_var_random_state); - SCM_ASSERT (SCM_NIMP (state) && SCM_RSTATEP (state), - state, - SCM_ARG1, - s_random_exp); + SCM_VALIDATE_RSTATE(2,state); return scm_makdbl (scm_c_exp1 (SCM_RSTATE (state)), 0.0); } +#undef FUNC_NAME void scm_init_random () -- cgit v1.2.1