implemented several missing gh_ functions, mostly related to lists and pairs

NEWS

@@ -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,

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

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);

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);
+}

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)));
+}

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));