Mercurial > repos > tabletprog
annotate modules/object.tp @ 323:eb5f1fca9b78
Fix infinite loop in foldr:with
author | Michael Pavone <pavone@retrodev.com> |
---|---|
date | Mon, 23 Mar 2015 21:18:26 -0700 |
parents | b74956a2196f |
children | ead24192ed45 |
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 } |
266
75dc7161c1ca
Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff
changeset
|
71 } |
75dc7161c1ca
Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff
changeset
|
72 getMethodDict <- { |
75dc7161c1ca
Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff
changeset
|
73 methodDict <- dict hash |
75dc7161c1ca
Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff
changeset
|
74 i <- 0 |
75dc7161c1ca
Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff
changeset
|
75 n <- rt numMessages |
75dc7161c1ca
Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff
changeset
|
76 while: { i < n } do: { |
75dc7161c1ca
Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff
changeset
|
77 name <- rt methodName: i |
75dc7161c1ca
Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff
changeset
|
78 methodDict set: name i |
75dc7161c1ca
Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff
changeset
|
79 i <- i + 1 |
75dc7161c1ca
Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff
changeset
|
80 } |
75dc7161c1ca
Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff
changeset
|
81 getMethodDict <- { |
75dc7161c1ca
Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff
changeset
|
82 methodDict |
75dc7161c1ca
Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff
changeset
|
83 } |
75dc7161c1ca
Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff
changeset
|
84 methodDict |
75dc7161c1ca
Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff
changeset
|
85 } |
75dc7161c1ca
Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff
changeset
|
86 #{ |
75dc7161c1ca
Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff
changeset
|
87 does:understand? <- :obj :message { |
75dc7161c1ca
Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff
changeset
|
88 d <- getMethodDict: |
75dc7161c1ca
Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff
changeset
|
89 d ifget: message :messageId{ |
75dc7161c1ca
Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff
changeset
|
90 rt understands?: obj messageId |
75dc7161c1ca
Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff
changeset
|
91 } else: { false } |
75dc7161c1ca
Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff
changeset
|
92 } |
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 understoodBy <- :obj { |
75dc7161c1ca
Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff
changeset
|
95 ids <- rt addUnderstood: obj #[] |
75dc7161c1ca
Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff
changeset
|
96 ids map: :id { |
75dc7161c1ca
Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff
changeset
|
97 rt methodName: id |
75dc7161c1ca
Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff
changeset
|
98 } |
75dc7161c1ca
Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff
changeset
|
99 } |
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
|
100 |
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
|
101 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
|
102 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
|
103 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
|
104 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
|
105 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
|
106 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
|
107 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
|
108 } 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
|
109 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
|
110 } |
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 } |
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 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
|
113 } |
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 |
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
|
115 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
|
116 d <- getMethodDict: |
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
|
117 d ifget: message :messageId{ |
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
|
118 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
|
119 } 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
|
120 } |
266
75dc7161c1ca
Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff
changeset
|
121 } |
75dc7161c1ca
Added object module which provides some basic reflection capabilities
Michael Pavone <pavone@retrodev.com>
parents:
diff
changeset
|
122 } |