[Ooc-checkins] ooc2/src/H2O Translate.Mod,1.11,1.12

[Stewart G. <sgr...@us...>]

Update of /cvsroot/ooc/ooc2/src/H2O
In directory sc8-pr-cvs3.sourceforge.net:/tmp/cvs-serv21054

Modified Files:
	Translate.Mod 
Log Message:
Refactored tag handling. Added support for Component Pascal output.
(settings are thanks to Bernhard Treutwein).



Index: Translate.Mod
===================================================================
RCS file: /cvsroot/ooc/ooc2/src/H2O/Translate.Mod,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -d -r1.11 -r1.12
--- Translate.Mod	13 Dec 2006 01:46:26 -0000	1.11
+++ Translate.Mod	2 Mar 2007 01:58:47 -0000	1.12
@@ -45,6 +45,11 @@
   renameProcedures : Option.Boolean;
   tagSuffix : Option.String;
   autoPrefix : Option.String;
+  varTag : Option.String;
+  arrayTag : Option.String;
+  unionTag : Option.String;
+  recordTag : Option.String;
+  oocHeader : Option.Boolean;
 
 (*
 Elimination of type constructors:
@@ -273,6 +278,14 @@
   END;
 END RewriteAliasesList;
 
+PROCEDURE OutTag(e : Emitter.Emitter; value : STRING);
+BEGIN
+  IF (value # NIL) & (value.length > 0) THEN
+    e.WriteObject(value);
+    e.WriteChar(' ');
+  END;
+END OutTag;
+
 PROCEDURE MapNumber(e : Emitter.Emitter;
   size : LONGINT; m1, m2, m4, m8 : Option.String);
 BEGIN
@@ -311,10 +324,11 @@
       name := buf.ToString();
     END;
     e.WriteObject(name);
+    e.WriteString(" ");
     IF var THEN
-      e.WriteString(" [NIL_COMPAT]");
+      OutTag(e, varTag.value);
     END;
-    e.WriteString(" : ");
+    e.WriteString(": ");
     IF var THEN
       WriteType(e, obj.type.base, mod, level);
     ELSE
@@ -355,7 +369,9 @@
     IF Variant.cstring IN t.variant THEN
       e.WriteString("[CSTRING] ");
     END;
-    e.WriteString("TO ARRAY OF ");
+    e.WriteString("TO ARRAY ");
+    OutTag(e, arrayTag.value);
+    e.WriteString("OF ");
     WriteType(e, t.base, mod, level);
   END;
 END WritePointerType;
@@ -363,6 +379,7 @@
 PROCEDURE WriteArrayType(e : Emitter.Emitter; t : Type.Type; mod : Type.Module; level : INTEGER);
 BEGIN
   e.WriteString("ARRAY ");
+  OutTag(e, arrayTag.value);
   IF t.size >= 0 THEN
     e.WriteInt(t.size); e.WriteChar(" ");
   END;
@@ -376,9 +393,11 @@
   namelessCount : LONGINT;
 BEGIN
   namelessCount := 0;
-  e.WriteString("RECORD"); 
+  e.WriteString("RECORD "); 
   IF t.class = Type.tUnion THEN
-    e.WriteString(" [UNION]");
+    OutTag(e, unionTag.value);
+  ELSE
+    OutTag(e, recordTag.value);
   END;
   IF t.link # NIL THEN
     e.WriteLn;
@@ -588,8 +607,11 @@
       IF count > 0 THEN
         e.WriteString("; ");
       END;
-      e.WriteObject(type);
-      e.WriteString(' "');
+      IF type.length > 0 THEN
+        e.WriteObject(type);
+        e.WriteChar(" ");
+      END;
+      e.WriteString('"');
       e.WriteObject(list.value.Get(i));
       e.WriteString('"');
       INC(count);
@@ -676,16 +698,21 @@
   e := NEW(Emitter.Emitter, writer);
   e.WriteString("MODULE ");
   e.WriteObject(m.outputName.value);
-  e.WriteString(' [ INTERFACE "');
-  e.WriteObject(m.interfaceType.value);
-  e.WriteString('"');
-  IF (m.linkFramework.value.size > 0) OR (m.linkLib.value.size > 0) OR (m.linkFile.value.size > 0) THEN
-    e.WriteString("; LINK ");
-    depCount := 0;
-    ListDependencies(depCount, "FRAMEWORK", m.linkFramework);
-    ListDependencies(depCount, "LIB", m.linkLib);
-    ListDependencies(depCount, "FILE", m.linkFile);
-    e.WriteString(" END");
+  depCount := 0;
+  e.WriteString(" [ ");
+  IF oocHeader.value THEN
+    e.WriteString('INTERFACE "');
+    e.WriteObject(m.interfaceType.value);
+    e.WriteString('"');
+    IF (m.linkFramework.value.size > 0) OR (m.linkLib.value.size > 0) OR (m.linkFile.value.size > 0) THEN
+      e.WriteString("; LINK ");
+      ListDependencies(depCount, "FRAMEWORK", m.linkFramework);
+      ListDependencies(depCount, "LIB", m.linkLib);
+      ListDependencies(depCount, "FILE", m.linkFile);
+      e.WriteString(" END");
+    END;
+  ELSE
+    ListDependencies(depCount, "", m.linkLib);
   END;
   e.WriteString(" ];");
   e.WriteLn;
@@ -766,17 +793,44 @@
   END;
 END Translate;
 
+(* Initialise the translator to generate Component Pascal source code. *)
+
+PROCEDURE InitCP*;
+BEGIN
+  mapCharType.value := "SHORTCHAR";
+  mapUnsignedCharType.value := mapCharType.value;
+  mapShortType.value := "SHORTINT";
+  mapUnsignedShortType.value := mapUnsignedShortType.value;
+  mapLongType.value := "INTEGER";
+  mapUnsignedLongType.value := mapLongType.value;
+  mapLongLongType.value := "LONGINT";
+  mapUnsignedLongLongType.value := mapUnsignedLongLongType.value;
+  mapFloatType.value := "SHORTREAL";
+  mapDoubleType.value := "REAL";
+  mapLongDoubleType.value := "LONGDOUBLE";
+  mapPointer.value := "ANYPTR";
+  mapEnum.value := "INTEGER";
+  mapVoid.value := "";
+  varTag.value := "[nil]";
+  arrayTag.value := "[untagged]";
+  unionTag.value := "[union]";
+  recordTag.value := "[untagged]";
+  oocHeader.value := FALSE;
+END InitCP;
+
+(* Create options with defaults for OOC output *)
+
 PROCEDURE InitOptions;
 BEGIN
   options := NEW(Option.Options);
   mapCharType := options.String("MapChar", "CHAR");
-  mapUnsignedCharType := options.String("MapUnsignedChar", "CHAR");
+  mapUnsignedCharType := options.String("MapUnsignedChar", mapCharType.value);
   mapShortType := options.String("MapShort", "INTEGER");
-  mapUnsignedShortType := options.String("MapUnsignedShort", "INTEGER");
+  mapUnsignedShortType := options.String("MapUnsignedShort", mapShortType.value);
   mapLongType := options.String("MapLong", "LONGINT");
-  mapUnsignedLongType := options.String("MapUnsignedLong", "LONGINT");
+  mapUnsignedLongType := options.String("MapUnsignedLong", mapLongType.value);
   mapLongLongType := options.String("MapLongLong", "HUGEINT");
-  mapUnsignedLongLongType := options.String("MapUnsignedLongLong", "HUGEINT");
+  mapUnsignedLongLongType := options.String("MapUnsignedLongLong", mapLongLongType.value);
   mapFloatType := options.String("MapFloat", "REAL");
   mapDoubleType := options.String("MapDouble", "LONGREAL");
   mapLongDoubleType := options.String("MapLongDouble", "LONGDOUBLE");
@@ -788,7 +842,11 @@
   renameProcedures := options.Boolean("RenameProcedures", TRUE);
   tagSuffix := options.String("TagSuffix", "_tag");
   autoPrefix := options.String("AutoPrefix", "Auto");
-
+  varTag := options.String("VarTag", "[NIL_COMPAT]");
+  arrayTag := options.String("ArrayTag", "");
+  unionTag := options.String("UnionTag", "[UNION]");
+  recordTag := options.String("RecordTag", "");
+  oocHeader := options.Boolean("OOCHeader", TRUE);
   moduleSuffix := options.String("ModuleSuffix", "Mod");
 END InitOptions;