DIRECTORY
  TreesDefs USING [TreeNode, FreeTree],
  PrintingDefs USING [OutCode, PrintComments],
  PrintDclsDefs USING [],
  PrintExprDefs USING [MakeExpression],
  String USING [EqualString],
  Storage USING [AppendString, CopyString, FreeString, Free],
  SymbolTableDefs USING [EnterSymbol, SymbolType];
  

PrintDclsImpl: PROGRAM IMPORTS PrintingDefs, PrintExprDefs, String,
  Storage, TreesDefs, SymbolTableDefs
  EXPORTS PrintDclsDefs = {
  
  -- Global variable (saved from call to call)
  structName: LONG STRING _ "StructA";
  
    
  PrintFunctionHead: PUBLIC PROCEDURE [name: LONG STRING,
  	functionAttributes: LONG POINTER TO TreesDefs.TreeNode,
	pointerTo: BOOLEAN, nameList: LONG POINTER TO TreesDefs.TreeNode,
	argList: LONG POINTER TO TreesDefs.TreeNode] = {
	
    dataType: LONG STRING;
    symType: SymbolTableDefs.SymbolType;
    dcl, itemHead, n: LONG POINTER TO TreesDefs.TreeNode;
    
    PrintingDefs.OutCode[name, 0];
    IF name # NIL THEN Storage.FreeString[name];
    PrintingDefs.OutCode[": PROCEDURE ["L, 0];
    
    FOR n _ nameList, n.right WHILE n # NIL DO
        [dcl, itemHead] _ InDclList[n, argList];
        IF itemHead = NIL THEN {
	    -- enter symbol with blockHeader=TRUE so that the symbol
	    -- will belong to the block about to be entered.
	    SymbolTableDefs.EnterSymbol[n.string,
	            long, long, "INT"L, 0, TRUE];
	    PrintingDefs.OutCode[n.string, 0];
	    PrintingDefs.OutCode[": INT"L, 0]; }
	ELSE PrintOneDeclaration[dcl, 0, ""L, itemHead];
	IF n.right # NIL THEN PrintingDefs.OutCode[", "L, 0];
	ENDLOOP;
	
    IF pointerTo THEN {
        PrintingDefs.OutCode["] RETURNS [LONG POINTER TO "L, 0];
	[symType, dataType] _ GetAttributes[functionAttributes, 0];
	SymbolTableDefs.EnterSymbol[name, pointer, symType, dataType, 1];
	PrintingDefs.OutCode[dataType, 0];
	Storage.FreeString[dataType]; }
    ELSE IF functionAttributes # NIL THEN {
        PrintingDefs.OutCode["] RETURNS ["L, 0];
	[symType, dataType] _ GetAttributes[functionAttributes, 0];
	SymbolTableDefs.EnterSymbol[name, symType, symType, dataType, 0];
	PrintingDefs.OutCode[dataType, 0];
	Storage.FreeString[dataType]; };
	
    PrintingDefs.OutCode["] =\n"L, 0];
    TreesDefs.FreeTree[functionAttributes];
    TreesDefs.FreeTree[argList];
    TreesDefs.FreeTree[nameList]; };
    
    
  InDclList: PROCEDURE [node, list: LONG POINTER TO TreesDefs.TreeNode]
  	RETURNS [dcl, item: LONG POINTER TO TreesDefs.TreeNode] = {
	
    n, dclItemList, dcltor: LONG POINTER TO TreesDefs.TreeNode;
    
    FOR n _ list, n.right WHILE n # NIL DO -- move along dclList
        IF n.left = NIL THEN LOOP;
        FOR dclItemList _ n.left.right, dclItemList.right
            WHILE dclItemList # NIL DO
	        IF dclItemList.left = NIL THEN LOOP;
	        dcltor _ dclItemList.left.left;
	        IF String.EqualString[dcltor.string, node.string] THEN
	            RETURN [n.left, dclItemList.left];
	ENDLOOP;
    ENDLOOP;
    RETURN [NIL, NIL]; };
    
    
  PrintDeclarations: PUBLIC PROCEDURE [node: LONG POINTER TO TreesDefs.TreeNode,
      indent: CARDINAL, separator: LONG STRING, terminateWithSeparator: BOOLEAN] = {
      
    n: LONG POINTER TO TreesDefs.TreeNode;
    
    FOR n _ node, n.right WHILE n # NIL DO
        IF n.nodeType # dclList THEN {
	    PrintingDefs.OutCode["*** No dclList in PrintDeclarations ***"L, 0];
	    PrintingDefs.OutCode[separator, 0];
	    RETURN; };
        PrintOneDeclaration[n.left, indent,
	    IF n.right = NIL AND NOT terminateWithSeparator
	    THEN ""L ELSE separator,
	    NIL];
    ENDLOOP; };
    
    
  GetAttributes: PUBLIC PROCEDURE [node: LONG POINTER TO TreesDefs.TreeNode,
  	    indent: CARDINAL]
	RETURNS [symType: SymbolTableDefs.SymbolType, typeString: LONG STRING] = {
	
    IF node = NIL THEN {
        symType _ none;
        typeString _ Storage.CopyString["*** NIL argument to GetAttributes ***"L];
	RETURN; }
    ELSE IF node.nodeType # attributes THEN {
        symType _ none;
    	typeString _ Storage.CopyString["*** No attributes in GetAttributes ***"L];
	RETURN; }
    ELSE IF node.structure THEN {
        symType _ structure;
        IF node.right = NIL THEN typeString _ Storage.CopyString[node.string]
	ELSE {
	    IF node.string = NIL THEN {
	        typeString _ Storage.CopyString[structName];
		-- move to next generated structure name
	        structName.text[6] _ structName.text[6] + 1; }
	    ELSE typeString _ Storage.CopyString[node.string];
	    PrintingDefs.OutCode[typeString, indent];
	    PrintingDefs.OutCode[": TYPE = RECORD [\n"L, 0];
	    PrintDeclarations[node.right, indent + 1, ",\n"L, FALSE];
	    PrintingDefs.OutCode["];\n"L, indent]; }; }
	    
    ELSE IF node.union THEN {
        symType _ union;
        typeString _ Storage.CopyString["UNION"L]  }
	
    ELSE IF node.enumeration THEN {
        symType _ enumeration;
        typeString _ Storage.CopyString["ENUMERATION"L]  }
	
    ELSE IF node.long THEN {
        symType _ long;
        IF node.unsigned THEN typeString _ Storage.CopyString["LONG CARDINAL"L]
	ELSE IF node.int THEN typeString _ Storage.CopyString["LONG INTEGER"L]
	ELSE IF node.float OR node.double THEN typeString _ Storage.CopyString["LONG REAL"L]
	ELSE typeString _ Storage.CopyString["INT"L]; }
	
    ELSE IF node.unsigned THEN {
        symType _ long;
        typeString _ Storage.CopyString["LONG CARDINAL"L]  }
    ELSE IF node.char THEN {
        symType _ short;
        typeString _ Storage.CopyString["INTEGER"L]  }
    ELSE IF node.short THEN {
        symType _ short;
        typeString _ Storage.CopyString["INTEGER"L]  }
    ELSE IF node.float THEN {
        symType _ real;
        typeString _ Storage.CopyString["REAL"L]  }
    ELSE IF node.double THEN {
        symType _ double;
        typeString _ Storage.CopyString["LONG REAL"L]  }
    ELSE {
        symType _ long;
        typeString _ Storage.CopyString["INT"L];  };
    IF node.class = extern THEN Storage.AppendString[@typeString, "--EXTERN--"L]
    ELSE IF node.class = static THEN Storage.AppendString[@typeString, "--STATIC--"L]; };
    
    
  PrintOneDeclaration: PROCEDURE [node: LONG POINTER TO TreesDefs.TreeNode,
      indent: CARDINAL, separator: LONG STRING,
      oneOnly: LONG POINTER TO TreesDefs.TreeNode] = {
      
    temp: LONG STRING;
    basicTypeString: LONG STRING;
    symType: SymbolTableDefs.SymbolType;
    baseSymType: SymbolTableDefs.SymbolType;
    dclItem: LONG POINTER TO TreesDefs.TreeNode;
    m: LONG POINTER TO TreesDefs.TreeNode;
    dclItemHead: LONG POINTER TO TreesDefs.TreeNode;
    topLevelArray: BOOLEAN;
    nextLevelArray: BOOLEAN;
    pointerCount: CARDINAL;
    sawProcedure: BOOLEAN;
    inBlockHeader: BOOLEAN;
    
    IF node = NIL THEN RETURN;
    
    -- check for a slipup
    IF node.nodeType # declaration THEN {
	PrintingDefs.OutCode["*** No declaration in PrintOneDeclaration ***"L, 0];
	PrintingDefs.OutCode[separator, 0];
	RETURN; };
	
    -- ignore class for now --
    
    -- print any comments associated with this nodeType=declaration
    IF node.string # NIL AND node.string.length > 0 THEN
        PrintingDefs.PrintComments[node.string, indent];
	
    -- get the basic type for this declaration --
    [baseSymType, basicTypeString] _ GetAttributes[node.left, indent];
    
    -- traverse the dclItemList --
    FOR dclItem _ node.right, dclItem.right WHILE dclItem # NIL DO
    
        -- error checking --
        IF dclItem.nodeType # dclItemList THEN {
	    PrintingDefs.OutCode["*** No dclItemList in PrintOneDeclaration ***"L, 0];
	    PrintingDefs.OutCode[separator, 0];
	    RETURN; };
	    
	-- go down the tree and more error checking --
        dclItemHead _ dclItem.left;
        IF dclItemHead.nodeType # itemHead THEN {
	    PrintingDefs.OutCode["*** No itemHead in PrintOneDeclaration ***"L, 0];
	    PrintingDefs.OutCode[separator, 0];
	    RETURN; };
	    
	-- oneOnly # NIL => call from PrintFunctionHead and so only a
	-- single thing is being declared and this is not it
	IF oneOnly # NIL AND dclItemHead # oneOnly THEN LOOP;
	
	-- Now see if the outer level type is ARRAY --
	-- The outer level type is a the end of the declarator list --
	topLevelArray _ dclItemHead.left # NIL
	                AND dclItemHead.left.right # NIL
	                AND dclItemHead.left.right.declaratorType = arrayOf;
	nextLevelArray _ dclItemHead.left # NIL
	                AND dclItemHead.left.right # NIL
	                AND dclItemHead.left.right.right # NIL
			AND dclItemHead.left.right.right.declaratorType = arrayOf;
	    
	-- Now we print out the declaration
	-- First we write out the name of the variable and the ": "
        PrintingDefs.OutCode[dclItemHead.left.string, indent];
        PrintingDefs.OutCode[": "L, 0];
	
	-- Change typedefs to Mesa TYPE declarations --
	IF node.left = NIL THEN EXIT;
        IF node.left.class = typedef THEN PrintingDefs.OutCode["TYPE = "L, 0];
	
	-- Generate the "LONG POINTER TO" part of the type name and count how many indirections
	pointerCount _ 0;
	sawProcedure _ FALSE;
	-- get to and loop through the declarator node chain --
        FOR m _ dclItemHead.left.right, m.right WHILE m # NIL DO
            IF m.nodeType # declarator THEN { -- error checking
                PrintingDefs.OutCode["*** No declarator in PrintOneDeclaration ***"L, 0];
                PrintingDefs.OutCode[separator, 0];
                RETURN; };
    	    SELECT m.declaratorType FROM
    	        pointerTo, arrayOf => {
		    pointerCount _ pointerCount + 1;
		    PrintingDefs.OutCode["LONG POINTER TO "L, 0]; };
    	        functionOf => {
		    PrintingDefs.OutCode["PROCEDURE [] RETURNS ["L, 0];
		    sawProcedure _ TRUE; };
    	        ENDCASE;
    	    ENDLOOP;
	    
	-- Print out the basic type --
        PrintingDefs.OutCode[basicTypeString, 0];
	
	inBlockHeader _ oneOnly # NIL;
	IF topLevelArray AND NOT inBlockHeader THEN {
	    symType _ IF nextLevelArray
	              THEN arrayArray
		      ELSE array; }
	ELSE symType _ IF pointerCount > 0
	               THEN pointer
		       ELSE baseSymType;
	SymbolTableDefs.EnterSymbol[dclItemHead.left.string,
	    symType, baseSymType, basicTypeString, pointerCount, inBlockHeader];
	IF sawProcedure THEN PrintingDefs.OutCode["]"L, 0];
	
	-- If there was an array declaration in the list we have to
	-- now generate space for the array since we have changed its
	-- type to pointer.
	-- Note we don't do this for declaraions in procedure argument
	-- lists (onlyOne # NIL) since no space needs to be generated
	-- in these cases.
        IF NOT inBlockHeader
        AND (symType = array OR symType = arrayArray) THEN {
	    -- Set the array variable (whose type was changed to pointer)
	    -- to point to the first element in the array that allocates
	    -- the space for this variable's array.
    	    PrintingDefs.OutCode[" = @"L, 0];
            PrintingDefs.OutCode[dclItemHead.left.string, 0];
    	    PrintingDefs.OutCode["Array[0]"L, 0];
    	    PrintingDefs.OutCode[separator, 0]; -- includes CR
	    
	    -- now append "Array" to the name and allocate the array itself
            PrintingDefs.OutCode[dclItemHead.left.string, indent];
    	    PrintingDefs.OutCode["Array: "L, 0];
	    -- Go through the declarators again, this time actually allocating
	    -- space for the arrays.
	    m _ dclItemHead.left.right;
	    PrintingDefs.OutCode["ARRAY [0.."L, 0];
	    temp _ IF m.left = NIL THEN Storage.CopyString["0"L]
		   ELSE PrintExprDefs.MakeExpression[m.left, FALSE];
	    PrintingDefs.OutCode[temp, 0];
	    Storage.FreeString[temp];
	    PrintingDefs.OutCode[") OF "L, 0];
    	    FOR m _ dclItemHead.left.right.right, m.right WHILE m # NIL DO
                IF m.nodeType # declarator THEN {
                    PrintingDefs.OutCode[
		        "*** No declarator in PrintOneDeclaration ***"L, 0];
                    PrintingDefs.OutCode[separator, 0];
                    RETURN; };
    	        SELECT m.declaratorType FROM
    	            pointerTo, arrayOf =>
		        PrintingDefs.OutCode["LONG  POINTER TO "L, 0];
    	            functionOf =>
		        PrintingDefs.OutCode["PROCEDURE [] RETURNS [] "L, 0];
    	            ENDCASE;
    	        ENDLOOP;
            PrintingDefs.OutCode[basicTypeString, 0]; };
	
	-- Now handle the double array case
        IF NOT inBlockHeader AND symType = arrayArray THEN {
	    -- Note that these are not initialized correctly.
    	    PrintingDefs.OutCode[" = ALL[@"L, 0];
	    PrintingDefs.OutCode[dclItemHead.left.string, 0];
    	    PrintingDefs.OutCode["ArrayArray[i][0]]"L, 0];
    	    PrintingDefs.OutCode[separator, 0]; -- includes CR
	    
            PrintingDefs.OutCode[dclItemHead.left.string, indent];
    	    PrintingDefs.OutCode["ArrayArray: "L, 0];
    	    FOR m _ dclItemHead.left.right, m.right WHILE m # NIL DO
    	        SELECT m.declaratorType FROM
    	            pointerTo =>
		        PrintingDefs.OutCode["LONG  POINTER TO "L, 0];
    	            arrayOf => {
		        PrintingDefs.OutCode["ARRAY [0.."L, 0];
			temp _ IF m.left = NIL THEN Storage.CopyString["0"L]
			    ELSE PrintExprDefs.MakeExpression[m.left, FALSE];
			PrintingDefs.OutCode[temp, 0];
			Storage.FreeString[temp];
		        PrintingDefs.OutCode[") OF "L, 0]; };
    	            functionOf =>
		        PrintingDefs.OutCode["PROCEDURE [] RETURNS [] "L, 0];
    	            ENDCASE;
    	        ENDLOOP;
            PrintingDefs.OutCode[basicTypeString, 0]; };
	
	-- now see if there is an initialization  --
	IF dclItemHead.right # NIL THEN {	-- there is an initializer
	    SELECT dclItemHead.right.operationType FROM
	        eList => {
	            PrintingDefs.OutCode[" _ "L, 0];
	            PrintInitList[dclItemHead.right]; };
		ENDCASE => {
	            PrintingDefs.OutCode[" _ "L, 0];
                    temp _ PrintExprDefs.MakeExpression[dclItemHead.right, FALSE];
	            PrintingDefs.OutCode[temp, 0];
	            Storage.FreeString[temp]; }; };
	PrintingDefs.OutCode[separator, 0];
	ENDLOOP;
    Storage.FreeString[basicTypeString];
    };
    
    
  PrintInitList: PROCEDURE [node: LONG POINTER TO TreesDefs.TreeNode] = {
  
    n: LONG POINTER TO TreesDefs.TreeNode;
		    temp: LONG STRING;
    
    PrintingDefs.OutCode["["L, 0];
    FOR n _ node, n.right WHILE n # NIL DO
	IF n.left = NIL THEN LOOP;
        SELECT n.left.operationType FROM
	    eList =>
	        PrintInitList[n.left];
	    ENDCASE => {
                temp _ PrintExprDefs.MakeExpression[n.left, FALSE];
	        PrintingDefs.OutCode[temp, 0];
	        Storage.FreeString[temp]; };
        IF n.right # NIL THEN PrintingDefs.OutCode[", "L, 0];
        ENDLOOP;
    PrintingDefs.OutCode["]"L, 0];
		    };
		
  MergeAttributes: PUBLIC PROCEDURE [n1: LONG POINTER TO TreesDefs.TreeNode,
  	n2: LONG POINTER TO TreesDefs.TreeNode]
	RETURNS [result: LONG POINTER TO TreesDefs.TreeNode] = {
	
        IF n2.structure OR n2.union OR n2.enumeration THEN {
	    IF n2.class = noClass THEN n2.class _ n1.class;
	    result _ n2;
	    Storage.Free[n1]; }
	ELSE IF n1.structure OR n1.union OR n1.enumeration THEN {
	    IF n1.class = noClass THEN n1.class _ n2.class;
	    result _ n1;
	    Storage.Free[n2]; }
		        ELSE {
            n1.char	_ n1.char	OR n2.char;
            n1.short	_ n1.short	OR n2.short;
            n1.int	_ n1.int	OR n2.int;
            n1.long	_ n1.long	OR n2.long;
            n1.unsigned	_ n1.unsigned	OR n2.unsigned;
            n1.float	_ n1.float	OR n2.float;
            n1.double	_ n1.double	OR n2.double;
	    IF n1.class = noClass THEN n1.class _ n2.class;
            result _ n1;
	    Storage.Free[n2]; };
    };
      
  }.