All COBJ operations have default implementations now;

no null pointer check over struct cobj_ops operations.

New typechecking function for COBJ objects.

7 files changed, 95 insertions, 43 deletions

diff --git a/ChangeLog b/ChangeLog
index dbc6d93a..edd347c5 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,37 @@
+2009-12-08  Kaz Kylheku  <kkylheku@gmail.com>
+
+	All COBJ operations have default implementations now;
+	no null pointer check over struct cobj_ops operations.
+
+	New typechecking function for COBJ objects.
+
+	* gc.c (finalize): Assume function pointer destroy
+	is not null.
+	(cobj_destroy_op): New function.
+	(mark_obj): Assume function pointer mark is not null.
+	(cobj_mark_op): New function.
+
+	* hash.c (ll_hash): Assume function pointer hash
+	is not null.
+	(cobj_hash_op): New function.
+	(hash_equal): Function removed.
+	(hash_ops): Replaced hash_equal with cobj_equal_op.
+
+	* lib.c (class_check, cobj_equal_op): New functions.
+
+	* lib.h (cobj_equal_op, cobj_destroy_op, cobj_mark_op,
+	cobj_hash_op): Declarations added.
+	(system_package, user_package, class_check): Declaration added.
+
+	* regex.c (regex_equal): Function removed.
+	(regex_obj_ops): regex_equal replaced with cobj_equal_op.
+
+	* stream.c (common_equal): Function removed.
+	(stdio_ops, pipe_ops, string_in_ops, byte_in_ops,
+	string_out_ops, dir_ops): common_equal replaced
+	with cobj_equal_op, and all previously null
+	function pointers populated with default functions.
+
 2009-12-05  Kaz Kylheku  <kkylheku@gmail.com>
 
 	More void * to mem_t * conversion.
diff --git a/gc.c b/gc.c
index 1a48ab2f..2a659e2b 100644
--- a/gc.c
+++ b/gc.c
@@ -196,14 +196,17 @@ static void finalize(val obj)
   case LSTR:
     return;
   case COBJ:
-    if (obj->co.ops->destroy)
-      obj->co.ops->destroy(obj);
+    obj->co.ops->destroy(obj);
     return;
   }
 
   assert (0 && "corrupt type field");
 }
 
+void cobj_destroy_op(val obj)
+{
+}
+
 static void mark_obj(val obj)
 {
   type_t t;
@@ -272,14 +275,17 @@ tail_call:
     mark_obj(obj->ls.opts);
     mark_obj_tail(obj->ls.list);
   case COBJ:
-    if (obj->co.ops->mark)
-      obj->co.ops->mark(obj);
+    obj->co.ops->mark(obj);
     mark_obj_tail(obj->co.cls);
   }
 
   assert (0 && "corrupt type field");
 }
 
+void cobj_mark_op(val obj)
+{
+}
+
 static int in_heap(val ptr)
 {
   heap_t *heap;
diff --git a/hash.c b/hash.c
index f0c0d8d0..82b1406f 100644
--- a/hash.c
+++ b/hash.c
@@ -115,22 +115,20 @@ static cnum ll_hash(val obj)
     lazy_str_force(obj);
     return ll_hash(obj->ls.prefix);
   case COBJ:
-    if (obj->co.ops->hash)
-      return obj->co.ops->hash(obj);
-    return ((cnum) obj) & NUM_MAX;
+    return obj->co.ops->hash(obj);
   }
 
   internal_error("unhandled case in equal function");
 }
 
-val hash_obj(val obj)
+cnum cobj_hash_op(val obj)
 {
-  return num(ll_hash(obj));
+  return ((cnum) obj) & NUM_MAX;
 }
 
-static val hash_equal(val self, val other)
+val hash_obj(val obj)
 {
-  return self == other ? t : nil;
+  return num(ll_hash(obj));
 }
 
 static void hash_destroy(val hash)
@@ -187,11 +185,11 @@ static void hash_mark(val hash)
 }
 
 static struct cobj_ops hash_ops = {
-  hash_equal,
+  cobj_equal_op,
   cobj_print_op,
   hash_destroy,
   hash_mark,
-  0
+  cobj_hash_op
 };
 
 static void hash_grow(struct hash *h)
diff --git a/lib.c b/lib.c
index 679cbdc0..b38212c5 100644
--- a/lib.c
+++ b/lib.c
@@ -156,6 +156,14 @@ val type_check3(val obj, int t1, int t2, int t3)
   return t;
 }
 
+val class_check(val cobj, val class_sym)
+{
+  type_check (cobj, COBJ);
+  type_assert (cobj->co.cls == class_sym, (lit("~a is not a cobj of class ~a"),
+                                           cobj, class_sym));
+  return t;
+}
+
 val car(val cons)
 {
   if (cons == nil)
@@ -524,6 +532,11 @@ val equal(val left, val right)
   internal_error("unhandled case in equal function");
 }
 
+val cobj_equal_op(val left, val right)
+{
+  return eq(left, right);
+}
+
 static val equal_tramp(val env, val left, val right)
 {
   (void) env;
diff --git a/lib.h b/lib.h
index 9d2dc255..c9ebd6c0 100644
--- a/lib.h
+++ b/lib.h
@@ -155,6 +155,13 @@ struct cobj_ops {
   cnum (*hash)(val self);
 };
 
+/* Default operations for above structure. */
+val cobj_equal_op(val, val);
+void cobj_print_op(val, val);
+void cobj_destroy_op(val);
+void cobj_mark_op(val);
+cnum cobj_hash_op(val);
+
 union obj {
   struct any t;
   struct cons c;
@@ -197,7 +204,7 @@ INLINE wchar_t *litptr(val obj)
 #define lit_noex(strlit) ((obj_t *) ((cnum) (L ## strlit) | TAG_LIT))
 #define lit(strlit) lit_noex(strlit)
 
-extern val keyword_package;
+extern val keyword_package, system_package, user_package;
 extern val null, t, cons_s, str_s, chr_s, num_s, sym_s, pkg_s, fun_s, vec_s;
 extern val stream_s, hash_s, lcons_s, lstr_s, cobj_s;
 extern val var_s, regex_s, set_s, cset_s, wild_s, oneplus_s;
@@ -231,6 +238,7 @@ val typeof(val obj);
 val type_check(val obj, int);
 val type_check2(val obj, int, int);
 val type_check3(val obj, int, int, int);
+val class_check(val cobj, val class_sym);
 val car(val cons);
 val cdr(val cons);
 val *car_l(val cons);
@@ -348,7 +356,6 @@ val length_str_ge(val str, val len);
 val length_str_lt(val str, val len);
 val length_str_le(val str, val len);
 val cobj(mem_t *handle, val cls_sym, struct cobj_ops *ops);
-void cobj_print_op(val, val); /* Default function for struct cobj_ops */
 val assoc(val list, val key);
 val acons_new(val list, val key, val value);
 val *acons_new_l(val *list, val key, val *new_p);
diff --git a/regex.c b/regex.c
index 3a406873..ec1e656c 100644
--- a/regex.c
+++ b/regex.c
@@ -1136,11 +1136,6 @@ nfam_result_t nfa_machine_feed(nfa_machine_t *nfam, wchar_t ch)
   return NFAM_INCOMPLETE;
 }
 
-static val regex_equal(val self, val other)
-{
-  return self == other ? t : nil; /* eq equality only */
-}
-
 static void regex_destroy(val regex)
 {
   nfa_t *pnfa = (nfa_t *) regex->co.handle;
@@ -1150,7 +1145,11 @@ static void regex_destroy(val regex)
 }
 
 static struct cobj_ops regex_obj_ops = {
-  regex_equal, cobj_print_op, regex_destroy, 0, 0
+  cobj_equal_op,
+  cobj_print_op,
+  regex_destroy,
+  cobj_mark_op,
+  cobj_hash_op
 };
 
 val regex_compile(val regex_sexp)
diff --git a/stream.c b/stream.c
index 1f133315..5f93209b 100644
--- a/stream.c
+++ b/stream.c
@@ -54,11 +54,6 @@ struct strm_ops {
   val (*close)(val, val);
 };
 
-static val common_equal(val self, val other)
-{
-  return self == other ? t : nil;
-}
-
 static void common_destroy(val obj)
 {
   (void) close_stream(obj, nil);
@@ -226,11 +221,11 @@ static val stdio_close(val stream, val throw_on_error)
 }
 
 static struct strm_ops stdio_ops = {
-  { common_equal,
+  { cobj_equal_op,
     stdio_stream_print,
     stdio_stream_destroy,
     stdio_stream_mark,
-    0 },
+    cobj_hash_op },
   stdio_put_string,
   stdio_put_char,
   stdio_get_line,
@@ -277,11 +272,11 @@ static val pipe_close(val stream, val throw_on_error)
 }
 
 static struct strm_ops pipe_ops = {
-  { common_equal,
+  { cobj_equal_op,
     stdio_stream_print,
     stdio_stream_destroy,
     stdio_stream_mark,
-    0 },
+    cobj_hash_op },
   stdio_put_string,
   stdio_put_char,
   stdio_get_line,
@@ -327,11 +322,11 @@ static val string_in_get_char(val stream)
 }
 
 static struct strm_ops string_in_ops = {
-  { common_equal,
+  { cobj_equal_op,
     cobj_print_op,
-    0,
+    cobj_destroy_op,
     string_in_stream_mark,
-    0 },
+    cobj_hash_op },
   0,
   0,
   string_in_get_line,
@@ -356,11 +351,11 @@ static val byte_in_get_byte(val stream)
 }
 
 static struct strm_ops byte_in_ops = {
-  { common_equal,
+  { cobj_equal_op,
     cobj_print_op,
-    0,
-    0,
-    0 },
+    cobj_destroy_op,
+    cobj_mark_op,
+    cobj_hash_op },
   0,
   0,
   0,
@@ -427,11 +422,11 @@ static val string_out_put_char(val stream, val ch)
 }
 
 static struct strm_ops string_out_ops = {
-  { common_equal,
+  { cobj_equal_op,
     cobj_print_op,
     string_out_stream_destroy,
-    0,
-    0 },
+    cobj_mark_op,
+    cobj_hash_op },
   string_out_put_string,
   string_out_put_char,
   0,
@@ -470,11 +465,11 @@ static val dir_close(val stream, val throw_on_error)
 }
 
 static struct strm_ops dir_ops = {
-  { common_equal,
+  { cobj_equal_op,
     cobj_print_op,
     common_destroy,
-    0,
-    0 },
+    cobj_mark_op,
+    cobj_hash_op },
   0,
   0,
   dir_get_line,