view release on metacpan or  search on metacpan

lib/Text/Treesitter/Language.pm  view on Meta::CPAN

C<Text::Treesitter::Language> - represents a F<tree-sitter> language grammar

=head1 SYNOPSIS

Usually accessed indirectly, via C<Text::Treesitter>. Can also be used
directly.

   use Text::Treesitter::Language;

   my $language_lib = "path/to/the/tree-sitter-perl.so";

   my $lang = Text::Treesitter::Language::load( $language_lib, "perl" );

   printf "This language defines %d symbols\n", $lang->symbol_count;

=head1 DESCRIPTION

Instances of this class represent an entire language grammar specification.
Typically an application will load just one of these for the lifetime of its
operation; or at least, just one per type of language being parsed.

=cut

=head1 UTILITY FUNCTIONS

These utility functions are not exported, and must be called fully-qualified.

=cut

=head2 build

   Text::Treesitter::Language::build( $output, @dirs );

Requests that a language grammar repository directory (or several) be compiled
into an object file that can later be loaded.

=cut

# We -could- use ExtUtils::CBuilder but that's intended for building
# specifically to link against perl, and it won't cope with the C++ version
# of the final link step

use Config;
use constant CC => $Config::Config{cc};

{
   my $guess;

   my @CXX_compile;
   sub CXX_compile
   {
      return @CXX_compile if @CXX_compile;

      require ExtUtils::CppGuess;
      $guess //= ExtUtils::CppGuess->new;
      my %opts = $guess->module_build_options;

      return @CXX_compile = ( $opts{config}{cc},
         # $opts{extra_compiler_flags} might begin with a space
         split m/ +/, $opts{extra_compiler_flags} =~ s/^ +//r,
      );
   }

   my @CXX_link;
   sub CXX_link
   {
      return @CXX_link if @CXX_link;

      require ExtUtils::CppGuess;
      $guess //= ExtUtils::CppGuess->new;
      my %opts = $guess->module_build_options;

      return @CXX_link = ( $opts{config}{cc},
         # $opts{extra_linker_flags} might begin with a space
         split m/ +/, $opts{extra_linker_flags} =~ s/^ +//r,
      );
   }
}

sub _compile
{
   my ( $source ) = @_;
   my $is_cpp = $source =~ m/\.cc$/;

   my $output = $source =~ s/\.cc?$/.o/r;

   my @args = ( $is_cpp ? CXX_compile : CC,
      "-o", $output,
      "-fPIC",
      "-c", $source,
   );

   push @args, "-ggdb";

   print join( " ", @args ), "\n";
   system( @args ) == 0 or
      die "Unable to $args[0] - $?\n";

   return $output;
}

sub _link
{
   my ( $output, $is_cpp, @objects ) = @_;

   my @args = ( $is_cpp ? CXX_link : CC,
      "-o", $output,
      "-shared",
      @objects,
   );

   print join( " ", @args ), "\n";
   system( @args ) == 0 or
      die "Unable to $args[0] - $?\n";

   return $output;
}

sub build
{
   my ( $output, @dirs ) = @_;

   my $is_cpp = 0;
   my @objects;

   foreach my $dir ( @dirs ) {
      my $srcdir = "$dir/src";

      unless( -f "$srcdir/parser.c" ) {
         die "Expected a parser.c within $srcdir\n";
      }

      push @objects, _compile( "$srcdir/parser.c" );

      if( -f "$srcdir/scanner.c" ) {