line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Decl::Semantics::Use;
|
2
|
|
|
|
|
|
|
|
3
|
12
|
|
|
12
|
|
80
|
use warnings;
|
|
12
|
|
|
|
|
26
|
|
|
12
|
|
|
|
|
515
|
|
4
|
12
|
|
|
12
|
|
74
|
use strict;
|
|
12
|
|
|
|
|
29
|
|
|
12
|
|
|
|
|
493
|
|
5
|
|
|
|
|
|
|
|
6
|
12
|
|
|
12
|
|
73
|
use base qw(Decl::Node);
|
|
12
|
|
|
|
|
26
|
|
|
12
|
|
|
|
|
5512
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
=head1 NAME
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
Decl::Semantics::Use - imports a module.
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
=head1 VERSION
|
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
Version 0.01
|
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
=cut
|
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
our $VERSION = '0.01';
|
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
=head1 SYNOPSIS
|
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
In its simplest form, a "use" tag looks exactly like Perl's native "use" statement:
|
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
use Word::Declarative;
|
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
The semicolon on the end is optional, and is there because you're going to type it no matter what I say, and there's no reason the tag shouldn't
|
28
|
|
|
|
|
|
|
understand perfectly well what you mean.
|
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
The reason we need this at all is that if we import a semantic domain in filter mode, but still need a second semantic domain, then without
|
31
|
|
|
|
|
|
|
a "use" tag we'd have no way to import the second domain. Similarly, if we define an extension of, say, "dpl" to invoke a declarative Perl
|
32
|
|
|
|
|
|
|
script in Windows, then we're in filter mode right from the get-go, and also need a declarative module import option.
|
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
But the tag can be used for more than that - just not yet. It's the logical place to set up how to handle non-declarative modules as well.
|
35
|
|
|
|
|
|
|
I can see two ways that could be useful: first is that modules imported this way would also be imported for all the code snippets in the tree, and
|
36
|
|
|
|
|
|
|
second might be specifying a tag structure for some object-oriented but not declarative module. If it's simple, you could probably specify
|
37
|
|
|
|
|
|
|
everything you need in a declarative structure and bypass the hassle of writing your own semantic domain module.
|
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
I could see the "use" tag as being able to override parsers, set up tag aliases if there are collisions, and so on. It's the logical place
|
40
|
|
|
|
|
|
|
to put all this stuff.
|
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
=head2 defines(), tags_defined()
|
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
Called by Decl::Semantics during import, to find out what xmlapi tags this plugin claims to implement.
|
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
=cut
|
47
|
0
|
|
|
0
|
1
|
0
|
sub defines { ('use'); }
|
48
|
12
|
|
|
12
|
1
|
96
|
sub tags_defined { Decl->new_data(<
|
49
|
|
|
|
|
|
|
use (body=vanilla)
|
50
|
|
|
|
|
|
|
EOF
|
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
=head2 post_build()
|
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
After the tag is built, we'll do our work - this has to happen during the build phase because it affects the semantics of the rest of our tags.
|
55
|
|
|
|
|
|
|
And in fact it's worse than that: by the time this C |
56
|
|
|
|
|
|
|
we have to scan the siblings of the C |
57
|
|
|
|
|
|
|
parser logic to a less logical approach.
|
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
=cut
|
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
sub post_build {
|
62
|
0
|
|
|
0
|
1
|
|
my ($self) = @_;
|
63
|
|
|
|
|
|
|
|
64
|
0
|
|
|
|
|
|
my $module = $self->name;
|
65
|
0
|
|
|
|
|
|
$module =~ s/;$//;
|
66
|
0
|
|
|
|
|
|
eval "use $module;";
|
67
|
0
|
0
|
|
|
|
|
if ($@) {
|
68
|
0
|
|
|
|
|
|
warn $@;
|
69
|
|
|
|
|
|
|
} else {
|
70
|
0
|
|
|
|
|
|
push @Decl::semantic_classes, $module;
|
71
|
0
|
|
|
|
|
|
my $root = $self->root;
|
72
|
0
|
|
|
|
|
|
$root->initiate_semantic_class($module);
|
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
# Scan our siblings
|
75
|
0
|
|
|
|
|
|
my $on = 0;
|
76
|
0
|
|
|
|
|
|
my $index = -1;
|
77
|
0
|
|
|
|
|
|
my @p = $self->{parent}->nodes;
|
78
|
0
|
|
|
|
|
|
foreach my $sib ($self->{parent}->nodes) {
|
79
|
0
|
|
|
|
|
|
$index += 1;
|
80
|
0
|
0
|
|
|
|
|
unless ($on) {
|
81
|
0
|
0
|
|
|
|
|
$on = 1 if $sib == $self;
|
82
|
0
|
|
|
|
|
|
next;
|
83
|
|
|
|
|
|
|
}
|
84
|
0
|
|
|
|
|
|
my $newnode = $root->remakenode($sib);
|
85
|
0
|
|
|
|
|
|
$self->{parent}->replace_node ($sib, $newnode);
|
86
|
|
|
|
|
|
|
}
|
87
|
0
|
|
|
|
|
|
@p = $self->{parent}->nodes;
|
88
|
|
|
|
|
|
|
}
|
89
|
|
|
|
|
|
|
}
|
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
=head1 AUTHOR
|
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
Michael Roberts, C<< >>
|
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
=head1 BUGS
|
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
Please report any bugs or feature requests to C, or through
|
98
|
|
|
|
|
|
|
the web interface at L. I will be notified, and then you'll
|
99
|
|
|
|
|
|
|
automatically be notified of progress on your bug as I make changes.
|
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT
|
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
Copyright 2010 Michael Roberts.
|
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it
|
106
|
|
|
|
|
|
|
under the terms of either: the GNU General Public License as published
|
107
|
|
|
|
|
|
|
by the Free Software Foundation; or the Artistic License.
|
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
See http://dev.perl.org/licenses/ for more information.
|
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
=cut
|
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
1; # End of Decl::Semantics::Use
|