#!/usr/bin/perl 

1;

sub ALF_CheckSemanticsDeclaration {	local($semantics) = @_;
	print("# ALF Semantics Info:\tvalidating semantics declaration $semantics:\t",&ALF_ObjectInfoText($semantics),"\n") if $ALF_Debug;
	local $parent = $ALF_Parent{$semantics};
	local $keyword = $ALF_Name{$semantics};
	local $rule = $ALF_Value{$semantics};
	local $context = &ALF_FindMatchingObject($semantics,'CONTEXT');
	local $valuetype = &ALF_FindMatchingObject($semantics,'VALUETYPE');
	local $values = &ALF_FindMatchingObject($semantics,'VALUES');
	local $referencetype = &ALF_FindMatchingObject($semantics,'REFERENCETYPE');
	local $default = &ALF_FindMatchingObject($semantics,'DEFAULT');
	local $si_model = &ALF_FindMatchingObject($semantics,'SI_MODEL');
	if (defined($rule)) {
		print("# ALF Semantics Error:\tinvalid rule $rule in semantics declaration $semantics ",&ALF_ObjectInfoText($semantics),"\n") unless &StringMatch($rule,
				'annotation',
				'single_value_annotation',
				'multi_value_annotation',
				'annotation_container',
				'arithmetic_model',
				'arithmetic_submodel',
				'arithmetic_model_container',
				'geometric_model',
		);
	}
	if (defined($valuetype)) {
		if (&StringMatch($rule,'annotation','single_value_annotation','multi_value_annotation')) {
			print("# ALF Semantics Error:\trule $rule with invalid qualifier $valuetype ",&ALF_ObjectInfoText($valuetype),"\n") unless &StringMatch($ALF_Value{$valuetype},
				'number',
				'signed_integer',
				'unsigned_integer',
				'multiplier_prefix_value',
				'identifier',
				'string_value',
				'quoted_string',
				'boolean_value',
				'edge_value',
				'control_expression',
				'boolean_expression',
				'arithmetic_expression',
			);
		}
		if (&StringMatch($rule,'arithmetic_model')) {
			print("# ALF Semantics Error:\trule $rule with invalid $valuetype ",&ALF_ObjectInfoText($valuetype),"\n") unless &StringMatch($ALF_Value{$valuetype},
				'number',
				'signed_integer',
				'unsigned_integer',
				'multiplier_prefix_value',
				'identifier',
				'bit_literal',
				'based_literal',
			);
		}
		if (&StringMatch($rule,'annotation_container','arithmetic_submodel','arithmetic_model_container','geometric_model')) {
			print("# ALF Semantics Error:\trule $rule cannot have $valuetype ",&ALF_ObjectInfoText($valuetype),"\n");
		}
		if (defined($values)) {
			foreach $value (&Array($ALF_Value{$values})) {
				print("# ALF Semantics Error:\tconflict between $valuetype ",&ALF_ObjectInfoText($valuetype)," and $values ",&ALF_ObjectInfoText($values),"\n") unless (&ALF_LexicalMatch($ALF_Value{$valuetype},$value) || &ALF_LexicalMatch($ALF_LexicalImplication{$ALF_Value{$valuetype}},$value));
			}
		}
	}
	if (defined($default)) {
		if (defined($values)) {
			print("# ALF Semantics Error:\tconflict between $values ",&ALF_ObjectInfoText($values)," and $default ",&ALF_ObjectInfoText($default),"\n") unless defined(&FindArrayKey($ALF_Value{$values},$ALF_Value{$default}));
		} elsif (defined($valuetype)) {
			print("# ALF Semantics Error:\tconflict between $valuetype ",&ALF_ObjectInfoText($valuetype)," and $default ",&ALF_ObjectInfoText($default),"\n") unless (&ALF_LexicalMatch($ALF_Value{$valuetype},$ALF_Value{$default}) || &ALF_LexicalMatch($ALF_LexicalImplication{$ALF_Value{$valuetype}},$ALF_Value{$default}));
		} else {
			print("# ALF Semantics Error:\tinvalid default $default ",&ALF_ObjectInfoText($default),"\n");
		}
	}
	if (defined($si_model)) {
		print("# ALF Semantics Error:\trule $rule cannot have si_model $si_model ",&ALF_ObjectInfoText($si_model),"\n") unless (defined($rule) && &StringMatch($rule,'arithmetic_model') || &ALF_SyntaxMatch('arithmetic_model',$keyword));
	}
	foreach $qualifier ($context,$valuetype,$values,$referencetype,$default,$si_model) {
		if (defined($qualifier)) {
			print("# ALF Semantics Info:\tqualifier $qualifier of semantics declaration $semantics:\t",&ALF_ObjectInfoText($qualifier),"\n") if $ALF_Debug;
		}
	}
	local $objects = &CreateArray();
	&ALF_SearchForObjects($objects,$parent,'ALF_ObjectMatch',$keyword);
	&ALF_SearchForObjects($objects,$parent,'ALF_HierarchicalMatch',$keyword) if &ALF_LexicalMatch('hierarchical_identifier',$keyword);
	foreach $object (&Array($objects)) {
		local $syntax = $ALF_SyntaxRule{$ALF_Type{$object}};
		unless ($ALF_Name{$object} && &StringMatch($syntax,'generic_object','library_specific_object')) {
			&ALF_CheckSemanticsCompliance($object,$keyword,$rule,$context,$valuetype,$values,$referencetype);
		}
	}
	1;
}

sub ALF_CheckSemanticsCompliance {	local($object,$keyword,$rule,$context,$valuetype,$values,$referencetype) = @_;
	print("# ALF Semantics Info:\tvalidating semantics of object $object:\t",&ALF_ObjectInfoText($object),"\n") if $ALF_Debug;
	local $syntax = $ALF_SyntaxRule{$ALF_Type{$object}};
	local $name = $ALF_Name{$object};
	local $value = $ALF_Value{$object};
	local $children = $ALF_Children{$object};
	if (defined($rule)) {
		if (&StringMatch($rule,'annotation_container','arithmetic_model','arithmetic_submodel','arithmetic_model_container','geometric_model')) {
			if (&StringMatch($syntax,$rule)) {
				print("# ALF Semantics Info:\tsyntax \47$syntax\47 of object $object matches rule \47$rule\47\n") if $ALF_Debug;
			} else {
				print("# ALF Semantics Error:\tsyntax \47$syntax\47 of object $object does not match rule \47$rule\47\n");
			}
		} elsif (&StringMatch($rule,'annotation','single_value_annotation','multi_value_annotation')) {
			if ($name || $children) {
				print("# ALF Semantics Error:\tobject $object does not comply with rule \47$rule\47\n");
			} elsif (&StringMatch($rule,'single_value_annotation')) {
				print("# ALF Semantics Error:\tobject $object does not comply with rule \47$rule\47\n") if defined(&Array($value));
			} elsif (&StringMatch($rule,'multi_value_annotation')) {
				print("# ALF Semantics Error:\tobject $object does not comply with rule \47$rule\47\n") unless defined(&Array($value));
			}
			if (! &StringMatch($syntax,'generic_object','library_specific_object','annotation','single_value_annotation','multi_value_annotation')) {
				print("# ALF Semantics Error:\tsyntax $syntax of object $object is not compatible with rule \47$rule\47\n");
			} elsif (&StringMatch($syntax,'single_value_annotation') && &StringMatch($rule,'multi_value_annotation')) {
				print("# ALF Semantics Error:\tsyntax $syntax of object $object is not compatible with rule \47$rule\47\n");
			} elsif (&StringMatch($syntax,'multi_value_annotation') && &StringMatch($rule,'single_value_annotation')) {
				print("# ALF Semantics Error:\tsyntax $syntax of object $object is not compatible with rule \47$rule\47\n");
			} else {
				print("# ALF Semantics Info:\tsyntax \47$syntax\47 of object $object is compatible with rule \47$rule\47\n") if $ALF_Debug;
			}
		}
	}
	local $match;
	if (defined($context)) {
		local $contextval = $ALF_Value{$context};
		local @context = &ArraySize($contextval)? &Array($contextval) : ($contextval);
		local $parent = &ALF_LexicalMatch('hierarchical_identifier',$keyword)? &ALF_HierarchicalMatch($object,$keyword) : $ALF_Parent{$object};
		local $parenttype = $ALF_Type{$parent};
		if (&StringMatch($parenttype,@context)) {
			print("# ALF Semantics Info:\tparenttype \47$parenttype\47 of object $object matches a type in set (@context)\n") if $ALF_Debug;
		} elsif ($match = &ALF_HierarchicalMatch($parent,undef,@context)) {
			print("# ALF Semantics Info:\tparenttype \47$parenttype\47 of object $object matches hierarchical definition \47$match\47 in set (@context)\n") if $ALF_Debug;
		} elsif (defined($parenttype)) {
			print("# ALF Semantics Error:\tparenttype \47$parenttype\47 of object $object does not match a type in set (@context)\n");
		} else {
			print("# ALF Semantics Warning:\tobject $object appears out of context defined in set (@context)\n");
		}
	}
	local @testval = &ArraySize($value)? &Array($value) : defined($value)? ($value) : ();
	if (defined($valuetype)) {
		local $valtypeval = $ALF_Value{$valuetype};
		foreach $testval (@testval) {
			if (&ALF_LexicalMatch($valtypeval,$testval) || &ALF_LexicalMatch($ALF_LexicalImplication{$valtypeval},$testval)) {
				print("# ALF Semantics Info:\tvalue \47$testval\47 of object $object matches valuetype \47$valtypeval\47\n") if $ALF_Debug;
			} else {
				print("# ALF Semantics Error:\tvalue \47$testval\47 of object $object does not match valuetype \47$valtypeval\47\n");
			}
		}
	}
	if (defined($values)) {
		local @values = &Array($ALF_Value{$values});
		foreach $testval (@testval) {
			if (&StringMatch($testval,@values)) {
				print("# ALF Semantics Info:\tvalue \47$testval\47 of object $object matches a value in set (@values)\n") if $ALF_Debug;
			} elsif ($match = &ALF_SemanticsMatch($testval,@values)) {
				print("# ALF Semantics Info:\tvalue \47$testval\47 of object $object matches semantics of \47$match\47 in set (@values)\n") if $ALF_Debug;
			} elsif (defined($valuetype)) {
				print("# ALF Semantics Warning:\tvalue \47$testval\47 of object $object does not match a value in set (@values)\n");
			} else {
				print("# ALF Semantics Error:\tvalue \47$testval\47 of object $object does not match a value in set (@values)\n");
			}
		}
	}
	if (defined($referencetype)) {
		local $reftype = $ALF_Value{$referencetype};
		local @reftype = &ArraySize($reftype)? &Array($reftype) : ($reftype);
		local @val = &ArraySize($value)? &Array($value) : ($value);
		foreach $val (@val) {
			local $found;
			local $ancestor = $ALF_Parent{$object}; 
			foreach $type (@reftype) {
				while ($ALF_Type{$ancestor} && !$found) {
					print("# ALF Semantics Info:\tlooking for object of type $type and name $val in $ancestor ",&ALF_ObjectInfoText($ancestor),"\n") if (ALF_Debug > 1);
					$found = &ALF_SearchForObject($ancestor,'ALF_ObjectMatch',$type,$val);
					$ancestor = $ALF_Parent{$ancestor};
				}
				last if $found;
			}
			if ($found) {
				print("# ALF Semantics Info:\tfound reference $found ",&ALF_ObjectInfoText($found)," for object $object ",&ALF_ObjectInfoText($object),"\n") if $ALF_Debug;
			} else {
				print("# ALF Semantics Error:\tdid not find reference of type ",join(' or ',@reftype)," with name $val for object $object ",&ALF_ObjectInfoText($object),"\n");
			}
		}
	} elsif (&StringMatch($syntax,'generic_object','library_specific_object') && !&ALF_LexicalMatch('hierarchical_identifier',$keyword)) {
		print("# ALF Semantics Error:\tmissing referencetype for \47$rule\47 $object ",&ALF_ObjectInfoText($object)," refering to a \47$syntax\47\n");
	}
}

sub ALF_SemanticsMatch {	local($type,@candidates) = @_;
	local $match = 0;
	foreach $candidate (@candidates) {
		$match = $candidate if (&ALF_SyntaxMatch($candidate,$type));
		last if $match;
	}
	$match;
}

sub ALF_HierarchicalMatch {	local($object,@hiertype) = @_;
	local $match = 0;
	foreach $hiertype (@hiertype) {
		local @hier = reverse(split(/\./,$hiertype));
		if ($#hier > 0) {
			$match = $object;
			print("# ALF Semantics Info:\ttrying to match hierarchical qualifier $hiertype with object $match:\t",&ALF_ObjectInfoText($match),"\n") if ($ALF_Debug > 1);
			local $undef = 0;
			foreach $hier (@hier) {
				if (!$hier) {
					$undef = 1;
				} elsif ($undef) {
					$match = &ALF_FindAncestor($match,$hier);
					$undef = 0;
				} elsif (&StringMatch($hier,$ALF_Type{$match})) {
					$match = $ALF_Parent{$match};
				} else {
					$match = 0;
				}
				last unless $match;
				print("# ALF Semantics Info:\tfound possible parent $match of object with hierarchical qualifier \47$hier\47:\t",&ALF_ObjectInfoText($match),"\n") if ($ALF_Debug > 1);
			}
		}
		if ($match) {
			print("# ALF Semantics Info:\thierarchical qualifier $hiertype matches with object $object\t",&ALF_ObjectInfoText($object),"\n") if $ALF_Debug;
		}
		last if $match;
	}
	$match;
}