diff options
| -rw-r--r-- | NEWS | 5 | ||||
| -rw-r--r-- | libguile/ChangeLog | 24 | ||||
| -rw-r--r-- | libguile/gh.h | 21 | ||||
| -rw-r--r-- | libguile/gh_list.c | 51 | ||||
| -rw-r--r-- | libguile/gh_predicates.c | 16 | ||||
| -rw-r--r-- | libguile/gh_test_c.c | 23 |
6 files changed, 135 insertions, 5 deletions
@@ -302,6 +302,11 @@ exists and behaves like (make-vector ...). gh_vref() and gh_vset() have been renamed gh_vector_set() and gh_vector_ref(). Some missing vector-related gh_ functions have been implemented. +** pair and list routines + +Implemented several of the R4RS pair and list functions that were +missing. + * Changes to the scm_ interface ** Function: SCM scm_internal_stack_catch (SCM tag, diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 2ba8001c6..8963c7b11 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,27 @@ +1997-10-19 Mark Galassi <rosalia@cygnus.com> + + * gh.h (gh_reverse): + (gh_list_tail): + (gh_list_ref): + (gh_memq): + (gh_memv): + (gh_member): + (gh_assq): + (gh_assv): + (gh_assoc): added these gh_ functions implemented as macros. + + * gh_predicates.c (gh_null_p): + (gh_string_equal_p): added these two missing predicates. + + * gh_list.c (gh_append): + (gh_append2): + (gh_append3): + (gh_append4): + (gh_set_car_x): + (gh_set_cdr_x): added these routines as I go through and try to + complete the picture R4RS functions that should be mirrored in the + gh_ interface. + Sat Oct 18 01:52:51 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se> * tags.h (scm_tc7_substring): Changed the comment and code to diff --git a/libguile/gh.h b/libguile/gh.h index f3c4ea968..bc7dc0195 100644 --- a/libguile/gh.h +++ b/libguile/gh.h @@ -139,9 +139,13 @@ int gh_exact_p(SCM val); int gh_eq_p(SCM x, SCM y); int gh_eqv_p(SCM x, SCM y); int gh_equal_p(SCM x, SCM y); +int gh_string_equal_p(SCM s1, SCM s2); +int gh_null_p(SCM l); /* standard Scheme procedures available from C */ +#define gh_not(x) scm_not(x) + SCM gh_define(char *name, SCM val); /* vector manipulation routines */ @@ -165,6 +169,19 @@ SCM gh_module_lookup (SCM vector, char *sname); SCM gh_cons(SCM x, SCM y); #define gh_list scm_listify unsigned long gh_length(SCM l); +SCM gh_append(SCM args); +SCM gh_append2(SCM l1, SCM l2); +SCM gh_append3(SCM l1, SCM l2, SCM l3); +SCM gh_append4(SCM l1, SCM l2, SCM l3, SCM l4); +#define gh_reverse(ls) scm_reverse(ls) +#define gh_list_tail(ls, k) scm_list_tail(ls, k) +#define gh_list_ref(ls, k) scm_list_ref(ls, k) +#define gh_memq(x, ls) scm_memq(x, ls) +#define gh_memv(x, ls) scm_memqv(x, ls) +#define gh_member(x, ls) scm_memqber(x, ls) +#define gh_assq(x, alist) scm_assq(x, alist) +#define gh_assv(x, alist) scm_assv(x, alist) +#define gh_assoc(x, alist) scm_assoc(x, alist) SCM gh_car(SCM x); SCM gh_cdr(SCM x); @@ -183,6 +200,10 @@ SCM gh_cdadr(SCM x); SCM gh_cddar(SCM x); SCM gh_cdddr(SCM x); +SCM gh_set_car_x(SCM pair, SCM value); +SCM gh_set_cdr_x(SCM pair, SCM value); + + /* Calling Scheme functions from C. */ SCM gh_apply (SCM proc, SCM ls); SCM gh_call0 (SCM proc); diff --git a/libguile/gh_list.c b/libguile/gh_list.c index bc1c7f4aa..044176d41 100644 --- a/libguile/gh_list.c +++ b/libguile/gh_list.c @@ -55,6 +55,41 @@ gh_length (SCM l) /* list operations */ +/* gh_list(SCM elt, ...) is implemented as a macro in gh.h. */ + +/* gh_append() takes a args, which is a list of lists, and appends + them all together into a single list, which is returned. This is + equivalent to the Scheme procedure (append list1 list2 ...) */ +SCM gh_append(SCM args) +{ + return scm_append(args); +} + +SCM gh_append2(SCM l1, SCM l2) +{ + return scm_append(scm_listify(l1, l2, SCM_UNDEFINED)); +} + +SCM gh_append3(SCM l1, SCM l2, SCM l3) +{ + return scm_append(scm_listify(l1, l2, l3, SCM_UNDEFINED)); +} + +SCM gh_append4(SCM l1, SCM l2, SCM l3, SCM l4) +{ + return scm_append(scm_listify(l1, l2, l3, l4, SCM_UNDEFINED)); +} + +/* gh_reverse() is defined as a macro in gh.h */ +/* gh_list_tail() is defined as a macro in gh.h */ +/* gh_list_ref() is defined as a macro in gh.h */ +/* gh_memq() is defined as a macro in gh.h */ +/* gh_memv() is defined as a macro in gh.h */ +/* gh_member() is defined as a macro in gh.h */ +/* gh_assq() is defined as a macro in gh.h */ +/* gh_assv() is defined as a macro in gh.h */ +/* gh_assoc() is defined as a macro in gh.h */ + /* analogous to the Scheme cons operator */ SCM gh_cons (SCM x, SCM y) @@ -62,8 +97,6 @@ gh_cons (SCM x, SCM y) return scm_cons (x, y); } -/* gh_list(SCM elt, ...) is implemented as a macro in gh.h. */ - /* analogous to the Scheme car operator */ SCM gh_car (SCM x) @@ -140,3 +173,17 @@ gh_cdddr (SCM x) { return SCM_CDDDR (x); } + +/* equivalent to (set-car! pair value) */ +SCM +gh_set_car_x(SCM pair, SCM value) +{ + return scm_set_car_x(pair, value); +} + +/* equivalent to (set-cdr! pair value) */ +SCM +gh_set_cdr_x(SCM pair, SCM value) +{ + return scm_set_cdr_x(pair, value); +} diff --git a/libguile/gh_predicates.c b/libguile/gh_predicates.c index cb41ebaeb..6d06fdb62 100644 --- a/libguile/gh_predicates.c +++ b/libguile/gh_predicates.c @@ -119,3 +119,19 @@ gh_equal_p (SCM x, SCM y) { return (SCM_NFALSEP (scm_equal_p (x, y))); } + +/* equivalent to (string=? ...), but returns 0 or 1 rather than Scheme + booleans */ +int +gh_string_equal_p(SCM s1, SCM s2) +{ + return (SCM_NFALSEP (scm_string_equal_p(s1, s2))); +} + +/* equivalent to (null? ...), but returns 0 or 1 rather than Scheme + booleans */ +int +gh_null_p(SCM l) +{ + return (SCM_NFALSEP(scm_null_p(l))); +} diff --git a/libguile/gh_test_c.c b/libguile/gh_test_c.c index 43ae1cf5d..1dc136dc5 100644 --- a/libguile/gh_test_c.c +++ b/libguile/gh_test_c.c @@ -75,7 +75,12 @@ main_prog (int argc, char *argv[]) sym_string = gh_symbol2newstr (sym, NULL); printf ("the symbol was <%s>; after converting to Scheme and back to\n", "a-test-symbol"); - printf ("a C string it is now <%s>\n", sym_string); + printf (" a C string it is now <%s>", sym_string); + if (strcmp("a-test-symbol", sym_string) == 0) { + printf("...PASS\n"); + } else { + printf("...FAIL\n"); + } free (sym_string); } @@ -97,12 +102,24 @@ main_prog (int argc, char *argv[]) gh_eval_str_with_standard_handler ("(display \"dude!\n\")"); - /* in this next line I have a wilful typo: dosplay is not a defined + /* in this next test I have a wilful typo: dosplay is not a defined procedure, so it should throw an error */ + printf("We should now get an error which should be trapped by a handler\n"); gh_eval_str_with_standard_handler ("(dosplay \"dude!\n\")"); + printf("now we will display a backtrace of that error; this should not\n"); + printf(" work because the handler did not save the stack\n"); + gh_eval_str("(backtrace)"); + + /* now do that test with a stack saving handler */ + printf("Redo last test with stack-saving handler\n"); + gh_eval_str_with_stack_saving_handler ("(dosplay \"dude!\n\")"); + printf("now we will display a backtrace of that error; this should work:\n"); + gh_eval_str("(backtrace)"); /* now define some new primitives in C */ cf = gh_new_procedure1_0 ("c-factorial", c_factorial); + gh_display (cf); + gh_newline (); gh_new_procedure1_0 ("c-sin", c_sin); gh_new_procedure1_0 ("c-vector-test", c_vector_test); @@ -211,7 +228,7 @@ c_vector_test (SCM s_length) unsigned long c_length; c_length = gh_scm2ulong (s_length); - printf ("VECTOR test -- requested length for vector: %ld", c_length); + printf ("VECTOR test (length for vector %ld)", c_length); /* create a vector filled witth 0.0 entries */ xvec = gh_make_vector (s_length, gh_double2scm (0.0)); |