MODULE; IMPORT Text, TextExtras, Fmt; IMPORT Rd; IMPORT M3AST, M3AST_PG, M3AST_AS; IMPORT M3AST_LX_F, 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, M3CComment; <*NOWARN*> IMPORT M3CWhitespace; TYPE Token = M3CToken.T; TokenSet = M3CToken.Set; CONST None = TokenSet{}; StartOfUnit = TokenSet{M3CToken.UNSAFE_, M3CToken.MODULE_, M3CToken.INTERFACE_, M3CToken.GENERIC_}; StartOfImport = TokenSet{M3CToken.FROM_, M3CToken.IMPORT_}; StartOfDeclaration = TokenSet{M3CToken.CONST_, M3CToken.TYPE_, M3CToken.VAR_, M3CToken.EXCEPTION_, M3CToken.PROCEDURE_}; StartOfRevelation = TokenSet{M3CToken.REVEAL_}; StartOfDeclarationOrRevelation = StartOfDeclaration + StartOfRevelation; StartOfBlock = TokenSet{M3CToken.BEGIN_} + StartOfDeclarationOrRevelation; AlwaysStartOfType = TokenSet{M3CToken.CurlyBra, M3CToken.SquareBra, M3CToken.ADDRESS_, M3CToken.ARRAY_, M3CToken.BITS_, M3CToken.INTEGER_, M3CToken.LONGINT_, M3CToken.LONGREAL_, M3CToken.NULL_, M3CToken.OBJECT_, M3CToken.REAL_, M3CToken.RECORD_, M3CToken.REF_, M3CToken.REFANY_, M3CToken.ROOT_, M3CToken.SET_, M3CToken.BRANDED_, M3CToken.UNTRACED_, M3CToken.EXTENDED_, M3CToken.WIDECHAR_}; StartOfType = AlwaysStartOfType + TokenSet{M3CToken.Identifier, M3CToken.Bra, M3CToken.PROCEDURE_}; AlwaysStartOfExpression = TokenSet{M3CToken.NOT_, M3CToken.Plus, M3CToken.Minus, M3CToken.NIL_} + M3CToken.Literals; StartOfExpression = AlwaysStartOfExpression + StartOfType; AlwaysStartOfStatement = TokenSet{M3CToken.CASE_, M3CToken.EXIT_, M3CToken.EVAL_, M3CToken.FOR_, M3CToken.IF_, M3CToken.LOCK_, M3CToken.LOOP_, M3CToken.RAISE_, M3CToken.REPEAT_, M3CToken.RETURN_, M3CToken.TRY_, M3CToken.TYPECASE_, M3CToken.WHILE_, M3CToken.WITH_}; StartOfStatement = AlwaysStartOfStatement + StartOfBlock + StartOfExpression; Start = StartOfUnit + StartOfImport + StartOfStatement + StartOfBlock; IdAsSet = TokenSet{M3CToken.Identifier}; EndAsSet = TokenSet{M3CToken.END_}; ElseOrEnd = TokenSet{M3CToken.ELSE_} + EndAsSet; REVEAL T = Public BRANDED OBJECT lexer: M3CLex.T; lastErrorPos := M3CSrcPos.Null; lastSrcPosNode: M3AST_AS.SRC_NODE := NIL; terminators := SET OF CHAR{}; interface := FALSE; commentOrPragma := FALSE; pragmas: M3CPragma.Store; comments: M3CComment.Store; lastPragma: M3CPragma.T := NIL; lastComment: M3CComment.T := NIL; errorHandler: ErrorHandler := NIL; identifiers: M3CReservedWord.Table; idNEW: M3CHash.Id := NIL; nil_litrep: M3CLiteral.T; OVERRIDES init := Init; compilation := Compilation; any := Any; reset := Reset; END; PROCEDURE M3CParse ErrorMessage (t: T; text: Text.T) RAISES {}= VAR pos := t.lexer.position(); BEGIN t.lastErrorPos := pos; t.errorHandler.handle(pos, text); END ErrorMessage; PROCEDUREUnexpectedMessage (t: T; text: Text.T := NIL) RAISES {}= BEGIN IF text = NIL THEN ErrorMessage(t, Fmt.F("Unexpected symbol: %s", t.lexer.currentTokenToText())); ELSE ErrorMessage(t, Fmt.F("%s expected, %s found", text, t.lexer.currentTokenToText())); END; END UnexpectedMessage; <*INLINE*> PROCEDUREFirstErrorHere (t: T): BOOLEAN RAISES {}= BEGIN RETURN t.lastErrorPos # t.lexer.position(); END FirstErrorHere; PROCEDUREUnexpected (t: T) RAISES {}= BEGIN IF FirstErrorHere(t) THEN UnexpectedMessage(t, NIL); END; END Unexpected; PROCEDUREExpected (t: T; token: Token) RAISES {}= BEGIN IF FirstErrorHere(t) THEN UnexpectedMessage(t, M3CLex.TokenToText(token)); END; END Expected; PROCEDURESetToText (set: TokenSet): Text.T RAISES {}= TYPE ST = RECORD set: TokenSet; text: Text.T END; CONST 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; PROCEDUREExpectedSet (t: T; READONLY valid: TokenSet) RAISES {}= BEGIN IF FirstErrorHere(t) THEN UnexpectedMessage(t, SetToText(valid)); END; END ExpectedSet; PROCEDURENodeAfter (t: T; srcNode: M3AST_AS.SRC_NODE) RAISES {}= BEGIN IF t.lastPragma # NIL THEN M3CPragma.AddFollowingNode(srcNode, t.pragmas); t.lastPragma := NIL; END; IF t.lastComment # NIL THEN M3CComment.AddFollowingNode(srcNode, t.comments); t.lastComment := NIL; END; t.commentOrPragma := FALSE; END NodeAfter; <*INLINE*> PROCEDUREPos ( t: T; srcNode: M3AST_AS.SRC_NODE; next := FALSE) RAISES {Rd.Failure}= BEGIN srcNode.lx_srcpos := t.lexer.position(); t.lastSrcPosNode := srcNode; IF t.commentOrPragma THEN NodeAfter(t, srcNode) END; IF next THEN EVAL t.lexer.next() END; END Pos; <*INLINE*> PROCEDUREEndPos ( t: T; mustBeAt := M3CToken.END_) RAISES {Rd.Failure}= BEGIN EVAL MustBeAt(t, mustBeAt); END EndPos; <*INLINE*> PROCEDUREAt (t: T; token: Token): BOOLEAN RAISES {Rd.Failure}= BEGIN IF t.lexer.current() = token THEN EVAL t.lexer.next(); RETURN TRUE; ELSE RETURN FALSE; END; (* if *) END At; <*INLINE*> PROCEDUREMustBeAt ( t: T; token: Token) : BOOLEAN RAISES {Rd.Failure}= VAR at := At(t, token); BEGIN IF NOT at THEN Expected(t, token) END; RETURN at; END MustBeAt; PROCEDURELenientAt ( t: T; token, alternative: Token) : BOOLEAN RAISES {Rd.Failure}= BEGIN IF NOT At(t, token) THEN IF t.lexer.current() = alternative THEN Expected(t, token); EVAL t.lexer.next(); RETURN TRUE; ELSE RETURN FALSE; END; ELSE RETURN TRUE; END; END LenientAt; <*INLINE*> PROCEDURELenientMustBeAt ( t: T; token, alternative: Token) : BOOLEAN RAISES {Rd.Failure}= BEGIN RETURN MustBeAt(t, token) OR At(t, alternative); END LenientMustBeAt; PROCEDUREFindExpected ( t: T; token: Token; READONLY term: TokenSet) : BOOLEAN RAISES {Rd.Failure}= VAR current := t.lexer.current(); stop := term + TokenSet{token}; BEGIN Expected(t, token); LOOP IF current IN stop THEN IF current = token THEN EVAL t.lexer.next(); RETURN TRUE; ELSE RETURN FALSE; END; ELSE current := t.lexer.next(); END; END; END FindExpected; <*INLINE*> PROCEDUREExpect ( t: T; token: Token; READONLY term: TokenSet) : BOOLEAN RAISES {Rd.Failure}= BEGIN IF t.lexer.current() = token THEN EVAL t.lexer.next(); RETURN TRUE; ELSE RETURN FindExpected(t, token, term); END; END Expect; PROCEDUREFindExpectedSet ( t: T; READONLY valid, term: TokenSet) : BOOLEAN RAISES {Rd.Failure}= VAR current := t.lexer.current(); stop := valid + term; BEGIN ExpectedSet(t, valid); LOOP IF current IN stop THEN RETURN current IN valid; ELSE current := t.lexer.next(); END; END; END FindExpectedSet; <*INLINE*> PROCEDUREExpectSet ( t: T; READONLY valid: TokenSet; READONLY term := None) : BOOLEAN RAISES {Rd.Failure}= BEGIN IF t.lexer.current() IN valid THEN RETURN TRUE; ELSE RETURN FindExpectedSet(t, valid, term); END; END ExpectSet; PROCEDUREEndOfSequenceSet ( t: T; sep: Token; READONLY validTerm, continue, term: TokenSet) : BOOLEAN RAISES {Rd.Failure}=
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 = M3CToken.Semicolon; atSep := At(t, sep); BEGIN LOOP WITH current = t.lexer.current() DO IF current = sep THEN Unexpected(t); EVAL t.lexer.next(); 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*> PROCEDUREEndOfSequence ( t: T; sep, validTerm: Token; READONLY continue, term: TokenSet) : BOOLEAN RAISES {Rd.Failure}= BEGIN WITH result = EndOfSequenceSet(t, sep, TokenSet{validTerm}, continue, term) DO EVAL At(t, validTerm); RETURN result; END; END EndOfSequence; PROCEDUREId (t: T; id: M3AST_AS.ID) RAISES {Rd.Failure}= BEGIN Pos(t, id); IF t.lexer.current() = M3CToken.Identifier THEN id.lx_symrep := t.lexer.identifier(); EVAL t.lexer.next(); ELSE Expected(t, M3CToken.Identifier); END; END Id; PROCEDURESingleIdQualId ( t: T; id: M3CLex.Symbol_rep; pos: M3CSrcPos.T) : M3AST_AS.Qual_used_id RAISES {}= BEGIN VAR q: M3AST_AS.Qual_used_id := NEW(M3AST_AS.Qual_used_id).init(); BEGIN q.lx_srcpos := pos; q.as_id := NEW(M3AST_AS.Used_def_id).init(); q.as_id.lx_symrep := id; q.as_id.lx_srcpos := pos; t.lastSrcPosNode := q.as_id; RETURN q; END; END SingleIdQualId; PROCEDUREDoubleIdQualId ( t: T; id1, id2: M3CLex.Symbol_rep; pos1, pos2: M3CSrcPos.T) : M3AST_AS.Qual_used_id RAISES {}= BEGIN VAR q: M3AST_AS.Qual_used_id := NEW(M3AST_AS.Qual_used_id).init(); BEGIN q.lx_srcpos := pos1; q.as_intf_id := NEW(M3AST_AS.Used_interface_id).init(); q.as_intf_id.lx_symrep := id1; q.as_intf_id.lx_srcpos := pos1; q.as_id := NEW(M3AST_AS.Used_def_id).init(); q.as_id.lx_symrep := id2; q.as_id.lx_srcpos := pos2; t.lastSrcPosNode := q.as_id; RETURN q; END; END DoubleIdQualId; PROCEDUREQualId (t: T): M3AST_AS.Qual_used_id RAISES {Rd.Failure}= VAR id1 := t.lexer.identifier(); pos1 := t.lexer.position(); BEGIN IF NOT MustBeAt(t, M3CToken.Identifier) THEN id1 := NIL END; IF At(t, M3CToken.Dot) THEN VAR id2 := t.lexer.identifier(); pos2 := t.lexer.position(); BEGIN IF NOT MustBeAt(t, M3CToken.Identifier) THEN id2 := NIL END; RETURN DoubleIdQualId(t, id1, id2, pos1, pos2); END; ELSE RETURN SingleIdQualId(t, id1, pos1); END; END QualId; PROCEDURENamedType (q: M3AST_AS.Qual_used_id): M3AST_AS.Named_type RAISES {}= VAR n: M3AST_AS.Named_type := NEW(M3AST_AS.Named_type).init(); BEGIN n.lx_srcpos := q.lx_srcpos; n.as_qual_id := q; RETURN n; END NamedType; PROCEDUREArray ( t: T; READONLY term: TokenSet) : M3AST_AS.Array_type RAISES {Rd.Failure}= VAR a: M3AST_AS.Array_type := NEW(M3AST_AS.Array_type).init(); BEGIN Pos(t, a, TRUE); a.as_indextype_s := SeqM3AST_AS_M3TYPE.Null; IF NOT At(t, M3CToken.OF_) THEN WITH arrayTerm = term + TokenSet{M3CToken.Comma, M3CToken.OF_} + StartOfType DO REPEAT SeqM3AST_AS_M3TYPE.AddRear(a.as_indextype_s, Type(t, arrayTerm)); UNTIL EndOfSequence(t, M3CToken.Comma, M3CToken.OF_, StartOfType, arrayTerm); END; END; a.as_elementtype := Type(t, term); RETURN a; END Array; PROCEDUREPacked ( t: T; READONLY term: TokenSet) : M3AST_AS.Packed_type RAISES {Rd.Failure}= VAR packedTerm := term + TokenSet{M3CToken.FOR_} + StartOfType; p: M3AST_AS.Packed_type := NEW(M3AST_AS.Packed_type).init(); BEGIN Pos(t, p, TRUE); p.as_exp := Expr(t, packedTerm); EVAL Expect(t, M3CToken.FOR_, packedTerm); p.as_type := Type(t, term); RETURN p; END Packed; PROCEDURETypeAndOrDefault ( t: T; READONLY term: TokenSet; VAR default: M3AST_AS.EXP_NULL) : M3AST_AS.M3TYPE_NULL RAISES {Rd.Failure}= VAR type: M3AST_AS.M3TYPE_NULL := NIL; typeTerm := term + TokenSet{M3CToken.Becomes} + StartOfExpression; BEGIN default := NIL; IF At(t, M3CToken.Colon) THEN type := Type(t, typeTerm); ELSIF t.lexer.current() IN StartOfExpression THEN TYPECASE Expr(t, typeTerm, TRUE) OF <*NOWARN*> | M3AST_AS.M3TYPE(m3Type) => type := m3Type; | M3AST_AS.EXP(exp) => default := exp; END; END; IF default = NIL THEN WITH at = LenientAt(t, M3CToken.Becomes, M3CToken.Equal) DO IF at OR t.lexer.current() IN StartOfExpression - IdAsSet THEN IF NOT at THEN Expected(t, M3CToken.Becomes) END; default := Expr(t, term); END; END; END; IF type = NIL AND default = NIL THEN RETURN NEW(M3AST_AS.Bad_M3TYPE).init(); ELSE RETURN type; END; END TypeAndOrDefault; PROCEDUREFields ( t: T; READONLY validTerm, term: TokenSet) : SeqM3AST_AS_Fields.T RAISES {Rd.Failure}= VAR seqFields := SeqM3AST_AS_Fields.Null; CONST PossibleStartOfField = StartOfType + StartOfExpression + TokenSet{M3CToken.Identifier, M3CToken.Colon, M3CToken.Becomes}; BEGIN WITH fieldTerm = validTerm + term + TokenSet{M3CToken.Semicolon} + PossibleStartOfField DO REPEAT VAR fields: M3AST_AS.Fields := NEW(M3AST_AS.Fields).init(); BEGIN SeqM3AST_AS_Fields.AddRear(seqFields, fields); Pos(t, fields); fields.as_id_s := SeqM3AST_AS_Field_id.Null; (* IdList *) REPEAT VAR id: M3AST_AS.Field_id := NEW(M3AST_AS.Field_id).init(); BEGIN SeqM3AST_AS_Field_id.AddRear(fields.as_id_s, id); Id(t, id); END; UNTIL EndOfSequenceSet(t, M3CToken.Comma, TokenSet{M3CToken.Colon, M3CToken.Becomes}, IdAsSet, fieldTerm); (* ( ":=" Expr & ":" Type ) *) fields.as_type := TypeAndOrDefault(t, fieldTerm, fields.as_default); END; UNTIL EndOfSequenceSet(t, M3CToken.Semicolon, validTerm, PossibleStartOfField, term); END; RETURN seqFields; END Fields; PROCEDUREMethods ( t: T; READONLY validTerm, term: TokenSet) : SeqM3AST_AS_Method.T RAISES {Rd.Failure}= VAR methods := SeqM3AST_AS_Method.Null; CONST PossibleStartOfMethod = TokenSet{M3CToken.Identifier, M3CToken.Bra, M3CToken.Becomes}; BEGIN WITH methodTerm = validTerm + term + TokenSet{M3CToken.Semicolon} + PossibleStartOfMethod DO REPEAT VAR method: M3AST_AS.Method := NEW(M3AST_AS.Method).init(); BEGIN SeqM3AST_AS_Method.AddRear(methods, method); Pos(t, method); method.as_id := NEW(M3AST_AS.Method_id).init(); Id(t, method.as_id); WITH pos = t.lexer.position() DO method.as_type := Signature(t, methodTerm); method.as_type.lx_srcpos := pos; END; EVAL ExpectSet(t, methodTerm); IF LenientAt(t, M3CToken.Becomes, M3CToken.Equal) THEN method.as_default := Expr(t, methodTerm, FALSE); END; END; UNTIL EndOfSequenceSet(t, M3CToken.Semicolon, validTerm, PossibleStartOfMethod, term); END; RETURN methods; END Methods; PROCEDUREOverrides ( t: T; READONLY validTerm, term: TokenSet) : SeqM3AST_AS_Override.T RAISES {Rd.Failure}= VAR overrides := SeqM3AST_AS_Override.Null; CONST PossibleStartOfOverride = TokenSet{M3CToken.Identifier, M3CToken.Becomes}; BEGIN WITH overrideTerm = validTerm + term + TokenSet{M3CToken.Semicolon} + PossibleStartOfOverride DO REPEAT VAR override: M3AST_AS.Override := NEW(M3AST_AS.Override).init(); BEGIN SeqM3AST_AS_Override.AddRear(overrides, override); Pos(t, override); override.as_id := NEW(M3AST_AS.Override_id).init(); Id(t, override.as_id); IF LenientMustBeAt(t, M3CToken.Becomes, M3CToken.Equal) THEN override.as_default := Expr(t, overrideTerm, FALSE); ELSE override.as_default := NEW(M3AST_AS.Bad_EXP).init(); END; END; UNTIL EndOfSequenceSet(t, M3CToken.Semicolon, validTerm, PossibleStartOfOverride, term); END; RETURN overrides; END Overrides; PROCEDUREObjectCheck ( t: T; READONLY term: TokenSet; ancestor: M3AST_AS.M3TYPE) : M3AST_AS.M3TYPE RAISES {Rd.Failure}= VAR token := t.lexer.current(); BEGIN IF token = M3CToken.OBJECT_ THEN RETURN Object(t, term, ancestor); ELSIF token = M3CToken.BRANDED_ THEN RETURN Branded(t, term, ancestor := ancestor); ELSE RETURN ancestor; END; (* if *) END ObjectCheck; PROCEDUREObject ( t: T; READONLY term: TokenSet; ancestor: M3AST_AS.M3TYPE := NIL; brand: M3AST_AS.Brand := NIL) : M3AST_AS.Object_type RAISES {Rd.Failure}= CONST MethodsOrOverrides = TokenSet{M3CToken.METHODS_, M3CToken.OVERRIDES_}; MethodsOrOverridesOrEnd = MethodsOrOverrides + EndAsSet; OverridesOrEnd = TokenSet{M3CToken.OVERRIDES_} + EndAsSet; VAR o: M3AST_AS.Object_type := NEW(M3AST_AS.Object_type).init(); BEGIN Pos(t, o, TRUE); o.as_ancestor := ancestor; o.as_brand := brand; IF t.lexer.current() # M3CToken.END_ THEN IF NOT(t.lexer.current() IN MethodsOrOverrides) THEN o.as_fields_s := Fields(t, MethodsOrOverridesOrEnd, term); ELSE o.as_fields_s := SeqM3AST_AS_Fields.Null; END; IF At(t, M3CToken.METHODS_) AND t.lexer.current() # M3CToken.END_ THEN o.as_method_s := Methods(t, OverridesOrEnd, term); ELSE o.as_method_s := SeqM3AST_AS_Method.Null; END; IF At(t, M3CToken.OVERRIDES_) AND t.lexer.current() # M3CToken.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); RETURN ObjectCheck(t, term, o); END Object; CONST PossibleStartOfFormal = StartOfType + StartOfExpression + TokenSet{M3CToken.VALUE_, M3CToken.VAR_, M3CToken.READONLY_} + TokenSet{M3CToken.Identifier, M3CToken.Colon, M3CToken.Becomes}; PROCEDURENewF_Value_id (): M3AST_AS.FORMAL_ID RAISES {}= BEGIN RETURN NEW(M3AST_AS.F_Value_id).init(); END NewF_Value_id; PROCEDURENewF_Readonly_id (): M3AST_AS.FORMAL_ID RAISES {}= BEGIN RETURN NEW(M3AST_AS.F_Readonly_id).init(); END NewF_Readonly_id; PROCEDURENewF_Var_id (): M3AST_AS.FORMAL_ID RAISES {}= BEGIN RETURN NEW(M3AST_AS.F_Var_id).init(); END NewF_Var_id; PROCEDUREFormals ( t: T; READONLY term: TokenSet) : SeqM3AST_AS_Formal_param.T RAISES {Rd.Failure}= VAR formals := SeqM3AST_AS_Formal_param.Null; BEGIN IF NOT At(t, M3CToken.Ket) THEN WITH formalTerm = term + TokenSet{M3CToken.Ket, M3CToken.Semicolon} + PossibleStartOfFormal DO REPEAT VAR create: PROCEDURE(): M3AST_AS.FORMAL_ID RAISES {}; formal: M3AST_AS.Formal_param := NEW(M3AST_AS.Formal_param).init(); BEGIN SeqM3AST_AS_Formal_param.AddRear(formals, formal); Pos(t, formal); formal.as_id_s := SeqM3AST_AS_FORMAL_ID.Null; IF At(t, M3CToken.VAR_) THEN create := NewF_Var_id; ELSIF At(t, M3CToken.READONLY_) THEN create := NewF_Readonly_id; ELSE EVAL At(t, M3CToken.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, M3CToken.Comma, TokenSet{M3CToken.Colon, M3CToken.Becomes}, IdAsSet, formalTerm); (* ( ":=" Expr & ":" Type ) *) formal.as_formal_type := TypeAndOrDefault(t, formalTerm, formal.as_default); END; UNTIL EndOfSequence(t, M3CToken.Semicolon, M3CToken.Ket, PossibleStartOfFormal, term); END; END; RETURN formals; END Formals; PROCEDURESignature ( t: T; READONLY term: TokenSet) : M3AST_AS.Procedure_type RAISES {Rd.Failure}= VAR p: M3AST_AS.Procedure_type := NEW(M3AST_AS.Procedure_type).init(); BEGIN EVAL Expect(t, M3CToken.Bra, term + PossibleStartOfFormal + TokenSet{M3CToken.Ket, M3CToken.Colon, M3CToken.RAISES_}); p.as_formal_param_s := Formals(t, term + TokenSet{M3CToken.Colon, M3CToken.RAISES_}); WITH atColon = At(t, M3CToken.Colon) DO IF atColon OR t.lexer.current() IN StartOfType THEN IF NOT atColon THEN Expected(t, M3CToken.Colon) END; p.as_result_type := Type(t, term + TokenSet{M3CToken.RAISES_}); END; END; IF t.lexer.current() = M3CToken.RAISES_ THEN WITH pos = t.lexer.position() DO EVAL t.lexer.next(); IF At(t, M3CToken.ANY_) THEN p.as_raises := NEW(M3AST_AS.Raisees_any).init(); ELSE p.as_raises := NEW(M3AST_AS.Raisees_some).init(); WITH r = NARROW(p.as_raises, M3AST_AS.Raisees_some) DO r.as_raisees_s := SeqM3AST_AS_Qual_used_id.Null; EVAL Expect(t, M3CToken.CurlyBra, term); IF NOT At(t, M3CToken.CurlyKet) THEN REPEAT SeqM3AST_AS_Qual_used_id.AddRear( r.as_raisees_s, QualId(t)); UNTIL EndOfSequence(t, M3CToken.Comma, M3CToken.CurlyKet, IdAsSet, term); END; END; END; p.as_raises.lx_srcpos := pos; END; END; RETURN p; END Signature; PROCEDUREProcedureType ( t: T; READONLY term: TokenSet) : M3AST_AS.Procedure_type RAISES {Rd.Failure}= VAR pos := t.lexer.position(); BEGIN EVAL t.lexer.next(); WITH p = Signature(t, term) DO p.lx_srcpos := pos; RETURN p; END; END ProcedureType; PROCEDURERecord ( t: T; READONLY term: TokenSet) : M3AST_AS.Record_type RAISES {Rd.Failure}= VAR r: M3AST_AS.Record_type := NEW(M3AST_AS.Record_type).init(); BEGIN Pos(t, r, TRUE); IF t.lexer.current() # M3CToken.END_ THEN r.as_fields_s := Fields(t, EndAsSet, term); ELSE r.as_fields_s := SeqM3AST_AS_Fields.Null; END; EndPos(t); RETURN r; END Record; PROCEDURERef ( t: T; READONLY term: TokenSet; untraced: M3AST_AS.Untraced := NIL; brand: M3AST_AS.Brand := NIL) : M3AST_AS.Ref_type RAISES {Rd.Failure}= VAR r: M3AST_AS.Ref_type := NEW(M3AST_AS.Ref_type).init(); BEGIN Pos(t, r, TRUE); r.as_trace_mode := untraced; r.as_brand := brand; r.as_type := Type(t, term); RETURN r; END Ref; PROCEDURESet ( t: T; READONLY term: TokenSet) : M3AST_AS.Set_type RAISES {Rd.Failure}= VAR s: M3AST_AS.Set_type := NEW(M3AST_AS.Set_type).init(); BEGIN Pos(t, s, TRUE); EVAL Expect(t, M3CToken.OF_, term + StartOfType); s.as_type := Type(t, term); RETURN s; END Set; PROCEDUREBranded ( t: T; READONLY term: TokenSet; untraced: M3AST_AS.Untraced := NIL; ancestor: M3AST_AS.M3TYPE := NIL) : M3AST_AS.M3TYPE RAISES {Rd.Failure}= VAR b: M3AST_AS.Brand := NEW(M3AST_AS.Brand).init(); CONST StartOfBrandName = TokenSet{M3CToken.TextLiteral, M3CToken.Identifier}; BEGIN Pos(t, b, TRUE); VAR expected: TokenSet; object := FALSE; type: M3AST_AS.M3TYPE; BEGIN IF ancestor # NIL THEN expected := TokenSet{M3CToken.OBJECT_}; ELSIF untraced # NIL THEN expected := TokenSet{M3CToken.REF_}; ELSE expected := TokenSet{M3CToken.OBJECT_, M3CToken.REF_}; END; IF t.lexer.current() IN StartOfBrandName THEN b.as_exp := Expr(t, term + expected); END; EVAL ExpectSet(t, expected, term + StartOfType); CASE t.lexer.current() OF <*NOWARN*> | M3CToken.OBJECT_ => type := Object(t, term, ancestor, b); object := TRUE; | M3CToken.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; PROCEDUREUntraced ( t: T; READONLY term: TokenSet) : M3AST_AS.M3TYPE RAISES {Rd.Failure}= CONST PossiblyUntraced = TokenSet{M3CToken.REF_, M3CToken.BRANDED_, M3CToken.ROOT_}; VAR u := NEW(M3AST_AS.Untraced).init(); BEGIN Pos(t, u, TRUE); EVAL ExpectSet(t, PossiblyUntraced, term + StartOfType); CASE t.lexer.current() OF | M3CToken.REF_ => RETURN Ref(t, term, u); | M3CToken.BRANDED_ => RETURN Branded(t, term, u); | M3CToken.ROOT_ => VAR root: M3AST_AS.Root_type := NEW(M3AST_AS.Root_type).init(); BEGIN Pos(t, root, TRUE); root.as_trace_mode := u; RETURN root; END; ELSE RETURN Type(t, term); END; (* if *) END Untraced; PROCEDUREEnumeration ( t: T; READONLY term: TokenSet) : M3AST_AS.Enumeration_type RAISES {Rd.Failure}= VAR e: M3AST_AS.Enumeration_type := NEW(M3AST_AS.Enumeration_type).init(); BEGIN Pos(t, e, TRUE); e.as_id_s := SeqM3AST_AS_Enum_id.Null; IF NOT At(t, M3CToken.CurlyKet) THEN REPEAT VAR id: M3AST_AS.Enum_id := NEW(M3AST_AS.Enum_id).init(); BEGIN SeqM3AST_AS_Enum_id.AddRear(e.as_id_s, id); Id(t, id); END; UNTIL EndOfSequence(t, M3CToken.Comma, M3CToken.CurlyKet, IdAsSet, term); END; RETURN e; END Enumeration; PROCEDURERange (exp1, exp2: M3AST_AS.EXP): M3AST_AS.Range RAISES {}= VAR r: M3AST_AS.Range := NEW(M3AST_AS.Range).init(); BEGIN r.lx_srcpos := exp1.lx_srcpos; r.as_exp1 := exp1; r.as_exp2 := exp2; RETURN r; END Range; PROCEDURESubrange ( t: T; READONLY term: TokenSet) : M3AST_AS.Subrange_type RAISES {Rd.Failure}= VAR s: M3AST_AS.Subrange_type := NEW(M3AST_AS.Subrange_type).init(); BEGIN Pos(t, s, TRUE); WITH secondExprTerm = term + TokenSet{M3CToken.SquareKet}, firstExprTerm = secondExprTerm + TokenSet{M3CToken.Range} + StartOfExpression, exp1 = Expr(t, firstExprTerm) DO EVAL Expect(t, M3CToken.Range, firstExprTerm); s.as_range := Range(exp1, Expr(t, secondExprTerm)); EVAL Expect(t, M3CToken.SquareKet, secondExprTerm); END; RETURN s; END Subrange; PROCEDUREType ( t: T; READONLY term: TokenSet) : M3AST_AS.M3TYPE RAISES {Rd.Failure}= BEGIN IF ExpectSet(t, StartOfType, term) THEN VAR type: M3AST_AS.M3TYPE; BEGIN CASE t.lexer.current() OF <*NOWARN*> | M3CToken.Identifier => type := NamedType(QualId(t)); | M3CToken.ADDRESS_ => VAR address: M3AST_AS.Address_type := NEW(M3AST_AS.Address_type).init(); BEGIN Pos(t, address, TRUE); type := address; END; | M3CToken.ARRAY_ => type := Array(t, term); | M3CToken.BITS_ => type := Packed(t, term); | M3CToken.INTEGER_ => VAR integer: M3AST_AS.Integer_type := NEW(M3AST_AS.Integer_type).init(); BEGIN Pos(t, integer, TRUE); type := integer; END; | M3CToken.LONGINT_ => VAR longint: M3AST_AS.Longint_type := NEW(M3AST_AS.Longint_type).init(); BEGIN Pos(t, longint, TRUE); type := longint; END; | M3CToken.WIDECHAR_ => VAR widechar: M3AST_AS.WideChar_type := NEW(M3AST_AS.WideChar_type).init(); BEGIN Pos(t, widechar, TRUE); type := widechar; END; | M3CToken.LONGREAL_ => VAR longreal: M3AST_AS.LongReal_type := NEW(M3AST_AS.LongReal_type).init(); BEGIN Pos(t, longreal, TRUE); type := longreal; END; | M3CToken.EXTENDED_ => VAR extended: M3AST_AS.Extended_type := NEW(M3AST_AS.Extended_type).init(); BEGIN Pos(t, extended, TRUE); type := extended; END; | M3CToken.NULL_ => VAR null: M3AST_AS.Null_type := NEW(M3AST_AS.Null_type).init(); BEGIN Pos(t, null, TRUE); type := null; END; | M3CToken.OBJECT_ => type := Object(t, term); | M3CToken.PROCEDURE_ => type := ProcedureType(t, term); | M3CToken.REAL_ => VAR real: M3AST_AS.Real_type := NEW(M3AST_AS.Real_type).init(); BEGIN Pos(t, real, TRUE); type := real; END; | M3CToken.RECORD_ => type := Record(t, term); | M3CToken.REF_ => type := Ref(t, term); | M3CToken.REFANY_ => VAR refany: M3AST_AS.RefAny_type := NEW(M3AST_AS.RefAny_type).init(); BEGIN Pos(t, refany, TRUE); type := refany; END; | M3CToken.ROOT_ => VAR root: M3AST_AS.Root_type := NEW(M3AST_AS.Root_type).init(); BEGIN Pos(t, root, TRUE); type := root; END; | M3CToken.SET_ => type := Set(t, term); | M3CToken.BRANDED_ => type := Branded(t, term); | M3CToken.UNTRACED_ => type := Untraced(t, term); | M3CToken.CurlyBra => type := Enumeration(t, term); | M3CToken.SquareBra => type := Subrange(t, term); | M3CToken.Bra => EVAL t.lexer.next(); type := Type(t, term + TokenSet{M3CToken.Ket}); EVAL Expect(t, M3CToken.Ket, term); END; (* case *) type := ObjectCheck(t, term, type); EVAL ExpectSet(t, term); RETURN type; END; ELSE RETURN NEW(M3AST_AS.Bad_M3TYPE).init(); END; END Type; PROCEDURENewNumericLiteral (token: Token): M3AST_AS.NUMERIC_LITERAL RAISES {}= BEGIN CASE token OF <*NOWARN*> | M3CToken.IntegerLiteral => RETURN NEW(M3AST_AS.Integer_literal).init(); | M3CToken.LongintLiteral => RETURN NEW(M3AST_AS.Longint_literal).init(); | M3CToken.RealLiteral => RETURN NEW(M3AST_AS.Real_literal).init(); | M3CToken.LongRealLiteral => RETURN NEW(M3AST_AS.LongReal_literal).init(); | M3CToken.ExtendedLiteral => RETURN NEW(M3AST_AS.Extended_literal).init(); END; (* case *) END NewNumericLiteral; PROCEDUREE8 ( t: T; READONLY term: TokenSet) : M3AST_AS.EXP_TYPE RAISES {Rd.Failure}= CONST NumericLiterals = TokenSet{ M3CToken.IntegerLiteral, M3CToken.LongintLiteral, M3CToken.RealLiteral, M3CToken.LongRealLiteral, M3CToken.ExtendedLiteral}; VAR token := t.lexer.current(); result: M3AST_AS.EXP_TYPE; BEGIN CASE token OF | ORD(FIRST(M3CToken.Literal))..ORD(LAST(M3CToken.Literal)) => IF token IN NumericLiterals THEN WITH numeric = NewNumericLiteral(token) DO numeric.lx_litrep := t.lexer.literal(); result := numeric; END; ELSIF token = M3CToken.TextLiteral THEN VAR text: M3AST_AS.Text_literal := NEW(M3AST_AS.Text_literal).init(); BEGIN text.lx_litrep := t.lexer.literal(); result := text; END; ELSIF token = M3CToken.WideTextLiteral THEN VAR text: M3AST_AS.WideText_literal := NEW(M3AST_AS.WideText_literal).init(); BEGIN text.lx_litrep := t.lexer.literal(); result := text; END; ELSIF token = M3CToken.CharLiteral THEN VAR char: M3AST_AS.Char_literal := NEW(M3AST_AS.Char_literal).init(); BEGIN char.lx_litrep := t.lexer.literal(); result := char; END; ELSE <*ASSERT token = M3CToken.WideCharLiteral*> VAR char: M3AST_AS.WideChar_literal := NEW(M3AST_AS.WideChar_literal).init(); BEGIN char.lx_litrep := t.lexer.literal(); result := char; END; END; Pos(t, result, TRUE); | M3CToken.NIL_ => VAR nil: M3AST_AS.Nil_literal := NEW(M3AST_AS.Nil_literal).init(); BEGIN Pos(t, nil, TRUE); nil.lx_litrep := t.nil_litrep; result := nil; END; | M3CToken.Identifier => VAR expUsedId: M3AST_AS.Exp_used_id := NEW(M3AST_AS.Exp_used_id).init(); BEGIN Pos(t, expUsedId); Id(t, expUsedId.vUSED_ID); t.lastSrcPosNode := expUsedId; (* cos Id sets it wrong *) result := expUsedId; END; | M3CToken.Bra => EVAL t.lexer.next(); result := Expr(t, term + TokenSet{M3CToken.Ket}, TRUE); EVAL Expect(t, M3CToken.Ket, term); ELSE result := Type(t, term); END; (* case *) EVAL ExpectSet(t, term); RETURN result; END E8; PROCEDURESelect ( t: T; lhs: M3AST_AS.EXP) : M3AST_AS.Select RAISES {Rd.Failure}= VAR s: M3AST_AS.Select := NEW(M3AST_AS.Select).init(); expUsedId: M3AST_AS.Exp_used_id := NEW(M3AST_AS.Exp_used_id).init(); BEGIN Pos(t, s, TRUE); Id(t, expUsedId.vUSED_ID); expUsedId.lx_srcpos := expUsedId.vUSED_ID.lx_srcpos; t.lastSrcPosNode := expUsedId; s.as_exp := lhs; s.as_id := expUsedId; RETURN s; END Select; PROCEDUREIndex ( t: T; READONLY term: TokenSet; array: M3AST_AS.EXP) : M3AST_AS.Index RAISES {Rd.Failure}= VAR i: M3AST_AS.Index := NEW(M3AST_AS.Index).init(); BEGIN EVAL t.lexer.next(); i.lx_srcpos := array.lx_srcpos; i.as_array := array; i.as_exp_s := SeqM3AST_AS_EXP.Null; WITH indexTerm = term + TokenSet{M3CToken.Comma, M3CToken.SquareKet} + StartOfExpression DO REPEAT SeqM3AST_AS_EXP.AddRear(i.as_exp_s, Expr(t, indexTerm)); UNTIL EndOfSequence(t, M3CToken.Comma, M3CToken.SquareKet, StartOfExpression, term); END; RETURN i; END Index; PROCEDURECall ( t: T; READONLY term: TokenSet; callexp: M3AST_AS.EXP) : M3AST_AS.Call RAISES {Rd.Failure}= CONST PossibleStartOfActual = StartOfExpression + TokenSet{M3CToken.Identifier, M3CToken.Comma, M3CToken.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 := NEW(M3AST_AS.NEWCall).init(); END; (* if *) ELSE END; (* typecase *) IF c = NIL THEN c := NEW(M3AST_AS.Call).init() END; EVAL t.lexer.next(); c.lx_srcpos := callexp.lx_srcpos; c.as_callexp := callexp; c.as_param_s := SeqM3AST_AS_Actual.Null; IF NOT At(t, M3CToken.Ket) THEN WITH actualTerm = term + TokenSet{M3CToken.Ket} + PossibleStartOfActual DO REPEAT VAR actual: M3AST_AS.Actual := NEW(M3AST_AS.Actual).init(); expType := Expr(t, actualTerm, TRUE); BEGIN SeqM3AST_AS_Actual.AddRear(c.as_param_s, actual); actual.lx_srcpos := expType.lx_srcpos; IF ISTYPE(expType, M3AST_AS.EXP) AND At(t, M3CToken.Becomes) THEN actual.as_id := expType; actual.as_exp_type := Expr(t, actualTerm); ELSE actual.as_exp_type := expType; END; END; UNTIL EndOfSequence(t, M3CToken.Comma, M3CToken.Ket, PossibleStartOfActual, actualTerm); END; END; RETURN c; END Call; PROCEDURERangeExp (exp: M3AST_AS.EXP): M3AST_AS.Range_EXP RAISES {}= BEGIN VAR new: M3AST_AS.Range_EXP := NEW(M3AST_AS.Range_EXP).init(); BEGIN new.lx_srcpos := exp.lx_srcpos; new.as_exp := exp; RETURN new; END; END RangeExp; PROCEDUREConstructor ( t: T; READONLY term: TokenSet; type: M3AST_AS.M3TYPE) : M3AST_AS.Constructor RAISES {Rd.Failure}= VAR c: M3AST_AS.Constructor := NEW(M3AST_AS.Constructor).init(); BEGIN EVAL t.lexer.next(); c.lx_srcpos := type.lx_srcpos; c.as_type := type; c.as_element_s := SeqM3AST_AS_CONS_ELEM.Null; IF NOT At(t, M3CToken.CurlyKet) THEN CONST PossibleStartOfElement = StartOfExpression + TokenSet{M3CToken.Identifier, M3CToken.Comma, M3CToken.Becomes, M3CToken.Range}; VAR first := TRUE; elementTerm := term + TokenSet{M3CToken.CurlyKet} + PossibleStartOfElement; BEGIN REPEAT IF NOT first AND t.lexer.current() = M3CToken.Range THEN c.as_propagate := NEW(M3AST_AS.Propagate).init(); Pos(t, c.as_propagate, TRUE); IF Expect(t, M3CToken.CurlyKet, elementTerm) THEN EXIT END; IF NOT t.lexer.current() IN PossibleStartOfElement THEN EXIT END; ELSE VAR element: M3AST_AS.CONS_ELEM; expr := Expr(t, elementTerm); BEGIN IF At(t, M3CToken.Becomes) THEN VAR actualElem: M3AST_AS.Actual_elem := NEW(M3AST_AS.Actual_elem).init(); BEGIN VAR actual: M3AST_AS.Actual := NEW(M3AST_AS.Actual).init(); BEGIN 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 VAR rangeExpElem: M3AST_AS.RANGE_EXP_elem := NEW(M3AST_AS.RANGE_EXP_elem).init(); BEGIN rangeExpElem.lx_srcpos := expr.lx_srcpos; IF At(t, M3CToken.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, M3CToken.Comma, M3CToken.CurlyKet, PossibleStartOfElement, elementTerm); END; END; RETURN c; END Constructor; EXCEPTION IsType(M3AST_AS.M3TYPE); PROCEDUREIsId (e: M3AST_AS.EXP): BOOLEAN RAISES {}= BEGIN TYPECASE e OF <*NOWARN*> | M3AST_AS.Exp_used_id => RETURN TRUE; | M3AST_AS.Select(b) => RETURN ISTYPE(b.as_exp, M3AST_AS.Exp_used_id); ELSE RETURN FALSE; END; END IsId; PROCEDUREEXP_TYPEToM3TYPE ( t: T; e: M3AST_AS.EXP_TYPE) : M3AST_AS.M3TYPE RAISES {}= BEGIN TYPECASE e OF <*NOWARN*> | 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.Select(select) => VAR e := select.as_exp; id := select.as_id; BEGIN RETURN NamedType(DoubleIdQualId(t, NARROW(e, M3AST_AS.Exp_used_id).vUSED_ID.lx_symrep, id.vUSED_ID.lx_symrep, e.lx_srcpos, id.lx_srcpos)); END; END; (* typecase *) END EXP_TYPEToM3TYPE; PROCEDUREE7 ( t: T; READONLY term: TokenSet; canBeType := FALSE) : M3AST_AS.EXP RAISES {Rd.Failure, IsType}= VAR e7Term := term + TokenSet{M3CToken.Dereference, M3CToken.Dot, M3CToken.SquareBra, M3CToken.Bra}; e7FullTerm := e7Term + TokenSet{M3CToken.CurlyBra, M3CToken.OBJECT_, M3CToken.BRANDED_}; bra := (t.lexer.current() = M3CToken.Bra); e8 := E8(t, e7FullTerm); token := t.lexer.current(); e8IsType := ISTYPE(e8, M3AST_AS.M3TYPE); e8MayBeType := e8IsType OR IsId(e8); BEGIN IF token = M3CToken.Dot AND e8MayBeType AND NOT (e8IsType OR bra) THEN e8 := Select(t, e8); EVAL ExpectSet(t, e7FullTerm); token := t.lexer.current(); END; IF e8MayBeType AND canBeType AND token IN TokenSet{M3CToken.OBJECT_, M3CToken.BRANDED_} THEN WHILE token IN TokenSet{M3CToken.OBJECT_, M3CToken.BRANDED_} DO e8IsType := TRUE; e8 := ObjectCheck(t, e7FullTerm, EXP_TYPEToM3TYPE(t, e8)); EVAL ExpectSet(t, e7FullTerm); token := t.lexer.current(); END; ELSIF token = M3CToken.CurlyBra THEN IF e8MayBeType THEN e8 := Constructor(t, e7Term, EXP_TYPEToM3TYPE(t, e8)); END; EVAL ExpectSet(t, e7Term); token := t.lexer.current(); ELSIF e8IsType THEN IF canBeType THEN RAISE IsType(e8); ELSE EVAL MustBeAt(t, M3CToken.CurlyBra); e8 := NEW(M3AST_AS.Bad_EXP).init(); END; END; VAR result: M3AST_AS.EXP := e8; BEGIN LOOP CASE token OF | M3CToken.Dereference => VAR d: M3AST_AS.Deref := NEW(M3AST_AS.Deref).init(); BEGIN d.as_exp := result; Pos(t, d, TRUE); result := d; END; | M3CToken.Dot => result := Select(t, result); | M3CToken.SquareBra => result := Index(t, e7Term, result); | M3CToken.Bra => result := Call(t, e7Term, result); ELSE EXIT; END; (* case *) EVAL ExpectSet(t, e7Term); token := t.lexer.current(); END; (* loop *) RETURN result; END; END E7; PROCEDUREE6 ( t: T; READONLY term: TokenSet; canBeType := FALSE) : M3AST_AS.EXP RAISES {Rd.Failure, IsType}= VAR current := t.lexer.current(); BEGIN IF current IN TokenSet{M3CToken.Plus, M3CToken.Minus} THEN VAR unary: M3AST_AS.UNARY; BEGIN IF current = M3CToken.Plus THEN unary := NEW(M3AST_AS.Unaryplus).init(); ELSE unary := NEW(M3AST_AS.Unaryminus).init(); END; Pos(t, unary, TRUE); unary.as_exp := E6(t, term); RETURN unary; END; ELSE RETURN E7(t, term, canBeType); END; END E6; PROCEDUREE5 ( t: T; READONLY term: TokenSet; canBeType := FALSE) : M3AST_AS.EXP RAISES {Rd.Failure, IsType}= CONST Mulop = TokenSet{M3CToken.Times, M3CToken.Divide, M3CToken.DIV_, M3CToken.MOD_}; VAR e5Term := term + Mulop; result := E6(t, e5Term, canBeType); BEGIN LOOP WITH current = t.lexer.current() DO IF current IN Mulop THEN VAR binary: M3AST_AS.BINARY; BEGIN CASE current OF <*NOWARN*> | M3CToken.Times => binary := NEW(M3AST_AS.Times).init(); | M3CToken.Divide => binary := NEW(M3AST_AS.Rdiv).init(); | M3CToken.DIV_ => binary := NEW(M3AST_AS.Div).init(); | M3CToken.MOD_ => binary := NEW(M3AST_AS.Mod).init(); END; Pos(t, binary, TRUE); binary.as_exp1 := result; binary.as_exp2 := E6(t, e5Term); result := binary; END; ELSE RETURN result; END; END; END; END E5; PROCEDUREE4 ( t: T; READONLY term: TokenSet; canBeType := FALSE) : M3AST_AS.EXP RAISES {Rd.Failure, IsType}= CONST Addop = TokenSet{M3CToken.Plus, M3CToken.Minus, M3CToken.Ampersand}; VAR e4Term := term + Addop; result := E5(t, e4Term, canBeType); BEGIN LOOP WITH current = t.lexer.current() DO IF current IN Addop THEN VAR binary: M3AST_AS.BINARY; BEGIN CASE current OF <*NOWARN*> | M3CToken.Plus => binary := NEW(M3AST_AS.Plus).init(); | M3CToken.Minus => binary := NEW(M3AST_AS.Minus).init(); | M3CToken.Ampersand => binary := NEW(M3AST_AS.Textcat).init(); END; Pos(t, binary, TRUE); binary.as_exp1 := result; binary.as_exp2 := E5(t, e4Term); result := binary; END; ELSE RETURN result; END; END; END; END E4; PROCEDUREE3 ( t: T; READONLY term: TokenSet; canBeType := FALSE) : M3AST_AS.EXP RAISES {Rd.Failure, IsType}= CONST Relop = TokenSet{M3CToken.Equal, M3CToken.NotEqual, M3CToken.LessThan, M3CToken.LessThanOrEqual, M3CToken.GreaterThan, M3CToken.GreaterThanOrEqual, M3CToken.IN_}; VAR e3Term := term + Relop; result := E4(t, e3Term, canBeType); BEGIN LOOP WITH current = t.lexer.current() DO IF current IN Relop THEN VAR binary: M3AST_AS.BINARY; BEGIN CASE current OF <*NOWARN*> | M3CToken.Equal => binary := NEW(M3AST_AS.Eq).init(); | M3CToken.NotEqual => binary := NEW(M3AST_AS.Ne).init(); | M3CToken.LessThan => binary := NEW(M3AST_AS.Lt).init(); | M3CToken.LessThanOrEqual => binary := NEW(M3AST_AS.Le).init(); | M3CToken.GreaterThan => binary := NEW(M3AST_AS.Gt).init(); | M3CToken.GreaterThanOrEqual => binary := NEW(M3AST_AS.Ge).init(); | M3CToken.IN_ => binary := NEW(M3AST_AS.In).init(); END; Pos(t, binary, TRUE); binary.as_exp1 := result; binary.as_exp2 := E4(t, e3Term); result := binary; END; ELSE RETURN result; END; END; END; END E3; PROCEDUREE2 ( t: T; READONLY term: TokenSet; canBeType := FALSE) : M3AST_AS.EXP RAISES {Rd.Failure, IsType}= BEGIN IF t.lexer.current() = M3CToken.NOT_ THEN VAR not: M3AST_AS.Not := NEW(M3AST_AS.Not).init(); BEGIN Pos(t, not, TRUE); not.as_exp := E2(t, term); RETURN not; END; ELSE RETURN E3(t, term, canBeType); END; END E2; PROCEDUREE1 ( t: T; READONLY term: TokenSet; canBeType := FALSE) : M3AST_AS.EXP RAISES {Rd.Failure, IsType}= VAR e1Term := term + TokenSet{M3CToken.AND_}; result := E2(t, e1Term, canBeType); BEGIN WHILE t.lexer.current() = M3CToken.AND_ DO VAR and: M3AST_AS.And := NEW(M3AST_AS.And).init(); BEGIN Pos(t, and, TRUE); and.as_exp1 := result; and.as_exp2 := E2(t, e1Term); result := and; END; END; RETURN result; END E1; PROCEDUREExpr ( t: T; READONLY term: TokenSet; canBeType := FALSE) : M3AST_AS.EXP_TYPE RAISES {Rd.Failure}= BEGIN IF ExpectSet(t, StartOfExpression, term) THEN TRY VAR exprTerm := term + TokenSet{M3CToken.OR_}; result := E1(t, exprTerm, canBeType); BEGIN WHILE t.lexer.current() = M3CToken.OR_ DO VAR or: M3AST_AS.Or := NEW(M3AST_AS.Or).init(); BEGIN Pos(t, or, TRUE); or.as_exp1 := result; or.as_exp2 := E1(t, exprTerm); result := or; END; END; RETURN result; END; EXCEPT | IsType(type) => RETURN type; END; ELSE RETURN NEW(M3AST_AS.Bad_EXP).init(); END; END Expr; PROCEDUREElse ( t: T; READONLY term: TokenSet;) : M3AST_AS.Else_stm_NULL RAISES {Rd.Failure}= BEGIN IF t.lexer.current() = M3CToken.ELSE_ THEN VAR e: M3AST_AS.Else_stm := NEW(M3AST_AS.Else_stm).init(); BEGIN Pos(t, e, TRUE); e.as_stm_s := StmtsThenEnd(t, term); RETURN e; END; ELSE EndPos(t); RETURN NIL; END; (* if *) END Else; PROCEDURECase ( t: T; READONLY term: TokenSet) : M3AST_AS.Case_st RAISES {Rd.Failure}= VAR possibleStartOfCase := StartOfExpression + StartOfStatement + TokenSet{M3CToken.Bar, M3CToken.Range, M3CToken.Implies}; caseTerm := term + possibleStartOfCase + TokenSet{M3CToken.END_, M3CToken.ELSE_}; caseLabelTerm := caseTerm + TokenSet{M3CToken.Comma}; case_st: M3AST_AS.Case_st := NEW(M3AST_AS.Case_st).init(); BEGIN Pos(t, case_st, TRUE); case_st.as_exp := Expr(t, caseTerm + TokenSet{M3CToken.OF_}); EVAL MustBeAt(t, M3CToken.OF_); case_st.as_case_s := SeqM3AST_AS_Case.Null; IF NOT t.lexer.current() IN TokenSet{M3CToken.ELSE_, M3CToken.END_} THEN EVAL At(t, M3CToken.Bar); REPEAT VAR case: M3AST_AS.Case := NEW(M3AST_AS.Case).init(); BEGIN 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, M3CToken.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, M3CToken.Comma, M3CToken.Implies, StartOfExpression + TokenSet{M3CToken.Range}, caseTerm); case.as_stm_s := Stmts(t, TokenSet{M3CToken.Bar, M3CToken.ELSE_, M3CToken.END_}, caseTerm); END; UNTIL EndOfSequenceSet(t, M3CToken.Bar, ElseOrEnd, possibleStartOfCase, caseTerm); END; case_st.as_else := Else(t, term); RETURN case_st; END Case; PROCEDUREExit (t: T): M3AST_AS.Exit_st RAISES {Rd.Failure}= VAR e := NEW(M3AST_AS.Exit_st).init(); BEGIN Pos(t, e, TRUE); RETURN e; END Exit; PROCEDUREEval ( t: T; READONLY term: TokenSet) : M3AST_AS.Eval_st RAISES {Rd.Failure}= VAR e: M3AST_AS.Eval_st := NEW(M3AST_AS.Eval_st).init(); BEGIN Pos(t, e, TRUE); e.as_exp := Expr(t, term); RETURN e; END Eval; PROCEDUREFor ( t: T; READONLY term: TokenSet) : M3AST_AS.For_st RAISES {Rd.Failure}= VAR forTerm := term + StartOfStatement + TokenSet{M3CToken.TO_, M3CToken.BY_, M3CToken.DO_, M3CToken.END_}; f: M3AST_AS.For_st := NEW(M3AST_AS.For_st).init(); BEGIN Pos(t, f, TRUE); f.as_id := NEW(M3AST_AS.For_id).init(); Id(t, f.as_id); EVAL Expect(t, M3CToken.Becomes, forTerm); f.as_from := Expr(t, forTerm); EVAL Expect(t, M3CToken.TO_, forTerm); f.as_to := Expr(t, forTerm - TokenSet{M3CToken.TO_}); IF t.lexer.current() = M3CToken.BY_ THEN f.as_by := NEW(M3AST_AS.By).init(); Pos(t, f.as_by, TRUE); f.as_by.as_exp := Expr(t, forTerm - TokenSet{M3CToken.TO_, M3CToken.BY_}); END; EVAL Expect(t, M3CToken.DO_, forTerm - TokenSet{M3CToken.TO_, M3CToken.BY_}); f.as_stm_s := StmtsThenEnd(t, term); RETURN f; END For; PROCEDUREIf ( t: T; READONLY term: TokenSet) : M3AST_AS.If_st RAISES {Rd.Failure}= CONST EndOfIfArm = TokenSet{M3CToken.ELSE_, M3CToken.ELSIF_, M3CToken.END_}; VAR ifExprTerm := term + StartOfStatement + EndOfIfArm + TokenSet{M3CToken.THEN_}; if: M3AST_AS.If_st := NEW(M3AST_AS.If_st).init(); BEGIN Pos(t, if, TRUE); if.as_exp := Expr(t, ifExprTerm); EVAL MustBeAt(t, M3CToken.THEN_); if.as_stm_s := Stmts(t, EndOfIfArm, term); if.as_elsif_s := SeqM3AST_AS_Elsif.Null; WHILE t.lexer.current() = M3CToken.ELSIF_ DO VAR elsif: M3AST_AS.Elsif := NEW(M3AST_AS.Elsif).init(); BEGIN SeqM3AST_AS_Elsif.AddRear(if.as_elsif_s, elsif); Pos(t, elsif, TRUE); elsif.as_exp := Expr(t, ifExprTerm); EVAL MustBeAt(t, M3CToken.THEN_); elsif.as_stm_s := Stmts(t, EndOfIfArm, term); END; END; if.as_else := Else(t, term); RETURN if; END If; PROCEDURELock ( t: T; READONLY term: TokenSet) : M3AST_AS.Lock_st RAISES {Rd.Failure}= VAR l: M3AST_AS.Lock_st := NEW(M3AST_AS.Lock_st).init(); BEGIN Pos(t, l, TRUE); l.as_exp := Expr(t, term + EndAsSet + TokenSet{M3CToken.DO_}); EVAL MustBeAt(t, M3CToken.DO_); l.as_stm_s := StmtsThenEnd(t, term); RETURN l; END Lock; PROCEDURELoop ( t: T; READONLY term: TokenSet) : M3AST_AS.Loop_st RAISES {Rd.Failure}= VAR l: M3AST_AS.Loop_st := NEW(M3AST_AS.Loop_st).init(); BEGIN Pos(t, l, TRUE); l.as_stm_s := StmtsThenEnd(t, term); RETURN l; END Loop; PROCEDURERepeat ( t: T; READONLY term: TokenSet) : M3AST_AS.Repeat_st RAISES {Rd.Failure}= VAR r: M3AST_AS.Repeat_st := NEW(M3AST_AS.Repeat_st).init(); BEGIN Pos(t, r, TRUE); r.as_stm_s := Stmts(t, TokenSet{M3CToken.UNTIL_}, term); EndPos(t, M3CToken.UNTIL_); r.as_exp := Expr(t, term); RETURN r; END Repeat; PROCEDURERaise ( t: T; READONLY term: TokenSet) : M3AST_AS.Raise_st RAISES {Rd.Failure}= VAR r: M3AST_AS.Raise_st := NEW(M3AST_AS.Raise_st).init(); BEGIN Pos(t, r, TRUE); r.as_qual_id := QualId(t); EVAL ExpectSet(t, term + TokenSet{M3CToken.Bra}); IF At(t, M3CToken.Bra) THEN r.as_exp_void := Expr(t, term + TokenSet{M3CToken.Ket}); EVAL MustBeAt(t, M3CToken.Ket); END; RETURN r; END Raise; PROCEDUREReturn ( t: T; READONLY term: TokenSet) : M3AST_AS.Return_st RAISES {Rd.Failure}= VAR r: M3AST_AS.Return_st := NEW(M3AST_AS.Return_st).init(); BEGIN Pos(t, r, TRUE); IF NOT t.lexer.current() IN term - StartOfExpression THEN r.as_exp := Expr(t, term); END; RETURN r; END Return; PROCEDURETry ( t: T; READONLY term: TokenSet) : M3AST_AS.Try_st RAISES {Rd.Failure}= VAR try: M3AST_AS.Try_st := NEW(M3AST_AS.Try_st).init(); BEGIN Pos(t, try, TRUE); try.as_stm_s := Stmts(t, TokenSet{M3CToken.FINALLY_, M3CToken.EXCEPT_}, term + TokenSet{M3CToken.Bar, M3CToken.ELSE_, M3CToken.END_}); IF t.lexer.current() = M3CToken.FINALLY_ THEN VAR f: M3AST_AS.Try_finally := NEW(M3AST_AS.Try_finally).init(); BEGIN try.as_try_tail := f; Pos(t, f, TRUE); f.as_stm_s := StmtsThenEnd(t, term); END; ELSE VAR e: M3AST_AS.Try_except := NEW(M3AST_AS.Try_except).init(); BEGIN try.as_try_tail := e; Pos(t, e); EVAL At(t, M3CToken.EXCEPT_); e.as_handler_s := SeqM3AST_AS_Handler.Null; IF NOT t.lexer.current() IN TokenSet{M3CToken.ELSE_, M3CToken.END_} THEN VAR possibleStartOfHandler := StartOfStatement + IdAsSet + TokenSet{M3CToken.Bar, M3CToken.Bra, M3CToken.Implies}; handlerTerm := term + possibleStartOfHandler + TokenSet{M3CToken.END_, M3CToken.ELSE_}; BEGIN EVAL At(t, M3CToken.Bar); REPEAT VAR h: M3AST_AS.Handler := NEW(M3AST_AS.Handler).init(); BEGIN 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, M3CToken.Comma, TokenSet{M3CToken.Bra, M3CToken.Implies}, IdAsSet, handlerTerm); IF At(t, M3CToken.Bra) THEN h.as_id := NEW(M3AST_AS.Handler_id).init(); Id(t, h.as_id); EVAL Expect(t, M3CToken.Ket, handlerTerm); END; EVAL LenientMustBeAt(t, M3CToken.Implies, M3CToken.Colon); h.as_stm_s := Stmts(t, TokenSet{M3CToken.Bar, M3CToken.ELSE_, M3CToken.END_}, handlerTerm); END; UNTIL EndOfSequenceSet(t, M3CToken.Bar, ElseOrEnd, possibleStartOfHandler, handlerTerm); END; END; e.as_else := Else(t, term); END; END; RETURN try; END Try; PROCEDURETypecase ( t: T; READONLY term: TokenSet) : M3AST_AS.Typecase_st RAISES {Rd.Failure}= VAR possibleStartOfTypecase := StartOfStatement + StartOfType + TokenSet{M3CToken.Bar, M3CToken.Bra, M3CToken.Implies}; typecaseTerm := term + possibleStartOfTypecase + TokenSet{M3CToken.END_, M3CToken.ELSE_}; typecaseLabelTerm := typecaseTerm + TokenSet{M3CToken.Comma}; VAR typecase_st: M3AST_AS.Typecase_st := NEW(M3AST_AS.Typecase_st).init(); BEGIN Pos(t, typecase_st, TRUE); typecase_st.as_exp := Expr(t, typecaseTerm + TokenSet{M3CToken.OF_}); EVAL Expect(t, M3CToken.OF_, typecaseTerm); typecase_st.as_tcase_s := SeqM3AST_AS_Tcase.Null; IF NOT t.lexer.current() IN TokenSet{M3CToken.ELSE_, M3CToken.END_} THEN EVAL At(t, M3CToken.Bar); REPEAT VAR tcase: M3AST_AS.Tcase := NEW(M3AST_AS.Tcase).init(); BEGIN 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, M3CToken.Comma, TokenSet{M3CToken.Bra, M3CToken.Implies}, StartOfType, typecaseTerm); IF At(t, M3CToken.Bra) THEN tcase.as_id := NEW(M3AST_AS.Tcase_id).init(); Id(t, tcase.as_id); EVAL Expect(t, M3CToken.Ket, typecaseTerm); END; EVAL Expect(t, M3CToken.Implies, typecaseTerm); tcase.as_stm_s := Stmts( t, TokenSet{M3CToken.Bar, M3CToken.ELSE_, M3CToken.END_}, typecaseTerm); END; UNTIL EndOfSequenceSet(t, M3CToken.Bar, ElseOrEnd, possibleStartOfTypecase, typecaseTerm); END; typecase_st.as_else := Else(t, term); RETURN typecase_st; END Typecase; PROCEDUREWhile ( t: T; READONLY term: TokenSet) : M3AST_AS.While_st RAISES {Rd.Failure}= VAR w: M3AST_AS.While_st := NEW(M3AST_AS.While_st).init(); BEGIN Pos(t, w, TRUE); w.as_exp := Expr(t, term + TokenSet{M3CToken.DO_, M3CToken.END_}); EVAL MustBeAt(t, M3CToken.DO_); w.as_stm_s := StmtsThenEnd(t, term); RETURN w; END While; PROCEDUREWith ( t: T; READONLY term: TokenSet) : M3AST_AS.With_st RAISES {Rd.Failure}= VAR possibleStartOfBinding := TokenSet{M3CToken.Identifier, M3CToken.Equal} + StartOfExpression; bindingTerm := term + StartOfStatement + possibleStartOfBinding + TokenSet{M3CToken.Comma, M3CToken.DO_, M3CToken.END_}; w: M3AST_AS.With_st := NEW(M3AST_AS.With_st).init(); BEGIN Pos(t, w, TRUE); w.as_binding_s := SeqM3AST_AS_Binding.Null; REPEAT VAR b: M3AST_AS.Binding := NEW(M3AST_AS.Binding).init(); BEGIN SeqM3AST_AS_Binding.AddRear(w.as_binding_s, b); Pos(t, b); b.as_id := NEW(M3AST_AS.With_id).init(); Id(t, b.as_id); EVAL Expect(t, M3CToken.Equal, bindingTerm); b.as_exp := Expr(t, bindingTerm); END; UNTIL EndOfSequence(t, M3CToken.Comma, M3CToken.DO_, possibleStartOfBinding, bindingTerm); w.as_stm_s := StmtsThenEnd(t, term); RETURN w; END With; <*INLINE*> PROCEDUREExprOrInit ( t: T; READONLY term: TokenSet; VAR init: M3AST_AS.EXP) : M3AST_AS.EXP RAISES {Rd.Failure}= VAR old := init; BEGIN IF old = NIL THEN RETURN Expr(t, term); ELSE init := NIL; RETURN old; END; END ExprOrInit; PROCEDUREStmts ( t: T; READONLY validTerm, term: TokenSet; initialExp: M3AST_AS.EXP := NIL) : SeqM3AST_AS_STM.T RAISES {Rd.Failure}= VAR fullTerm := validTerm + term; result := SeqM3AST_AS_STM.Null; BEGIN IF initialExp = NIL AND t.lexer.current() IN validTerm THEN RETURN result; ELSIF initialExp # NIL OR ExpectSet(t, StartOfStatement, fullTerm) THEN WITH stmtTerm = fullTerm + TokenSet{M3CToken.Semicolon} DO LOOP VAR token := t.lexer.current(); 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{M3CToken.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, M3CToken.Becomes); ELSE assignment := Expect(t, M3CToken.Becomes, stmtTerm); END; IF isCall AND NOT assignment THEN VAR c: M3AST_AS.Call_st := NEW(M3AST_AS.Call_st).init(); BEGIN c.lx_srcpos := exp.lx_srcpos; c.as_call := exp; stm := c; END; ELSE VAR a: M3AST_AS.Assign_st := NEW(M3AST_AS.Assign_st).init(); BEGIN 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 := NEW(M3AST_AS.Bad_EXP).init(); END; stm := a; END; END; END; ELSE CASE token OF <*NOWARN*> | M3CToken.CASE_ => stm := Case(t, stmtTerm); | M3CToken.EXIT_ => stm := Exit(t); | M3CToken.EVAL_ => stm := Eval(t, stmtTerm); | M3CToken.FOR_ => stm := For(t, stmtTerm); | M3CToken.IF_ => stm := If(t, stmtTerm); | M3CToken.LOCK_ => stm := Lock(t, stmtTerm); | M3CToken.LOOP_ => stm := Loop(t, stmtTerm); | M3CToken.RAISE_ => stm := Raise(t, stmtTerm); | M3CToken.REPEAT_ => stm := Repeat(t, stmtTerm); | M3CToken.RETURN_ => stm := Return(t, stmtTerm); | M3CToken.TRY_ => stm := Try(t, stmtTerm); | M3CToken.TYPECASE_ => stm := Typecase(t, stmtTerm); | M3CToken.WHILE_ => stm := While(t, stmtTerm); | M3CToken.WITH_ => stm := With(t, stmtTerm); END; END; SeqM3AST_AS_STM.AddRear(result, stm); WITH exit = EndOfSequenceSet(t, M3CToken.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; PROCEDUREStmtsThenEnd ( t: T; READONLY term: TokenSet) : SeqM3AST_AS_STM.T RAISES {Rd.Failure}= BEGIN WITH result = Stmts(t, EndAsSet, term) DO EndPos(t); RETURN result; END; END StmtsThenEnd; PROCEDUREEndOfDecl ( t: T; decl: M3AST.NODE; READONLY term: TokenSet) : BOOLEAN RAISES {Rd.Failure}= BEGIN EVAL Expect(t, M3CToken.Semicolon, term + IdAsSet); LOOP WITH token = t.lexer.current() DO IF token = M3CToken.Semicolon THEN Unexpected(t); EVAL t.lexer.next(); ELSE IF t.lastPragma # NIL THEN M3CPragma.AddPrecedingStmOrDecl(decl, t.pragmas); END; RETURN token # M3CToken.Identifier; END; END; END; END EndOfDecl; PROCEDUREConstDecl ( t: T; READONLY term: TokenSet) : M3AST_AS.Const_decl_s RAISES {Rd.Failure}= VAR constDeclS: M3AST_AS.Const_decl_s := NEW(M3AST_AS.Const_decl_s).init(); BEGIN Pos(t, constDeclS, TRUE); constDeclS.as_const_decl_s := SeqM3AST_AS_Const_decl.Null; IF NOT t.lexer.current() IN StartOfBlock THEN LOOP VAR c: M3AST_AS.Const_decl := NEW(M3AST_AS.Const_decl).init(); BEGIN SeqM3AST_AS_Const_decl.AddRear(constDeclS.as_const_decl_s, c); Pos(t, c); c.as_id := NEW(M3AST_AS.Const_id).init(); Id(t, c.as_id); IF At(t, M3CToken.Colon) THEN c.as_type := Type(t, term + TokenSet{M3CToken.Equal}); END; EVAL Expect(t, M3CToken.Equal, term); c.as_exp := Expr(t, term); IF EndOfDecl(t, c, term) THEN EXIT END; END; END; END; RETURN constDeclS; END ConstDecl; PROCEDUREOpaque (t: M3AST_AS.M3TYPE): M3AST_AS.M3TYPE RAISES {} = VAR new: M3AST_AS.Opaque_type := NEW(M3AST_AS.Opaque_type).init(); BEGIN new.lx_srcpos := t.lx_srcpos; new.as_type := t; RETURN new; END Opaque; PROCEDURETypeDecl ( t: T; READONLY term: TokenSet) : M3AST_AS.Type_decl_s RAISES {Rd.Failure}= VAR typeDeclS: M3AST_AS.Type_decl_s := NEW(M3AST_AS.Type_decl_s).init(); BEGIN Pos(t, typeDeclS, TRUE); typeDeclS.as_type_decl_s := SeqM3AST_AS_TYPE_DECL.Null; IF NOT t.lexer.current() IN StartOfBlock THEN LOOP VAR td: M3AST_AS.TYPE_DECL; id: M3AST_AS.Type_id := NEW(M3AST_AS.Type_id).init(); opaque: BOOLEAN; BEGIN Id(t, id); opaque := At(t, M3CToken.Subtype); IF opaque THEN td := NEW(M3AST_AS.Subtype_decl).init(); ELSE EVAL Expect(t, M3CToken.Equal, term + StartOfType); td := NEW(M3AST_AS.Concrete_decl).init(); 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; PROCEDUREExceptionDecl ( t: T; READONLY term: TokenSet) : M3AST_AS.Exc_decl_s RAISES {Rd.Failure}= VAR excDeclS: M3AST_AS.Exc_decl_s := NEW(M3AST_AS.Exc_decl_s).init(); BEGIN Pos(t, excDeclS, TRUE); excDeclS.as_exc_decl_s := SeqM3AST_AS_Exc_decl.Null; IF NOT t.lexer.current() IN StartOfBlock THEN LOOP VAR e: M3AST_AS.Exc_decl := NEW(M3AST_AS.Exc_decl).init(); BEGIN SeqM3AST_AS_Exc_decl.AddRear(excDeclS.as_exc_decl_s, e); Pos(t, e); e.as_id := NEW(M3AST_AS.Exc_id).init(); Id(t, e.as_id); IF At(t, M3CToken.Bra) THEN e.as_type := Type(t, term + TokenSet{M3CToken.Ket}); EVAL Expect(t, M3CToken.Ket, term); END; IF EndOfDecl(t, e, term) THEN EXIT END; END; END; END; RETURN excDeclS; END ExceptionDecl; PROCEDUREIdAfterEnd (t: T; id: M3CLex.Symbol_rep) RAISES {Rd.Failure}= BEGIN IF t.lexer.current() = M3CToken.Identifier THEN IF id # NIL AND id # t.lexer.identifier() THEN ErrorMessage(t, Fmt.F("name after END should be \'%s\'", id.toText())); END; EVAL t.lexer.next(); ELSE Expected(t, M3CToken.Identifier); END; END IdAfterEnd; PROCEDUREProcedureDecl ( t: T; READONLY term: TokenSet) : M3AST_AS.Proc_decl RAISES {Rd.Failure}= VAR p: M3AST_AS.Proc_decl := NEW(M3AST_AS.Proc_decl).init(); BEGIN Pos(t, p, TRUE); p.as_id := NEW(M3AST_AS.Proc_id).init(); Id(t, p.as_id); WITH pos = t.lexer.position() DO p.as_type := Signature(t, term + TokenSet{M3CToken.Equal} + StartOfBlock); p.as_type.lx_srcpos := pos; END; EVAL ExpectSet(t, TokenSet{M3CToken.Equal, M3CToken.Semicolon}, StartOfStatement + term); IF t.interface THEN EVAL MustBeAt(t, M3CToken.Semicolon); ELSE EVAL MustBeAt(t, M3CToken.Equal); EVAL ExpectSet(t, StartOfBlock, StartOfStatement + term); p.as_body := Block(t, term); IdAfterEnd(t, p.as_id.lx_symrep); EVAL Expect(t, M3CToken.Semicolon, term); END; IF t.lastPragma # NIL THEN M3CPragma.AddPrecedingStmOrDecl(p, t.pragmas); END; RETURN p; END ProcedureDecl; PROCEDUREVarDecl ( t: T; READONLY term: TokenSet) : M3AST_AS.Var_decl_s RAISES {Rd.Failure}= VAR varTerm := term + TokenSet{M3CToken.Colon, M3CToken.Becomes} + StartOfType + StartOfExpression; varDeclS: M3AST_AS.Var_decl_s := NEW(M3AST_AS.Var_decl_s).init(); BEGIN Pos(t, varDeclS, TRUE); varDeclS.as_var_decl_s := SeqM3AST_AS_Var_decl.Null; IF NOT t.lexer.current() IN StartOfBlock THEN LOOP VAR v: M3AST_AS.Var_decl := NEW(M3AST_AS.Var_decl).init(); BEGIN SeqM3AST_AS_Var_decl.AddRear(varDeclS.as_var_decl_s, v); Pos(t, v); v.as_id_s := SeqM3AST_AS_Var_id.Null; REPEAT VAR id: M3AST_AS.Var_id := NEW(M3AST_AS.Var_id).init(); BEGIN SeqM3AST_AS_Var_id.AddRear(v.as_id_s, id); Id(t, id); END; UNTIL EndOfSequenceSet(t, M3CToken.Comma, TokenSet{M3CToken.Colon, M3CToken.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; PROCEDUREReveal ( t: T; READONLY term: TokenSet) : M3AST_AS.Revelation_s RAISES {Rd.Failure}= VAR revelationS: M3AST_AS.Revelation_s := NEW(M3AST_AS.Revelation_s).init(); BEGIN Pos(t, revelationS, TRUE); revelationS.as_reveal_s := SeqM3AST_AS_REVELATION.Null; IF NOT t.lexer.current() IN StartOfBlock THEN LOOP VAR qualId := QualId(t); r: M3AST_AS.REVELATION; BEGIN IF At(t, M3CToken.Subtype) THEN r := NEW(M3AST_AS.Subtype_reveal).init(); ELSE EVAL Expect(t, M3CToken.Equal, term + StartOfType); r := NEW(M3AST_AS.Concrete_reveal).init(); 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*> PROCEDURELastPos (srcNode: M3AST_AS.SRC_NODE): M3CSrcPos.T RAISES {}= BEGIN IF srcNode = NIL THEN RETURN M3CSrcPos.Null; ELSE RETURN srcNode.lx_srcpos; END; END LastPos; PROCEDUREExternalPragma ( 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; BEGIN WHILE M3CPragma.Next(iter, pragma) DO IF M3CPragma.Match(pragma, "EXTERNAL", langSpec) THEN RETURN pragma; END; END; RETURN NIL; END ExternalPragma; PROCEDUREInlinePragma ( 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; PROCEDUREExternal ( pragma: M3CPragma.T; langSpec: Text.T) : M3AST_PG.External RAISES {}= VAR external: M3AST_PG.External := NEW(M3AST_PG.External).init(); 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; PROCEDUREDeclarations ( t: T; READONLY term: TokenSet; revealOk := FALSE) : SeqM3AST_AS_DECL_REVL.T RAISES {Rd.Failure}= VAR declTerm := term + TokenSet{M3CToken.Semicolon} + StartOfDeclarationOrRevelation; result := SeqM3AST_AS_DECL_REVL.Null; BEGIN LOOP VAR token := t.lexer.current(); 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 <*NOWARN*> | M3CToken.CONST_ => d := ConstDecl(t, declTerm); | M3CToken.TYPE_ => d := TypeDecl(t, declTerm); | M3CToken.EXCEPTION_ => d := ExceptionDecl(t, declTerm); | M3CToken.PROCEDURE_ => VAR inlinePragma := InlinePragma(t.pragmas, t.lastSrcPosNode); procDecl := ProcedureDecl(t, declTerm); BEGIN IF inlinePragma # NIL THEN VAR inline: M3AST_PG.Inline := NEW(M3AST_PG.Inline).init(); BEGIN inline.lx_srcpos := M3CPragma.Position(inlinePragma); procDecl.pg_inline := inline; END; M3CPragma.SetHook(inlinePragma, procDecl); END; d := procDecl; END; | M3CToken.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 = M3CToken.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 = M3CToken.Semicolon THEN Unexpected(t); EVAL t.lexer.next(); ELSE EXIT; END; END; END; (* loop *) RETURN result; END Declarations; PROCEDUREBlock ( t: T; READONLY term: TokenSet; revealOk := FALSE) : M3AST_AS.Block RAISES {Rd.Failure}= VAR blockTerm := term + StartOfStatement + EndAsSet; b: M3AST_AS.Block := NEW(M3AST_AS.Block).init(); BEGIN Pos(t, b); b.as_decl_s := Declarations(t, blockTerm + TokenSet{M3CToken.BEGIN_}, revealOk); EVAL Expect(t, M3CToken.BEGIN_, blockTerm); b.as_stm_s := StmtsThenEnd(t, blockTerm); RETURN b; END Block; PROCEDUREImports ( t: T; READONLY term: TokenSet) : SeqM3AST_AS_IMPORTED.T RAISES {Rd.Failure}= VAR possibleStartOfImport := StartOfImport + TokenSet{M3CToken.Identifier, M3CToken.AS_, M3CToken.Comma, M3CToken.Semicolon}; importTerm := term + possibleStartOfImport; seqImported := SeqM3AST_AS_IMPORTED.Null; BEGIN IF t.lexer.current() IN StartOfImport THEN REPEAT VAR pos := t.lexer.position(); imported: M3AST_AS.IMPORTED; BEGIN IF At(t, M3CToken.FROM_) THEN VAR f: M3AST_AS.From_import := NEW(M3AST_AS.From_import).init(); BEGIN f.lx_srcpos := pos; f.as_intf_id := NEW(M3AST_AS.Used_interface_id).init(); Id(t, f.as_intf_id); f.as_id_s := SeqM3AST_AS_Used_def_id.Null; EVAL Expect(t, M3CToken.IMPORT_, importTerm); REPEAT VAR id: M3AST_AS.Used_def_id := NEW(M3AST_AS.Used_def_id).init(); BEGIN SeqM3AST_AS_Used_def_id.AddRear(f.as_id_s, id); Id(t, id); END; UNTIL EndOfSequence(t, M3CToken.Comma, M3CToken.Semicolon, IdAsSet, importTerm); imported := f; END; ELSE VAR i: M3AST_AS.Simple_import := NEW(M3AST_AS.Simple_import).init(); BEGIN i.lx_srcpos := pos; i.as_import_item_s := SeqM3AST_AS_Import_item.Null; EVAL Expect(t, M3CToken.IMPORT_, importTerm); REPEAT VAR import_item: M3AST_AS.Import_item := NEW(M3AST_AS.Import_item).init(); BEGIN SeqM3AST_AS_Import_item.AddRear(i.as_import_item_s, import_item); Pos(t, import_item, FALSE); import_item.as_intf_id := NEW(M3AST_AS.Used_interface_id).init(); Id(t, import_item.as_intf_id); IF At(t, M3CToken.AS_) THEN import_item.as_id := NEW(M3AST_AS.Interface_AS_id).init(); Id(t, import_item.as_id); END; END; UNTIL EndOfSequence(t, M3CToken.Comma, M3CToken.Semicolon, IdAsSet, importTerm); imported := i; END; END; SeqM3AST_AS_IMPORTED.AddRear(seqImported, imported); END; UNTIL NOT t.lexer.current() IN possibleStartOfImport; END; RETURN seqImported; END Imports; PROCEDUREGenericFormals (t: T; READONLY term: TokenSet): SeqM3AST_AS_F_Interface_id.T RAISES {Rd.Failure}= VAR seqF_Interface_id := SeqM3AST_AS_F_Interface_id.Null; BEGIN EVAL Expect(t, M3CToken.Bra, term); IF NOT At(t, M3CToken.Ket) THEN REPEAT VAR id: M3AST_AS.F_Interface_id := NEW(M3AST_AS.F_Interface_id).init(); BEGIN SeqM3AST_AS_F_Interface_id.AddRear(seqF_Interface_id, id); Id(t, id); END; UNTIL EndOfSequence(t, M3CToken.Comma, M3CToken.Ket, IdAsSet, term); END; (* if *) RETURN seqF_Interface_id; END GenericFormals; PROCEDUREGenericActuals (t: T; READONLY term: TokenSet ): SeqM3AST_AS_Used_interface_id.T RAISES {Rd.Failure}= VAR seqUsed_interface_id := SeqM3AST_AS_Used_interface_id.Null; BEGIN EVAL Expect(t, M3CToken.Bra, term); IF NOT At(t, M3CToken.Ket) THEN REPEAT VAR id: M3AST_AS.Used_interface_id := NEW(M3AST_AS.Used_interface_id).init(); BEGIN SeqM3AST_AS_Used_interface_id.AddRear(seqUsed_interface_id, id); Id(t, id); END; UNTIL EndOfSequence(t, M3CToken.Comma, M3CToken.Ket, IdAsSet, term); END; (* if *) RETURN seqUsed_interface_id; END GenericActuals; PROCEDURETruncatedUnit (t: T; unit: M3AST_AS.UNIT): M3AST_AS.UNIT RAISES {}= VAR b: M3AST_AS.Block := NEW(M3AST_AS.Block).init(); pos := t.lexer.position(); BEGIN b.lx_srcpos := pos; b.as_decl_s := SeqM3AST_AS_DECL_REVL.Null; b.as_stm_s := SeqM3AST_AS_STM.Null; TYPECASE unit OF | M3AST_AS.UNIT_WITH_BODY(ub) => ub.as_block := b; ELSE END; RETURN unit; END TruncatedUnit; PROCEDUREUnit ( t: T; headerOnly := FALSE) : M3AST_AS.UNIT RAISES {Rd.Failure}= CONST UnitTerm = StartOfImport + StartOfDeclaration + StartOfRevelation + TokenSet{M3CToken.END_, M3CToken.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 t.lexer.current() = M3CToken.UNSAFE_ THEN unsafe := NEW(M3AST_AS.Unsafe).init(); Pos(t, unsafe, TRUE); END; IF t.lexer.current() = M3CToken.GENERIC_ THEN generic := TRUE; IF unsafe # NIL THEN Unexpected(t) END; EVAL t.lexer.next(); END; IF t.lexer.current() = M3CToken.INTERFACE_ THEN VAR interface: M3AST_AS.Interface := NEW(M3AST_AS.Interface).init(); 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 := NEW(M3AST_AS.Interface_id).init(); interface.as_unsafe := unsafe; Id(t, interface.as_id); IF generic THEN VAR interface_gen_def: M3AST_AS.Interface_gen_def := NEW(M3AST_AS.Interface_gen_def).init(); 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, M3CToken.Semicolon, UnitTerm); END; ELSE EVAL ExpectSet(t, TokenSet{M3CToken.Semicolon, M3CToken.Equal}, UnitTerm); IF At(t, M3CToken.Equal) THEN VAR interface_gen_ins: M3AST_AS.Interface_gen_ins := NEW(M3AST_AS.Interface_gen_ins).init(); 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 := NEW(M3AST_AS.Used_interface_id).init(); Id(t, interface_gen_ins.as_gen_id); interface_gen_ins.as_id_s := GenericActuals(t, UnitTerm); END; ELSE EVAL Expect(t, M3CToken.Semicolon, UnitTerm); unit := interface; END; END; IF ISTYPE(unit, M3AST_AS.UNIT_WITH_BODY) THEN unit_with_body := unit; EVAL ExpectSet(t, UnitTerm - TokenSet{M3CToken.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 := NEW(M3AST_AS.Block).init(); block.lx_srcpos := t.lexer.position(); block.as_decl_s := Declarations(t, UnitTerm - StartOfImport, TRUE); block.as_stm_s := SeqM3AST_AS_STM.Null; END; END; EVAL Expect(t, M3CToken.END_, UnitTerm); t.interface := FALSE; END; ELSE CONST ModuleTerm = UnitTerm + StartOfBlock; ExportsTerm = ModuleTerm + TokenSet{M3CToken.Semicolon}; StartOfModuleBody = StartOfImport + StartOfBlock; VAR module: M3AST_AS.Module := NEW(M3AST_AS.Module).init(); BEGIN module.as_unsafe := unsafe; Pos(t, module); EVAL MustBeAt(t, M3CToken.MODULE_); module.as_id := NEW(M3AST_AS.Module_id).init(); Id(t, module.as_id); module.as_export_s := SeqM3AST_AS_Used_interface_id.Null; IF generic THEN VAR module_gen_def: M3AST_AS.Module_gen_def := NEW(M3AST_AS.Module_gen_def).init(); 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, M3CToken.Semicolon, UnitTerm); END; ELSE IF At(t, M3CToken.EXPORTS_) THEN REPEAT VAR id: M3AST_AS.Used_interface_id := NEW(M3AST_AS.Used_interface_id).init(); BEGIN SeqM3AST_AS_Used_interface_id.AddRear(module.as_export_s, id); Id(t, id); END; UNTIL EndOfSequenceSet(t, M3CToken.Comma, TokenSet{M3CToken.Semicolon, M3CToken.Equal}, IdAsSet, ExportsTerm); END; EVAL ExpectSet(t, TokenSet{M3CToken.Semicolon, M3CToken.Equal}, ModuleTerm); IF At(t, M3CToken.Equal) THEN VAR module_gen_ins: M3AST_AS.Module_gen_ins := NEW(M3AST_AS.Module_gen_ins).init(); 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 := NEW(M3AST_AS.Used_interface_id).init(); Id(t, module_gen_ins.as_gen_id); module_gen_ins.as_id_s := GenericActuals(t, UnitTerm); END; EVAL MustBeAt(t, M3CToken.END_); ELSE EVAL Expect(t, M3CToken.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, M3CToken.Dot); RETURN unit; END Unit; EXCEPTION BadTerminators; <*INLINE*> PROCEDURECheckTerminators (chars: SET OF CHAR): SET OF CHAR= <*FATAL BadTerminators*> BEGIN IF chars <= AnyTerminators THEN RETURN chars; ELSE RAISE BadTerminators; END; END CheckTerminators; PROCEDUREAny ( t: T; terminators := SET OF CHAR{}) : REFANY RAISES {Rd.Failure}= CONST VoidAsSet = TokenSet{M3CToken.Void}; DefaultTerm = Start + VoidAsSet; VAR token := t.lexer.current(); result: REFANY := NIL; BEGIN t.terminators := CheckTerminators(terminators); t.pragmas := M3CPragma.NewStore(); t.comments := M3CComment.NewStore(); IF token = M3CToken.Void THEN token := t.lexer.next() 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 := t.lexer.position(); decls := Declarations(t, DefaultTerm); BEGIN IF At(t, M3CToken.BEGIN_) THEN VAR b: M3AST_AS.Block := NEW(M3AST_AS.Block).init(); BEGIN b.lx_srcpos := pos; b.as_decl_s := decls; b.as_stm_s := StmtsThenEnd(t, StartOfStatement + EndAsSet); IF At(t, M3CToken.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{M3CToken.Semicolon, M3CToken.Becomes}; VAR expr := Expr(t, DefaultTerm + PartOfStatement, TRUE); BEGIN IF ISTYPE(expr, M3AST_AS.M3TYPE) OR NOT t.lexer.current() IN PartOfStatement THEN result := expr; ELSE result := Stmts(t, VoidAsSet, DefaultTerm, expr); END; END; ELSE result := Stmts(t, VoidAsSet, DefaultTerm); END; END; IF t.lexer.current() # M3CToken.Void THEN Unexpected(t) END; t.terminators := SET OF CHAR{}; Reset(t); RETURN result; END Any; TYPE CallBack = M3CLex.CallBack OBJECT parser: T; OVERRIDES badChar := BadChar; comment := Comment; pragma := Pragma; whiteSpace := WhiteSpace; END; PROCEDUREBadChar (c: CallBack; ch: CHAR) RAISES {}= VAR text: Text.T; BEGIN IF ch IN c.parser.terminators THEN c.parser.lexer.disable(); ELSE IF ch IN AnyTerminators 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; PROCEDUREComment (c: CallBack; comment: Text.T) RAISES {}= VAR high := Text.Length(comment) - 1; (* will be at least 2 *) t := c.parser; BEGIN IF Text.GetChar(comment, high) # ')' OR Text.GetChar(comment, high - 1) # '*' THEN ErrorMessage(c.parser, "Non terminated comment"); ELSE t.lastComment := M3CComment.AddToStore(comment, t.lexer.position(), t.lastSrcPosNode, t.comments); t.commentOrPragma := TRUE; END; END Comment; PROCEDUREPragma (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, t.lexer.position(), t.lastSrcPosNode, t.pragmas); t.commentOrPragma := TRUE; END; END Pragma; PROCEDUREWhiteSpace (<*UNUSED*> c: CallBack; <*UNUSED*> ws: Text.T)= BEGIN END WhiteSpace; PROCEDUREInit ( t: T; rd: Rd.T; identifiers: M3CReservedWord.Table; literals: M3CHash.Table; errorHandler: ErrorHandler; lexer: M3CLex.T := NIL) : T RAISES {}= BEGIN t.identifiers := identifiers; t.idNEW := identifiers.enter("NEW"); t.nil_litrep := literals.enter("NIL"); t.errorHandler := errorHandler; IF lexer = NIL THEN lexer := NEW(M3CLex.T).init(rd, identifiers, literals, NEW(CallBack, parser := t)); END; t.lexer := lexer; RETURN t; END Init; PROCEDUREResetLastFields (t: T) RAISES {}= BEGIN t.lastErrorPos := M3CSrcPos.Null; t.lastSrcPosNode := NIL; t.commentOrPragma := FALSE; t.lastPragma := NIL; t.lastComment := NIL; END ResetLastFields; PROCEDURECompilation ( t: T; headerOnly := FALSE) : M3AST_AS.Compilation_Unit RAISES {Rd.Failure}= VAR c: M3AST_AS.Compilation_Unit := NEW(M3AST_AS.Compilation_Unit).init(); BEGIN t.pragmas := M3CPragma.NewStore(); t.comments := M3CComment.NewStore(); ResetLastFields(t); EVAL t.lexer.next(); c.as_root := Unit(t, headerOnly); c.lx_pragmas := t.pragmas; c.lx_comments := t.comments; ResetLastFields(t); t.pragmas := NIL; RETURN c; END Compilation; PROCEDUREReset (t: T; pos := M3CSrcPos.Null; rd: Rd.T := NIL) RAISES {}= BEGIN ResetLastFields(t); t.lexer.reset(pos, rd); END Reset; BEGIN END M3CParse.