m3tk/src/sem/M3CExpsMisc.m3


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.Select(select) =>
          WITH class2 = Classify(select.as_id) DO
            IF class2 = Class.Method AND
                Classify(select.as_exp) = Class.Type THEN
              (* ObjectType.method *)
              RETURN Class.Normal;
            ELSE
              RETURN class2;
            END; (* if *)
          END;
    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.Select;
    VAR writable: BOOLEAN)
    : BOOLEAN
    RAISES {}=
  VAR
    exp1: M3AST_AS.EXP;
  BEGIN
    exp1 := b.as_exp;
    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 =>
            VAR
              defId := b.as_id.vUSED_ID.sm_def;
            BEGIN
              IF defId # NIL AND
                 ISTYPE(defId, M3AST_AS.METHOD_OVERRIDE_ID) THEN
                RETURN FALSE;
              END;
            END;
        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_id, 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.Select(select) =>
        RETURN Selection(select, writable);

    | M3AST_AS.Deref(*unary*) =>
        writable := TRUE;
        RETURN TRUE;

    | 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.Select(select) =>
        IF Classify(select.as_exp) = Class.Interface THEN
          id := select.as_id;
        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.