Inline::BC - Inline ILSM for bc the arbitrary precision math Language

  use Inline BC;
  print x(int(rand(time())));
  __DATA__
  __BC__
  define x(a){
    scale = 20;
    return (a*3.456789);
  }

  use Inline BC => "DATA",
             MATH_LIB => 1,
             FILTERS  => [ qw(Strip_POD) ];

  my $r = bc_sinh(4.712);

  __END__

  __BC__
  =head1 BC Functions

  The following functions are defined in GNU bc language.

  =cut

  /*************************************/
  =pod

  Function Name: bc_sinh(x)
  Description  : Calculates the hyperbolic sine of real value x.
  Return       : The calculated result with 12 fractional decimal
               : digits of precision.

  =cut

  /*************************************/
  define bc_sinh (u) {
    scale = 12
    t = (e(u) - e(-u)) * 0.5
    return ( t )
  }

 man bc
 perldoc Inline
 perldoc Inline::Filters

package Inline::BC;
use strict;
use Carp;
require Inline;
require DynaLoader;
require Exporter;
use vars qw(@ISA $VERSION @EXPORT_OK $RUN_ONCE);
use vars qw($RE_balanced_brackets $RE_balanced_parens);
use vars qw($use_math_lib);

$use_math_lib = 0;    # assume BC's math library is not required
$VERSION      = '0.08';
@ISA = qw(Inline DynaLoader Exporter);

use Cwd qw(abs_path); 

use Data::Dumper;

my @export_ok = qw(bc_init bc_parse bc_run);

#==============================================================================
# lots of this code has been shamelessly stolen from Inline::Ruby :-)
#==============================================================================

sub dl_load_flags { 0x01 }
eval_support_code();


#==============================================================================
# Prep the BC interpreter
#==============================================================================
sub eval_support_code{
    return if $RUN_ONCE;
    Inline::BC->bootstrap($VERSION);
}



#==============================================================================
# Register BC.pm as a valid Inline language
#==============================================================================
sub register {
    return {
            language => 'BC',
            aliases => ['bc', 'Bc'],
            type => 'interpreted',
            suffix => 'bc',
           };
}

#==============================================================================
# Validate the BC config options
#==============================================================================
sub validate {
    my $o = shift;

    $o->{ILSM} ||= {};
    $o->{ILSM}{FILTERS} ||= [];
    $o->{ILSM}{built} ||= 0;
    $o->{ILSM}{loaded} ||= 0;
    
    $o->{ILSM}{bindto} = [qw(functions)];

    while (@_) {
	my ($key, $value) = (shift, shift);

	if ($key eq 'FILTERS') {
	    next if $value eq '1' or $value eq '0'; # ignore ENABLE, DISABLE
	    $value = [$value] unless ref($value) eq 'ARRAY';
	    my %filters;
	    for my $val (@$value) {
		if (ref($val) eq 'CODE') {
		    $o->add_list($o->{ILSM}, $key, $val, []);
	        }
		else {
		    eval { require Inline::Filters };
		    croak "'FILTERS' option requires Inline::Filters to be installed."
		      if $@;
		    %filters = Inline::Filters::get_filters($o->{API}{language})
		      unless keys %filters;
		    if (defined $filters{$val}) {
			my $filter = Inline::Filters->new($val, 
							  $filters{$val});
			$o->add_list($o->{ILSM},
				     $key,
				     [ $filter ],
				     [ ]);
		    }
		    else {
			croak "Invalid filter $val specified.";
		    }
		}
	    }
	}
	elsif ($key eq 'MATH_LIB') {
	    croak "Invalid value specified for config option 'MATH_LIB'"
	        if ($value ne '1' and $value ne '0');

	    if ($RUN_ONCE) {
	        if ($value ne $use_math_lib) {
		    warn("The BC interpreter was initialised with option ",
			 "MATH_LIB => $use_math_lib.\n",
			 "Any subsequent use of option 'MATH_LIB' will ",
			 "have no effect.\n");
		}
	    }
	    else {
	        $use_math_lib = $value;
	    }
	}
	else {
	    croak "$key is not a valid config option for BC";
	}
    }

    # Ensure the BC interpreter is initialised only once!
    unless ($RUN_ONCE) {
        bc_init( $use_math_lib );
	$RUN_ONCE = 1;
    }
}


sub usage_validate {
    return "Invalid value for config option $_[0]";
}


sub add_list {
    my $o = shift;
    my ($ref, $key, $value, $default) = @_;
    $value = [$value] unless ref $value;
    croak usage_validate($key) unless ref($value) eq 'ARRAY';
    for (@$value) {
	if (defined $_) {
	    push @{$ref->{$key}}, $_;
	}
	else {
	    $ref->{$key} = $default;
	}
    }
}


#==========================================================================
# Print a short information section if PRINT_INFO is enabled.
#==========================================================================
sub info {
    my $o = shift;
    my $info =  "";

    $o->build unless $o->{ILSM}{built};

    my @functions = @{$o->{ILSM}{namespace}{functions}||[]};
    $info .= "The following BC functions have been bound to Perl:\n"
      if @functions;
    for my $function (sort @functions) {
	$info .= "\tdefine $function()\n";
    }

    $info .= "\nThe BC math library has been loaded.\n" if ($use_math_lib);

    return $info;
}


#==========================================================================
# Run the code, study the main namespace, and cache the results.
#==========================================================================
sub build {
    my $o = shift;
    return if $o->{ILSM}{built};

    # Filter the code
    $o->{ILSM}{code} = $o->filter(@{$o->{ILSM}{FILTERS}});

    my $code = $o->{ILSM}{code};

    # get the function signatures
    # These regular expressions were derived from Regexp::Common v0.01.
    my $RE_comment_C   = q{(?:(?:\/\*)(?:(?:(?!\*\/)[\s\S])*)(?:\*\/))};
    my $RE_comment_Cpp = q{(?:\/\*(?:(?!\*\/)[\s\S])*\*\/|\/\/[^\n]*\n)};
    my $RE_quoted      = (q{(?:(?:\")(?:[^\\\"]*(?:\\.[^\\\"]*)*)(?:\")}
                        .q{|(?:\')(?:[^\\\']*(?:\\.[^\\\']*)*)(?:\'))});
    $RE_balanced_brackets =
        qr'(?:[{]((?:(?>[^{}]+)|(??{$RE_balanced_brackets}))*)[}])';
    $RE_balanced_parens   =
        qr'(?:[(]((?:(?>[^()]+)|(??{$RE_balanced_parens}))*)[)])';

    # First, we crush out anything potentially confusing.
    # The order of these _does_ matter.
    $code =~ s/$RE_comment_C/ /go;
    $code =~ s/$RE_comment_Cpp/ /go;
    $code =~ s/^\#.*(\\\n.*)*//mgo;
    $code =~ s/^[\n\s]+//s;
    $code =~ s/[\s\n]+$//s;
    $code =~ s/\n(\s*)?\n/\n/sg;
    $code =~ s/$RE_balanced_brackets/{ }/go;
    $code =~ s/\n//sg;
    my %functions = ();
    while ( $code =~ /define\s+(\w+)\s*?\((.*?)\)\s*?\{.*?\}/gs ){
      $functions{$1} = [ split(/,\s*?/, $2) ];
    }
    my $bytecode = bc_parse($o->{ILSM}{code});

    my $binding = "";
    foreach my $func ( keys %functions ){
       my $bcfunc = $func." ( ";
       $bcfunc .=  join(", ", map { "\$".$_ }(@{$functions{$func}}));
       $bcfunc .= " )";
       $binding .= <<END;
sub $func {
#    my \$self = shift;
END
       $binding .=  join("", map { "    my \$".$_." = shift;\n" }(@{$functions{$func}}));
       $binding .= <<END;
    return &Inline::BC::bc_run( &Inline::BC::bc_parse("$bcfunc\\n") );
}
END
    }

    # Cache the results
    require Inline::denter;
    my $namespace = Inline::denter->new->indent(
	*functions => \%functions,
	*filtered  => $o->{ILSM}{code},
	*bytecode  => $bytecode,
	*binding   => "package ".$o->{API}{pkg}.";\n".$binding,
    );

    $o->mkpath("$o->{API}{install_lib}/auto/$o->{API}{modpname}");

    open BCDAT, "> $o->{API}{location}" or
      croak "Inline::BC couldn't write parse information!";
    print BCDAT $namespace;
    close BCDAT;

    $o->{ILSM}{namespace} = \%functions;
    $o->{ILSM}{built}++;

}


#==============================================================================
# Load the code, run it, and bind everything to Perl
#==============================================================================
sub load {
    my $o = shift;
    return if $o->{ILSM}{loaded};

    # Load the code
    open BCDAT, $o->{API}{location} or 
      croak "Couldn't open parse info!";
    my $bcdat = join '', <BCDAT>;
    close BCDAT;

    require Inline::denter;
    my %bcdat = Inline::denter->new->undent($bcdat);
    $o->{ILSM}{namespace} = $bcdat{functions};
    $o->{ILSM}{code} = $bcdat{filtered};
    $o->{ILSM}{binding} = $bcdat{binding};
    $o->{ILSM}{loaded}++;

    # Run it
    bc_run(bc_parse($o->{ILSM}{code}));

    eval $o->{ILSM}{binding};
    croak $@ if $@;
}

#==============================================================================

1;