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


line stmt bran cond sub pod time code
1             package Language::Prolog::Types::Factory;
2              
3             our $VERSION = '0.09';
4              
5 1     1   6 use strict;
  1         2  
  1         30  
6 1     1   5 use warnings;
  1         2  
  1         24  
7              
8 1     1   5 use Carp;
  1         2  
  1         116  
9              
10             require Exporter;
11             our @ISA = qw(Exporter);
12             our @EXPORT = qw( prolog_list
13             prolog_ulist
14             prolog_functor
15             prolog_variable
16             prolog_variables
17             prolog_var
18             prolog_nil
19             prolog_atom
20             prolog_string
21             prolog_chain
22             prolog_opaque
23             );
24              
25 1     1   726 use Language::Prolog::Types::Abstract;
  1         3  
  1         774  
26              
27             my $factory;
28              
29             # ctors:
30             sub prolog_list {
31 0 0   0 1 0 @_<1
32             ? $factory->new_nil
33             : $factory->new_list(@_);
34             }
35              
36             sub prolog_ulist {
37 0 0   0 1 0 if (@_<2) {
38 0 0       0 return $_[0] if @_==1;
39 0         0 croak "prolog_ulist requires 1 or more arguments";
40             }
41 0         0 my $tail=pop @_;
42             # expand tail when it is some kind of list:
43 0 0       0 if(prolog_is_list_or_nil($tail)) {
44 0 0       0 prolog_is_nil($tail)
45             and return $factory->new_list(@_);
46 0 0       0 prolog_is_ulist($tail)
47             and return prolog_ulist( @_, $tail->largs, $tail->tail);
48 0         0 return prolog_list( @_,
49             prolog_list2perl_list($tail))
50             }
51 0         0 $factory->new_ulist(@_, $tail)
52             }
53              
54             sub prolog_functor ($@ ) {
55 0 0   0 1 0 prolog_is_atom($_[0]) or
56             croak "funtor name '$_[0]' is not an atom";
57             # functor without args is actually an atom
58 0 0       0 @_>1 or return $_[0];
59             # '.'/2 is promoted to list:
60 0 0 0     0 return prolog_ulist($_[1], $_[2])
61             if ($_[0] eq '.' and @_==3);
62 0         0 $factory->new_functor(@_)
63             }
64              
65 0     0 1 0 sub prolog_variable ($ ) { $factory->new_variable(@_) }
66              
67 0     0 0 0 sub prolog_variables { map { prolog_variable $_ } @_ }
  0         0  
68              
69 0     0 1 0 sub prolog_nil () { $factory->new_nil }
70              
71 0     0 1 0 sub prolog_atom ($ ) { "$_[0]" }
72              
73 0     0 1 0 sub prolog_string ($ ) { prolog_list(unpack('C*', $_[0])) }
74              
75 0     0 0 0 sub prolog_opaque ($ ) { $factory->new_opaque(@_) }
76              
77             sub prolog_chain {
78 0     0 0 0 my $functor=shift;
79 0 0       0 if (@_<=1) {
80 0 0       0 return $_[0] if @_;
81 0         0 return ();
82             }
83 0         0 my $first=shift;
84 0         0 prolog_functor($functor, $first, prolog_chain($functor, @_))
85             }
86              
87             *prolog_var=\&prolog_variable;
88              
89              
90 0     0 0 0 sub factory () { $factory }
91 1     1 0 4 sub set_factory { $factory=$_[0] }
92              
93              
94             1;
95             __END__