package macro::compiler;

use strict;
use warnings;

BEGIN{
	require macro;
	our @ISA = qw(macro);

	*VERSION = *macro::VERSION;
}

sub import{
	my $class = shift;

	return unless @_;

	my $file = do{
		my $i = 0;
		my($pkg, $file) = (caller($i))[0, 1];
		while($pkg->isa('macro')){
			($pkg, $file) = (caller(++$i))[0, 1]
		}
		$file;
	};

	if($^C){
		warn "Compiling $file by $class/$macro::VERSION ...\n";
	}

	my $self  = $class->new();

	$self->defmacro(@_);

	open my $fh, '<:perlio', $file
		or die qq{Cannot open "$file" for reading: $!};

	my $src = <$fh>;
	$src .= $self->_sign($file);
	{ local $/; $src .= <$fh> };
	close $fh;

	$src = $self->process($src);

	open $fh, '>:perlio', $file.'c'
		or die qq{Cannot open "${file}c" for writing: $!};

	print $fh $src
		or die qq{Cannot write to "${file}c": $!};

	close $fh
		or die qq{Cannot close "${file}c: $!};

	if($^C){
		exit;
	}
	else{
		require macro::filter;
		macro::filter->import(@_);
	}

	return;
}

# called from process();

sub preprocess{
	my($self, $d) = @_;

	# comment out 'use macro ...' statement
	$d->prune(\&_want_use_macro);
	warn $@ if $@;

	return $d;
}
sub _want_use_macro{
	my(undef, $it) = @_;
	my $elem;

	if($it->isa('PPI::Statement::Include')

		&& ($elem = $it->schild(0))
		&& ($elem->content eq 'use')

		&& ($elem = $elem->snext_sibling)
		&& ($elem->content eq __PACKAGE__ or $elem->content eq 'macro')){

		my $stmt = $it->content;
		$stmt =~ s/^/# /msxg;
		$it->__insert_before( PPI::Token::Comment->new($stmt) );

		return 1;
	}
	return 0;
}

sub _sign{
	my($self, $file) = @_;
	my $pkg = ref($self);
	return <<"SIGN";
# It was generated by $pkg version $macro::VERSION.
# Don't edit this file, edit $file instead.
# ANY CHANGES MADE HERE WILL BE LOST!
# line 4 $file
SIGN
}

1;

__END__

=head1 NAME

macro::compiler - macro.pm compiler backend

=head1 SYNOPSIS

	use macro::compiler add => sub{ $_[0] + $_[1] };

=head1 AUTHOR

Goro Fuji E<lt>gfuji(at)cpan.orgE<gt>.

=head1 LICENSE AND COPYRIGHT

Copyright (c) 2008, Goro Fuji E<lt>gfuji(at)cpan.orgE<gt>. Some rights reserved.

This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=cut

