diff modules/object.tp @ 266:75dc7161c1ca

Added object module which provides some basic reflection capabilities
author Michael Pavone <pavone@retrodev.com>
date Thu, 17 Jul 2014 23:57:41 -0700
parents
children 123e9468d55e
line wrap: on
line diff
--- /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
+			}
+		}
+	}
+}