1: # The LearningOnline Network with CAPA - LON-CAPA
2: # Operator definitions
3: #
4: # $Id: Definitions.pm,v 1.2 2023/03/13 22:31:22 raeburn Exp $
5: #
6: # Copyright (C) 2014 Michigan State University Board of Trustees
7: #
8: # This program is free software: you can redistribute it and/or modify
9: # it under the terms of the GNU General Public License as published by
10: # the Free Software Foundation, either version 3 of the License, or
11: # (at your option) any later version.
12: #
13: # This program is distributed in the hope that it will be useful,
14: # but WITHOUT ANY WARRANTY; without even the implied warranty of
15: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16: # GNU General Public License for more details.
17: #
18: # You should have received a copy of the GNU General Public License
19: # along with this program. If not, see <http://www.gnu.org/licenses/>.
20: #
21:
22: ##
23: # Operator definitions (see function define() at the end).
24: ##
25: package Apache::math_parser::Definitions;
26:
27: use strict;
28: use warnings;
29: use utf8;
30:
31: use JSON::DWIW;
32: use File::Slurp;
33:
34: use aliased 'Apache::math_parser::ENode';
35: use aliased 'Apache::math_parser::Operator';
36: use aliased 'Apache::math_parser::ParseException';
37: use aliased 'Apache::math_parser::Parser';
38: use aliased 'Apache::math_parser::Token';
39:
40: use constant ARG_SEPARATOR => ","; # ";" would be more international
41: use constant DECIMAL_SIGN_1 => ".";
42: use constant DECIMAL_SIGN_2 => "."; # with "," here
43: use constant INTERVAL_SEPARATOR => ":";
44:
45: use vars qw(%perlvar);
46:
47:
48: ##
49: # Constructor
50: ##
51: sub new {
52: my $class = shift;
53: my $self = {
54: _operators => [], # Array of Operator
55: };
56: bless $self, $class;
57: return $self;
58: }
59:
60: # Attribute helpers
61:
62: ##
63: # The operators.
64: # @returns {Operator[]}
65: ##
66: sub operators {
67: my $self = shift;
68: return $self->{_operators};
69: }
70:
71:
72: ##
73: # Creates a new operator.
74: # @param {string} id - Operator id (text used to recognize it)
75: # @param {integer} arity - Operator->UNARY, BINARY or TERNARY
76: # @param {integer} lbp - Left binding power
77: # @param {integer} rbp - Right binding power
78: # @param {function} nud - Null denotation function. Parameters: Operator, Parser. Returns: ENode.
79: # @param {function} led - Left denotation function. Parameters: Operator, Parser, ENode. Returns: ENode.
80: ##
81: sub operator {
82: my( $self, $id, $arity, $lbp, $rbp, $nud, $led ) = @_;
83: push(@{$self->{_operators}}, Operator->new($id, $arity, $lbp, $rbp, $nud, $led));
84: }
85:
86: ##
87: # Creates a new separator operator.
88: # @param {string} id - Operator id (text used to recognize it)
89: ##
90: sub separator {
91: my( $self, $id ) = @_;
92: $self->operator($id, Operator->BINARY, 0, 0);
93: }
94:
95: ##
96: # Creates a new infix operator.
97: # @param {string} id - Operator id (text used to recognize it)
98: # @param {integer} lbp - Left binding power
99: # @param {integer} rbp - Right binding power
100: # @optional {function} led - Left denotation function
101: ##
102: sub infix {
103: my( $self, $id, $lbp, $rbp, $led ) = @_;
104: my $arity = Operator->BINARY;
105: my $nud = undef;
106: if (!defined $led) {
107: $led = sub {
108: my( $op, $p, $left ) = @_;
109: my @children = ($left, $p->expression($rbp));
110: return ENode->new(ENode->OPERATOR, $op, $id, \@children);
111: }
112: }
113: $self->operator($id, $arity, $lbp, $rbp, $nud, $led);
114: }
115:
116: ##
117: # Creates a new prefix operator.
118: # @param {string} id - Operator id (text used to recognize it)
119: # @param {integer} rbp - Right binding power
120: # @optional {function} nud - Null denotation function
121: ##
122: sub prefix {
123: my( $self, $id, $rbp, $nud ) = @_;
124: my $arity = Operator->UNARY;
125: my $lbp = 0;
126: if (!defined $nud) {
127: $nud = sub {
128: my( $op, $p ) = @_;
129: my @children = ($p->expression($rbp));
130: return ENode->new(ENode->OPERATOR, $op, $id, \@children);
131: }
132: }
133: my $led = undef;
134: $self->operator($id, $arity, $lbp, $rbp, $nud, $led);
135: }
136:
137: ##
138: # Creates a new suffix operator.
139: # @param {string} id - Operator id (text used to recognize it)
140: # @param {integer} lbp - Left binding power
141: # @optional {function} led - Left denotation function
142: ##
143: sub suffix {
144: my( $self, $id, $lbp, $led ) = @_;
145: my $arity = Operator->UNARY;
146: my $rbp = 0;
147: my $nud = undef;
148: if (!defined $led) {
149: $led = sub {
150: my( $op, $p, $left ) = @_;
151: my @children = ($left);
152: return ENode->new(ENode->OPERATOR, $op, $id, \@children);
153: }
154: }
155: $self->operator($id, $arity, $lbp, $rbp, $nud, $led);
156: }
157:
158: ##
159: # Returns the defined operator with the given id
160: # @param {string} id - Operator id (text used to recognize it)
161: # @returns {Operator}
162: ##
163: sub findOperator {
164: my( $self, $id ) = @_;
165: for (my $i=0; $i<scalar(@{$self->operators}); $i++) {
166: if (@{$self->operators}[$i]->id eq $id) {
167: return(@{$self->operators}[$i]);
168: }
169: }
170: return undef;
171: }
172:
173: ##
174: # Led function for the ` (units) operator
175: # @param {Operator} op
176: # @param {Parser} p
177: # @param {ENode} left
178: # @returns {ENode}
179: ##
180: sub unitsLed {
181: my( $op, $p, $left ) = @_;
182: # this led for units gathers all the units in an ENode
183: my $right = $p->expression(125);
184: while (defined $p->current_token && index("*/", $p->current_token->value) != -1) {
185: my $token2 = $p->tokens->[$p->token_nr];
186: if (!defined $token2) {
187: last;
188: }
189: if ($token2->type != Token->NAME && $token2->value ne "(") {
190: last;
191: }
192: my $token3 = $p->tokens->[$p->token_nr + 1];
193: if (defined $token3 && ($token3->value eq "(" || $token3->type == Token->NUMBER)) {
194: last;
195: }
196: # a check for constant names here is not needed because constant names are replaced in the tokenizer
197: my $t = $p->current_token;
198: $p->advance();
199: $right = $t->op->led->($t->op, $p, $right);
200: }
201: my @children = ($left, $right);
202: return ENode->new(ENode->OPERATOR, $op, $op->id, \@children);
203: }
204:
205: ##
206: # nud function for the ( operator (used to parse mathematical sub-expressions and intervals)
207: # @param {Operator} op
208: # @param {Parser} p
209: # @returns {ENode}
210: ##
211: sub parenthesisNud {
212: my( $op, $p ) = @_;
213: my $e = $p->expression(0);
214: if (defined $p->current_token && defined $p->current_token->op &&
215: $p->current_token->op->id eq INTERVAL_SEPARATOR) {
216: return buildInterval(0, $e, $op, $p);
217: }
218: $p->advance(")");
219: return $e;
220: }
221:
222: ##
223: # Led function for the ( operator (used to parse function calls)
224: # @param {Operator} op
225: # @param {Parser} p
226: # @param {ENode} left
227: # @returns {ENode}
228: ##
229: sub parenthesisLed {
230: my( $op, $p, $left ) = @_;
231: if ($left->type != ENode->NAME && $left->type != ENode->SUBSCRIPT) {
232: die ParseException->new("Function name expected before a parenthesis.", $p->tokens->[$p->token_nr - 1]->from);
233: }
234: my @children = ($left);
235: if ((!defined $p->current_token) || (!defined $p->current_token->op) || ($p->current_token->op->id ne ")")) {
236: while (1) {
237: push(@children, $p->expression(0));
238: if (!defined $p->current_token || !defined $p->current_token->op || $p->current_token->op->id ne ARG_SEPARATOR) {
239: last;
240: }
241: $p->advance(ARG_SEPARATOR);
242: }
243: }
244: $p->advance(")");
245: return ENode->new(ENode->FUNCTION, $op, $op->id, \@children);
246: }
247:
248: ##
249: # nud function for the [ operator (used to parse vectors and intervals)
250: # @param {Operator} op
251: # @param {Parser} p
252: # @returns {ENode}
253: ##
254: sub squareBracketNud {
255: my( $op, $p ) = @_;
256: my @children = ();
257: if (!defined $p->current_token || !defined $p->current_token->op || $p->current_token->op->id ne "]") {
258: my $e = $p->expression(0);
259: if (defined $p->current_token && defined $p->current_token->op &&
260: $p->current_token->op->id eq INTERVAL_SEPARATOR) {
261: return buildInterval(1, $e, $op, $p);
262: }
263: while (1) {
264: push(@children, $e);
265: if (!defined $p->current_token || !defined $p->current_token->op || $p->current_token->op->id ne ARG_SEPARATOR) {
266: last;
267: }
268: $p->advance(ARG_SEPARATOR);
269: $e = $p->expression(0);
270: }
271: }
272: $p->advance("]");
273: return ENode->new(ENode->VECTOR, $op, undef, \@children);
274: }
275:
276: ##
277: # Led function for the [ operator (used to parse subscript)
278: # @param {Operator} op
279: # @param {Parser} p
280: # @param {ENode} left
281: # @returns {ENode}
282: ##
283: sub subscriptLed {
284: my( $op, $p, $left ) = @_;
285: if ($left->type != ENode->NAME && $left->type != ENode->SUBSCRIPT) {
286: die ParseException->new("Name expected before a square bracket.", $p->tokens->[$p->token_nr - 1]->from);
287: }
288: my @children = ($left);
289: if (!defined $p->current_token || !defined $p->current_token->op || $p->current_token->op->id != "]") {
290: while (1) {
291: push(@children, $p->expression(0));
292: if (!defined $p->current_token || !defined $p->current_token->op || $p->current_token->op->id ne ARG_SEPARATOR) {
293: last;
294: }
295: $p->advance(ARG_SEPARATOR);
296: }
297: }
298: $p->advance("]");
299: return ENode->new(ENode->SUBSCRIPT, $op, "[", \@children);
300: }
301:
302: ##
303: # Returns the ENode for the interval, parsing starting just before the interval separator
304: # @param {boolean} closed - was the first operator closed ?
305: # @param {ENode} e1 - First argument (already parsed)
306: # @param {Operator} op - The operator
307: # @param {Parser} p - The parser
308: # @returns {ENode}
309: ##
310: sub buildInterval {
311: my ($closed, $e1, $op, $p) = @_;
312: $p->advance(INTERVAL_SEPARATOR);
313: my $e2 = $p->expression(0);
314: if (!defined $p->current_token || !defined $p->current_token->op ||
315: ($p->current_token->op->id ne ")" && $p->current_token->op->id ne "]")) {
316: die ParseException->new("Wrong interval syntax.", $p->tokens->[$p->token_nr - 1]->from);
317: }
318: my $interval_type;
319: if ($p->current_token->op->id eq ")") {
320: $p->advance(")");
321: if ($closed) {
322: $interval_type = ENode->CLOSED_OPEN;
323: } else {
324: $interval_type = ENode->OPEN_OPEN;
325: }
326: } else {
327: $p->advance("]");
328: if ($closed) {
329: $interval_type = ENode->CLOSED_CLOSED;
330: } else {
331: $interval_type = ENode->OPEN_CLOSED;
332: }
333: }
334: return ENode->new(ENode->INTERVAL, $op, undef, [$e1, $e2], $interval_type);
335: }
336:
337: ##
338: # nud function for the { operator (used to parse sets)
339: # @param {Operator} op
340: # @param {Parser} p
341: # @returns {ENode}
342: ##
343: sub curlyBracketNud {
344: my( $op, $p ) = @_;
345: my @children = ();
346: if (!defined $p->current_token || !defined $p->current_token->op || $p->current_token->op->id ne "}") {
347: while (1) {
348: push(@children, $p->expression(0));
349: if (!defined $p->current_token || !defined $p->current_token->op || $p->current_token->op->id ne ARG_SEPARATOR) {
350: last;
351: }
352: $p->advance(ARG_SEPARATOR);
353: }
354: }
355: $p->advance("}");
356: return ENode->new(ENode->SET, $op, undef, \@children);
357: }
358:
359: ##
360: # Defines all the operators.
361: ##
362: sub define {
363: my( $self ) = @_;
364: $self->suffix("!", 160);
365: $self->infix("^", 140, 139);
366: $self->infix(".", 130, 129);
367: $self->infix("`", 125, 125, \&unitsLed);
368: $self->infix("*", 120, 120);
369: $self->infix("/", 120, 120);
370: $self->infix("%", 120, 120);
371: $self->infix("+", 100, 100);
372: $self->operator("-", Operator->BINARY, 100, 134, sub {
373: my( $op, $p ) = @_;
374: my @children = ($p->expression($op->rbp));
375: return ENode->new(ENode->OPERATOR, $op, $op->id, \@children);
376: }, sub {
377: my( $op, $p, $left ) = @_;
378: my @children = ($left, $p->expression(100));
379: return ENode->new(ENode->OPERATOR, $op, $op->id, \@children);
380: });
381: $self->infix("=", 80, 80);
382: $self->infix("#", 80, 80);
383: $self->infix("<=", 80, 80);
384: $self->infix(">=", 80, 80);
385: $self->infix("<", 80, 80);
386: $self->infix(">", 80, 80);
387:
388: $self->separator(")");
389: $self->separator(ARG_SEPARATOR);
390: $self->separator(INTERVAL_SEPARATOR);
391: $self->operator("(", Operator->BINARY, 200, 200, \&parenthesisNud, \&parenthesisLed);
392:
393: $self->separator("]");
394: $self->operator("[", Operator->BINARY, 200, 70, \&squareBracketNud, \&subscriptLed);
395:
396: $self->separator("}");
397: $self->prefix("{", 200, \&curlyBracketNud);
398: }
399:
400:
401: 1;
402: __END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to Definitions.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / homework / math_parser