/
BUILDPLAN.pm
84 lines (77 loc) · 2.85 KB
/
BUILDPLAN.pm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
role Perl6::Metamodel::BUILDPLAN {
has @!BUILDALLPLAN;
has @!BUILDPLAN;
# Creates the plan for building up the object. This works
# out what we'll need to do up front, so we can just zip
# through the "todo list" each time we need to make an object.
# The plan is an array of arrays. The first element of each
# nested array is an "op" representing the task to perform:
# 0 code = call specified BUILD method
# 1 class name attr_name = try to find initialization value
# 2 class attr_name code = call default value closure if needed
method create_BUILDPLAN($obj) {
# First, we'll create the build plan for just this class.
my @plan;
my @attrs := $obj.HOW.attributes($obj, :local(1));
# Does it have its own BUILD?
my $build := $obj.HOW.find_method($obj, 'BUILD', :no_fallback(1));
if !nqp::isnull($build) && $build {
# We'll call the custom one.
my $entry := [0, $build];
@all_plan[+@all_plan] := $entry;
if $i == 0 {
@plan[+@plan] := $entry;
}
}
else {
# No custom BUILD. Rather than having an actual BUILD
# in Mu, we produce ops here per attribute that may
# need initializing.
for @attrs {
if $_.has_accessor {
my $attr_name := $_.name;
my $name := nqp::substr($attr_name, 2);
my $entry := [1, $obj, $name, $attr_name];
@all_plan[+@all_plan] := $entry;
if $i == 0 {
@plan[+@plan] := $entry;
}
}
}
}
# Check if there's any default values to put in place.
for @attrs {
if nqp::can($_, 'build') {
my $default := $_.build;
if !nqp::isnull($default) && $default {
my $entry := [2, $obj, $_.name, $default];
@all_plan[+@all_plan] := $entry;
if $i == 0 {
@plan[+@plan] := $entry;
}
}
}
}
# Install plan for this class.
@!BUILDPLAN := @plan;
# Now create the full plan by getting the MRO, and working from
# least derived to most derived, copying the plans.
my @all_plan;
my @mro := self.mro($obj);
my $i := +@mro;
while $i > 0 {
$i := $i - 1;
my $class := @mro[$i];
for $class.HOW.BUILDPLAN($class) {
nqp::push(@all_plan, $_);
}
}
@!BUILDALLPLAN := @all_plan;
}
method BUILDPLAN($obj) {
@!BUILDPLAN
}
method BUILDALLPLAN($obj) {
@!BUILDALLPLAN
}
}