#
#			Interface Definition Language (OMG IDL CORBA v3.0)
#

use strict;

package Scope;

sub new {
	my $proto = shift;
	my $class = ref($proto) || $proto;
	my $self = {};
	bless($self, $class);
	my($symbtab, $classname, $full, $name) = @_;
	$self->{class} = $classname;
	$self->{full} = $full;
	$self->{entry} = {};
	return $self;
}

sub _Insert {
	my $self = shift;
	my($name, $defn) = @_;
	$self->{entry}->{lc $name} = $defn;
}

sub _Lookup {
	my $self = shift;
	my($name) = @_;
	return $self->{entry}->{lc $name};
}

##############################################################################

package Symbtab;

sub new {
	my $proto = shift;
	my $class = ref($proto) || $proto;
	my $self = {};
	bless($self, $class);
	my($parser) = @_;
	$self->{current_root} = '';
	$self->{current_scope} = '';
	$self->{parser} = $parser;

	$self->{scopes} = {
		''		=> new Scope($self, 'Module', '', '')
	};
	$self->{prefix} = {};
	$self->{typeprefix} = {};
	# C Mapping
	$self->{c_mapping} = {};
#	$self->_Init();
	return $self;
}

#sub _Init {
#	my $self = shift;
#}

sub _CheckCMapping {
	my $self = shift;
	my($full) = @_;

	my $c_key = $full;
	$c_key =~ s/^:://;
	$c_key =~ s/::/_/g;
	if (exists $self->{c_mapping}{$c_key}) {
		$self->{parser}->Info(
				"'$full' is ambiguous (C mapping) with '$self->{c_mapping}{$c_key}'.\n");
	} else {
		$self->{c_mapping}{$c_key} = $full
	}
}

sub PushCurrentRoot {
	my $self = shift;
	my($node) = @_;
	my $name = $node->{idf};
	my $class = ref $node;
##	print "PushCurrentRoot '$name' $class\n";
	$self->{parser}->Error("PushCurrentRoot: INTERNAL_ERROR ($class).\n")
			unless ($class eq 'Module');
	# OpenModule
	$self->{parser}->Error("PushCurrentRoot: INTERNAL_ERROR current_scope not empty ($self->{current_scope}).\n")
			if ($self->{current_scope});
	delete $self->{msg} if (exists $self->{msg});
	my $scope = $self->{current_root};
	my $key_prefix = $self->{parser}->YYData->{filename} . $scope;
	my $new_scope = $self->{current_root} . '::' . $name;
	my $prev = $self->{scopes}->{$scope}->_Lookup($name);
	if (defined $prev) {
		while ($prev->isa('Entry')) {
			$prev = $self->{scopes}->{$prev->{scope}}->_Lookup($name);
		}
		if ($prev->isa('Modules')) {
			# reopen
			push @{$prev->{list_decl}}, $node;
			if ($prev->{prefix} ne $node->{prefix}) {
				$self->{parser}->Error("Prefix redefinition for '$name'.\n");
			}
		} else {
			$self->{msg} ||= "Identifier '$name' already exists.\n";
			$self->{parser}->Error($self->{msg});
			unless (exists $self->{scopes}->{$new_scope}) {
				$self->{scopes}->{$new_scope} = new Scope($self, $class, $new_scope, $name);
				my $modules = bless {
						idf					=> $name,
						full				=> $new_scope,
						prefix				=> $node->{prefix},
						_typeprefix			=> $node->{_typeprefix},
						list_decl			=> [ $node ],
				}, 'Modules';
				$modules->{typeprefix} = $node->{typeprefix}
						if (exists $node->{typeprefix});
				$self->{scopes}->{$new_scope}->_Insert($name, $modules);
			}
		}
	} else {
		$self->{scopes}->{$scope}->_Insert($name, bless({'scope' => $new_scope}, 'Entry'));
		$self->_CheckCMapping($new_scope);
		$self->{scopes}->{$new_scope} = new Scope($self, $class, $new_scope, $name);
		my $modules = bless {
				idf					=> $name,
				full				=> $new_scope,
				prefix				=> $node->{prefix},
				_typeprefix			=> $node->{_typeprefix},
				list_decl			=> [ $node ],
		}, 'Modules';
		$modules->{typeprefix} = $node->{typeprefix}
				if (exists $node->{typeprefix});
		$self->{scopes}->{$new_scope}->_Insert($name, $modules);
	}

	$self->{current_root} = $new_scope;
	$node->{full} = $new_scope;
	if (defined $node->{_typeprefix}) {
		my $typeprefix = $node->{_typeprefix};
		if ($typeprefix) {
			$typeprefix .= '/' . $node->{idf};
		} else {
			$typeprefix = $node->{idf};
		}
		$self->{typeprefix}->{$new_scope} = $typeprefix;
	} else {
		$key_prefix .= '::' . $node->{idf};
		my $prefix = $node->{prefix};
		if ($prefix) {
			$prefix .= '/' . $node->{idf};
		} else {
			$prefix = $node->{idf};
		}
		$self->{prefix}->{$key_prefix} = $prefix;
	}
	return;
}

sub PopCurrentRoot {
	my $self = shift;
	my($node) = @_;
	return unless (defined $node);
	return if ($self->{current_root} =~ s/::$node->{idf}$//);
	$self->{parser}->Error(
			"PopCurrentRoot: INTERNAL_ERROR $self->{current_root} $node->{idf}.\n");
	return;
}

sub PushCurrentScope {
	my $self = shift;
	my($node) = @_;
	my $name = $node->{idf};
	my $class = ref $node;
##	print "PushCurrentScope '$name' $class\n";
	# Insert
	delete $self->{msg} if (exists $self->{msg});
	my $scope = $self->{current_root} . $self->{current_scope};
	my $key_prefix = $self->{parser}->YYData->{filename} . $scope;
	my $new_scope = $scope . '::' . $name;
	my $prev = $self->{scopes}->{$scope}->_Lookup($name);
	if (defined $prev) {
		while ($prev->isa('Entry')) {
			$prev = $self->{scopes}->{$prev->{scope}}->_Lookup($name);
		}
		if ($prev->isa('Forward' . $class)) {
			# the previous must be the same
			foreach (keys %{$prev}) {
				if (	   $_ eq 'full'
						or $_ eq 'filename'
						or $_ eq 'lineno'
						or $_ eq 'typeprefix'
						or $_ eq '_typeprefix'
						or $_ eq 'hash_attribute_operation' ) {
					next;
				}
				if (	   $_ eq 'id'
						or $_ eq 'version' ) {
					$node->{$_} = $prev->{$_};
					next;
				}
				if ($prev->{$_} ne $node->{$_}) {
##					print "$_ $prev->{$_} $node->{$_}\n";
					if ($_ eq 'prefix') {
						unless (defined $node->{_typeprefix}) {
							$self->{parser}->Error(
									"Prefix redefinition for '$name'.\n");
						}
						next;
					}
					$self->{parser}->Error(
							"Definition of '$name' conflicts with previous declaration.\n");
					return;
				}
			}
			$node->{typeprefix} = $prev->{typeprefix}
					if (exists $prev->{typeprefix});
			$self->{scopes}->{$scope}->_Insert($name, bless({'scope' => $new_scope}, 'Entry'));
			$self->{scopes}->{$new_scope} = new Scope($self, $class, $new_scope, $name);
			$self->{scopes}->{$new_scope}->_Insert($name, $node);
		} else {
			$self->{msg} ||= "Identifier '$name' already exists.\n";
			$self->{parser}->Error($self->{msg});
			unless (exists $self->{scopes}->{$new_scope}) {
				$self->{scopes}->{$new_scope} = new Scope($self, $class, $new_scope, $name);
				$self->{scopes}->{$new_scope}->_Insert($name, $node);
			}
		}
	} else {
		$self->{scopes}->{$scope}->_Insert($name, bless({'scope' => $new_scope}, 'Entry'));
		$self->_CheckCMapping($new_scope);
		$self->{scopes}->{$new_scope} = new Scope($self, $class, $new_scope, $name);
		$self->{scopes}->{$new_scope}->_Insert($name, $node);
	}

	$self->{current_scope} .= '::' . $name;
	$node->{full} = $new_scope;
	if (defined $node->{_typeprefix}) {
		my $typeprefix = $node->{_typeprefix};
		if ($typeprefix) {
			$typeprefix .= '/' . $node->{idf};
		} else {
			$typeprefix = $node->{idf};
		}
		$self->{typeprefix}->{$new_scope} = $typeprefix;
	} else {
		$key_prefix .= '::' . $node->{idf};
		my $prefix = $node->{prefix};
		if ($prefix) {
			$prefix .= '/' . $node->{idf};
		} else {
			$prefix = $node->{idf};
		}
		$self->{prefix}->{$key_prefix} = $prefix;
	}
	return;
}

sub PopCurrentScope {
	my $self = shift;
	my($node) = @_;
	return unless (defined $node);
	return if ($self->{current_scope} =~ s/::$node->{idf}$//);
	$self->{parser}->Error(
			"PopCurrentScope: INTERNAL_ERROR $self->{current_scope} $node->{idf}.\n");
	return;
}

sub Insert {
	my $self = shift;
	my($node) = @_;
	if ($node->isa('Specification')) {
		$self->{scopes}->{''}->_Insert('', $node);
		return;
	}
	my $name = $node->{idf};
	return unless ($name);
	delete $self->{msg} if (exists $self->{msg});
	my $scope = $self->{current_root} . $self->{current_scope};
##	print "Insert '$name' ",ref $node," => $scope\n";
	unless (exists $self->{scopes}->{$scope}) {
		warn "'$scope' not exist.\n";
		return;
	}
	my $prev = $self->{scopes}->{$scope}->_Lookup($name);
	if (defined $prev) {
		while ($prev->isa('Entry')) {
			$prev = $self->{scopes}->{$prev->{scope}}->_Lookup($name);
		}
		my $class = ref $prev;
		if ($class =~ s/^Forward//) {
			if (ref $node ne $class) {
				$self->{parser}->Error(
						"Definition of '$name' conflicts with previous declaration.\n");
				return;
			} else {
				# the previous must be the same
				foreach (keys %{$prev}) {
					if (	   $_ eq 'full'
							or $_ eq 'lineno'
							or $_ eq 'hash_attribute_operation' ) {
						next;
					}
					if (	   $_ eq 'id'
							or $_ eq 'version' ) {
						$node->{$_} = $prev->{$_};
						next;
					}
					if ($_ eq 'filename') {
						if (	   $prev->isa('ForwardStruct')
								or $prev->isa('ForwardUnion') ) {
							if ($prev->{$_} ne $node->{$_}) {
								$self->{parser}->Error(
								"Definition of '$name' is not in the same file.\n");
							}
						}
						next;
					}
					if ($prev->{$_} ne $node->{$_}) {
						if ($_ eq 'prefix') {
							unless (defined $node->{_typeprefix}) {
								$self->{parser}->Error(
										"Prefix redefinition for '$name'.\n");
							}
							next;
						}
						$self->{parser}->Error(
								"Definition of '$name' conflicts with previous declaration.\n");
					}
				}
			}
		} else {
			if ($prev->{idf} eq $name) {
				$self->{msg} ||= "Identifier '$name' already exists.\n";
			} else {
				$self->{msg} ||= "Identifier '$name' collides with '$prev->{idf}'.\n";
			}
			$self->{parser}->Error($self->{msg});
			return;
		}
	}
	# insert
	$node->{full} = $scope . '::' . $name;
	$self->{scopes}->{$scope}->_Insert($name, $node);
	$self->_CheckCMapping($node->{full});
	return;
}

sub InsertForward {
	my $self = shift;
	my($node) = @_;
	my $name = $node->{idf};
	return unless ($name);
	my $class = ref $node;
##	print "InsertForward '$name' '$node->{idf}'\n";
	delete $self->{msg} if (exists $self->{msg});
	my $scope = $self->{current_root} . $self->{current_scope};
	my $prev = $self->{scopes}->{$scope}->_Lookup($name);
	if (defined $prev) {
		while ($prev->isa('Entry')) {
			$prev = $self->{scopes}->{$prev->{scope}}->_Lookup($name);
		}
		my $class = ref $prev;
		if ($class =~ /^Forward/) {
			# redeclaration
			if (ref $node ne $class) {
				$self->{parser}->Error(
						"Definition of '$name' conflicts with previous declaration.\n");
				return;
			} else {
				# the previous must be the same
				foreach (keys %{$prev}) {
					if (	   $_ eq 'full'
							or $_ eq 'lineno'
							or $_ eq 'filename'
							or $_ eq 'typeprefix'
							or $_ eq '_typeprefix' ) {
						next;
					}
					if (	   $_ eq 'id'
							or $_ eq 'version' ) {
						$node->{$_} = $prev->{$_};
						next;
					}
					if ($prev->{$_} ne $node->{$_}) {
						if ($_ eq 'prefix') {
							unless (defined $node->{_typeprefix}) {
								$self->{parser}->Error(
										"Prefix redefinition for '$name'.\n");
							}
							next;
						}
						$self->{parser}->Error(
								"Definition of '$name' conflicts with previous declaration.\n");
						return;
					}
				}
				return;
			}
		} else {
			$self->{msg} ||= "Identifier '$name' already exists.\n";
			$self->{parser}->Error($self->{msg});
			return;
		}
	}
	# insert
	$node->{full} = $scope . '::' . $name;
	$self->{scopes}->{$scope}->_Insert($name, $node);
	return;
}

sub InsertInherit {
	my $self = shift;
	my($node, $name, $full) = @_;
##	print "InsertInherit '$name' $full \n";

	# Insert
	delete $self->{msg} if (exists $self->{msg});
	my $scope = $self->{current_root} . $self->{current_scope};
	my $prev = $self->{scopes}->{$scope}->_Lookup($name);
	if (defined $prev) {
		$self->{parser}->Error(__PACKAGE__ . "::InsertInherit: INTERNAL_ERROR ($full).\n");
	} else {
		my $scope_base = $full;
		$scope_base =~ s/::[0-9A-Z_a-z]+$//;
		$self->{scopes}->{$scope}->_Insert($name, bless({'scope' => $scope_base}, 'Entry'));
	}
	return;
}

sub InsertBogus {
	my $self = shift;
	my($node) = @_;
	my $scope =  $self->{current_root} . $self->{current_scope};
	$node->{full} = $scope . "::_seq_";
}

sub Lookup {
	my $self = shift;
	my($name) = @_;
	delete $self->{msg} if (exists $self->{msg});
	if (ref $name) {
		warn __PACKAGE__,"::Lookup $name ",caller," PB\n";
		return $name;
	}
	my $defn = $self->_Lookup($name);
	if (defined $defn) {
		$self->{parser}->Error($self->{msg}) if (exists $self->{msg});
	} else {
##		print __PACKAGE__,"::Lookup $name ",caller()," PB\n";
		$self->{parser}->Error("Undefined symbol '$name'.\n");
	}
	return $defn;
}

sub _Lookup {
	my $self = shift;
	my($name) = @_;
	my $defn;
##	print "_Lookup: '$name'\n";
	if (ref $name) {
		warn __PACKAGE__,"::_Lookup $name ",caller," PB\n";
		return $name;
	}
	return undef unless ($name);
	if ($name =~ /^::/) {
		# global name
##		print "_global name.\n";
		return $self->___Lookup($name);
	} elsif ($name =~ /^[0-9A-Z_a-z]+$/) {
		# identifier alone
		my $scope_init = $self->{current_root} . $self->{current_scope};
		my $scope = $scope_init;
##		print "_Lookup init : '$scope'\n";
		while (1) {
			# Section 3.15.3 Special Scoping Rules for Type Names
			my $g_name = $scope . '::' . $name;
			$defn = $self->__Lookup($scope, $g_name, $name);
			last if (defined $defn || $scope eq '');
			$scope =~ s/::[0-9A-Z_a-z]+$//;
##			print "_Lookup curr : '$scope'\n";
		};
		if (defined $defn) {
##			print "_found $name $scope_init $scope\n";
			my $scope_real = $defn->{full};
			$scope_real =~ s/::[0-9A-Z_a-z]+$//;
			while ($scope_init ne $scope) {
				my $node = $self->___Lookup($scope_init);
				if ($defn->isa('Modules') or ! $node->isa('Modules')) {
##					print "_insert $name $scope_init $scope_real\n";
					$self->{scopes}->{$scope_init}->_Insert($name, bless({'scope' => $scope_real}, 'Entry'));
				}
				$scope_init =~ s/::[0-9A-Z_a-z]+$//;
			}
		}
		return $defn;
	} else {
		# qualified name
		my @list = split /::/,$name;
		my $idf = pop @list;
		my $scoped_name = $name;
		$scoped_name =~ s/::[0-9A-Z_a-z]+$//;
##		print "_qualified name : '$scoped_name' '$idf'\n";
		my $scope = $self->_Lookup($scoped_name);		# recursive
		if (defined $scope) {
			$defn = $self->___Lookup($scope->{full} . '::' . $idf);
		}
		return $defn;
	}
}

sub __Lookup {
	my $self = shift;
	my ($scope, $g_name, $name) = @_;
##	print "__Lookup: '$scope' '$g_name' '$name'\n";
	my $defn = $self->___Lookup($g_name);
	return $defn if (defined $defn);
	return undef unless($scope);
	my $node = $self->___Lookup($scope);
	if (defined $node) {
##		print "__inherit $node->{full}\n";
		my @list;
		foreach ($node->getInheritance()) {
			my $base = $self->Lookup($_);
			if (defined $base) {
				$g_name = $base->{full} . '::' . $name;
				$defn = $self->___Lookup($g_name);
				if (defined $defn) {
					my $found = 0;
					foreach (@list) {
						if ($defn == $_) {
							$found = 1;
							last;
						}
					}
					push @list, $defn unless ($found);
				}
			}
		}
		if (@list) {
			if (scalar @list > 1) {
				$self->{parser}->Error("Ambiguous symbol '$name'.\n");
			}
			return pop @list;
		}
	}
	return undef;
}

sub ___Lookup {
	my $self = shift;
	my ($full) = @_;
##	print "___Lookup: '$full'\n";
	if ($full =~ /^((?:::[0-9A-Z_a-z]+)*)::([0-9A-Z_a-z]+)$/) {
		if (exists $self->{scopes}->{$1}) {
			my $defn = $self->{scopes}->{$1}->_Lookup($2);
			if (defined $defn) {
				while ($defn->isa('Entry')) {
					$defn = $self->{scopes}->{$defn->{scope}}->_Lookup($2);
					last unless (defined $defn);
				}
				unless (defined $defn) {
					$self->{parser}->Error(__PACKAGE__ . "::___Lookup: INTERNAL_ERROR ($full).\n");
					return undef;
				}
				if ($defn->{idf} ne $2) {
					$self->{msg} = "Identifier '$2' collides with '$defn->{idf}'.\n";
				}
##				print "___found $defn->{full}\n";
				return $defn;
			} else {
##				print "___not found '$2' in '$1'.\n";
				return undef;
			}
		} else {
##			print "___not found scope '$1'.\n";
			return undef;
		}
	} else {
		$self->{parser}->Error(__PACKAGE__ . "::___Lookup: INTERNAL_ERROR not match ($full).\n");
		return undef;
	}
}

sub PragmaID {							#	10.7.5.1	The ID Pragma
	my $self = shift;
	my($name, $id) = @_;
	my $node = $self->Lookup($name);
	if (defined $node) {
		if (exists $node->{typeid}) {
			$self->{parser}->Warning("TypeId/pragma conflict for '$self->{idf}'.\n");
		}
		if (exists $node->{id}) {
			$self->{parser}->Error("Repository ID redefinition for '$name'.\n")
					unless ($id eq $node->{id});
		} else {
			$node->{id} = $id;
			$self->CheckID($node, $id);
		}
		if ($node->isa('Modules')) {
			foreach (@{$node->{list_decl}}) {
				if ($_->{filename} eq $self->{parser}->YYData->{filename}) {
					$_->{id} = $id;
				}
			}
		}
	} else {
		$self->{parser}->Warning("Undefined symbol '$name' for '$id'.\n")
	}
}

sub CheckID {
	my $self = shift;
	my($node, $id) = @_;
	if ($id =~ /^IDL:/) {
		#	10.7.1		OMG IDL Format
		if ($id =~ /^IDL:[0-9A-Za-z_:\.\/\-]+:([0-9]+)\.([0-9]+)/) {
			my $version = $1 . '.' . $2;
			if (exists $node->{version}) {
				$self->{parser}->Error("Version redefinition for '$node->{idf}'.\n")
						unless ($version eq $node->{version});
			} else {
				$node->{version} = $version;
			}
		} else {
			$self->{parser}->Error("Bad IDL format for Repository ID '$id'.\n");
		}
	} elsif ($id =~ /^RMI:/) {
		#	10.7.2		RMI Hashed Format
		$self->{parser}->Error("Bad RMI format for Repository ID '$id'.\n")
				unless ($id =~ /^RMI:[0-9A-Fa-f\-]+:[0-9A-F]{16}(:[0-9A-F]{16})?/);
	} elsif ($id =~ /^DCE:/) {
		#	10.7.3		DCE UUID Format
		$self->{parser}->Error("Bad DCE format for Repository ID '$id'.\n")
				unless ($id =~ /^DCE:[0-9A-Fa-f\-]+:[0-9]+/);
	} elsif ($id =~ /^LOCAL:/) {
		# 	10.7.4		LOCAL Format
		# followed by an arbitrary string.
	}
}

sub PragmaPrefix {						#	10.7.5.2	The Prefix Pragma
	my $self = shift;
	my($prefix) = @_;
	my $key_prefix = $self->{parser}->YYData->{filename} . $self->{current_root} . $self->{current_scope};
	$self->{prefix}->{$key_prefix} = $prefix;
}

sub GetPrefix {
	my $self = shift;
	my $scope = $self->{current_root} . $self->{current_scope};
	my $key_prefix = $self->{parser}->YYData->{filename} . $scope;
	if (exists $self->{prefix}->{$key_prefix}) {
		return $self->{prefix}->{$key_prefix};
	} else {
		return "";
	}
}

sub GetTypePrefix {
	my $self = shift;
	my $scope = $self->{current_root} . $self->{current_scope};
	if (exists $self->{typeprefix}->{$scope}) {
		return $self->{typeprefix}->{$scope};
	} else {
		return undef;
	}
}

sub PragmaVersion {						#	10.7.5.3	The Version Pragma
	my $self = shift;
	my($name, $major, $minor) = @_;
	my $version = $major . '.' . $minor;
	my $node = $self->Lookup($name);
	if (defined $node) {
		if (exists $node->{version}) {
			$self->{parser}->Error("Version redefinition for '$name'.\n")
					unless ($version eq $node->{version});
		} else {
			$node->{version} = $version;
		}
	}
}

sub CheckForward {
	my $self = shift;

	foreach my $scope (values %{$self->{scopes}}) {
		foreach my $entry (values %{$scope->{entry}}) {
			if (ref($entry) =~ /^Forward/) {
				$self->{parser}->Error("'$entry->{idf}' never defined.\n");
			}
		}
	}
}

sub CheckRepositoryID {
	my $self = shift;

	foreach my $scope (values %{$self->{scopes}}) {
		foreach my $entry (values %{$scope->{entry}}) {
			if ($entry->isa('Modules') and exists $entry->{id}) {
				foreach (@{$entry->{list_decl}}) {
					if (       ! exists $_->{id}
							or $_->{id} ne $entry->{id} ) {
						$self->{parser}->Error("Repository ID inconsistent for '$entry->{idf}'.\n");
					}
				}
			}
		}
	}
}

sub Import {
	my $self = shift;
	my($node) = @_;

	my $dirname = $self->{parser}->YYData->{opt_i};
	my $fullname = $node->{value};
	$fullname =~ s/::/_/g;
	my $filename = $fullname . ".mod";
	$filename = $dirname . '/' . $filename if ($dirname);
	require $filename;
	my $scope = eval('$main::' . $fullname);
	if (defined $scope and $scope->isa('Scope')) {
		my $class = $scope->{class};
		if (       $class eq 'Module'
				or $class eq 'RegularInterface'
				or $class eq 'LocalInterface'
				or $class eq 'AbstractInterface'
				or $class eq 'RegularValue'
				or $class eq 'BoxedValue'
				or $class eq 'AbstractValue'
				or $class eq 'RegularEvent'
				or $class eq 'AbstractEvent' ) {
			$self->{scopes}->{$node->{value}} = $scope;
			my $root = $node->{value};
			$root =~ s/::([0-9A-Z_a-z]+)$//;
			my $name = lc $1;
			$self->{scopes}->{$root}->_Insert($name, bless({'scope' => $node->{value}}, 'Entry'));
			foreach (values %{$scope->{entry}}) {
				next if (ref $_ ne 'Entry');
				next if (exists $self->{scopes}->{$_->{scope}});
				$self->_Import($_->{scope});
			}
		} else {
			$self->{parser}->Error("'$node->{value}' can't imported (bad type).\n");
		}
	} else {
		$self->{parser}->Error("Import: INTERNAL_ERROR ($node->{value}).\n");
	}
}

sub _Import {
	my $self = shift;
	my($full) = @_;

	my $dirname = $self->{parser}->YYData->{opt_i};
	my $fullname = $full;
	$fullname =~ s/::/_/g;
	my $filename = $fullname . ".mod";
	$filename = $dirname . '/' . $filename if ($dirname);
	require $filename;
	my $scope = eval('$main::' . $fullname);
	if (defined $scope and $scope->isa('Scope')) {
		$self->{scopes}->{$full} = $scope;
		foreach (values %{$scope->{entry}}) {
			next if (ref $_ ne 'Entry');
			next if (exists $self->{scopes}->{$_->{scope}});
			$self->_Import($_->{scope});
		}
	} else {
		$self->{parser}->Error("_Import: INTERNAL_ERROR ($full).\n");
	}
}

sub Export {
	my $self = shift;
	use Data::Dumper;

	my $dirname = $self->{parser}->YYData->{opt_i};
	if ($dirname) {
		unless (-d $dirname) {
			mkdir $dirname
					or die "can't create $dirname ($!).\n";
		}
	}
	foreach my $scope (values %{$self->{scopes}}) {
		my $fullname = $scope->{full};
		next unless ($fullname);
		$fullname =~ s/::/_/g;
		my $filename = $fullname . ".mod";
		$filename = $dirname . '/' . $filename if ($dirname);
		open OUT, "> $filename"
				or die "can't open $filename ($!).\n";
		my $d = Data::Dumper->new([$scope], [$fullname]);
		$d->Indent(1);
#		$d->Indent(0);
		$d->Purity(1);
		print OUT "package main;\n";
		print OUT $d->Dump();
		close OUT;
	}
}

sub Dump {
	my $self = shift;
	use Data::Dumper;

	my $d = Data::Dumper->new([$self->{scopes}], [qw(scopes)]);
	$d->Indent(1);
#	$d->Indent(0);
	print $d->Dump();
}

##############################################################################

package UnnamedSymbtab;

sub new {
	my $proto = shift;
	my $class = ref($proto) || $proto;
	my($parser) = @_;
	my $self = {};
	bless($self, $class);
	$self->{parser} = $parser;
	$self->{entry} = {};
	return $self;
}

sub Insert {
	my $self = shift;
	my($name) = @_;
##	print "Insert '$name'\n";
	my $key = lc $name;
	if (exists $self->{entry}{$key}) {
		if ($self->{entry}{$key} eq $name) {
			$self->{parser}->Error(
					"Identifier '$name' already exists.\n");
		} else {
			$self->{parser}->Error(
					"Identifier '$name' collides with '$self->{entry}{$key}'.\n");
		}
	} else {
		$self->{entry}{$key} = $name;
	}
	return;
}

sub InsertUsed {
	my $self = shift;
	my($name) = @_;
##	print "InsertUsed '$name'\n";
	my $key = lc $name;
	$self->{entry}{$key} = $name unless (exists $self->{entry}{$key});
	return;
}

1;

