MODULE WebInfo;

IMPORT Word, Target, M3Buf, M3ID, Value, Scope, Module, Scanner;
IMPORT Expr, UserProc;

VAR
  info: M3Buf.T := NIL;

PROCEDURE Reset () =
  CONST Tag = ARRAY BOOLEAN OF CHAR { 'A', 'B' };
  VAR file: TEXT;  line: INTEGER;
  BEGIN
    IF (info = NIL) THEN info := M3Buf.New (); END;

    Scanner.LocalHere (file, line);
    OutC ('@');
    OutT (file);
    NL ();

    OutC (Tag [Module.IsInterface ()]);
    OutN (Module.Name (NIL));
    NL ();
  END Reset;

PROCEDURE Finish (): TEXT =
  BEGIN
    RETURN M3Buf.ToText (info);
  END Finish;

PROCEDURE Import_unit (n: Name) =
  BEGIN
    OutC ('C');
    OutN (n);
    NL ();
  END Import_unit;

PROCEDURE Export_unit (n: Name) =
  BEGIN
    OutC ('D');
    OutN (n);
    NL ();
  END Export_unit;

PROCEDURE Declare_typename (t: TypeUID;  x: Value.T) =
  BEGIN
    OutX (t, 'E');
    OutV (x);
    NL ();
  END Declare_typename;

PROCEDURE Declare_array (t: TypeUID;  index, elt: TypeUID;  s: Size) =
  BEGIN
    OutX (t, 'F');
    OutU (index);
    OutU (elt);
    OutI (s);
    NL ();
  END Declare_array;

PROCEDURE Declare_open_array (t: TypeUID;  elt: TypeUID;  s: Size) =
  BEGIN
    OutX (t, 'G');
    OutU (elt);
    OutI (s);
    NL ();
  END Declare_open_array;

PROCEDURE Declare_enum (t: TypeUID;  n_elts: INTEGER;  s: Size) =
  BEGIN
    OutX (t, 'H');
    OutI (n_elts);
    OutI (s);
    NL ();
  END Declare_enum;

PROCEDURE Declare_enum_elt (n: Name) =
  BEGIN
    OutC ('I');
    OutN (n);
    NL ();
  END Declare_enum_elt;

PROCEDURE Declare_packed  (t: TypeUID;  s: Size;  base: TypeUID) =
  BEGIN
    OutX (t, 'J');
    OutI (s);
    OutU (base);
    NL ();
  END Declare_packed ;

PROCEDURE Declare_record (t: TypeUID;  s: Size;  n_fields: INTEGER) =
  BEGIN
    OutX (t, 'K');
    OutI (s);
    OutI (n_fields);
    NL ();
  END Declare_record;

PROCEDURE Declare_field (n: Name;  o: Offset;  s: Size;  t: TypeUID) =
  BEGIN
    OutC ('L');
    OutN (n);
    OutI (o);
    OutI (s);
    OutU (t);
    NL ();
  END Declare_field;

PROCEDURE Declare_set (t, domain: TypeUID;  s: Size) =
  BEGIN
    OutX (t, 'M');
    OutU (domain);
    OutI (s);
    NL ();
  END Declare_set;

PROCEDURE Declare_subrange (t, domain: TypeUID;  READONLY min, max: Target.Int;
                   s: Size) =
  BEGIN
    OutX (t, 'N');
    OutU (domain);
    OutZ (min);
    OutZ (max);
    OutI (s);
    NL ();
  END Declare_subrange;

PROCEDURE Declare_pointer (t, target: TypeUID;  brand: TEXT; traced: BOOLEAN) =
  CONST Tag = ARRAY BOOLEAN OF CHAR { 'O', 'P' };
  BEGIN
    OutX (t, Tag [traced]);
    OutU (target);
    IF (brand # NIL) THEN
      OutC (' ');
      OutT (brand);
    END;
    NL ();
  END Declare_pointer;

PROCEDURE Declare_indirect (t, target: TypeUID) =
  BEGIN
    OutX (t, 'Q');
    OutU (target);
    NL ();
  END Declare_indirect;

PROCEDURE Declare_proctype (t: TypeUID; n_formals: INTEGER;
                            result: TypeUID;  n_raises: INTEGER) =
  BEGIN
    OutX (t, 'R');
    OutI (n_formals);
    OutU (result);
    OutI (n_raises);
    NL ();
  END Declare_proctype;

PROCEDURE Declare_formal (n: Name;  t: TypeUID) =
  BEGIN
    OutC ('S');
    OutN (n);
    OutU (t);
    NL ();
  END Declare_formal;

PROCEDURE Declare_raises (n: Name) =
  BEGIN
    OutC ('T');
    OutN (n);
    NL ();
  END Declare_raises;

PROCEDURE Declare_object (t, super: TypeUID;  brand: TEXT;  traced: BOOLEAN;
                n_fields, n_methods, n_overrides: INTEGER;  field_size: Size) =
  CONST Tag = ARRAY BOOLEAN OF CHAR { 'U', 'V' };
  BEGIN
    OutX (t, Tag[traced]);
    OutU (super);
    OutI (n_fields);
    OutI (n_methods);
    OutI (n_overrides);
    OutI (field_size);
    IF (brand # NIL) THEN
      OutC (' ');
      OutT (brand);
    END;
    NL ();
  END Declare_object;

PROCEDURE Declare_method (n: Name;  signature: TypeUID;  dfault: Expr.T) =
  VAR proc: Value.T;
  BEGIN
    OutC ('W');
    OutN (n);
    OutU (signature);
    IF (dfault = NIL) THEN
      (* skip *)
    ELSIF UserProc.IsProcedureLiteral (dfault, proc) THEN
      OutV (proc);
    ELSE
      OutT (" NIL");
    END;
    NL ();
  END Declare_method;

PROCEDURE Declare_override (n: Name;  dfault: Expr.T) =
  VAR proc: Value.T;
  BEGIN
    OutC ('X');
    OutN (n);
    IF (dfault = NIL) THEN
      OutT (" (??)");
    ELSIF UserProc.IsProcedureLiteral (dfault, proc) THEN
      OutV (proc);
    ELSE
      OutT (" NIL");
    END;
    NL ();
  END Declare_override;

PROCEDURE Declare_opaque (t, super: TypeUID) =
  BEGIN
    OutX (t, 'Y');
    OutU (super);
    NL ();
  END Declare_opaque;

PROCEDURE Reveal_opaque (lhs, rhs: TypeUID) =
  BEGIN
    OutX (lhs, 'Z');
    OutU (rhs);
    NL ();
  END Reveal_opaque;

PROCEDURE OutC (c: CHAR) =
  BEGIN
    M3Buf.PutChar (info, c);
  END OutC;

PROCEDURE OutI (i: INTEGER) =
  BEGIN
    M3Buf.PutChar (info, ' ');
    M3Buf.PutInt (info, i);
  END OutI;

PROCEDURE OutU (t: TypeUID) =
  BEGIN
    M3Buf.PutChar (info, ' ');
    PutHex (t);
  END OutU;

PROCEDURE OutN (n: Name) =
  BEGIN
    M3ID.Put (info, n);
  END OutN;

PROCEDURE OutX (t: TypeUID;  c: CHAR) =
  BEGIN
    M3Buf.PutChar (info, c);
    PutHex (t);
  END OutX;

PROCEDURE OutV (v: Value.T) =
  VAR s: Scope.IDStack;
  BEGIN
    M3Buf.PutChar (info, ' ');
    s.top := 0;
    Scope.NameToPrefix (v, s, dots := TRUE, with_module := TRUE);
    Scope.PutStack (info, s);
  END OutV;

PROCEDURE OutZ (READONLY i: Target.Int) =
  BEGIN
    M3Buf.PutChar (info, ' ');
    M3Buf.PutIntt (info, i);
  END OutZ;

PROCEDURE OutT (t: TEXT) =
  BEGIN
    M3Buf.PutText (info, t);
  END OutT;

CONST
  HexDigit = ARRAY [0..15] OF CHAR {
                 '0','1','2','3','4','5','6','7',
                 '8','9','a','b','c','d','e','f' };

PROCEDURE PutHex (i: INTEGER) =
  VAR buf: ARRAY [0..7] OF CHAR;
  BEGIN
    FOR j := 7 TO 0 BY -1 DO
      buf[j] := HexDigit [Word.Mod (i, 16)];
      i := Word.Divide (i, 16);
    END;
    M3Buf.PutSub (info, buf);
  END PutHex;

PROCEDURE NL () =
  BEGIN
    M3Buf.PutText (info, Target.EOL);
  END NL;

BEGIN
END WebInfo.