Acme-Lambda-Expr

 view release on metacpan or  search on metacpan

inc/Module/Install.pm  view on Meta::CPAN

	close FH or die "close($_[0]): $!";
}

# _version is for processing module versions (eg, 1.03_05) not
# Perl versions (eg, 5.8.1).

sub _version ($) {
	my $s = shift || 0;
	   $s =~ s/^(\d+)\.?//;
	my $l = $1 || 0;
	my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g;
	   $l = $l . '.' . join '', @v if @v;
	return $l + 0;
}

# Cloned from Params::Util::_CLASS
sub _CLASS ($) {
	(
		defined $_[0]
		and
		! ref $_[0]

inc/Module/Install/MakeMaker.pm  view on Meta::CPAN

	$ISCORE  = 1;
	@ISA     = qw{Module::Install::Base};
}

my $makefile;

sub WriteMakefile {
    my ($self, %args) = @_;
    $makefile = $self->load('Makefile');

    # mapping between MakeMaker and META.yml keys
    $args{MODULE_NAME} = $args{NAME};
    unless ( $args{NAME} = $args{DISTNAME} or ! $args{MODULE_NAME} ) {
        $args{NAME} = $args{MODULE_NAME};
        $args{NAME} =~ s/::/-/g;
    }

    foreach my $key ( qw{name module_name version version_from abstract author installdirs} ) {
        my $value = delete($args{uc($key)}) or next;
        $self->$key($value);
    }

inc/Module/Install/Makefile.pm  view on Meta::CPAN

	if ( $self->tests ) {
		die "tests_recursive will not work if tests are already defined";
	}
	my $dir = shift || 't';
	unless ( -d $dir ) {
		die "tests_recursive dir '$dir' does not exist";
	}
	%test_dir = ();
	require File::Find;
	File::Find::find( \&_wanted_t, $dir );
	$self->tests( join ' ', map { "$_/*.t" } sort keys %test_dir );
}

sub write {
	my $self = shift;
	die "&Makefile->write() takes no arguments\n" if @_;

	# Make sure we have a new enough
	require ExtUtils::MakeMaker;

	# MakeMaker can complain about module versions that include

inc/Module/Install/Makefile.pm  view on Meta::CPAN

	if ( eval($ExtUtils::MakeMaker::VERSION) > 6.17 and $self->sign ) {
		$args->{SIGN} = 1;
	}
	unless ( $self->is_admin ) {
		delete $args->{SIGN};
	}

	# merge both kinds of requires into prereq_pm
	my $prereq = ($args->{PREREQ_PM} ||= {});
	%$prereq = ( %$prereq,
		map { @$_ }
		map { @$_ }
		grep $_,
		($self->configure_requires, $self->build_requires, $self->requires)
	);

	# Remove any reference to perl, PREREQ_PM doesn't support it
	delete $args->{PREREQ_PM}->{perl};

	# merge both kinds of requires into prereq_pm
	my $subdirs = ($args->{DIR} ||= []);
	if ($self->bundles) {

inc/Module/Install/Makefile.pm  view on Meta::CPAN

	}

	if ( my $perl_version = $self->perl_version ) {
		eval "use $perl_version; 1"
			or die "ERROR: perl: Version $] is installed, "
			. "but we need version >= $perl_version";
	}

	$args->{INSTALLDIRS} = $self->installdirs;

	my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_})} keys %$args;

	my $user_preop = delete $args{dist}->{PREOP};
	if (my $preop = $self->admin->preop($user_preop)) {
		foreach my $key ( keys %$preop ) {
			$args{dist}->{$key} = $preop->{$key};
		}
	}

	my $mm = ExtUtils::MakeMaker::WriteMakefile(%args);
	$self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile');

inc/Module/Install/Metadata.pm  view on Meta::CPAN

		$self->{values}{$key} = shift;
		return $self;
	};
}

foreach my $key ( @resource_keys ) {
	*$key = sub {
		my $self = shift;
		unless ( @_ ) {
			return () unless $self->{values}{resources};
			return map  { $_->[1] }
			       grep { $_->[0] eq $key }
			       @{ $self->{values}{resources} };
		}
		return $self->{values}{resources}{$key} unless @_;
		my $uri = shift or die(
			"Did not provide a value to $key()"
		);
		$self->resources( $key => $uri );
		return 1;
	};

inc/Module/Install/Metadata.pm  view on Meta::CPAN

	my $self = shift;
	while ( @_ ) {
		my $module  = shift or last;
		my $version = shift || 0;
		push @{ $self->{values}{bundles} }, [ $module, $version ];
	}
	$self->{values}{bundles};
}

# Resource handling
my %lc_resource = map { $_ => 1 } qw{
	homepage
	license
	bugtracker
	repository
};

sub resources {
	my $self = shift;
	while ( @_ ) {
		my $name  = shift or last;

inc/Module/Install/Metadata.pm  view on Meta::CPAN

		# The user used ->feature like ->features by passing in the second
		# argument as a reference.  Accomodate for that.
		$mods = $_[0];
	} else {
		$mods = \@_;
	}

	my $count = 0;
	push @$features, (
		$name => [
			map {
				ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_
			} @$mods
		]
	);

	return @$features;
}

sub features {
	my $self = shift;

lib/Acme/Lambda/Expr/Bound.pm  view on Meta::CPAN

	is  => 'ro',
	isa => 'Acme::Lambda::Expr::Term',

	required => 1,
);

sub deparse{
	my($self) = @_;
	return sprintf 'sub{ %s }->(%s)',
		$self->function->deparse,
		join q{, }, map{ $_->deparse } $self->args;
}
sub stringify{
	my($self) = @_;

	return sprintf 'curry(%s, %s)',
		$self->function,
		join q{, }, $self->args;
}

sub codify{
	my($self) = @_;

	my $function = $self->function;
	my @args     = $self->args;

	return sub{
		@_ = map{ &{$_} } @args;
		goto &{$function};
	};
}

__PACKAGE__->meta->make_immutable();

lib/Acme/Lambda/Expr/Function.pm  view on Meta::CPAN

sub get_code_info{
	my($self) = @_;
	return Data::Util::get_code_info($self->function);
}

sub deparse{
	my($self) = @_;

	return sprintf '%s::%s(%s)',
		$self->get_code_info,
		join q{, }, map{ $_->deparse } $self->args;
}
sub stringify{
	my($self) = @_;

	return sprintf 'curry(\&%s::%s, %s)',
		$self->get_code_info,
		join q{, }, $self->args;
}

sub codify{
	my($self) = @_;

	my $function = $self->function;
	my @args     = $self->args;

	return sub{
		@_ = map{ &{$_} } @args;
		goto &{$function};
	};
}

__PACKAGE__->meta->make_immutable();

lib/Acme/Lambda/Expr/Method.pm  view on Meta::CPAN

	coerce   => 1,
	required => 1,
);

sub deparse{
	my($self) = @_;

	return sprintf '%s->%s(%s)',
		$self->invocant->deparse,
		$self->method,
		join q{, }, map{ $_->deparse } $self->args,
	;
}
sub stringify{
	my($self) = @_;

	return sprintf '%s->%s(%s)',
		$self->invocant,
		$self->method,
		join q{, }, $self->args,
	;

lib/Acme/Lambda/Expr/Method.pm  view on Meta::CPAN

sub codify{
	my($self) = @_;

	my $invocant = $self->invocant;
	my $method   = $self->method;
	my @args     = $self->args;

	return sub{
		my $self = &{$invocant};

		$self->$method(map{ &{$_} } @args);
#		if(not defined $self){
#			Carp::croak(qq{Can't call method "$method" on an undefined value});
#		}
#		elsif(Scalar::Util::looks_like_number $self){
#			Carp::croak(qq{Can't call method "$method" without a package or object reference});
#		}
#
#		my $method_entity = $self->can($method);
#
#		if($method_entity){
#			@_ = ($self, map{ &{$_} } @args);
#			goto &{$method_entity};
#		}
#		else{
#			my $pkg = ref($self) ? ref($self) : $self;
#			Carp::croak(qq{Can't locate object method "$method" via package "$pkg"});
#		}
	};
}

__PACKAGE__->meta->make_immutable;

lib/Acme/Lambda/Expr/Proc.pm  view on Meta::CPAN

	is  => 'ro',
	isa => 'ArrayRef',

	initializer => \&_initialize_args,
	auto_deref => 1,

	required => 1,
);
sub _initialize_args{
	my($self, $args) = @_;
	$self->{args} = [ map{ as_lambda_expr($_) } @{$args} ];
	return;
}

__PACKAGE__->meta->make_immutable();

tool/operators.pl  view on Meta::CPAN

		_str_less_eq    => 'le',
		_str_grater     => 'gt',
		_str_grater_eq  => 'ge',
		_str_compare    => 'cmp',

#		'_smart_match' => '~~',
	);

	while(my($name, $binop) = splice @binops, 0, 2){
		my $class_name = 'Acme::Lambda::Expr::'
			. join '', map{ ucfirst } split /_/, $name;

		$src .= <<"SRC";
package $class_name;
use Moose;
extends qw(Acme::Lambda::Expr::BinOp);

sub symbol{
	return q{$binop};
}
sub codify{

tool/operators.pl  view on Meta::CPAN

		_sin   => 'sin',
		_exp   => 'exp',
		_abs   => 'abs',
		_log   => 'log',
		_sqrt  => 'sqrt',
		_int   => 'int',
	);

	while(my($name, $uniop) = splice @uniops, 0, 2){
		my $class_name = 'Acme::Lambda::Expr::'
			. join '', map{ ucfirst } split /_/, $name;

		if($uniop eq 'neg'){
			$uniop = '-';
		}

		$src .= <<"SRC";
package $class_name;
use Moose;
extends qw(Acme::Lambda::Expr::UniOp);