(* Copyright 1991 Digital Equipment Corporation.               *)
(* Distributed only by permission.                             *)

MODULE ObPrintValue;
IMPORT Text, ObErr, SynWr, ObCommand, ObTree, ObPrintTree,
  ObCheck, NetObj, ObValue, ObLib;

VAR 
  printClosureGlobals: BOOLEAN;

  PROCEDURE Setup() =
    BEGIN
      printClosureGlobals := FALSE;
      ObCommand.Register(ObTree.doCommandSet,
        NEW(ObCommand.T, name:="ShowClosureGlobals", 
            sortingName:="ShowClosureGlobals",
            Exec:=PrintClosureGlobals));
    END Setup;

  PROCEDURE PrintValArray(swr: SynWr.T; array: REF ObValue.Vals; 
    libEnv: ObLib.Env; printEnv: ObTree.Env; depth: INTEGER) =
  VAR sep: TEXT; size: INTEGER;
  BEGIN
    TRY
      sep := "";
      size := NUMBER(array^);
      FOR i:=0 TO size-1 DO
        SynWr.Text(swr, sep); sep := ", ";
        SynWr.Break(swr);
        SynWr.Beg(swr, 2);
        PrintVal(swr, array^[i], libEnv, printEnv, depth-1);
        SynWr.End(swr);
      END;
    EXCEPT NetObj.Error => SynWr.Text(swr, "<disconnected>");
    END;
  END PrintValArray;

  PROCEDURE PrintVal(swr: SynWr.T; val: ObValue.Val; 
    libEnv: ObLib.Env; printEnv: ObTree.Env; depth: INTEGER) =
  VAR val1: ObValue.Val; protected, serialized: BOOLEAN; who: TEXT;
    fields: REF ObValue.ObjFields;
  BEGIN
    IF val=NIL THEN SynWr.Char(swr, '_'); RETURN END;
    TYPECASE val OF
    | ObValue.ValVar(node) => 
      TRY val1 := node.remote.Get();
      EXCEPT NetObj.Error => SynWr.Text(swr, "<remote variable disconnected>");
      END;
      PrintVal(swr, val1, libEnv, printEnv, depth);
    | ObValue.ValOk => ObPrintTree.PrintOk(swr);
    | ObValue.ValBool(node) => ObPrintTree.PrintBool(swr, node.bool);
    | ObValue.ValChar(node) => ObPrintTree.PrintChar(swr, node.char);
    | ObValue.ValText(node) => ObPrintTree.PrintText(swr, node.text);
    | ObValue.ValInt(node) => 
	ObPrintTree.PrintInt(swr, node.int);
	IF node.temp THEN SynWr.Text(swr, "<TEMP!>") END;
    | ObValue.ValReal(node) => 
	ObPrintTree.PrintReal(swr, node.real);
	IF node.temp THEN SynWr.Text(swr, "<TEMP!>") END;
    | ObValue.ValOption(node) => 
        IF depth <= 0 THEN SynWr.Text(swr, "..."); RETURN END;
        SynWr.Beg(swr);
          SynWr.Beg(swr, 2);
	    SynWr.Text(swr, "option ");
	  SynWr.Break(swr);
            SynWr.Beg(swr, 4);
	      SynWr.Text(swr, node.tag);
	      SynWr.Text(swr, " => ");
            SynWr.End(swr);
	  SynWr.Break(swr);
	    PrintVal(swr, node.val, libEnv, printEnv, depth-1);
	    SynWr.Char(swr, ' ');
	  SynWr.End(swr);
	SynWr.Break(swr);
	  SynWr.Text(swr, "end");
	SynWr.End(swr);
    | ObValue.ValAlias(node) => 
        IF depth <= 0 THEN SynWr.Text(swr, "..."); RETURN END;
        SynWr.Beg(swr);
          SynWr.Beg(swr, 2);
	    SynWr.Text(swr, "alias ");
	  SynWr.Break(swr);
            SynWr.Beg(swr, 4);
	      SynWr.Text(swr, node.label);
	      SynWr.Text(swr, " of ");
            SynWr.End(swr);
	  SynWr.Break(swr);
	    PrintVal(swr, node.obj, libEnv, printEnv, depth-1);
	    SynWr.Char(swr, ' ');
	  SynWr.End(swr);
	SynWr.Break(swr);
	  SynWr.Text(swr, "end");
	SynWr.End(swr);
    | ObValue.ValArray(node) => 
        IF depth <= 0 THEN SynWr.Text(swr, "..."); RETURN END;
        SynWr.Beg(swr, 1);
          SynWr.Char(swr, '[');
          PrintValArray(swr, node.remote.Obtain(), libEnv, printEnv, depth);
          SynWr.Char(swr, ']');
	SynWr.End(swr);
    | ObValue.ValAnything(node) => 
        SynWr.Text(swr, node.Print());
    | ObValue.ValFun(node) => 
        IF depth <= 0 THEN SynWr.Text(swr, "..."); RETURN END;
        PrintClosure(swr, node.fun, node.fun.globals, node.global, 
          libEnv, printEnv, depth);
    | ObValue.ValMeth(node) => 
        IF depth <= 0 THEN SynWr.Text(swr, "..."); RETURN END;
        PrintClosure(swr, node.meth, node.meth.globals, node.global, 
          libEnv, printEnv, depth);
   | ObValue.ValObj(node) => 
        IF depth <= 0 THEN SynWr.Text(swr, "..."); RETURN END;
        TYPECASE node.remote OF
        | ObValue.RemObjServer(remObj) => 
            who := remObj.Who((*out*)protected, (*out*)serialized);
            fields := remObj.Obtain(TRUE);
    	    SynWr.Beg(swr, 1); 
    	    SynWr.Char(swr, '{');
            PrintProtected(swr, protected);
            PrintSerialized(swr, serialized);
            PrintValObjFields(swr, fields, libEnv, printEnv, depth);
    	    SynWr.Char(swr, '}');
    	    SynWr.End(swr);
        ELSE 
          SynWr.Beg(swr, 1); SynWr.Char(swr, '{');
          TRY 
            who := node.remote.Who((*out*)protected, (*out*)serialized);
            IF Text.Empty(who) THEN SynWr.Text(swr, "<unknown>");
            ELSE SynWr.Text(swr, who);
            END;
          EXCEPT NetObj.Error => SynWr.Text(swr, "<disconnected>");
          END;
          SynWr.Char(swr, '}'); SynWr.End(swr);
        END;
   | ObValue.ValEngine(node) => 
        IF depth <= 0 THEN SynWr.Text(swr, "..."); RETURN END;
        SynWr.Beg(swr, 1); SynWr.Text(swr, "<Engine ");
        TRY SynWr.Text(swr, node.remote.Who())
        EXCEPT NetObj.Error => SynWr.Text(swr, "<disconnected>");
        END;
        SynWr.Char(swr, '>'); SynWr.End(swr);
    | ObValue.ValException(node) => 
        SynWr.Text(swr, "<the exception '" & node.name & "'>");
    ELSE SynWr.Text(swr, "<?>");
    END;
  END PrintVal;

  PROCEDURE PrintValSummary(swr: SynWr.T; val: ObValue.Val; 
    libEnv: ObLib.Env; printEnv: ObTree.Env) =
  VAR val1: ObValue.Val; protected, serialized: BOOLEAN; who: TEXT;
    fields: REF ObValue.ObjFields;
  BEGIN
    IF val=NIL THEN SynWr.Char(swr, '_'); RETURN END;
    TYPECASE val OF
    | ObValue.ValVar(node) => 
      TRY val1 := node.remote.Get();
      EXCEPT NetObj.Error => SynWr.Text(swr, "<remote variable disconnected>");
      END;
      PrintValSummary(swr, val1, libEnv, printEnv);
    | ObValue.ValOk, ObValue.ValBool, ObValue.ValChar,
      ObValue.ValInt, ObValue.ValReal => 
        PrintVal(swr, val, libEnv, printEnv, 10);
    | ObValue.ValText => SynWr.Text(swr, "\" ... \"");
    | ObValue.ValOption(node) => 
        SynWr.Beg(swr);
          SynWr.Beg(swr, 2);
	    SynWr.Text(swr, "option ");
	  SynWr.Break(swr);
            SynWr.Beg(swr, 4);
	      SynWr.Text(swr, node.tag);
	      SynWr.Text(swr, " => ... end");
            SynWr.End(swr);
	  SynWr.End(swr);
	SynWr.End(swr);
    | ObValue.ValAlias(node) => 
        SynWr.Beg(swr);
          SynWr.Beg(swr, 2);
	    SynWr.Text(swr, "alias ");
	  SynWr.Break(swr);
            SynWr.Beg(swr, 4);
	      SynWr.Text(swr, node.label);
	      SynWr.Text(swr, " of ... end");
            SynWr.End(swr);
	  SynWr.End(swr);
	SynWr.End(swr);
    | ObValue.ValArray => 
	SynWr.Text(swr, "[ ... ]");
    | ObValue.ValAnything(node) => 
        SynWr.Text(swr, node.Print());
    | ObValue.ValFun(node) => 
        ObPrintTree.PrintSignature(swr, node.fun, libEnv, printEnv);
    | ObValue.ValMeth(node) => 
        ObPrintTree.PrintSignature(swr, node.meth, libEnv, printEnv);
    | ObValue.ValObj(node) => 
        TYPECASE node.remote OF
        | ObValue.RemObjServer(remObj) =>
            who := remObj.Who((*out*)protected, (*out*)serialized);
            fields := remObj.Obtain(TRUE);
    	    SynWr.Beg(swr, 1); 
    	    SynWr.Char(swr, '{');
            PrintProtected(swr, protected);
            PrintSerialized(swr, serialized);
            PrintValObjFieldsSummary(swr, fields, libEnv, printEnv);
    	    SynWr.Char(swr, '}');
    	    SynWr.End(swr);
        ELSE 
          SynWr.Beg(swr, 1); SynWr.Char(swr, '{');
          TRY 
            who := node.remote.Who((*out*)protected, (*out*)serialized);
            IF Text.Empty(who) THEN SynWr.Text(swr, "<unknown>");
            ELSE SynWr.Text(swr, who);
            END;
          EXCEPT NetObj.Error => SynWr.Text(swr, "<disconnected>");
          END;
          SynWr.Char(swr, '}'); SynWr.End(swr);
        END;
   | ObValue.ValEngine(node) => 
        SynWr.Beg(swr, 1); SynWr.Text(swr, "<Engine ");
        TRY SynWr.Text(swr, node.remote.Who())
        EXCEPT NetObj.Error => SynWr.Text(swr, "<disconnected>");
        END;
        SynWr.Char(swr, '>'); SynWr.End(swr);
    | ObValue.ValException(node) => 
        SynWr.Text(swr, "<the exception '" & node.name & "'>");
    ELSE SynWr.Text(swr, "<?>");
    END;
  END PrintValSummary;

  PROCEDURE PrintClosure(swr: SynWr.T; fun: ObTree.Term;
    globalsList: ObTree.Globals; globalsEnv: ObValue.GlobalEnv;
    libEnv: ObLib.Env; printEnv: ObTree.Env; depth: INTEGER) =
  VAR sep: TEXT;
  BEGIN
    IF NUMBER(globalsEnv^)=0 THEN
      ObPrintTree.PrintTerm(swr, fun, libEnv, printEnv, depth);
    ELSIF printClosureGlobals THEN
      SynWr.Beg(swr, 2);
        ObPrintTree.PrintTerm(swr, fun, libEnv, printEnv, depth);
        SynWr.Char(swr, ' ');
      SynWr.Break(swr);
        SynWr.Text(swr, "where ");
        sep := "";
        FOR i:=0 TO NUMBER(globalsEnv^)-1 DO
          SynWr.Text(swr, sep); sep:=", ";
          SynWr.Break(swr);
          SynWr.Beg(swr, 2);
            SynWr.Beg(swr, 4);
              ObPrintTree.PrintIdeName(swr, globalsList.name, printEnv);
              SynWr.Text(swr, " = ");
            SynWr.End(swr);
          SynWr.Break(swr);
            PrintVal(swr, globalsEnv[i], libEnv, printEnv, depth-1);
          SynWr.End(swr);
          globalsList := globalsList.rest;
        END;
        SynWr.Char(swr, ' ');
      SynWr.Break(swr);
        SynWr.Text(swr, "end");
      SynWr.End(swr);
    ELSE
      SynWr.Beg(swr, 2);
        SynWr.Beg(swr, 4);
          SynWr.Text(swr, "global(");
          sep := "";
          FOR i:=0 TO NUMBER(globalsEnv^)-1 DO
            SynWr.Text(swr, sep); sep:=",";
            SynWr.Break(swr);
            ObPrintTree.PrintIdeName(swr, globalsList.name, printEnv);
            globalsList := globalsList.rest;
          END;
          SynWr.Text(swr, ") ");
        SynWr.End(swr);
      SynWr.Break(swr);
        ObPrintTree.PrintTerm(swr, fun, libEnv, printEnv, depth);
      SynWr.End(swr);
    END;
  END PrintClosure;

  PROCEDURE PrintProtected(swr: SynWr.T; protected: BOOLEAN) =
  BEGIN
    IF protected THEN
      SynWr.Break(swr);
      SynWr.Beg(swr, 2);
      SynWr.Text(swr, "protected, "); 
      SynWr.End(swr);
    END;
  END PrintProtected;

  PROCEDURE PrintSerialized(swr: SynWr.T; serialized: BOOLEAN) =
  BEGIN
    IF serialized THEN
      SynWr.Break(swr);
      SynWr.Beg(swr, 2);
      SynWr.Text(swr, "serialized, ");
      SynWr.End(swr);
    END;
  END PrintSerialized;

  PROCEDURE PrintValObjFields(swr: SynWr.T; fields: REF ObValue.ObjFields; 
    libEnv: ObLib.Env; printEnv: ObTree.Env; depth: INTEGER) =
  VAR sep: TEXT;
  BEGIN
    sep := "";
    FOR i:=0 TO NUMBER(fields^)-1 DO
	SynWr.Text(swr, sep); sep := ", ";
        SynWr.Break(swr);
        SynWr.Beg(swr, 2);
	  SynWr.Beg(swr, 4);
	    SynWr.Text(swr, fields^[i].label);
	    SynWr.Text(swr, " => ");
	  SynWr.End(swr);
	SynWr.Break(swr);
	  PrintVal(swr, fields^[i].field, libEnv, printEnv, depth-1);
	SynWr.End(swr);
    END;
  END PrintValObjFields;

  PROCEDURE PrintValObjFieldsSummary(swr: SynWr.T; 
    fields: REF ObValue.ObjFields; 
    libEnv: ObLib.Env; printEnv: ObTree.Env) =
  VAR sep: TEXT;
  BEGIN
    sep := "";
    FOR i:=0 TO NUMBER(fields^)-1 DO
	SynWr.Text(swr, sep); sep := ", ";
        SynWr.Break(swr);
        SynWr.Beg(swr, 2);
	  SynWr.Beg(swr, 4);
	    SynWr.Text(swr, fields^[i].label);
	    SynWr.Text(swr, "=> ... ");
	  SynWr.End(swr);
	SynWr.End(swr);
    END;
  END PrintValObjFieldsSummary;

PROCEDURE PrintPhraseLet(swr: SynWr.T; checkEnv, checkEnvStop: ObCheck.Env; 
    env, envStop: ObValue.Env; var: BOOLEAN; libEnv: ObLib.Env; depth: INTEGER) =
  BEGIN
    SynWr.Beg(swr, 2);
      IF var THEN SynWr.Text(swr, "var ") ELSE SynWr.Text(swr, "let ") END;
      PrintTermBinding(swr, checkEnv, checkEnvStop, env, envStop, libEnv, depth);
    SynWr.End(swr);
    SynWr.NewLine(swr);
  END PrintPhraseLet;

PROCEDURE PrintTermBinding(swr: SynWr.T; checkEnv, checkEnvStop: ObCheck.Env; 
    env, envStop: ObValue.Env; libEnv: ObLib.Env; depth: INTEGER) =
  BEGIN
    IF (checkEnv=checkEnvStop) AND (env=envStop) THEN RETURN END;
    IF (checkEnv=checkEnvStop) OR (env=envStop) OR
	NOT ObTree.SameIdeName(checkEnv.name, env.name) THEN
	ObErr.Fault(swr, "Envs do not match. (1)"); <* NOWARN *>
    END;
    PrintTermBinding(swr, checkEnv.rest, checkEnvStop, 
	env.rest, envStop, libEnv, depth);
    TYPECASE checkEnv OF
    | ObCheck.TermEnv(checkNode) =>
	TYPECASE env OF
	| ObValue.LocalEnv(valueNode) =>
            IF env.rest#envStop THEN SynWr.Text(swr, ", ") END;
            SynWr.Break(swr);
	    SynWr.Beg(swr, 2);
	      SynWr.Beg(swr, 4);
	        ObPrintTree.PrintIdeName(swr, checkNode.name, checkEnv);
                SynWr.Text(swr, " = ");
	      SynWr.End(swr);
	    SynWr.Break(swr);
              (* PrintVal(swr, valueNode.val, libEnv, checkNode.rest, depth-1); *)
              PrintValSummary(swr, valueNode.val, libEnv, checkNode.rest);
	    SynWr.End(swr);
	ELSE ObErr.Fault(swr, "Envs do not match. (2)"); <* NOWARN *>
	END;
    ELSE ObErr.Fault(swr, "PrintTermBinding"); <* NOWARN *>
    END;
  END PrintTermBinding;

  PROCEDURE PrintClosureGlobals(self: ObCommand.T; arg: TEXT; 
                                data: REFANY:=NIL) =
    BEGIN
      IF Text.Equal(arg, "!") OR Text.Equal(arg, "?") THEN
	SynWr.Text(SynWr.out , self.name & " {On Off} is ");
	IF printClosureGlobals THEN SynWr.Text(SynWr.out , "On");
	ELSE SynWr.Text(SynWr.out , "Off"); END;
	SynWr.NewLine(SynWr.out );
      ELSIF Text.Equal(arg, "On") THEN printClosureGlobals:=TRUE;
      ELSIF Text.Equal(arg, "Off") THEN printClosureGlobals:=FALSE;
      ELSE
	SynWr.Text(SynWr.out , "Command " & self.name 
	  & ": bad argument: " & arg);
	SynWr.NewLine(SynWr.out );
      END;
    END PrintClosureGlobals;

BEGIN
END ObPrintValue.
