view release on metacpan or  search on metacpan

lib/Affix/Wrap.pm  view on Meta::CPAN

                my $expr = $macros{$token};
                return undef unless defined $expr;
                1 while $expr =~ s/^\((.*)\)$/$1/;    # Strip outer parens

                # Resolve bitwise and arithmetic expressions
                if ( $expr =~ /[|&<>+\-*\/]/ ) {
                    my $evaluable = $expr;

                    # Using {} delimiters so the // operator doesn't break the regex parser
                    $evaluable =~ s{\b([a-zA-Z_]\w*)\b}{ $resolve->($1) // $1 }ge;

                    # Clean up any C-style suffixes that might have survived
                    $evaluable =~ s/\b(\d+)L+\b/$1/g;

                    # If everything is now numeric/operators/whitespace, we can safely eval
                    if ( $evaluable =~ /^[0-9\s|&<>\+\-\*\/\(\).xXa-fA-F]+$/ ) {

                        # Using a string eval here to let Perl's engine handle C-like precedence
                        my $res = eval $evaluable;
                        return $cache{$token} = $res if defined $res;
                    }
                }

                # 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 );
                    $node->set_value($val) if defined $val;
                }
            }
        }

        method _generate_code( $lib, $pkg ) {
            Carp::croak("Affix::Wrap::generate/wrap requires a valid package name") unless defined $pkg && $pkg =~ /^[a-zA-Z_]\w*(::\w+)*$/;
            my @nodes = $self->parse;
            my %unique_types;
            my %referenced_names;
            for my $node (@nodes) {
                if ( $node->can('name') && $node->name && $node->name ne '(anonymous)' ) {
                    next if $node isa Affix::Wrap::Macro || $node isa Affix::Wrap::Function || $node isa Affix::Wrap::Variable;
                    $unique_types{ $node->name } = $node;
                }

                # Collect dependencies from affix_type strings (e.g. '@sockaddr')
                my $sig = eval { $node->affix . "" } // '';
                while ( $sig =~ /@([a-zA-Z_]\w*)/g ) { $referenced_names{$1} = 1; }
            }

            # Atomic Engine Batch
            my @fwd = sort keys %{ { map { $_ => 1 } ( keys %unique_types, keys %referenced_names ) } };
            my @batch_lines;
            for my $name ( sort keys %unique_types ) {
                my $sig = $unique_types{$name}->affix_type;
                push @batch_lines, "    typedef $name => $sig;" if $sig && $sig ne "$name()";
            }
            my $batch_str = @batch_lines ? join( "\n", @batch_lines ) . "\n" : "";

            # Perl Module Construction
            # Safely quote $lib: escape \ and ] within q[...] delimiters
            my $_lib = '';
            if ( defined $lib ) {
                my $safe_lib = $lib;
                $safe_lib =~ s/\\/\\\\/g;
                $safe_lib =~ s/\]/\\]/g;
                $_lib = "my \$lib = q[$safe_lib];";
            }
            my $out = <<~"PERL";
            package $pkg {
                use v5.40;
                use Affix qw[:all];
                #
                $_lib
            PERL
            for my $name (@fwd) {
                $out .= "    typedef '$name';\n";
            }
            $out .= $batch_str;
            $out .= "\n    #\n";
            for my $node (@nodes) {
                $out .= "    " . $node->perl_constants . "\n" if $node isa Affix::Wrap::Enum;
            }
            $out .= "\n    #\n";
            for my $node (@nodes) {
                my $code = $node->affix_type;
                if ( $code && ( $node isa Affix::Wrap::Function || $node isa Affix::Wrap::Variable || $node isa Affix::Wrap::Macro ) ) {
                    $out .= "    $code;\n";
                }
            }
            $out .= "};\n1;\n";
        }

        method generate( $lib, $pkg, $file ) {
            my ( $code, $nodes ) = $self->_generate_code( $lib, $pkg );
            Path::Tiny::path($file)->spew_utf8($code);
        }

        method wrap ( $lib, $pkg //= [caller]->[0] ) {
            my ( $code, $nodes ) = $self->_generate_code( $lib, $pkg );
            eval $code;
            if ($@) {
                Carp::croak("Affix::Wrap wrap() compilation failed: $@\n\nCode:\n$code");
            }
            return grep { $_ isa Affix::Wrap::Function || $_ isa Affix::Wrap::Variable || $_ isa Affix::Wrap::Macro } @$nodes;
        }

        method list_symbols ($lib_path) {
            my $abs = path($lib_path)->absolute->stringify;
            return [] unless -e $abs;
            my @symbols;
            my ( $out, $err, $exit );

            # llvm-nm
            # We use --extern-only to find the public API
            ( $out, $err, $exit ) = capture { system( 'llvm-nm', '--extern-only', '--defined-only', $abs ) };
            if ( $exit == 0 && $out ) {
                for ( split /\n/, $out ) {
                    if (/ [TRG] (?:_)?(\w+)$/) { push @symbols, $1; }
                }
            }