view release on metacpan or  search on metacpan

inc/symbolics.pl  view on Meta::CPAN

#!/usr/bin/env perl
# PODNAME: symbolics.pl
# ABSTRACT: Extract operators and generate XS for dispatching to operators

use FindBin;
use lib "$FindBin::Bin/../lib";

use Modern::Perl;
use File::Spec;
use Alien::Kiwisolver;
use List::UtilsBy qw(nsort_by);

my $namespace = "Intertangle::API::Kiwisolver";

my @types = (
	"double",
	"const Constraint&",
	"const Expression&",
	"const Term&",
	"const Variable&",
);
my %type_order = map { $types[$_] => $_ } 0..@types-1;

my %ops_cpp_to_perl = (
	'2-'  => { cpp => '-',  overload => '-',   name => '_op_minus'   },
	'2+'  => { cpp => '+',  overload => '+',   name => '_op_add'     },
	'2*'  => { cpp => '*',  overload => '*',   name => '_op_mult'    },
	'2/'  => { cpp => '/',  overload => '/',   name => '_op_div'     },
	'2>=' => { cpp => '>=', overload => '>=',  name => '_op_num_ge'  },
	'2==' => { cpp => '==', overload => '==',  name => '_op_num_eq'  },
	'2<=' => { cpp => '<=', overload => '<=',  name => '_op_num_le'  },
	'1-' =>  { cpp => '-',  overload => 'neg', name => '_op_neg'     },
	'2|' =>  { cpp => '|',  overload => '|',   name => '_op_or'      },
);

sub type_to_kiwi_CPP {
	my ($type) = @_;
	return $type if($type eq 'double');
	$type =~ s/(?:const )?(\w+)(?:\&)?/kiwi::$1/r;
}

sub type_to_Perl_NS {
	my ($type) = @_;
	return $type if($type eq 'double');
	$type =~ s/const (\w+)&/${namespace}::$1/r;
};

sub read_symbolic_h {
	my $symbolics_h = File::Spec->catfile(
		Alien::Kiwisolver->new->dist_dir,
		qw(include kiwi symbolics.h)
	);
	open(my $symbolics_fh, '<', $symbolics_h);

	my $operator_func = qr,
		(?<ReturnType> \w+)
		\s+
		operator
		(?<Operator> [-|*/+<>=]+)
		\(
			\s*
			(?<ParamsString> [^)]* )
			\s*
		\)
	,x;
	my $param = qr, (?<Type> ([\w\s*&]+)+ ) \s+ (?<Name> \w+),x;

	my @operators;