Affix
view release on metacpan or search on metacpan
lib/Affix/Wrap.pm view on Meta::CPAN
Affix::affix(
$lib,
[ (
defined $self->mangled_name &&
$self->mangled_name ne $self->name &&
Affix::find_symbol( $_lib, $self->mangled_name ) ? $self->mangled_name : $self->name
),
$pkg . '::' . $self->name
],
$arg_types,
$ret_type
) // Carp::carp Affix::errno();
}
else {
Affix::affix(
$lib,
defined $self->mangled_name &&
$self->mangled_name ne $self->name &&
Affix::find_symbol( $lib, $self->mangled_name ) ? [ $self->mangled_name, $self->name ] : $self->name,
$arg_types,
$ret_type
) // Carp::carp Affix::errno();
}
}
}
method affix_ret { $ret->affix_type }
method affix_args {
[ map { $_->affix_type } @$args ]
}
method call_ret { $ret->affix }
method call_args {
[ map { $_->affix } @$args ]
}
} class #
Affix::Wrap::Driver::Clang {
use Config;
field $project_files : param : reader;
field $allowed_files = {};
field $project_dirs = [];
field $paths_seen = {};
field $file_cache = {};
field $last_seen_file = undef;
field $clang //= 'clang';
method _basename ($path) { return '' unless defined $path; $path =~ s{^.*[/\\]}{}; return lc($path); }
method _normalize ($path) {
return '' unless defined $path && length $path;
my $abs = Path::Tiny::path($path)->absolute->stringify;
$abs =~ s{\\}{/}g;
return $abs;
}
ADJUST {
my %seen_dirs;
for my $f (@$project_files) {
next unless defined $f && length $f;
my $abs = $self->_normalize($f);
next unless length $abs;
$allowed_files->{$abs} = 1;
my $dir = Path::Tiny::path($abs)->parent->stringify;
$dir =~ s{\\}{/}g;
unless ( $seen_dirs{$dir}++ ) { push @$project_dirs, $dir; }
}
}
method parse ( $entry_point, $include_dirs //= [] ) {
if ( !defined $entry_point || !length $entry_point ) {
($entry_point) = grep { defined $_ && length $_ } @$project_files;
}
return () unless defined $entry_point && length $entry_point;
my $ep_abs = $self->_normalize($entry_point);
return () unless length $ep_abs;
$allowed_files->{$ep_abs} = 1;
$last_seen_file = $ep_abs;
my $ep_dir = Path::Tiny::path($ep_abs)->parent->stringify;
$ep_dir =~ s{\\}{/}g;
my $found = 0;
for my $pd (@$project_dirs) {
if ( $ep_dir eq $pd ) { $found = 1; last; }
}
push @$project_dirs, $ep_dir unless $found;
my @includes = map { "-I" . $self->_normalize($_) } @$include_dirs;
for my $d (@$project_dirs) { push @includes, "-I$d"; }
my @cmd = (
$clang, '-target', $self->_get_triple(), '-Xclang',
'-ast-dump=json', '-Xclang', '-detailed-preprocessing-record', '-fsyntax-only',
'-fparse-all-comments', '-Wno-everything', @includes, $ep_abs
);
my ( $stdout, $stderr, $exit ) = Capture::Tiny::capture { system(@cmd); };
if ( $exit != 0 ) { die "Clang Error:\n$stderr"; }
if ( $stdout =~ /^.*?(\{.*)/s ) { $stdout = $1; }
my $ast = JSON::PP::decode_json($stdout);
my @objects;
$self->_walk( $ast, \@objects, $ep_abs );
$self->_scan_macros_fallback( \@objects );
$self->_merge_typedefs( \@objects );
$self->_wrap_named_types( \@objects );
#~ @objects = sort { ( $a->file cmp $b->file ) || ( $a->start_offset <=> $b->start_offset ) } @objects;
@objects;
}
method _walk( $node, $acc, $current_file ) {
return unless ref $node eq 'HASH';
my $kind = $node->{kind} // 'Unknown';
my $node_file = $self->_get_node_file($node);
if ($node_file) {
$current_file = $self->_normalize($node_file);
$last_seen_file = $current_file;
}
elsif ( defined $last_seen_file ) { $current_file = $last_seen_file; }
if ( $self->_is_valid_file($current_file) && !$node->{isImplicit} ) {
if ( $kind eq 'MacroDefinitionRecord' ) {
if ( $node->{range} ) { $self->_macro( $node, $acc, $current_file ); }
}
elsif ( $kind eq 'TypedefDecl' ) { $self->_typedef( $node, $acc, $current_file ); }
elsif ( $kind eq 'RecordDecl' || $kind eq 'CXXRecordDecl' ) {
$self->_record( $node, $acc, $current_file );
return;
}
elsif ( $kind eq 'EnumDecl' ) {
$self->_enum( $node, $acc, $current_file );
return;
}
elsif ( $kind eq 'VarDecl' ) {
if ( ( $node->{storageClass} // '' ) ne 'static' ) { $self->_var( $node, $acc, $current_file ); }
}
elsif ( $kind eq 'FunctionDecl' ) {
$self->_func( $node, $acc, $current_file );
return;
}
elsif ( $kind eq 'BuiltinType' ) { return; }
}
if ( $node->{inner} ) {
lib/Affix/Wrap.pm view on Meta::CPAN
end_offset => $e
);
}
elsif ( $content =~ /^(.+?)([\s\*]+)([a-zA-Z_]\w*(?:\[.*?\])?)$/ ) {
my ( $type_str, $sep, $name ) = ( $1, $2, $3 );
$type_str .= $sep;
if ( $name =~ s/(\[.*\])$// ) { $type_str .= $1; }
push @$acc,
Affix::Wrap::Typedef->new(
name => $name,
underlying => Affix::Wrap::Type->parse($type_str),
file => $f,
line => $self->_ln( $c, $s ),
end_line => $self->_ln( $c, $e ),
doc => $self->_doc( $c, $s ),
start_offset => $s,
end_offset => $e
);
}
}
}
method _enum_consts($body) {
my @cs;
my $v = 0;
for ( split /,/, $body ) {
s/\/\/.*$//;
s/\/\*.*?\*\///s;
s/^\s+|\s+$//g;
next unless length;
if (/^(\w+)\s*(?:=\s*(.+?))?$/) {
my $name = $1;
my $val = $2; # Capture string or undef
# Safe hex handling without string eval
if ( defined $val && $val =~ /^(-?)0x([\da-fA-F]+)$/ ) {
my $sign = $1 || '';
my $num = hex($2);
$val = $sign eq '-' ? -$num : $num;
}
push @cs, { name => $name, value => $val };
}
}
return \@cs;
}
method _scan_funcs( $f, $acc ) {
my $c = $self->_read($f);
while ( $c
=~ /^\s*((?:const\s+|unsigned\s+|struct\s+|[\w:<>]+(?:\s*::\s*[\w:<>]+)*\s*\*?\s*)+?)\s*(\w+)\s*(\((?:[^()]++|(?3))*\))(?:\s*;|\s*\{)/gm
) {
next if $2 =~ /^(if|while|for|return|switch|typedef)$/ || $1 =~ /static/;
my $s = $-[0];
my $e = $+[0];
my ( $ret_str, $func_name, $args_str ) = ( $1, $2, substr( $3, 1, -1 ) );
#
$ret_str =~ s/\b[A-Z_][A-Z0-9_]*\b//g;
$ret_str =~ s/^\s+|\s+$//g;
my $ret_obj = Affix::Wrap::Type->parse($ret_str);
# Split args respecting commas inside parentheses (function pointers, etc.)
my @args_raw = grep {length} map { s/^\s+|\s+$//g; $_ } split /,(?![^(]*\))/, $args_str;
if ( @args_raw == 1 && $args_raw[0] =~ /^void$/ ) { @args_raw = (); }
my @args;
for my $raw (@args_raw) {
if ( $raw =~ /^(.+?)\s*\(\*\s*(\w+)\)\s*\((.*)\)$/ ) {
my ( $r_type, $cb_name, $cb_args ) = ( $1, $2, $3 );
my $ret = Affix::Wrap::Type->parse($r_type);
my @p;
if ( $cb_args ne '' && $cb_args ne 'void' ) {
@p = map { Affix::Wrap::Type->parse($_) } split /,(?![^(]*\))/, $cb_args;
}
my $code_ref = Affix::Wrap::Type::CodeRef->new( ret => $ret, params => \@p );
push @args, Affix::Wrap::Argument->new( type => $code_ref, name => $cb_name );
}
elsif ( $raw =~ /^(.+?)([\s\*]+)([a-zA-Z_]\w*(?:\[.*?\])?)$/ ) {
my ( $t, $sep, $n ) = ( $1, $2, $3 );
$t .= $sep;
if ( $n =~ s/(\[.*\])$// ) { $t .= $1 }
push @args, Affix::Wrap::Argument->new( type => Affix::Wrap::Type->parse($t), name => $n );
}
else {
push @args, Affix::Wrap::Argument->new( type => Affix::Wrap::Type->parse($raw) );
}
}
push @$acc,
Affix::Wrap::Function->new(
name => $func_name,
mangled_name => $func_name,
ret => $ret_obj,
args => \@args,
file => $f,
line => $self->_ln( $c, $s ),
end_line => $self->_ln( $c, $e ),
doc => $self->_doc( $c, $s ),
start_offset => $s,
end_offset => $e
);
}
}
method _mem($b) {
my @m;
my $pending_doc = '';
my $clean = sub ($t) {
$t =~ s/^\s*\/\*\*?//mg;
$t =~ s/\s*\*\/$//mg;
$t =~ s/^\s*\*\s?//mg;
$t =~ s/^\s*\/\/\s?//mg;
$t =~ s/^\s+|\s+$//g;
return length($t) ? $t : undef;
};
while ( length($b) > 0 ) {
if ( $b =~ s/^(\s+)// ) { next; }
if ( $b =~ s|^(\s*/\*(.*?)\*/)||s ) { $pending_doc .= $2; next; }
if ( $b =~ s|^(//(.*?)\n)|| ) { $pending_doc .= "$2\n"; next; }
if ( $b =~ s/^\s*(union|struct)\s*(\{(?:[^{}]++|(?2))*\})\s*(\w+)\s*;// ) {
my $tag = $1;
my $d = Affix::Wrap::Struct->new( name => '', tag => $tag, members => $self->_mem( substr( $2, 1, -1 ) ) );
push @m, Affix::Wrap::Member->new( name => $3, definition => $d, doc => $clean->($pending_doc) );
$pending_doc = '';
lib/Affix/Wrap.pm view on Meta::CPAN
$t =~ s/^\s*(\/\*+|\*+\/|\*|\/\/)\s?//mg;
$t =~ s/^\s+|\s+$//g;
return $t;
}
}
class Affix::Wrap {
field $driver : param //= ();
field $project_files : param //= $driver->project_files;
field $include_dirs : param //= [];
field $types : param //= {};
#
ADJUST {
if ( defined $driver && !builtin::blessed($driver) ) {
if ( $driver eq 'Clang' ) { $driver = Affix::Wrap::Driver::Clang->new( project_files => $project_files ); }
elsif ( $driver eq 'Regex' ) { $driver = Affix::Wrap::Driver::Regex->new( project_files => $project_files ); }
else { die "Unknown driver '$driver'"; }
}
elsif ( !defined $driver ) {
my ( $out, $err, $exit ) = Capture::Tiny::capture { system( 'clang', '--version' ); };
my $use_clang = $exit == 0;
$driver = $use_clang ? Affix::Wrap::Driver::Clang->new( project_files => $project_files ) :
Affix::Wrap::Driver::Regex->new( project_files => $project_files );
}
}
method parse( $entry_point //= () ) {
$entry_point //= $project_files->[0];
$driver->parse( $entry_point, $include_dirs );
}
method _resolve_macros ($nodes) {
my %macros;
for my $node (@$nodes) {
if ( $node isa Affix::Wrap::Macro ) {
my $val = $node->value // '';
$val =~ s/(?<=\d)[Uu][Ll]{0,2}//g;
$macros{ $node->name } = $val;
}
}
my %cache;
my $resolve;
$resolve = sub {
my ($token) = @_;
return undef unless defined $token;
$token =~ s/^\s+|\s+$//g; # Trim whitespace
# Is it a literal number?
return oct($token) if $token =~ /^0x[\da-fA-F]+$/i; # Hex -> Int
return int($token) if $token =~ /^-?\d+$/; # Dec -> Int
# Check cache (recursion guard)
return $cache{$token} if exists $cache{$token};
local $cache{$token} = undef;
# Look up definition
my $expr = $macros{$token};
return undef unless defined $expr; # Not found (maybe a string or unknown)
# Parse expression
# Strip outer parentheses recursively: ((A|B)) -> A|B
1 while $expr =~ s/^\((.*)\)$/$1/;
# Handle bitwise OR chains (e.g. "FLAG_A | FLAG_B")
if ( $expr =~ /\|/ ) {
my $accum = 0;
for my $part ( split /\|/, $expr ) {
my $val = $resolve->($part);
return undef unless defined $val; # Abort if any part is non-numeric
$accum |= $val;
}
return $cache{$token} = $accum;
}
# Fallback: Treat as simple alias (A -> B)
return $cache{$token} = $resolve->($expr);
};
for my $node (@$nodes) {
if ( $node isa Affix::Wrap::Macro ) {
my $val = $resolve->( $node->name );
if ( defined $val ) {
$node->set_value($val);
}
}
}
}
method generate ( $lib, $pkg, $file ) {
my @nodes = $self->parse;
$self->_resolve_macros( \@nodes );
my $out =<<~"";
package $pkg {
use v5.36;
use Affix;
#
my \$lib = '$lib';
for my $name ( keys %$types ) {
my $type = $types->{$name};
my $type_str = builtin::blessed($type) ? $type : "'$type'"; # Quote user types
$out .= "typedef '$name' => $type_str;\n";
}
for my $node (@nodes) {
if ( ( $node isa Affix::Wrap::Typedef || $node isa Affix::Wrap::Struct || $node isa Affix::Wrap::Enum ) &&
exists $types->{ $node->name } ) {
next;
}
my $code = $node->affix_type;
if ($code) { $out .= "$code;\n"; }
}
$out .= "\n};\n1;\n";
Path::Tiny::path($file)->spew_utf8($out);
}
method wrap ( $lib, $target //= [caller]->[0] ) {
# Pre-register User Types
# This ensures they are available in the Affix registry before signatures are parsed,
# and allows using them in recursive definitions or opaque handles.
for my $name ( keys %$types ) {
my $type = $types->{$name};
( run in 0.855 second using v1.01-cache-2.11-cpan-8f98c5d2c55 )