#!/usr/bin/perl
package Blondie::Backend::C;
use base qw/Blondie::Runtime Blondie::Reducer::DynamicScoping/;
use strict;
use warnings;
use UNIVERSAL::require;
use Blondie::TypeSafe ();
use Blondie::Backend::C::Builtins;
sub run {
my $self = shift;
my $prog = shift;
my $c = $self->compile($prog);
my $type_annotated = $self->annotate($c);
my $c_code = $self->emit($type_annotated);
my $main = $self->bind($c_code);
$main->();
}
sub annotator_class { "Blondie::TypeSafe::Annotator" }
sub annotator {
my $self = shift;
#$self->annotator_class->require || die $UNIVERSAL::require::ERROR;
$self->annotator_class->new;
}
sub annotate {
my $self = shift;
$self->annotator->annotate($self, @_);
}
sub emitter_class { "Blondie::Backend::C::Emitter" }
sub emitter {
my $self = shift;
$self->emitter_class->require || die $UNIVERSAL::require::ERROR;
$self->emitter_class->new;
}
sub emit {
my $self = shift;
$self->emitter->emit(@_);
}
my %cache;
sub bind {
my $self = shift;
my $c_code = shift;
my $digest = Digest->new("SHA-1");
$digest->add($c_code);
my $sha1 = $digest->digest;
$cache{$sha1} ||= $self->generate_inline_c($c_code);
}
my $i;
sub generate_inline_c {
my $self = shift;
my $c_code = shift;
my %table = (
IV => "int",
PV => "char *",
);
$c_code =~ s/^([GIP]V) b_main/$table{$1} b_main/m;
$c_code =~ s/([GIP]V)/blondie_$1/g;
$c_code =~ s/int main \(\) {.*?}//;
my $func = eval sprintf <<'BIND', __PACKAGE__, ++$i;
package %s::inline_bindings::%d;
use Inline C => Config => LIBS => "-lgc"; # http://www.hpl.hp.com/personal/Hans_Boehm/gc/
Inline->bind(C => $c_code); # marble losing routine
\&b_main;
BIND
die $@ if $@;
return $func;
}
sub compile_to_c {
my $self = shift;
my $compiled = $self->compile(@_);
warn "compiled: $compiled";
my $safe = $self->annotate($compiled);
$self->emit($safe);
}
sub provides {
my $self = shift;
my $node = shift;
Blondie::Backend::C::Builtins->find($node->digest || return);
}
sub cast_node_type {
my $self = shift;
my $node = shift;
my $from = shift->type;
my $to = shift->type;
Blondie::TypeSafe::Annotation->new(
type => $to,
struct_equiv => Blondie::App->new(
Blondie::TypeSafe::Annotation->new(
type => [$from => $to],
struct_equiv => Blondie::Val->new(
Blondie::TypeSafe::Annotation->new(
type => [$from => $to],
struct_equiv => Blondie::Backend::C::Prim->new(
arity => 1,
body => "type_convert_${from}_${to}",
type => [$from => $to],
),
),
),
),
(ref $node)->new(
%$node,
orig => Blondie::Val->new($node->orig),
),
),
orig => $node->orig,
);
}
__PACKAGE__;
__END__
=pod
=head1 NAME
Blondie::Backend::C -
=head1 SYNOPSIS
use Blondie::Backend::C;
=head1 DESCRIPTION
=cut