Streamline NativeCall::Compiler::GNU (part 2/2)

Re-imagine mangle_cpp_symbol using mostly nqp ops, hopefully having a good effect on compiling large nativecall libraries
rakudo · May 5, 2024 · 92da00a · 92da00a
1 parent f25dcac
commit 92da00a
Showing 1 changed file with 67 additions and 29 deletions.
diff --git a/lib/NativeCall/Compiler/GNU.rakumod b/lib/NativeCall/Compiler/GNU.rakumod
@@ -27,47 +27,85 @@ my constant $type2letter = nqp::hash(
 );
 
 #- helper sub ------------------------------------------------------------------
-my sub cpp_param_letter($type, str :$R = '', str :$P = '', str :$K = '') {
+my sub cpp_param_letter($type, str $RPK = '') {
     my str $name = $type.^name;
 
-    $R ~ $P ~ $K ~ nqp::ifnull(
+    $RPK ~ nqp::ifnull(
       (nqp::atkey($type2letter, $name) || cpp_param_letter($type.of)),
       (nqp::chars($name) ~ $name)
     )
 }
 
 #- mangle_cpp_symbol -----------------------------------------------------------
-our sub mangle_cpp_symbol(Routine $r, $symbol) {
-    $r.signature.set_returns($r.package)
-        if $r.name eq 'new' && !$r.signature.has_returns && $r.package !~~ GLOBAL;
-
-    my $is-cpp-struct = $r.package.REPR eq 'CPPStruct';
-    my @parts         = $symbol.split: '::';
-    my $mangled       = '_Z';
-    $mangled ~= 'N' if $is-cpp-struct;
-    $mangled ~= 'K' if $r.?cpp-const;
-    $mangled ~= .chars ~ $_ for @parts[0..*-2];
-    if +@parts >= 2 && (@parts.tail eq 'new' || @parts[*-2] eq @parts[*-1]) {
-        $mangled ~= 'C1';
-    } else {
-        $mangled ~= @parts.tail.chars ~ @parts.tail
-    }
-    $mangled ~= 'E' if $is-cpp-struct;
+our sub mangle_cpp_symbol(Routine:D $routine, Str:D $symbol) {
+    my $package   := $routine.package;
+    my $signature := $routine.signature;
+
+    $signature.set_returns($package)
+      if $routine.name eq 'new'
+      && !$signature.has_returns
+      && !($package ~~ GLOBAL);
+
+    my $is-cpp-struct := $package.REPR eq 'CPPStruct';
+    my str @parts      = $symbol.split: '::';
+    my int $last       = nqp::elems(@parts) - 1;
+
+    my str @mangled = '_Z';
+    nqp::push_s(@mangled, "N") if $is-cpp-struct;
+    nqp::push_s(@mangled, "K") if $routine.?cpp-const;
+
+    # Handle all name parts except the last
+    my str $part;
+    my int $i;
+    nqp::while(
+      $i < $last,
+      nqp::stmts(
+        ($part = nqp::atpos_s(@parts, $i++)),
+        nqp::push_s(@mangled, nqp::concat(nqp::chars($part), $part))
+      )
+    );
 
-    my @params = $r.signature.params;
-    if $r ~~ Method {
-        @params.shift;
+    # Handle the final name part
+    nqp::push_s(
+      @mangled,
+      nqp::stmts(
+        ($part = nqp::atpos_s(@parts, $last)),
+        nqp::if(
+          nqp::elems(@parts) >= 2
+            && ($part eq 'new' || nqp::atpos_s(@parts, $last - 1) eq $part),
+          'C1',
+          nqp::concat(nqp::chars($part), $part)
+        )
+      )
+    );
+    nqp::push_s(@mangled, "E") if $is-cpp-struct;
+
+    # Get parameters that matter
+    my @params = $signature.params;
+    if nqp::istype($routine, Method) {
+        @params.shift;  # self
         @params.pop if @params.tail.name eq '%_';
     }
 
-    my $params = join '', @params.map: {
-        my $R = .?cpp-ref                 ?? 'R' !! ''; # reference
-        my $P = .rw                       ?? 'P' !! ''; # pointer
-        $P ~= 'P' if .type ~~ Str | NativeCall::Types::Pointer | NativeCall::Types::CArray;
-        my $K = ($R || $P) && .?cpp-const ?? 'K' !! ''; # const
-        cpp_param_letter(.type, :$R, :$P, :$K)
-    };
-    $mangled ~= $params || 'v';
+    # Add any letters for parameters
+    nqp::push_s(
+      @mangled,
+      @params.map({
+          my str $R = .?cpp-ref ?? 'R' !! ''; # reference
+          my str $P = .rw       ?? 'P' !! ''; # pointer
+
+          my $type := .type;
+          $P ~= 'P'
+            if nqp::istype($type, Str)
+            || nqp::istype($type, NativeCall::Types::Pointer)
+            || nqp::istype($type, NativeCall::Types::CArray);
+
+          my str $K = ($R || $P) && .?cpp-const ?? 'K' !! ''; # const
+          cpp_param_letter($type, $R ~ $P ~ $K)
+      }).join || 'v'
+    );
+
+    nqp::join('', @mangled)
 }
 
 # vim: expandtab shiftwidth=4