Catching up after the holidays.
[kakapo:kakapo.git] / src / Classes / P6object.nqp
1 # Copyright (C) 2009, Austin Hastings. See accompanying LICENSE file, or 
2 # http://www.opensource.org/licenses/artistic-license-2.0.php for license.
3
4 module P6object;
5 =begin
6
7 =head1 P6object - the root of the P6/NQP class hierarchy.
8
9 P6object is added automatically as the parent class of any class that is 
10 set up using the C< P6metaclass > C< .register > method. (By default: all 
11 classes.)
12
13 Thus, methods on this class correspond roughly to the C< UNIVERSAL >
14 methods from P5.
15
16 =item sub onload()  I<(standard)>
17
18 Sets up the C< P6protoobject >, C< P6object >, and 
19 C< P6metaclass > classes. Creates protoobjects for 
20 C< P6object > and C< P6metaclass >.
21
22 =item method __ABSTRACT__()
23
24 Sugar. Throws an AbstractMethodCalled exception.
25
26 =end
27
28 method __ABSTRACT__() {
29         Exception::AbstractMethodCalled.new().throw;
30         exit_code, message, severity, type
31 }
32
33 =begin
34
35 =item method HOW()  I<(standard)>
36
37 Returns the L<P6metaclass> of the invocant. 
38
39 =item PROTOOVERRIDES()  I<(standard)>
40
41 Returns a list of methods to be overridden in the I< protoobjects > for 
42 the class.  The methods defined (or imported) in the Foo::Bar namespace whose 
43 names are returned in the C< PROTOOVERRIDES > list will replace any standard
44 proto-object methods with the same name provided by the P6object library.
45
46 By default, the list returned consists solely of the method C< new >. Thus,
47 any C< new > method defined in the C< class > or C< module > block will
48 supersede the default C< new > method provided by the P6object library.
49
50 (Note that if you don't provide a replacement C< new > method, the default one 
51 gets used. Returning a name in the C< PROTOOVERRIDES > list I< allows >, but 
52 does not I< require > replacing a method.)
53
54 =item method WHAT()  I<(standard)>
55
56 Return the L<P6protoobject> for the invocant. The protoobject is the object 
57 the lives under the C<Foo::Bar> class name . Calling C< Foo::Bar.new() >actually
58 looks up the C< Foo::Bar > object (a protoobject) and runs it's C< .new > method.
59
60 =item method WHERE()  I<(standard)>
61
62 Returns the memory address of the invocant. (Useful for identity tests.)
63
64 =item method WHO()  I<(standard)>
65
66 Returns the package for the invocant. That is, the namespace where the 
67 proto-object lives. For example, objects of class C< Foo::Bar > have a 
68 protoobject C< Foo::Bar > (of type P6protoobject) that belongs to a 
69 I<namespace> (a different PMC type) also called C< Foo::Bar >.
70
71 =end
72
73 method defined() {
74 # returns true. (Overridden for the Undef PMC type.)
75         return 1;
76 }
77
78 method get_bool() {
79 # returns true.
80         return 1;
81 }
82
83 method get_string() {
84 # Returns a perl5-style object class+address.
85         return Class::name_of(self) ~ ' @' ~ self.WHERE;
86 }
87
88 method _init_(@pos, %named) {
89         # First, set up the default data
90         # ...
91         
92         # Accept args.
93         self._init_args_(@pos, %named);
94 }
95
96 method _init_args_(@pos, %named) {
97         self._init_named_(%named);
98         self._init_positional_(@pos);
99 }
100
101 method _init_named_(%named) {   
102         for %named {
103                 my $name := ~ $_;
104                 
105                 if Opcode::can(self, $name) {
106                         Parrot::call_method(self, $name, %named{$name});
107                 }
108                 else {
109                         Opcode::die("No accessor defined for attribute '", $name, "'.");
110                 }
111         }
112 }
113
114 method _init_positional_(@pos) {
115         if +@pos {
116                 Opcode::die("Don't know what to do with positional parameters. Define your own 'init_' method to handle them.");
117         }
118 }
119
120 method isa($type) {
121         return self.HOW.isa(self, $type);
122 }
123
124 method new(*@pos, *%named) {
125         my $class := Opcode::getattribute(self.HOW, 'parrotclass');
126         my $new_object := Opcode::new($class);
127
128         # NB: I'm not flattening the params, because that forces
129         # everybody to do call_method or in-line pir to pass
130         # along flat args.
131         $new_object._init_(@pos, %named);
132         return $new_object;
133 }
134
135 our @No_args;
136
137 sub _pre_initload() {
138 # Special sub called when the Kakapo library is loaded or initialized. This is to guarantee 
139 # this module is available during :init and :load processing for other modules.
140
141         @No_args := Array::empty();
142
143         Pir::compile_sub(:name('__get_bool'), :vtable('get_bool'),
144                 :namespace('Kakapo::Object'),
145                 :body(
146                         '$I0= self."get_bool"()',
147                         '.return ($I0)',
148                 ),
149         );
150         
151         Pir::compile_sub(:name('__get_string'), :vtable('get_string'),
152                 :namespace('Kakapo::Object'),
153                 :body(
154                         '$S0 = self."get_string"()',
155                         '.return ($S0)',
156                 ),
157         );
158 }