MODULE M3CExpsMisc;

(***************************************************************************)
(*                      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 Text;

IMPORT M3AST_AS, M3AST_SM;

IMPORT M3AST_AS_F, M3AST_SM_F;

IMPORT SeqM3AST_AS_Actual;

IMPORT M3Error, M3Assert, M3CStdProcs;


PROCEDURE Classify(exp: M3AST_AS.EXP): Class RAISES {}=
  BEGIN
    TYPECASE exp OF
    | M3AST_AS.Exp_used_id(expUsedId) =>
        TYPECASE expUsedId.vUSED_ID.sm_def OF
        | NULL =>
            (* assume normal *)
        | M3AST_AS.Interface_id, M3AST_AS.Interface_AS_id =>
            RETURN Class.Interface;
        | M3AST_AS.Module_id =>
            M3Assert.Fail(); (* can't happen? *)
        | M3AST_AS.Type_id =>
            RETURN Class.Type;
        | M3AST_AS.Exc_id =>
            RETURN Class.Exception;
        | M3AST_AS.METHOD_OVERRIDE_ID =>
            RETURN Class.Method;
        ELSE
          (* normal *)
        END; (* case *)
    | M3AST_AS.Binary(binary) =>
        IF ISTYPE(binary.as_binary_op, M3AST_AS.Select) THEN
          WITH class2 = Classify(binary.as_exp2) DO
            IF class2 = Class.Method AND
                Classify(binary.as_exp1) = Class.Type THEN
              (* ObjectType.method *)
              RETURN Class.Normal;
            ELSE
              RETURN class2;
            END; (* if *)
          END;
        END; (* if *)
    ELSE
      (* take the default *)
    END; (* case *)
    (* if we get here everything looks normal *)
    RETURN Class.Normal;
  END Classify;


PROCEDURE WrongClass(en: M3Error.ERROR_NODE; class: Class) RAISES {}=
  VAR
    text: Text.T;
  BEGIN
    CASE class OF
    | Class.Normal =>    text := "invalid use of expression";
    | Class.Type =>      text := "invalid use of type";
    | Class.Interface => text := "invalid use of interface";
    | Class.Method =>    text := "invalid use of method";
    | Class.Exception => text := "invalid use of exception";
    ELSE
      M3Assert.Fail();
    END; (* case *)
    M3Error.Report(en, text);
  END WrongClass;


PROCEDURE Index(
    index: M3AST_AS.Index;
    VAR writable: BOOLEAN)
    : BOOLEAN
    RAISES {}=
  VAR
    array := index.as_array;
  BEGIN
    TYPECASE array.sm_exp_type_spec OF
    | NULL =>
    | M3AST_AS.Array_type =>
        RETURN IsDesignator(array, writable);
    ELSE
    END; (* if *)
    (* could validly be a ref type or could just be an error. In either
     case we go for: *)
    writable := TRUE;
    RETURN TRUE;
  END Index;


PROCEDURE FirstParam(
    params: SeqM3AST_AS_Actual.T;
    VAR writable: BOOLEAN)
    : BOOLEAN
    RAISES {}=
  VAR
    actual: M3AST_AS.Actual;
    seqActual := SeqM3AST_AS_Actual.NewIter(params);
  BEGIN
    IF SeqM3AST_AS_Actual.Next(seqActual, actual) THEN
      TYPECASE actual.as_exp_type OF
      | M3AST_AS.EXP(exp) =>
          RETURN IsDesignator(exp, writable);
      ELSE
      END; (* if *)
    END; (* if *)
    (* we get here if there has been a previous error; the default is
     optimistic: *)
    writable := TRUE;
    RETURN TRUE;
  END FirstParam;


PROCEDURE Selection(
    b: M3AST_AS.Binary;
    VAR writable: BOOLEAN)
    : BOOLEAN
    RAISES {}=
  VAR
    exp1, exp2: M3AST_AS.EXP;
  BEGIN
    exp1 := b.as_exp1;
    CASE Classify(exp1) OF
    | Class.Normal =>
        TYPECASE exp1.sm_exp_type_spec OF
        | NULL =>
            (* take the default *)
        | M3AST_AS.Record_type =>
            RETURN IsDesignator(exp1, writable);
        | M3AST_AS.Object_type =>
            exp2 := b.as_exp2;
            TYPECASE exp2 OF
            | M3AST_AS.Exp_used_id(expUsedId) =>
                VAR
                  defId := expUsedId.vUSED_ID.sm_def;
                BEGIN
                  IF defId # NIL AND
                     ISTYPE(defId, M3AST_AS.METHOD_OVERRIDE_ID) THEN
                    RETURN FALSE;
                  END;
                END;
                (* take the default *)
            ELSE
              (* is an object field or there is an error; be optimistic and
               drop through to default *)
            END; (* if *)
        ELSE
          (* could validly be a ref type or it may be an error; in either
             case we take the default *)
        END; (* case *)
    | Class.Interface =>
        RETURN IsDesignator(b.as_exp2, writable);
    | Class.Type =>
        (* ObjectType.blah, Enumeration.blah *)
        RETURN FALSE;
    ELSE
      (* there has been a cockup; be optimistic and take the default *)
    END; (* case *)
    writable := TRUE;
    RETURN TRUE;
  END Selection;


PROCEDURE IsDesignator(
    exp: M3AST_AS.EXP;
    VAR writable: BOOLEAN)
    : BOOLEAN
    RAISES {}=
  VAR
    def_id: M3AST_SM.DEF_ID_UNSET;
    pf: M3CStdProcs.T;
  BEGIN
    TYPECASE exp OF
    | M3AST_AS.Exp_used_id(exp_used_id) =>
        def_id := exp_used_id.vUSED_ID.sm_def;
        IF def_id = NIL THEN writable := TRUE; RETURN TRUE END;
        TYPECASE def_id OF
        | M3AST_AS.Var_id,
          M3AST_AS.F_Var_id,
          M3AST_AS.F_Value_id,
          M3AST_AS.Tcase_id,
          M3AST_AS.Handler_id =>
            writable := TRUE;
            RETURN TRUE;
        | M3AST_AS.F_Readonly_id,
          M3AST_AS.For_id =>
            writable := FALSE;
            RETURN TRUE;
        | M3AST_AS.With_id(with_id) =>
            WITH withExp = with_id.vINIT_ID.sm_init_exp DO
              IF withExp = NIL THEN
                writable := TRUE;
                RETURN TRUE;
              ELSE
                IF NOT IsDesignator(withExp, writable) THEN
                  writable := FALSE;
                END;
                RETURN TRUE;
              END;
            END;
        ELSE
          (* no *)
        END; (* case *)
    | M3AST_AS.Binary(binary) =>
        IF ISTYPE(binary.as_binary_op, M3AST_AS.Select) THEN
          RETURN Selection(binary, writable);
        END; (* if *)
    | M3AST_AS.Unary(unary) =>
        IF ISTYPE(unary.as_unary_op, M3AST_AS.Deref) THEN
          writable := TRUE;
          RETURN TRUE;
        END; (* if *)
    | M3AST_AS.Call(call) =>
        IF M3CStdProcs.IsStandardCall(exp, pf) AND
            ((pf = M3CStdProcs.T.Subarray) OR (pf = M3CStdProcs.T.Loophole)) THEN
          RETURN FirstParam(call.as_param_s, writable);
        END; (* if *)
    | M3AST_AS.Index(index) =>
        RETURN Index(index, writable);
    ELSE
      (* no way *)
    END; (* case *)
    (* if we get here then it doesn't look at all like a designator *)
    RETURN FALSE;
  END IsDesignator;
   

PROCEDURE IsId(
    exp: M3AST_AS.EXP;
    VAR defId: M3AST_AS.DEF_ID)
    : BOOLEAN
    RAISES {}=
  VAR
    id: M3AST_AS.Exp_used_id;
  BEGIN
    TYPECASE exp OF
    | M3AST_AS.Exp_used_id(expUsedId) =>
        id := expUsedId;
    | M3AST_AS.Binary(binary) =>
        IF ISTYPE(binary.as_binary_op, M3AST_AS.Select) AND
            Classify(binary.as_exp1) = Class.Interface AND
            ISTYPE(binary.as_exp2, M3AST_AS.Exp_used_id) THEN
          id := binary.as_exp2;
        ELSE
          RETURN FALSE;
        END;
    ELSE
      RETURN FALSE
    END;
    (* If we get this far 'id' has been set up *)
    IF id.vUSED_ID.sm_def # NIL THEN
      defId := id.vUSED_ID.sm_def;
      RETURN TRUE;
    ELSE
      RETURN FALSE;
    END;
  END IsId;


BEGIN
END M3CExpsMisc.