File Coverage

blib/lib/Wasm.pm

Criterion	Covered	Total	%
statement	160	166	96.3
branch	60	80	75.0
condition	14	21	66.6
subroutine	13	13	100.0
pod			n/a
total	247	280	88.2

package Wasm;

use strict;
use warnings;
use 5.008004;
use Ref::Util qw( is_plain_arrayref );
use Carp ();
use Wasm::Trap;

# ABSTRACT: Write Perl extensions using Wasm
our $VERSION = '0.23'; # VERSION


our %WASM;
my $linker;
my %inst;
my %pp;
my $wasi;
my @keep;

sub _linker
{
  require Wasm::Wasmtime;
  $linker ||= do {
    my $linker = Wasm::Wasmtime::Linker->new(
      Wasm::Wasmtime::Store->new(
        Wasm::Wasmtime::Engine->new(
          Wasm::Wasmtime::Config
            ->new
            ->wasm_multi_value(1)
            ->cache_config_default,
        ),
      ),
    );
    $linker->allow_shadowing(0);
    $linker;
  };
}

sub import
{
  my $class = shift;
  my($caller, $fn) = caller;

  return unless @_;

  if(defined $_[0] && $_[0] ne '-api')
  {
    Carp::croak("You MUST specify an api level as the first option");
  }

  my $api;
  my $exporter;
  my @module;
  my $package = $caller;
  my $file    = $fn;

  my @global;

  while(@_)
  {
    my $key = shift;
    if($key eq '-api')
    {
      if(defined $api)
      {
        Carp::croak("Specified -api more than once");
      }
      $api = shift;
      unless(defined $api && $api == 0)
      {
        Carp::croak("Currently only -api => 0 is supported");
      }
    }
    elsif($key eq '-wat')
    {
      my $wat = shift;
      Carp::croak("-wat undefined") unless defined $wat;
      @module = (wat => $wat);
    }
    elsif($key eq '-file')
    {
      my $path = shift;
      unless(defined $path && -f $path)
      {
        $path = 'undef' unless defined $path;
        Carp::croak("no such file $path");
      }
      $file = "$path";
      @module = (file => $file);
    }
    elsif($key eq '-self')
    {
      require Path::Tiny;
      my $perl_path = Path::Tiny->new($fn);
      my $basename = $perl_path->basename;
      $basename =~ s/\.(pl|pm)$//;
      my @maybe = sort { $b->stat->mtime <=> $a->stat->mtime } grep { -f $_ } (
        $perl_path->parent->child($basename . ".wasm"),
        $perl_path->parent->child($basename . ".wat"),
      );
      if(@maybe == 0)
      {
        Carp::croak("unable to find .wasm or .wat file relative to Perl source");
      }
      else
      {
        $file = shift @maybe;
        @module = (file => $file);
      }
    }
    elsif($key eq '-exporter')
    {
      $exporter = shift;
    }
    elsif($key eq '-package')
    {
      $package = shift;
    }
    elsif($key eq '-global')
    {
      if(is_plain_arrayref $_[0])
      {
        push @global, shift;
      }
      else
      {
        Carp::croak("-global should be an array reference");
      }
    }
    elsif($key eq '-imports')
    {
      Carp::croak("-imports was removed in Wasm.pm 0.08");
    }
    else
    {
      Carp::croak("Unknown Wasm option: $key");
    }
  }

  _linker();

  if(@global)
  {
    Carp::croak("Cannot specify both Wasm and -global") if @module;
    foreach my $spec (@global)
    {
      my($name, $content, $mutability, $value) = @$spec;
      my $global = Wasm::Wasmtime::Global->new(
        $linker->store,
        Wasm::Wasmtime::GlobalType->new($content, $mutability),
        $value,
      );
      no strict 'refs';
      *{"${package}::$name"} = $global->tie;
      $pp{$package} = $file;
    }
    return;
  }

  @module = (wat => '(module)') unless @module;

  Carp::croak("The wasm_ namespace is reserved for internal use") if $package =~ /^wasi_/;
  Carp::croak("Wasm for $package already loaded") if $inst{$package};

  my $module = Wasm::Wasmtime::Module->new($linker->store->engine, @module);

  foreach my $import (@{ $module->imports })
  {

    my $module = $import->module;

    if($module =~ /^(wasi_unstable|wasi_snapshot_preview1)$/)
    {
      next if $WASM{$module};
      $linker->define_wasi(
        $wasi ||= Wasm::Wasmtime::WasiInstance->new(
          $linker->store,
          $module,
          Wasm::Wasmtime::WasiConfig
            ->new
            ->set_argv($0, @ARGV)
            ->inherit_env
            ->inherit_stdin
            ->inherit_stdout
            ->inherit_stderr
            ->preopen_dir("/", "/"),
        )
      );
      $WASM{$module} = __FILE__;  # Maybe Wasi::Snapshot::Preview1 etc.
      next;
    }

    if($module ne 'main' && !$inst{$module} && !$pp{$module})
    {
      my $pm = "$module.pm";
      $pm =~ s{::}{/}g;
      eval { require $pm };
      if(my $error = $@)
      {
        $error =~ s/ at (.*?)$//;
        $error .= " module required by WebAssembly at $file";
        Carp::croak("$error");
      }
    }

    next if $inst{$module};

    my $name = $import->name;
    my $type = $import->type;
    my $kind = $type->kind;

    my $extern;

    if($kind eq 'functype')
    {
      if(my $f = $module->can("${module}::$name"))
      {
        $extern = Wasm::Wasmtime::Func->new(
          $linker->store,
          $type,
          $f,
        );
        push @keep, $extern;
      }
    }
    elsif($kind eq 'globaltype')
    {
      if(my $global = do { no strict 'refs'; tied ${"${module}::$name"} })
      {
        $extern = $global;
      }
    }

    if($extern)
    {
      # TODO: check that the store is the same?
      eval {
        $linker->define(
          $module,
          $name,
          $extern,
        );
      };
      if(my $error = $@)
      {
        if(Wasm::Wasmtime::Error->can('new'))
        {
          # TODO: if we can do a get on the define that would
          # be better than doing this regex on the diagnostic.
          # this is available in the rust api, but not the c api
          # as of this writing.
          die $error unless $error =~ /defined twice/;
        }
        else
        {
          # TODO: also for the prod version of wasmtime we don't
          # have an error so we end up swallowing other types
          # of errors, if there are any.
        }
      }
    }
  }

  my $instance = $inst{$package} = $linker->instantiate($module);
  $linker->define_instance($package, $instance);
  $WASM{$package} = "$file";

  my @me = @{ $module->exports   };
  my @ie = @{ $instance->exports };

  my @function_names;

  for my $i (0..$#ie)
  {
    my $exporttype = $me[$i];
    my $name = $me[$i]->name;
    my $externtype = $exporttype->type;
    my $extern = $ie[$i];
    my $kind = $extern->kind;
    if($kind eq 'func')
    {
      my $func = $extern;
      $func->attach($package, $name);
      push @function_names, $name;
    }
    elsif($kind eq 'global')
    {
      my $global = $extern;
      no strict 'refs';
      *{"${package}::$name"} = $global->tie;
    }
    elsif($kind eq 'memory')
    {
      require Wasm::Memory;
      my $memory = Wasm::Memory->new($extern);
      no strict 'refs';
      *{"${package}::$name"} = \$memory;
    }
  }

  if($exporter)
  {
    require Exporter;
    no strict 'refs';
    push @{ "${package}::ISA"       }, 'Exporter';
    if($exporter eq 'all')
    {
      push @{ "${package}::EXPORT" }, @function_names;
    }
    else
    {
      push @{ "${package}::EXPORT_OK" }, @function_names;
    }
  }
}

1;

__END__