eda-tools/old-boom/misc.pl

#!/usr/bin/perl


#
# determine the equivalent parts, taking into account that %eq is transitive
#

sub eq
{
    my %seen;
    my @p = @_;	# parts to consider
    my @r = ();	# new equivalences we've found
    my $skip = @p;

    while (@p) {
	my $p = shift @p;
	next if $seen{$p};
	$seen{$p} = 1;
	push(@r, $p) if $skip-- <= 0;
	push(@p, @{ $eq{$p} });
    }
    return @r;
}


#
# When looking for a description, we also consider equivalent parts.
#
# Furthermore, some descriptions may just be pointers to other descriptions.
# Users can add regular expressions that are used to extract references from
# a description, which are then looked up as well.
#

sub __dsc_lookup
{
    local ($id) = @_;

    for ($id, &eq($id)) {
        return $dsc{$_} if defined $dsc{$_};
    }
    return undef;
}


sub dsc_find
{
    my $id = $_[0];
    LOOKUP: while (1) {
	my $dsc = &__dsc_lookup($id);
	return undef unless defined $dsc;
	for (my $i = 0; $i <= $#xlat_from; $i++) {
# @@@ this is UUUUHHHGLLEEEEE !!! Why can't I just expand $to[$i] ?
	    next
	      unless ($id = $dsc) =~ s/^.*$xlat_from[$i].*$/$xlat_to[$i] $1/;
	    next LOOKUP if defined &__dsc_lookup($id);
	}
	return $dsc;
    }
    return undef;
}


sub dsc_xlat
{
    local ($from, $to) = @_;
    push(@xlat_from, $from);
    push(@xlat_to, $to);
}


sub dsc_xlat_arg
{
    return undef unless $_[0] =~ /^(.)([^\1]*)\1([^\1]*)\1$/;
    &dsc_xlat($2, $3);
    return 1;
}


#
# Lexical ordering of component references
#

sub cmp_cref
{
    local ($a, $b) = @_;
    local ($as, $an, $bs, $bn);

    return $a cmp $b unless ($as, $an) = $a =~ /^([[:alpha:]]+)(\d*)$/;
    return $a cmp $b unless ($bs, $bn) = $b =~ /^([[:alpha:]]+)(\d*)$/;
    return $as cmp $bs unless $as eq $bs;
    return $an <=> $bn
}


return 1;