# HG changeset patch
# User Michael Pavone <pavone@retrodev.com>
# Date 1405666661 25200
# Node ID 75dc7161c1ca52c2018d8d0e8a9935fe36823879
# Parent  d6a4c9e7716e694c9f6be274d430460890518a6e
Added object module which provides some basic reflection capabilities

diff -r d6a4c9e7716e -r 75dc7161c1ca cbackend.js
--- a/cbackend.js	Mon Jul 14 19:03:46 2014 -0700
+++ b/cbackend.js	Thu Jul 17 23:57:41 2014 -0700
@@ -522,6 +522,8 @@
 cObject.prototype.toCDef = function() {
 	this.checkInitMsg();
 	var slotdefs = '';
+	var methlists = '';
+	var methdict = '}, {'
 	var metadef = 'obj_meta ' + this.name + '_meta = {sizeof(' + this.name +'), {';
 	for (var i = 0; i < 16; i++) {
 		if (i) {
@@ -552,13 +554,20 @@
 					'\t\t\treturn no_impl(method_id, num_params, (object *)self, args);\n\t}\n}\n';
 
 			}
+			methlists += 'uint32_t ' + this.name + '_methods_' + i + '[] = {'
+			for (j in this.slots[i]) {
+				methlists += this.slots[i][j][0] + ', ';
+			}
+			methlists += 'LAST_METHOD};';
 			metadef += this.name + '_slot_' + i;
+			methdict += (i ? ', ' : '') + this.name + '_methods_' + i;
 		} else {
 			metadef += 'no_impl';
+			methdict += (i ? ', ' : '') + 'NULL';
 		}
 	}
-	metadef += '}};\n';
-	return slotdefs + metadef;
+	metadef += methdict + '}};\n';
+	return slotdefs + methlists + metadef;
 }
 
 cObject.prototype.toCInstance = function() {
diff -r d6a4c9e7716e -r 75dc7161c1ca modules/object.tp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/modules/object.tp	Thu Jul 17 23:57:41 2014 -0700
@@ -0,0 +1,94 @@
+{
+	rt <- #{
+		llMessage: numMessages withVars: {
+			intret <- obj_int32 ptr
+		} andCode: {
+			intret <- make_object: (addr_of: obj_int32_meta) NULL 0
+			intret num!: (sizeof: methodNames) / (sizeof: (char ptr))
+			intret
+		}
+
+		llMessage: methodName withVars: {
+			methodId <- obj_int32 ptr
+			name <- string ptr
+			namelen <- int
+		} andCode: :methodId {
+			name <- make_object: (addr_of: string_meta) NULL 0
+			namelen <- strlen: (methodNames get: (methodId num))
+			name bytes!: namelen
+			name len!: namelen
+			name data!: (GC_MALLOC_ATOMIC: namelen + 1)
+			memcpy: (name data) (methodNames get: (methodId num)) namelen
+			name
+		}
+
+		llMessage: understands? withVars: {
+			obj <- object ptr
+			methodId <- obj_int32 ptr
+			ret <- object ptr
+		} andCode: :obj methodId {
+			if: (object_understands: obj (methodId num)) {
+				ret <- module_true
+			} else: {
+				ret <- module_false
+			}
+			ret
+		}
+
+		llMessage: addUnderstood withVars: {
+			obj <- object ptr
+			arr <- object ptr
+			methHash <- (uint32_t ptr) ptr
+			methodId <- obj_int32 ptr
+			slot <- int
+			i <- int
+		} andCode: :obj arr {
+			methHash <- (obj meta) methods
+			slot <- 0
+			while: {slot < 16} do: {
+				if: (methHash get: slot) {
+					i <- 0
+					while: { ((methHash get: slot) get: i) != 0xFFFFFFFF } do: {
+						methodId <- make_object: (addr_of: obj_int32_meta) NULL 0
+						methodId num!: ((methHash get: slot) get: i)
+						mcall: append 2 arr methodId
+
+						i <- i + 1
+					}
+				}
+
+				slot <- slot + 1
+			}
+			arr
+		}
+	}
+	getMethodDict <- {
+		methodDict <- dict hash
+		i <- 0
+		n <- rt numMessages
+		while: { i < n } do: {
+			name <- rt methodName: i
+			methodDict set: name i
+			i <- i + 1
+		}
+		getMethodDict <- {
+			methodDict
+		}
+		methodDict
+	}
+	#{
+		does:understand? <- :obj :message {
+			d <- getMethodDict:
+			d ifget: message :messageId{
+				rt understands?: obj messageId
+			} else: { false }
+		}
+
+		understoodBy <- :obj {
+			ids <- rt addUnderstood: obj #[]
+			ids map: :id {
+				rt methodName: id
+			}
+		}
+	}
+}
diff -r d6a4c9e7716e -r 75dc7161c1ca runtime/object.c
--- a/runtime/object.c	Mon Jul 14 19:03:46 2014 -0700
+++ b/runtime/object.c	Thu Jul 17 23:57:41 2014 -0700
@@ -10,7 +10,7 @@
 	object * newobj = GC_MALLOC(meta->size);
 	newobj->meta = meta;
 	newobj->parent = parent;
-	
+
 	va_start(args, num_props);
 	object ** curprop = ((object **)(newobj + 1));
 	for (; num_props > 0; num_props--)
@@ -30,3 +30,18 @@
 	va_end(args);
 	return ret;
 }
+
+int object_understands(object * obj, uint32_t method_id)
+{
+	uint32_t slot = method_id & 0xF;
+	uint32_t *cur;
+	if (!obj->meta->methods[slot]) {
+		return 0;
+	}
+	for (cur = obj->meta->methods[slot]; *cur != LAST_METHOD; cur++) {
+		if (*cur == method_id) {
+			return 1;
+		}
+	}
+	return 0;
+}
diff -r d6a4c9e7716e -r 75dc7161c1ca runtime/object.h
--- a/runtime/object.h	Mon Jul 14 19:03:46 2014 -0700
+++ b/runtime/object.h	Thu Jul 17 23:57:41 2014 -0700
@@ -4,6 +4,8 @@
 #include <stdint.h>
 #include <stdarg.h>
 
+#define LAST_METHOD 0xFFFFFFFF
+
 typedef struct obj_meta obj_meta;
 
 typedef struct object
@@ -27,6 +29,7 @@
 {
 	uint32_t size;
 	method   meth_lookup[16];
+	uint32_t *methods[16];
 };
 
 extern obj_meta lambda_meta;
@@ -38,5 +41,6 @@
 object * make_lambda(void * env, closure_func func);
 object * make_array(uint32_t num_els, ...);
 object * make_list(uint32_t num_els, ...);
+int object_understands(object * obj, uint32_t method_id);
 
 #endif //OBJECT_H_
diff -r d6a4c9e7716e -r 75dc7161c1ca samples/reflect.tp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/samples/reflect.tp	Thu Jul 17 23:57:41 2014 -0700
@@ -0,0 +1,10 @@
+#{
+	main <- {
+		print: (string: (object does: 42 understand?: "+")) . "\n"
+		print: (string: (object does: 42 understand?: "foobar")) . "\n"
+		foreach: (object understoodBy: 42) :idx el{
+			print: el . "\n"
+		}
+		0
+	}
+}