# Junction.pm

# ChangeLog
#
# 2005-09-27
# * created this file
#

# TODO
# 

use strict;

use Perl6::Value;

my $class_description = '-0.0.1-cpan:FGLOCK';

class1 'Junction'.$class_description => {
    is => [ $::Object ],
    instance => {
        attrs => [ '$.type', '$.things' ],
                # type - unboxed str
                # things - ptr to native ARRAY of objects
        methods => {
            'junction_normalize' => sub {
                my @ary = @{_('$.things')};
                my $type = _('$.type');
                my @res;
                for ( @ary ) {
                    if ( $_->isa('Junction') && $_->type eq $type ) {
                        push @res, @{ $_->things };
                    }
                    else {
                        push @res, $_
                    }
                }
                #warn "SORT @res";
                # remove duplicates
                for ( @res ) {
                    $_ = $_->fetch if $_->isa('Scalar');
                }
                @res = sort { Perl6::Value::identify($a) cmp Perl6::Value::identify($b) } @res;
                my $last_id = rand();
                #warn "SORTED @res";
                @res = grep { 
                        my $id = Perl6::Value::identify( $_ );
                        #warn "ID $id";
                        $id eq $last_id ? 0 : ( $last_id = $id, 1 )
                    } @res;
                @{_('$.things')} = @res;
            },
            'values' => sub { 
                my $ary = Array->new;
                $ary->push( @{_('$.things')} );
                return $ary;
            },
            'num' =>  sub { warn "Junction.num() not implemented" },
            'int' =>  sub { warn "Junction.int() not implemented" },
            'str' =>  sub { 
                my $sep = "!";  # none?
                $sep = "|" if _('$.type') eq 'any';
                $sep = "&" if _('$.type') eq 'all';
                $sep = "^" if _('$.type') eq 'one';             
                Str->new( '$.unboxed' => 
                    "(" . 
                    join(" $sep ", 
                        map { $_->str->unboxed } @{_('$.things')}
                    ) . 
                    ")"
                ) 
            },
            'bit' =>  sub { 
                #warn "Junction.bit() not implemented";
                my @ary = @{_('$.things')};
                my $type = _('$.type');
                @ary = map {
                        ref($_) ?
                        $_->bit->unboxed :
                        $_ != 0
                    } @ary;
                #warn "BIT: $type [ @ary ]";
                if ( $type eq 'all' ) {
                    for ( @ary ) { return Bit->new( '$.unboxed' => 0 ) unless $_ }
                    return Bit->new( '$.unboxed' => 1 );
                }
                if ( $type eq 'any' ) {
                    for ( @ary ) { return Bit->new( '$.unboxed' => 1 ) if $_ }
                    return Bit->new( '$.unboxed' => 0 );
                }
                if ( $type eq 'one' ) {
                    my $count = 0;
                    for ( @ary ) { $count++ if $_ }
                    return Bit->new( '$.unboxed' => ( $count == 1 ) );
                }
                if ( $type eq 'none' ) {
                    for ( @ary ) { return Bit->new( '$.unboxed' => 0 ) if $_ }
                    return Bit->new( '$.unboxed' => 1 );
                }
                die "Unknown Junction $type";
            },
            'perl' => sub {
                Str->new( '$.unboxed' =>  
                    _('$.type') . "(" . 
                    join(", ", 
                        map { $_->str->unboxed } @{_('$.things')}
                    ) . ")"
                ) 
            },
            'ref' =>  sub { $::CLASS }, 
        },
    }
};



1;
__END__

=head1 NAME

Perl6::Value::Junction - Perl6 junctions

=head1 SYNOPSIS

  use Perl6::Value::Junction;
  
  ...

=head1 DESCRIPTION


=head1 SEE ALSO

Pugs

=head1 AUTHOR

Flavio S. Glock, E<lt>fglock@gmail.com<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2005 by Flavio S. Glock

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.4 or,
at your option, any later version of Perl 5 you may have available.

=cut