package Language::Prolog::Sugar;
our $VERSION = '0.06';
use strict;
use warnings;
use Carp qw(carp croak);
use Language::Prolog::Types ':ctors';
sub export {
my ($sub, $pkg, $name)=@_;
no strict 'refs';
*{$pkg.'::'.$name}=$sub;
}
sub import {
my $class=shift;
my $to=caller
or die "unable to infer importer package";
while(@_) {
my $key=shift;
if ($key eq 'vars' or $key eq 'variables') {
my $vars=shift;
if (ref $vars eq 'ARRAY') {
foreach (@{$vars}) {
my $var=prolog_var($_);
export sub () { $var }, $to, $_;
}
}
elsif (ref $vars eq 'HASH') {
foreach my $name (keys %{$vars}) {
my $var=prolog_var($name);
export sub () { $var }, $to, $name;
}
}
else {
croak "invalid argument '$vars' for $key option";
}
}
elsif ($key eq 'functors') {
my $functors=shift;
if (ref $functors eq 'ARRAY') {
foreach (@{$functors}) {
my $functor=$_;
export sub {
prolog_functor($functor, @_);
}, $to, $functor;
}
}
elsif (ref $functors eq 'HASH') {
foreach my $name (keys %{$functors}) {
my $functor=$functors->{$name};
export sub {
prolog_functor($functor, @_);
}, $to, $name;
}
}
else {
croak "invalid argument '$functors' for $key option";
}
}
elsif ($key eq 'atoms') {
my $atoms=shift;
if (ref $atoms eq 'ARRAY') {
foreach (@{$atoms}) {
my $atom=$_;
export sub () { $atom }, $to, $atom;
}
}
elsif (ref $atoms eq 'HASH') {
foreach my $name (keys %{$atoms}) {
my $atom=$atoms->{$name};
export sub () { $atom }, $to, $name;
}
}
else {
croak "invalid argument '$atoms' for $key option";
}
}
elsif ($key eq 'chains') {
my $chains=shift;
if (ref $chains eq 'ARRAY') {
foreach (@{$chains}) {
my $chain=$_;
export sub {
prolog_chain($chain, @_);
}, $to, $chain;
}
}
elsif (ref $chains eq 'HASH') {
foreach my $name (keys %{$chains}) {
my $chain=$chains->{$name};
export sub {
prolog_chain($chain, @_);
}, $to, $name;
}
}
else {
croak "invalid argument '$chains' for $key option";
}
}
elsif ($key eq 'auto_functor') {
carp "Language::Prolog::Sugar auto_functor has been obsoleted";
export \&_auto_functor, $to, 'AUTOLOAD';
}
elsif ($key eq 'auto_term') {
export \&_auto_term, $to, 'AUTOLOAD';
}
else {
croak "Unknow option '$key'";
}
}
}
our $AUTOLOAD;
sub _auto_functor {
my ($pkg, $name) = $AUTOLOAD =~ /(?:(.*)::)?(.*)/;
$pkg = 'main' unless length $pkg;
$name =~ /^[A-Z]/
and croak "invalid functor name '$name': starts with uppercase";
export sub { prolog_functor($name, @_) }, $pkg, $name;
no strict 'refs';
goto &$AUTOLOAD
}
sub _auto_term {
my ($pkg, $name) = $AUTOLOAD =~ /(?:(.*)::)?(.*)/;
$pkg = 'main' unless length $pkg;
if ($name =~ /^[A-Z]/) {
my $var = prolog_var $name;
my $sub = sub () { $var };
export $sub, $pkg, $name;
}
else {
export sub { prolog_functor($name, @_) }, $pkg, $name;
}
no strict 'refs';
goto &$AUTOLOAD
}
1;
__END__
# Below is stub documentation for your module. You'd better edit it!
=head1 NAME
Language::Prolog::Sugar - Syntactic sugar for Prolog term constructors
=head1 SYNOPSIS
use Language::Prolog::Sugar vars => [qw(X Y Z)];
use Language::Prolog::Sugar functors =>{ equal => '=',
minus => '-' };
use Language::Prolog::Sugar functors =>[qw(is)];
use Language::Prolog::Sugar atoms =>[qw(foo bar)];
use Language::Prolog::Sugar atoms =>{ cut => '!' };
use Language::Prolog::Sugar chains =>{ andn => ',',
orn => ';' };
$term=andn( equal(X, foo),
orn( equal(Y, [4, bar]),
equal(Y, foo)),
cut,
is(Z, minus(34, Y)));
=head1 ABSTRACT
This module allows you to easily define constructor subs for Prolog
terms.
=head1 DESCRIPTION
Language::Prolog::Sugar is able to export to the calling package a set
of subrutines to create Prolog terms as defined in the
L<Language::Prolog::Types> module.
Perl programs using these constructors have the same look as real
Prolog programs.
Unfortunately Prolog operators syntax could not be simulated in any
way I know (well, something could be done using overloading, but just
something).
=head2 EXPORT
Whatever you wants!
Language::Prolog::Sugar can create constructors for four Prolog types:
atoms, functors, vars and chains.
The syntax to use it is as follows:
use Language::Prolog::Sugar $type1s=>{ $name1 => $prolog_name1,
$name2 => $prolog_name2,
... },
...
or
use Language::Prolog::Sugar $type2s=>[qw($name1 $name2 ...)],
...
C<$type1s>, C<$type2s>, ... are C<atoms>, C<functors>, C<vars> or
C<chains>.
C<$name1>, C<$name2>, ... are the names of the subrutines exported to
the caller package.
C<$prolog_name>, C<$prolog_name2>, ... are the names that the
constructors use when making the Prolog terms.
i.e:
use Language::Prolog::Sugar atoms=>{ cut => '!' }
exports a subrutine C<cut> that when called returns a Prolog atom C<!>.
use Language::Prolog::Sugar functor=>{ equal => '=' }
exports a subrutine C<equal> that when called returns a Prolog functor
C<=>.
equal(3,4)
returns
'='(3,4)
It should be noted that functor arity is inferred from the number of
arguments:
equal(3, 4, 5, 6, 7)
returns
'='(3, 4, 5, 6, 7)
I call 'chain' the structure formed tipically by ','/2 or ';'/2
operators in Prolog programs. i.e., Prolog program
p, o, r, s.
is actually
','(p, ','(o, ','(r, s))).
using chains allows for a more easily composition of those structures:
use Language::Prolog::Sugar chains => { andn => ',' },
atoms => [qw(p o r s)];
and
andn(p, o, r, s)
generates the Prolog structure for the example program above.
Also, the tag C<auto_term> can be used to install and AUTOLOAD sub on
the caller module that would make a functor, term or variable for
every undefined subroutine. For instance:
use Language::Prolog::Sugar 'auto_term';
swi_call(use_module(library(pce)));
swi_call(foo(hello, Hello))
The old C<auto_functor> tag has been obsoleted.
=head1 SEE ALSO
L<Language::Prolog::Types>, L<Language::Prolog::Types::Factory>
=head1 COPYRIGHT AND LICENSE
Copyright 2002-2006 by Salvador FandiE<ntilde>o (sfandino@yahoo.com).
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut