MODULE QVal;

IMPORT Fmt, Convert, Text;
IMPORT M3Buf, Quake, QIdent, QValue, QVTbl, QVSeq, QMachine, QCode;
FROM Quake IMPORT Error, Machine, ID;

TYPE
  QK = QValue.Kind;

PROCEDURE ToTag (m: Machine;  READONLY t: T): TEXT
  RAISES {Error} =
  VAR txt: TEXT;
  BEGIN
    CASE t.kind OF
    | QK.Var      => txt := "<variable " & m.map.id2txt (t.int) & ">";
    | QK.Integer  => txt := Fmt.Int (t.int);
    | QK.String   => txt := m.map.id2txt (t.int);
    | QK.Table    => txt := TableText (m, t.ref, TRUE);
    | QK.Array    => txt := ArrayText (m, t.ref, TRUE);
    | QK.Proc     => txt := ProcText (m, t.ref);
    END; (*CASE*)
    RETURN txt;
  END ToTag;

PROCEDURE ToBool (m: Machine;  READONLY t: T): BOOLEAN
  RAISES {Error} =
  BEGIN
    IF t.kind # QK.String THEN
      m.error ("attempting to use non-string value as a boolean: " & ToTag (m, t))
    END;
    RETURN (t.int # m.map.boolean [FALSE]);
  END ToBool;

PROCEDURE ToInt (m: Machine;  READONLY t: T): INTEGER
  RAISES {Error} =
  VAR
    txt: TEXT;
    used, val, len: INTEGER;
    buf: ARRAY [0..BITSIZE(INTEGER)-1] OF CHAR;
  BEGIN
    IF t.kind = QK.Integer THEN
      RETURN t.int;
    END;
    IF t.kind # QK.String THEN
      m.error ("cannot convert value to an integer: " & ToTag (m, t))
    END;
    txt := m.map.id2txt (t.int);
    len := Text.Length (txt);
    Text.SetChars (buf, txt);
    val := Convert.ToInt (SUBARRAY (buf, 0, len), used);
    IF (used # len) THEN
      m.error ("cannot convert value to an integer: " & ToTag (m, t))
    END;
    RETURN val;
  END ToInt;

PROCEDURE ToText (m: Machine;  READONLY t: T): TEXT
  RAISES {Error} =
  BEGIN
    CASE t.kind OF
    | QK.Integer => RETURN Fmt.Int (t.int);
    | QK.String  =>
      IF t.int # Quake.NoID THEN
        RETURN m.map.id2txt (t.int);
      ELSE
        RETURN NARROW (t.ref, TEXT);
      END;
    | QK.Array   => RETURN ArrayText (m, t.ref, FALSE);
    | QK.Table   => RETURN TableText (m, t.ref, FALSE);
    ELSE m.error ("cannot convert value to string: " & ToTag (m, t));  RETURN NIL;
    END;
  END ToText;

PROCEDURE ToID (m: Machine;  READONLY t: T): ID
  RAISES {Error} =
  BEGIN
    IF (t.kind = QK.String)
      THEN RETURN t.int;
      ELSE RETURN m.map.txt2id (ToText (m, t));
    END;
  END ToID;

PROCEDURE ToTable (m: Machine;  READONLY t: T): QVTbl.T
  RAISES {Error} =
  BEGIN
    IF t.kind # QK.Table THEN
      m.error ("cannot convert value to table: " & ToTag (m, t));
    END;
    RETURN t.ref;
  END ToTable;

PROCEDURE ToArray (m: Machine;  READONLY t: T): QVSeq.T
  RAISES {Error} =
  BEGIN
    IF t.kind # QK.Array THEN
      m.error ("cannot convert value to array: " & ToTag (m, t));
    END;
    RETURN t.ref;
  END ToArray;

PROCEDURE ToProc (m: Machine;  READONLY t: T): QValue.Proc
  RAISES {Error} =
  BEGIN
    IF t.kind # QK.Proc THEN
      m.error ("attempting to call a non-procedure value: " & ToTag (m, t));
    END;
    RETURN t.ref;
  END ToProc;

PROCEDURE ToBuf (m: Machine;  READONLY t: T;  buf: M3Buf.T)
  RAISES {Error} =
  BEGIN
    FillBuf (m, t, buf, FALSE);
  END ToBuf;

PROCEDURE FillBuf (m: Machine;  READONLY t: T;  buf: M3Buf.T;  tag_only: BOOLEAN)
  RAISES {Error} =
  BEGIN
    CASE t.kind OF
    | QK.Integer => M3Buf.PutInt  (buf, t.int);
    | QK.String  =>
      IF t.ref = NIL THEN
        M3Buf.PutText (buf, m.map.id2txt (t.int));
      ELSE
        M3Buf.PutText (buf, NARROW (t.ref, TEXT));
      END;
    | QK.Array   => ArrayToBuf (m, t.ref, buf, tag_only);
    | QK.Table   => TableToBuf (m, t.ref, buf, tag_only);
    ELSE m.error ("cannot convert value to string: " & ToTag (m, t));
    END;
  END FillBuf;

PROCEDURE TableText (m: Machine;  tbl: QVTbl.T;  tag_only: BOOLEAN): TEXT
  RAISES {Error} =
  VAR buf := M3Buf.New ();
  BEGIN
    TableToBuf (m, tbl, buf, tag_only);
    RETURN M3Buf.ToText (buf);
  END TableText;

PROCEDURE TableToBuf (m: Machine;  tbl: QVTbl.T;  buf: M3Buf.T;  tag_only: BOOLEAN)
  RAISES {Error} =
  VAR
    iter  := tbl.iterate();
    key   : INTEGER;
    val   : T;
    first := TRUE;
  BEGIN
    IF tag_only THEN M3Buf.PutText (buf, "{ "); END;
    WHILE iter.next(key, val) DO
      IF tag_only THEN
        IF NOT first THEN M3Buf.PutText (buf, ", ..."); EXIT; END;
        M3Buf.PutText (buf, m.map.id2txt (key));
        M3Buf.PutText (buf, ": ");
      END;
      IF NOT first THEN M3Buf.PutChar (buf, ' '); END;
      FillBuf (m, val, buf, tag_only);
      first := FALSE;
    END;
    IF tag_only THEN M3Buf.PutText (buf, " }"); END;
  END TableToBuf;

PROCEDURE ArrayText (m: Machine;  arr: QVSeq.T;  tag_only: BOOLEAN): TEXT
  RAISES {Error} =
  VAR buf := M3Buf.New ();
  BEGIN
    ArrayToBuf (m, arr, buf, tag_only);
    RETURN M3Buf.ToText (buf);
  END ArrayText;

PROCEDURE ArrayToBuf (m: Machine;  arr: QVSeq.T;  buf: M3Buf.T;  tag_only: BOOLEAN)
  RAISES {Error} =
  BEGIN
    IF tag_only THEN M3Buf.PutText (buf, "[ "); END;
    FOR i := 0 TO arr.size() - 1 DO
      IF tag_only AND (i > 0) THEN M3Buf.PutText (buf, ", ..."); EXIT; END;
      IF i > 0 THEN M3Buf.PutChar (buf, ' '); END;
      FillBuf (m, arr.get(i), buf, tag_only);
    END;
    IF tag_only THEN M3Buf.PutText (buf, " ]"); END;
  END ArrayToBuf;

PROCEDURE ProcText (m: Machine;  proc: QValue.Proc): TEXT =
  BEGIN
    IF proc.info.builtin THEN
      RETURN "<builtin procedure "
               & m.map.id2txt (proc.info.name)
               & ">";
    ELSE
      RETURN "<procedure "
               & m.map.id2txt (proc.info.name)
               & " from "
               & m.map.id2txt (proc.info.code.source_file)
               & ">";
    END;
  END ProcText;

BEGIN
END QVal.