init

Tools/CodeGeneration/Templates/Common/std.tdl

@@ -0,0 +1,334 @@
+ //*****************************************************************************
+// $RCSfile: std.tdl,v $
+// $Revision: 1.2 $
+// $Date: 2002/03/08 15:54:33 $
+// Author: Markus Kern
+//*****************************************************************************
+/*
+Contains language independent procedures and templates. These are used by the
+language dependent code generators.
+See the documentation for a description of these procedures and templates
+*/
+
+//------------------------------------------------------------------------------
+proc setCount(count)
+	[__COUNT__] = [count];
+end proc
+
+proc addCount(number)
+	[__COUNT__] = add([__COUNT__],[number]);
+end proc
+
+proc getCount()
+	return [__COUNT__];
+end proc
+
+proc setDelim(delim)
+	[__DELIM__] = [delim];
+end proc
+
+proc delim()
+	return [__DELIM__];
+end proc
+
+proc setVar(varName, varValue)
+	[[varName]] = [varValue];
+end proc
+
+//------------------------------------------------------------------------------
+proc setString(init)
+	[__INIT__] = [init];
+	return [init];
+end proc
+
+proc getString()
+	local txt = [__INIT__];
+	[__INIT__] = "";
+	return [txt];
+end proc
+
+//------------------------------------------------------------------------------
+tcl_proc add(num1, num2)
+	return [expr $num1 + $num2]
+end proc
+
+tcl_proc sub(num1, num2)
+	return [expr $num1 - $num2]
+end proc
+
+tcl_proc mul(num1, num2)
+	return [expr $num1 * $num2]
+end proc
+
+tcl_proc div(num1, num2)
+	return [expr $num1 / $num2]
+end proc
+
+//------------------------------------------------------------------------------
+tcl_proc time()
+	return [clock format [clock seconds] -format "%X"]
+end proc
+
+tcl_proc date()
+	return [clock format [clock seconds] -format "%x"]
+end proc
+
+//------------------------------------------------------------------------------
+tcl_proc hostname()
+	return [info hostname]
+end proc
+
+//------------------------------------------------------------------------------
+tcl_proc replace(str, expr, subSpec)
+	set ret "";
+	regsub -all $expr $str $subSpec ret;
+	return $ret;
+end proc
+
+tcl_proc toUpper(str)
+	return [string toupper $str];
+end proc
+
+tcl_proc toLower(str)
+	return [string tolower $str];
+end proc
+
+tcl_proc getLength(str)
+	return [string length $str];
+end proc
+
+tcl_proc lsdir(dir)
+	return [file dirname $dir];
+end proc
+
+tcl_proc mkdir(dir)
+	file mkdir $dir;
+end proc
+
+tcl_proc dirName(file)
+	set dirName [file dirname $file];
+	if { $dirName == "" } {	return "";}
+	set delim "/"
+	return $dirName$delim;
+end proc
+
+tcl_proc fileName(file)
+	set fileList [file split $file]
+	return [lindex $fileList [ expr [llength $fileList] - 1]]
+end proc
+
+tcl_proc regexp(str,reg)
+	set ret ""
+	regexp $reg $str ret;
+	return $ret;
+end proc
+
+tcl_proc createString(str,count)
+	set x 0
+	set ret ""
+	while {$x < $count} {
+		set ret $ret$str
+		incr x
+	}
+	return $ret
+end proc
+
+//------------------------------------------------------------------------------
+tcl_proc invIdOrder(list)
+	set invList "";
+	set li [split $list " "];
+	foreach {elem} $li {
+		set invList [concat $elem $invList]
+	}
+	return $invList	
+end proc
+
+//------------------------------------------------------------------------------
+proc isExternal(MClass)
+	loop(MClass->Note->Item
+	Where [Item.value] == "True" AND [Item.type] == "UmlClassIsImported")
+		return TRUE;
+	end loop
+	return FALSE;
+end proc
+
+//------------------------------------------------------------------------------
+proc getStereotype(MSemElement)
+	loop(MSemElement->Stereotype)
+		return [Stereotype.name];
+	end loop
+end proc
+
+//------------------------------------------------------------------------------
+proc getMultiplicity(multiplicity)
+
+	switch([multiplicity])
+	case "":
+	case "1":
+	case "0..1":
+	case "1..0":
+	case "0..0":
+		return "One";
+
+	case "*":
+	case "1..*":
+	case "n":
+	case "N":
+		return "Many";
+
+	case regexp([multiplicity],"[0-9]+"):
+		return [multiplicity];
+
+	case regexp([multiplicity],"[0-9]+\.\.[0-9]+"):
+		return split([multiplicity],".","T");
+
+	default:
+		return "Many";
+
+	end switch
+end proc
+
+//------------------------------------------------------------------------------
+tcl_proc split(str,delim,pos)
+
+	set li [split $str $delim];
+	switch $pos { 
+		"L"	{
+			return [lindex $li 0]
+		} 
+
+		"T"	{
+			return  [lindex $li [ expr [llength $li] - 1]]
+		} 
+
+		default {
+			return [lindex $li $pos]
+		} 	
+	}
+end proc
+
+//------------------------------------------------------------------------------
+proc setText(init)
+	[__INIT__] = [init];
+	return [init];
+end proc
+
+proc getText()
+	local txt = [__INIT__];
+	[__INIT__] = "";
+	return [txt];
+end proc
+
+//------------------------------------------------------------------------------
+proc outText(text,delim1,delim2)
+	local ret;
+	loop(Instances->TokenSet([text]);setString([delim1]);setString("\n" [delim2]))
+	[ret] = [ret] getString()[TokenSet.line];
+	end loop
+	return [ret];
+end proc
+
+//------------------------------------------------------------------------------
+proc safeOutput(fileName)
+	mkdir(lsdir([fileName]));
+	setOutput([fileName]);
+
+	// This comes last, so that it holds the correct value during the insert/mark fixup process
+	[ACT_OUTPUT_FILE] = [fileName];
+end proc
+
+//------------------------------------------------------------------------------
+proc output(fileName)
+	mkdir(lsdir([fileName]));
+	setOutput(dirName([fileName])"_"fileName([fileName]));
+	appendMergeFile([fileName]);
+	
+	// This comes last, so that it holds the correct value during the insert/mark fixup process
+	[ACT_OUTPUT_FILE] = [fileName];
+end proc
+
+
+proc getOutput()
+	return [ACT_OUTPUT_FILE];
+end proc
+
+//------------------------------------------------------------------------------
+proc setLanguage(language)
+	[ACT_LANGUAGE] = [language];
+end proc
+
+// Generate the id list for the class(es) with specified name.
+// Note that we normally expect a single MClass in the list.
+// This was introduced to improve the code generator performance.
+proc MClass_ids_by_name (name)
+
+   local x = "MClass_by_name_Cache_For_" [name];
+   
+   if ([[x]] == "")
+      loop(Instances -> MClass where [MClass.name] == [name])
+         [[x]] = [[x]] " " [MClass.id];
+//T info = "MClass_ids_by_name #" [x]" -> "[[x]]"\n";  
+      end loop
+   end if
+
+//T info = "MClass_ids_by_name :" [x]" -> "[[x]]"\n";   
+   return [[x]];
+end proc
+
+proc getDataType(type)
+	loop(Instances->MClass(MClass_ids_by_name ([type]))->MDataType->TaggedValue
+	Where [TaggedValue.tag] == [ACT_LANGUAGE])
+		return [TaggedValue.value];
+	end loop
+//info = "MClass_ids_by_name #" [ACT_LANGUAGE] "\n";  
+	return [type];
+end proc
+
+//------------------------------------------------------------------------------
+template genLines(Lines)
+[loop(Instances->TokenSet([Lines]))]
+[TokenSet.line]
+[end loop]
+end template
+
+//------------------------------------------------------------------------------
+proc getUniqueId(MElement)
+     loop (MElement->MSemElement where [MSemElement.guid] != "")
+         return [MSemElement.guid];
+     end loop
+     return [MElement.id];
+end proc
+
+//------------------------------------------------------------------------------
+tcl_proc appendMergeFile(fileName)
+    catch {
+        set file [open "_acdGeneratedFiles.mrg"  "a"];
+        puts $file $fileName;
+        close $file
+    }
+end proc
+
+//------------------------------------------------------------------------------
+tcl_proc delMergeFile()
+    catch {
+        file delete "_acdGeneratedFiles.mrg"
+    }
+end proc
+
+// ECR 5664 begin
+
+tcl_proc substring(text, first, last)
+    return [string range $text $first $last];
+end proc
+
+tcl_proc searchstr(text, str, start)
+    variable res
+    set res [string first $str [string range $text $start end]]
+    if {$res == -1} {
+        return -1
+    } else {
+        return [expr $start + $res]
+    }
+end proc
+
+// ECR 5664 end