view modules/object.tp @ 338:1458c069c715

Added "value" method to option value and option none. It behaves similarly to value:none, except the none case just propagates the none value and the value case wraps the result in an option value
author Michael Pavone <pavone@retrodev.com>
date Sat, 04 Apr 2015 11:54:46 -0700
parents ead24192ed45
children
line wrap: on
line source

{
	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
		}

		llMessage: sendMessage:to withVars: {
			obj <- object ptr
			methodId <- obj_int32 ptr
		} andCode: :methodId :obj {
			mcall: (methodId num) 1 obj
		}
		
		llMessage: setProperty:on:to withVars: {
			obj <- object ptr
			methodId <- obj_int32 ptr
			val <- object ptr
		} andCode: :methodId :obj :val {
			mcall: (methodId num) 1 obj val
		}
	}
	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
			}
		}

		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 {
				rt sendMessage: messageId to: obj
			} else: { false }
		}
		
		setProperty:on:to <- :message :obj :val {
			d <- getMethodDict:
			d ifget: (message. "!") :messageId {
				rt setProperty: messageId on: obj to: val
			} else: { false }
		}
	}
}