view release on metacpan or  search on metacpan

lib/Math/Formula.pm  view on Meta::CPAN

# This code is part of Perl distribution Math-Formula version 0.18.
# The POD got stripped from this file by OODoc version 3.03.
# For contributors see file ChangeLog.

# This software is copyright (c) 2023-2025 by Mark Overmeer.

# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
# SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-1.0-or-later

#oodist: *** DO NOT USE THIS VERSION FOR PRODUCTION ***
#oodist: This file contains OODoc-style documentation which will get stripped
#oodist: during its release in the distribution.  You can use this file for
#oodist: testing, however the code of this development version may be broken!

package Math::Formula;{
our $VERSION = '0.18';
}


use warnings;
use strict;
use utf8;

use Log::Report 'math-formula';

use Math::Formula::Token ();
use Math::Formula::Type  ();

use Scalar::Util         qw/blessed/;

#--------------------

#--------------------

sub new(%)
{	my ($class, $name, $expr, %self) = @_;
	$self{_name} = $name;
	$self{_expr} = $expr;
	(bless {}, $class)->init(\%self);
}

sub init($)
{	my ($self, $args) = @_;
	my $name    = $self->{MSBE_name} = $args->{_name} or panic "every formular requires a name";
	my $expr    = $args->{_expr} or panic "every formular requires an expression";
	my $returns = $self->{MSBE_returns} = $args->{returns};

	if(ref $expr eq 'SCALAR')
	{	$expr = MF::STRING->new(undef, $$expr);
	}
	elsif(! ref $expr && $returns && $returns->isa('MF::STRING'))
	{	$expr = MF::STRING->new(undef, $expr);
	}

	$self->{MSBE_expr} = $expr;
	$self;
}

#--------------------

sub name()       { $_[0]->{MSBE_name} }
sub expression() { $_[0]->{MSBE_expr} }
sub returns()    { $_[0]->{MSBE_returns} }


sub tree($)
{	my ($self, $expression) = @_;
	$self->{MSBE_ast} ||= $self->_build_ast($self->_tokenize($expression), 0);
}

# For testing only: to load a new expression without the need to create
# a new object.
sub _test($$)
{	my ($self, $expr) = @_;
	$self->{MSBE_expr} = $expr;
	delete $self->{MSBE_ast};
}

###
### PARSER
###

my $match_int   = MF::INTEGER->_match;
my $match_float = MF::FLOAT->_match;
my $match_name  = MF::NAME->_match;
my $match_date  = MF::DATE->_match;
my $match_time  = MF::TIME->_match;
my $match_tz    = MF::TIMEZONE->_match;
my $match_dt    = MF::DATETIME->_match;
my $match_dur   = MF::DURATION->_match;

my $match_op    = join '|',
	qw{ // -> }, '[?*\/+\-#~.%]',
	qw{ =~ !~ <=> <= >= == != < > },  # order is important
	qw{ :(?![0-9][0-9]) (?<![0-9][0-9]): },
	( map "$_\\b", qw/ and or not xor exists like unlike cmp lt le eq ne ge gt/
	);

sub _tokenize($)
{	my ($self, $s) = @_;
	our @t = ();
	my $parens_open = 0;

	use re 'eval';  #XXX needed with newer than 5.16 perls?