view release on metacpan or  search on metacpan

maint/process-capi.pl  view on Meta::CPAN

#!/usr/bin/env perl
# PODNAME: gen-capi-docs
# ABSTRACT: Generates POD for C API docs

use strict;
use warnings;

use FindBin;
use lib "$FindBin::Bin/../lib";
use Sub::Uplevel; # place early to override caller()

package TF::CAPI::Extract {
	use Mu;
	use CLI::Osprey;
	use AI::TensorFlow::Libtensorflow::Lib;

	use feature qw(say postderef);
	use Syntax::Construct qw(heredoc-indent);
	use Function::Parameters;

	use Path::Tiny;
	use Types::Path::Tiny qw/Path/;
	use File::Find::Rule;

	use Sort::Key::Multi qw(iikeysort);
	use List::Util qw(uniq first);
	use List::SomeUtils qw(firstidx part);

	use Module::Runtime qw(module_notional_filename);
	use Module::Load qw(load);

	option 'root_path' => (
		is => 'ro',
		format => 's',
		doc => 'Root for TensorFlow',
		default => "$FindBin::Bin/../../tensorflow/tensorflow",
		isa => Path,
		coerce => 1,
	);

	option 'lib_path' => (
		is => 'ro',
		format => 's',
		doc => 'Root for lib',
		default => "$FindBin::Bin/../lib",
		isa => Path,
		coerce => 1,
	);


	lazy capi_path => method() {
		$self->root_path->child(qw(tensorflow c));
	};

	lazy header_paths => method() {
		[ map path($_), File::Find::Rule->file
			->name('*.h')
			->in( $self->capi_path ) ];
	};

	lazy header_order => method() {
		my @order = (
			qr{/c/c_api.h$},
			qr{/c/tf_[^.]+\.h$},
			qr{/c/(ops|env|logging)\.h},
			qr{kernels},
			qr{/eager/},
			qr{/experimental/},
			qr{.*},
		);
		\@order;
	};

	lazy fdecl_re => method() {
		my $re = qr{
			(?>
				(?<comment>

maint/process-capi.pl  view on Meta::CPAN

		EOF

		$pod .= <<~EOF;

		=head1 SEE ALSO

		L<https://github.com/tensorflow/tensorflow/tree/master/tensorflow/c>

		=cut

		EOF

		my $output = $self->lib_path->child(module_notional_filename($doc_name) =~ s/\.pm$/.pod/r );
		$output->parent->mkpath;
		$output->spew_utf8($pod);
	}

	lazy typedef_struct_data => method() {
		my $re = qr{
			(?<opaque>
				^
				typedef      \s+
				struct       \s+
				(?<name>\w+) \s+
				\k<name>     \s*
				;
			)
			|
			(?<transparent>
				^
				typedef      \s+
				struct       \s+
				(?<name>\w+) \s+
				\{
				[^\}]+
				\}           \s+
				\k<name>     \s*
				;
			)
		}xm;
		$self->_process_re($re);
	};

	method check_types() {
		my @data = $self->typedef_struct_data->@*;
		my %types = map { $_ => 1 } AI::TensorFlow::Libtensorflow::Lib->ffi->types;
		my %part;
		@part{qw(todo done)} = part { exists $types{$_} } uniq map { $_->{name} } @data;
		use DDP; p %part;
	}

	method check_functions($first_arg = undef) {
		my $functions = AI::TensorFlow::Libtensorflow::Lib->ffi->_attached_functions;
		my @dupes = map { $_->[0]{c} }
			grep { @$_ != 1 } values $functions->%*;
		die "Duplicated functions @dupes" if @dupes;

		my @data = $self->fdecl_data->@*;

		say <<~STATS;
		Statistics:
		==========
		Attached functions: @{[ scalar keys %$functions ]}
		Total CAPI functions: @{[ scalar @data ]}
		STATS

		my $first_missing_function = first {
			! exists $functions->{$_->{func_name}}
			&&
			(
				! defined $first_arg ||
				$_->{fdecl} =~ /\(\s*\Q$first_arg\E\s*\*/
			)
		} @data;
		say "Missing function:";
		use DDP; p $first_missing_function;
	}

	method run() {
		$self->generate_capi_funcs;
		#$self->check_types;
		$self->check_functions;
	}

	subcommand 'generate-capi-docs' => method(@) {
		$self->generate_capi_funcs;
	};

	subcommand 'check-types' => method(@) {
		$self->check_types;
	};

	subcommand 'check-functions' => method(@) {
		if( $_[0] eq '--help' ) {
			print STDERR "$0 check-functions [TYPE]\n";
			exit;
		}
		$self->check_functions(shift @_);
	};

	sub BUILD {
		Moo::Role->apply_roles_to_object(
			AI::TensorFlow::Libtensorflow::Lib->ffi
			=> qw(AttachedFunctionTrackable));
		load 'AI::TensorFlow::Libtensorflow';
		load 'AI::TensorFlow::Libtensorflow::_Misc';
	}

}

package AttachedFunctionTrackable {
	use Mu::Role;
	use Sub::Uplevel qw(uplevel);
	use Hook::LexWrap;

	ro _attached_functions => ( default => sub { {} } );

	around attach => sub {
	    my ($orig, $self, $name) = @_;
	    my $real_name;
	    wrap 'FFI::Platypus::DL::dlsym',
		post => sub { $real_name = $_[1] if $_[-1] };
	    my $ret = uplevel 3, $orig, @_[1..$#_];
	    push $self->_attached_functions->{$real_name}->@*, {
		    c        => $real_name,
		    package  => (caller(2))[0],
		    perl     => ref($name) ? $name->[1] : $name,
		    args     => $_[3],
		    return   => $_[4],
	    };
	    $ret;
	}
}

TF::CAPI::Extract->new_with_options->run;