LLVM IR からバイナリを生成するための Perl スクリプト

以下のリンクの続き。
副産物として Perl スクリプトをコンパイルしてくれる Perl スクリプトを作成した。

codehex.hateblo.jp

これは Mac 限定で動く。

#!/usr/bin/env perl

use strict;
use warnings;

package Compiler {
    use Moo;
    use Carp 'croak';
    use Fcntl qw(:flock);
    use File::Basename;

    use Compiler::Lexer;
    use Compiler::Parser;
    use Compiler::CodeGenerator::LLVM;

    has lexer => (
        is => 'ro',
        lazy => 1,
        default => sub { Compiler::Lexer->new }
    );

    has parser => (
        is => 'ro',
        lazy => 1,
        default => sub { Compiler::Parser->new }
    );

    has generator => (
        is => 'ro',
        lazy => 1,
        default => sub { Compiler::CodeGenerator::LLVM->new }
    );
    
    has _get_osx_version => (
        is => 'ro',
        default => sub {
            chomp(my $osx_version = `defaults read loginwindow SystemVersionStampAsString`);
            return $osx_version;
        }
    );

    sub tokenize {
        my ($self, $script) = @_;
        return $self->lexer->tokenize($script);
    }

    sub parse {
        my ($self, $tokens) = @_;
        return $self->parser->parse($tokens);
    }

    sub compile {
        my ($self, $filename) = @_;
        my $script = $self->_read($filename);
        my $tokens = $self->tokenize($script);
        my $ast = $self->parse($tokens);
        my $llvm_ir = $self->generator->generate($ast);

        my $trimmed_filename = $self->_trim_filename($filename);
        $self->_write("${trimmed_filename}.ll", $llvm_ir);
        $self->_create_object($trimmed_filename);
        $self->_link_object($trimmed_filename);
    }

    sub _create_object {
        my ($self, $trimmed_filename) = @_;
        system "llc ${trimmed_filename}.ll -march=x86-64 -filetype=obj -o=${trimmed_filename}.o";
    }

    sub _link_object {
        my ($self, $trimmed_filename) = @_;
        my $osx_version = $self->_get_osx_version;
        system "ld -arch x86_64 -macosx_version_min $osx_version ${trimmed_filename}.o -lSystem -o $trimmed_filename";
    }

    sub _trim_filename {
        my ($self, $filename) = @_;
        my $basename = basename($filename);
        return $basename =~ s/\.[^.]+$//r;
    }

    sub _write {
        my ($self, $filename, $content) = @_;

        open my $fh, ">", $filename or croak "Failed to open a $filename";
        flock $fh, LOCK_EX or croak "Failed to lock a $filename";
        print $fh $content;
        flock $fh, LOCK_UN or croak "Failed to unlock a $filename";
        close $fh;
    }

    sub _read {
        my ($self, $filename) = @_;

        open my $fh, "<", $filename or croak "Failed to open a $filename";
        flock $fh, LOCK_EX or croak "Failed to lock a $filename";
        my $script = do { local $/, <$fh> };
        flock $fh, LOCK_UN or croak "Failed to unlock a $filename";
        close $fh;

        return $script;
    }

    __PACKAGE__->meta->make_immutable;
};


Compiler->new->compile($ARGV[0]);

参考として次のような Perl スクリプトを用意する。

#!/usr/bin/env perl

sub fib {
    if ($_[0] < 2) {
        return 1;
    }
    return fib($_[0] - 1) + fib($_[0] - 2);
}

say fib(35);

これを fib.pl と名付ける。先ほどのスクリプトを compile.pl とした場合

perl compile.pl fib.pl

と実行が可能である。