view release on metacpan or  search on metacpan

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

		return $forms->{$name} = Math::Formula->new($name, @_)
			if blessed $next && $next->isa('Math::Formula::Type');

		my ($data, %attrs) = @_==1 && ref $next eq 'ARRAY' ? @$next : $next;
		if(my $r = $attrs{returns})
		{	my $typed = $r->isa('MF::STRING') ? $r->new(undef, $data) : $data;
			return $forms->{$name} = Math::Formula->new($name, $typed, %attrs);
		}

		if(length(my $leader = $self->lead_expressions))
		{	my $typed  = $data =~ s/^\Q$leader// ? $data : \$data;
			return $forms->{$name} = Math::Formula->new($name, $typed, %attrs);
		}

		return $forms->{$name} = Math::Formula->new($name, $data, %attrs);
	}

	error __x"formula declaration '{name}' not understood", name => $name;
}


sub formula($) { $_[0]->{MFC_forms}{$_[1]} }


sub addFragment($;$)
{	my $self = shift;
	my ($name, $fragment) = @_==2 ? @_ : ($_[0]->name, $_[0]);
	$self->{MFC_frags}{$name} = MF::FRAGMENT->new($name, $fragment);
}


sub fragment($) { $_[0]->{MFC_frags}{$_[1]} }

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

sub evaluate($$%)
{	my ($self, $name) = (shift, shift);

	# Wow, I am impressed!  Caused by prefix(#,.) -> infix
	length $name or return $self;

	my $form = $name =~ /^ctx_/ ? $self->attribute($name) : $self->formula($name);
	unless($form)
	{	warning __x"no formula '{name}' in {context}", name => $name, context => $self->name;
		return undef;
	}

	my $claims = $self->{MFC_claims};
	! $claims->{$name}++
		or error __x"recursion in expression '{name}' at {context}", name => $name, context => $self->name;

	my $result = $form->evaluate($self, @_);

	delete $claims->{$name};
	$result;
}


sub run($%)
{	my ($self, $expr, %args) = @_;
	my $name  = delete $args{name} || join '#', (caller)[1,2];
	my $result = Math::Formula->new($name, $expr)->evaluate($self, %args);

	while($result && $result->isa('MF::NAME'))
	{	$result = $self->evaluate($result->token, %args);
	}

	$result;
}


sub value($@)
{	my $self = shift;
	my $result = $self->run(@_);
	$result ? $result->value : undef;
}


sub setCaptures($) { $_[0]{MFC_capts} = $_[1] }
sub _captures() { $_[0]{MFC_capts} }


sub capture($) { $_[0]->_captures->[$_[1]] }

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

1;