#!/usr/bin/env perl

use v5.30;
use warnings;

use FindBin qw/$Bin $Script/;
use List::Util qw/pairs/;
use Data::Dumper qw//;
use ExtUtils::Typemaps qw//;
use ExtUtils::ParseXS::Utilities qw/standard_typemap_locations/;
use autodie;

my $add_trace = $ENV{WGPU_PL_TRACE} // 0;

my $h_file = find_header();

open my $h,  '<', $h_file;
open my $xs, '>', "$Bin/webgpu.xs";
open my $c,  '>', "$Bin/webgpu_wrap.c";
open my $tm, '>', "$Bin/../typemap";
open my $pm, '>', "$Bin/../lib/WebGPU/Direct/XS.pm";

my $class_defaults = require "$Bin/$Script.default";
my $constants      = require "$Bin/$Script.constant";

my %typedefs = (
  bool     => 'bool',
  double   => 'double',
  float    => 'float',
  uint16_t => 'uint16_t',
  uint32_t => 'uint32_t',
  uint64_t => 'uint64_t',
  int32_t  => 'int32_t',
  size_t   => 'size_t',
  char     => 'str',
  void     => 'void',
);

my @typemap = (
  q{WebGPU::Direct::MappedBuffer                                    T_FETCHPTR},
  q{},
  q{# We do the tr/:/_/ in the output because ParseXS doesn't for outputs},
  q{INPUT},
  q{T_VOID},
  q{    $var = ($type) _get_struct_ptr(aTHX_ $arg, NULL)},
  q{T_FETCH},
  q{    $var = *($type *) _get_struct_ptr(aTHX_ $arg, newSVpvs(\"${ my $t=$type; $t=~s/ .*//; $t=~tr/_/:/; $t=~s/^WGPU/WebGPU::Direct::/; \$t}\"))},
  q{T_FETCHPTR},
  q{    $var = ($type) _get_struct_ptr(aTHX_ $arg, newSVpvs(\"${ my $t=$type; $t=~s/ .*//; $t=~tr/_/:/; $t=~s/^WGPU/WebGPU::Direct::/; \$t}\"))},
  q{},
  q{OUTPUT},
  q{T_VOID},
  q{    $arg = _void__wrap($var);},
  q{T_FETCH},
  q{    ${$type=~tr/:/_/, \$type}* ptr_$var; Newx(ptr_$var, 1, $type);},
  q{    Copy(&$var, ptr_$var, 1, $type);},
  q{    $arg = ${\$type}__wrap(ptr_$var); /* T_FETCH */},
  q{T_FETCHPTR},
  q{    $arg = ${$type=~tr/:/_/, \$type}__wrap($var); /* T_FETCHPTR */},
);

my $arrcnt_re = qr/^(\w+)Count$/xms;
my $arrnme_re = qr/^(\w+)s$/xms;
my $bufcnt_re = qr/^(data)?[sS]ize$/xms;
my $bufnme_re = qr/^data$/xms;

my @fns;
my @classes;
my %enums;
my %classdefs;
my %callbackdefs;

my $edit_warning = <<EOS;
# !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!! #
#   This file is generated by webgpu.xs.PL  #
# !!!!!!!   ANY EDIT WILL BE LOST   !!!!!!! #
EOS

say $xs qq{$edit_warning};

say $c qq{/*\n$edit_warning*/};
say $c q{};

say $tm $edit_warning;

say $pm $edit_warning;
say $pm q{use v5.30;};
say $pm q{use warnings;};
say $pm q{use Carp;};
say $pm q{};
say $pm q[package # Hide from PAUSE];
say $pm q[    WebGPU::Direct::XS];
say $pm q[{];
say $pm q[  our $VERSION = '0.15';];
say $pm q[  require XSLoader;];
say $pm q[  XSLoader::load('WebGPU::Direct', $VERSION);];
say $pm q[}];
say $pm q[];
say $pm q[package # Hide from PAUSE];
say $pm q[    WebGPU::Direct::Opaque {];
say $pm q[}];
say $pm q[];
say $pm q[require WebGPU::Direct::MappedBuffer;];
say $pm q[require WebGPU::Direct::Error;];
say $pm q[];

sub pkg_name
{
  my $ctype = shift;

  $ctype =~ s/\s*[*]\s*$//xms;
  $ctype =~ s/\s*const$//xms;
  $ctype =~ s/\s+$//xms;

  return $ctype
      if exists $typedefs{$ctype};

  $ctype = "WebGPU::Direct::$ctype";
  $ctype =~ s/::WGPU/::/;

  return $ctype;
}

sub trace_c
{
  my $name  = shift;
  my $stage = shift;

  return \''
      unless $add_trace;

  return \qq{printf("$name: $stage L%d\\n", __LINE__);};
}

# Parse the header file
while (<$h>)
{
  chomp;
  s[// .* $][]xms;
  s[/[*] .*? [*]/][]xms;
  s[ (?:\s|\b) (?:WGPU_OBJECT_ATTRIBUTE|WGPU_ENUM_ATTRIBUTE|WGPU_STRUCTURE_ATTRIBUTE|WGPU_FUNCTION_ATTRIBUTE|WGPU_NULLABLE)][]xmsg;

  # Skip the WGPU_SKIP_PROCS definitions
  if ( m{^ [#] if \s+ [!] defined [(] WGPU_SKIP_PROCS [)] }xms .. m[^ [#] endif ]xms )
  {
    next;
  }

  # Ignore multi-line comments
  if (m[(.*?) /[*] .*?]xms .. m[.*? [*]/ (.*)]xms )
  {
    next
      if !defined $1;
    $_ = $1;
  }

  # Ignore multi-line definitions
  if (m/^ [#] .* \\ $/xms .. m[ [^\\] $ ]xms )
  {
    next;
  }

  # Ignore CPP macros, blank lines, and extern statements
  if (m/^ [#] | ^ \s* $ | ^ extern \s* "C" \s* { | ^ } \s* $ /xms)
  {
    next;
  }

  # Skip forward declares
  if (m/^ \s* struct \s+ \w+ ; $/xms)
  {
    next;
  }

  # Enum typedef blocks
  if ( m[^ typedef \s+ (enum) \s+ (\w+) \s+ { $]xms .. m[ ^ } \s+ (\w+) ; $]xms )
  {
    state $type;
    if ($1)
    {
      if ( $1 eq 'enum' )
      {
        die "Duplicate typedef: $2"
            if exists $typedefs{$2};
        $type = $2;
        $enums{$type} = {};
      }
      else
      {
        die "Type mismatch: $1 ne $type"
            if $1 ne $type;
        $typedefs{$type} = 'enum';
      }
    }

    # Pull out constants, including named ones
    if (
      m[^ \s*
              (\w+) \s*
              = \s*
              ([^,]+) \s*
              ,? \s* $]xms
        )
    {
      my $const = $1;
      my $value = $2;
      my $short = $const;
      $short =~ s/$type\_//;
      if ( $short =~ m/^\d/ )
      {
        $short = "_$short";
      }

      next
        if $short eq 'Force32';

      if ( $short !~ m/^[[:upper:]][\d[:upper:]]+/ )
      {
        $short = lcfirst $short;
      }

      # If it is a definition of previous constants, keep the idea in tact
      # and let perl do that work of its value
      if ( $value !~ m/^[0-9a-fx]+$/ixms )
      {
        $value =~ s/$type [_] (\w+)/\l$1()/xmsg;
      }

      $enums{$type}->{$value} = "__PACKAGE__->_add_enum('$short' => ($value, '$const'));";
    }

    next;
  }

  # Bit flag typedef definitions
  if (m[^ typedef \s+ (WGPUFlags) \s+ (\w+); $]xms)
  {
    die "Duplicate typedef: $2"
        if exists $typedefs{$2};
    my $type = $2;
    $enums{$type}    = {};
    $typedefs{$type} = 'flag';
    next;
  }

  # Bit flag definitions
  if (m[^ static \s+ const \s+ (\w+) \s+ (\w+) \s* = \s* ( (?:0x)? [0-9a-fx]+ ) \s* ;]ixms)
  {
    my $type  = $1;
    my $const = $2;
    my $value = $3;
    my $short = $const;
    $short =~ s/$type\_//;
    if ( $short =~ m/^\d/ )
    {
      $short = "_$short";
    }

    next
        if $short eq 'Force32';

    if ( $short !~ m/^[[:upper:]][\d[:upper:]]+/ )
    {
      $short = lcfirst $short;
    }

    $enums{$type}->{$value} = "__PACKAGE__->_add_enum('$short' => ($value, '$const'));";

    next;
  }

  # Struct definitions
  if ( m[^ typedef \s+ (struct) \s+ (\w+) \s+ { $]xms .. m[ ^ } \s+ (\w+) ; $]xms )
  {
    state $type;
    state $class;
    state @defs;

    if ($1)
    {
      if ( $1 eq 'struct' )
      {
        @defs  = ();
        $type  = $2;
        $class = pkg_name($type);

        die "Duplicate typedef: $class"
            if exists $typedefs{$class};

        $typedefs{$class} = 'obj';

      }
      else
      {
        my $restype = $2;
        die "Type mismatch: $1 ne $type"
            if $1 ne $type;

        push @classes, $class;
        $classdefs{$class} = {
          type     => $type,
          class    => $class,
          defs     => [@defs],
          fns      => [],
          ptr_type => '',
        };
      }
      next;
    }

    if (
      m[^ \s*
              (struct \s*)?
              (\w+) \s*
              (const \s+)?
              (\s* [*] \s*)?
              (\w+)
              ; \s* $]xms
        )
    {
      no warnings 'uninitialized';
      my $full_ret   = "$1 $2 $3 $4";
      my $key        = $5;
      my $klen       = length $5;
      my $ctype      = $2;
      my $is_ptr     = !!$4;
      my $return     = pkg_name($ctype);
      my $typedef    = $typedefs{$ctype} // $typedefs{$return};
      my $inline_obj = !$is_ptr && $typedef eq 'obj';

      if ( $inline_obj && $classdefs{$return} && $classdefs{$return}->{ptr_type} )
      {
        $inline_obj = undef;
      }

      if ( !defined $typedef )
      {
        die "Unknown typedef: $ctype";
      }

      if ( $typedef ne 'obj' && $typedef ne 'opaque' )
      {
        $return = $ctype;
      }

      if ( $typedef eq 'str' )
      {
        $return = $full_ret;
      }

      if ( $typedef eq 'void' )
      {
        $return = "void *";
      }

      $return =~ s/^\s+//;
      push @defs,
          {
        key        => $key,
        klen       => $klen,
        ctype      => $ctype,
        typedef    => $typedef,
        is_ptr     => $is_ptr,
        inline_obj => $inline_obj,
        return     => $return,
          };
    }
    else
    {
      die $_;
    }
    next;
  }

  # Handle all other function call typdefs
  if (m[^ typedef \s+ (\w+) \s+ [(][*] (\w*) [)] [(] ([^)]+) [)] ; ]xms)
  {
    my $return     = $1;
    my $type       = $2;
    my $definition = $3;

    my $class = pkg_name($type);

    die "Duplicate typedef: $class"
        if exists $typedefs{$class};

    my @args = ( $definition =~ m[ \s* ([^,]*) \s+ (\w+) \s* (?: , | $ ) ]xmsg );

    # If the last arg is a user-data slot, create a callback situation
    if ( $return eq 'void' && $args[-2] && $args[-2] =~ m/^void\s*[*]$/ )
    {
      $callbackdefs{$class} = {
        type  => $type,
        class => $class,
        args  => \@args,
      };
    }

    $typedefs{$class} = 'CODE';

    push @classes, $class;

    $classdefs{$class} = {
      type     => $type,
      class    => $class,
      ptr_type => 1,
      fn_type  => 1,
      defs     => [],
      fns      => [],
    };

    next;
  }

  if (
    m[^WGPU_EXPORT \s* (\w+) \s* ( (?: const \s+)? (?: \s* [*] \s*)? ) \s* (\w+) \s* [(] \s* ( [^)]* ) \s* [)] ; \s* $ ]xms
      )
  {
    my $return  = $1;
    my $return2 = $2;
    my $fn_name = $3;
    my $arg     = $4;

    my @args = ( $arg =~ m[ \s* ([^,]*) \s+ (\w+) \s* (?: , | $ ) ]xmsg );

    my $fn_def = {
      return => "$return $return2",
      c_name => $fn_name,
      name   => $fn_name,
      args   => [@args],
    };

    my $first_arg = $args[0];
    my $first_pkg = pkg_name($first_arg);

    if ( ( ( $typedefs{$first_pkg} // '' ) eq 'obj' || ( $typedefs{$first_pkg} // '' ) eq 'opaque' )
      && $fn_name =~ m/^($first_arg)/i )
    {
      $fn_def->{name} =~ s/^($first_arg)//i;
      $fn_def->{prefix} = $1;
      push $classdefs{$first_pkg}->{fns}->@*, $fn_def;
    }
    else
    {
      $fn_def->{name} =~ s/^(wgpu)//;
      $fn_def->{prefix} = $1;
      push @fns, $fn_def;
    }

    $fn_def->{name} = lcfirst($fn_def->{name});

    next;
  }

  if (m[^ typedef \s+ (\w+[*]?) \s+ (\w+); $]xms)
  {
    die "Unknown typedef: $1"
        if !$typedefs{$1};

    $typedefs{$2} = $typedefs{$1};
    next;
  }

  # Handle opaque sturcts that may be used as specifc types
  if (m[^ typedef \s+ struct \s+ (\w+ [*]?) \s+ (\w+); $]xms)
  {
    my $type   = $2;
    my $is_ptr = ( $1 =~ m/[*]/ );
    my $class  = pkg_name($type);

    die "Duplicate typedef: $class"
        if exists $typedefs{$class};

    die
        if !$is_ptr;

    $typedefs{$class} = 'opaque';
    push @classes, $class;
    $classdefs{$class} = {
      type     => $type,
      ptr_type => $is_ptr,
      opaque   => 1,
      class    => $class,
      defs     => [],
      fns      => [],
    };
    next;
  }

  die "Unparsed line: $_";
}

say $xs qq{MODULE = WebGPU::Direct\t\tPACKAGE = WebGPU::Direct::XS\t\tPREFIX = wgpu};
say $pm qq[package\n\tWebGPU::Direct {];

# Map all the shortcuts to their proper calsses
foreach (@fns)
{
  my %def = %$_;
  say_call_fn( \%def );
  say $pm qq[  sub $def{name} { my \$class = shift; WebGPU::Direct::XS::$def{name}(\@_); }];
}

say $pm qq[  our \@export_all;];
foreach my $enum ( sort keys %enums )
{
  $enum =~ s/^WGPU//;
  my $pkg = "WebGPU::Direct::$enum";
  say $pm qq[  sub $enum () { '$pkg' }; push \@export_all, '$enum';];
}

{
  my @new;
  my @pkgs;
  foreach my $pkg ( sort @classes )
  {
    next
        if $classdefs{$pkg}->{fn_type};
    next
        if $classdefs{$pkg}->{opaque};

    my $fn = $pkg;
    $fn =~ s/^WebGPU::Direct:://;
    push @pkgs, qq[  sub $fn () { Carp::croak if \@_>1; '$pkg' }];
    push @new,  qq[  sub new$fn { my \$class = shift; return $pkg\->new(\@_); }];
  }
  say $pm join( "\n", @pkgs );
  say $pm join( "\n", @new );
}

# Write out all the constant definitions
foreach my $const ( sort keys %$constants )
{
  my $val = $constants->{$const};
  say $pm qq[  sub $const () { $val }; push \@export_all, '$const';];
}

say $pm qq[};];
say $pm qq[];

open my $const_pod, '>', "$Bin/../lib/WebGPU/Direct/Constants.pod";
open my $types_pod, '>', "$Bin/../lib/WebGPU/Direct/Types.pod";

my %enum_base = (
  enum => 'WebGPU::Direct::Enum',
  flag => 'WebGPU::Direct::Flag',
);

# Write out all the enum definitions
foreach my $enum ( sort keys %enums )
{
  my $pkg = "WebGPU::Direct::$enum";
  $pkg =~ s/::WGPU/::/;

  my $base = $enum_base{ $typedefs{$enum} };
  $const_pod->say(qq[\n=head1 $pkg]);
  $const_pod->say(qq[\n=over]);
  say $pm qq[package\n\t$pkg {];
  say $pm qq{  use base "$base";};

  my %consts = %{ $enums{$enum} };

  foreach my $value ( sort keys %consts )
  {
    my ($short) = $consts{$value} =~ m/'(\w*)'/;
    $const_pod->say(qq[\n=item * $short]);
    say $pm qq[  $consts{$value}];
  }

  $const_pod->say(qq[\n=back]);
  say $pm qq[  $pkg\->_build_const_lut;];
  say $pm qq[};];
  say $pm qq[];
}

# Forward define the callback refs
foreach my $cb_name ( sort keys %callbackdefs )
{
  my $callback = $callbackdefs{$cb_name};
  my $type     = $callback->{type};
  my $class    = $callback->{class};
  my @args     = $callback->{args}->@*;
  my $c_prefix = "${class}";

  $c_prefix =~ s/::/__/g;

  my @argdefs;
  my @keys;
  my @vals;
  my @pushs;

  my $argoff = -1;
  foreach my $pair ( pairs @args )
  {
    my ( $key, $value ) = @$pair;

    my ($type) = $key =~ m/^(?:struct\s+)?(\w+)/;
    my $pkg = pkg_name($type);

    warn "Unknown type: $type"
        if !exists $typedefs{$pkg} && !exists $typedefs{$type};

    push @argdefs, "$key $value";
  }

  {
    local $" = ', ';
    say $c "void ${c_prefix}__callback( @argdefs );";
  }
}
say $c '';

# Produce all the class definitions
foreach my $class (@classes)
{
  my %def = $classdefs{$class}->%*;

  my $type = $def{type};
  my @defs = $def{defs}->@*;
  my @fns  = $def{fns}->@*;

  my $preamble    = "";
  my $packs       = "";
  my $addl_pack   = "";
  my $unpacks     = "";
  my $addl_unpack = "";
  my $destroy     = '';
  my $c_prefix    = "${class}";
  my $prefix      = "wgpu";

  $c_prefix =~ s/::/__/g;

  my $class_path = "$class";
  $class_path =~ s[::][/]g;
  $class_path = "$Bin/../lib/$class_path";

  warn "Class definition for $type doesn't expect to have attributes and functions"
      if @defs && @fns;

  if (@defs)
  {
    # Tehcnically this gets more than it should, because anyone with a first
    # element that is non-pointer struct can be used in place of that first
    # element type. Used to require that the first one be the only inlinable
    # object, but that now removes some that are legit ISA's. TODO
    if ( $defs[0]->{inline_obj} )
    {
      my $c_prefix = $defs[0]->{return} . '::';
      $c_prefix =~ s/::/__/g;
      $addl_pack   = qq{${c_prefix}pack( /*asdf*/ THIS );\n};
      $addl_unpack = qq{${c_prefix}unpack( /*asdf*/ THIS );\n};
      $preamble    = qq{push \@$class\::ISA, "$defs[0]->{return}";};
    }

    # Check for array-type elements
    my $maybe_array;
    foreach my $i ( 0 .. $#defs )
    {
      my %def = $defs[$i]->%*;

      my $match;
      if ( $def{ctype} eq 'size_t' && $def{key} =~ m/$arrcnt_re/ )
      {
        $match = $1;
      }
      if ( $def{key} =~ $arrnme_re )
      {
        $match = $1;
      }

      if ($match)
      {
        # If there is not yet a match
        if ( !$maybe_array )
        {
          $maybe_array = $match;
          next;
        }

        # Or the match doesn't match the last try
        if ( $match ne $maybe_array )
        {
          if ( $match =~ m/^(.*)y$/ && $maybe_array =~ m/^$1ie$/ )
          {
            # Count came second, so $match is the key we want
            $maybe_array = $match;
          }
          elsif ( $match =~ m/^(.*)ie$/ && $maybe_array =~ m/^$1y$/ )
          {
            # Count came second, so $maybe_array has what we wnat
            $match = $maybe_array;
          }
          else
          {
            $maybe_array = $match;
            next;
          }
        }

        my $cnt_i = $def{key} =~ m/$arrcnt_re/ ? $i : $i - 1;
        my $arr_i = $cnt_i == $i ? $i - 1 : $i;

        $defs[$cnt_i]->{ro}    = 1;
        $defs[$arr_i]->{array} = $match;
      }

      undef $maybe_array;
    }

    # Check for callback-type elements
    if ( $#defs >= 3 )
    {
      my %has_x;
      foreach my $i ( 0 .. $#defs )
      {
        my %def = $defs[$i]->%*;

        foreach my $x (qw/callback userdata1 userdata2/)
        {
          if ( $def{key} eq $x )
          {
            die "Saw $x twice in the same struct: $class"
                if $has_x{$x};

            $has_x{$x} = $i || '0 but true';
            last;
          }
        }
      }

      if ( $has_x{callback} && $has_x{userdata1} && $has_x{userdata2} )
      {
        $defs[ $has_x{callback} ]->{struct_key} = 'userdata1';

        $defs[ $has_x{userdata1} ]->{is_ro} = 1;
        $defs[ $has_x{userdata1} ]->{key}   = '';
        $defs[ $has_x{userdata1} ]->{klen}  = 0;

        $defs[ $has_x{userdata2} ]->{typedef}    = 'SV';
        $defs[ $has_x{userdata2} ]->{key}        = 'userdata';
        $defs[ $has_x{userdata2} ]->{klen}       = 8;
        $defs[ $has_x{userdata2} ]->{struct_key} = 'userdata2';

        my $cb_type = pkg_name( $defs[ $has_x{callback} ]->{ctype} );
        $cb_type =~ s/::/__/g;
        $cb_type .= '__callback';

        $packs .= "  n->callback = &${cb_type};\n";
      }
    }

    # Check for a pascal-like string type, aka StringView
    if ( $#defs == 1 && $defs[0]->{key} eq 'data' && $defs[1]->{key} eq 'length' )
    {
      $defs[0]->{str} = 1;
      $defs[1]->{ro}  = 1;
    }

  }
  else
  {
    $preamble = qq{push \@$class\::ISA, "WebGPU::Direct::Opaque";};
  }

  if (@fns)
  {
    $prefix = $fns[0]->{prefix};
    warn "prefix is inconsistent: $prefix"
        if grep { $_->{prefix} && $_->{prefix} ne $prefix } @fns;
  }

  # Check for any specialized functions
  {
    my $class_pm = "$class_path.pm";

    if ( @fns && ! -e $class_pm )
    {
      open my $class_fh, '>', $class_pm;
      $class_fh->say("package $class\n{");
      $class_fh->say("  use v5.30;");
      $class_fh->say("  use warnings;");
      $class_fh->say("  no warnings qw(experimental::signatures);");
      $class_fh->say("  use feature 'signatures';");
      $class_fh->say("};\n\n1;");
    }

    if ( -e $class_pm )
    {
      $preamble .= "\n    require $class;";

      open my $class_fh, '<', $class_pm;
      my %subs;

      while (<$class_fh>)
      {
        if (m/sub \s* (\w+)/xms)
        {
          $subs{$1} = 1;
        }
      }

      foreach (@fns)
      {
        my %fn_def = %$_;
        if ( exists $subs{ $fn_def{name} } )
        {
          $_->{as} = "_$fn_def{name}";
        }
      }
    }
  }

  say $xs '';
  say $xs qq{MODULE = WebGPU::Direct\tPACKAGE = $class\tPREFIX = $prefix};
  say $xs '';

  my @destroys;
  if ( grep { $_->{name} eq 'release' } @fns )
  {
    push @destroys, '$_[0]->release;';
  }
  if ( grep { $_->{name} eq 'freeMembers' } @fns )
  {
    push @destroys, '$_[0]->freeMembers;';
  }

  if (@destroys)
  {
    $destroy = <<~"EOF"; my $n = qq{

        sub DESTROY
        {
          if ( \${^GLOBAL_PHASE} ne 'DESTRUCT' )
          {
            @destroys
          }
        }
    EOF
    };
  }

  if (@defs)
  {
    $types_pod->say(qq[=head1 $class\n]);
    $types_pod->say(qq[=over\n]);
    $types_pod->say(qq[=item * Attributes\n]);
    $types_pod->say(qq[=over\n]);
  }

  foreach (@defs)
  {
    my %def   = %$_;
    my %calls = calls_for( %$_, c_prefix => $c_prefix );

    next
      if $def{key} eq '';

    $packs   .= $calls{pack};
    $unpacks .= $calls{unpack};

    say_set_fn( $class, $type, %def );

    my $type = typed_pod( $def{return} );
    $types_pod->say(qq[=item * $def{key} ($type)\n]);
  }

  if (@defs)
  {
    $types_pod->say(qq[=back\n]);
    $types_pod->say(qq[=back\n]);

    my $short_class = $class;
    $short_class =~ s/WebGPU::Direct:://;

    my $default_raw = $class_defaults->{$short_class};
    my $coerce      = 'ref( $_[0] ) eq ref {} ? %{$_[0]} : @_';
    if ( $class_defaults->{ARRAY}->{$short_class} )
    {
      my @c             = ();
      my $array_default = $class_defaults->{ARRAY}->{$short_class};
      foreach my $i ( keys @$array_default )
      {
        my $n = $array_default->[$i];
        my $d = ' // 0';
        if ( exists $default_raw->{$n} )
        {
          $d = " // " . $default_raw->{$n};
        }
        push @c, "$n => \$_[0]->[$i]$d";
      }

      my $constr = join( ', ', @c );
      $coerce      = "ref( \$_[0] ) eq ref [] ? ($constr) : " . $coerce;
    }

    # StringView is special since it represents a string
    if ( $short_class eq 'StringView' )
    {
      $coerce = "(scalar \@_ == 1 && ref( \$_[0] ) eq '') ? (data => \$_[0]) : " . $coerce;
    }

    local $Data::Dumper::Trailingcomma = 1;
    local $Data::Dumper::Sortkeys      = 1;
    my $default = Data::Dumper->Dump( [ $default_raw // {} ], [qw/default/] );

    # Any scalar refs, strip the decoration and fully-qualify the call
    $default =~ s[\\'([\w\:\-\>]*)'][WebGPU::Direct::$1]g;

    say $pm <<~"EOF"; my $n = qq{
      package\n\t$class {
          $preamble
          my $default
          sub new {
              local \$SIG{__DIE__} = \\&Carp::confess;
              my \$class = shift;
              die "\$class does not inherit from $class\\n"
                if !\$class->isa("$class");
              \$class = ref(\$class) ? ref(\$class) : \$class;
              my \%params = $coerce;
              my \$result = { \%\$default, \%params };
              \$result = \$class->BUILDARGS(\$result)
                if \$class->can('BUILDARGS');
              \$result = bless( \$result, \$class );
              \$result->pack;
              return \$result;
          }
          $destroy
      }
      EOF
      };

    say $xs <<~"EOF"; $n = qq{
      void
      pack(THIS)
              SV *THIS
          PROTOTYPE: \$
          CODE:
              ${c_prefix}__pack( THIS );
              $addl_pack //

      void
      unpack(THIS)
              SV *THIS
          PROTOTYPE: \$
          CODE:
              ${c_prefix}__unpack( THIS );
              $addl_unpack //

      SV *
      bytes(THIS)
              SV *THIS
          PROTOTYPE: \$
          CODE:
              $type *n = ($type *) _get_struct_ptr(aTHX_ THIS, NULL);
              RETVAL = newSVpvn((const char *const) n, sizeof($type) );
          OUTPUT:
              RETVAL
      EOF
      };

    my $init_struct = "Newxz(n, 1, $type)";
    if ( $short_class eq 'StringView' )
    {
      $init_struct .= "; _init_strview(aTHX_ h, n)";
    }

    say $c <<~"EOF"; $n = qq{
    void ${c_prefix}__pack( SV *THIS )
    {
      ${trace_c("${c_prefix}__pack", "start")}
      if (!SvROK(THIS) || !sv_derived_from(THIS, "$class"))
      {
        croak_nocontext("%s: %s is not of type %s",
          "$class",
          "THIS", "$class");
      }

      HV *h = (HV *)SvRV(THIS);
      $type *n = ($type *) _get_struct_ptr(aTHX_ THIS, NULL);
      if ( !n )
      {
        $init_struct;
        sv_magicext((SV *)h, NULL, PERL_MAGIC_ext, NULL, (const char *)n, 0);
      }
    $packs
      ${trace_c("${c_prefix}__pack", "end")}
    }
    EOF
    };

    say $c <<~"EOF"; $n = qq{
    void ${c_prefix}__unpack( SV *THIS )
    {
      if (!SvROK(THIS) || !sv_derived_from(THIS, "$class"))
      {
        croak_nocontext("%s: %s is not of type %s",
          "$class",
          "THIS", "$class");
      }

      HV *h = (HV *)SvRV(THIS);
      $type *n = ($type *) _get_struct_ptr(aTHX_ THIS, NULL);
      if ( !n )
      {
        Newxz(n, 1, $type);
        sv_magicext((SV *)h, NULL, PERL_MAGIC_ext, NULL, (const char *)n, 0);
      }
    $unpacks
    }

    SV *${type}__wrap( const ${type} * n )
    {
      HV *h = newHV();
      SV *RETVAL = sv_2mortal(newRV((SV*)h));

      sv_magicext((SV *)h, NULL, PERL_MAGIC_ext, NULL, (const char *)n, 0);
      sv_bless(RETVAL, gv_stashpv("$class", GV_ADD));
      ${c_prefix}__unpack(RETVAL);
      return SvREFCNT_inc(RETVAL);
    }
    EOF
    EOF
    };
  }
  else
  {
    if ( !$def{fn_type} )
    {
      say $pm <<~"EOF"; my $n = qq{
        package\n\t$class {
            $preamble
            sub new {
                local \$SIG{__DIE__} = \\&Carp::croak;
                my \$class = __PACKAGE__;
                die "Cannot call new on abstract class \$class";
            }$destroy
        }
        EOF
        };
    }

    # If the def is a ptr type, that is its already a pointer inside the
    # typedef, we don't add the * here
    my $ptr = $def{ptr_type} ? '' : '*';

    say $c <<~"EOF"; my $n = qq{
    SV *${type}__wrap( ${type} $ptr n )
    {
      return _new_opaque(newSVpvs("$class"), n);
    }
    EOF
    };
  }

  if (@fns)
  {
    my $pod_file = "$class_path.pm";
    my $pm_input = '';
    {
      open my $in_pod, '<', $pod_file;
      $pm_input = do { local $/; <$in_pod> };
      $pm_input =~ s/^__END__$ .*//xms;
      $pm_input .= '__END__';
    }
    open my $pod, '>', $pod_file;
    $pod->say($pm_input);
    $pod->say("=pod\n");
    $pod->say("=encoding UTF-8\n");
    $pod->say("=head1 NAME\n");
    $pod->say("$class\n");

    $pod->say(qq[=head2 Methods\n]);
    foreach (@fns)
    {
      my %def = %$_;
      say_call_fn( \%def );

      my $type = typed_pod( $def{return} );

      $pod->say(qq[=head3 $def{name}\n]);

      # Remove the first item, which will always be $self
      my @pairs = pairs $def{args}->@*;
      shift @pairs;

      if ( $type ne 'void' || @pairs )
      {
        $pod->say(qq[=over\n]);
        if ( $type ne 'void' )
        {
          $pod->say(qq[=item * Return Type\n]);
          $pod->say(qq[=over\n]);
          $pod->say(qq[=item * $type\n]);
          $pod->say(qq[=back\n]);
        }

        if (@pairs)
        {
          $pod->say(qq[=item * Arguments\n]);
          $pod->say(qq[=over\n]);
          foreach my $pair (@pairs)
          {
            my ( $return, $arg ) = @$pair;
            my $type = typed_pod($return);
            my $default = '';

            my $short_class = $class;
            $short_class =~ s/WebGPU::Direct:://;

            my $defaults = $class_defaults->{$short_class}->{$def{name}};

            if ( exists $defaults->{$arg} )
            {
              my $def_val = $defaults->{$arg};
              $default = " Default: $def_val";
            }

            $pod->say(qq[=item * $arg ($type)$default\n]);
          }
          $pod->say(qq[=back\n]);
        }
        $pod->say(qq[=back\n]);
      }
    }
  }

  my $typemap = $typedefs{$class} eq 'obj' ? 'T_SV' : '';
  if ( $def{ptr_type} )
  {
    say $tm sprintf( "%-64s%s", $type,                  'T_FETCHPTR' );
  }
  else
  {
    say $tm sprintf( "%-64s%s", $type,                  'T_FETCH' );
    say $tm sprintf( "%-64s%s", "$type *",              'T_FETCHPTR' );
    say $tm sprintf( "%-64s%s", "$type const *",        'T_FETCHPTR' );
    say $tm sprintf( "%-64s%s", "struct $type const *", 'T_FETCHPTR' );
  }

  say $tm sprintf( "%-64s%s", $class,                 $typemap ) if $typemap;

  say $c "typedef SV* $c_prefix;";
}

# Output all of the typemaps
foreach my $typedef ( sort keys %typedefs )
{
  next
      if exists $classdefs{$typedef};

  my $typemap = tm_of($typedef);
  say $tm sprintf( "%-64s%s", $typedef,           $typemap );
  say $tm sprintf( "%-64s%s", "$typedef *",       $typemap );
  say $tm sprintf( "%-64s%s", "$typedef const *", $typemap );
}

say $tm join( "\n", @typemap );

$tm->flush;

# Load and merge the typemaps into our typemap
my $tmx = ExtUtils::Typemaps->new;
foreach my $tm_file ( standard_typemap_locations( \@INC ) )
{
  next unless -f $tm_file;

  # skip directories, binary files etc.
  next
      if !-T $tm_file;

  $tmx->merge( file => $tm_file, replace => 1 );
}

# Write out all the static callback functions
foreach my $cb_name ( sort keys %callbackdefs )
{
  my $callback = $callbackdefs{$cb_name};
  my $type     = $callback->{type};
  my $class    = $callback->{class};
  my @args     = $callback->{args}->@*;
  my $c_prefix = "${class}";

  $c_prefix =~ s/::/__/g;

  my @argdefs;
  my @keys;
  my @vals;
  my @pushs;

  my $argoff = -1;
  foreach my $pair ( pairs @args )
  {
    my ( $key, $value ) = @$pair;

    my ($type) = $key =~ m/^(?:struct\s+)?(\w+)/;
    my $pkg = pkg_name($type);

    warn "Unknown type: $type"
        if !exists $typedefs{$pkg} && !exists $typedefs{$type};

    push @argdefs, "$key $value";
    push @keys,    $key;
    push @vals,    $value;

    # userdata1 is the callback, which we don't need to supply
    if ( $value eq 'userdata1' )
    {
      next;
    }

    # userdata2 is the userdata, which we handle special
    if ( $value eq 'userdata2' )
    {
      push @pushs, "\n    XPUSHs(user_sv);";
      next;
    }

    my $outputmap = $tmx->get_outputmap( ctype => $key );
    $argoff++;

    # If we're passed a const-pointer to a normal type, we can take extra
    # steps to pass it along
    my $const_ptr;
    if ( !defined $outputmap && $key =~ m/^(\w+) \s+ const \s* [*]/xms )
    {
      $outputmap = $tmx->get_outputmap( ctype => $1 );
      $const_ptr = 1;
    }

    die "Can't find for ctype $key"
        if !defined $outputmap;

    {
      my $arg  = "tm_$value";
      my $var  = $value;
      my $type = $type;

      $type =~ tr/:/_/;

      if ($const_ptr)
      {
        $var = "*$var";
      }

      my $expr = $outputmap->cleaned_code;

      {
        local $@;
        my $pushget = eval qq{use strict; "$expr;"};
        die $@
            if $@;
        push @pushs, "\n    $c_prefix $arg = newSV(0); $pushget";
        push @pushs, "\n    XPUSHs($arg);";
      }
    }
  }

  {
    local $" = ', ';
    say $c "void ${c_prefix}__callback( @argdefs )";
  }

  # userdata1 is the CODE/CV. userdata2 is the userdata

  say $c <<~"EOF"; my $n = qq{
      {
        if ( userdata1 == NULL || !SvOK((SV *)userdata1) )
        {
          warn("Callback ${c_prefix} failed: callback function was NULL");
          return;
        }

        SV* callback = (SV *) userdata1;
        SV* user_sv  = (SV *) userdata2;

        if ( userdata2 == NULL || !SvOK(user_sv) )
        {
          user_sv = &PL_sv_undef;
        }

        if ( !SvROK(callback) )
        {
          warn("Callback ${c_prefix} failed: callback function was not a ref: %s", SvPV_nolen(callback));
          return;
        }
        if ( SvTYPE(SvRV(callback)) != SVt_PVCV )
        {
          warn("Callback ${c_prefix} failed: callback function was not a coderef: %s", SvPV_nolen(callback));
          return;
        }

        dSP;
        dTARGET;
        PUSHMARK(SP);@pushs
        PUTBACK;
        call_sv((SV *)callback, G_VOID);
      }
    EOF
    };
}

my %pages_needed;

END
{
  foreach my $page ( keys %pages_needed )
  {
    $page =~ s[::][/]g;
    if ( !-e "$Bin/../lib/$page.pm" )
    {
      warn "Does not exist: $page";
    }
  }
}

sub typed_pod
{
  my $type = shift;

  my ($as_ptr) = $type =~ m/\s*(?:const\s+)?(\w+(?:\s+const)?\s*[*])\s*$/;
  if ($as_ptr)
  {
    $as_ptr =~ s/\bconst\s*//xms;
    $as_ptr =~ s/\s+/ /g;
  }

  $type = pkg_name($type);
  $type =~ s/\s*[*]\s*$//xms;
  $type =~ s/\s*const$//xms;
  $type =~ s/\s+$//xms;

  my $result = $type;

  if ( $type =~ m/::/ )
  {
    $result = "L<$type>";
  }

  if ( $classdefs{$type} && $classdefs{$type}->{defs}->@* )
  {
    $result = "L<$type|WebGPU::Direct::Types/$type>";
  }

  if ( $enums{$type} )
  {
    my $pkg = $type;
    $pkg =~ s/^WGPU/WebGPU::Direct::/;
    $result = "L<$pkg|WebGPU::Direct::Constants/$pkg>";
  }

  if ( $type =~ m/^(\w+)Flags$/ && $enums{$1} )
  {
    my $pkg = $1;
    $pkg =~ s/^WGPU/WebGPU::Direct::/;
    $result = "L<$type|WebGPU::Direct::Constants/$pkg>";
  }

  if ( $typedefs{$type} && $typedefs{$type} eq 'CODE' )
  {
    $result = "$type (Code reference)";
  }

  my %basic_types = (
    WGPUBool => 'Boolean',
    'char *' => 'String',
    'void *' => 'Scalar',
    uint16_t => 'Unsigned 16bit',
    uint32_t => 'Unsigned 32bit',
    uint64_t => 'Unsigned 64bit',
    int32_t  => 'Signed 32bit',
    size_t   => 'Integer',
    float    => 'Float',
    double   => 'Double',
  );

  if ( exists $basic_types{$result} )
  {
    $result = $basic_types{$result} . " ($result)";
  }
  elsif ( $as_ptr && exists $basic_types{$as_ptr} )
  {
    $result = $basic_types{$as_ptr} . " ($as_ptr)";
  }

  if ( $result =~ m/L<([\w:]+)>/xms )
  {
    $pages_needed{$1} = $1;
  }

  return $result;
}

sub tm_of
{
  my $typedef = shift;

  my $typemap
      = ( $typedef =~ m/WGPU/i )  ? 'T_IV'
      : ( $typedef =~ m/_t$/ )    ? 'T_IV'
      : ( $typedef =~ m/^char$/ ) ? 'T_PV'
      :                             'T_' . uc($typedef);

  return $typemap;
}

sub calls_for
{
  my %def = @_;

  my $cast          = '';
  my $set_addl      = '';
  my $typedef = $def{typedef};
  my $return  = $def{return};

  if ( $typedef eq 'enum' || $typedef eq 'flag' )
  {
    $return = "WebGPU::Direct::$return";
    $return =~ s/::WGPU/::/;
  }

  my $is_obj_opaque = $def{typedef} eq 'obj' || $def{typedef} eq 'opaque' || $def{typedef} eq 'SV';
  my $base
      = ( $typedef eq 'obj' )    ? qq{newSVpvs("$return")}
      : ( $typedef eq 'opaque' ) ? qq{newSVpvs("$return")}
      : ( $typedef eq 'enum' )   ? qq{newSVpvs("$return")}
      : ( $typedef eq 'flag' )   ? qq{newSVpvs("$return")}
      :                                 "NULL";

  if ( $def{is_ptr} )
  {
    if ( ( $typedef eq 'obj' || $typedef eq 'enum' || $typedef eq 'opaque' ) && $def{array} )
    {
      $typedef  = "objarray";
      $set_addl = qq{, sizeof(*n->$def{key})$set_addl};
      $set_addl = qq{, &n->$def{array}Count$set_addl};
      $cast     = '(void **)';
    }
    elsif ( $typedef eq 'obj' )
    {
      $typedef = "${typedef}ptr";
      $cast    = '(void **)';
    }
  }

  if ( $typedef eq 'obj' && !$def{is_ptr} )
  {
    $set_addl = qq{, sizeof(n->$def{key})$set_addl};
  }

  if ( $typedef eq 'opaque' )
  {
    $cast = '(void **)';
  }

  if ( $def{str} )
  {
    $typedef = 'strview';
    $set_addl = qq{, &n->length$set_addl};
  }

  my %result = (
    pack    => '',
    unpack  => '',
    store   => '',
    find    => '',
    set     => '',
    typedef => undef,
  );

  if ( !$is_obj_opaque && $def{ctype} ne 'char' && $def{is_ptr} && !$def{array} )
  {
    my $warning = qq{  // "$def{key}" is a ptr type $def{ctype}, and that's not quite right yet, using opaque\n};
    $result{pack}   .= $warning;
    $result{unpack} .= $warning;
    $result{store}  .= $warning;
    $result{find}   .= $warning;
    $result{set}    .= $warning;

    $typedef = 'void';
    $cast    = '(void **)';
  }

  my $c_prefix = $def{c_prefix} // '';
  my $struct_key = $def{struct_key} // $def{key};
  $result{pack}   .= ${ trace_c( "${c_prefix}__pack",   "pack $struct_key" ) };
  $result{unpack} .= ${ trace_c( "${c_prefix}__unpack", "unpack $struct_key" ) };

  my $call     = qq{aTHX_ h, "$def{key}", $def{klen}, $cast &n->${struct_key}$set_addl, $base};
  my $set_call = qq{aTHX_ value,/**/ (void *) &n->${struct_key}$set_addl, $base};

  $result{pack}   .= qq{  _pack_$typedef($call);\n};
  $result{unpack} .= qq{  _unpack_$typedef($call);\n};
  $result{store}  .= qq{  _store_$typedef($call, value);\n};
  $result{find}   .= qq{  _find_$typedef($call);\n};
  $result{set}    .= qq{  _set_$typedef($set_call);\n};

  $result{typedef} = $typedef;

  if ( $def{ro} )
  {
    $result{pack} = '';
  }

  return %result;
}

sub say_set_fn
{
  my $class = shift;
  my $type  = shift;
  my %def   = @_;

  my %calls = calls_for( %def, c_prefix => $class );

  my $typedef  = $calls{typedef};
  my $ret_type = $def{return};
  my $is_ptr   = ( $def{ctype} ne 'char' && $def{is_ptr} );
  my $is_obj   = ( $typedef eq 'obj' || $typedef eq 'void' );
  my $is_ro    = $def{ro};
  my $is_arr   = $def{array};

  my $val_type
      = $is_ptr ? "SV *"
      : $is_obj ? "$def{return}"
      :           "SV *";

  if ($is_ptr)
  {
    $val_type = 'SV *';
    $ret_type = 'SV *';
  }

  my $mut = 'SvREFCNT_inc(RETVAL);';
  if ( !$is_ro )
  {
    $mut = <<~"EOF"; my $n = qq{
    if (items > 1)
            {
                $calls{store}
            }
            else
            {
                SvREFCNT_inc(RETVAL);
            }
    EOF
    };
  }

  say $xs <<~"EOF"; my $n = qq{
    SV *
    $def{key}(THIS, value = NO_INIT)
            $class THIS
            $val_type value
        PROTOTYPE: \$;\$
        CODE:
            HV *h = (HV *)SvRV(THIS);
            $type *n = ($type *) _get_struct_ptr(aTHX_ THIS, NULL);
            RETVAL = $calls{find}
            $mut

        OUTPUT:
            RETVAL
    EOF
    };
}

sub say_call_fn
{
  my $def_arg = shift;
  my %def     = %$def_arg;

  # 0b001: has offset
  # 0b010: has size
  # 0b100: is a MappedBuffer return
  my $has_mb = 0;

  # Handle certain aspects in a perl-ish way
  my @defargs = $def{args}->@*;

  my %arrays;
  my $array_can;
  my %buffers;
  my $buffer_can;

  foreach my $i ( 0 .. @defargs )
  {
    next
        unless $i % 2;

    my $key   = $defargs[$i];
    my $value = $defargs[ $i - 1 ];

    # Check if this has size and offset for MappedBuffer
    if ( $key eq 'size' && !( $has_mb & 0x2 ) )
    {
      $has_mb |= 0x2;
    }

    if ( $key eq 'offset' && !( $has_mb & 0x1 ) )
    {
      $has_mb |= 0x1;
    }

    # Check for array parameters
    if ( $value eq 'size_t' && $key =~ m/$arrcnt_re/ )
    {
      $array_can = $1;
      next;
    }
    if ( $array_can && $key =~ $arrnme_re && $1 eq $array_can )
    {
      $arrays{$array_can} = $value;
    }

    # Check for data buffer parameters
    if ( $value ne 'size_t' && $key =~ m/$bufnme_re/ )
    {
      $buffer_can = $key;
      next;
    }
    if ( $buffer_can && $key =~ $bufcnt_re )
    {
      $buffers{$buffer_can} = $key;
      $buffers{$key}        = $buffer_can;
    }

    undef $array_can;
    undef $buffer_can;
  }

  my @args;
  my @keys;
  my @vals;
  my @unpacks;
  foreach my $pair ( pairs @defargs )
  {
    my ( $key, $value ) = @$pair;

    my ($type) = $key =~ m/^(\w+)/;
    my $pkg = pkg_name($type);

    warn "Unknown type: $type"
        if !exists $typedefs{$pkg} && !exists $typedefs{$type};

    # Handle the array cases
    if ( $value =~ $arrcnt_re && exists $arrays{$1} )
    {
      next;
    }
    if ( $value =~ $arrnme_re && exists $arrays{$1} )
    {
      $key = 'AV *';
    }

    # Handle the data buffer cases
    if ( $value =~ $bufnme_re && exists $buffers{$value} )
    {
      $key = 'SV *';
    }
    if ( $value =~ $bufcnt_re && exists $buffers{$value} )
    {
      next;
    }

    if ( $typedefs{$pkg} eq 'obj' && $key !~ m/const/ )
    {
      # We have to count ST so that we can call it on the original SV arg
      push @unpacks, scalar @keys;
    }

    push @args, "$key $value";
    push @keys, "$key";
    push @vals, "$value";
  }

  my $fn_name = $def{as} // $def{name};
  my $return  = $def{return};

  if ( $return =~ m[^void \s* [*] \s* $ ]xms && $has_mb > 0x2 )
  {
    $has_mb |= 0x4;
    $return = 'SV *';
  }

  my @calls = @vals;

  {
    my $class = $def{prefix};
    $class =~ s/^wgpu//;

    # Using $fn_name instead of $def{name} since if there is an override
    # included (aka _$def{name}), prefer adding the default in the perl space
    # but leave them for generated documentation to use
    my $defaults = $class_defaults->{$class}->{$fn_name};

    foreach my $val (@vals)
    {
      if ( exists $defaults->{$val} )
      {
        $val .= ' = ' . $defaults->{$val};
      }
    }
  }

  local $" = ', ';
  say $xs "";
  say $xs "$return";
  say $xs "$def{prefix}$fn_name(@vals)";
  foreach (@args)
  {
    say $xs "        $_";
  }

  say $xs "    CODE:";

  if ( keys %arrays || keys %buffers )
  {
    foreach my $array ( sort keys %arrays )
    {
      my $type = $arrays{$array};
      die $type if $type !~ m/[*]$/;
      $type =~ s/[*]$//;
      $type =~ s/const//;

      my $cast = "($type)";
      my $class = $classdefs{pkg_name($type)};
      if ( $class && !$class->{ptr_type} )
      {
        $cast = "*($type *)";
      }

      my $fetch = "$cast _get_struct_ptr(aTHX_ *item, NULL)";
      if ( $type =~ m/^\s*uint\d+_t\s*$/xms )
      {
        $fetch = "SvIV(*item)";
      }

      say $xs <<~"EOF"; my $n = qq{
              Size_t ${array}Count = av_count(${array}s);
              $type $array\[${array}Count+1];
              for ( Size_t i = 0; i < ${array}Count; i++ )
              {
                SV **item = av_fetch(${array}s, i, 0);
                if ( *item != NULL )
                {
                  $type n = $fetch;
                  $array\[i] = n;
                }
              }
        EOF
        };

      if ( $class && $class->{ptr_type} )
      {
        say $xs "      $array\[${array}Count+1] = ($type) 0;";
      }

      @calls = map { $_ eq "${array}s" ? ( "${array}Count", $array ) : $_ } @calls;
    }

    foreach my $buffer ( sort keys %buffers )
    {
      next
          if $buffer =~ m/size/i;

      my $type = $buffers{$buffer};
      $type =~ s/[*]$//;
      $type =~ s/const//;

      say $xs <<~"EOF"; my $n = qq{
              STRLEN ${buffer}Size;
              const char *${buffer}Data = SvPV_const(${buffer}, ${buffer}Size);
        EOF
        };

      @calls = map { $_ eq "${buffer}" ? ( "${buffer}Data", "${buffer}Size" ) : $_ } @calls;
    }
  }

  my $call   = join( ', ', @calls );
  my $retval = $return =~ m/^void\s*$/ ? '' : 'RETVAL = ';

  if ( $has_mb > 0x6 )
  {
    if ( !$has_mb & 0x1 )
    {
      say $xs "      Size_t offset = 0;";
    }
    say $xs "      void *n = $def{c_name}($call);";
    say $xs "      RETVAL =  WebGPU__Direct__MappedBuffer__wrap(aTHX_ n, size-offset);";
    $def_arg->{return} = 'MappedBuffer';
  }
  else
  {
    say $xs "      $retval$def{c_name}($call);";
  }

  foreach my $unpack (@unpacks)
  {
    say $xs "      {";
    say $xs "        SV *u = ST($unpack);";
    say $xs "        if ( sv_isobject(u) ) { _unpack(u); }";
    say $xs "      }";
  }

  if ($retval)
  {
    say $xs "    OUTPUT:";
    say $xs "      RETVAL";
  }
  say $xs "";
}

say $pm q{1;};

warn Data::Dumper::Dumper( \%typedefs );

sub find_header
{
  use File::Find qw//;

  my $result;
  my $find = sub
  {
    if (m/^webgpu[.]h$/xms)
    {
      die "Found more than one webgpu.h"
        if $result;
      $result = $File::Find::name;
    }

    if ( m/git-tag/xms )
    {
      open my $gittag_fh, '<', $_;
      open my $versio_fh, '>', "$Bin/../webgpu-version";
      $versio_fh->print( <$gittag_fh> );
    }
  };
  File::Find::find( $find, "$Bin/../webgpu/" );
  return $result;
}

1;
