MODULE M3CParse;

(***************************************************************************)
(*                      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.                                                       *)
(***************************************************************************)

(* Copyright (C) 1991, Digital Equipment Corporation           *)
(* All rights reserved.                                        *)
(* See the file COPYRIGHT for a full description.              *)

(* ToDo:
-- SetToText - constant currently declared as variable due to compiler bug
*)

IMPORT Text, TextExtras, Fmt;
IMPORT CharType, IO;

IMPORT M3AST, M3AST_LX, M3AST_PG, M3AST_AS;


IMPORT M3AST_AS_F, M3AST_PG_F; 


IMPORT
    SeqM3AST_AS_IMPORTED, SeqM3AST_AS_Import_item,
    SeqM3AST_AS_Used_interface_id, SeqM3AST_AS_Used_def_id,
    SeqM3AST_AS_REVELATION, SeqM3AST_AS_DECL_REVL,
    SeqM3AST_AS_Const_decl, SeqM3AST_AS_TYPE_DECL,
    SeqM3AST_AS_Var_decl, SeqM3AST_AS_Exc_decl,
    SeqM3AST_AS_Var_id, SeqM3AST_AS_F_Interface_id,
    SeqM3AST_AS_Enum_id, SeqM3AST_AS_Field_id,
    SeqM3AST_AS_FORMAL_ID, SeqM3AST_AS_Qual_used_id,
    SeqM3AST_AS_Fields, SeqM3AST_AS_Method, SeqM3AST_AS_Override,
    SeqM3AST_AS_M3TYPE, 
    SeqM3AST_AS_Formal_param, SeqM3AST_AS_CONS_ELEM,
    SeqM3AST_AS_EXP, SeqM3AST_AS_Actual,
    SeqM3AST_AS_Case, SeqM3AST_AS_STM,
    SeqM3AST_AS_Elsif, SeqM3AST_AS_Tcase,
    SeqM3AST_AS_Handler, SeqM3AST_AS_Binding,
    SeqM3AST_AS_RANGE_EXP;

IMPORT M3CHash, M3CToken, M3CReservedWord, M3CSrcPos;
IMPORT M3CPragma, M3CLex, M3CLiteral;


TYPE
  Token = M3CToken.T;
  TokenSet = M3CToken.Set;


CONST
  None = TokenSet{};

  StartOfUnit = TokenSet{Token.UNSAFE_, Token.MODULE_, Token.INTERFACE_,
                         Token.GENERIC_};

  StartOfImport = TokenSet{Token.FROM_, Token.IMPORT_};

  StartOfDeclaration =
      TokenSet{Token.CONST_, Token.TYPE_, Token.VAR_, Token.EXCEPTION_,
          Token.PROCEDURE_};

  StartOfRevelation = TokenSet{Token.REVEAL_};

  StartOfDeclarationOrRevelation = StartOfDeclaration + StartOfRevelation;

  StartOfBlock = TokenSet{Token.BEGIN_} + StartOfDeclarationOrRevelation;

  AlwaysStartOfType = TokenSet{Token.CurlyBra, Token.SquareBra, Token.ADDRESS_,
      Token.ARRAY_, Token.BITS_, Token.INTEGER_, Token.LONGREAL_, Token.NULL_,
      Token.OBJECT_, Token.REAL_, Token.RECORD_, Token.REF_, Token.REFANY_,
      Token.ROOT_, Token.SET_, Token.BRANDED_, Token.UNTRACED_,
      Token.EXTENDED_};
  StartOfType = AlwaysStartOfType +
      TokenSet{Token.Identifier, Token.Bra, Token.PROCEDURE_};
      

  AlwaysStartOfExpression =
      TokenSet{Token.NOT_, Token.Plus, Token.Minus, Token.NIL_} +
          M3CToken.Literals;
  StartOfExpression = AlwaysStartOfExpression + StartOfType;

  AlwaysStartOfStatement = TokenSet{Token.CASE_, Token.EXIT_, Token.EVAL_,
      Token.FOR_, Token.IF_, Token.LOCK_, Token.LOOP_, Token.RAISE_,
      Token.REPEAT_, Token.RETURN_, Token.TRY_, Token.TYPECASE_, Token.WHILE_,
      Token.WITH_};
  StartOfStatement = AlwaysStartOfStatement + StartOfBlock + StartOfExpression;

  Start = StartOfUnit + StartOfImport + StartOfStatement + StartOfBlock;

  IdAsSet = TokenSet{Token.Identifier};
  EndAsSet = TokenSet{Token.END_};
  ElseOrEnd = TokenSet{Token.ELSE_} + EndAsSet;


REVEAL
  T = M3CLex.T BRANDED OBJECT
    lastErrorPos := M3CSrcPos.Null;
    lastSrcPosNode: M3AST_AS.SRC_NODE := NIL;
    terminators := CharType.None;
    interface := FALSE;
    errorHandler: ErrorHandler := NIL;
    commentOrPragma := FALSE;
    comments: M3AST_LX.CommentStore;
    pragmas: M3AST_LX.PragmaStore;
    lastPragma: M3CPragma.T := NIL;
    identifiers: M3CReservedWord.Table;
    idNEW: M3CHash.Id := NIL;
  END;


PROCEDURE ErrorMessage(t: T; text: Text.T) RAISES {}=
  VAR
    pos := M3CLex.Position(t);
  BEGIN
    t.lastErrorPos := pos;
    t.errorHandler.handle(pos, text);
  END ErrorMessage;


PROCEDURE UnexpectedMessage(t: T; text: Text.T := NIL) RAISES {}=
  BEGIN
    IF text = NIL THEN
      ErrorMessage(t, Fmt.F("Unexpected symbol: %s",
          M3CLex.CurrentTokenToText(t)));
    ELSE
      ErrorMessage(t,
          Fmt.F("%s expected, %s found", text, M3CLex.CurrentTokenToText(t)));
    END;
  END UnexpectedMessage;


<*INLINE*> PROCEDURE FirstErrorHere(t: T): BOOLEAN RAISES {}=
  BEGIN
    RETURN t.lastErrorPos # M3CLex.Position(t);
  END FirstErrorHere;


PROCEDURE Unexpected(t: T) RAISES {}=
  BEGIN
    IF FirstErrorHere(t) THEN
      UnexpectedMessage(t, NIL);
    END;
  END Unexpected;


PROCEDURE Expected(t: T; token: Token) RAISES {}=
  BEGIN
    IF FirstErrorHere(t) THEN
      UnexpectedMessage(t, M3CLex.TokenToText(token));
    END;
  END Expected;


PROCEDURE SetToText(set: TokenSet): Text.T RAISES {}=
  TYPE
    ST = RECORD set: TokenSet; text: Text.T END;
  VAR (* CONST when compiler fixed! *)
    CommonSets := ARRAY [0..2] OF ST{
        ST{StartOfType, "Type"},
        ST{StartOfExpression, "Expression"},
        ST{StartOfStatement, "Statement"}};
  BEGIN
    FOR i := FIRST(CommonSets) TO LAST(CommonSets) DO
      WITH st = CommonSets[i] DO
        IF st.set = set THEN RETURN st.text END;
      END;
    END;
    VAR
      count := 0;
      save: ARRAY [0..2] OF Token;
    BEGIN
      FOR i := FIRST(Token) TO LAST(Token) DO
        IF i IN set THEN
          IF count < NUMBER(save) THEN save[count] := i END;
          INC(count);
        END;
      END;
      IF 0 < count AND count <= NUMBER(save) THEN
        VAR
          result: Text.T;
        BEGIN
          FOR i := 0 TO count - 1 DO
            VAR
              tokenText := M3CLex.TokenToText(save[i]);
              join: Text.T;
            BEGIN
              IF i = 0 THEN
                result := tokenText;
              ELSE
                IF i = count - 1 THEN join := " or " ELSE join := ", " END;
                result := result & join & tokenText;
              END;
            END;
          END;
          RETURN result;
        END;
      ELSE
        RETURN NIL;
      END;
    END;
  END SetToText;


PROCEDURE ExpectedSet(t: T; READONLY valid: TokenSet) RAISES {}=
  BEGIN
    IF FirstErrorHere(t) THEN
      UnexpectedMessage(t, SetToText(valid));
    END;
  END ExpectedSet;


PROCEDURE NodeAfter(t: T; srcNode: M3AST_AS.SRC_NODE) RAISES {}=
  BEGIN
    IF t.lastPragma # NIL THEN
      M3CPragma.AddFollowingNode(srcNode, t.pragmas);
      t.lastPragma := NIL;
    END;
    t.commentOrPragma := FALSE;
  END NodeAfter;


<*INLINE*> PROCEDURE Pos(
    t: T;
    srcNode: M3AST_AS.SRC_NODE;
    next := FALSE)
    RAISES {IO.Error}=
  BEGIN
    srcNode.lx_srcpos := M3CLex.Position(t);
    t.lastSrcPosNode := srcNode;
    IF t.commentOrPragma THEN NodeAfter(t, srcNode) END;
    IF next THEN EVAL M3CLex.Next(t) END;
  END Pos;


<*INLINE*> PROCEDURE EndPos(
    t: T;
    endSrcNode: M3AST_AS.END_SRC_NODE;
    mustBeAt := Token.END_)
    RAISES {IO.Error}=
  BEGIN
    endSrcNode.lx_end_srcpos := M3CLex.Position(t);
    EVAL MustBeAt(t, mustBeAt);
  END EndPos;


<*INLINE*> PROCEDURE At(t: T; token: Token): BOOLEAN RAISES {IO.Error}=
  BEGIN
    IF M3CLex.Current(t) = token THEN
      EVAL M3CLex.Next(t);
      RETURN TRUE;
    ELSE
      RETURN FALSE;
    END; (* if *)
  END At;


<*INLINE*> PROCEDURE MustBeAt(
    t: T;
    token: Token)
    : BOOLEAN
    RAISES {IO.Error}=
  VAR
    at := At(t, token);
  BEGIN
    IF NOT at THEN Expected(t, token) END;
    RETURN at;
  END MustBeAt;


PROCEDURE LenientAt(
    t: T;
    token, alternative: Token)
    : BOOLEAN
    RAISES {IO.Error}=
  BEGIN
    IF NOT At(t, token) THEN
      IF M3CLex.Current(t) = alternative THEN
        Expected(t, token);
        EVAL M3CLex.Next(t);
        RETURN TRUE;
      ELSE
        RETURN FALSE;
      END;
    ELSE
      RETURN TRUE;
    END;
  END LenientAt;


<*INLINE*> PROCEDURE LenientMustBeAt(
    t: T;
    token, alternative: Token)
    : BOOLEAN
    RAISES {IO.Error}=
  BEGIN
    RETURN MustBeAt(t, token) OR At(t, alternative);
  END LenientMustBeAt;


PROCEDURE FindExpected(
    t: T;
    token: Token;
    READONLY term: TokenSet)
    : BOOLEAN
    RAISES {IO.Error}=
  VAR
    current := M3CLex.Current(t);
    stop := term + TokenSet{token};
  BEGIN
    Expected(t, token);
    LOOP
      IF current IN stop THEN
        IF current = token THEN
          EVAL M3CLex.Next(t);
          RETURN TRUE;
        ELSE
          RETURN FALSE;
        END;
      ELSE
        current := M3CLex.Next(t);
      END;
    END;
  END FindExpected;


<*INLINE*> PROCEDURE Expect(
    t: T;
    token: Token;
    READONLY term: TokenSet)
    : BOOLEAN
    RAISES {IO.Error}=
  BEGIN
    IF M3CLex.Current(t) = token THEN
      EVAL M3CLex.Next(t);
      RETURN TRUE;
    ELSE
      RETURN FindExpected(t, token, term);
    END;
  END Expect;


PROCEDURE FindExpectedSet(
    t: T;
    READONLY valid, term: TokenSet)
    : BOOLEAN
    RAISES {IO.Error}=
  VAR
    current := M3CLex.Current(t);
    stop := valid + term;
  BEGIN
    ExpectedSet(t, valid);
    LOOP
      IF current IN stop THEN
        RETURN current IN valid;
      ELSE
        current := M3CLex.Next(t);
      END;
    END;
  END FindExpectedSet;


<*INLINE*> PROCEDURE ExpectSet(
    t: T;
    READONLY valid: TokenSet;
    READONLY term := None)
    : BOOLEAN
    RAISES {IO.Error}=
  BEGIN
    IF M3CLex.Current(t) IN valid THEN
      RETURN TRUE;
    ELSE
      RETURN FindExpectedSet(t, valid, term);
    END;
  END ExpectSet;


PROCEDURE EndOfSequenceSet(
    t: T;
    sep: Token;
    READONLY validTerm, continue, term: TokenSet)
    : BOOLEAN
    RAISES {IO.Error}=
(* After a call of 'EndOfSequenceSet' the current token not 'sep' and is
in one of the sets:
'validTerm' => result is TRUE
'continue' => result is FALSE
'term' => result is TRUE *)
  VAR
    sepAllowedAtEnd := sep = Token.Semicolon;
    atSep := At(t, sep);
  BEGIN
    LOOP
      WITH current = M3CLex.Current(t) DO
        IF current = sep THEN
          Unexpected(t);
          EVAL M3CLex.Next(t);
        ELSIF (NOT atSep OR sepAllowedAtEnd) AND current IN validTerm THEN
          RETURN TRUE;
        ELSIF current IN continue THEN
          IF NOT atSep THEN EVAL Expect(t, sep, continue) END;
          RETURN FALSE;
        ELSIF current IN term THEN
          IF atSep AND NOT sepAllowedAtEnd THEN Unexpected(t) END;
          EVAL FindExpectedSet(t, validTerm, term);
          RETURN TRUE;
        ELSE
          IF atSep THEN
            EVAL ExpectSet(t, continue + validTerm + term + TokenSet{sep});
            atSep := At(t, sep); 
          ELSE
            atSep := Expect(t, sep, continue + validTerm + term);
          END;
        END;
      END;
    END;
  END EndOfSequenceSet;


<*INLINE*> PROCEDURE EndOfSequence(
    t: T;
    sep, validTerm: Token;
    READONLY continue, term: TokenSet)
    : BOOLEAN
    RAISES {IO.Error}=
  BEGIN
    WITH
      result = EndOfSequenceSet(t, sep, TokenSet{validTerm}, continue, term)
    DO
      EVAL At(t, validTerm);
      RETURN result;
    END;
  END EndOfSequence;


PROCEDURE Id(t: T; id: M3AST_AS.ID) RAISES {IO.Error}=
  BEGIN
    Pos(t, id);
    IF M3CLex.Current(t) = Token.Identifier THEN
      id.lx_symrep := M3CLex.Identifier(t);
      EVAL M3CLex.Next(t);
    ELSE
      Expected(t, Token.Identifier);
    END;
  END Id;


PROCEDURE SingleIdQualId(
    t: T;
    id: M3CLex.Symbol_rep;
    pos: M3CSrcPos.T)
    : M3AST_AS.Qual_used_id RAISES {}=
  BEGIN
    WITH q = M3AST_AS.NewQual_used_id() DO
      q.lx_srcpos := pos;
      q.as_id := M3AST_AS.NewUsed_def_id();
      q.as_id.lx_symrep := id;
      q.as_id.lx_srcpos := pos;
      t.lastSrcPosNode := q.as_id;
      RETURN q;
    END;
  END SingleIdQualId;


PROCEDURE DoubleIdQualId(
    t: T;
    id1, id2: M3CLex.Symbol_rep;
    pos1, pos2: M3CSrcPos.T)
    : M3AST_AS.Qual_used_id
    RAISES {}=
  BEGIN
    WITH q = M3AST_AS.NewQual_used_id() DO
      q.lx_srcpos := pos1;
      q.as_intf_id := M3AST_AS.NewUsed_interface_id();
      q.as_intf_id.lx_symrep := id1;
      q.as_intf_id.lx_srcpos := pos1;
      q.as_id := M3AST_AS.NewUsed_def_id();
      q.as_id.lx_symrep := id2;
      q.as_id.lx_srcpos := pos2;
      t.lastSrcPosNode := q.as_id;
      RETURN q;
    END;
  END DoubleIdQualId;


PROCEDURE QualId(t: T): M3AST_AS.Qual_used_id RAISES {IO.Error}=
  VAR
    id1 := M3CLex.Identifier(t);
    pos1 := M3CLex.Position(t);
  BEGIN
    IF NOT MustBeAt(t, Token.Identifier) THEN id1 := NIL END;
    IF At(t, Token.Dot) THEN
      VAR
        id2 := M3CLex.Identifier(t);
        pos2 := M3CLex.Position(t);
      BEGIN
        IF NOT MustBeAt(t, Token.Identifier) THEN id2 := NIL END;
        RETURN DoubleIdQualId(t, id1, id2, pos1, pos2);
      END;
    ELSE
      RETURN SingleIdQualId(t, id1, pos1);
    END;
  END QualId;


PROCEDURE NamedType(q: M3AST_AS.Qual_used_id): M3AST_AS.Named_type RAISES {}=
  VAR
    n := M3AST_AS.NewNamed_type();
  BEGIN
    n.lx_srcpos := q.lx_srcpos;
    n.as_qual_id := q;
    RETURN n;
  END NamedType;


PROCEDURE Array(
    t: T;
    READONLY term: TokenSet)
    : M3AST_AS.Array_type
    RAISES {IO.Error}=
  VAR
    a := M3AST_AS.NewArray_type();
  BEGIN
    Pos(t, a, TRUE);
    a.as_indextype_s := SeqM3AST_AS_M3TYPE.Null;
    IF NOT At(t, Token.OF_) THEN
      WITH arrayTerm = term + TokenSet{Token.Comma, Token.OF_} + StartOfType DO
        REPEAT
          SeqM3AST_AS_M3TYPE.AddRear(a.as_indextype_s, Type(t, arrayTerm));
        UNTIL EndOfSequence(t, Token.Comma, Token.OF_, StartOfType, arrayTerm);
      END;
    END;
    a.as_elementtype := Type(t, term);
    RETURN a;
  END Array;


PROCEDURE Packed(
    t: T;
    READONLY term: TokenSet)
    : M3AST_AS.Packed_type
    RAISES {IO.Error}=
  VAR
    packedTerm := term + TokenSet{Token.FOR_} + StartOfType;
    p := M3AST_AS.NewPacked_type();
  BEGIN
    Pos(t, p, TRUE);
    p.as_exp := Expr(t, packedTerm);
    EVAL Expect(t, Token.FOR_, packedTerm);
    p.as_type := Type(t, term);
    RETURN p;
  END Packed;


PROCEDURE TypeAndOrDefault(
    t: T;
    READONLY term: TokenSet;
    VAR default: M3AST_AS.EXP_NULL)
    : M3AST_AS.M3TYPE_NULL
    RAISES {IO.Error}=
  VAR
    type: M3AST_AS.M3TYPE_NULL := NIL;
    typeTerm := term + TokenSet{Token.Becomes} + StartOfExpression;
  BEGIN
    default := NIL;
    IF At(t, Token.Colon) THEN
      type := Type(t, typeTerm);
    ELSIF M3CLex.Current(t) IN StartOfExpression THEN
      TYPECASE Expr(t, typeTerm, TRUE) OF
      | M3AST_AS.M3TYPE(m3Type) =>
          type := m3Type;
      | M3AST_AS.EXP(exp) =>
          default := exp;
      END;
    END;
    IF default = NIL THEN
      WITH at = LenientAt(t, Token.Becomes, Token.Equal) DO
        IF at OR M3CLex.Current(t) IN StartOfExpression - IdAsSet THEN
          IF NOT at THEN Expected(t, Token.Becomes) END;
          default := Expr(t, term);
        END;
      END;
    END;
    IF type = NIL AND default = NIL THEN
      RETURN M3AST_AS.NewBad_M3TYPE();
    ELSE
      RETURN type;
    END;
  END TypeAndOrDefault;


PROCEDURE Fields(
    t: T;
    READONLY validTerm, term: TokenSet)
    : SeqM3AST_AS_Fields.T
    RAISES {IO.Error}=
  VAR
    seqFields := SeqM3AST_AS_Fields.Null;
  CONST
    PossibleStartOfField = StartOfType + StartOfExpression +
        TokenSet{Token.Identifier, Token.Colon, Token.Becomes};
  BEGIN
    WITH
      fieldTerm = validTerm + term +
          TokenSet{Token.Semicolon} + PossibleStartOfField
    DO
      REPEAT
        WITH fields = M3AST_AS.NewFields() DO
          SeqM3AST_AS_Fields.AddRear(seqFields, fields);
          Pos(t, fields);
          fields.as_id_s := SeqM3AST_AS_Field_id.Null;
          (* IdList *)
          REPEAT
            WITH id = M3AST_AS.NewField_id() DO
              SeqM3AST_AS_Field_id.AddRear(fields.as_id_s, id);
              Id(t, id);
            END;
          UNTIL EndOfSequenceSet(t, Token.Comma,
              TokenSet{Token.Colon, Token.Becomes}, IdAsSet, fieldTerm);
          (* ( ":=" Expr & ":" Type ) *)
          fields.as_type := TypeAndOrDefault(t, fieldTerm, fields.as_default);
        END;
      UNTIL EndOfSequenceSet(t, Token.Semicolon,
          validTerm, PossibleStartOfField, term);
    END;
    RETURN seqFields;
  END Fields;


PROCEDURE Methods(
    t: T;
    READONLY validTerm, term: TokenSet)
    : SeqM3AST_AS_Method.T
    RAISES {IO.Error}=
  VAR
    methods := SeqM3AST_AS_Method.Null;
  CONST
    PossibleStartOfMethod =
        TokenSet{Token.Identifier, Token.Bra, Token.Becomes};
  BEGIN
    WITH
      methodTerm = validTerm + term +
          TokenSet{Token.Semicolon} + PossibleStartOfMethod
    DO
      REPEAT
        WITH method = M3AST_AS.NewMethod() DO
          SeqM3AST_AS_Method.AddRear(methods, method);
          Pos(t, method);
          method.as_id := M3AST_AS.NewMethod_id();
          Id(t, method.as_id);
          WITH pos = M3CLex.Position(t) DO
            method.as_type := Signature(t, methodTerm);
            method.as_type.lx_srcpos := pos;
          END;
          EVAL ExpectSet(t, methodTerm);
          IF LenientAt(t, Token.Becomes, Token.Equal) THEN
            method.as_default := Expr(t, methodTerm, FALSE);
          END;
        END;
      UNTIL EndOfSequenceSet(t, Token.Semicolon,
          validTerm, PossibleStartOfMethod, term);
    END;
    RETURN methods;
  END Methods;


PROCEDURE Overrides(
    t: T;
    READONLY validTerm, term: TokenSet)
    : SeqM3AST_AS_Override.T
    RAISES {IO.Error}=
  VAR
    overrides := SeqM3AST_AS_Override.Null;
  CONST
    PossibleStartOfOverride =
        TokenSet{Token.Identifier, Token.Becomes};
  BEGIN
    WITH
      overrideTerm = validTerm + term +
          TokenSet{Token.Semicolon} + PossibleStartOfOverride
    DO
      REPEAT
        WITH override = M3AST_AS.NewOverride() DO
          SeqM3AST_AS_Override.AddRear(overrides, override);
          Pos(t, override);
          override.as_id := M3AST_AS.NewOverride_id();
          Id(t, override.as_id);
          IF LenientMustBeAt(t, Token.Becomes, Token.Equal) THEN
            override.as_default := Expr(t, overrideTerm, FALSE);
          ELSE
            override.as_default := M3AST_AS.NewBad_EXP();
          END;
        END;
      UNTIL EndOfSequenceSet(t, Token.Semicolon,
          validTerm, PossibleStartOfOverride, term);
    END;
    RETURN overrides;
  END Overrides;


PROCEDURE ObjectCheck(
    t: T;
    READONLY term: TokenSet;
    ancestor: M3AST_AS.M3TYPE)
    : M3AST_AS.M3TYPE
    RAISES {IO.Error}=
  VAR
    token := M3CLex.Current(t);
  BEGIN
    IF token = Token.OBJECT_ THEN
      RETURN Object(t, term, ancestor);
    ELSIF token = Token.BRANDED_ THEN
      RETURN Branded(t, term, ancestor := ancestor);
    ELSE
      RETURN ancestor;
    END; (* if *)
  END ObjectCheck;


PROCEDURE Object(
    t: T;
    READONLY term: TokenSet;
    ancestor: M3AST_AS.M3TYPE := NIL;
    brand: M3AST_AS.Brand := NIL)
    : M3AST_AS.Object_type
    RAISES {IO.Error}=
  CONST
    MethodsOrOverrides = TokenSet{Token.METHODS_, Token.OVERRIDES_};
    MethodsOrOverridesOrEnd =  MethodsOrOverrides +  EndAsSet;
    OverridesOrEnd = TokenSet{Token.OVERRIDES_} + EndAsSet;
  VAR
    o := M3AST_AS.NewObject_type();
  BEGIN
    Pos(t, o, TRUE);
    o.as_ancestor := ancestor;
    o.as_brand := brand;
    IF M3CLex.Current(t) # Token.END_ THEN
      IF NOT(M3CLex.Current(t) IN MethodsOrOverrides) THEN
        o.as_fields_s := Fields(t, MethodsOrOverridesOrEnd, term);
      ELSE
        o.as_fields_s := SeqM3AST_AS_Fields.Null;
      END;
      IF At(t, Token.METHODS_) AND M3CLex.Current(t) # Token.END_ THEN
        o.as_method_s := Methods(t, OverridesOrEnd, term);
      ELSE
        o.as_method_s := SeqM3AST_AS_Method.Null;
      END;
      IF At(t, Token.OVERRIDES_) AND M3CLex.Current(t) # Token.END_ THEN
        o.as_override_s := Overrides(t, EndAsSet, term);
      ELSE
        o.as_override_s := SeqM3AST_AS_Override.Null;
      END;
    ELSE
      o.as_fields_s := SeqM3AST_AS_Fields.Null;
      o.as_method_s := SeqM3AST_AS_Method.Null;
    END;
    EndPos(t, o.vEND_SRC_NODE);
    RETURN ObjectCheck(t, term, o);
  END Object;


CONST
  PossibleStartOfFormal =
      StartOfType + StartOfExpression +
      TokenSet{Token.VALUE_, Token.VAR_, Token.READONLY_} +
      TokenSet{Token.Identifier, Token.Colon, Token.Becomes};


PROCEDURE NewF_Value_id(): M3AST_AS.FORMAL_ID RAISES {}=
  BEGIN
    RETURN M3AST_AS.NewF_Value_id();
  END NewF_Value_id;


PROCEDURE NewF_Readonly_id(): M3AST_AS.FORMAL_ID RAISES {}=
  BEGIN
    RETURN M3AST_AS.NewF_Readonly_id();
  END NewF_Readonly_id;


PROCEDURE NewF_Var_id(): M3AST_AS.FORMAL_ID RAISES {}=
  BEGIN
    RETURN M3AST_AS.NewF_Var_id();
  END NewF_Var_id;


PROCEDURE Formals(
    t: T;
    READONLY term: TokenSet)
    : SeqM3AST_AS_Formal_param.T
    RAISES {IO.Error}=
  VAR
    formals := SeqM3AST_AS_Formal_param.Null;
  BEGIN
    IF NOT At(t, Token.Ket) THEN
      WITH
        formalTerm = term +
            TokenSet{Token.Ket, Token.Semicolon} + PossibleStartOfFormal
      DO
        REPEAT
          VAR
            create: PROCEDURE(): M3AST_AS.FORMAL_ID RAISES {};
            formal := M3AST_AS.NewFormal_param();
          BEGIN
            SeqM3AST_AS_Formal_param.AddRear(formals, formal);
            Pos(t, formal);
            formal.as_id_s := SeqM3AST_AS_FORMAL_ID.Null;
            IF At(t, Token.VAR_) THEN
              create := NewF_Var_id;
            ELSIF At(t, Token.READONLY_) THEN
              create := NewF_Readonly_id;
            ELSE
              EVAL At(t, Token.VALUE_);
              create := NewF_Value_id;
            END;
            REPEAT
              WITH formalId = create() DO
                SeqM3AST_AS_FORMAL_ID.AddRear(formal.as_id_s, formalId);
                Id(t, formalId);
              END;
            UNTIL EndOfSequenceSet(t, Token.Comma,
                TokenSet{Token.Colon, Token.Becomes}, IdAsSet, formalTerm);
            (* ( ":=" Expr & ":" Type ) *)
            formal.as_formal_type :=
                TypeAndOrDefault(t, formalTerm, formal.as_default);
          END;
        UNTIL EndOfSequence(t, Token.Semicolon,
            Token.Ket, PossibleStartOfFormal, term);
      END;
    END;
    RETURN formals;
  END Formals;


PROCEDURE Signature(
    t: T;
    READONLY term: TokenSet)
    : M3AST_AS.Procedure_type
    RAISES {IO.Error}=
  VAR
    p := M3AST_AS.NewProcedure_type();
  BEGIN
    EVAL Expect(t, Token.Bra, term + PossibleStartOfFormal +
        TokenSet{Token.Ket, Token.Colon, Token.RAISES_});
    p.as_formal_param_s := Formals(t,
        term + TokenSet{Token.Colon, Token.RAISES_});
    WITH atColon = At(t, Token.Colon) DO
      IF atColon OR M3CLex.Current(t) IN StartOfType THEN
        IF NOT atColon THEN Expected(t, Token.Colon) END;
        p.as_result_type := Type(t, term + TokenSet{Token.RAISES_});
      END;
    END;
    IF M3CLex.Current(t) = Token.RAISES_ THEN
     WITH pos = M3CLex.Position(t) DO
      EVAL M3CLex.Next(t);
      IF At(t, Token.ANY_) THEN
        p.as_raises := M3AST_AS.NewRaisees_any();
      ELSE
        p.as_raises := M3AST_AS.NewRaisees_some();
        WITH r = NARROW(p.as_raises, M3AST_AS.Raisees_some) DO
          r.as_raisees_s := SeqM3AST_AS_Qual_used_id.Null;
          EVAL Expect(t, Token.CurlyBra, term);
          IF NOT At(t, Token.CurlyKet) THEN
            REPEAT
              SeqM3AST_AS_Qual_used_id.AddRear(
                  r.as_raisees_s, QualId(t));
            UNTIL EndOfSequence(t, Token.Comma, Token.CurlyKet, IdAsSet, term);
          END;
        END;
      END;
      p.as_raises.lx_srcpos := pos;
     END;
    END;
    RETURN p;
  END Signature;


PROCEDURE ProcedureType(
    t: T;
    READONLY term: TokenSet)
    : M3AST_AS.Procedure_type
    RAISES {IO.Error}=
  VAR
    pos := M3CLex.Position(t);
  BEGIN
    EVAL M3CLex.Next(t);
    WITH p = Signature(t, term) DO
      p.lx_srcpos := pos;
      RETURN p;
    END;
  END ProcedureType;


PROCEDURE Record(
    t: T;
    READONLY term: TokenSet)
    : M3AST_AS.Record_type
    RAISES {IO.Error}=
  VAR
    r := M3AST_AS.NewRecord_type();
  BEGIN
    Pos(t, r, TRUE);
    IF M3CLex.Current(t) # Token.END_ THEN
      r.as_fields_s := Fields(t, EndAsSet, term);
    ELSE
      r.as_fields_s := SeqM3AST_AS_Fields.Null;
    END;
    EndPos(t, r.vEND_SRC_NODE);
    RETURN r;
  END Record;


PROCEDURE Ref(
    t: T;
    READONLY term: TokenSet;
    untraced: M3AST_AS.Untraced := NIL;
    brand: M3AST_AS.Brand := NIL)
    : M3AST_AS.Ref_type
    RAISES {IO.Error}=
  VAR
    r := M3AST_AS.NewRef_type();
  BEGIN
    Pos(t, r, TRUE);
    r.as_trace_mode := untraced;
    r.as_brand := brand;
    r.as_type := Type(t, term);
    RETURN r;
  END Ref;


PROCEDURE Set(
    t: T;
    READONLY term: TokenSet)
    : M3AST_AS.Set_type
    RAISES {IO.Error}=
  VAR
    s := M3AST_AS.NewSet_type();
  BEGIN
    Pos(t, s, TRUE);
    EVAL Expect(t, Token.OF_, term + StartOfType);
    s.as_type := Type(t, term);
    RETURN s;
  END Set;


PROCEDURE Branded(
    t: T;
    READONLY term: TokenSet;
    untraced: M3AST_AS.Untraced := NIL;
    ancestor: M3AST_AS.M3TYPE := NIL)
    : M3AST_AS.M3TYPE
    RAISES {IO.Error}=
  VAR
    b := M3AST_AS.NewBrand();
  CONST
    StartOfBrandName = TokenSet{Token.TextLiteral, Token.Identifier};
  BEGIN
    Pos(t, b, TRUE);
    VAR
      expected: TokenSet;
      object := FALSE;
      type: M3AST_AS.M3TYPE;
    BEGIN
      IF ancestor # NIL THEN
        expected := TokenSet{Token.OBJECT_};
      ELSIF untraced # NIL THEN
        expected := TokenSet{Token.REF_};
      ELSE
        expected := TokenSet{Token.OBJECT_, Token.REF_};
      END;
      IF M3CLex.Current(t) IN StartOfBrandName THEN
        b.as_exp := Expr(t, term + expected);
      END;
      EVAL ExpectSet(t, expected, term + StartOfType);
      CASE M3CLex.Current(t) OF
      | Token.OBJECT_ =>
          type := Object(t, term, ancestor, b);
          object := TRUE;
      | Token.REF_ =>
          type := Ref(t, term, untraced, b);
      ELSE
        type := Type(t, term);
      END;
      IF ancestor # NIL AND NOT object THEN
        RETURN ancestor;
      ELSE
        RETURN type;
      END;
    END;
  END Branded;


PROCEDURE Untraced(
    t: T;
    READONLY term: TokenSet)
    : M3AST_AS.M3TYPE
    RAISES {IO.Error}=
  CONST
    PossiblyUntraced =
        TokenSet{Token.REF_, Token.BRANDED_, Token.ROOT_};
  VAR
    u := M3AST_AS.NewUntraced();
  BEGIN
    Pos(t, u, TRUE);
    EVAL ExpectSet(t, PossiblyUntraced, term + StartOfType);
    CASE M3CLex.Current(t) OF
    | Token.REF_ =>
        RETURN Ref(t, term, u);
    | Token.BRANDED_ =>
        RETURN Branded(t, term, u);
    | Token.ROOT_ =>
        WITH root = M3AST_AS.NewRoot_type() DO
          Pos(t, root, TRUE);
          root.as_trace_mode := u;
          RETURN root;
        END;
    ELSE
      RETURN Type(t, term);
    END; (* if *)
  END Untraced;


PROCEDURE Enumeration(
    t: T;
    READONLY term: TokenSet)
    : M3AST_AS.Enumeration_type
    RAISES {IO.Error}=
  VAR
    e := M3AST_AS.NewEnumeration_type();
  BEGIN
    Pos(t, e, TRUE);
    e.as_id_s := SeqM3AST_AS_Enum_id.Null;
    IF NOT At(t, Token.CurlyKet) THEN
      REPEAT
        WITH id = M3AST_AS.NewEnum_id() DO
          SeqM3AST_AS_Enum_id.AddRear(e.as_id_s, id);
          Id(t, id);
        END;
      UNTIL EndOfSequence(t, Token.Comma, Token.CurlyKet, IdAsSet, term);
    END;
    RETURN e;
  END Enumeration;


PROCEDURE Range(exp1, exp2: M3AST_AS.EXP): M3AST_AS.Range RAISES {}=
  VAR
    r := M3AST_AS.NewRange();
  BEGIN
    r.lx_srcpos := exp1.lx_srcpos;
    r.as_exp1 := exp1;
    r.as_exp2 := exp2;
    RETURN r;
  END Range;


PROCEDURE Subrange(
    t: T;
    READONLY term: TokenSet)
    : M3AST_AS.Subrange_type
    RAISES {IO.Error}=
  VAR
    s := M3AST_AS.NewSubrange_type();
  BEGIN
    Pos(t, s, TRUE);
    WITH
      secondExprTerm = term + TokenSet{Token.SquareKet},
      firstExprTerm = secondExprTerm
           + TokenSet{Token.Range} + StartOfExpression,
      exp1 = Expr(t, firstExprTerm)
    DO
      EVAL Expect(t, Token.Range, firstExprTerm);
      s.as_range := Range(exp1, Expr(t, secondExprTerm));
      EVAL Expect(t, Token.SquareKet, secondExprTerm);
    END;
    RETURN s;
  END Subrange;


PROCEDURE Type(
    t: T;
    READONLY term: TokenSet)
    : M3AST_AS.M3TYPE
    RAISES {IO.Error}=
  BEGIN
    IF ExpectSet(t, StartOfType, term) THEN
      VAR
        type: M3AST_AS.M3TYPE;
      BEGIN
        CASE M3CLex.Current(t) OF
        | Token.Identifier =>
            type := NamedType(QualId(t));
        | Token.ADDRESS_ =>
            WITH address = M3AST_AS.NewAddress_type() DO
              Pos(t, address, TRUE);
              type := address;
            END;
        | Token.ARRAY_ =>
            type := Array(t, term);
        | Token.BITS_ =>
            type := Packed(t, term);
        | Token.INTEGER_ =>
            WITH integer = M3AST_AS.NewInteger_type() DO
              Pos(t, integer, TRUE);
              type := integer;
            END;
        | Token.LONGREAL_ =>
            WITH longreal = M3AST_AS.NewLongReal_type() DO
              Pos(t, longreal, TRUE);
              type := longreal;
            END;
        | Token.EXTENDED_ =>
            WITH extended = M3AST_AS.NewExtended_type() DO
              Pos(t, extended, TRUE);
              type := extended;
            END;
        | Token.NULL_ =>
            WITH null = M3AST_AS.NewNull_type() DO
              Pos(t, null, TRUE);
              type := null;
            END;
        | Token.OBJECT_ =>
            type := Object(t, term);
        | Token.PROCEDURE_ =>
            type := ProcedureType(t, term);
        | Token.REAL_ =>
            WITH real = M3AST_AS.NewReal_type() DO
              Pos(t, real, TRUE);
              type := real;
            END;
        | Token.RECORD_ =>
            type := Record(t, term);
        | Token.REF_ =>
            type := Ref(t, term);
        | Token.REFANY_ =>
            WITH refany = M3AST_AS.NewRefAny_type() DO
              Pos(t, refany, TRUE);
              type := refany;
            END;
        | Token.ROOT_ =>
            WITH root = M3AST_AS.NewRoot_type() DO
              Pos(t, root, TRUE);
              type := root;
            END;
        | Token.SET_ =>
            type := Set(t, term);
        | Token.BRANDED_ =>
            type := Branded(t, term);
        | Token.UNTRACED_ =>
            type := Untraced(t, term);
        | Token.CurlyBra =>
            type := Enumeration(t, term);
        | Token.SquareBra =>
            type := Subrange(t, term);
        | Token.Bra =>
            EVAL M3CLex.Next(t);
            type := Type(t, term + TokenSet{Token.Ket});
            EVAL Expect(t, Token.Ket, term);
        END; (* case *)
        type := ObjectCheck(t, term, type);
        EVAL ExpectSet(t, term);
        RETURN type;
      END;
    ELSE
      RETURN M3AST_AS.NewBad_M3TYPE();
    END;
  END Type;


PROCEDURE NewNumericLiteral(token: Token): M3AST_AS.NUMERIC_LITERAL RAISES {}=
  BEGIN
    CASE token OF
    | Token.IntegerLiteral =>
        RETURN M3AST_AS.NewInteger_literal();
    | Token.RealLiteral =>
        RETURN M3AST_AS.NewReal_literal();
    | Token.LongRealLiteral =>
        RETURN M3AST_AS.NewLongReal_literal();
    | Token.ExtendedLiteral =>
        RETURN M3AST_AS.NewExtended_literal();
    END; (* case *)
  END NewNumericLiteral;


PROCEDURE E8(
    t: T;
    READONLY term: TokenSet)
    : M3AST_AS.EXP_TYPE
    RAISES {IO.Error}=
  CONST
    NumericLiterals = TokenSet{
        Token.IntegerLiteral, Token.RealLiteral, Token.LongRealLiteral,
        Token.ExtendedLiteral};
  VAR
    token := M3CLex.Current(t);
    result: M3AST_AS.EXP_TYPE;
  BEGIN
    CASE token OF
    | FIRST(M3CToken.Literal)..LAST(M3CToken.Literal) =>
        IF token IN NumericLiterals THEN
          WITH numeric = NewNumericLiteral(token) DO
            numeric.lx_numrep := M3CLex.Literal(t);
            result := numeric;
          END;
        ELSIF token = Token.TextLiteral THEN
          WITH text = M3AST_AS.NewText_literal() DO
            text.lx_textrep := M3CLex.Literal(t);
            result := text;
          END;
        ELSE
          WITH char = M3AST_AS.NewChar_literal() DO
            char.lx_charrep := M3CLex.Literal(t);
            result := char;
          END;
        END;
        Pos(t, result, TRUE);
    | Token.NIL_ =>
        WITH nil = M3AST_AS.NewNil_literal() DO
          Pos(t, nil, TRUE);
          result := nil;
        END;
    | Token.Identifier =>
        WITH expUsedId = M3AST_AS.NewExp_used_id() DO
          Pos(t, expUsedId);
          Id(t, expUsedId.vUSED_ID);
          t.lastSrcPosNode := expUsedId; (* cos Id sets it wrong *)
          result := expUsedId;
        END;
    | Token.Bra =>
        EVAL M3CLex.Next(t);
        result := Expr(t, term + TokenSet{Token.Ket}, TRUE);
        EVAL Expect(t, Token.Ket, term);
    ELSE
      result := Type(t, term);
    END; (* case *)
    EVAL ExpectSet(t, term);
    RETURN result;
  END E8;


PROCEDURE Unary(
    op: M3AST_AS.UNARY_OP;
    exp: M3AST_AS.EXP;
    expFirst := FALSE)
    : M3AST_AS.Unary
    RAISES {}=
  VAR
    u := M3AST_AS.NewUnary();
  BEGIN
    IF expFirst THEN
      u.lx_srcpos := exp.lx_srcpos;
    ELSE
      u.lx_srcpos := op.lx_srcpos;
    END;
    u.as_unary_op := op;
    u.as_exp := exp;
    RETURN u;
  END Unary;


PROCEDURE Binary(
    op: M3AST_AS.BINARY_OP;
    lhs, rhs: M3AST_AS.EXP)
    : M3AST_AS.Binary
    RAISES {}=
  VAR
    b := M3AST_AS.NewBinary();
  BEGIN
    b.lx_srcpos := lhs.lx_srcpos;
    b.as_binary_op := op;
    b.as_exp1 := lhs;
    b.as_exp2 := rhs;
    RETURN b;
  END Binary;


PROCEDURE Select(
    t: T;
    lhs: M3AST_AS.EXP)
    : M3AST_AS.Binary
    RAISES {IO.Error}=
  VAR
    s := M3AST_AS.NewSelect();
    expUsedId := M3AST_AS.NewExp_used_id();
  BEGIN
    Pos(t, s, TRUE);
    Id(t, expUsedId.vUSED_ID);
    expUsedId.lx_srcpos := expUsedId.vUSED_ID.lx_srcpos;
    t.lastSrcPosNode := expUsedId;
    RETURN Binary(s, lhs, expUsedId);
  END Select;


PROCEDURE Index(
    t: T;
    READONLY term: TokenSet;
    array: M3AST_AS.EXP)
    : M3AST_AS.Index
    RAISES {IO.Error}=
  VAR
    i := M3AST_AS.NewIndex();
  BEGIN
    EVAL M3CLex.Next(t);
    i.lx_srcpos := array.lx_srcpos;
    i.as_array := array;
    i.as_exp_s := SeqM3AST_AS_EXP.Null;
    WITH indexTerm = term + TokenSet{Token.Comma, Token.SquareKet} +
        StartOfExpression DO
      REPEAT
        SeqM3AST_AS_EXP.AddRear(i.as_exp_s, Expr(t, indexTerm));
      UNTIL EndOfSequence(t, Token.Comma,
          Token.SquareKet, StartOfExpression, term);
    END;
    RETURN i;
  END Index;


PROCEDURE Call(
    t: T;
    READONLY term: TokenSet;
    callexp: M3AST_AS.EXP)
    : M3AST_AS.Call
    RAISES {IO.Error}=
  CONST
    PossibleStartOfActual = StartOfExpression +
        TokenSet{Token.Identifier, Token.Comma, Token.Becomes};
  VAR
    c: M3AST_AS.Call := NIL;
  BEGIN
    (* Trap NEW(...) and use NEWCall instead of Call *)
    TYPECASE callexp OF
    | M3AST_AS.Exp_used_id(id) =>
        IF id.vUSED_ID.lx_symrep = t.idNEW THEN
          c := M3AST_AS.NewNEWCall();  
        END; (* if *)
    ELSE
    END; (* typecase *)
    IF c = NIL THEN c := M3AST_AS.NewCall() END;

    EVAL M3CLex.Next(t);
    c.lx_srcpos := callexp.lx_srcpos;
    c.as_callexp := callexp;
    c.as_param_s := SeqM3AST_AS_Actual.Null;
    IF NOT At(t, Token.Ket) THEN
      WITH actualTerm = term + TokenSet{Token.Ket} + PossibleStartOfActual DO
        REPEAT
          WITH
            actual = M3AST_AS.NewActual(),
            expType = Expr(t, actualTerm, TRUE)
          DO
            SeqM3AST_AS_Actual.AddRear(c.as_param_s, actual);
            actual.lx_srcpos := expType.lx_srcpos;
            IF ISTYPE(expType, M3AST_AS.EXP) AND At(t, Token.Becomes) THEN
              actual.as_id := expType;
              actual.as_exp_type := Expr(t, actualTerm);
            ELSE
              actual.as_exp_type := expType;
            END;
          END;
        UNTIL EndOfSequence(t, Token.Comma,
            Token.Ket, PossibleStartOfActual, actualTerm);
      END;
    END;
    RETURN c;
  END Call;


PROCEDURE RangeExp(exp: M3AST_AS.EXP): M3AST_AS.Range_EXP RAISES {}=
  BEGIN
    WITH new = M3AST_AS.NewRange_EXP() DO
      new.lx_srcpos := exp.lx_srcpos;
      new.as_exp := exp;
      RETURN new;
    END;
  END RangeExp;


PROCEDURE Constructor(
    t: T;
    READONLY term: TokenSet;
    type: M3AST_AS.M3TYPE)
    : M3AST_AS.Constructor
    RAISES {IO.Error}=
  VAR
    c := M3AST_AS.NewConstructor();
  BEGIN
    EVAL M3CLex.Next(t);
    c.lx_srcpos := type.lx_srcpos;
    c.as_type := type;
    c.as_element_s := SeqM3AST_AS_CONS_ELEM.Null;
    IF NOT At(t, Token.CurlyKet) THEN
      CONST
        PossibleStartOfElement = StartOfExpression +
            TokenSet{Token.Identifier, Token.Comma,
                Token.Becomes, Token.Range};
      VAR
        first := TRUE;
        elementTerm := term + TokenSet{Token.CurlyKet} +
            PossibleStartOfElement;
      BEGIN
        REPEAT
          IF NOT first AND M3CLex.Current(t) = Token.Range THEN
            c.as_propagate := M3AST_AS.NewPropagate();
            Pos(t, c.as_propagate, TRUE);
            IF Expect(t, Token.CurlyKet, elementTerm) THEN EXIT END;
            IF NOT M3CLex.Current(t) IN PossibleStartOfElement THEN EXIT END;
          ELSE
            VAR
              element: M3AST_AS.CONS_ELEM;
              expr := Expr(t, elementTerm);
            BEGIN
              IF At(t, Token.Becomes) THEN
                WITH actualElem = M3AST_AS.NewActual_elem() DO
                  WITH actual = M3AST_AS.NewActual() DO
                    actual.lx_srcpos := expr.lx_srcpos;
                    actual.as_id := expr;
                    actual.as_exp_type := Expr(t, elementTerm);
                    actualElem.lx_srcpos := actual.lx_srcpos;
                    actualElem.as_actual := actual;
                  END;
                  element := actualElem;
                END;
              ELSE
                WITH rangeExpElem = M3AST_AS.NewRANGE_EXP_elem() DO
                  rangeExpElem.lx_srcpos := expr.lx_srcpos;
                  IF At(t, Token.Range) THEN
                    rangeExpElem.as_range_exp :=
                        Range(expr, Expr(t, elementTerm));
                  ELSE
                    rangeExpElem.as_range_exp := RangeExp(expr);
                  END;
                  element := rangeExpElem;
                END;
              END;
              SeqM3AST_AS_CONS_ELEM.AddRear(c.as_element_s, element);
            END;
          END;
          first := FALSE;
        UNTIL EndOfSequence(t, Token.Comma,
            Token.CurlyKet, PossibleStartOfElement, elementTerm);
      END;
    END;
    RETURN c;
  END Constructor;


EXCEPTION
  IsType(M3AST_AS.M3TYPE);


PROCEDURE IsId(e: M3AST_AS.EXP): BOOLEAN RAISES {}=
  BEGIN
    TYPECASE e OF
    | M3AST_AS.Exp_used_id =>
        RETURN TRUE;
    | M3AST_AS.Binary(b) =>
        RETURN ISTYPE(b.as_binary_op, M3AST_AS.Select) AND
            ISTYPE(b.as_exp1, M3AST_AS.Exp_used_id);
    ELSE
      RETURN FALSE;
    END;
  END IsId;


PROCEDURE EXP_TYPEToM3TYPE(
    t: T;
    e: M3AST_AS.EXP_TYPE)
    : M3AST_AS.M3TYPE
    RAISES {}=
  BEGIN
    TYPECASE e OF
    | M3AST_AS.M3TYPE(m3type) =>
        RETURN m3type;
    | M3AST_AS.Exp_used_id(usedId) =>
        RETURN NamedType(SingleIdQualId(
            t, usedId.vUSED_ID.lx_symrep, usedId.vUSED_ID.lx_srcpos));
    | M3AST_AS.Binary(binary) =>
        EVAL NARROW(binary.as_binary_op, M3AST_AS.Select);
        VAR
          e1 := binary.as_exp1;
          e2 := binary.as_exp2;
        BEGIN
          RETURN NamedType(DoubleIdQualId(t,
              NARROW(e1, M3AST_AS.Exp_used_id).vUSED_ID.lx_symrep,
              NARROW(e2, M3AST_AS.Exp_used_id).vUSED_ID.lx_symrep,
              e1.lx_srcpos, e2.lx_srcpos));
        END;
    END; (* typecase *)
  END EXP_TYPEToM3TYPE;


PROCEDURE E7(
    t: T;
    READONLY term: TokenSet;
    canBeType := FALSE)
    : M3AST_AS.EXP
    RAISES {IO.Error, IsType}=
  VAR
    e7Term := term +
        TokenSet{Token.Dereference, Token.Dot, Token.SquareBra, Token.Bra};
    e7FullTerm := e7Term +
        TokenSet{Token.CurlyBra, Token.OBJECT_, Token.BRANDED_};
    bra := (M3CLex.Current(t) = Token.Bra);
    e8 := E8(t, e7FullTerm);
    token := M3CLex.Current(t);
    e8IsType := ISTYPE(e8, M3AST_AS.M3TYPE);
    e8MayBeType := e8IsType OR IsId(e8);
  BEGIN
    IF token = Token.Dot AND e8MayBeType AND NOT (e8IsType OR bra) THEN
      e8 := Select(t, e8);
      EVAL ExpectSet(t, e7FullTerm);
      token := M3CLex.Current(t);
    END;

    IF e8MayBeType THEN
      WHILE token IN TokenSet{Token.OBJECT_, Token.BRANDED_} DO
        e8IsType := TRUE;
        e8 := ObjectCheck(t, e7FullTerm, EXP_TYPEToM3TYPE(t, e8));
        EVAL ExpectSet(t, e7FullTerm);
        token := M3CLex.Current(t);
      END;
    END;

    IF token = Token.CurlyBra THEN
      IF e8MayBeType THEN
        e8 := Constructor(t, e7Term, EXP_TYPEToM3TYPE(t, e8));
      END;
      EVAL ExpectSet(t, e7Term);
      token := M3CLex.Current(t);
    ELSIF e8IsType THEN
      IF canBeType THEN
        RAISE IsType(e8);
      ELSE
        EVAL MustBeAt(t, Token.CurlyBra);
        e8 := M3AST_AS.NewBad_EXP();
      END;
    END;

    VAR
      result: M3AST_AS.EXP := e8;
    BEGIN    
      LOOP
        CASE token OF
        | Token.Dereference =>
            WITH d = M3AST_AS.NewDeref() DO
              Pos(t, d, TRUE);
              result := Unary(d, result, TRUE);
            END;
        | Token.Dot =>
            result := Select(t, result);
        | Token.SquareBra =>
            result := Index(t, e7Term, result);
        | Token.Bra =>
            result := Call(t, e7Term, result);
        ELSE
          EXIT;
        END; (* case *)
        EVAL ExpectSet(t, e7Term);
        token := M3CLex.Current(t);
      END; (* loop *)
      RETURN result;
    END;
  END E7;


PROCEDURE E6(
    t: T;
    READONLY term: TokenSet;
    canBeType := FALSE)
    : M3AST_AS.EXP
    RAISES {IO.Error, IsType}=
  VAR
    current := M3CLex.Current(t);
  BEGIN
    IF current IN TokenSet{Token.Plus, Token.Minus} THEN
      VAR
        op: M3AST_AS.UNARY_OP;
      BEGIN
        IF current = Token.Plus THEN
          op := M3AST_AS.NewUnaryplus();
        ELSE
          op := M3AST_AS.NewUnaryminus();
        END;
        Pos(t, op, TRUE);
        RETURN Unary(op, E6(t, term));
      END;
    ELSE
      RETURN E7(t, term, canBeType);
    END;
  END E6;


PROCEDURE E5(
    t: T;
    READONLY term: TokenSet;
    canBeType := FALSE)
    : M3AST_AS.EXP
    RAISES {IO.Error, IsType}=
  CONST
    Mulop = TokenSet{Token.Times, Token.Divide, Token.DIV_, Token.MOD_};
  VAR
    e5Term := term + Mulop;
    result := E6(t, e5Term, canBeType);
  BEGIN
    LOOP
      WITH current = M3CLex.Current(t) DO
        IF current IN Mulop THEN
          VAR
            op: M3AST_AS.BINARY_OP;
          BEGIN
            CASE current OF
            | Token.Times =>  op := M3AST_AS.NewTimes();
            | Token.Divide => op := M3AST_AS.NewRdiv();
            | Token.DIV_ =>   op := M3AST_AS.NewDiv();
            | Token.MOD_ =>   op := M3AST_AS.NewMod();
            END;
            Pos(t, op, TRUE);
            result := Binary(op, result, E6(t, e5Term));
          END;
        ELSE
          RETURN result;
        END;
      END;
    END;
  END E5;


PROCEDURE E4(
    t: T;
    READONLY term: TokenSet;
    canBeType := FALSE)
    : M3AST_AS.EXP
    RAISES {IO.Error, IsType}=
  CONST
    Addop = TokenSet{Token.Plus, Token.Minus, Token.Ampersand};
  VAR
    e4Term := term + Addop;
    result := E5(t, e4Term, canBeType);
  BEGIN
    LOOP
      WITH current = M3CLex.Current(t) DO
        IF current IN Addop THEN
          VAR
            op: M3AST_AS.BINARY_OP;
          BEGIN
            CASE current OF
            | Token.Plus =>  op := M3AST_AS.NewPlus();
            | Token.Minus => op := M3AST_AS.NewMinus();
            | Token.Ampersand =>   op := M3AST_AS.NewTextcat();
            END;
            Pos(t, op, TRUE);
            result := Binary(op, result, E5(t, e4Term));
          END;
        ELSE
          RETURN result;
        END;
      END;
    END;
  END E4;


PROCEDURE E3(
    t: T;
    READONLY term: TokenSet;
    canBeType := FALSE)
    : M3AST_AS.EXP
    RAISES {IO.Error, IsType}=
  CONST
    Relop = TokenSet{Token.Equal, Token.NotEqual,
        Token.LessThan, Token.LessThanOrEqual,
        Token.GreaterThan, Token.GreaterThanOrEqual,
        Token.IN_};
  VAR
    e3Term := term + Relop;
    result := E4(t, e3Term, canBeType);
  BEGIN
    LOOP
      WITH current = M3CLex.Current(t) DO
        IF current IN Relop THEN
          VAR
            op: M3AST_AS.BINARY_OP;
          BEGIN
            CASE current OF
            | Token.Equal =>              op := M3AST_AS.NewEq();
            | Token.NotEqual =>           op := M3AST_AS.NewNe();
            | Token.LessThan =>           op := M3AST_AS.NewLt();
            | Token.LessThanOrEqual =>    op := M3AST_AS.NewLe();
            | Token.GreaterThan =>        op := M3AST_AS.NewGt();
            | Token.GreaterThanOrEqual => op := M3AST_AS.NewGe();
            | Token.IN_ =>                op := M3AST_AS.NewIn();
            END;
            Pos(t, op, TRUE);
            result := Binary(op, result, E4(t, e3Term));
          END;
        ELSE
          RETURN result;
        END;
      END;
    END;
  END E3;


PROCEDURE E2(
    t: T;
    READONLY term: TokenSet;
    canBeType := FALSE)
    : M3AST_AS.EXP
    RAISES {IO.Error, IsType}=
  BEGIN
    IF M3CLex.Current(t) = Token.NOT_ THEN
      WITH op = M3AST_AS.NewNot() DO
        Pos(t, op, TRUE);
        RETURN Unary(op, E2(t, term));
      END;
    ELSE
      RETURN E3(t, term, canBeType);
    END;
  END E2;


PROCEDURE E1(
    t: T;
    READONLY term: TokenSet;
    canBeType := FALSE)
    : M3AST_AS.EXP
    RAISES {IO.Error, IsType}=
  VAR
    e1Term := term + TokenSet{Token.AND_};
    result := E2(t, e1Term, canBeType);
  BEGIN
    WHILE M3CLex.Current(t) = Token.AND_ DO
      WITH op = M3AST_AS.NewAnd() DO
        Pos(t, op, TRUE);
        result := Binary(op, result, E2(t, e1Term));
      END;
    END;
    RETURN result;
  END E1;


PROCEDURE Expr(
    t: T;
    READONLY term: TokenSet;
    canBeType := FALSE)
    : M3AST_AS.EXP_TYPE
    RAISES {IO.Error}=
  BEGIN
    IF ExpectSet(t, StartOfExpression, term) THEN
      TRY
        VAR
          exprTerm := term + TokenSet{Token.OR_};
          result := E1(t, exprTerm, canBeType);
        BEGIN
          WHILE M3CLex.Current(t) = Token.OR_ DO
            WITH op = M3AST_AS.NewOr() DO
              Pos(t, op, TRUE);
              result := Binary(op, result, E1(t, exprTerm));
            END;
          END;
          RETURN result;
        END;
      EXCEPT
      | IsType(type) => RETURN type;
      END;
    ELSE
      RETURN M3AST_AS.NewBad_EXP();
    END;
  END Expr;


PROCEDURE Else(
    t: T;
    READONLY term: TokenSet;
    end: M3AST_AS.END_SRC_NODE)
    : M3AST_AS.Else_stm_NULL
    RAISES {IO.Error}=
  BEGIN
    IF M3CLex.Current(t) = Token.ELSE_ THEN
      WITH e = M3AST_AS.NewElse_stm() DO
        Pos(t, e, TRUE);
        e.as_stm_s := StmtsThenEnd(t, term, end);
        RETURN e;
      END;
    ELSE
      EndPos(t, end);
      RETURN NIL;
    END; (* if *)
  END Else;


PROCEDURE Case(
    t: T;
    READONLY term: TokenSet)
    : M3AST_AS.Case_st
    RAISES {IO.Error}=
  VAR
    possibleStartOfCase := StartOfExpression + StartOfStatement +
        TokenSet{Token.Bar, Token.Range, Token.Implies};
    caseTerm := term + possibleStartOfCase + TokenSet{Token.END_, Token.ELSE_};
    caseLabelTerm := caseTerm + TokenSet{Token.Comma};
    case_st := M3AST_AS.NewCase_st();
  BEGIN
    Pos(t, case_st, TRUE);
    case_st.as_exp := Expr(t, caseTerm + TokenSet{Token.OF_});
    EVAL MustBeAt(t, Token.OF_);
    case_st.as_case_s := SeqM3AST_AS_Case.Null;
    IF NOT M3CLex.Current(t) IN TokenSet{Token.ELSE_, Token.END_} THEN
      EVAL At(t, Token.Bar);
      REPEAT
        WITH case = M3AST_AS.NewCase() DO
          SeqM3AST_AS_Case.AddRear(case_st.as_case_s, case);
          Pos(t, case);
          case.as_case_label_s := SeqM3AST_AS_RANGE_EXP.Null;
          REPEAT
            VAR
              rangeExp: M3AST_AS.RANGE_EXP;
              exp := Expr(t, caseLabelTerm);
            BEGIN
              IF At(t, Token.Range) THEN
                rangeExp := Range(exp, Expr(t, caseLabelTerm));
              ELSE
                rangeExp := RangeExp(exp);
              END;
              SeqM3AST_AS_RANGE_EXP.AddRear(case.as_case_label_s, rangeExp);
            END;
          UNTIL EndOfSequence(t, Token.Comma,
              Token.Implies, StartOfExpression + TokenSet{Token.Range},
              caseTerm);
          case.as_stm_s := Stmts(t,
              TokenSet{Token.Bar, Token.ELSE_, Token.END_}, caseTerm);
        END;
      UNTIL EndOfSequenceSet(t, Token.Bar,
          ElseOrEnd, possibleStartOfCase, caseTerm);
    END;
    case_st.as_else := Else(t, term, case_st.vEND_SRC_NODE);
    RETURN case_st;
  END Case;


PROCEDURE Exit(t: T): M3AST_AS.Exit_st RAISES {IO.Error}=
  VAR
    e := M3AST_AS.NewExit_st();
  BEGIN
    Pos(t, e, TRUE);
    RETURN e;
  END Exit;


PROCEDURE Eval(
    t: T;
    READONLY term: TokenSet)
    : M3AST_AS.Eval_st
    RAISES {IO.Error}=
  VAR
    e := M3AST_AS.NewEval_st();
  BEGIN
    Pos(t, e, TRUE);
    e.as_exp := Expr(t, term);
    RETURN e;
  END Eval;


PROCEDURE For(
    t: T;
    READONLY term: TokenSet)
    : M3AST_AS.For_st
    RAISES {IO.Error}=
  VAR
    forTerm := term + StartOfStatement +
        TokenSet{Token.TO_, Token.BY_, Token.DO_, Token.END_};
    f := M3AST_AS.NewFor_st();
  BEGIN
    Pos(t, f, TRUE);
    f.as_id := M3AST_AS.NewFor_id();
    Id(t, f.as_id);
    EVAL Expect(t, Token.Becomes, forTerm);
    f.as_from := Expr(t, forTerm);
    EVAL Expect(t, Token.TO_, forTerm);
    f.as_to := Expr(t, forTerm - TokenSet{Token.TO_});
    IF M3CLex.Current(t) = Token.BY_ THEN
      f.as_by := M3AST_AS.NewBy();
      Pos(t, f.as_by, TRUE);
      f.as_by.as_exp := Expr(t, forTerm - TokenSet{Token.TO_, Token.BY_});
    END;
    EVAL Expect(t, Token.DO_, forTerm - TokenSet{Token.TO_, Token.BY_});
    f.as_stm_s := StmtsThenEnd(t, term, f.vEND_SRC_NODE);
    RETURN f;
  END For;


PROCEDURE If(
    t: T;
    READONLY term: TokenSet)
    : M3AST_AS.If_st
    RAISES {IO.Error}=
  CONST
    EndOfIfArm = TokenSet{Token.ELSE_, Token.ELSIF_, Token.END_};
  VAR
    ifExprTerm := term + StartOfStatement + EndOfIfArm + TokenSet{Token.THEN_};
    if := M3AST_AS.NewIf_st();
  BEGIN
    Pos(t, if, TRUE);
    if.as_exp := Expr(t, ifExprTerm);
    EVAL MustBeAt(t, Token.THEN_);
    if.as_stm_s := Stmts(t, EndOfIfArm, term);
    if.as_elsif_s := SeqM3AST_AS_Elsif.Null;
    WHILE M3CLex.Current(t) = Token.ELSIF_ DO
      WITH elsif = M3AST_AS.NewElsif() DO
        SeqM3AST_AS_Elsif.AddRear(if.as_elsif_s, elsif);
        Pos(t, elsif, TRUE);
        elsif.as_exp := Expr(t, ifExprTerm);
        EVAL MustBeAt(t, Token.THEN_);
        elsif.as_stm_s := Stmts(t, EndOfIfArm, term);
      END;
    END;
    if.as_else := Else(t, term, if.vEND_SRC_NODE);
    RETURN if;
  END If;


PROCEDURE Lock(
    t: T;
    READONLY term: TokenSet)
    : M3AST_AS.Lock_st
    RAISES {IO.Error}=
  VAR
    l := M3AST_AS.NewLock_st();
  BEGIN
    Pos(t, l, TRUE);
    l.as_exp := Expr(t, term + EndAsSet + TokenSet{Token.DO_});
    EVAL MustBeAt(t, Token.DO_);
    l.as_stm_s := StmtsThenEnd(t, term, l.vEND_SRC_NODE);
    RETURN l;
  END Lock;


PROCEDURE Loop(
    t: T;
    READONLY term: TokenSet)
    : M3AST_AS.Loop_st
    RAISES {IO.Error}=
  VAR
    l := M3AST_AS.NewLoop_st();
  BEGIN
    Pos(t, l, TRUE);
    l.as_stm_s := StmtsThenEnd(t, term, l.vEND_SRC_NODE);
    RETURN l;
  END Loop;


PROCEDURE Repeat(
    t: T;
    READONLY term: TokenSet)
    : M3AST_AS.Repeat_st
    RAISES {IO.Error}=
  VAR
    r := M3AST_AS.NewRepeat_st();
  BEGIN
    Pos(t, r, TRUE);
    r.as_stm_s := Stmts(t, TokenSet{Token.UNTIL_}, term);
    EndPos(t, r.vEND_SRC_NODE, Token.UNTIL_);
    r.as_exp := Expr(t, term);
    RETURN r;
  END Repeat;


PROCEDURE Raise(
    t: T;
    READONLY term: TokenSet)
    : M3AST_AS.Raise_st
    RAISES {IO.Error}=
  VAR
    r := M3AST_AS.NewRaise_st();
  BEGIN
    Pos(t, r, TRUE);
    r.as_qual_id := QualId(t);
    EVAL ExpectSet(t, term + TokenSet{Token.Bra});
    IF At(t, Token.Bra) THEN
      r.as_exp_void := Expr(t, term + TokenSet{Token.Ket});
      EVAL MustBeAt(t, Token.Ket);
    END;
    RETURN r;
  END Raise;


PROCEDURE Return(
    t: T;
    READONLY term: TokenSet)
    : M3AST_AS.Return_st
    RAISES {IO.Error}=
  VAR
    r := M3AST_AS.NewReturn_st();
  BEGIN
    Pos(t, r, TRUE);
    IF NOT M3CLex.Current(t) IN term - StartOfExpression THEN
      r.as_exp := Expr(t, term);
    END;
    RETURN r;
  END Return;


PROCEDURE Try(
    t: T;
    READONLY term: TokenSet)
    : M3AST_AS.Try_st
    RAISES {IO.Error}=
  VAR
    try := M3AST_AS.NewTry_st();
  BEGIN
    Pos(t, try, TRUE);
    try.as_stm_s := Stmts(t, TokenSet{Token.FINALLY_, Token.EXCEPT_},
        term + TokenSet{Token.Bar, Token.ELSE_, Token.END_});
    IF M3CLex.Current(t) = Token.FINALLY_ THEN
      WITH f = M3AST_AS.NewTry_finally() DO
        try.as_try_tail := f;
        Pos(t, f, TRUE);
        f.as_stm_s := StmtsThenEnd(t, term, try.vEND_SRC_NODE);
      END;
    ELSE
      WITH e = M3AST_AS.NewTry_except() DO
        try.as_try_tail := e;
        Pos(t, e);
        EVAL At(t, Token.EXCEPT_);
        e.as_handler_s := SeqM3AST_AS_Handler.Null;
        IF NOT M3CLex.Current(t) IN TokenSet{Token.ELSE_, Token.END_} THEN
          VAR
            possibleStartOfHandler := StartOfStatement + IdAsSet +
                TokenSet{Token.Bar, Token.Bra, Token.Implies};
            handlerTerm := term + possibleStartOfHandler +
                TokenSet{Token.END_, Token.ELSE_};
          BEGIN
            EVAL At(t, Token.Bar);
            REPEAT
              WITH h = M3AST_AS.NewHandler() DO
                SeqM3AST_AS_Handler.AddRear(e.as_handler_s, h);
                Pos(t, h);
                h.as_qual_id_s := SeqM3AST_AS_Qual_used_id.Null;
                REPEAT
                  SeqM3AST_AS_Qual_used_id.AddRear(h.as_qual_id_s, QualId(t));
                UNTIL EndOfSequenceSet(t, Token.Comma,
                    TokenSet{Token.Bra, Token.Implies}, IdAsSet, handlerTerm);
                IF At(t, Token.Bra) THEN
                  h.as_id := M3AST_AS.NewHandler_id();
                  Id(t, h.as_id);
                  EVAL Expect(t, Token.Ket, handlerTerm);
                END;
                EVAL LenientMustBeAt(t, Token.Implies, Token.Colon);
                h.as_stm_s := Stmts(t,
                    TokenSet{Token.Bar, Token.ELSE_, Token.END_}, handlerTerm);
              END;
            UNTIL EndOfSequenceSet(t, Token.Bar,
                ElseOrEnd, possibleStartOfHandler, handlerTerm);
          END;
        END;
        e.as_else := Else(t, term, try.vEND_SRC_NODE);
      END;
    END;
    RETURN try;
  END Try;


PROCEDURE Typecase(
    t: T;
    READONLY term: TokenSet)
    : M3AST_AS.Typecase_st
    RAISES {IO.Error}=
  VAR
    possibleStartOfTypecase := StartOfStatement + StartOfType +
        TokenSet{Token.Bar, Token.Bra, Token.Implies};
    typecaseTerm := term + possibleStartOfTypecase +
        TokenSet{Token.END_, Token.ELSE_};
    typecaseLabelTerm := typecaseTerm + TokenSet{Token.Comma};
  VAR
    typecase_st := M3AST_AS.NewTypecase_st();
  BEGIN
    Pos(t, typecase_st, TRUE);
    typecase_st.as_exp := Expr(t, typecaseTerm + TokenSet{Token.OF_});
    EVAL Expect(t, Token.OF_, typecaseTerm);
    typecase_st.as_tcase_s := SeqM3AST_AS_Tcase.Null;
    IF NOT M3CLex.Current(t) IN TokenSet{Token.ELSE_, Token.END_} THEN
      EVAL At(t, Token.Bar);
      REPEAT
        WITH tcase = M3AST_AS.NewTcase() DO
          SeqM3AST_AS_Tcase.AddRear(typecase_st.as_tcase_s, tcase);
          Pos(t, tcase);
          tcase.as_type_s := SeqM3AST_AS_M3TYPE.Null;
          REPEAT
            SeqM3AST_AS_M3TYPE.AddRear(tcase.as_type_s,
                Type(t, typecaseLabelTerm));
          UNTIL EndOfSequenceSet(t, Token.Comma,
              TokenSet{Token.Bra, Token.Implies}, StartOfType, typecaseTerm);
          IF At(t, Token.Bra) THEN
            tcase.as_id := M3AST_AS.NewTcase_id();
            Id(t, tcase.as_id);
            EVAL Expect(t, Token.Ket, typecaseTerm);
          END;
          EVAL Expect(t, Token.Implies, typecaseTerm);
          tcase.as_stm_s := Stmts(
              t, TokenSet{Token.Bar, Token.ELSE_, Token.END_}, typecaseTerm);
        END;
      UNTIL EndOfSequenceSet(t, Token.Bar,
          ElseOrEnd, possibleStartOfTypecase, typecaseTerm);
    END;
    typecase_st.as_else := Else(t, term, typecase_st.vEND_SRC_NODE);
    RETURN typecase_st;
  END Typecase;


PROCEDURE While(
    t: T;
    READONLY term: TokenSet)
    : M3AST_AS.While_st
    RAISES {IO.Error}=
  VAR
    w := M3AST_AS.NewWhile_st();
  BEGIN
    Pos(t, w, TRUE);
    w.as_exp := Expr(t, term + TokenSet{Token.DO_, Token.END_});
    EVAL MustBeAt(t, Token.DO_);
    w.as_stm_s := StmtsThenEnd(t, term, w.vEND_SRC_NODE);
    RETURN w;
  END While;


PROCEDURE With(
    t: T;
    READONLY term: TokenSet)
    : M3AST_AS.With_st
    RAISES {IO.Error}=
  VAR
    possibleStartOfBinding := TokenSet{Token.Identifier, Token.Equal} +
        StartOfExpression;
    bindingTerm := term + StartOfStatement + possibleStartOfBinding +
        TokenSet{Token.Comma, Token.DO_, Token.END_};
    w := M3AST_AS.NewWith_st();
  BEGIN
    Pos(t, w, TRUE);
    w.as_binding_s := SeqM3AST_AS_Binding.Null;
    REPEAT
      WITH b = M3AST_AS.NewBinding() DO
        SeqM3AST_AS_Binding.AddRear(w.as_binding_s, b);
        Pos(t, b);
        b.as_id := M3AST_AS.NewWith_id();
        Id(t, b.as_id);
        EVAL Expect(t, Token.Equal, bindingTerm);
        b.as_exp := Expr(t, bindingTerm);
      END;
    UNTIL EndOfSequence(t, Token.Comma,
        Token.DO_, possibleStartOfBinding, bindingTerm);
    w.as_stm_s := StmtsThenEnd(t, term, w.vEND_SRC_NODE);
    RETURN w;
  END With;


<*INLINE*> PROCEDURE ExprOrInit(
    t: T;
    READONLY term: TokenSet;
    VAR init: M3AST_AS.EXP)
    : M3AST_AS.EXP
    RAISES {IO.Error}=
  VAR
    old := init;
  BEGIN
    IF old = NIL THEN
      RETURN Expr(t, term);
    ELSE
      init := NIL;
      RETURN old;
    END;
  END ExprOrInit;


PROCEDURE Stmts(
    t: T;
    READONLY validTerm, term: TokenSet;
    initialExp: M3AST_AS.EXP := NIL)
    : SeqM3AST_AS_STM.T
    RAISES {IO.Error}=
  VAR
    fullTerm := validTerm + term;
    result := SeqM3AST_AS_STM.Null;
  BEGIN
    IF initialExp = NIL AND M3CLex.Current(t) IN validTerm THEN
      RETURN result;
    ELSIF initialExp # NIL OR ExpectSet(t, StartOfStatement, fullTerm) THEN
      WITH stmtTerm = fullTerm + TokenSet{Token.Semicolon} DO
        LOOP
          VAR
            token := M3CLex.Current(t);
            stm: M3AST_AS.STM;
          BEGIN
            IF initialExp = NIL AND token IN StartOfBlock THEN
              stm := Block(t, stmtTerm);
            ELSIF initialExp # NIL OR token IN StartOfExpression THEN
              VAR
                lhsTerm := stmtTerm + TokenSet{Token.Becomes};
                exp := ExprOrInit(t, lhsTerm, initialExp);
                assignment: BOOLEAN;
                isCall := ISTYPE(exp, M3AST_AS.Call);
              BEGIN
                IF isCall THEN
                  EVAL ExpectSet(t, lhsTerm);
                  assignment := At(t, Token.Becomes);
                ELSE
                  assignment := Expect(t, Token.Becomes, stmtTerm);
                END;
                IF isCall AND NOT assignment THEN
                  WITH c = M3AST_AS.NewCall_st() DO
                    c.lx_srcpos := exp.lx_srcpos;
                    c.as_call := exp;
                    stm := c;
                  END;
                ELSE
                  WITH a = M3AST_AS.NewAssign_st() DO
                    a.lx_srcpos := exp.lx_srcpos;
                    a.as_lhs_exp := exp;
                    IF assignment THEN
                      a.as_rhs_exp := Expr(t, stmtTerm);
                    ELSE
                      a.as_rhs_exp := M3AST_AS.NewBad_EXP();
                    END;
                    stm := a;
                  END;
                END;
              END;
            ELSE
              CASE token OF
              | Token.CASE_ => stm := Case(t, stmtTerm);
              | Token.EXIT_ => stm := Exit(t);
              | Token.EVAL_ => stm := Eval(t, stmtTerm);
              | Token.FOR_ => stm := For(t, stmtTerm);
              | Token.IF_ => stm := If(t, stmtTerm);
              | Token.LOCK_ => stm := Lock(t, stmtTerm);
              | Token.LOOP_ => stm := Loop(t, stmtTerm);
              | Token.RAISE_ => stm := Raise(t, stmtTerm);
              | Token.REPEAT_ => stm := Repeat(t, stmtTerm);
              | Token.RETURN_ => stm := Return(t, stmtTerm);
              | Token.TRY_ => stm := Try(t, stmtTerm);
              | Token.TYPECASE_ => stm := Typecase(t, stmtTerm);
              | Token.WHILE_ => stm := While(t, stmtTerm);
              | Token.WITH_ => stm := With(t, stmtTerm);
              END;
            END;
            SeqM3AST_AS_STM.AddRear(result, stm);
            WITH exit = EndOfSequenceSet(t, Token.Semicolon,
                validTerm, StartOfStatement, term) DO
              IF t.lastPragma # NIL THEN
                M3CPragma.AddPrecedingStmOrDecl(stm, t.pragmas);
              END;
              IF exit THEN EXIT END;
            END;
          END;
        END;
      END;
    END;
    RETURN result;
  END Stmts;


PROCEDURE StmtsThenEnd(
    t: T;
    READONLY term: TokenSet;
    end: M3AST_AS.END_SRC_NODE)
    : SeqM3AST_AS_STM.T
    RAISES {IO.Error}=
  BEGIN
    WITH result = Stmts(t, EndAsSet, term) DO
      EndPos(t, end);
      RETURN result;
    END;
  END StmtsThenEnd;


PROCEDURE EndOfDecl(
    t: T;
    decl: M3AST.NODE;
    READONLY term: TokenSet)
    : BOOLEAN
    RAISES {IO.Error}=
  BEGIN
    EVAL Expect(t, Token.Semicolon, term + IdAsSet);
    LOOP
      WITH token = M3CLex.Current(t) DO 
        IF token = Token.Semicolon THEN
          Unexpected(t);
          EVAL M3CLex.Next(t);
        ELSE
          IF t.lastPragma # NIL THEN
            M3CPragma.AddPrecedingStmOrDecl(decl, t.pragmas);
          END;
          RETURN token # Token.Identifier;
        END;
      END;
    END;
  END EndOfDecl;


PROCEDURE ConstDecl(
    t: T;
    READONLY term: TokenSet)
    : M3AST_AS.Const_decl_s
    RAISES {IO.Error}=
  VAR
    constDeclS := M3AST_AS.NewConst_decl_s();
  BEGIN
    Pos(t, constDeclS, TRUE);
    constDeclS.as_const_decl_s := SeqM3AST_AS_Const_decl.Null;
    IF NOT M3CLex.Current(t) IN StartOfBlock THEN
      LOOP
        WITH c = M3AST_AS.NewConst_decl() DO
          SeqM3AST_AS_Const_decl.AddRear(constDeclS.as_const_decl_s, c);
          Pos(t, c);
          c.as_id := M3AST_AS.NewConst_id();
          Id(t, c.as_id);
          IF At(t, Token.Colon) THEN
            c.as_type := Type(t, term + TokenSet{Token.Equal});
          END;
          EVAL Expect(t, Token.Equal, term);
          c.as_exp := Expr(t, term);
          IF EndOfDecl(t, c, term) THEN EXIT END;
        END;
      END;
    END;
    RETURN constDeclS;
  END ConstDecl;


PROCEDURE Opaque(t: M3AST_AS.M3TYPE): M3AST_AS.M3TYPE RAISES {} =
  VAR
    new := M3AST_AS.NewOpaque_type();
  BEGIN
    new.lx_srcpos := t.lx_srcpos;
    new.as_type := t;
    RETURN new;
  END Opaque;


PROCEDURE TypeDecl(
    t: T;
    READONLY term: TokenSet)
    : M3AST_AS.Type_decl_s
    RAISES {IO.Error}=
  VAR
    typeDeclS := M3AST_AS.NewType_decl_s();
  BEGIN
    Pos(t, typeDeclS, TRUE);
    typeDeclS.as_type_decl_s := SeqM3AST_AS_TYPE_DECL.Null;
    IF NOT M3CLex.Current(t) IN StartOfBlock THEN
      LOOP
        VAR
          td: M3AST_AS.TYPE_DECL;
          id := M3AST_AS.NewType_id();
          opaque: BOOLEAN;
        BEGIN
          Id(t, id);
          opaque := At(t, Token.Subtype);
          IF opaque THEN
            td := M3AST_AS.NewSubtype_decl();
          ELSE
            EVAL Expect(t, Token.Equal, term + StartOfType);
            td := M3AST_AS.NewConcrete_decl();
          END;
          SeqM3AST_AS_TYPE_DECL.AddRear(typeDeclS.as_type_decl_s, td);
          td.lx_srcpos := id.lx_srcpos;
          td.as_id := id;
          td.as_type := Type(t, term);
          IF opaque THEN
            td.as_type := Opaque(td.as_type);
          END;
          IF EndOfDecl(t, td, term) THEN EXIT END;
        END;
      END;
    END;
    RETURN typeDeclS;
  END TypeDecl;


PROCEDURE ExceptionDecl(
    t: T;
    READONLY term: TokenSet)
    : M3AST_AS.Exc_decl_s
    RAISES {IO.Error}=
  VAR
    excDeclS := M3AST_AS.NewExc_decl_s();
  BEGIN
    Pos(t, excDeclS, TRUE);
    excDeclS.as_exc_decl_s := SeqM3AST_AS_Exc_decl.Null;
    IF NOT M3CLex.Current(t) IN StartOfBlock THEN
      LOOP
        WITH e = M3AST_AS.NewExc_decl() DO
          SeqM3AST_AS_Exc_decl.AddRear(excDeclS.as_exc_decl_s, e);
          Pos(t, e);
          e.as_id := M3AST_AS.NewExc_id();
          Id(t, e.as_id);
          IF At(t, Token.Bra) THEN
            e.as_type := Type(t, term + TokenSet{Token.Ket});
            EVAL Expect(t, Token.Ket, term);
          END;
          IF EndOfDecl(t, e, term) THEN EXIT END;
        END;
      END;
    END;
    RETURN excDeclS;
  END ExceptionDecl;


PROCEDURE IdAfterEnd(t: T; id: M3CLex.Symbol_rep) RAISES {IO.Error}=
  BEGIN
    IF M3CLex.Current(t) = Token.Identifier THEN
      IF id # NIL AND id # M3CLex.Identifier(t) THEN
        ErrorMessage(t,
            Fmt.F("name after END should be \'%s\'", M3CHash.IdToText(id)));
      END;
      EVAL M3CLex.Next(t);
    ELSE
      Expected(t, Token.Identifier);
    END;
  END IdAfterEnd;


PROCEDURE ProcedureDecl(
    t: T;
    READONLY term: TokenSet)
    : M3AST_AS.Proc_decl
    RAISES {IO.Error}=
  VAR
    p := M3AST_AS.NewProc_decl();
  BEGIN
    Pos(t, p, TRUE);
    p.as_id := M3AST_AS.NewProc_id();
    Id(t, p.as_id);
    WITH pos = M3CLex.Position(t) DO
      p.as_type := Signature(t, term + TokenSet{Token.Equal} + StartOfBlock);
      p.as_type.lx_srcpos := pos;
    END;
    EVAL ExpectSet(t,
        TokenSet{Token.Equal, Token.Semicolon}, StartOfStatement + term);
    IF t.interface THEN
      EVAL MustBeAt(t, Token.Semicolon);
    ELSE
      EVAL MustBeAt(t, Token.Equal);
      EVAL ExpectSet(t, StartOfBlock, StartOfStatement + term);
      p.as_body := Block(t, term);
      IdAfterEnd(t, p.as_id.lx_symrep);
      EVAL Expect(t, Token.Semicolon, term);
    END;
    IF t.lastPragma # NIL THEN
      M3CPragma.AddPrecedingStmOrDecl(p, t.pragmas);
    END;
    RETURN p;
  END ProcedureDecl;


PROCEDURE VarDecl(
    t: T;
    READONLY term: TokenSet)
    : M3AST_AS.Var_decl_s
    RAISES {IO.Error}=
  VAR
    varTerm := term + TokenSet{Token.Colon, Token.Becomes} + StartOfType +
        StartOfExpression;
    varDeclS := M3AST_AS.NewVar_decl_s();
  BEGIN
    Pos(t, varDeclS, TRUE);
    varDeclS.as_var_decl_s := SeqM3AST_AS_Var_decl.Null;
    IF NOT M3CLex.Current(t) IN StartOfBlock THEN
      LOOP
        WITH v = M3AST_AS.NewVar_decl() DO
          SeqM3AST_AS_Var_decl.AddRear(varDeclS.as_var_decl_s, v);
          Pos(t, v);
          v.as_id_s := SeqM3AST_AS_Var_id.Null;
          REPEAT
            WITH id = M3AST_AS.NewVar_id() DO
              SeqM3AST_AS_Var_id.AddRear(v.as_id_s, id);
              Id(t, id);
            END;
          UNTIL EndOfSequenceSet(t, Token.Comma,
              TokenSet{Token.Colon, Token.Becomes}, IdAsSet, varTerm);
          v.as_type := TypeAndOrDefault(t, varTerm, v.as_default);
          IF EndOfDecl(t, v, term) THEN EXIT END;
        END;
      END;
    END;
    RETURN varDeclS;
  END VarDecl;


PROCEDURE Reveal(
    t: T;
    READONLY term: TokenSet)
    : M3AST_AS.Revelation_s
    RAISES {IO.Error}=
  VAR
    revelationS := M3AST_AS.NewRevelation_s();
  BEGIN
    Pos(t, revelationS, TRUE);
    revelationS.as_reveal_s := SeqM3AST_AS_REVELATION.Null;
    IF NOT M3CLex.Current(t) IN StartOfBlock THEN
      LOOP
        VAR
          qualId := QualId(t);
          r: M3AST_AS.REVELATION;
        BEGIN
          IF At(t, Token.Subtype) THEN
            r := M3AST_AS.NewSubtype_reveal();
          ELSE
            EVAL Expect(t, Token.Equal, term + StartOfType);
            r := M3AST_AS.NewConcrete_reveal();
          END;
          SeqM3AST_AS_REVELATION.AddRear(revelationS.as_reveal_s, r);
          r.lx_srcpos := qualId.lx_srcpos;
          r.as_qual_id := qualId;
          r.as_type := Type(t, term);
          IF EndOfDecl(t, r, term) THEN EXIT END;
        END;
      END;
    END;
    RETURN revelationS;
  END Reveal;


<*INLINE*> PROCEDURE LastPos(srcNode: M3AST_AS.SRC_NODE): M3CSrcPos.T RAISES {}=
  BEGIN
    IF srcNode = NIL THEN
      RETURN M3CSrcPos.Null;
    ELSE
      RETURN srcNode.lx_srcpos;
    END;
  END LastPos;


PROCEDURE ExternalPragma(
    pragmas: M3CPragma.Store;
    last: M3AST_AS.SRC_NODE;
    VAR langSpec: Text.T)
    : M3CPragma.T
    RAISES {}=
  VAR
    iter := M3CPragma.NewIter(pragmas, LastPos(last));
    pragma: M3CPragma.T;
    args: Text.T;
  BEGIN
    WHILE M3CPragma.Next(iter, pragma) DO
      IF M3CPragma.Match(pragma, "EXTERNAL", langSpec) THEN
        RETURN pragma;
      END;
    END;
    RETURN NIL;
  END ExternalPragma;


PROCEDURE InlinePragma(
    pragmas: M3CPragma.Store;
    last: M3AST_AS.SRC_NODE)
    : M3CPragma.T
    RAISES {}=
  VAR
    iter := M3CPragma.NewIter(pragmas, LastPos(last));
    pragma: M3CPragma.T;
    args: Text.T;
  BEGIN
    WHILE M3CPragma.Next(iter, pragma) DO
      IF M3CPragma.Match(pragma, "INLINE", args) AND args = NIL THEN
        RETURN pragma;
      END;
    END;
    RETURN NIL;
  END InlinePragma;


PROCEDURE External(
    pragma: M3CPragma.T;
    langSpec: Text.T)
    : M3AST_PG.External
    RAISES {}=
  VAR
    external := M3AST_PG.NewExternal();
  BEGIN
    external.lx_srcpos := M3CPragma.Position(pragma);
    IF langSpec = NIL THEN external.lx_lang_spec := NIL
    ELSE 
      (* M3AST_PG_F says its a Text_rep, so it must be quoted (sigh) *)
      IF NOT Text.GetChar(langSpec, 0) = '"' THEN
        langSpec := TextExtras.Join("\"", langSpec, "\"");
      END;
      external.lx_lang_spec := M3CLiteral.Enter(langSpec);
    END;
    RETURN external;
  END External;


PROCEDURE Declarations(
    t: T;
    READONLY term: TokenSet;
    revealOk := FALSE)
    : SeqM3AST_AS_DECL_REVL.T
    RAISES {IO.Error}=
  VAR
    declTerm := term +
        TokenSet{Token.Semicolon} + StartOfDeclarationOrRevelation;
    result := SeqM3AST_AS_DECL_REVL.Null;
  BEGIN
    LOOP
      VAR
        token := M3CLex.Current(t);
      BEGIN
        IF token IN StartOfDeclaration THEN
          VAR
            d: M3AST_AS.DECL;
            langSpec: Text.T;
            externalPragma :=
                ExternalPragma(t.pragmas, t.lastSrcPosNode, langSpec);
          BEGIN
            CASE token OF
            | Token.CONST_ =>
                d := ConstDecl(t, declTerm);
            | Token.TYPE_ =>
                d := TypeDecl(t, declTerm);
            | Token.EXCEPTION_ =>
                d := ExceptionDecl(t, declTerm);
            | Token.PROCEDURE_ =>
                VAR
                  inlinePragma := InlinePragma(t.pragmas, t.lastSrcPosNode);
                  procDecl := ProcedureDecl(t, declTerm);
                BEGIN
                  IF inlinePragma # NIL THEN
                    WITH inline = M3AST_PG.NewInline() DO
                      inline.lx_srcpos := M3CPragma.Position(inlinePragma);
                      procDecl.pg_inline := inline;
                    END;
                    M3CPragma.SetHook(inlinePragma, procDecl);
                  END;
                  d := procDecl;
                END;
            | Token.VAR_ =>
                d := VarDecl(t, declTerm);
            END; (* case *)
            IF externalPragma # NIL THEN
              VAR
                externalDecl: M3AST_PG.EXTERNAL_DECL;
              BEGIN
                IF M3AST_PG.IsA_EXTERNAL_DECL(d, externalDecl) THEN
                  externalDecl.pg_external :=
                      External(externalPragma, langSpec);
                  M3CPragma.SetHook(externalPragma, d);
                END;
              END;
            END;
            SeqM3AST_AS_DECL_REVL.AddRear(result, d);
          END;
        ELSIF token = Token.REVEAL_ THEN
          IF NOT revealOk THEN Unexpected(t) END;
          WITH reveal = Reveal(t, declTerm) DO
            SeqM3AST_AS_DECL_REVL.AddRear(result, reveal);
          END;
        ELSIF token = Token.Semicolon THEN
          Unexpected(t);
          EVAL M3CLex.Next(t);
        ELSE
          EXIT;
        END;
      END;
    END; (* loop *)
    RETURN result;
  END Declarations;


PROCEDURE Block(
    t: T;
    READONLY term: TokenSet;
    revealOk := FALSE)
    : M3AST_AS.Block
    RAISES {IO.Error}=
  VAR
    blockTerm := term + StartOfStatement + EndAsSet;
    b := M3AST_AS.NewBlock();
  BEGIN
    Pos(t, b);
    b.as_decl_s :=
        Declarations(t, blockTerm + TokenSet{Token.BEGIN_}, revealOk);
    EVAL Expect(t, Token.BEGIN_, blockTerm);
    b.as_stm_s := StmtsThenEnd(t, blockTerm, b.vEND_SRC_NODE);
    RETURN b;
  END Block;


PROCEDURE Imports(
    t: T;
    READONLY term: TokenSet)
    : SeqM3AST_AS_IMPORTED.T
    RAISES {IO.Error}=
  VAR
    possibleStartOfImport := StartOfImport +
        TokenSet{Token.Identifier, Token.AS_, Token.Comma, Token.Semicolon};
    importTerm := term + possibleStartOfImport;
    seqImported := SeqM3AST_AS_IMPORTED.Null;
  BEGIN
    IF M3CLex.Current(t) IN StartOfImport THEN
      REPEAT
        VAR
          pos := M3CLex.Position(t);
          imported: M3AST_AS.IMPORTED;
        BEGIN
          IF At(t, Token.FROM_) THEN
            WITH f = M3AST_AS.NewFrom_import() DO
              f.lx_srcpos := pos;
              f.as_intf_id := M3AST_AS.NewUsed_interface_id();
              Id(t, f.as_intf_id);
              f.as_id_s := SeqM3AST_AS_Used_def_id.Null;
              EVAL Expect(t, Token.IMPORT_, importTerm);
              REPEAT
                WITH id = M3AST_AS.NewUsed_def_id() DO
                  SeqM3AST_AS_Used_def_id.AddRear(f.as_id_s, id);
                  Id(t, id);
                END;
              UNTIL EndOfSequence(t, Token.Comma,
                  Token.Semicolon, IdAsSet, importTerm);
              imported := f;
            END;
          ELSE
            WITH i = M3AST_AS.NewSimple_import() DO
              i.lx_srcpos := pos;
              i.as_import_item_s := SeqM3AST_AS_Import_item.Null;
              EVAL Expect(t, Token.IMPORT_, importTerm);
              REPEAT
                WITH import_item = M3AST_AS.NewImport_item() DO
                  SeqM3AST_AS_Import_item.AddRear(i.as_import_item_s, import_item);
                  Pos(t, import_item, FALSE);
                  import_item.as_intf_id := M3AST_AS.NewUsed_interface_id();
                  Id(t, import_item.as_intf_id);
                  IF At(t, Token.AS_) THEN
                    import_item.as_id := M3AST_AS.NewInterface_AS_id();
                    Id(t, import_item.as_id);
                  END;
                END;
              UNTIL EndOfSequence(t, Token.Comma,
                  Token.Semicolon, IdAsSet, importTerm);
              imported := i;
            END;
          END;
          SeqM3AST_AS_IMPORTED.AddRear(seqImported, imported);
        END;
      UNTIL NOT M3CLex.Current(t) IN possibleStartOfImport;
    END;
    RETURN seqImported;
  END Imports;

PROCEDURE GenericFormals(t: T;
    READONLY term: TokenSet): SeqM3AST_AS_F_Interface_id.T RAISES {IO.Error}=
  VAR seqF_Interface_id := SeqM3AST_AS_F_Interface_id.Null;
  BEGIN
    EVAL Expect(t, Token.Bra, term);
    IF NOT At(t, Token.Ket) THEN
      REPEAT
        WITH id = M3AST_AS.NewF_Interface_id() DO
          SeqM3AST_AS_F_Interface_id.AddRear(seqF_Interface_id, id);
          Id(t, id);
        END;
      UNTIL EndOfSequence(t, Token.Comma, Token.Ket, IdAsSet, term);
    END; (* if *)
    RETURN seqF_Interface_id;
  END GenericFormals;


PROCEDURE GenericActuals(t: T;
    READONLY term: TokenSet
    ): SeqM3AST_AS_Used_interface_id.T RAISES {IO.Error}=
  VAR seqUsed_interface_id := SeqM3AST_AS_Used_interface_id.Null;
  BEGIN
    EVAL Expect(t, Token.Bra, term);
    IF NOT At(t, Token.Ket) THEN
      REPEAT
        WITH id = M3AST_AS.NewUsed_interface_id() DO
          SeqM3AST_AS_Used_interface_id.AddRear(seqUsed_interface_id, id);
          Id(t, id);
        END;
      UNTIL EndOfSequence(t, Token.Comma, Token.Ket, IdAsSet, term);
    END; (* if *)
    RETURN seqUsed_interface_id;
  END GenericActuals;


PROCEDURE TruncatedUnit(t: T; unit: M3AST_AS.UNIT): M3AST_AS.UNIT RAISES {}=
  VAR
    b := M3AST_AS.NewBlock();
    pos := M3CLex.Position(t);
  BEGIN
    b.lx_srcpos := pos;
    b.as_decl_s := SeqM3AST_AS_DECL_REVL.Null;
    b.as_stm_s := SeqM3AST_AS_STM.Null;
    b.vEND_SRC_NODE.lx_end_srcpos := pos;
    TYPECASE unit OF
    | M3AST_AS.UNIT_WITH_BODY(ub) => ub.as_block := b;
    ELSE
    END;
    RETURN unit;
  END TruncatedUnit;


PROCEDURE Unit(
    t: T;
    headerOnly := FALSE)
    : M3AST_AS.UNIT
    RAISES {IO.Error}=
  CONST
    UnitTerm = StartOfImport + StartOfDeclaration + StartOfRevelation +
        TokenSet{Token.END_, Token.Void};
  VAR
    unit: M3AST_AS.UNIT; unit_with_body: M3AST_AS.UNIT_WITH_BODY;
    unsafe: M3AST_AS.Unsafe := NIL;
    generic := FALSE;
  BEGIN
    EVAL ExpectSet(t, StartOfUnit, UnitTerm + IdAsSet);
    IF M3CLex.Current(t) = Token.UNSAFE_ THEN
      unsafe := M3AST_AS.NewUnsafe();
      Pos(t, unsafe, TRUE);
    END;
    IF M3CLex.Current(t) = Token.GENERIC_ THEN
      generic := TRUE;
      IF unsafe # NIL THEN Unexpected(t) END;
      EVAL M3CLex.Next(t);
    END;
    IF M3CLex.Current(t) = Token.INTERFACE_ THEN
      VAR
        interface := M3AST_AS.NewInterface();
        langSpec: Text.T;
        externalPragma := ExternalPragma(t.pragmas, NIL, langSpec);
      BEGIN
        IF externalPragma # NIL THEN
          interface.vEXTERNAL_DECL.pg_external :=
              External(externalPragma, langSpec);
          M3CPragma.SetHook(externalPragma, interface);
        END;
        t.interface := TRUE;
        Pos(t, interface, TRUE);
        interface.as_id := M3AST_AS.NewInterface_id();
        interface.as_unsafe := unsafe;
        Id(t, interface.as_id);
        IF generic THEN
          VAR interface_gen_def := M3AST_AS.NewInterface_gen_def();
          BEGIN
            unit := interface_gen_def;
            interface_gen_def.as_id_s := GenericFormals(t, UnitTerm);
            interface_gen_def.as_id := interface.as_id;
            interface_gen_def.lx_srcpos := interface.lx_srcpos;
            interface_gen_def.vEXTERNAL_DECL.pg_external :=
                interface.vEXTERNAL_DECL.pg_external;
            EVAL Expect(t, Token.Semicolon, UnitTerm);
          END;
        ELSE
          EVAL ExpectSet(t, TokenSet{Token.Semicolon, Token.Equal}, UnitTerm);
          IF At(t, Token.Equal) THEN
            VAR interface_gen_ins := M3AST_AS.NewInterface_gen_ins();
            BEGIN
              unit := interface_gen_ins;
              interface_gen_ins.as_id := interface.as_id;
              interface_gen_ins.lx_srcpos := interface.lx_srcpos;
              interface_gen_ins.as_unsafe := unsafe;
              interface_gen_ins.as_gen_id := M3AST_AS.NewUsed_interface_id();
              Id(t, interface_gen_ins.as_gen_id);
              interface_gen_ins.as_id_s := GenericActuals(t, UnitTerm);
            END;
          ELSE
            EVAL Expect(t, Token.Semicolon, UnitTerm);
            unit := interface;
          END;
        END;
        IF ISTYPE(unit, M3AST_AS.UNIT_WITH_BODY) THEN
          unit_with_body := unit;
          EVAL ExpectSet(t, UnitTerm - TokenSet{Token.Void}, UnitTerm);
          unit_with_body.as_import_s := Imports(t, UnitTerm);
          IF headerOnly THEN RETURN TruncatedUnit(t, unit_with_body) END;
          WITH block = unit_with_body.as_block DO
            block := M3AST_AS.NewBlock();
            block.lx_srcpos := M3CLex.Position(t);
            block.as_decl_s :=
                Declarations(t, UnitTerm - StartOfImport, TRUE);
            block.as_stm_s := SeqM3AST_AS_STM.Null;
            block.vEND_SRC_NODE.lx_end_srcpos := M3CLex.Position(t);
          END;
        END;
        EVAL Expect(t, Token.END_, UnitTerm);
        t.interface := FALSE;
      END;
    ELSE
      CONST
        ModuleTerm = UnitTerm + StartOfBlock;
        ExportsTerm = ModuleTerm + TokenSet{Token.Semicolon};
        StartOfModuleBody = StartOfImport + StartOfBlock;
      VAR
        module := M3AST_AS.NewModule();
      BEGIN
        module.as_unsafe := unsafe;
        Pos(t, module);
        EVAL MustBeAt(t, Token.MODULE_);
        module.as_id := M3AST_AS.NewModule_id();
        Id(t, module.as_id);
        module.as_export_s := SeqM3AST_AS_Used_interface_id.Null;
        IF generic THEN
          VAR module_gen_def := M3AST_AS.NewModule_gen_def();
          BEGIN
            unit := module_gen_def;
            module_gen_def.as_id := module.as_id;
            module_gen_def.lx_srcpos := module.lx_srcpos;
            module_gen_def.as_id_s := GenericFormals(t, UnitTerm);
            EVAL Expect(t, Token.Semicolon, UnitTerm);
          END;
        ELSE
          IF At(t, Token.EXPORTS_) THEN
            REPEAT
              WITH id = M3AST_AS.NewUsed_interface_id() DO
                SeqM3AST_AS_Used_interface_id.AddRear(module.as_export_s, id);
                Id(t, id);
              END;
            UNTIL EndOfSequenceSet(t, Token.Comma,
                TokenSet{Token.Semicolon, Token.Equal}, IdAsSet, ExportsTerm);
          END;
          EVAL ExpectSet(t, TokenSet{Token.Semicolon, Token.Equal},
                         ModuleTerm);
          IF At(t, Token.Equal) THEN
            VAR module_gen_ins := M3AST_AS.NewModule_gen_ins();
            BEGIN
              unit := module_gen_ins;
              module_gen_ins.as_id := module.as_id;
              module_gen_ins.lx_srcpos := module.lx_srcpos;
              module_gen_ins.as_export_s := module.as_export_s;
              module_gen_ins.as_unsafe := unsafe;
              module_gen_ins.as_gen_id := M3AST_AS.NewUsed_interface_id();
              Id(t, module_gen_ins.as_gen_id);
              module_gen_ins.as_id_s := GenericActuals(t, UnitTerm);
            END;
            EVAL MustBeAt(t, Token.END_);
          ELSE
            EVAL Expect(t, Token.Semicolon, ModuleTerm);
            unit := module
          END; (* if *)
        END; (* if *)
        IF ISTYPE(unit, M3AST_AS.UNIT_WITH_BODY) THEN
          unit_with_body := unit;
          EVAL ExpectSet(t, StartOfModuleBody, ModuleTerm);
          unit_with_body.as_import_s := Imports(t, ModuleTerm);
          IF headerOnly THEN RETURN TruncatedUnit(t, unit) END;
          unit_with_body.as_block := Block(t, ModuleTerm - StartOfImport, TRUE);
        END;
      END;
    END;
    IdAfterEnd(t, unit.as_id.lx_symrep);
    EVAL MustBeAt(t, Token.Dot);
    RETURN unit;
  END Unit;


EXCEPTION
  BadTerminators;

<*INLINE*> PROCEDURE CheckTerminators(chars: CharType.Set): CharType.Set RAISES {}=
  BEGIN
    IF chars <= M3CToken.PrintableBadChars THEN
      RETURN chars;
    ELSE
      RAISE BadTerminators;
    END;
  END CheckTerminators;


PROCEDURE Any(
    t: T;
    terminators := CharType.None)
    : REFANY
    RAISES {IO.Error}=
  CONST
    VoidAsSet = TokenSet{Token.Void};
    DefaultTerm = Start + VoidAsSet;
  VAR
    token := M3CLex.Current(t);
    result: REFANY := NIL;
  BEGIN
    t.comments := NIL;
    t.pragmas := M3CPragma.NewStore();
    t.terminators := CheckTerminators(terminators);
    IF token = Token.Void THEN token := M3CLex.Next(t) END;
    IF ExpectSet(t, Start, DefaultTerm) THEN
      IF token IN StartOfUnit THEN
        result := Unit(t);
      ELSIF token IN StartOfImport THEN
        result := Imports(t, DefaultTerm);
      ELSIF token IN StartOfBlock THEN
        VAR
	  pos := M3CLex.Position(t);
          decls := Declarations(t, DefaultTerm);
        BEGIN
          IF At(t, Token.BEGIN_) THEN
            WITH b = M3AST_AS.NewBlock() DO
	      b.lx_srcpos := pos;
              b.as_decl_s := decls;
              b.as_stm_s := StmtsThenEnd(t,
                  StartOfStatement + EndAsSet, b.vEND_SRC_NODE);
              IF At(t, Token.Semicolon) THEN
                VAR
                  seqStm := Stmts(t, VoidAsSet, DefaultTerm);
                BEGIN
                  SeqM3AST_AS_STM.AddFront(seqStm, b);
                  result := seqStm;
                END;
              ELSE
                result := b;
              END;
            END;
          ELSE
            result := decls;
          END;
        END;
      ELSIF token IN StartOfExpression THEN
        CONST
          PartOfStatement = TokenSet{Token.Semicolon, Token.Becomes};
        VAR
          expr := Expr(t, DefaultTerm + PartOfStatement, TRUE);
        BEGIN
          IF ISTYPE(expr, M3AST_AS.M3TYPE) OR
              NOT M3CLex.Current(t) IN PartOfStatement THEN
            result := expr;
          ELSE
            result := Stmts(t, VoidAsSet, DefaultTerm, expr);
          END;
        END;
      ELSE
        result := Stmts(t, VoidAsSet, DefaultTerm);
      END;
    END;
    IF M3CLex.Current(t) # Token.Void THEN Unexpected(t) END;
    t.terminators := CharType.None;
    Reset(t);
    RETURN result;
  END Any;


TYPE
  CallBack = M3CLex.CallBack OBJECT
    parser: T;
  OVERRIDES
    badChar := BadChar;
    comment := Comment;
    pragma := Pragma;
  END;


PROCEDURE BadChar(c: CallBack; ch: CHAR) RAISES {}=
  VAR
    text: Text.T;
  BEGIN
    IF ch IN c.parser.terminators THEN
      M3CLex.Disable(c.parser);
    ELSE
      IF ch IN CharType.Printable THEN
        text := Fmt.Char(ch);
      ELSE
        text := Fmt.F("%s", Fmt.Int(ORD(ch), 8));
      END;
      ErrorMessage(c.parser, "Bad char - " & text);
    END;
  END BadChar;


PROCEDURE Comment(c: CallBack; comment: Text.T) RAISES {}=
  VAR
    high := Text.Length(comment) - 1; (* will be at least 2 *)
  BEGIN
    IF Text.GetChar(comment, high) # ')' OR
        Text.GetChar(comment, high - 1) # '*' THEN
      ErrorMessage(c.parser, "Non terminated comment");
    END;
    (* should append to 't.comments' *)
  END Comment;


PROCEDURE Pragma(c: CallBack; pragma: Text.T) RAISES {}=
  VAR
    high := Text.Length(pragma) - 1; (* will be at least 2 *)
    t := c.parser;
  BEGIN
    IF Text.GetChar(pragma, high) # '>' OR
        Text.GetChar(pragma, high - 1) # '*' THEN
      ErrorMessage(t, "Non terminated pragma");
    ELSE
      t.lastPragma := M3CPragma.AddToStore(pragma, M3CLex.Position(t),
          t.lastSrcPosNode, t.pragmas);
      t.commentOrPragma := TRUE;
    END;
  END Pragma;


PROCEDURE NewCallBack(parser: T): M3CLex.CallBack RAISES {}=
  BEGIN
    RETURN NEW(CallBack, parser := parser);
  END NewCallBack;


PROCEDURE New(
    s: IO.Stream;
    identifiers: M3CReservedWord.Table;
    literals: M3CHash.Table;
    errorHandler: ErrorHandler;
    init: T := NIL)
    : T
    RAISES {}=
  VAR
    t := init;
  BEGIN
    IF t = NIL THEN t := NEW(T) END;
    EVAL M3CLex.New(s, identifiers, literals, NewCallBack(t), t);
    t.identifiers := identifiers;
    t.idNEW  := M3CHash.Enter(identifiers, "NEW");
    t.errorHandler := errorHandler;
    RETURN t;
  END New;


PROCEDURE ResetLastFields(t: T) RAISES {}=
  BEGIN
    t.lastErrorPos := M3CSrcPos.Null;
    t.lastSrcPosNode := NIL;
    t.commentOrPragma := FALSE;
    t.lastPragma := NIL;
  END ResetLastFields;


PROCEDURE Compilation(
    t: T;
    headerOnly := FALSE)
    : M3AST_AS.Compilation_Unit
    RAISES {IO.Error}=
  VAR
    c := M3AST_AS.NewCompilation_Unit();
  BEGIN
    t.comments := NIL;
    t.pragmas := M3CPragma.NewStore();
    ResetLastFields(t);
    EVAL M3CLex.Next(t);
    c.as_root := Unit(t, headerOnly);
    c.lx_comments := t.comments;
    c.lx_pragmas := t.pragmas;
    ResetLastFields(t);
    t.comments := NIL;
    t.pragmas := NIL;
    RETURN c;
  END Compilation;


PROCEDURE Reset(t: T; pos := M3CSrcPos.Null; s: IO.Stream := NIL) RAISES {}=
  BEGIN
    ResetLastFields(t);
    M3CLex.Reset(t, pos, s);
  END Reset;


PROCEDURE Comments(t: T): M3AST_LX.CommentStore RAISES {}=
  BEGIN
    RETURN t.comments;
  END Comments;


PROCEDURE Pragmas(t: T): M3AST_LX.PragmaStore RAISES {}=
  BEGIN
    RETURN t.pragmas;
  END Pragmas;


BEGIN

END M3CParse.