diff options
Diffstat (limited to 'nim/msgs.pas')
| -rw-r--r-- | nim/msgs.pas | 708 |
1 files changed, 360 insertions, 348 deletions
diff --git a/nim/msgs.pas b/nim/msgs.pas index 8112b8df7..d65a5a1e4 100644 --- a/nim/msgs.pas +++ b/nim/msgs.pas @@ -1,53 +1,54 @@ -// -// -// The Nimrod Compiler -// (c) Copyright 2008 Andreas Rumpf -// -// See the file "copying.txt", included in this -// distribution, for details about the copyright. -// -unit msgs; - -interface - -{$include 'config.inc'} - -uses - nsystem, options, strutils, nos; - -//[[[cog -//enum = "type\n TMsgKind = (\n" -//msgs = "const\n MsgKindToStr: array [TMsgKind] of string = (\n" -//warns = "const\n WarningsToStr: array [0..%d] of string = (\n" -//hints = "const\n HintsToStr: array [0..%d] of string = (\n" -//w = 0 # counts the warnings -//h = 0 # counts the hints -// -//for elem in eval(file('data/messages.yml').read()): -// for key, val in elem.iteritems(): -// enum += ' %s,\n' % key -// v = val.replace("'", "''") -// if key.startswith('warn'): -// msgs += " '%s [%s]',\n" % (v, key[4:]) -// warns += " '%s',\n" % key[4:] -// w += 1 -// elif key.startswith('hint'): -// msgs += " '%s [%s]',\n" % (v, key[4:]) -// hints += " '%s',\n" % key[4:] -// h += 1 -// else: -// msgs += " '%s',\n" % v -// -//enum = enum[:-2] + ');\n\n' -//msgs = msgs[:-2] + '\n );\n' -//warns = (warns[:-2] + '\n );\n') % (w-1) -//hints = (hints[:-2] + '\n );\n') % (h-1) -// -//cog.out(enum) -//cog.out(msgs) -//cog.out(warns) -//cog.out(hints) -//]]] +// +// +// The Nimrod Compiler +// (c) Copyright 2008 Andreas Rumpf +// +// See the file "copying.txt", included in this +// distribution, for details about the copyright. +// +unit msgs; + +interface + +{$include 'config.inc'} + +uses + nsystem, options, strutils, nos; + +//[[[cog +//from string import replace +//enum = "type\n TMsgKind = (\n" +//msgs = "const\n MsgKindToStr: array [TMsgKind] of string = (\n" +//warns = "const\n WarningsToStr: array [0..%d] of string = (\n" +//hints = "const\n HintsToStr: array [0..%d] of string = (\n" +//w = 0 # counts the warnings +//h = 0 # counts the hints +// +//for elem in eval(open('data/messages.yml').read()): +// for key, val in elem.items(): +// enum = enum + ' %s,\n' % key +// v = replace(val, "'", "''") +// if key[0:4] == 'warn': +// msgs = msgs + " '%s [%s]',\n" % (v, key[4:]) +// warns = warns + " '%s',\n" % key[4:] +// w = w + 1 +// elif key[0:4] == 'hint': +// msgs = msgs + " '%s [%s]',\n" % (v, key[4:]) +// hints = hints + " '%s',\n" % key[4:] +// h = h + 1 +// else: +// msgs = msgs + " '%s',\n" % v +// +//enum = enum[:-2] + ');\n\n' +//msgs = msgs[:-2] + '\n );\n' +//warns = (warns[:-2] + '\n );\n') % (w-1) +//hints = (hints[:-2] + '\n );\n') % (h-1) +// +//cog.out(enum) +//cog.out(msgs) +//cog.out(warns) +//cog.out(hints) +//]]] type TMsgKind = ( errUnknown, @@ -293,16 +294,17 @@ type warnCommentXIgnored, warnUser, hintSuccess, + hintSuccessX, hintLineTooLong, hintXDeclaredButNotUsed, hintConvToBaseNotNeeded, hintConvFromXtoItselfNotNeeded, hintExprAlwaysX, - hintMo2FileInvalid, - hintModuleHasChanged, - hintCannotOpenMo2File, hintQuitCalled, hintProcessing, + hintCodeBegin, + hintCodeEnd, + hintConf, hintUser); const @@ -439,7 +441,7 @@ const 'computing the type''s size produced an overflow', 'set is too large', 'base type of a set must be an ordinal', - 'inheritance only works non-final objects', + 'inheritance only works with non-final objects', 'inheritance only works with an enum', 'illegal recursion in type ''$1''', 'cannot instantiate: ''$1''', @@ -550,16 +552,17 @@ const 'comment ''$1'' ignored [CommentXIgnored]', '$1 [User]', 'operation successful [Success]', + 'operation successful ($1 lines compiled; $2 sec total) [SuccessX]', 'line too long [LineTooLong]', '''$1'' is declared but not used [XDeclaredButNotUsed]', 'conversion to base object is not needed [ConvToBaseNotNeeded]', 'conversion from $1 to itself is pointless [ConvFromXtoItselfNotNeeded]', 'expression evaluates always to ''$1'' [ExprAlwaysX]', - 'mo2 file ''$1'' is invalid [Mo2FileInvalid]', - 'module ''$1'' has been changed [ModuleHasChanged]', - 'mo2 file ''$1'' does not exist [CannotOpenMo2File]', 'quit() called [QuitCalled]', - 'processing [Processing]', + 'processing $1 [Processing]', + 'generated code listing: [CodeBegin]', + 'end of listing [CodeEnd]', + 'used config file ''$1'' [Conf]', '$1 [User]' ); const @@ -580,261 +583,265 @@ const 'User' ); const - HintsToStr: array [0..11] of string = ( + HintsToStr: array [0..12] of string = ( 'Success', + 'SuccessX', 'LineTooLong', 'XDeclaredButNotUsed', 'ConvToBaseNotNeeded', 'ConvFromXtoItselfNotNeeded', 'ExprAlwaysX', - 'Mo2FileInvalid', - 'ModuleHasChanged', - 'CannotOpenMo2File', 'QuitCalled', 'Processing', + 'CodeBegin', + 'CodeEnd', + 'Conf', 'User' ); -//[[[end]]] - -const - fatalMin = errUnknown; - fatalMax = errInternal; - errMin = errUnknown; - errMax = errUser; - warnMin = warnCannotOpenFile; - warnMax = pred(hintSuccess); - hintMin = hintSuccess; - hintMax = high(TMsgKind); - -type - TNoteKind = warnMin..hintMax; - // "notes" are warnings or hints - TNoteKinds = set of TNoteKind; - - TLineInfo = record - // This is designed to be as small as possible, because it is used - // in syntax nodes. We safe space here by using two int16 and an int32 - // on 64 bit and on 32 bit systems this is only 8 bytes. - line, col: int16; - fileIndex: int32; - end; - -function UnknownLineInfo(): TLineInfo; - -var - gNotes: TNoteKinds = [low(TNoteKind)..high(TNoteKind)]; - gErrorCounter: int = 0; // counts the number of errors - gHintCounter: int = 0; - gWarnCounter: int = 0; - gErrorMax: int = 1; // stop after gErrorMax errors - -const // this format is understood by many text editors: it is the same that - // Borland and Freepascal use - PosErrorFormat = '$1($2, $3) Error: $4'; - PosWarningFormat = '$1($2, $3) Warning: $4'; - PosHintFormat = '$1($2, $3) Hint: $4'; - - RawErrorFormat = 'Error: $1'; - RawWarningFormat = 'Warning: $1'; - RawHintFormat = 'Hint: $1'; - -procedure MessageOut(const s: string); - -procedure rawMessage(const msg: TMsgKind; const arg: string = ''); -procedure liMessage(const info: TLineInfo; const msg: TMsgKind; - const arg: string = ''); - -procedure InternalError(const info: TLineInfo; const errMsg: string); - overload; -procedure InternalError(const errMsg: string); overload; - -function newLineInfo(const filename: string; line, col: int): TLineInfo; - -function ToFilename(const info: TLineInfo): string; -function toColumn(const info: TLineInfo): int; -function ToLinenumber(const info: TLineInfo): int; - -function MsgKindToString(kind: TMsgKind): string; - -// checkpoints are used for debugging: -function checkpoint(const info: TLineInfo; const filename: string; - line: int): boolean; - -procedure addCheckpoint(const info: TLineInfo); overload; -procedure addCheckpoint(const filename: string; line: int); overload; -function inCheckpoint(const current: TLineInfo): boolean; -// prints the line information if in checkpoint - -procedure pushInfoContext(const info: TLineInfo); -procedure popInfoContext; - -implementation - -function UnknownLineInfo(): TLineInfo; -begin - result.line := -1; - result.col := -1; - result.fileIndex := -1; -end; - -{@ignore} -var - filenames: array of string; - msgContext: array of TLineInfo; -{@emit -var - filenames: array of string = []; - msgContext: array of TLineInfo = []; -} - -procedure pushInfoContext(const info: TLineInfo); -var - len: int; -begin - len := length(msgContext); - setLength(msgContext, len+1); - msgContext[len] := info; -end; - -procedure popInfoContext; -begin - setLength(msgContext, length(msgContext)-1); -end; - -function includeFilename(const f: string): int; -var - i: int; -begin - for i := high(filenames) downto low(filenames) do - if filenames[i] = f then begin - result := i; exit - end; - // not found, so add it: - result := length(filenames); - setLength(filenames, result+1); - filenames[result] := f; -end; - -function checkpoint(const info: TLineInfo; const filename: string; - line: int): boolean; -begin - result := (info.line = line) and ( - ChangeFileExt(extractFilename(filenames[info.fileIndex]), '') = filename); -end; - - -{@ignore} -var - checkPoints: array of TLineInfo; -{@emit -var - checkPoints: array of TLineInfo = []; -} - -procedure addCheckpoint(const info: TLineInfo); overload; -var - len: int; -begin - len := length(checkPoints); - setLength(checkPoints, len+1); - checkPoints[len] := info; -end; - -procedure addCheckpoint(const filename: string; line: int); overload; -begin - addCheckpoint(newLineInfo(filename, line, -1)); -end; - -function newLineInfo(const filename: string; line, col: int): TLineInfo; -begin - result.fileIndex := includeFilename(filename); - result.line := int16(line); - result.col := int16(col); -end; - -function ToFilename(const info: TLineInfo): string; -begin - if info.fileIndex = -1 then result := '???' - else result := filenames[info.fileIndex] -end; - -function ToLinenumber(const info: TLineInfo): int; -begin - result := info.line -end; - -function toColumn(const info: TLineInfo): int; -begin - result := info.col -end; - -procedure MessageOut(const s: string); -begin // change only this proc to put it elsewhere - Writeln(output, s); -end; - -function coordToStr(const coord: int): string; -begin - if coord = -1 then result := '???' - else result := toString(coord) -end; - -function MsgKindToString(kind: TMsgKind): string; -begin // later versions may provide translated error messages - result := msgKindToStr[kind]; -end; - -function getMessageStr(msg: TMsgKind; const arg: string): string; -begin - result := format(msgKindToString(msg), [arg]); -end; - -function inCheckpoint(const current: TLineInfo): boolean; -var - i: int; -begin - result := false; - if not (optCheckpoints in gOptions) then exit; // ignore all checkpoints - for i := 0 to high(checkPoints) do begin - if (current.line = int(checkPoints[i].line)) and - (current.fileIndex = int(checkPoints[i].fileIndex)) then begin - MessageOut(Format('$1($2, $3) Checkpoint: ', [toFilename(current), - coordToStr(current.line), - coordToStr(current.col)])); - result := true; - exit - end - end -end; - -procedure handleError(const msg: TMsgKind); -begin - if (msg >= fatalMin) and (msg <= fatalMax) then begin - if optVerbose in gGlobalOptions then assert(false); - halt(1) - end; - if (msg >= errMin) and (msg <= errMax) then begin - inc(gErrorCounter); - if gErrorCounter >= gErrorMax then begin - if optVerbose in gGlobalOptions then assert(false); - halt(1) // one error stops the compiler - end - end -end; - -procedure writeContext; -var - i: int; -begin - for i := 0 to length(msgContext)-1 do begin - MessageOut(Format(posErrorFormat, [toFilename(msgContext[i]), - coordToStr(msgContext[i].line), - coordToStr(msgContext[i].col), - getMessageStr(errInstantiationFrom, '')])); - end; -end; - -procedure rawMessage(const msg: TMsgKind; const arg: string = ''); +//[[[end]]] + +const + fatalMin = errUnknown; + fatalMax = errInternal; + errMin = errUnknown; + errMax = errUser; + warnMin = warnCannotOpenFile; + warnMax = pred(hintSuccess); + hintMin = hintSuccess; + hintMax = high(TMsgKind); + +type + TNoteKind = warnMin..hintMax; + // "notes" are warnings or hints + TNoteKinds = set of TNoteKind; + + TLineInfo = record + // This is designed to be as small as possible, because it is used + // in syntax nodes. We safe space here by using two int16 and an int32 + // on 64 bit and on 32 bit systems this is only 8 bytes. + line, col: int16; + fileIndex: int32; + end; + +function UnknownLineInfo(): TLineInfo; + +var + gNotes: TNoteKinds = [low(TNoteKind)..high(TNoteKind)]; + gErrorCounter: int = 0; // counts the number of errors + gHintCounter: int = 0; + gWarnCounter: int = 0; + gErrorMax: int = 1; // stop after gErrorMax errors + +const // this format is understood by many text editors: it is the same that + // Borland and Freepascal use + PosErrorFormat = '$1($2, $3) Error: $4'; + PosWarningFormat = '$1($2, $3) Warning: $4'; + PosHintFormat = '$1($2, $3) Hint: $4'; + + RawErrorFormat = 'Error: $1'; + RawWarningFormat = 'Warning: $1'; + RawHintFormat = 'Hint: $1'; + +procedure MessageOut(const s: string); + +procedure rawMessage(const msg: TMsgKind; const arg: string = ''); overload; +procedure rawMessage(const msg: TMsgKind; const args: array of string); overload; + +procedure liMessage(const info: TLineInfo; const msg: TMsgKind; + const arg: string = ''); + +procedure InternalError(const info: TLineInfo; const errMsg: string); + overload; +procedure InternalError(const errMsg: string); overload; + +function newLineInfo(const filename: string; line, col: int): TLineInfo; + +function ToFilename(const info: TLineInfo): string; +function toColumn(const info: TLineInfo): int; +function ToLinenumber(const info: TLineInfo): int; + +function MsgKindToString(kind: TMsgKind): string; + +// checkpoints are used for debugging: +function checkpoint(const info: TLineInfo; const filename: string; + line: int): boolean; + +procedure addCheckpoint(const info: TLineInfo); overload; +procedure addCheckpoint(const filename: string; line: int); overload; +function inCheckpoint(const current: TLineInfo): boolean; +// prints the line information if in checkpoint + +procedure pushInfoContext(const info: TLineInfo); +procedure popInfoContext; + +implementation + +function UnknownLineInfo(): TLineInfo; +begin + result.line := int16(-1); + result.col := int16(-1); + result.fileIndex := -1; +end; + +{@ignore} +var + filenames: array of string; + msgContext: array of TLineInfo; +{@emit +var + filenames: array of string = @[]; + msgContext: array of TLineInfo = @[]; +} + +procedure pushInfoContext(const info: TLineInfo); +var + len: int; +begin + len := length(msgContext); + setLength(msgContext, len+1); + msgContext[len] := info; +end; + +procedure popInfoContext; +begin + setLength(msgContext, length(msgContext)-1); +end; + +function includeFilename(const f: string): int; +var + i: int; +begin + for i := high(filenames) downto low(filenames) do + if filenames[i] = f then begin + result := i; exit + end; + // not found, so add it: + result := length(filenames); + setLength(filenames, result+1); + filenames[result] := f; +end; + +function checkpoint(const info: TLineInfo; const filename: string; + line: int): boolean; +begin + result := (int(info.line) = line) and ( + ChangeFileExt(extractFilename(filenames[info.fileIndex]), '') = filename); +end; + + +{@ignore} +var + checkPoints: array of TLineInfo; +{@emit +var + checkPoints: array of TLineInfo = @[]; +} + +procedure addCheckpoint(const info: TLineInfo); overload; +var + len: int; +begin + len := length(checkPoints); + setLength(checkPoints, len+1); + checkPoints[len] := info; +end; + +procedure addCheckpoint(const filename: string; line: int); overload; +begin + addCheckpoint(newLineInfo(filename, line, -1)); +end; + +function newLineInfo(const filename: string; line, col: int): TLineInfo; +begin + result.fileIndex := includeFilename(filename); + result.line := int16(line); + result.col := int16(col); +end; + +function ToFilename(const info: TLineInfo): string; +begin + if info.fileIndex = -1 then result := '???' + else result := filenames[info.fileIndex] +end; + +function ToLinenumber(const info: TLineInfo): int; +begin + result := info.line +end; + +function toColumn(const info: TLineInfo): int; +begin + result := info.col +end; + +procedure MessageOut(const s: string); +begin // change only this proc to put it elsewhere + Writeln(output, s); +end; + +function coordToStr(const coord: int): string; +begin + if coord = -1 then result := '???' + else result := toString(coord) +end; + +function MsgKindToString(kind: TMsgKind): string; +begin // later versions may provide translated error messages + result := msgKindToStr[kind]; +end; + +function getMessageStr(msg: TMsgKind; const arg: string): string; +begin + result := format(msgKindToString(msg), [arg]); +end; + +function inCheckpoint(const current: TLineInfo): boolean; +var + i: int; +begin + result := false; + if not (optCheckpoints in gOptions) then exit; // ignore all checkpoints + for i := 0 to high(checkPoints) do begin + if (current.line = checkPoints[i].line) and + (current.fileIndex = (checkPoints[i].fileIndex)) then begin + MessageOut(Format('$1($2, $3) Checkpoint: ', [toFilename(current), + coordToStr(current.line), + coordToStr(current.col)])); + result := true; + exit + end + end +end; + +procedure handleError(const msg: TMsgKind); +begin + if msg = errInternal then assert(false); // we want a stack trace here + if (msg >= fatalMin) and (msg <= fatalMax) then begin + if gVerbosity >= 3 then assert(false); + halt(1) + end; + if (msg >= errMin) and (msg <= errMax) then begin + inc(gErrorCounter); + if gErrorCounter >= gErrorMax then begin + if gVerbosity >= 3 then assert(false); + halt(1) // one error stops the compiler + end + end +end; + +procedure writeContext; +var + i: int; +begin + for i := 0 to length(msgContext)-1 do begin + MessageOut(Format(posErrorFormat, [toFilename(msgContext[i]), + coordToStr(msgContext[i].line), + coordToStr(msgContext[i].col), + getMessageStr(errInstantiationFrom, '')])); + end; +end; + +procedure rawMessage(const msg: TMsgKind; const args: array of string); var frmt: string; begin @@ -857,51 +864,56 @@ begin end; else assert(false) // cannot happen end; - MessageOut(Format(frmt, [getMessageStr(msg, arg)])); - handleError(msg); -end; - -procedure liMessage(const info: TLineInfo; const msg: TMsgKind; - const arg: string = ''); -var - frmt: string; -begin - case msg of - errMin..errMax: begin - writeContext(); - frmt := posErrorFormat; - end; - warnMin..warnMax: begin - if not (optWarns in gOptions) then exit; - if not (msg in gNotes) then exit; - frmt := posWarningFormat; - inc(gWarnCounter); - end; - hintMin..hintMax: begin - if not (optHints in gOptions) then exit; - if not (msg in gNotes) then exit; - frmt := posHintFormat; - inc(gHintCounter); - end; - else assert(false) // cannot happen - end; - MessageOut(Format(frmt, [toFilename(info), - coordToStr(info.line), - coordToStr(info.col), - getMessageStr(msg, arg)])); + MessageOut(Format(frmt, format(msgKindToString(msg), args))); handleError(msg); end; - -procedure InternalError(const info: TLineInfo; const errMsg: string); + +procedure rawMessage(const msg: TMsgKind; const arg: string = ''); begin - writeContext(); - liMessage(info, errInternal, errMsg); -end; - -procedure InternalError(const errMsg: string); overload; -begin - writeContext(); - rawMessage(errInternal, errMsg); -end; - -end. + rawMessage(msg, [arg]); +end; + +procedure liMessage(const info: TLineInfo; const msg: TMsgKind; + const arg: string = ''); +var + frmt: string; +begin + case msg of + errMin..errMax: begin + writeContext(); + frmt := posErrorFormat; + end; + warnMin..warnMax: begin + if not (optWarns in gOptions) then exit; + if not (msg in gNotes) then exit; + frmt := posWarningFormat; + inc(gWarnCounter); + end; + hintMin..hintMax: begin + if not (optHints in gOptions) then exit; + if not (msg in gNotes) then exit; + frmt := posHintFormat; + inc(gHintCounter); + end; + else assert(false) // cannot happen + end; + MessageOut(Format(frmt, [toFilename(info), + coordToStr(info.line), + coordToStr(info.col), + getMessageStr(msg, arg)])); + handleError(msg); +end; + +procedure InternalError(const info: TLineInfo; const errMsg: string); +begin + writeContext(); + liMessage(info, errInternal, errMsg); +end; + +procedure InternalError(const errMsg: string); overload; +begin + writeContext(); + rawMessage(errInternal, errMsg); +end; + +end. |