MODULE M3LTypeToText EXPORTS M3LTypeToText, M3LTypeSpecToText;

(***************************************************************************)
(*                      Copyright (C) Olivetti 1989                        *)
(*                          All Rights reserved                            *)
(*                                                                         *)
(* Use and copy of this software and preparation of derivative works based *)
(* upon this software are permitted to any person, provided this same      *)
(* copyright notice and the following Olivetti warranty disclaimer are     *) 
(* included in any copy of the software or any modification thereof or     *)
(* derivative work therefrom made by any person.                           *)
(*                                                                         *)
(* This software is made available AS IS and Olivetti disclaims all        *)
(* warranties with respect to this software, whether expressed or implied  *)
(* under any law, including all implied warranties of merchantibility and  *)
(* fitness for any purpose. In no event shall Olivetti be liable for any   *)
(* damages whatsoever resulting from loss of use, data or profits or       *)
(* otherwise arising out of or in connection with the use or performance   *)
(* of this software.                                                       *)
(***************************************************************************)


IMPORT IO, Text;

IMPORT M3AST_AS, M3AST_SM, M3ASTNext;

IMPORT M3AST_AS_F, M3AST_TM_F, M3AST_SM_F;

IMPORT SeqM3AST_AS_RANGE_EXP, SeqM3AST_AS_Enum_id, SeqM3AST_AS_M3TYPE,
    SeqM3AST_AS_Fields, SeqM3AST_AS_Formal_param, SeqM3AST_AS_Qual_used_id,
    SeqM3AST_AS_Method, SeqM3AST_AS_Override;

IMPORT M3CId, M3CLiteral;
IMPORT M3CTypesMisc, M3CStdTypes, M3CBackEnd, M3CExpValue;
IMPORT M3CBackEnd_C; (* for representation of brands *)

VAR
  char_g, boolean_g, cardinal_g, text_g: INTEGER;

PROCEDURE Initialize() RAISES {}=
  BEGIN
    (* these guys can't be initialized as global variables because 
       M3CStdTypes.Cardinal returns NIL until after M3 has been parsed
       and that doesn't occur until much later. 
    *)
    char_g := M3CStdTypes.Char().tmp_type_code;
    boolean_g := M3CStdTypes.Boolean().tmp_type_code;
    cardinal_g := M3CStdTypes.Cardinal().tmp_type_code;
    text_g := M3CStdTypes.Text().tmp_type_code;
  END Initialize;

PROCEDURE SmallNumberDigits(s: IO.Stream; n: CARDINAL) RAISES {IO.Error}=
  VAR  
    base: CARDINAL;
    baseCh: CHAR;
  BEGIN
    IF n >= FirstBigNumber THEN
      SmallNumberDigits(s, n DIV FirstBigNumber);
      n := n MOD FirstBigNumber;
    END;
    CASE n OF
    | FirstDigitValue..LastDigitValue =>
        base := FirstDigitValue;
        baseCh := FirstDigitCh;
    | FirstLowerValue..LastLowerValue =>
        base := FirstLowerValue;
        baseCh := FirstLowerCh;
    | FirstUpperValue..LastUpperValue =>
        base := FirstUpperValue;
        baseCh := FirstUpperCh;
    END; (* case *)
    IO.Put(s, VAL(ORD(baseCh) + n - base, CHAR));
  END SmallNumberDigits;


PROCEDURE SmallNumber(s: IO.Stream; n: CARDINAL) RAISES {IO.Error}=
  BEGIN
    IF n >= FirstBigNumber THEN
      IO.Put(s, BigNumberBraCh);
      SmallNumberDigits(s, n);
      IO.Put(s, BigNumberKetCh);
    ELSE
      SmallNumberDigits(s, n);
    END;
  END SmallNumber;


<*INLINE*> PROCEDURE TypeIndexDigits(
    s: IO.Stream;
    n: CARDINAL)
    RAISES {IO.Error}=
  VAR
    div := n DIV TypeIndexBase;
    mod := n MOD TypeIndexBase;
  BEGIN
    IF div # 0 THEN TypeIndexDigits(s, div) END;
    IO.Put(s, VAL(mod + ORD(TypeIndexFirstDigitCh), CHAR));
  END TypeIndexDigits;


PROCEDURE TypeIndex(s: IO.Stream; n: CARDINAL) RAISES {IO.Error}=
  CONST
    MaxOneDigit = TypeIndexBase - 1;
    MaxTwoDigit = TypeIndexBase * TypeIndexBase - 1;
    MaxThreeDigit = TypeIndexBase * TypeIndexBase * TypeIndexBase - 1;
  VAR
    ch: CHAR;
  BEGIN
    IF n <= MaxOneDigit THEN
      ch := TypeIndexOneCh;
    ELSIF n <= MaxTwoDigit THEN
      ch := TypeIndexTwoCh;
    ELSIF n <= MaxThreeDigit THEN
      ch := TypeIndexThreeCh;
    ELSE
      ch := TypeIndexManyCh;
    END;
    IO.Put(s, ch);
    TypeIndexDigits(s, n);
    IF ch = TypeIndexManyCh THEN IO.Put(s, ch) END;
  END TypeIndex;


PROCEDURE Txt(s: IO.Stream; t: Text.T) RAISES {IO.Error}=
  BEGIN
    SmallNumber(s, Text.Length(t));
    IO.PutText(s, t);
  END Txt;


PROCEDURE Id(s: IO.Stream; id: M3CId.T) RAISES {IO.Error}=
  BEGIN
    Txt(s, M3CId.ToText(id));
  END Id;


PROCEDURE Exp(s: IO.Stream; exp: M3AST_AS.EXP) RAISES {IO.Error}=
  BEGIN
    TYPECASE exp.sm_exp_type_spec OF
    | M3AST_AS.RefAny_type, M3AST_AS.Root_type,
      M3AST_AS.Address_type,
      M3AST_AS.Ref_type, M3AST_AS.Object_type,
      M3AST_AS.Opaque_type, M3AST_AS.Null_type,
      M3AST_AS.Procedure_type =>
        (* excepts for texts can only be NIL *)
        IF exp.sm_exp_type_spec.tmp_type_code = text_g THEN
          Txt(s, M3CBackEnd.ExpValueToText(
              exp.sm_exp_value));
        ELSE
          SmallNumber(s, 0);
        END;
    | M3AST_AS.Record_type, M3AST_AS.Array_type =>
        VAR
          constructor := M3CBackEnd.ConstructorOriginal(exp.sm_exp_value);
          iter := SeqM3AST_AS_RANGE_EXP.NewIter(constructor.sm_actual_s);
          r: M3AST_AS.RANGE_EXP;
        BEGIN
          WHILE SeqM3AST_AS_RANGE_EXP.Next(iter, r) DO
            Exp(s, NARROW(r, M3AST_AS.Range_EXP).as_exp);
          END; (* while *)
          IF constructor.as_propagate # NIL THEN
            IO.Put(s, PropagateCh);
          END;
          IO.Put(s, EndSeqCh);
        END;
    ELSE
      VAR
        val: INTEGER;
      BEGIN
        IF M3CExpValue.Ordinal(exp, val) = M3CBackEnd.NumStatus.Valid AND
           val = 0 THEN
          SmallNumber(s, 0);
        ELSE
          Txt(s, M3CBackEnd.ExpValueToText(exp.sm_exp_value));
        END;
      END;
    END;
  END Exp;


PROCEDURE QualId(s: IO.Stream; q: M3AST_AS.Qual_used_id) RAISES {IO.Error}=
  VAR
    defId := q.as_id.sm_def;
  BEGIN
    Id(s, defId.tmp_unit_id.lx_symrep);
    Id(s, defId.lx_symrep);
  END QualId;

PROCEDURE Enumeration(
    s: IO.Stream;
    e: M3AST_AS.Enumeration_type)
    RAISES {IO.Error}=
  BEGIN
    IF e.tmp_type_code = char_g THEN
      IO.Put(s, CharCh);
    ELSIF e.tmp_type_code = boolean_g THEN
      IO.Put(s, BooleanCh);
    ELSE
      VAR
        i := SeqM3AST_AS_Enum_id.NewIter(e.as_id_s);
        id: M3AST_AS.Enum_id;
      BEGIN
        IO.Put(s, EnumerationCh);
        WHILE SeqM3AST_AS_Enum_id.Next(i, id) DO
          Id(s, id.lx_symrep)
        END;
        IO.Put(s, EndSeqCh);
      END;
    END;
  END Enumeration;


PROCEDURE Subrange(
    s: IO.Stream;
    sub: M3AST_AS.Subrange_type)
    RAISES {IO.Error}=
  BEGIN
    IF sub.tmp_type_code = cardinal_g THEN
      IO.Put(s, CardinalCh);
    ELSE
      IO.Put(s, SubrangeCh);
      ComponentType(s, sub.sm_base_type_spec);
      Exp(s, sub.as_range.as_exp1);
      Exp(s, sub.as_range.as_exp2);
    END;
  END Subrange;


PROCEDURE Array(s: IO.Stream; a: M3AST_AS.Array_type) RAISES {IO.Error}=
  VAR
    iter := SeqM3AST_AS_M3TYPE.NewIter(a.as_indextype_s);
    m3Type: M3AST_AS.M3TYPE;
  BEGIN
    IO.Put(s, ArrayCh);
    IF SeqM3AST_AS_M3TYPE.Next(iter, m3Type) THEN
      ComponentType(s, m3Type);
    ELSE
      IO.Put(s, VoidCh);
    END;
    ComponentType(s, a.sm_norm_type.as_elementtype);
  END Array;


PROCEDURE Fields(
    s: IO.Stream;
    fields: SeqM3AST_AS_Fields.T)
    RAISES {IO.Error}=
  VAR
    iter := M3ASTNext.NewIterField(fields);
    id: M3AST_AS.Field_id;
  BEGIN
    WHILE M3ASTNext.Field(iter, id) DO
      Id(s, id.lx_symrep);
      ComponentType(s, id.sm_type_spec);
      IF id.vINIT_ID.sm_init_exp # NIL THEN
        IO.Put(s, DefaultCh);
        Exp(s, id.vINIT_ID.sm_init_exp);
      END; (* if *)
    END; (* while *)
    IO.Put(s, EndSeqCh);
  END Fields;


PROCEDURE Record(
    s: IO.Stream;
    r: M3AST_AS.Record_type)
    RAISES {IO.Error}=
  BEGIN
    IO.Put(s, RecordCh);
    Fields(s, r.as_fields_s);
  END Record;


PROCEDURE Packed(
    s: IO.Stream;
    b: M3AST_AS.Packed_type)
    RAISES {IO.Error}=
  BEGIN
    IO.Put(s, BitsCh);
    Exp(s, b.as_exp);
    ComponentType(s, b.as_type);
  END Packed;


PROCEDURE Set(s: IO.Stream; set: M3AST_AS.Set_type) RAISES {IO.Error}=
  BEGIN
    IO.Put(s, SetCh);
    ComponentType(s, set.as_type);
  END Set;


PROCEDURE Brand(s: IO.Stream; b: M3AST_AS.Brand_NULL) RAISES {IO.Error}=
  BEGIN
    IF b # NIL THEN
      IF b.as_exp = NIL THEN
        IO.Put(s, CompilerBrandCh);
      ELSE
        IO.Put(s, UserBrandCh);
      END; (* if *)
      Txt(s, NARROW(b.sm_brand, M3CBackEnd_C.Text_value).sm_value);
    END; (* if *)
  END Brand;


PROCEDURE Ref(s: IO.Stream; r: M3AST_AS.Ref_type) RAISES {IO.Error}=
  BEGIN
    IF r.as_trace_mode = NIL THEN
      IO.Put(s, RefCh);
    ELSE
      IO.Put(s, UntracedRefCh);
    END; (* if *)
    Brand(s, r.as_brand);
    ComponentType(s, r.as_type);
  END Ref;


PROCEDURE Formals(
    s: IO.Stream;
    formals: SeqM3AST_AS_Formal_param.T)
    RAISES {IO.Error}=
  VAR
    iter := M3ASTNext.NewIterFormal(formals);
    f: M3AST_AS.Formal_param;
    id: M3AST_AS.FORMAL_ID;
  BEGIN
    WHILE M3ASTNext.Formal(iter, f, id) DO
      TYPECASE id OF
      | M3AST_AS.F_Var_id => IO.Put(s, VarCh);
      | M3AST_AS.F_Readonly_id => IO.Put(s, ReadonlyCh);
      ELSE
      END;
      Id(s, id.lx_symrep);
      ComponentType(s, id.sm_type_spec);
      IF f.as_default # NIL THEN
        IO.Put(s, DefaultCh);
        Exp(s, f.as_default);
      END; (* if *)
    END; (* while *)
    IO.Put(s, EndSeqCh);
  END Formals;


PROCEDURE Procedure(
    s: IO.Stream;
    p: M3AST_AS.Procedure_type)
    RAISES {IO.Error}=
  BEGIN
    IO.Put(s, ProcedureCh);
    WITH smDefId = p.sm_def_id DO
      IF (smDefId # NIL) AND (ISTYPE(smDefId, M3AST_AS.Method_id)) THEN
        WITH methodId = NARROW(smDefId, M3AST_AS.Method_id) DO
          IO.Put(s, MethodCh);
          TypeIndex(s, methodId.vRECOBJ_ID.sm_enc_type_spec.tmp_type_code);
        END;
      END;
    END;

    Formals(s, p.as_formal_param_s);
    IF p.as_result_type = NIL THEN
      IO.Put(s, VoidCh);
    ELSE
      ComponentType(s, p.as_result_type);
    END; (* if *)
    VAR
      r := p.as_raises;
    BEGIN
      TYPECASE r OF
      | NULL => 
          IO.Put(s, EndSeqCh); (* RAISES {} *)
      | M3AST_AS.Raisees_any =>
          IO.Put(s, RaisesAnyCh);
      | M3AST_AS.Raisees_some(r) => 
          VAR
            i := SeqM3AST_AS_Qual_used_id.NewIter(r.as_raisees_s);
            q: M3AST_AS.Qual_used_id;
          BEGIN
            WHILE SeqM3AST_AS_Qual_used_id.Next(i, q) DO
              QualId(s, q);
            END; (* while *)
          END;
          IO.Put(s, EndSeqCh);
      END;
    END;
  END Procedure;


PROCEDURE Object(
    s: IO.Stream;
    o: M3AST_AS.Object_type)
    RAISES {IO.Error}=
  BEGIN
    IO.Put(s, ObjectCh);
    Brand(s, o.as_brand);
    IF o.as_ancestor = NIL THEN
      IO.Put(s, RootCh);
    ELSE
      ComponentType(s, o.as_ancestor);
    END; (* if *)
    Fields(s, o.as_fields_s);
    VAR
      i := SeqM3AST_AS_Method.NewIter(o.as_method_s);
      m: M3AST_AS.Method;
    BEGIN
      WHILE SeqM3AST_AS_Method.Next(i, m) DO
        Id(s, m.as_id.lx_symrep);
        ComponentType(s, m.as_type);
        IF m.as_default # NIL THEN
          IO.Put(s, DefaultCh);
          Exp(s, m.as_id.vINIT_ID.sm_init_exp);
        END; (* if *)
      END; (* while *)
    END;
    IO.Put(s, EndSeqCh);
    VAR
      i := SeqM3AST_AS_Override.NewIter(o.as_override_s);
      m: M3AST_AS.Override;
    BEGIN
      WHILE SeqM3AST_AS_Override.Next(i, m) DO
        Id(s, m.as_id.lx_symrep);
        ComponentType(s, m.as_id.sm_type_spec);
        IO.Put(s, DefaultCh);
        Exp(s, m.as_id.vINIT_ID.sm_init_exp);
      END; (* while *)
    END;
    IO.Put(s, EndSeqCh);
  END Object;


PROCEDURE Opaque(s: IO.Stream; o: M3AST_AS.Opaque_type) RAISES {IO.Error}=
  BEGIN
    IO.Put(s, OpaqueCh);
    IF o.sm_concrete_type_spec = NIL THEN
      TypeIndex(s, o.tmp_type_code);
      IO.Put(s, VoidCh);
    ELSE
      TypeSpec(s, o.sm_concrete_type_spec);
    END;
  END Opaque;


PROCEDURE ComponentType(s: IO.Stream; t: M3AST_AS.M3TYPE) RAISES {IO.Error}=
  VAR
    ts: M3AST_SM.TYPE_SPEC_UNSET;
    tc: INTEGER;
  BEGIN
    M3CTypesMisc.GetTYPE_SPECFromM3TYPE(t, ts);
    TYPECASE ts OF
    | M3AST_AS.Integer_type, M3AST_AS.FLOAT_TYPE,
      M3AST_AS.RefAny_type,
      M3AST_AS.Address_type, M3AST_AS.Null_type,
      M3AST_AS.Root_type =>
        TypeSpec(s, ts);
    ELSE
      tc := ts.tmp_type_code;
      IF tc = boolean_g THEN
        IO.Put(s, BooleanCh);
      ELSIF tc = char_g THEN
        IO.Put(s, CharCh);
      ELSIF tc = cardinal_g THEN
        IO.Put(s, CardinalCh);
      ELSE 
        TypeIndex(s, tc);
      END;
    END;
  END ComponentType;


PROCEDURE TypeSpec(
    s: IO.Stream;
    t: M3AST_AS.TYPE_SPEC)
    RAISES {IO.Error}=
  BEGIN
    TYPECASE t OF
    | M3AST_AS.Integer_type =>
        IO.Put(s, IntegerCh);
    | M3AST_AS.Real_type =>
        IO.Put(s, RealCh);
    | M3AST_AS.LongReal_type =>
        IO.Put(s, LongRealCh);
    | M3AST_AS.Extended_type =>
        IO.Put(s, ExtendedCh);
    | M3AST_AS.RefAny_type =>
        IO.Put(s, RefAnyCh);
    | M3AST_AS.Address_type =>
        IO.Put(s, AddressCh);
    | M3AST_AS.Null_type =>
        IO.Put(s, NullCh);
    | M3AST_AS.Root_type(root_type) =>
        IF root_type.as_trace_mode = NIL THEN
          IO.Put(s, RootCh);
        ELSE
          IO.Put(s, UntracedRootCh);
        END;
    | M3AST_AS.Enumeration_type =>
        Enumeration(s, t);
    | M3AST_AS.Subrange_type =>
        Subrange(s, t);
    | M3AST_AS.Array_type =>
        Array(s, t);
    | M3AST_AS.Record_type =>
        Record(s, t);
    | M3AST_AS.Packed_type =>
        Packed(s, t);
    | M3AST_AS.Set_type =>
        Set(s, t);
    | M3AST_AS.Ref_type =>
        Ref(s, t);
    | M3AST_AS.Procedure_type =>
        Procedure(s, t);
    | M3AST_AS.Object_type =>
        Object(s, t);
    | M3AST_AS.Opaque_type =>
        Opaque(s, t);
    END; (* case *)
  END TypeSpec;


BEGIN
END M3LTypeToText.