Mercurial > repos > tabletprog

annotate modules/object.tp @ 338:1458c069c715

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
266
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
1 {
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
2 rt <- #{
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
3 llMessage: numMessages withVars: {
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
4 intret <- obj_int32 ptr
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
5 } andCode: {
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
6 intret <- make_object: (addr_of: obj_int32_meta) NULL 0
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
7 intret num!: (sizeof: methodNames) / (sizeof: (char ptr))
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
8 intret
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
9 }
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
10
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
11 llMessage: methodName withVars: {
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
12 methodId <- obj_int32 ptr
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
13 name <- string ptr
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
14 namelen <- int
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
15 } andCode: :methodId {
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
16 name <- make_object: (addr_of: string_meta) NULL 0
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
17 namelen <- strlen: (methodNames get: (methodId num))
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
18 name bytes!: namelen
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
19 name len!: namelen
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
20 name data!: (GC_MALLOC_ATOMIC: namelen + 1)
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
21 memcpy: (name data) (methodNames get: (methodId num)) namelen
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
22 name
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
23 }
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
24
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
25 llMessage: understands? withVars: {
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
26 obj <- object ptr
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
27 methodId <- obj_int32 ptr
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
28 ret <- object ptr
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
29 } andCode: :obj methodId {
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
30 if: (object_understands: obj (methodId num)) {
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
31 ret <- module_true
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
32 } else: {
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
33 ret <- module_false
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
34 }
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
35 ret
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
36 }
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
37
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
38 llMessage: addUnderstood withVars: {
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
39 obj <- object ptr
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
40 arr <- object ptr
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
41 methHash <- (uint32_t ptr) ptr
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
42 methodId <- obj_int32 ptr
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
43 slot <- int
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
44 i <- int
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
45 } andCode: :obj arr {
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
46 methHash <- (obj meta) methods
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
47 slot <- 0
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
48 while: {slot < 16} do: {
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
49 if: (methHash get: slot) {
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
50 i <- 0
270
b74956a2196f Add a propertiesOf method to the object module that returns the names of things that look like getter messages
Michael Pavone <pavone@retrodev.com>
parents: 268
diff changeset
51 while: { ((methHash get: slot) get: i)!= 0xFFFFFFFF } do: {
266
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
52 methodId <- make_object: (addr_of: obj_int32_meta) NULL 0
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
53 methodId num!: ((methHash get: slot) get: i)
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
54 mcall: append 2 arr methodId
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
55
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
56 i <- i + 1
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
57 }
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
58 }
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
59
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
60 slot <- slot + 1
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
61 }
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
62 arr
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
63 }
268
123e9468d55e Add support for invoking methods that take no arguments other than self through the relfection API
Michael Pavone <pavone@retrodev.com>
parents: 266
diff changeset
64
123e9468d55e Add support for invoking methods that take no arguments other than self through the relfection API
Michael Pavone <pavone@retrodev.com>
parents: 266
diff changeset
65 llMessage: sendMessage:to withVars: {
123e9468d55e Add support for invoking methods that take no arguments other than self through the relfection API
Michael Pavone <pavone@retrodev.com>
parents: 266
diff changeset
66 obj <- object ptr
123e9468d55e Add support for invoking methods that take no arguments other than self through the relfection API
Michael Pavone <pavone@retrodev.com>
parents: 266
diff changeset
67 methodId <- obj_int32 ptr
123e9468d55e Add support for invoking methods that take no arguments other than self through the relfection API
Michael Pavone <pavone@retrodev.com>
parents: 266
diff changeset
68 } andCode: :methodId :obj {
123e9468d55e Add support for invoking methods that take no arguments other than self through the relfection API
Michael Pavone <pavone@retrodev.com>
parents: 266
diff changeset
69 mcall: (methodId num) 1 obj
123e9468d55e Add support for invoking methods that take no arguments other than self through the relfection API
Michael Pavone <pavone@retrodev.com>
parents: 266
diff changeset
70 }
332
ead24192ed45 Initial work on a UI module
Michael Pavone <pavone@retrodev.com>
parents: 270
diff changeset
71
ead24192ed45 Initial work on a UI module
Michael Pavone <pavone@retrodev.com>
parents: 270
diff changeset
72 llMessage: setProperty:on:to withVars: {
ead24192ed45 Initial work on a UI module
Michael Pavone <pavone@retrodev.com>
parents: 270
diff changeset
73 obj <- object ptr
ead24192ed45 Initial work on a UI module
Michael Pavone <pavone@retrodev.com>
parents: 270
diff changeset
74 methodId <- obj_int32 ptr
ead24192ed45 Initial work on a UI module
Michael Pavone <pavone@retrodev.com>
parents: 270
diff changeset
75 val <- object ptr
ead24192ed45 Initial work on a UI module
Michael Pavone <pavone@retrodev.com>
parents: 270
diff changeset
76 } andCode: :methodId :obj :val {
ead24192ed45 Initial work on a UI module
Michael Pavone <pavone@retrodev.com>
parents: 270
diff changeset
77 mcall: (methodId num) 1 obj val
ead24192ed45 Initial work on a UI module
Michael Pavone <pavone@retrodev.com>
parents: 270
diff changeset
78 }
266
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
79 }
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
80 getMethodDict <- {
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
81 methodDict <- dict hash
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
82 i <- 0
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
83 n <- rt numMessages
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
84 while: { i < n } do: {
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
85 name <- rt methodName: i
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
86 methodDict set: name i
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
87 i <- i + 1
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
88 }
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
89 getMethodDict <- {
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
90 methodDict
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
91 }
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
92 methodDict
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
93 }
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
94 #{
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
95 does:understand? <- :obj :message {
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
96 d <- getMethodDict:
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
97 d ifget: message :messageId{
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
98 rt understands?: obj messageId
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
99 } else: { false }
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
100 }
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
101
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
102 understoodBy <- :obj {
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
103 ids <- rt addUnderstood: obj #[]
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
104 ids map: :id {
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
105 rt methodName: id
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
106 }
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
107 }
268
123e9468d55e Add support for invoking methods that take no arguments other than self through the relfection API
Michael Pavone <pavone@retrodev.com>
parents: 266
diff changeset
108
270
b74956a2196f Add a propertiesOf method to the object module that returns the names of things that look like getter messages
Michael Pavone <pavone@retrodev.com>
parents: 268
diff changeset
109 propertiesOf <- :obj {
b74956a2196f Add a propertiesOf method to the object module that returns the names of things that look like getter messages
Michael Pavone <pavone@retrodev.com>
parents: 268
diff changeset
110 messages <- understoodBy: obj
b74956a2196f Add a propertiesOf method to the object module that returns the names of things that look like getter messages
Michael Pavone <pavone@retrodev.com>
parents: 268
diff changeset
111 setters <- dict hash
b74956a2196f Add a propertiesOf method to the object module that returns the names of things that look like getter messages
Michael Pavone <pavone@retrodev.com>
parents: 268
diff changeset
112 potentials <- #[]
b74956a2196f Add a propertiesOf method to the object module that returns the names of things that look like getter messages
Michael Pavone <pavone@retrodev.com>
parents: 268
diff changeset
113 foreach: messages :idx message {
b74956a2196f Add a propertiesOf method to the object module that returns the names of things that look like getter messages
Michael Pavone <pavone@retrodev.com>
parents: 268
diff changeset
114 if: (message endsWith?: "!") {
b74956a2196f Add a propertiesOf method to the object module that returns the names of things that look like getter messages
Michael Pavone <pavone@retrodev.com>
parents: 268
diff changeset
115 setters set: (message from: 0 withLength: (message length) - 1) true
b74956a2196f Add a propertiesOf method to the object module that returns the names of things that look like getter messages
Michael Pavone <pavone@retrodev.com>
parents: 268
diff changeset
116 } else: {
b74956a2196f Add a propertiesOf method to the object module that returns the names of things that look like getter messages
Michael Pavone <pavone@retrodev.com>
parents: 268
diff changeset
117 potentials append: message
b74956a2196f Add a propertiesOf method to the object module that returns the names of things that look like getter messages
Michael Pavone <pavone@retrodev.com>
parents: 268
diff changeset
118 }
b74956a2196f Add a propertiesOf method to the object module that returns the names of things that look like getter messages
Michael Pavone <pavone@retrodev.com>
parents: 268
diff changeset
119 }
b74956a2196f Add a propertiesOf method to the object module that returns the names of things that look like getter messages
Michael Pavone <pavone@retrodev.com>
parents: 268
diff changeset
120 potentials filter: :el { setters contains?: el }
b74956a2196f Add a propertiesOf method to the object module that returns the names of things that look like getter messages
Michael Pavone <pavone@retrodev.com>
parents: 268
diff changeset
121 }
b74956a2196f Add a propertiesOf method to the object module that returns the names of things that look like getter messages
Michael Pavone <pavone@retrodev.com>
parents: 268
diff changeset
122
268
123e9468d55e Add support for invoking methods that take no arguments other than self through the relfection API
Michael Pavone <pavone@retrodev.com>
parents: 266
diff changeset
123 sendMessage:to <- :message :obj {
123e9468d55e Add support for invoking methods that take no arguments other than self through the relfection API
Michael Pavone <pavone@retrodev.com>
parents: 266
diff changeset
124 d <- getMethodDict:
332
ead24192ed45 Initial work on a UI module
Michael Pavone <pavone@retrodev.com>
parents: 270
diff changeset
125 d ifget: message :messageId {
268
123e9468d55e Add support for invoking methods that take no arguments other than self through the relfection API
Michael Pavone <pavone@retrodev.com>
parents: 266
diff changeset
126 rt sendMessage: messageId to: obj
123e9468d55e Add support for invoking methods that take no arguments other than self through the relfection API
Michael Pavone <pavone@retrodev.com>
parents: 266
diff changeset
127 } else: { false }
123e9468d55e Add support for invoking methods that take no arguments other than self through the relfection API
Michael Pavone <pavone@retrodev.com>
parents: 266
diff changeset
128 }
332
ead24192ed45 Initial work on a UI module
Michael Pavone <pavone@retrodev.com>
parents: 270
diff changeset
129
ead24192ed45 Initial work on a UI module
Michael Pavone <pavone@retrodev.com>
parents: 270
diff changeset
130 setProperty:on:to <- :message :obj :val {
ead24192ed45 Initial work on a UI module
Michael Pavone <pavone@retrodev.com>
parents: 270
diff changeset
131 d <- getMethodDict:
ead24192ed45 Initial work on a UI module
Michael Pavone <pavone@retrodev.com>
parents: 270
diff changeset
132 d ifget: (message. "!") :messageId {
ead24192ed45 Initial work on a UI module
Michael Pavone <pavone@retrodev.com>
parents: 270
diff changeset
133 rt setProperty: messageId on: obj to: val
ead24192ed45 Initial work on a UI module
Michael Pavone <pavone@retrodev.com>
parents: 270
diff changeset
134 } else: { false }
ead24192ed45 Initial work on a UI module
Michael Pavone <pavone@retrodev.com>
parents: 270
diff changeset
135 }
266
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
136 }
75dc7161c1ca Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
137 }