File Coverage

blib/lib/Language/Prolog/Types/Factory.pm

Criterion	Covered	Total	%
statement	13	41	31.7
branch	0	22	0.0
condition	0	3	0.0
subroutine	5	16	31.2
pod	7	12	58.3
total	25	94	26.6

package Language::Prolog::Types::Factory;

our $VERSION = '0.09';

use strict;
use warnings;

use Carp;

require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw( prolog_list
		  prolog_ulist
		  prolog_functor
		  prolog_variable
		  prolog_variables
		  prolog_var
		  prolog_nil
		  prolog_atom
		  prolog_string
		  prolog_chain
		  prolog_opaque
		);

use Language::Prolog::Types::Abstract;

my $factory;

# ctors:
sub prolog_list {
    @_<1
	? $factory->new_nil
	    : $factory->new_list(@_);
}

sub prolog_ulist {
    if (@_<2) {
	return $_[0] if @_==1;
	croak "prolog_ulist requires 1 or more arguments";
    }
    my $tail=pop @_;
    # expand tail when it is some kind of list:
    if(prolog_is_list_or_nil($tail)) {
	prolog_is_nil($tail)
	    and return $factory->new_list(@_);
	prolog_is_ulist($tail)
	    and return prolog_ulist( @_, $tail->largs, $tail->tail);
	return prolog_list( @_,
			    prolog_list2perl_list($tail))
    }
    $factory->new_ulist(@_, $tail)
}

sub prolog_functor ($@ ) {
    prolog_is_atom($_[0]) or
	croak "funtor name '$_[0]' is not an atom";
    # functor without args is actually an atom
    @_>1 or return $_[0];
    # '.'/2 is promoted to list:
    return prolog_ulist($_[1], $_[2])
	if ($_[0] eq '.' and @_==3);
    $factory->new_functor(@_)
}

sub prolog_variable ($ ) { $factory->new_variable(@_) }

sub prolog_variables { map { prolog_variable $_ } @_ }

sub prolog_nil () { $factory->new_nil }

sub prolog_atom ($ ) { "$_[0]" }

sub prolog_string ($ ) { prolog_list(unpack('C*', $_[0])) }

sub prolog_opaque ($ ) { $factory->new_opaque(@_) }

sub prolog_chain {
    my $functor=shift;
    if (@_<=1) {
	return $_[0] if @_;
	return ();
    }
    my $first=shift;
    prolog_functor($functor, $first, prolog_chain($functor, @_))
}

*prolog_var=\&prolog_variable;


sub factory () { $factory }
sub set_factory { $factory=$_[0] }


1;
__END__