m2/gm2-gcc/m2decl.o \
m2/gm2-gcc/m2expr.o \
m2/gm2-gcc/m2linemap.o \
+ m2/gm2-gcc/m2spellcheck.o \
m2/gm2-gcc/m2statement.o \
m2/gm2-gcc/m2type.o \
m2/gm2-gcc/m2tree.o \
M2Size.def \
M2StackAddress.def \
M2StackWord.def \
+ M2StackSpell.def \
M2StateCheck.def \
M2Students.def \
M2Swig.def \
M2Size.mod \
M2StackAddress.mod \
M2StackWord.mod \
+ M2StackSpell.mod \
M2StateCheck.mod \
M2Students.mod \
M2Swig.mod \
m2linemap.def \
m2misc.def \
m2pp.def \
+ m2spellcheck.def \
m2statement.def \
m2top.def \
m2tree.def \
M2Size.def \
M2StackAddress.def \
M2StackWord.def \
+ M2StackSpell.def \
M2StateCheck.def \
M2Students.def \
M2Swig.def \
M2Size.mod \
M2StackAddress.mod \
M2StackWord.mod \
+ M2StackSpell.mod \
M2StateCheck.mod \
M2Students.mod \
M2Swig.mod \
END ;
IF IsUnknown(t1) AND IsUnknown(t2)
THEN
+ (* --fixme-- spellcheck. *)
s := ConCat(s, InitString('two different unknown types {%1a:{%2a:{%1a} and {%2a}}} must either be declared or imported)')) ;
MetaErrorStringT2 (tok, s, t1, t2)
ELSIF IsUnknown(t1)
THEN
+ (* --fixme-- spellcheck. *)
s := ConCat(s, InitString('this type {%1a} is currently unknown, it must be declared or imported')) ;
MetaErrorStringT1 (tok, s, t1)
ELSIF IsUnknown(t2)
THEN
+ (* --fixme-- spellcheck. *)
s := ConCat (s, InitString('this type {%1a} is currently unknown, it must be declared or imported')) ;
MetaErrorStringT1 (tok, s, t2)
ELSE
FROM M2Error IMPORT MoveError ;
FROM M2Debug IMPORT Assert ;
FROM Storage IMPORT ALLOCATE ;
+FROM M2StackSpell IMPORT GetSpellHint ;
FROM Indexing IMPORT Index, InitIndex, KillIndex, GetIndice, PutIndice,
DeleteIndice, HighIndice ;
len,
ini : INTEGER ;
vowel,
+ importHint,
+ exportHint,
+ withStackHint,
glyph,
chain,
root,
ini := 0 ;
glyph := FALSE ; (* Nothing to output yet. *)
vowel := FALSE ; (* Check for a vowel when outputing string? *)
+ importHint := FALSE;
+ exportHint := FALSE ;
+ withStackHint := FALSE ;
quotes := TRUE ;
positive := TRUE ;
root := FALSE ;
currentCol := findColorType (input) ;
beginCol := unsetColor ;
endCol := unsetColor ;
- stackPtr := 0
+ stackPtr := 0 ;
END
END initErrorBlock ;
THEN
toblock.stackPtr := fromblock.stackPtr ;
toblock.colorStack := fromblock.colorStack ;
- popColor (toblock) (* and restore the color from the push start. *)
+ popColor (toblock) (* Lastly restore the color from the push start. *)
ELSE
IF fromblock.quotes
THEN
- (* string needs to be quoted. *)
+ (* The string needs to be quoted. *)
IF toblock.currentCol = unsetColor
THEN
- (* caller has not yet assigned a color, so use the callee color at the end. *)
+ (* The caller has not yet assigned a color, so use the callee color at the end. *)
OutOpenQuote (toblock) ;
OutGlyphS (toblock, fromblock.out) ;
OutCloseQuote (toblock) ;
changeColor (toblock, fromblock.currentCol)
ELSE
shutdownColor (fromblock) ;
- (* caller has assigned a color, so use it after the new string. *)
+ (* The caller has assigned a color, so use it after the new string. *)
c := toblock.currentCol ;
OutOpenQuote (toblock) ;
OutGlyphS (toblock, fromblock.out) ;
ELSE
IF toblock.currentCol = unsetColor
THEN
- OutGlyphS (toblock, fromblock.out) ;
+ JoinSentances (toblock, fromblock.out) ;
toblock.endCol := fromblock.endCol ;
changeColor (toblock, fromblock.endCol)
ELSE
pushColor (toblock) ;
- OutGlyphS (toblock, fromblock.out) ;
+ JoinSentances (toblock, fromblock.out) ;
toblock.endCol := fromblock.endCol ;
popColor (toblock)
END
toblock.chain := fromblock.chain ;
toblock.root := fromblock.root ;
toblock.ini := fromblock.ini ;
- toblock.type := fromblock.type (* might have been changed by the callee. *)
+ toblock.type := fromblock.type (* It might have been changed by the callee. *)
END pop ;
(*
op := {'!'|'a'|'c'|'d'|'k'|'n'|'p'|'q'|'s'|'t'|'u'|'v'|
'A'|'B'|'C'|'D'|'E'|'F'|'G'|'H'|'K'|'M'|'N'|
- 'O'|'P'|'Q'|'R'|'S'|'T'|'U'|'V'|'W'|'X'|'Y'|'Z'} then =:
+ 'O'|'P'|'Q'|'R'|'S'|'T'|'U'|'V'|'W'|'X'|'Y'|'Z'|
+ '&' } then =:
*)
PROCEDURE op (VAR eb: errorBlock;
'X': pushOutput (eb) |
'Y': processDefine (eb) |
'Z': popOutput (eb) |
+ '&': continuation (eb, sym, bol) ;
+ DEC (eb.ini) |
':': ifNonNulThen (eb, sym) ;
DEC (eb.ini) |
'1': InternalError ('incorrect format spec, expecting %1 rather than % spec 1') |
END op ;
+(*
+ continuation := {':'|'1'|'2'|'3'|'4'|'i'|'s'|'x'|'w'} =:
+*)
+
+PROCEDURE continuation (VAR eb: errorBlock;
+ VAR sym: ARRAY OF CARDINAL; bol: CARDINAL) ;
+BEGIN
+ Assert ((eb.ini < eb.len) AND (char (eb.in, eb.ini) = '&')) ;
+ INC (eb.ini) ;
+ WHILE (eb.ini < eb.len) AND (char (eb.in, eb.ini) # '}') DO
+ CASE char (eb.in, eb.ini) OF
+
+ ':': ifNonNulThen (eb, sym) ;
+ DEC (eb.ini) |
+ '1': InternalError ('incorrect format spec, expecting %1 rather than % spec 1') |
+ '2': InternalError ('incorrect format spec, expecting %2 rather than % spec 2') |
+ '3': InternalError ('incorrect format spec, expecting %3 rather than % spec 3') |
+ '4': InternalError ('incorrect format spec, expecting %4 rather than % spec 4') |
+ 'i': AddImportsHint (eb) |
+ 's': SpellHint (eb, sym, bol) |
+ 'x': AddExportsHint (eb) |
+ 'w': AddWithStackHint (eb)
+
+ ELSE
+ InternalFormat (eb, 'expecting one of [:1234isxw]',
+ __LINE__)
+ END ;
+ INC (eb.ini)
+ END ;
+ IF (eb.ini < eb.len) AND (char (eb.in, eb.ini) # '}')
+ THEN
+ DEC (eb.ini)
+ END
+END continuation ;
+
+
(*
percenttoken := '%' (
'1' % doOperand(1) %
END percenttoken ;
+(*
+ IsPunct - returns TRUE if ch is a punctuation character.
+*)
+
+PROCEDURE IsPunct (ch: CHAR) : BOOLEAN ;
+BEGIN
+ RETURN (ch = '.') OR (ch = ',') OR (ch = ':') OR
+ (ch = ';') OR (ch = '!') OR (ch = '(') OR
+ (ch = ')') OR (ch = '[') OR (ch = ']')
+END IsPunct ;
+
+
+(*
+ JoinSentances - join s onto eb. It removes trailing
+ spaces from eb if s starts with a punctuation
+ character.
+*)
+
+PROCEDURE JoinSentances (VAR eb: errorBlock; s: String) ;
+VAR
+ i: INTEGER ;
+BEGIN
+ IF (s # NIL) AND (Length (s) > 0)
+ THEN
+ IF IsPunct (char (s, 0))
+ THEN
+ eb.out := RemoveWhitePostfix (eb.out)
+ END ;
+ flushColor (eb) ;
+ eb.out := ConCat (eb.out, s) ;
+ eb.glyph := TRUE ;
+ eb.quotes := FALSE
+ END
+END JoinSentances ;
+
+
+(*
+ SpellHint -
+*)
+
+PROCEDURE SpellHint (VAR eb: errorBlock; sym: ARRAY OF CARDINAL; bol: CARDINAL) ;
+BEGIN
+ IF (bol <= HIGH (sym)) AND IsUnknown (sym[bol])
+ THEN
+ JoinSentances (eb, GetSpellHint (sym[bol]))
+ END
+END SpellHint ;
+
+
+(*
+ AddImportsHint -
+*)
+
+PROCEDURE AddImportsHint (VAR eb: errorBlock) ;
+BEGIN
+ eb.importHint := TRUE
+END AddImportsHint ;
+
+
+(*
+ AddExportsHint -
+*)
+
+PROCEDURE AddExportsHint (VAR eb: errorBlock) ;
+BEGIN
+ eb.exportHint := TRUE
+END AddExportsHint ;
+
+
+(*
+ AddWithStackHint -
+*)
+
+PROCEDURE AddWithStackHint (VAR eb: errorBlock) ;
+BEGIN
+ eb.withStackHint := TRUE
+END AddWithStackHint ;
+
+
(*
changeColor - changes to color, c.
*)
printf1 ("\nLength (out) = %d", l) ;
printf1 ("\nlen = %d", eb.len) ;
printf1 ("\nhighplus1 = %d", eb.highplus1) ;
- printf1 ("\nglyph = %d", eb.glyph) ;
+ (* printf1 ("\nglyph = %d", eb.glyph) ;
printf1 ("\nquotes = %d", eb.quotes) ;
printf1 ("\npositive = %d", eb.positive) ;
+ *)
printf0 ("\nbeginCol = ") ; dumpColorType (eb.beginCol) ;
printf0 ("\nendCol = ") ; dumpColorType (eb.endCol) ;
printf0 ("\ncurrentCol = ") ; dumpColorType (eb.currentCol) ;
FROM SymbolConversion IMPORT GccKnowsAbout ;
FROM M2Diagnostic IMPORT Diagnostic, InitMemDiagnostic, MemIncr, MemSet ;
-IMPORT M2Error, FIO, SFIO, DynamicStrings, StdIO ;
-
+IMPORT M2Error, FIO, SFIO, DynamicStrings, StdIO, M2StackSpell ;
CONST
DebugStackOn = TRUE ;
DisplayStack
ELSIF IsUnknown (ProcSym)
THEN
- MetaError1 ('{%1Ua} is not recognised as a procedure, check declaration or import', ProcSym) ;
- PopN (NoOfParam + 2)
+ (* Spellcheck. *)
+ MetaError1 ('{%1Ua} is not recognised as a procedure {%1&s}', ProcSym) ;
+ PopN (NoOfParam + 2) ;
+ UnknownReported (ProcSym)
ELSE
DisplayStack ;
BuildRealProcedureCall (tokno) ;
THEN
IF IsUnknown(Proc)
THEN
- MetaError1('{%1Ua} is not recognised as a procedure, check declaration or import', Proc)
+ (* Spellcheck. *)
+ MetaError1('{%1Ua} is not recognised as a procedure, check declaration or import {%1&s}', Proc) ;
+ UnknownReported (Proc)
ELSE
- MetaErrors1('{%1a} is not recognised as a procedure, check declaration or import',
+ (* --fixme-- filter on Var, Const, Procedure. *)
+ MetaErrors1('{%1a} is not recognised as a procedure, check declaration or import {%1&s}',
'{%1Ua} is not recognised as a procedure, check declaration or import',
Proc)
END
THEN
IF IsUnknown(FormalType)
THEN
+ (* Spellcheck. *)
FailParameter(tokpos,
- 'procedure parameter type is undeclared',
+ 'procedure parameter type is undeclared {%1&s}',
Actual, ProcSym, i) ;
RETURN
END ;
s1 := Mark(DescribeType(Type)) ;
s := ConCat(ConCat(s, Mark(InitString('] OF '))), s1)
ELSE
- IF IsUnknown(Type)
+ IF IsUnknown (Type)
THEN
+ (* Spellcheck. *)
s1 := Mark(InitStringCharStar(KeyToCharStar(GetSymName(Type)))) ;
- s := Sprintf1(Mark(InitString('%s (currently unknown, check declaration or import)')),
+ s := Sprintf1(Mark(InitString('%s (currently unknown, check declaration or import) {%1&s}')),
s1)
ELSE
s := InitStringCharStar(KeyToCharStar(GetSymName(Type)))
(* Compile time stack restored to entry state. *)
IF IsUnknown (ProcSym)
THEN
+ (* Spellcheck. *)
paramtok := OperandTtok (1) ;
combinedtok := MakeVirtual2Tok (functok, paramtok) ;
- MetaErrorT1 (functok, 'procedure function {%1Ea} is undefined', ProcSym) ;
+ MetaErrorT1 (functok, 'procedure function {%1Ea} is undefined {%1&s}', ProcSym) ;
+ UnknownReported (ProcSym) ;
PopN (NoOfParam + 2) ;
(* Fake return value to continue compiling. *)
PushT (MakeConstLit (combinedtok, MakeKey ('0'), NulSym))
PROCEDURE GetQualidentImport (tokno: CARDINAL;
n: Name; module: Name) : CARDINAL ;
VAR
+ sym,
ModSym: CARDINAL ;
BEGIN
ModSym := MakeDefinitionSource (tokno, module) ;
Assert(IsDefImp(ModSym)) ;
IF (GetExported (tokno, ModSym, n)=NulSym) OR IsUnknown (GetExported (tokno, ModSym, n))
THEN
- MetaErrorN2 ('module %a does not export procedure %a which is a necessary component of the runtime system, hint check the path and library/language variant',
- module, n) ;
+ sym := GetExported (tokno, ModSym, n) ;
+ IF IsUnknown (sym)
+ THEN
+ (* Spellcheck. *)
+ MetaErrorN2 ('module %a does not export procedure %a which is a necessary component' +
+ ' of the runtime system, hint check the path and library/language variant',
+ module, n) ;
+ MetaErrorT1 (tokno, 'unknown symbol {%1&s}', sym) ;
+ UnknownReported (sym)
+ ELSE
+ MetaErrorN2 ('module %a does not export procedure %a which is a necessary component' +
+ ' of the runtime system, hint check the path and library/language variant',
+ module, n)
+ END ;
FlushErrors ;
RETURN NulSym
END ;
PopTtok (ProcSym, tok) ;
IF IsUnknown (Type)
THEN
- (* not sensible to try and recover when we dont know the return type. *)
+ (* Spellcheck. *)
+ (* It is sensible not to try and recover when we dont know the return type. *)
MetaErrorT1 (typetok,
- 'undeclared type found in builtin procedure function {%AkVAL} {%1ad}',
- Type)
- (* non recoverable error. *)
+ 'undeclared type found in builtin procedure function {%AkVAL} {%1ad} {%1&s}',
+ Type) ;
+ (* Non recoverable error. *)
+ UnknownReported (Type)
ELSIF ConstExprError (ProcSym, Exp, exptok, ConstExpr)
THEN
(* Generate fake result. *)
exptok := OperandTok (1) ;
IF IsUnknown (Type)
THEN
- (* we cannot recover if we dont have a type. *)
- MetaErrorT1 (typetok, 'undeclared type {%1Aad} found in {%kCAST}', Type)
- (* non recoverable error. *)
+ (* Spellcheck. *)
+ (* We cannot recover if we dont have a type. *)
+ MetaErrorT1 (typetok, 'undeclared type {%1Aad} found in {%kCAST} {%1&s}', Type) ;
+ (* Non recoverable error. *)
+ UnknownReported (Type)
ELSIF ConstExprError (ProcSym, Exp, exptok, ConstExpr)
THEN
(* Generate fake result. *)
PopT (ProcSym) ;
IF IsUnknown (Type)
THEN
- (* we cannot recover if we dont have a type. *)
- MetaErrorT1 (typetok, 'undeclared type {%1Aad} found in {%kCONVERT}', Type)
- (* non recoverable error. *)
+ (* Spellcheck. *)
+ (* We cannot recover if we dont have a type. *)
+ MetaErrorT1 (typetok, 'undeclared type {%1Aad} found in {%kCONVERT} {%1&s}', Type) ;
+ UnknownReported (Type)
+ (* Non recoverable error. *)
ELSIF IsUnknown (Exp)
THEN
- (* we cannot recover if we dont have a type. *)
- MetaErrorT1 (typetok, 'unknown {%1Ad} {%1ad} found in {%kCONVERT}', Exp)
- (* non recoverable error. *)
+ (* Spellcheck. *)
+ (* We cannot recover if we dont have an expression. *)
+ MetaErrorT1 (typetok, 'unknown {%1Ad} {%1ad} found in {%kCONVERT} {%1&s}', Exp) ;
+ UnknownReported (Exp)
+ (* Non recoverable error. *)
ELSIF ConstExprError (ProcSym, Exp, exptok, ConstExpr)
THEN
(* Generate fake result. *)
THEN
IF (Type = NulSym) OR IsPartialUnbounded (Type) OR IsUnknown (Type)
THEN
- MetaError1 ('the type used in the formal parameter declaration in {%1Md} {%1a} is unknown',
- BlockSym)
+ IF IsUnknown (Type)
+ THEN
+ (* Spellcheck. *)
+ MetaError2 ('the type used in the formal parameter declaration in {%1Md} {%1a} is unknown {%2&s}',
+ BlockSym, Type) ;
+ UnknownReported (Type)
+ ELSE
+ MetaError1 ('the type used in the formal parameter declaration in {%1Md} {%1a} is unknown',
+ BlockSym)
+ END
ELSE
+ (* --fixme-- filter spellcheck on type. *)
MetaError2 ('the type {%1Ead} used in the formal parameter declaration in {%2Md} {%2a} was not declared as a type',
Type, BlockSym)
END
BlockSym)
ELSIF IsPartialUnbounded(Type) OR IsUnknown(Type)
THEN
- MetaError2 ('the type {%1EMad} used during variable declaration section in procedure {%2ad} is unknown',
+ (* Spellcheck. *)
+ MetaError2 ('the type {%1EMad} used during variable declaration section in procedure {%2ad} is unknown {%1&s}',
Type, BlockSym) ;
MetaError2 ('the type {%1Ead} used during variable declaration section in procedure {%2Mad} is unknown',
- Type, BlockSym)
+ Type, BlockSym) ;
+ UnknownReported (Type)
ELSE
MetaError2 ('the {%1d} {%1Ea} is not a type and therefore cannot be used to declare a variable in {%2d} {%2a}',
Type, BlockSym)
MetaErrorT1 (ptrtok, '{%1ad} has no type and therefore cannot be dereferenced by ^', Sym1)
ELSIF IsUnknown (Sym1)
THEN
- MetaError1 ('{%1EMad} is undefined and therefore {%1ad}^ cannot be resolved', Sym1)
+ (* Spellcheck. *)
+ MetaError1 ('{%1EMad} is undefined and therefore {%1ad}^ cannot be resolved {%1&s}', Sym1) ;
+ UnknownReported (Sym1)
ELSE
combinedtok := MakeVirtual2Tok (destok, ptrtok) ;
IF IsPointer (Type1)
END ;
StartScope (Type)
END ;
+ M2StackSpell.Push (Type) ;
DisplayStack ;
END StartBuildWith ;
BEGIN
DisplayStack ;
EndScope ;
- PopWith
+ PopWith ;
+ M2StackSpell.Pop ;
; DisplayStack ;
END EndBuildWith ;
i, n, rw,
Sym, Type: CARDINAL ;
BEGIN
- n := NoOfItemsInStackAddress(WithStack) ;
+ n := NoOfItemsInStackAddress (WithStack) ;
IF (n>0) AND (NOT SuppressWith)
THEN
PopTFrwtok (Sym, Type, rw, tokpos) ;
Assert (tokpos # UnknownTokenNo) ;
- (* inner WITH always has precidence *)
- i := 1 ; (* top of stack *)
- WHILE i<=n DO
- (* WriteString('Checking for a with') ; *)
- f := PeepAddress (WithStack, i) ;
- WITH f^ DO
- IF IsRecordField (Sym) AND (GetRecord (GetParent (Sym)) = RecordType)
- THEN
- IF IsUnused (Sym)
+ IF IsUnknown (Sym)
+ THEN
+ MetaErrorT1 (tokpos, '{%1ad} is unknown {%1&s}', Sym) ;
+ UnknownReported (Sym)
+ ELSE
+ (* Inner WITH always has precedence. *)
+ i := 1 ; (* top of stack *)
+ WHILE i<=n DO
+ (* WriteString('Checking for a with') ; *)
+ f := PeepAddress (WithStack, i) ;
+ WITH f^ DO
+ IF IsRecordField (Sym) AND (GetRecord (GetParent (Sym)) = RecordType)
THEN
- MetaError1('record field {%1Dad} was declared as unused by a pragma', Sym)
- END ;
- (* Fake a RecordSym.op *)
- PushTFrwtok (RecordRef, RecordType, rw, RecordTokPos) ;
- PushTFtok (Sym, Type, tokpos) ;
- BuildAccessWithField ;
- PopTFrw (Sym, Type, rw) ;
- i := n+1 (* Finish loop. *)
- ELSE
- INC (i)
+ IF IsUnused (Sym)
+ THEN
+ MetaError1('record field {%1Dad} was declared as unused by a pragma', Sym)
+ END ;
+ (* Fake a RecordSym.op *)
+ PushTFrwtok (RecordRef, RecordType, rw, RecordTokPos) ;
+ PushTFtok (Sym, Type, tokpos) ;
+ BuildAccessWithField ;
+ PopTFrw (Sym, Type, rw) ;
+ i := n+1 (* Finish loop. *)
+ ELSE
+ INC (i)
+ END
END
END
END ;
typepos := tokpos
ELSIF IsUnknown (Type)
THEN
- n := GetSymName (Type) ;
- WriteFormat1 ('set type %a is undefined', n) ;
+ (* Spellcheck. *)
+ MetaError1 ('set type {%1a} is undefined {%1&s}', Type) ;
+ UnknownReported (Type) ;
Type := Bitset
ELSIF NOT IsSet (SkipType (Type))
THEN
- n := GetSymName (Type) ;
- WriteFormat1('expecting a set type %a', n) ;
+ MetaError1 ('expecting a set type {%1a} and not a {%1d}', Type) ;
Type := Bitset
ELSE
Type := SkipType (Type) ;
type := GetSType (sym) ;
IF IsUnknown (sym)
THEN
- MetaErrorT1 (tokpos, '{%1EUad} has not been declared', sym) ;
+ (* Spellcheck. *)
+ MetaErrorT1 (tokpos, '{%1EUad} has not been declared {%1&s}', sym) ;
UnknownReported (sym)
ELSIF IsPseudoSystemFunction (sym) OR IsPseudoBaseFunction (sym)
THEN
--- /dev/null
+(* M2StackSpell.def definition module for M2StackSpell.mod.
+
+Copyright (C) 2025 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaiusmod2@gmail.com>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. *)
+
+DEFINITION MODULE M2StackSpell ;
+
+FROM DynamicStrings IMPORT String ;
+FROM NameKey IMPORT Name ;
+
+
+(*
+ GetSpellHint - return a string describing a spelling hint.
+*)
+
+PROCEDURE GetSpellHint (unknown: CARDINAL) : String ;
+
+
+(*
+ Push - push a scope onto the spelling stack.
+ sym might be a ModSym, DefImpSym or a varsym
+ of a record type denoting a with statement.
+*)
+
+PROCEDURE Push (sym: CARDINAL) ;
+
+
+(*
+ Pop - remove the top scope from the spelling stack.
+*)
+
+PROCEDURE Pop ;
+
+
+(*
+ GetRecordField - return the record field containing fieldName.
+ An error is generated if the fieldName is not
+ found in record.
+*)
+
+PROCEDURE GetRecordField (tokno: CARDINAL;
+ record: CARDINAL;
+ fieldName: Name) : CARDINAL ;
+
+
+END M2StackSpell.
--- /dev/null
+(* M2StackSpell.mod maintain a stack of scopes used in spell checks.
+
+Copyright (C) 2025 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaiusmod2@gmail.com>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. *)
+
+IMPLEMENTATION MODULE M2StackSpell ;
+
+FROM SymbolTable IMPORT NulSym, IsModule, IsDefImp, IsRecord,
+ IsEnumeration, IsProcedure, GetNth,
+ GetSymName, GetSym, GetLocalSym,
+ UnknownReported,
+ ForeachProcedureDo, ForeachLocalSymDo,
+ ForeachFieldEnumerationDo ;
+
+FROM SymbolKey IMPORT PerformOperation ;
+FROM DynamicStrings IMPORT InitStringCharStar, InitString, Mark, string, ConCat ;
+FROM FormatStrings IMPORT Sprintf1, Sprintf2, Sprintf3 ;
+FROM NameKey IMPORT KeyToCharStar ;
+FROM M2MetaError IMPORT MetaErrorStringT0 ;
+
+FROM M2StackWord IMPORT StackOfWord, PushWord, PopWord,
+ InitStackWord, KillStackWord,
+ NoOfItemsInStackWord, PeepWord ;
+
+FROM CDataTypes IMPORT ConstCharStar ;
+
+IMPORT m2spellcheck ;
+FROM m2spellcheck IMPORT Candidates ;
+
+
+VAR
+ DefaultStack: StackOfWord ;
+
+
+(*
+ GetRecordField - return the record field containing fieldName.
+ An error is generated if the fieldName is not
+ found in record.
+*)
+
+PROCEDURE GetRecordField (tokno: CARDINAL;
+ record: CARDINAL;
+ fieldName: Name) : CARDINAL ;
+VAR
+ str : String ;
+ sym : CARDINAL ;
+ recordName: Name ;
+ content : ConstCharStar ;
+ cand : Candidates ;
+ fieldStr,
+ recordStr,
+ contentStr: String ;
+BEGIN
+ sym := GetLocalSym (record, fieldName) ;
+ IF sym = NulSym
+ THEN
+ recordName := GetSymName (record) ;
+ content := NIL ;
+ cand := m2spellcheck.InitCandidates () ;
+ IF PushCandidates (cand, record) > 0
+ THEN
+ content := m2spellcheck.FindClosestCharStar (cand,
+ KeyToCharStar (fieldName))
+ END ;
+ fieldStr := Mark (InitStringCharStar (KeyToCharStar (fieldName))) ;
+ recordStr := Mark (InitStringCharStar (KeyToCharStar (recordName))) ;
+ IF content = NIL
+ THEN
+ str := Sprintf2 (Mark (InitString ("field %s does not exist within record %s")),
+ fieldStr, recordStr)
+ ELSE
+ contentStr := Mark (InitStringCharStar (content)) ;
+ str := Sprintf3 (Mark (InitString ("field %s does not exist within record %s, did you mean %s?")),
+ fieldStr, recordStr, contentStr)
+ END ;
+ MetaErrorStringT0 (tokno, str) ;
+ m2spellcheck.KillCandidates (cand)
+ END ;
+ RETURN sym
+END GetRecordField ;
+
+
+(*
+ Push - push a scope onto the spelling stack.
+ sym might be a ModSym, DefImpSym or a varsym
+ of a record type denoting a with statement.
+*)
+
+PROCEDURE Push (sym: CARDINAL) ;
+BEGIN
+ PushWord (DefaultStack, sym)
+END Push ;
+
+
+(*
+ Pop - remove the top scope from the spelling stack.
+*)
+
+PROCEDURE Pop ;
+BEGIN
+ IF PopWord (DefaultStack) = 0
+ THEN
+ END
+END Pop ;
+
+
+VAR
+ PushCount : CARDINAL ;
+ PushCandidate: Candidates ;
+
+(*
+ PushName -
+*)
+
+PROCEDURE PushName (sym: CARDINAL) ;
+VAR
+ str: String ;
+BEGIN
+ str := InitStringCharStar (KeyToCharStar (GetSymName (sym))) ;
+ m2spellcheck.Push (PushCandidate, string (str)) ;
+ (* str := KillString (str) *)
+ INC (PushCount)
+END PushName ;
+
+
+(*
+ ForeachRecordFieldDo -
+*)
+
+PROCEDURE ForeachRecordFieldDo (record: CARDINAL; op: PerformOperation) ;
+VAR
+ i : CARDINAL ;
+ field: CARDINAL ;
+BEGIN
+ i := 1 ;
+ REPEAT
+ field := GetNth (record, i) ;
+ IF field # NulSym
+ THEN
+ op (field)
+ END ;
+ INC (i)
+ UNTIL field = NulSym
+END ForeachRecordFieldDo ;
+
+
+(*
+ PushCandidates -
+*)
+
+PROCEDURE PushCandidates (cand: Candidates; sym: CARDINAL) : CARDINAL ;
+BEGIN
+ PushCount := 0 ;
+ PushCandidate := cand ;
+ IF IsModule (sym) OR IsDefImp (sym)
+ THEN
+ ForeachProcedureDo (sym, PushName) ;
+ ForeachLocalSymDo (sym, PushName)
+ ELSIF IsEnumeration (sym)
+ THEN
+ ForeachFieldEnumerationDo (sym, PushName)
+ ELSIF IsRecord (sym)
+ THEN
+ ForeachRecordFieldDo (sym, PushName)
+ END ;
+ RETURN PushCount
+END PushCandidates ;
+
+
+(*
+ CheckForHintStr - lookup a spell hint matching misspelt. If one exists
+ then append it to HintStr. Return HintStr.
+*)
+
+PROCEDURE CheckForHintStr (sym: CARDINAL;
+ HintStr, misspelt: String) : String ;
+VAR
+ cand : Candidates ;
+ content: ConstCharStar ;
+ str : String ;
+BEGIN
+ IF IsModule (sym) OR IsDefImp (sym) OR IsProcedure (sym) OR
+ IsRecord (sym) OR IsEnumeration (sym)
+ THEN
+ cand := m2spellcheck.InitCandidates () ;
+ IF PushCandidates (cand, sym) > 1
+ THEN
+ content := m2spellcheck.FindClosestCharStar (cand, string (misspelt)) ;
+ ELSE
+ content := NIL
+ END ;
+ m2spellcheck.KillCandidates (cand) ;
+ IF content # NIL
+ THEN
+ str := InitStringCharStar (content) ;
+ IF HintStr = NIL
+ THEN
+ RETURN Sprintf1 (Mark (InitString (", did you mean %s")), str)
+ ELSE
+ RETURN Sprintf2 (Mark (InitString ("%s or %s")), HintStr, str)
+ END
+ END
+ END ;
+ RETURN HintStr
+END CheckForHintStr ;
+
+
+(*
+ AddPunctuation - adds punct to the end of str providing that str is non NIL.
+*)
+
+PROCEDURE AddPunctuation (str: String; punct: ARRAY OF CHAR) : String ;
+BEGIN
+ IF str = NIL
+ THEN
+ RETURN NIL
+ ELSE
+ RETURN ConCat (str, Mark (InitString (punct)))
+ END
+END AddPunctuation ;
+
+
+(*
+ GetSpellHint - return a string describing a spelling hint.
+*)
+
+PROCEDURE GetSpellHint (unknown: CARDINAL) : String ;
+VAR
+ i, n : CARDINAL ;
+ sym : CARDINAL ;
+ misspell,
+ HintStr : String ;
+BEGIN
+ misspell := InitStringCharStar (KeyToCharStar (GetSymName (unknown))) ;
+ HintStr := NIL ;
+ n := NoOfItemsInStackWord (DefaultStack) ;
+ i := 1 ;
+ WHILE (i <= n) AND (HintStr = NIL) DO
+ sym := PeepWord (DefaultStack, i) ;
+ HintStr := CheckForHintStr (sym, HintStr, misspell) ;
+ IF IsModule (sym) OR IsDefImp (sym)
+ THEN
+ (* Cannot see beyond a module scope. *)
+ RETURN AddPunctuation (HintStr, '?')
+ END ;
+ INC (i)
+ END ;
+ RETURN AddPunctuation (HintStr, '?')
+END GetSpellHint ;
+
+
+(*
+ Init -
+*)
+
+PROCEDURE Init ;
+BEGIN
+ DefaultStack := InitStackWord ()
+END Init ;
+
+
+BEGIN
+ Init
+END M2StackSpell.
THEN
IF isunknown
THEN
+ (* --fixme-- spellcheck. *)
MetaError2('attempting to declare a type {%1ad} to a type which is itself and also unknown {%2ad}',
Sym, Type)
ELSE
FROM P2SymBuild IMPORT BuildString, BuildNumber ;
FROM M2MetaError IMPORT MetaErrorT0, MetaErrorT2 ;
FROM M2CaseList IMPORT ElseCase ;
+FROM M2StackSpell IMPORT GetRecordField ;
FROM M2Reserved IMPORT tokToTok, toktype,
NulTok, ImportTok, ExportTok, QualifiedTok, UnQualifiedTok,
StartScope(Type) %
Ident
% PopTtok (name, tok) ;
- Sym := GetLocalSym(Type, name) ;
- IF Sym=NulSym
- THEN
- n1 := GetSymName(Type) ;
- WriteFormat2('field %a does not exist within record %a', name, n1)
- END ;
- Type := GetType(Sym) ;
+ Sym := GetRecordField (GetTokenNo () -1, Type, name) ;
+ Type := GetType (Sym) ;
PushTFtok (Sym, Type, tok) ;
EndScope ;
- PushT(1) ;
+ PushT (1) ;
BuildDesignatorRecord (dotpostok) %
| "[" ArrayExpList
"]"
FROM FifoQueue IMPORT GetSubrangeFromFifoQueue ;
FROM M2Reserved IMPORT NulTok, ImportTok ;
+
IMPORT M2Error ;
+IMPORT M2StackSpell ;
(*
StartScope (ModuleSym) ;
Assert (IsDefImp (ModuleSym)) ;
Assert (CompilingDefinitionModule ()) ;
+ M2StackSpell.Push (ModuleSym) ;
PushT (name) ;
M2Error.EnterDefinitionScope (name)
END P3StartBuildDefModule ;
Assert(CompilingDefinitionModule()) ;
CheckForUnknownInModule ;
EndScope ;
+ M2StackSpell.Pop ;
PopT(NameEnd) ;
PopT(NameStart) ;
IF NameStart#NameEnd
Assert (IsDefImp(ModuleSym)) ;
Assert (CompilingImplementationModule()) ;
PushT (name) ;
- M2Error.EnterImplementationScope (name)
+ M2Error.EnterImplementationScope (name) ;
+ M2StackSpell.Push (ModuleSym)
END P3StartBuildImpModule ;
Assert(CompilingImplementationModule()) ;
CheckForUnknownInModule ;
EndScope ;
+ M2StackSpell.Pop ;
PopT(NameEnd) ;
PopT(NameStart) ;
IF NameStart#NameEnd
Assert(CompilingProgramModule()) ;
Assert(NOT IsDefImp(ModuleSym)) ;
PushT(name) ;
- M2Error.EnterProgramScope (name)
+ M2Error.EnterProgramScope (name) ;
+ M2StackSpell.Push (ModuleSym)
END P3StartBuildProgModule ;
WriteFormat0('too many errors in pass 3') ;
FlushErrors
END ;
- M2Error.LeaveErrorScope
+ M2Error.LeaveErrorScope ;
+ M2StackSpell.Pop
END P3EndBuildProgModule ;
Assert(NOT IsDefImp(ModuleSym)) ;
SetCurrentModule(ModuleSym) ;
PushT(name) ;
- M2Error.EnterModuleScope (name)
+ M2Error.EnterModuleScope (name) ;
+ M2StackSpell.Push (ModuleSym)
END StartBuildInnerModule ;
FlushErrors
END ;
SetCurrentModule(GetModuleScope(GetCurrentModule())) ;
- M2Error.LeaveErrorScope
+ M2Error.LeaveErrorScope ;
+ M2StackSpell.Pop
END EndBuildInnerModule ;
Assert (IsProcedure (ProcSym)) ;
PushTtok (ProcSym, tok) ;
StartScope (ProcSym) ;
- M2Error.EnterProcedureScope (name)
+ M2Error.EnterProcedureScope (name) ;
+ M2StackSpell.Push (ProcSym)
END StartBuildProcedure ;
FlushErrors
END ;
EndScope ;
- M2Error.LeaveErrorScope
+ M2Error.LeaveErrorScope ;
+ M2StackSpell.Pop
END EndBuildProcedure ;
THEN
PopT(ProcSym) ;
PopT(NameStart) ;
- EndScope
+ EndScope ;
+ M2StackSpell.Pop
END
END BuildProcedureHeading ;
BEGIN
PopN (2) ;
EndScope ;
- M2Error.LeaveErrorScope
+ M2Error.LeaveErrorScope ;
+ M2StackSpell.Pop
END EndBuildForward ;
WriteString('RequestSym for: ') ; WriteKey(SymName) ; WriteLn ;
*)
Sym := GetSym (SymName) ;
- IF Sym=NulSym
+ IF Sym = NulSym
THEN
Sym := GetSymFromUnknownTree (SymName) ;
- IF Sym=NulSym
+ IF Sym = NulSym
THEN
- (* Make unknown *)
+ (* Make unknown. *)
NewSym (Sym) ;
FillInUnknownFields (tok, Sym, SymName) ;
(* Add to unknown tree *)
EXTERN void _M2_M2StateCheck_init (int argc, char *argv[], char *envp[]);
EXTERN void _M2_P3Build_init (int argc, char *argv[], char *envp[]);
EXTERN void _M2_M2Diagnostic_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_M2StackSpell_init (int argc, char *argv[], char *envp[]);
EXTERN void exit (int);
EXTERN void M2Comp_compile (const char *filename);
EXTERN void RTExceptions_DefaultErrorCatch (void);
_M2_M2Check_init (0, NULL, NULL);
_M2_M2LangDump_init (0, NULL, NULL);
_M2_M2StateCheck_init (0, NULL, NULL);
+ _M2_M2StackSpell_init (0, NULL, NULL);
_M2_P3Build_init (0, NULL, NULL);
M2Comp_compile (filename);
}
--- /dev/null
+/* m2spellcheck.cc provides an interface to GCC expression trees.
+
+Copyright (C) 2025 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaiusmod2@gmail.com>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
+
+#include "gcc-consolidation.h"
+
+#include "../gm2-lang.h"
+#include "../m2-tree.h"
+
+#define m2spellcheck_c
+#include "m2assert.h"
+#include "m2builtins.h"
+#include "m2convert.h"
+#include "m2decl.h"
+#include "m2expr.h"
+#include "m2spellcheck.h"
+
+
+/* Define the hidden type Candidates declared in the definition module. */
+
+typedef struct Candidates_t {
+ auto_vec<const char *> candidates_array;
+ struct Candidates_t *next;
+} Candidates;
+
+
+static Candidates *freeList = NULL;
+
+
+/* InitCandidates create an empty candidate array. */
+
+void *
+m2spellcheck_InitCandidates (void)
+{
+ Candidates *c = NULL;
+ if (freeList == NULL)
+ c = (Candidates *) xmalloc (sizeof (Candidates));
+ else
+ {
+ c = freeList;
+ freeList = freeList->next;
+ }
+ memset (c, 0, sizeof (Candidates));
+ return c;
+}
+
+/* Push a string to the Candidates array.
+ The candidates array will contain str at the end. */
+
+static
+void
+Push (Candidates *cand, const char *name)
+{
+ cand->candidates_array.safe_push (name);
+}
+
+/* Push a string to the Candidates array.
+ The candidates array will contain str at the end. */
+
+void
+m2spellcheck_Push (void *cand, const char *name)
+{
+ Push (static_cast<Candidates *> (cand), name);
+}
+
+static
+void
+KillCandidates (Candidates **cand)
+{
+ // --fixme-- deallocate and zero the candidates_array.
+ (*cand)->next = freeList;
+ freeList = *cand;
+ (*cand) = NULL;
+}
+
+/* KillCandidates deallocates the candidates array and set (*cand) to NULL.
+ (*cand) is placed into the m2spellcheck module freeList. */
+
+void
+m2spellcheck_KillCandidates (void **cand)
+{
+ KillCandidates (reinterpret_cast<Candidates **> (cand));
+}
+
+/* FindClosestCharStar return the closest match to name found within
+ the candidates_array. NULL is returned if no close match is found. */
+
+const char*
+FindClosestCharStar (Candidates *cand, const char *name)
+{
+ return find_closest_string (name, &cand->candidates_array);
+}
+
+const char*
+m2spellcheck_FindClosestCharStar (void *cand, const char *name)
+{
+ return FindClosestCharStar (static_cast<Candidates *> (cand),
+ name);
+}
--- /dev/null
+(* m2spellcheck.def definition module for m2spellcheck.cc.
+
+Copyright (C) 2025 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaiusmod2@gmail.com>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. *)
+
+DEFINITION MODULE FOR "C" m2spellcheck ;
+
+FROM CDataTypes IMPORT ConstCharStar ;
+FROM SYSTEM IMPORT ADDRESS ;
+
+
+TYPE
+ Candidates = ADDRESS ;
+
+
+(*
+ InitCandidates - create an empty candidate array.
+*)
+
+PROCEDURE InitCandidates () : Candidates ;
+
+
+(*
+ Push - push a string to the Candidates array.
+ The possibly new candidates array is returned which
+ will contain str at the end.
+*)
+
+PROCEDURE Push (cand: Candidates; str: ConstCharStar) ;
+
+
+(*
+ KillCandidates - deallocates the candidates array.
+*)
+
+PROCEDURE KillCandidates (VAR cand: Candidates) ;
+
+
+(*
+ FindClosestCharStar - return a C string which is the closest
+ string found in candidates array.
+ NIL is returned if no suitable candidate
+ is found.
+*)
+
+PROCEDURE FindClosestCharStar (cand: Candidates;
+ name: ConstCharStar) : ConstCharStar ;
+
+
+END m2spellcheck.
--- /dev/null
+/* m2spellcheck.h header file for m2spellcheck.cc.
+
+Copyright (C) 2025 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaiusmod2@gmail.com>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
+
+#if !defined(m2spellcheck_h)
+#define m2spellcheck_h
+#if defined(m2spellcheck_c)
+#if defined(__GNUG__)
+#define EXTERN extern "C"
+#else /* !__GNUG__. */
+#define EXTERN
+#endif /* !__GNUG__. */
+#else /* !m2spellcheck_c. */
+#if defined(__GNUG__)
+#define EXTERN extern "C"
+#else /* !__GNUG__. */
+#define EXTERN extern
+#endif /* !__GNUG__. */
+#endif /* !m2spellcheck_c. */
+
+EXTERN void *m2spellcheck_InitCandidates (void);
+EXTERN void m2spellcheck_Push (void *cand, const char *name);
+EXTERN void m2spellcheck_KillCandidates (void **cand);
+EXTERN const char *m2spellcheck_FindClosestCharStar (void *cand,
+ const char *name);
+
+#undef EXTERN
+#endif /* m2spellcheck_h. */
(*
- RemoveWhitePostfix - removes any leading white space from String, s.
+ RemoveWhitePostfix - removes any trailing white space from String, s.
A new string is returned.
*)
(*
- RemoveWhitePostfix - removes any leading white space from String, s.
+ RemoveWhitePostfix - removes any trailing white space from String, s.
A new string is returned.
*)
--- /dev/null
+MODULE badfield ;
+
+TYPE
+ rec = RECORD
+ xpos,
+ ypos: CARDINAL ;
+ END ;
+
+VAR
+ v: rec ;
+BEGIN
+ v.xpod := 1
+END badfield.
--- /dev/null
+MODULE badfield2 ;
+
+TYPE
+ rec = RECORD
+ xpos,
+ ypos: CARDINAL ;
+ END ;
+
+VAR
+ v: rec ;
+BEGIN
+ WITH v DO
+ xpod := 1
+ END
+END badfield2.
--- /dev/null
+MODULE badprocedure ;
+
+PROCEDURE foo ;
+BEGIN
+END foo ;
+
+BEGIN
+ Foo
+END badprocedure.
--- /dev/null
+MODULE badprocedure2 ;
+
+
+PROCEDURE foo1 ;
+BEGIN
+END foo1 ;
+
+ MODULE inner ;
+
+ IMPORT foo1 ;
+
+ PROCEDURE foo ;
+ BEGIN
+ END foo ;
+
+ BEGIN
+ Foo
+ END inner ;
+
+BEGIN
+END badprocedure2.
--- /dev/null
+MODULE badset4 ;
+
+TYPE
+ foo = SET OF CHAR ;
+VAR
+ s: Foo ;
+BEGIN
+END badset4.
projects / thirdparty / gcc.git / commitdiff
