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__ |