Replaced Array::new with [ ]
[kakapo:kakapo.git] / src / Classes / BaseBehavior.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 Class::BaseBehavior;
5 #       Common methods for Class::*Based
6
7 our @No_args;
8
9 sub _pre_initload() {
10 # Special sub called when the Kakapo library is loaded or initialized. This is to guarantee 
11 # this module is available during :init and :load processing for other modules.
12
13         Global::use('Dumper');
14         
15         @No_args := [ ];
16
17         my $get_bool := '
18 .namespace [ "Class" ; "BaseBehavior" ]
19 .sub "__get_bool" :vtable("get_bool") :method
20         $I0 = self."get_bool"()
21         .return ($I0)
22 .end';
23
24         Pir::compile($get_bool);
25         
26         my $get_string := '
27 .namespace [ "Class" ; "BaseBehavior" ]
28 .sub "__get_string" :vtable("get_string") :method
29         $S0 = self."get_string"()
30         .return ($S0)
31 .end';
32         Pir::compile($get_string);
33         
34         Class::NEW_CLASS('Class::BaseBehavior');
35 }
36
37 method _ABSTRACT_METHOD() {
38         DIE("A subclass must override this abstract method.");
39 }
40
41 method _ATTR($name, @value)     { self._ABSTRACT_METHOD(); }
42
43 method _ATTR_ARRAY($name, @value) {
44         my $result := self._ATTR($name, @value);
45         
46         if ! Opcode::defined($result) {
47                 $result := self._ATTR($name,  [ [ ] ] );
48         }
49         
50         return $result;
51 }
52
53 method _ATTR_DEFAULT($name, @value, $default) {
54         my $result := self._ATTR($name, @value);
55         
56         if ! Opcode::defined($result) {
57                 $result := self._ATTR($name, [ $default ] );
58         }
59         
60         return $result;
61 }
62
63 method _ATTR_CONST($name, @value) {
64         if +@value && Opcode::defined(
65                 self._ATTR($name, @No_args)) {
66                 DIE("You cannot reset the value of the '", $name, "' attribute.");
67         }
68         
69         return self._ATTR($name, @value);
70 }
71
72 method _ATTR_HASH($name, @value) {
73         my $result := self._ATTR($name, @value);
74         
75         if ! Opcode::defined($result) {
76                 $result := self._ATTR($name,  [ Hash::empty() ] );
77         }
78         
79         return $result;
80 }
81
82 method _ATTR_SETBY($name, $method_name) {
83         my $result := self._ATTR($name, @No_args);
84         
85         if ! Opcode::defined($result) {
86                 Parrot::call_method(self, $method_name);
87                 $result := self._ATTR($name, @No_args);
88         }
89         
90         return $result;
91 }
92
93 method get_bool() {
94         return 1;
95 }
96
97 method get_string() {
98         return Class::name_of(self) ~ ' @' ~ Parrot::get_address_of(self);
99 }
100
101 method init(@children, %attributes) {
102         for %attributes {
103                 NOTE("Setting attribute: '", ~$_, "'");
104                 Parrot::call_method(self, ~$_, %attributes{$_});
105         }
106 }
107
108 method isa($type) {
109         return self.HOW.isa(self, $type);
110 }
111
112 method new(*@children, *%attributes) {
113         my $class := Opcode::getattribute(self.HOW, 'parrotclass');
114         my $new_object := Opcode::new($class);
115         
116         # NB: I'm not flattening the params, because that forces
117         # everybody to do call_method or in-line pir to pass
118         # along flat args.
119         $new_object.init(@children, %attributes);
120         return $new_object;
121 }