[system] / trunk / pg / lib / Parser / Context.pm Repository:
ViewVC logotype

Annotation of /trunk/pg/lib/Parser/Context.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2647 - (view) (download) (as text)

1 : sh002i 2558 #
2 :     # add/remove/get reduction flags
3 : dpvc 2579 # make patterns into real patterns, not strings
4 : sh002i 2558 #
5 :    
6 :     #########################################################################
7 :    
8 :     package Parser::Context;
9 :     my $pkg = "Parser::Context";
10 :     use strict;
11 : dpvc 2579 use vars qw(@ISA);
12 :     @ISA = qw(Value::Context);
13 : sh002i 2558
14 :     #
15 : dpvc 2579 # Create a new Context object and initialize its data lists
16 : sh002i 2558 #
17 :     sub new {
18 :     my $self = shift; my $class = ref($self) || $self;
19 : dpvc 2579 my $context = $Value::defaultContext->copy();
20 :     bless $context, $class;
21 :     $context->{_initialized} = 0;
22 :     foreach my $list ('functions','variables','constants','operators','strings','parens') {
23 :     push(@{$context->{data}{hashes}},$list);
24 :     $context->{$list} = {};
25 :     }
26 :     my %data = (
27 :     functions => {},
28 :     variables => {},
29 :     constants => {},
30 :     operators => {},
31 :     strings => {},
32 :     parens => {},
33 :     lists => {},
34 :     flags => {},
35 :     @_
36 :     );
37 : sh002i 2558 $context->{_functions} = new Parser::Context::Functions($context,%{$data{functions}});
38 :     $context->{_variables} = new Parser::Context::Variables($context,%{$data{variables}});
39 :     $context->{_constants} = new Parser::Context::Constants($context,%{$data{constants}});
40 :     $context->{_operators} = new Parser::Context::Operators($context,%{$data{operators}});
41 :     $context->{_strings} = new Parser::Context::Strings($context,%{$data{strings}});
42 :     $context->{_parens} = new Parser::Context::Parens($context,%{$data{parens}});
43 : dpvc 2579 $context->lists->set(%{$data{lists}}) if defined($data{lists});
44 :     $context->flags->set(%{$data{flags}}) if defined($data{flags});
45 : sh002i 2558 $context->{_initialized} = 1;
46 :     $context->update;
47 :     return $context;
48 :     }
49 :    
50 :     #
51 :     # Update the token pattern
52 :     #
53 :     sub update {
54 :     my $self = shift; return unless $self->{_initialized};
55 :     $self->{pattern}{token} =
56 :     '(?:('.join(')|(',
57 :     $self->strings->{pattern},
58 :     $self->functions->{pattern},
59 :     $self->constants->{pattern},
60 :     $self->{pattern}{number},
61 :     $self->operators->{pattern},
62 :     $self->parens->{open},
63 :     $self->parens->{close},
64 :     $self->variables->{pattern},
65 :     ).'))';
66 :     }
67 :    
68 :     #
69 :     # Access to the data lists
70 :     #
71 :     sub operators {(shift)->{_operators}}
72 :     sub functions {(shift)->{_functions}}
73 :     sub constants {(shift)->{_constants}}
74 :     sub variables {(shift)->{_variables}}
75 :     sub strings {(shift)->{_strings}}
76 :     sub parens {(shift)->{_parens}}
77 :    
78 :    
79 :     #
80 : dpvc 2620 # Store pointer to user's context table
81 :     #
82 :     my $userContext;
83 :    
84 :     #
85 : sh002i 2558 # Set/Get the current Context object
86 :     #
87 :     sub current {
88 : dpvc 2647 my $self = shift; my $contextTable = shift; my $context = shift;
89 : dpvc 2620 if ($contextTable) {$userContext = $contextTable} else {$contextTable = $userContext}
90 : dpvc 2647 if (defined($context)) {
91 :     if (!ref($context)) {
92 :     my $name = $context;
93 :     $context = Parser::Context->get($contextTable,$context);
94 :     Value::Error("Unknown context '$name'") unless defined($context);
95 :     }
96 : dpvc 2619 $contextTable->{current} = $context;
97 :     $Value::context = \$contextTable->{current};
98 : dpvc 2620 } elsif (!defined($contextTable->{current})) {
99 :     $contextTable->{current} = $Parser::Context::Default::fullContext->copy;
100 :     $Value::context = \$contextTable->{current};
101 : sh002i 2558 }
102 : dpvc 2619 return $contextTable->{current};
103 : sh002i 2558 }
104 :    
105 :     #
106 :     # Get a named context
107 :     # (either from the main list or a copy from the default list)
108 :     #
109 :     sub get {
110 : dpvc 2619 my $self = shift; my $contextTable = shift; my $name = shift;
111 : sh002i 2558 my $context = $contextTable->{$name};
112 :     return $context if $context;
113 :     $context = $Parser::Context::Default::context{$name};
114 :     return unless $context;
115 :     return $context->copy;
116 :     }
117 :    
118 :     #
119 :     # Update the precedences of multiplication so that they
120 :     # are the standard or non-standard ones, depending on the
121 :     # argument. It should be 'Standard' or 'Non-Standard'.
122 :     #
123 :     sub usePrecedence {
124 :     my $self = shift;
125 :     for (shift) {
126 :    
127 :     /^Standard/i and do {
128 :     $self->operators->set(
129 :     ' *' => {precedence => 3},
130 :     '* ' => {precedence => 3},
131 :     ' /' => {precedence => 3},
132 :     '/ ' => {precedence => 3},
133 :     fn => {precedence => 3},
134 :     ' ' => {precedence => 3},
135 :     );
136 :     last;
137 :     };
138 :    
139 :     /^Non-Standard/i and do {
140 :     $self->operators->set(
141 :     ' *' => {precedence => 2.8},
142 :     '* ' => {precedence => 2.8},
143 :     ' /' => {precedence => 2.8},
144 :     '/ ' => {precedence => 2.8},
145 :     fn => {precedence => 2.9},
146 :     ' ' => {precedence => 3.1},
147 :     );
148 :     last;
149 :     };
150 :    
151 :     Value::Error("Precedence type should be one of 'Standard' or 'Non-standard'");
152 :     }
153 :     }
154 :    
155 :     #########################################################################
156 :     #
157 :     # Load the subclasses.
158 :     #
159 :    
160 : dpvc 2579 use Parser::Context::Constants;
161 :     use Parser::Context::Functions;
162 :     use Parser::Context::Operators;
163 :     use Parser::Context::Parens;
164 :     use Parser::Context::Strings;
165 :     use Parser::Context::Variables;
166 : sh002i 2558
167 :     #########################################################################
168 :    
169 :     1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9