MODULE M3CActualUtil;

IMPORT M3AST_LX, M3AST_AS, M3AST_SM;

IMPORT M3AST_LX_F, M3AST_AS_F, M3AST_SM_F;

IMPORT SeqM3AST_AS_EXP, SeqM3AST_AS_CONS_ELEM, SeqM3AST_AS_Actual;

IMPORT M3Error, M3Assert, M3CTypeRelation, M3CTypeChkUtil, M3CExpsMisc,
    M3CDef, M3CSrcPos;

PROCEDURE Passable(
    formalType: M3AST_SM.TYPE_SPEC_UNSET;
    actual: M3AST_AS.EXP;
    safe: BOOLEAN)
    : BOOLEAN
    RAISES {}=
  BEGIN
    IF formalType = NIL THEN RETURN TRUE END;
    IF ISTYPE(formalType, M3AST_AS.Procedure_type) THEN
      (* don't want the check to see if 'actual' is top level which comes
       with 'EXPAssignable' *)
      RETURN M3CTypeRelation.Assignable(
          formalType, actual.sm_exp_type_spec, safe);
    ELSE
      RETURN M3CTypeChkUtil.EXPAssignable(formalType, actual, safe);
    END; (* if *)
  END Passable;

PROCEDURE AddDefault(
    call: M3AST_AS.Call;
    formal: M3AST_AS.Formal_param)
    : BOOLEAN
    RAISES {}=
  BEGIN
    IF formal.as_default # NIL THEN
      (* assuming defaults on VAR parameters are caught elsewhere *)
      SeqM3AST_AS_EXP.AddRear(call.sm_actual_s, formal.as_default);
      RETURN TRUE;
    ELSE
      RETURN FALSE;
    END; (* if *)
  END AddDefault;

PROCEDURE CheckIsVARActual(actual: M3AST_AS.EXP) RAISES {}=
  VAR
    writeable: BOOLEAN;
  BEGIN
    IF NOT (M3CExpsMisc.IsDesignator(actual, writeable) AND writeable) THEN
      M3Error.Report(actual,
          "argument to VAR parameter is not writeable designator");
    END; (* if *)
  END CheckIsVARActual;

PROCEDURE TooFewArguments(call: M3AST_AS.Call) RAISES {}=
  BEGIN
    M3Error.Report(call, "too few arguments for procedure call")
  END TooFewArguments;

PROCEDURE TooManyArguments(call: M3AST_AS.Call) RAISES {}=
  BEGIN
    M3Error.Report(call, "too many arguments for procedure call")
  END TooManyArguments;

PROCEDURE ArgumentIsWrongType(exp: M3AST_AS.EXP) RAISES {}=
  BEGIN
    M3Error.Report(exp, "argument is wrong type");
  END ArgumentIsWrongType;

TYPE
  LotsOfActuals = [0..15];
  (* the procedures below cope with more than 15 elements, but they slow down
   a little *)

  SetOfLotsOfActuals = SET OF LotsOfActuals;

  ExpAndId = RECORD
    exp: M3AST_AS.EXP;
    id: M3AST_AS.Exp_used_id;
    hashId: M3AST_LX.Symbol_rep;
  END; (* record *)

REVEAL
  List = BRANDED REF RECORD
    next: List;
    count, positionals: INTEGER;
    matched: SetOfLotsOfActuals;
    array: ARRAY LotsOfActuals OF ExpAndId;
  END; (* record *)

TYPE
  BuildingRec = RECORD
    first, last: List := NIL;
    positional := TRUE;
  END; (* record *)

CONST
  AllMatched =
      SetOfLotsOfActuals{FIRST(LotsOfActuals)..LAST(LotsOfActuals)};

EXCEPTION
  FatalActualError;

PROCEDURE NewListRec(): List RAISES {}=
  VAR
    new := NEW(List);
  BEGIN
    new.next := NIL;
    new.count := 0;
    new.positionals := 0;
    new.matched := AllMatched;
    RETURN new;
  END NewListRec;

PROCEDURE AddExpAndId(
    exp: M3AST_AS.EXP;
    id: M3AST_AS.Exp_used_id;
    VAR b: BuildingRec)
    RAISES {}=
  BEGIN
    IF (b.first = NIL) OR (b.last.count > LAST(b.last.array)) THEN
      WITH new = NewListRec() DO
        IF b.first = NIL THEN b.first := new ELSE b.last.next := new END;
        b.last := new;
      END;
    END;
    VAR
      last := b.last;
    BEGIN
      WITH expAndId = last.array[last.count] DO
        expAndId.exp := exp;
        expAndId.id := id;
        IF id # NIL THEN
          expAndId.hashId := id.vUSED_ID.lx_symrep;
        ELSE
          expAndId.hashId := NIL;
        END;
      END;
      IF id = NIL THEN
        IF b.positional THEN
          INC(last.positionals);
          last.matched := last.matched - SetOfLotsOfActuals{last.count};
        ELSE
          M3Error.Report(exp,
              "positional items must precede those with keywords");
        END; (* if *)
      ELSE (* is not positional *)
        last.matched := last.matched - SetOfLotsOfActuals{last.count};
        b.positional := FALSE;
      END; (* if *)
      INC(last.count);
    END;
  END AddExpAndId;

PROCEDURE AddTypeSpec(
    ts: M3AST_SM.TYPE_SPEC_UNSET;
    pos: M3CSrcPos.T;
    VAR b: BuildingRec)
    RAISES {}=
  VAR
    t: M3AST_SM.TypeActual := NEW(M3AST_SM.TypeActual).init();
  BEGIN
    t.lx_srcpos := pos;
    t.sm_exp_type_spec := ts;
    AddExpAndId(t, NIL, b);
  END AddTypeSpec;

PROCEDURE AddActual(
    actual: M3AST_AS.Actual;
    VAR b: BuildingRec;
    typeOk := FALSE)
    RAISES {}=
  VAR
    id: M3AST_AS.Exp_used_id;
  BEGIN
    TYPECASE actual.as_id OF
    | NULL =>
        id := NIL;
    | M3AST_AS.Exp_used_id(expUsedId) =>
        id := expUsedId;
        typeOk := FALSE;
    ELSE
      M3Error.Report(actual.as_id, "expression not bound to valid keyword");
      id := NIL;
    END;
    TYPECASE actual.as_exp_type OF <*NOWARN*>
    | M3AST_AS.EXP(exp) =>
        WITH class =  M3CExpsMisc.Classify(exp) DO
          IF class = M3CExpsMisc.Class.Normal THEN
            AddExpAndId(exp, id, b);
          ELSIF typeOk AND class = M3CExpsMisc.Class.Type THEN
            VAR
              defId: M3AST_AS.DEF_ID;
            BEGIN
              M3Assert.Check(M3CExpsMisc.IsId(exp, defId) AND
                  ISTYPE(defId, M3AST_AS.Type_id));
              AddTypeSpec(NARROW(defId, M3AST_AS.Type_id).sm_type_spec,
                  exp.lx_srcpos, b);
            END;
          ELSE
            M3CExpsMisc.WrongClass(exp, class);
            AddExpAndId(NIL, id, b);
          END;
        END;
    | M3AST_AS.M3TYPE(m3Type) =>
        IF typeOk THEN
          TYPECASE m3Type OF <*NOWARN*>
          | M3AST_AS.Bad_M3TYPE =>
              AddTypeSpec(NIL, m3Type.lx_srcpos, b);
          | M3AST_AS.TYPE_SPEC(typeSpec) =>
              AddTypeSpec(typeSpec, typeSpec.lx_srcpos, b);
          END;
        ELSE
          M3CExpsMisc.WrongClass(m3Type, M3CExpsMisc.Class.Type);
          AddExpAndId(NIL, id, b);
        END;
    END; (* if *)
  END AddActual;

PROCEDURE ElementList(cons: M3AST_AS.Constructor): List RAISES {}=
  VAR
    b := BuildingRec{};
    iter := SeqM3AST_AS_CONS_ELEM.NewIter(cons.as_element_s);
    element: M3AST_AS.CONS_ELEM;
  BEGIN
    WHILE SeqM3AST_AS_CONS_ELEM.Next(iter, element) DO
      TYPECASE element OF <*NOWARN*>
      | M3AST_AS.Actual_elem(aElem) =>
          AddActual(aElem.as_actual, b);
      | M3AST_AS.RANGE_EXP_elem(rElem) =>
          TYPECASE rElem.as_range_exp OF
          | M3AST_AS.Range_EXP(rangeExp) =>
              AddExpAndId(rangeExp.as_exp, NIL, b);
          ELSE
            M3Error.Report(rElem, "range not allowed in record constructor");
          END;
      END;
    END;
    RETURN b.first;
  END ElementList;

PROCEDURE ActualList(call: M3AST_AS.Call; typeOk := FALSE): List RAISES {}=
  VAR
    b := BuildingRec{};
    s: SeqM3AST_AS_Actual.T := NIL;
    iter: SeqM3AST_AS_Actual.Iter;
    actual: M3AST_AS.Actual;
  BEGIN
    TYPECASE call OF
    | M3AST_AS.NEWCall(newcall) => s := newcall.sm_norm_actual_s;
    ELSE
    END;
    IF s = NIL THEN s := call.as_param_s END;
    iter := SeqM3AST_AS_Actual.NewIter(s);
    WHILE SeqM3AST_AS_Actual.Next(iter, actual) DO
      AddActual(actual, b, typeOk);
    END;
    RETURN b.first;
  END ActualList;

PROCEDURE TotalActuals(a: List): INTEGER RAISES {}=
  BEGIN
    IF a = NIL THEN
      RETURN 0;
    ELSIF a.next = NIL THEN
      RETURN a.count;
    ELSE
      RETURN NUMBER(LotsOfActuals) + TotalActuals(a.next);
    END; (* if *)
  END TotalActuals;

PROCEDURE PositionalActuals(a: List): INTEGER RAISES {}=
  BEGIN
    IF a = NIL THEN
      RETURN 0;
    ELSIF (a.count > a.positionals) OR (a.next = NIL) THEN
      RETURN a.positionals;
    ELSE
      RETURN NUMBER(LotsOfActuals) + PositionalActuals(a.next);
    END; (* if *)
  END PositionalActuals;

PROCEDURE FindByKeyword(
    keyword: M3AST_LX.Symbol_rep;
    VAR a: List;
    VAR pos: INTEGER)
    : BOOLEAN
    RAISES {}=
  <*FATAL FatalActualError*>
  BEGIN
    IF (a = NIL) OR (keyword = NIL) THEN
      RETURN FALSE;
    ELSE
      LOOP
        IF pos >= a.count THEN
          IF pos > a.count THEN RAISE FatalActualError END;
          a := a.next;
          IF a = NIL THEN RETURN FALSE END;
          pos := 0;
        END; (* if *)
        IF a.array[pos].hashId = keyword AND (* conjunct added MJJ 10/21/92 *)
           NOT(pos IN a.matched) THEN
          RETURN TRUE;
        ELSE
          INC(pos);
          (* and loop *)
        END; (* if *)
      END; (* loop *)
    END; (* if *)
  END FindByKeyword;

PROCEDURE MarkAsMatchedAndLookForDuplicates(
    keyword: M3AST_LX.Symbol_rep;
    VAR a: List;
    VAR pos: INTEGER)
    RAISES {}=
  BEGIN
    LOOP
      a.matched := a.matched + SetOfLotsOfActuals{pos};
      INC(pos);
      IF FindByKeyword(keyword, a, pos) THEN
        WITH expAndId = a.array[pos] DO
          M3Error.ReportWithId(expAndId.id,
            "\'%s\' has already been bound", expAndId.hashId);
        END;
      ELSE
        EXIT;
      END; (* if *)
    END; (* loop *)
  END MarkAsMatchedAndLookForDuplicates;

PROCEDURE ActualAt(
    a: List;
    pos: INTEGER;
    id: M3AST_LX.Symbol_rep)
    : M3AST_AS.EXP
    RAISES {}=
  <*FATAL FatalActualError*>
  BEGIN
    LOOP
      IF (pos < 0) OR (a = NIL) THEN
        RAISE FatalActualError;
      ELSIF pos < a.positionals THEN
        WITH expAndId = a.array[pos] DO
          MarkAsMatchedAndLookForDuplicates(id, a, pos);
          RETURN expAndId.exp;
        END;
      ELSE
        DEC(pos, NUMBER(LotsOfActuals));
        a := a.next;
      END; (* if *)
    END; (* loop *)
  END ActualAt;

PROCEDURE ActualByKeyword(
    a: List;
    typedId: M3AST_AS.TYPED_ID;
    VAR exp: M3AST_AS.EXP)
    : BOOLEAN
    RAISES {}=
  VAR
    position: INTEGER;
  BEGIN
    IF a = NIL THEN
      RETURN FALSE;
    ELSE
      position := a.positionals;
      IF FindByKeyword(typedId.lx_symrep, a, position) THEN
        WITH expAndId = a.array[position] DO
          exp := expAndId.exp;
          M3CDef.ResolveActualKeyword(expAndId.id, typedId);
          expAndId.id.sm_exp_type_spec := typedId.sm_type_spec;
        END;
        MarkAsMatchedAndLookForDuplicates(typedId.lx_symrep, a, position);
        RETURN TRUE;
      ELSE
        RETURN FALSE;
      END; (* if *)
    END; (* if *)
  END ActualByKeyword;

PROCEDURE FindUnmatched(a: List) RAISES {}=
  BEGIN
    WHILE a # NIL DO
      IF a.matched # AllMatched THEN
        FOR m := VAL(a.positionals, LotsOfActuals) TO LAST(LotsOfActuals) DO
          IF NOT (m IN a.matched) THEN
            WITH expAndId = a.array[m] DO
              M3Error.ReportWithId(expAndId.id,
                "no match found for keyword \'%s\'", expAndId.hashId);
            END;
          END; (* if *)
        END; (* for *)
      END; (* if *)
      a := a.next;
    END; (* while *)
  END FindUnmatched;

PROCEDURE OriginalActual(
    call: M3AST_AS.Call;
    pos: INTEGER)
    : M3AST_AS.Actual
    RAISES {}=
  VAR
    count := 0;
    iter := SeqM3AST_AS_Actual.NewIter(call.as_param_s);
    actual: M3AST_AS.Actual;
  BEGIN
    WHILE SeqM3AST_AS_Actual.Next(iter, actual) DO
      IF count = pos THEN RETURN actual ELSE INC(count) END;
    END; (* while *)
    M3Assert.Fail();
    <*ASSERT FALSE*>
  END OriginalActual;

BEGIN
END M3CActualUtil.