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