########################
### Global variables ### 
########################

$ProgramName = 'OpenALF';
$ProgramVersion = '2006.9';
$AutoFirstLine = "ALF_REVISION \42IEEE 1603-2003\42\n// "; 
$AutoNameID = 'ALF';
$AutoNameCount = 0;

%ALF_Parent = ();	### parent(object)
%ALF_Type = (); 	### type(object)
%ALF_1stIndex = ();	### firstindex(object)
%ALF_Name = (); 	### name(object)
%ALF_2ndIndex = ();	### secondindex(object)
%ALF_Value = ();	### value(object) in case of atomic or compount object. Pointer to value(object) in case of semi-compound object.
%ALF_Children = ();	### pointer to children(object)
%ALF_Insert = ();	### defines the position where new children(object) will be added to the list.
%ALF_Prepend = ();	### defines whether new children(object) will be added before or after a previously defined member of the list.

%ALF_Hidden = ();	### hidden(object) is a flag to not print out an object.
%ALF_Link = ();		### link(object) is a pointer to a currently related object.
%ALF_Unlink = ();	### unlink(object) is a pointer to a formerly related object.
%ALF_Flatten = ();	### flatten(type(object)) is a flag to flatten an object in the database.
%ALF_ArrayFormat = ();	### arrayformat(value(object)) is a directive for printing formatted array in output file.
%ALF_ArrayCopy = ();	### arraycopy(value(object)) is a directive to copy an array instead of a pointer to the array, in case object is copied.
%ALF_SyntaxRule = ();	### syntaxrule(type(object)) is a syntax rule self-represented in ALF (as opposed to a syntax rule represented in BNF).
%ALF_Original = ();	### original(object) is a pointer to another object from which this object was copied from.
%ALF_Reference = ();	### reference(type(object)) is a cross-reference between an object and its reference, where syntaxrule(type(object))=instantiation.
%ALF_AssignmentList=();	### assignmentlist(reference(type(object))) is a pointer to a list of variables associated with reference(type(object)). Those variables will need key-value assignments, when the object is referenced.
%ALF_MemberList = ();	### memberlist(object) is a pointer to a list of variables associated with the subscripts of a vectorized object (e.g. PINGROUP).
%ALF_KeyTable = ();	### keytable(value(object)) is a set of pointers to lookup table keys for arithmetic model evaluation.
%ALF_KeyOffset = ();	### keyoffset(value(object)) is a set of pointers to the distance between data in a table corresponding to subsequent data in the table keys.
%ALF_KeyId = ();	### keyid(value(object)) is a set of pointers to the symbols used in an arithmetic expression.
@ALF_Keys = ();    	### keys(value(object)) is the ordered list of keys to access keytable(value(object)) and keyoffset(value(object)) or keyid(value(object)).

$ALF_ExpressionRuleSet{'boolean_expression'} = &CreateArray(
	'( boolean_expression )',
	'boolean_value',
	'identifier',
	'boolean_binary_operator boolean_expression',
	'? boolean_expression : boolean_expression',
	'boolean_unary_operator boolean_expression',
);

$ALF_ExpressionRuleSet{'vector_expression'} = &CreateArray(
	'( vector_expression )',
	'vector_expression_macro',
	'single_event',
	'vector_operator vector_expression',
	'control_and boolean_expression',
	'boolean_expression',
	'control_and vector_expression',
	'? vector_expression : vector_expression',
);

%ALF_LexicalImplication = (
	'boolean_expression',	'boolean_value',
	'arithmetic_expression','arithmetic_value',
);

### file IO interface ###

sub ALF_ReadWrite {	local($inputfile,$inputformat,$outputfile,$outputformat,*process,@arg) = @_;
	$outputformat = $inputformat unless defined($outputformat);
	&ALF_InitLexical;
	&FileIn($inputfile,'ALF_ReadLexical');
	local $root = &AutoName;
	local $input = &ALF_Import($inputformat,$root);
	unless (&StringMatch($inputformat,$outputformat)) {		
		local $output
		=	&StringMatch($outputformat,'alf')? 'alf'
		:	&StringMatch($outputformat,'lib','liberty')? 'lib'
		:	undef;
		&ALF_Data2Liberty($root) if ($input eq 'alf' && $output eq 'lib');
		&ALF_LibertyData2ALF($root) if ($input eq 'lib' && $output eq 'alf');
	}
	&process($root,@arg) if defined(&process);
	$AutoFirstLine = "// ";	# 1st line in output file will be preceded by "// "
	&FileOut($outputfile,'ALF_Export',$outputformat,$root) if defined ($outputfile);
	$root;
}

sub ALF_Import {	local($format,$parent) = @_;	### creates database containing children($parent). Returns 'alf' or 'lib'.
	local $input
	=	&StringMatch($format,'alf')? 'ALF_CreateData'
	:	&StringMatch($format,'lib','liberty')? 'ALF_CreateLibertyData'
	:	undef;
	local $return
	=	($input eq 'ALF_CreateData')? 'alf'
	:	($input eq 'ALF_CreateLibertyData')? 'lib'
	:	undef;
	if (defined($input)) {
		print("# System Message:\tcalling \47$input\47\n") if $ALF_Debug;
		&Eval($input,$parent);
	} else {
		print("# System Message:\tinput format \47$format\47 is not supported\n");
	} $return;
}

sub ALF_Export {	local($format,$parent) = @_;	### prints data related to children($parent). Returns true.
	local $output
	=	&StringMatch($format,'alf')? 'ALF_WriteObject'
	:	&StringMatch($format,'lib','liberty')? 'ALF_WriteLibertyObject'
	:	undef;
	if (defined($output)) {
		print("# System Message:\tcalling \47$output\47\n") if $ALF_Debug;
		foreach $child (&Array($ALF_Children{$parent})) {
			unless ($ALF_Hidden{$child}) {
				print("# ALF Data Info:\tprinting object \47$child\47 in $format format\t",&ALF_ObjectInfoText($child),"\n") if $ALF_Debug;
				&Eval($output,$child);
			}
		}
	} else {
		print("# System Message:\toutput format \47$format\47 is not supported\n");
	} 1;
}

### internal data access ###

sub ALF_ObjectInfo {	local($object) = @_;	### returns list of parent($object),type($object),name($object),value($object)
	(	$ALF_Parent{$object},
		$ALF_Type{$object},
		$ALF_Name{$object},
		$ALF_Value{$object},
		$ALF_Children{$object},
	);
}

sub ALF_ObjectInfoText {	local($object,@assoc) = @_;	### returns a formatted string based on parent($object), type($object), name($object), value($object)
	local ($parent,$type,$name,$value) = &ALF_ObjectInfo($object);
	local @info;
	$info[$#info+1] = "object = \47$object\47";
	$info[$#info+1] = "parent = \47$parent\47" if $parent;
	$info[$#info+1] = "type = \47$type\47" if $type;
	$info[$#info+1] = "name = \47$name\47" if $name;
	if (defined($value)) {
		if (&ArraySize($value)) {
			local @value = &Array($value);
			$info[$#info+1] = $ALF_Debug? "values = $value ( @value )" : "values = ( @value )";
		} else {
			$info[$#info+1] = "value = \47$value\47";
		}
	}
	foreach $assoc (@assoc) {
		local $other = &AssocVal($assoc,$object);
		if (defined($other)) {
			if (&ArraySize($other)) {
				local @other = &Array($other);
				$info[$#info+1] = $ALF_Debug? "$assoc = $other ( @other )" : "$assoc = ( @other )";
			} else {
				$info[$#info+1] = "$assoc = \47$other\47";
			}
		}
	}
	join(",\t",@info);
}

sub ALF_BusInfo {	local($object) = @_;	### returns list of index1($object),index2($object) 
	local $index1 = $ALF_1stIndex{$object};
	local $index2 = $ALF_2ndIndex{$object};
	(defined $index2)? ($index1,$index2) : (defined $index1)? ($index1) : ();
}

sub ALF_CreateObject {	local($parent,$type,$name,$value,%other) = @_;	### creates and returns an object and defines its $parent,$type,$name,$value
	local $object = &AutoName;
	if ($parent) {
		$ALF_Children{$parent} = &CreateArray() unless defined($ALF_Children{$parent});
		$ALF_Parent{$object} = $parent;
	&ALF_ReinsertObject($object,$parent);
	}
	$ALF_Type{$object} = $type if $type;
	$ALF_Name{$object} = join(' ',split(/\s+/,$name)) if $name;
	$ALF_Value{$object} = $value if defined($value);
	foreach $key (keys %other) {
		&AppendAssoc($key,$object,$other{$key});
	}
	print("# ALF Data Info:\tcreated object $object:\t",&ALF_ObjectInfoText($object,keys %other),"\n") if $ALF_Debug;
	$object;
}

sub ALF_CreateAnnotationContainer {	local($parent,$type,%annotation) = @_;
	local $object = &ALF_CreateObject($parent,$type);
	$ALF_Children{$object} = &CreateArray();
	foreach $key (keys %annotation) {
		&ALF_CreateObject($object,$key,$undef,$annotation{$key});
	} 
}

sub ALF_ReinsertObject {	local($object,$parent) = @_;
	if ($ALF_Prepend{$parent} && !$ALF_Insert{$parent}) {
		&PrependArray($ALF_Children{$parent},$object);
	} elsif (defined($ALF_Insert{$parent})) {
		if ($ALF_Prepend{$parent}) {
			&InsertArray($ALF_Insert{$parent},$ALF_Children{$parent},$object);
		} else {
			&InsertArray($ALF_Insert{$parent}+1,$ALF_Children{$parent},$object);
			$ALF_Insert{$parent} = $ALF_Insert{$parent} + 1;
		}
	} else {
		&AppendArray($ALF_Children{$parent},$object);
	} 1;
}

sub ALF_RedefineObject {	local($object,$parent,$type,$name,$value,%other) = @_;
	$ALF_Unlink{$object} = $ALF_Parent{$object} unless ($ALF_Parent{$object} eq $parent);
	$ALF_Children{$parent} = &CreateArray() unless defined($ALF_Children{$parent});
	&ALF_ReinsertObject($object,$parent) unless defined(&FindArrayKey($ALF_Children{$parent},$object));
	$ALF_Parent{$object} = $parent;
	$ALF_Type{$object} = $type;
	$ALF_Name{$object} = $name if defined($name);
	$ALF_Value{$object} = $value if defined($value);
	foreach $key (keys %other) {
		&AppendAssoc($key,$object,$other{$key});
	}
	print("# ALF Data Info:\tredefined object $object:\t",&ALF_ObjectInfoText($object,keys %other),"\n") if $ALF_Debug;
	1;
}

sub ALF_InsertObject {	local($sibling,$type,$name,$value,%other) = @_;
	local $parent = $ALF_Parent{$sibling};
	local $insert = $ALF_Insert{$parent};
	local $newinsert = &FindArrayKey($ALF_Children{$parent},$sibling);
	$ALF_Insert{$parent} = $newinsert;
	local $object = &ALF_CreateObject($parent,$type,$name,$value,%other);
	$ALF_Insert{$parent} = ($newinsert > $insert)? $insert : $insert + 1;
	$object;
}

### object search ###

sub ALF_SearchForObjects {	local($found,$parent,$matchfunction,@args) = @_;
	local $children = $ALF_Children{$parent};
	local @candidates = defined($children)? &Array($children) : ();
	print("# ALF Data Info:\tsearching for objects\tmatchfunction = $matchfunction(@args)\tcandidates = (@candidates)\t",&ALF_ObjectInfoText($parent),"\n") if $ALF_Debug;
	foreach $candidate (@candidates) {
		if (&Eval($matchfunction,$candidate,@args)) {
			print("# ALF Data Info:\tfound object\tmatchfunction = $matchfunction(@args)\t",&ALF_ObjectInfoText($candidate),"\n") if $ALF_Debug;
			&AppendArray($found,$candidate);
		} else {
			&ALF_SearchForObjects($found,$candidate,$matchfunction,@args);
		}
	} $found;
}
sub ALF_SearchForObject {	local($parent,$matchfunction,@args) = @_;
	local $found;
	local $children = $ALF_Children{$parent};
	local @candidates = defined($children)? &Array($children) : ();
	print("# ALF Data Info:\tsearching for object\tmatchfunction = $matchfunction(@args)\tcandidates = (@candidates)\t",&ALF_ObjectInfoText($parent),"\n") if $ALF_Debug;
	foreach $candidate (@candidates) {
		if (&Eval($matchfunction,$candidate,@args)) {
			print("# ALF Data Info:\tfound object\tmatchfunction = $matchfunction(@args)\t",&ALF_ObjectInfoText($candidate),"\n") if $ALF_Debug;
			$found = $candidate;
		} else {
			$found = &ALF_SearchForObject($candidate,$matchfunction,@args);
		}
		last if $found;
	} $found;
}

sub ALF_HideAllChildren {	local($parent,$hidden) = @_;
	foreach $child (&Array($ALF_Children{$parent})) {
		$ALF_Hidden{$child} = $hidden;
		&ALF_HideAllChildren($child,$hidden);
	}
}

### syntax parsing ###

sub ALF_SyntaxError {	local($rule,$token) = @_;	### prints error message related to syntax $rule and $ALF_ParserData[$token]. Increments $token until start of next valid statement and returns that token
	local $line = &ALF_CurrentLineNumber($token);
	local $left = $ALF_ParserData[$token];
	local $next;
	until ($next || $token > $#ALF_ParserData) {
		$token += 1;
		$next = &StringMatch($ALF_ParserData[$token],';','{','}');
		print("# ALF Syntax Info:\tsearching resync for rule $rule:\t$token ",$ALF_ParserData[$token],"\n") if ($ALF_Debug > 1);
	}
	$token = $token-1 unless ($ALF_ParserData[$token] eq ';');
	local $right = $ALF_ParserData[$token];
	print("# ALF Syntax Error:\ttext in line $line between \47$left\47 and \47$right\47 does not match rule \47$rule\47\n");
	$token;
}

### unit conversion ###

sub ALF_MultiplierPrefix2Number {	local($multiplier_prefix) = @_;
	&ALF_LexicalMatch('giga' ,$multiplier_prefix)? 1e9   :
	&ALF_LexicalMatch('mega' ,$multiplier_prefix)? 1e6   :
	&ALF_LexicalMatch('kilo' ,$multiplier_prefix)? 1e3   :
	&ALF_LexicalMatch('unity',$multiplier_prefix)? 1     :
	&ALF_LexicalMatch('milli',$multiplier_prefix)? 1-3   :
	&ALF_LexicalMatch('micro',$multiplier_prefix)? 1e-6  :
	&ALF_LexicalMatch('nano' ,$multiplier_prefix)? 1e-9  :
	&ALF_LexicalMatch('pico' ,$multiplier_prefix)? 1e-12 :
	&ALF_LexicalMatch('femto',$multiplier_prefix)? 1e-15 :
	0;
}

1;