changeset 270:b74956a2196f

Add a propertiesOf method to the object module that returns the names of things that look like getter messages
author Michael Pavone <pavone@retrodev.com>
date Fri, 18 Jul 2014 20:45:50 -0700
parents 632667d95d35
children bb4723fec05e
files modules/object.tp modules/string.tp samples/reflect.tp
diffstat 3 files changed, 42 insertions(+), 5 deletions(-) [+]
line wrap: on
line diff
--- a/modules/object.tp	Fri Jul 18 19:31:07 2014 -0700
+++ b/modules/object.tp	Fri Jul 18 20:45:50 2014 -0700
@@ -48,7 +48,7 @@
 			while: {slot < 16} do: {
 				if: (methHash get: slot) {
 					i <- 0
-					while: { ((methHash get: slot) get: i) != 0xFFFFFFFF } do: {
+					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
@@ -98,6 +98,20 @@
 			}
 		}
 
+		propertiesOf <- :obj {
+			messages <- understoodBy: obj
+			setters <- dict hash
+			potentials <- #[]
+			foreach: messages :idx message {
+				if: (message endsWith?: "!") {
+					setters set: (message from: 0 withLength: (message length) - 1) true
+				} else: {
+					potentials append: message
+				}
+			}
+			potentials filter: :el { setters contains?: el }
+		}
+
 		sendMessage:to <- :message :obj {
 			d <- getMethodDict:
 			d ifget: message :messageId{
--- a/modules/string.tp	Fri Jul 18 19:31:07 2014 -0700
+++ b/modules/string.tp	Fri Jul 18 20:45:50 2014 -0700
@@ -304,6 +304,12 @@
 		from: start withLength: (end - start)
 	}
 
+	endsWith? <- :suffix {
+		if: (suffix length) <= length {
+			0 = (compareSub: suffix (length - (suffix length)) 0 (suffix length))
+		}
+	}
+
 	isInteger? <- { false }
 	isString? <- { true }
 	isBasicString? <- { true }
--- a/samples/reflect.tp	Fri Jul 18 19:31:07 2014 -0700
+++ b/samples/reflect.tp	Fri Jul 18 20:45:50 2014 -0700
@@ -1,11 +1,28 @@
 #{
 	main <- {
-		print: (string: (object does: 42 understand?: "+")) . "\n"
-		print: (string: (object does: 42 understand?: "foobar")) . "\n"
-		foreach: (object understoodBy: 42) :idx el{
+		o <- #{
+			foo <- 42
+			bar <- 39
+			doStuff <- :blah {
+				foo <- bar * blah
+				foo
+			}
+			qux <- { 1337 }
+			+ <- :right {
+				foo + right
+			}
+		}
+		print: (string: (object does: o understand?: "+")) . "\n"
+		print: (string: (object does: o understand?: "foobar")) . "\n"
+		print: (string: (object sendMessage: "qux" to: o)) . "\n"
+		print: "Messages understood:\n"
+		foreach: (object understoodBy: o) :idx el{
 			print: el . "\n"
 		}
-		print: (object sendMessage: "hex" to: 42) . "\n"
+		print: "\nProperties of:\n"
+		foreach: (object propertiesOf: o) :idx el{
+			print: el . "\n"
+		}
 		0
 	}
 }