view release on metacpan or  search on metacpan

lib/Symbol/Opaque.pm  view on Meta::CPAN

package Symbol::Opaque;

our $VERSION = '0.03';

use 5.006001;
use strict;
use warnings;
no warnings 'uninitialized';
use Class::Multimethods::Pure;
use Exporter;
use Scalar::Util qw<readonly>;
use base 'Exporter';

our @EXPORT = qw<defsym free id _()>;

sub _() {
    Symbol::Opaque::Anything->new;
}

sub free($) {
    Symbol::Opaque::Free->new(\$_[0]);
}

sub id($) {
    Symbol::Opaque::Id->new($_[0]);
}

sub makesymdef {
    my ($name) = @_;
    sub {
        my @args;
        for my $i (0..$#_) {
            if (!defined $_[$i] && !readonly $_[$i]) {
                push @args, free $_[$i];
            }
            else {
                push @args, $_[$i];
            }
        }
        Symbol::Opaque::Symbol->new($name, @args);
    };
}

sub defsym {
    my ($name) = @_;
    no strict 'refs';
    my $package = caller;
    *{"$package\::$name"} = makesymdef $name;
}

multi UNIFY => (Any, Any) => sub {
    my ($a, $b) = @_;
    $a eq $b and sub { };
};

multi UNIFY => ('Symbol::Opaque::Free', Any) => sub {
    my ($var, $thing) = @_;
    $var->bind($thing);
};

multi UNIFY => (subtype('Symbol::Opaque::Free', sub { $_[0]->bound }), Any) => sub {
    my ($var, $thing) = @_;
    UNIFY($var->value, $thing);
};

multi UNIFY => ('Symbol::Opaque::Symbol', Any) => sub { 
    0; 
};

multi UNIFY => ('Symbol::Opaque::Symbol', 'Symbol::Opaque::Symbol') => sub {
    my ($sa, $sb) = @_;
    return 0 unless $sa->name eq $sb->name;

    UNIFY([$sa->args], [$sb->args]);
};

multi UNIFY => ('Symbol::Opaque::Anything', Any) => sub {
    sub { };
};

multi UNIFY => ('ARRAY', 'ARRAY') => sub {
    my ($a, $b) = @_;
    return 0 unless @$a == @$b;