uicache/theos/bin/lib/Logos/Generator/Base/Function.pm

package Logos::Generator::Base::Function;
use strict;
use Logos::Generator;
use Logos::Util;

sub originalFunctionName {
	my $self = shift;
	my $function = shift;
	return Logos::sigil("orig").$function->group->name."\$".$function->name;
}

sub newFunctionName {
	my $self = shift;
	my $function = shift;
	return Logos::sigil("function").$function->group->name."\$".$function->name;
}

sub originalFunctionCall {
	my $self = shift;
	my $function = shift;
	my $args = shift;

	my $return = $self->originalFunctionName($function)."(";
	if (!$args) {
		$args = [];
		for(@{$function->args}) {
			push(@$args, $self->getArgumentName($_));
		}
		$return .= join(", ", @$args);
	} else {
		$return .= $args;
	}
	$return .= ")";

	return $return;
}

sub declaration {
	my $self = shift;
	my $function = shift;
	my $return = "";
	$return .= "_disused static ".$function->retval." (*".$self->originalFunctionName($function).")(".join(", ", @{$function->args})."); ";
	$return .= "static ".$function->retval." ".$self->newFunctionName($function)."(".join(", ", @{$function->args}).")";
	return $return;
}

sub initializers {
	::fileError(-1, "Base::Function does not implement initializers");
}

##########
# extras #
##########

sub getArgumentName {
	my $self = shift;
	my $arg = shift;

	# Split the argument string by spaces
	my $argArray = $self->notSoSmartSplit($arg, " ");
	# Try to get the name of the last element of the array if it is a function pointer
	my $return = $self->escapeFunctionPointer(@$argArray[-1]);
	# Separate the name from trailing vector size
	$return =~ s/\[/ \[/g;
	# Trimm spaces or asterisks from the start
	while (substr($return, 0, 1) eq " " || substr($return, 0, 1) eq "*") {
		$return = substr($return, 1, length($return));
	}
	# Split the resulting string by spaces
	$argArray = $self->notSoSmartSplit($return, " ");
	# Get the first element
	my $return = @$argArray[0];

	return $return;
}

sub escapeFunctionPointer {
	my $self = shift;
	my $arg = shift;
	if($arg !~ /\(\s*[*^]/) {
		return $arg;
	}
	my $substring = $arg;
	my ($opening, $closing) = matchedParenthesisSet($substring, 0);
	my $offset = 0;
	while(1) {
		# We want to put the parameter name right before the closing ) in the deepest nested set if we found a (^ or (*.
		$substring = substr($substring, $opening, $closing - $opening - 1);
		$offset += $opening;
		my ($newopening, $newclosing) = matchedParenthesisSet($substring, 0);
		last if !defined $newopening;
		$opening = $newopening;
		$closing = $newclosing;
	}
	return substr($arg, $offset, $closing-$opening-1);
}

#for a lack of Logos::Util::matchedDelimiterSet()
sub notSoSmartSplit {
	my $self = shift;
	my $argumentString = shift;
	my $delimiter = shift;

	# Default to commas
	if (!$delimiter) {
		$delimiter = ",";
	}
	$argumentString .= $delimiter; #uber hax

# curved  brackets or parens ()
	my $parensLevel = 0;
# squared brackets or crotchets []
	my $crotchetsLevel = 0;
# curly   brackets or braces {}
	my $bracesLevel = 0;
# angled  brackets or chevrons <>
	my $chevronsLevel = 0;

	my $token = "";
	my $pc = "";

	my $args = [];

	foreach my $c (split //, $argumentString) {
		if ($c eq $delimiter) {
			# If at root level, end token, push to array and start again
			if ($parensLevel == 0 && $crotchetsLevel == 0 && $bracesLevel == 0 && $chevronsLevel == 0) {
				push(@$args, $token);
				$pc = $c;
				$token = "";
				next;
			}
		}

		if ($c eq "(") {
			$parensLevel++;
		}
		if ($c eq ")") {
			$parensLevel--;
		}

		if ($c eq "[") {
			$crotchetsLevel++;
		}
		if ($c eq "]") {
			$crotchetsLevel--;
		}

		if ($c eq "{") {
			$bracesLevel++;
		}
		if ($c eq "}") {
			$bracesLevel--;
		}

		if ($c eq "<") {
			$chevronsLevel++;
		}
		if ($c eq ">") {
			$chevronsLevel--;
		}

		#skip redundant empty spaces
		if (($pc eq $delimiter && $c eq " ") || ($pc eq " " && $c eq " ")) {
			next;
		}

		# Concatenate char to token
		$token .= $c;
		#save previous char
		$pc = $c;
	} # foreach

	return $args;
}

1;