-- File [Ivy]<Nelson>Lupine>LupineDeclareUtilityImpl.mesa.
-- Last edited by BZM on March 18, 1982  10:56 AM.

-- This module cooperates with LupineDeclare*Impl to export LupineDeclare.


DIRECTORY
  CWF USING [SWF2, WF1, WFC],
  LongString USING [EqualStrings, EquivalentStrings],
  LupineDeclare USING [
	DirectoryItem, DirectoryList, DispatcherType,
	EmptyDirectoryList, InterfaceUse, ModuleNameList ],
  LupineDeclarePrivate USING [GetString, StringConstantType],
  LupineManagerPrivate USING [
	AllocString, Error, Indent, IsNull, Language,
	MaxIdentifierLength, ModuleName,
	Nest, Options, String, StringNIL,
	WFL, WFL1, WFLL, WFS, WFS1, WFSL ],
  LupineSymbolTable USING [
	DirectoryProcedure, EnumerateDirectory, EnumerateTransfers,
	IsAnonymous, PutTypeName, SymbolHandle, SymbolID,
	SymbolName, SymbolType, SymbolUniqueID,
	TransferProcedure, TypeHandle ];


LupineDeclareUtilityImpl: PROGRAM
  IMPORTS
	CWF, LongString, LupineManagerPrivate,
	Private: LupineDeclarePrivate, ST: LupineSymbolTable 
  EXPORTS LupineDeclare, LupineDeclarePrivate
  = BEGIN OPEN LupineManagerPrivate, LupineDeclare;



-- General symbol and type routines.

  TransferName: PUBLIC PROCEDURE [transfer: ST.SymbolHandle, nameString: String]
      RETURNS[name: String] =
    BEGIN
    IF ST.IsAnonymous[transfer]
      THEN ERROR
      ELSE RETURN[ST.SymbolName[transfer, nameString]];
    END;

  WriteTransferName: PUBLIC PROCEDURE [transfer: ST.SymbolHandle] =
    BEGIN
    name: AllocString = [MaxIdentifierLength];
    WFS1[TransferName[transfer, name]];
    END;

  ParameterName: PUBLIC PROCEDURE [parameter: ST.SymbolHandle,
	parameterNumber: INTEGER, nameString: String]
      RETURNS [name: String] =
    BEGIN
    IF ST.IsAnonymous[parameter]
     THEN BEGIN
      paramID: LONG CARDINAL --ST.SymbolID-- _ ST.SymbolUniqueID[parameter];
      CWF.SWF2[nameString, "anonP%Did%LU"L, @parameterNumber, @paramID];
      RETURN[nameString];
      END
     ELSE RETURN[ST.SymbolName[parameter, nameString]];
    END;

  WriteParameterName: PUBLIC PROCEDURE [
	parameter: ST.SymbolHandle, parameterNumber: INTEGER] =
    BEGIN
    name: AllocString = [MaxIdentifierLength];
    WFS1[ParameterName[parameter, parameterNumber, name]];
    END;
    
  WriteSymbolName: PUBLIC PROCEDURE [symbol: ST.SymbolHandle] =
    BEGIN
    name: AllocString = [MaxIdentifierLength];
    IF ST.IsAnonymous[symbol]
      THEN Error[AnonymousIdentifier]
      ELSE WFS1[ST.SymbolName[symbol, name]];
    END;
    
  WriteSymbolType: PUBLIC PROCEDURE [symbol: ST.SymbolHandle] =
    BEGIN
    WriteTypeName[ST.SymbolType[symbol]];
    END;
    
  WriteTypeName: PUBLIC PROCEDURE [
      type: ST.TypeHandle, includeReadonly: BOOLEAN_TRUE ] =
    BEGIN
    ST.PutTypeName[
	putProc: CWF.WFC,
	type: type,
	includeReadonly: includeReadonly,
	rootInterfaceOpenName: ModuleName[openedInterface] ];
    END;


-- Directory and interface manipulation routines.

  Directory: PUBLIC PROCEDURE [
	includeInterfaceDirectory: BOOLEAN_TRUE,
	extraDirectories: DirectoryList_EmptyDirectoryList,
	options: Options,
	nest: Nest_0 ] =
    BEGIN
    printedOne: BOOLEAN_FALSE;
    maxExtraDirLength: INTEGER = 6*16;
    duplicate: PACKED ARRAY [0..maxExtraDirLength) OF BOOLEAN _ ALL[FALSE];
    PrintDirItem: PROCEDURE [dirItem: DirectoryItem, file: String_StringNIL] =
      BEGIN
      hasFileName: BOOLEAN =
      	~IsNull[file] AND ~LongString.EquivalentStrings[dirItem.module, file];
      IF ~dirItem.forLanguage[options.targetLanguage] OR IsNull[dirItem.module]
	  THEN RETURN;
      IF printedOne
	  THEN WFS[",*N"L, Indent[nest+1]]
	  ELSE BEGIN
	    WFSL["*N*N"L, Indent[nest], "DIRECTORY*N"L, Indent[nest+1]];
	    printedOne _ TRUE;
	    END;
      WFS[dirItem.module];
      IF hasFileName THEN WFS[": FROM """L, file, """"L];
      SELECT TRUE FROM
	dirItem.usingAll # StringNIL =>
	  WFS[" USING ["L, dirItem.usingAll, "]"L];
	dirItem.usingSome # StringNIL =>
	  WFS[" --USING SOME OF ["L, dirItem.usingSome, "]--"L];
	ENDCASE => NULL;
      END;  -- PrintDirItem.
    IF LENGTH[extraDirectories] > maxExtraDirLength THEN ERROR;
    IF includeInterfaceDirectory
      THEN BEGIN
      PrintInterfaceDirItem: ST.DirectoryProcedure =
	BEGIN
	FOR dir: CARDINAL IN [0..LENGTH[extraDirectories]) DO
	  IF LongString.EqualStrings[extraDirectories[dir].module, moduleName]
	    THEN {duplicate[dir] _ TRUE; EXIT};
	    ENDLOOP;
	PrintDirItem[dirItem: [module: moduleName], file: fileName];
	END;  -- PrintInterfaceDirItem.
      [] _ ST.EnumerateDirectory[PrintInterfaceDirItem];
      END;
    FOR dir: CARDINAL IN [0..LENGTH[extraDirectories]) DO
      -- Must do this list second so that USING conflicts are avoided.
      IF ~duplicate[dir] THEN PrintDirItem[dirItem: extraDirectories[dir]];
      ENDLOOP;
    IF printedOne THEN WFS1[";*N"L];
    END;

  ModuleHead: PUBLIC PROCEDURE [
  	moduleNames: ModuleNameList,
	moduleType: String,
	interfaceList: DirectoryList_EmptyDirectoryList,
	options: Options,
	nest: Nest_0 ] = 
    BEGIN
    UseKeywords: ARRAY InterfaceUse OF RECORD [begin, end: String] = [
	imports: ["IMPORTS "L, "*N"L], exports: ["EXPORTS "L, "*N"L],
	shares:  ["SHARES  "L, "*N"L], beginOpen: ["= BEGIN OPEN "L, ";*N"L] ];
    hasThisUse: ARRAY InterfaceUse OF BOOLEAN _ ALL[FALSE];
    IF LENGTH[moduleNames]=0 OR IsNull[moduleType] THEN ERROR;
    FOR item: CARDINAL IN [0..LENGTH[interfaceList]) DO
      FOR use: InterfaceUse IN InterfaceUse DO
	IF interfaceList[item].usedIn[use] THEN hasThisUse[use] _ TRUE;
	ENDLOOP;
      ENDLOOP;
    WFS["*N*N"L, Indent[nest]];
    FOR name: CARDINAL IN [0..LENGTH[moduleNames]) DO
      IF name > 0 THEN WFS1[", "L];
      WFS[moduleNames[name]];
      ENDLOOP;
    WFS[": "L, moduleType, "*N"L];
    FOR use: InterfaceUse IN InterfaceUse DO
      IF hasThisUse[use] THEN
	InterfaceList [ nest: nest+1,
	  use: use,
	  targetSystem: options.targetLanguage,
	  interfaceList: interfaceList,
	  beginText: UseKeywords[use].begin,
	  endText: UseKeywords[use].end ]; 
	ENDLOOP;
    IF ~hasThisUse[beginOpen] THEN WFL1[nest+1, "= BEGIN"L];
    END;

  InterfaceList: PUBLIC PROCEDURE [
  	use: InterfaceUse,
  	targetSystem: Language,
	interfaceList: DirectoryList,
	beginText, endText: String_StringNIL,
	nest: Nest ] = 
    BEGIN
    printedOne: BOOLEAN_FALSE;
    WFS[Indent[nest], beginText];
    FOR item: CARDINAL IN [0..LENGTH[interfaceList]) DO
      interface: DirectoryItem = interfaceList[item];
      IF   ~interface.usedIn[use]
	OR ~interface.forLanguage[targetSystem]
	OR IsNull[interface.module]
	  THEN LOOP;
      IF printedOne THEN WFS1[", "L] ELSE printedOne _ TRUE;
      IF use=beginOpen OR (use=imports AND ~interface.usedIn[beginOpen])
	THEN IF ~IsNull[interface.openName] THEN WFS[interface.openName, ": "L];
      WFS[interface.module];
      ENDLOOP;
    WFS1[endText];
    END;


-- Other code generation routines.

  LastLupineTransferIndex: INTEGER = 3B;

  ProcedureIndex: PUBLIC PROCEDURE [nest: Nest_1] =
    BEGIN
    TransferEnumeration[ nest: nest,
	enumerationName: Private.GetString[procedureIndex],
	procs: TRUE ];
    END;

  SignalIndex: PUBLIC PROCEDURE [nest: Nest_1] =
    BEGIN
    TransferEnumeration[ nest: nest,
	enumerationName: Private.GetString[signalIndex],
	exceptions: TRUE ];
    END;

  TransferEnumeration: PROCEDURE [
	enumerationName: String,
	procs, exceptions: BOOLEAN _ FALSE,
	nest: Nest ] =
    BEGIN
    index: INTEGER _ LastLupineTransferIndex;
    WriteIndex: PROC =
      {CWF.WF1[" (%D)"L, @index];  index _ index + 1};
    NameList: ST.TransferProcedure =
      BEGIN
      WFS1[IF transferIndex=1 THEN ",*B"L ELSE ", "L];
      WriteTransferName[transfer];  WriteIndex;
      END;
    WFSL["*N"L, Indent[nest], enumerationName,
      ": PRIVATE TYPE = MACHINE DEPENDENT {*B"L,
      "LupineUnusedIndex (0), LupineLastIndex"L ];
    WriteIndex;
    [] _ ST.EnumerateTransfers[
      proc: NameList, procs: procs, errors: exceptions, signals: exceptions ];
    WFS1["};*N"L];
    END;


  DispatcherHead: PUBLIC PROCEDURE [type: DispatcherType, nest: Nest] =
    BEGIN
    WFS1["*N"L];
    WFLL[nest, DispatcherName[type], ": --"L,
      Private.GetString[dispatcherDeclaration], "-- RpcPrivate.Dispatcher ="L];
    WFL1[nest+1, "BEGIN"L];
    END;

  DispatcherSelect: PUBLIC PROCEDURE [type: DispatcherType, nest: Nest] =
    BEGIN
    WFL[nest+1, "SELECT LOOPHOLE[pkt.data[0], RpcControl."L,
      (SELECT type FROM
	server => Private.GetString[procedureIndex],
	client => Private.GetString[signalIndex],
	ENDCASE => ERROR),
      "] FROM"L];
    END;

  DispatcherTail: PUBLIC PROCEDURE [type: DispatcherType, nest: Nest] =
    BEGIN
    WFL1[nest+2, "ENDCASE => RETURN[Lupine.DispatchingError[]];*N"L];
    WFL[nest+1, "END;  -- "L, DispatcherName[type]];
    END;


-- Routines private to LupineDeclare*Impl via LupineDeclarePrivate.

  DispatcherName: PUBLIC PROCEDURE [type: DispatcherType] RETURNS [String] =
    BEGIN
    RETURN[ SELECT type FROM
	none => StringNIL,
	client => GetString[clientDispatcher],
	server => GetString[serverDispatcher],
	callback => GetString[callbackDispatcher],
	ENDCASE => ERROR ];
    END;


  StringConstants: PACKED ARRAY Private.StringConstantType OF STRING = [
    clientDispatcher: "ClientDispatcher",
    serverDispatcher: "ServerDispatcher",
    callbackDispatcher: "CallbackDispatcher",
    procedureIndex: "ProcedureIndex",
    signalIndex: "SignalIndex",
    dispatcherDeclaration: "PROCEDURE [pkt: RPCPkt, callLength: DataLength, lastPkt: BOOLEAN, localConversation: Conversation] RETURNS [returnLength: DataLength]",
    dispatcherArgs: "pkt: pkt, callLength: callLength, lastPkt: lastPkt, localConversation: localConversation",
    dispatcherResults: "returnLength: returnLength",
    dispatcherPkt: "pkt",
    dispatcherConversation: "localConversation",
    dispatcherReturnLength: "returnLength" ];

  GetString: PUBLIC PROCEDURE [type: Private.StringConstantType]
      RETURNS [--string:-- String] =
    BEGIN RETURN[StringConstants[type]] END;


END.  -- LupineDeclareUtilityImpl.