MODULEThis version records error message strings in a hash table, and records nodes with errors on a list, plus the args if any. The errors can then be displayed in various ways, including a sequence of text messages, sorted by line number.M3Error EXPORTSM3Error ,M3ErrorStream ; IMPORT TextExtras, Fmt, Wr, Stdio, Thread, RefList, TextRefTbl, Atom; IMPORT AST, M3AST_LX, M3AST_AS; IMPORT M3AST_FE_priv; IMPORT M3AST_LX_F, (*M3AST_AS_F,*) M3AST_SM_F, M3AST_TM_F, M3AST_FE_priv_F; IMPORT M3CSrcPos, M3CId, M3CUnit, M3ASTWalk; IMPORT M3Assert;
VAR messages_g := NEW(TextRefTbl.Default).init(); cu_g: M3AST_AS.Compilation_Unit := NIL; stream_g: Wr.T := Stdio.stderr; warn_g := TRUE; REVEAL Notification = Notification_public BRANDED OBJECT END; TYPE NotificationElem = REF RECORD e: Notification END; <* FATAL Thread.Alerted, Wr.Failure *> VAR notifications_g: RefList.T := NIL; notificationsMutex_g := NEW(MUTEX); PROCEDUREAddNotification (e: Notification) RAISES {}= BEGIN LOCK notificationsMutex_g DO notifications_g := RefList.AppendD(notifications_g, RefList.List1(NEW(NotificationElem, e := e))); END; (* lock *) END AddNotification; PROCEDURERemoveNotification (e: Notification) RAISES {}= VAR l: RefList.T := notifications_g; prev: RefList.T := NIL; BEGIN LOCK notificationsMutex_g DO WHILE l # NIL DO IF NARROW(l.head, NotificationElem).e = e THEN IF prev = NIL THEN notifications_g := l.tail ELSE prev.tail := l.tail; END; RETURN END; prev := l; l := l.tail; END; END; (* lock *) END RemoveNotification; PROCEDURENotify (cu: M3AST_AS.Compilation_Unit; warn: BOOLEAN)= BEGIN LOCK notificationsMutex_g DO VAR list: RefList.T := notifications_g; BEGIN WHILE list # NIL DO NARROW(list.head, NotificationElem).e.notify(cu, warn); list := list.tail; END; END; END; END Notify; TYPE NodeElem = REF RECORD node: ERROR_NODE; errors: RefList.T (* of ErrorElem *); END; ErrorElem = REF RECORD messageKey: Atom.T; a1, a2, a3, a4: M3AST_LX.Symbol_rep END; REVEAL M3AST_FE_priv.Unit_errors = BRANDED REF RefList.T; PROCEDURESetCu (cu: M3AST_AS.Compilation_Unit) RAISES {} = BEGIN cu_g := cu; IF cu # NIL AND cu.fe_priv_errors = NIL THEN cu.fe_priv_errors := NEW(M3AST_FE_priv.Unit_errors); END; END SetCu; PROCEDUREReportAtPos (pos: M3CSrcPos.T; message: TEXT) RAISES {} = BEGIN M3Assert.Check(cu_g # NIL); PutError(M3CUnit.TextName(cu_g.fe_uid), pos, message); END ReportAtPos; PROCEDUREReport (n: ERROR_NODE; message: TEXT) RAISES {}= BEGIN RecordError(n, message, TRUE); END Report; PROCEDUREReportWithId (n: ERROR_NODE; message: TEXT; id1, id2, id3, id4: M3AST_LX.Symbol_rep := NIL) RAISES {} = BEGIN RecordError(n, message, TRUE, id1, id2, id3, id4); END ReportWithId; PROCEDUREWarn (pos: ERROR_NODE; message: TEXT) RAISES {} = BEGIN IF warn_g THEN RecordError(pos, "warning: " & message, FALSE); END; END Warn; PROCEDUREWarnWithId (pos: ERROR_NODE; message: TEXT; id1, id2, id3, id4: M3AST_LX.Symbol_rep := NIL) RAISES {} = BEGIN IF warn_g THEN RecordError(pos, "warning: " & message, FALSE, id1, id2, id3, id4); END; END WarnWithId; PROCEDURESuppressWarnings (b := TRUE) RAISES {}= BEGIN warn_g := b; END SuppressWarnings; PROCEDURERecordError ( pos: ERROR_NODE; message: TEXT; serious: BOOLEAN; arg1, arg2, arg3, arg4: M3AST_LX.Symbol_rep := NIL) RAISES {} = VAR errors: RefList.T; error: ErrorElem; cu: M3AST_AS.Compilation_Unit; key: Atom.T; nodeElem: NodeElem; BEGIN (* Redeclaration errors may be in units other than current *) TYPECASE pos OF | M3AST_AS.DEF_ID(def_id) => WITH unitId = def_id.tmp_unit_id DO IF unitId = NIL THEN (* We are at an early stage of processing; the 'tmp_unit_id' has not been set up yet. This implies 'def_id' is declared in the current unit as imported units are fully semantically analysed (and hence have their 'tmp_unit_id' fields set up) before the current unit is analysed *) cu := cu_g; ELSE cu := unitId.sm_spec.sm_comp_unit; END; END; ELSE cu := cu_g; END; key := Atom.FromText(message); EVAL messages_g.put(message, key); IF CarefulNodeLookup(cu, pos, nodeElem) THEN (* not the first on this node *) ELSE nodeElem := NEW(NodeElem, node := pos, errors := NIL); cu.fe_priv_errors^ := RefList.AppendD(cu.fe_priv_errors^, RefList.List1(nodeElem)); END; (* if *) errors := nodeElem.errors; WHILE errors # NIL DO error := NARROW(errors.head, ErrorElem); IF (error.messageKey = key) AND (error.a1 = arg1) AND (error.a2 = arg2) AND (error.a3 = arg3) AND (error.a4 = arg4) THEN RETURN (* duplicate *) END; errors := errors.tail; END; (* while *) error := NEW(ErrorElem, a1 := arg1, a2 := arg2, a3 := arg3, a4 := arg4, messageKey := key); nodeElem.errors := RefList.AppendD(nodeElem.errors, RefList.List1(error)); Notify(cu, serious); END RecordError; PROCEDURECarefulNodeLookup ( cu: M3AST_AS.Compilation_Unit; n: ERROR_NODE; VAR (*out*) nodeElem: NodeElem) : BOOLEAN RAISES {}= BEGIN IF cu.fe_priv_errors = NIL THEN cu.fe_priv_errors := NEW(M3AST_FE_priv.Unit_errors); END; RETURN NodeLookup(cu.fe_priv_errors^, n, nodeElem); END CarefulNodeLookup; PROCEDURENodeLookup ( nodes: RefList.T; n: ERROR_NODE; VAR (*out*) nodeElem: NodeElem) : BOOLEAN RAISES {}= BEGIN WHILE nodes # NIL DO IF NARROW(nodes.head, NodeElem).node = n THEN nodeElem := nodes.head; RETURN TRUE ELSE nodes := nodes.tail; END; END; (* while *) RETURN FALSE; END NodeLookup; PROCEDUREShow (n: ERROR_NODE; forget := TRUE) RAISES {} = VAR nodeElem: NodeElem; errors: RefList.T; error: ErrorElem; BEGIN IF NodeLookup(cu_g.fe_priv_errors^, n, nodeElem) THEN errors := nodeElem.errors; WHILE errors # NIL DO error := NARROW(errors.head, ErrorElem); PutError(M3CUnit.TextName(cu_g.fe_uid), n.lx_srcpos, Atom.ToText(error.messageKey), error.a1, error.a2, error.a3, error.a4); errors := errors.tail; END; (* while *) IF forget THEN cu_g.fe_priv_errors^ := RefList_DeleteD(cu_g.fe_priv_errors^, nodeElem); END; END; (* if *) VAR usedId: M3AST_AS.USED_ID; BEGIN IF n.IsA_USED_ID(usedId) AND usedId # n THEN Show(usedId) END; END; END Show; TYPE Closure = M3ASTWalk.Closure OBJECT forget: BOOLEAN END; PROCEDUREShowAll (n: ERROR_NODE; forget := TRUE) RAISES {}= BEGIN (* nothing to do if cu.fe_priv_errors empty *) IF cu_g.fe_priv_errors^ # NIL THEN <* FATAL ANY *> BEGIN M3ASTWalk.VisitNodes(n, NEW(Closure, forget := forget, callback := DoShow)); END; END; (* if *) END ShowAll; PROCEDUREDoShow (cl: Closure; n: AST.NODE; <*UNUSED*> vm: M3ASTWalk.VisitMode) RAISES {}= BEGIN Show(n, cl.forget); END DoShow; PROCEDUREPutError (name: TEXT; pos: M3CSrcPos.T; message: TEXT; id1, id2, id3, id4: M3AST_LX.Symbol_rep := NIL; ) RAISES {} = VAR line, linePos: CARDINAL; t, messageWithIds: TEXT; BEGIN t := Fmt.F("\"%s\"", name); IF pos # M3CSrcPos.Null THEN line := M3CSrcPos.Unpack(pos, linePos); t := Fmt.F("%s, line %s,%s", t, Fmt.Int(line), Fmt.Int(linePos)); END; (* if *) IF id1 = NIL THEN (* This is not just an optimisation it is important. Some syntax errors may have an embedded %s in 'message' but do not want it substituted by an id (such messages must never contain a %s which does need substitution or chaos will ensue) *) messageWithIds := message; ELSE messageWithIds := Fmt.F(message, SafeIdToText(id1), SafeIdToText(id2), SafeIdToText(id3), SafeIdToText(id4)); END; t := TextExtras.Join(t, ": ", messageWithIds); WITH err = stream_g DO Wr.PutText(err, t); Wr.PutChar(err, '\n'); END; END PutError; PROCEDURESafeIdToText (id: M3AST_LX.Symbol_rep): TEXT RAISES {}= BEGIN IF id # NIL THEN RETURN id.toText() ELSE RETURN NIL; END; END SafeIdToText; PROCEDURESet (s: Wr.T): Wr.T RAISES {}= VAR old: Wr.T; BEGIN old := stream_g; stream_g := s; RETURN old; END Set; PROCEDURERefList_DeleteD (list: RefList.T; x: REFANY): RefList.T= VAR result, t: RefList.T; BEGIN IF list.head = x THEN result := list.tail ELSE result := list; t := list; list := list.tail; WHILE list # NIL DO IF list.head = x THEN t.tail := list.tail; EXIT ELSE t := list; list := list.tail; END; END; END; RETURN result; END RefList_DeleteD; BEGIN END M3Error.