forks
/
dexed
mirror of https://gitlab.com/basile.b/dexed.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

fix #29

This commit is contained in:
Basile Burg 2016-03-25 05:59:16 +01:00
parent eeb9502757
commit abfb1728d3
2 changed files with 86 additions and 80 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

159
src/ce_dlang.pas
View File

@ -116,19 +116,19 @@ type
*) *)
TLexTokenList = class(TFPList) TLexTokenList = class(TFPList)
private private
function getToken(index: integer): TLexToken; function getToken(index: integer): PLexToken;
public public
procedure Clear; procedure Clear;
procedure addToken(aValue: PLexToken); procedure addToken(aValue: PLexToken);
property token[index: integer]: TLexToken read getToken; property token[index: integer]: PLexToken read getToken; default;
end; end;
TLexTokenEnumerator = class TLexTokenEnumerator = class
fList: TLexTokenList; fList: TLexTokenList;
fIndex: Integer; fIndex: Integer;
function GetCurrent: TLexToken; function GetCurrent: PLexToken;
function MoveNext: Boolean; function MoveNext: Boolean;
property Current: TLexToken read GetCurrent; property Current: PLexToken read GetCurrent;
end; end;
(***************************************************************************** (*****************************************************************************
@ -164,24 +164,24 @@ type
operator enumerator(aTokenList: TLexTokenList): TLexTokenEnumerator; operator enumerator(aTokenList: TLexTokenList): TLexTokenEnumerator;
operator enumerator(anErrorList: TLexErrorList): TLexErrorEnumerator; operator enumerator(anErrorList: TLexErrorList): TLexErrorEnumerator;
(***************************************************************************** (**
* Lexes aText and fills aList with the TLexToken found. * Lexes aText and fills aList with the TLexToken found.
*) *)
procedure lex(const aText: string; aList: TLexTokenList; aCallBack: TLexFoundEvent = nil); procedure lex(const aText: string; aList: TLexTokenList; aCallBack: TLexFoundEvent = nil);
(***************************************************************************** (**
* Detects various syntactic errors in a TLexTokenList * Detects various syntactic errors in a TLexTokenList
*) *)
procedure checkSyntacticErrors(const aTokenList: TLexTokenList; const anErrorList: TLexErrorList); procedure checkSyntacticErrors(const aTokenList: TLexTokenList; const anErrorList: TLexErrorList);
(***************************************************************************** (**
* Outputs the module name from a tokenized D source. * Outputs the module name from a tokenized D source.
*) *)
function getModuleName(const aTokenList: TLexTokenList): string; function getModuleName(const aTokenList: TLexTokenList): string;
(***************************************************************************** (**
* Compares two TPoints. * Compares two TPoints.
*) *)
operator = (lhs: TPoint; rhs: TPoint): boolean; operator = (lhs: TPoint; rhs: TPoint): boolean;
implementation implementation
@ -189,7 +189,7 @@ implementation
var var
D2Dictionary: TD2Dictionary; D2Dictionary: TD2Dictionary;
{$REGION TReaderHead------------------------------------------------------------} {$REGION TReaderHead -----------------------------------------------------------}
operator = (lhs: TPoint; rhs: TPoint): boolean; operator = (lhs: TPoint; rhs: TPoint): boolean;
begin begin
exit((lhs.y = rhs.y) and (lhs.x = rhs.x)); exit((lhs.y = rhs.y) and (lhs.x = rhs.x));
@ -246,7 +246,7 @@ begin
end; end;
{$ENDREGION} {$ENDREGION}
{$REGION TD2Dictionary----------------------------------------------------------} {$REGION TD2Dictionary ---------------------------------------------------------}
constructor TD2Dictionary.Create; constructor TD2Dictionary.Create;
var var
Value: string; Value: string;
@ -308,10 +308,10 @@ end;
{$ENDREGION} {$ENDREGION}
{$REGION Lexing-----------------------------------------------------------------} {$REGION Lexing ----------------------------------------------------------------}
function TLexTokenList.getToken(index: integer): TLexToken; function TLexTokenList.getToken(index: integer): PLexToken;
begin begin
Result := PLexToken(Items[index])^; Result := PLexToken(Items[index]);
end; end;
procedure TLexTokenList.Clear; procedure TLexTokenList.Clear;
@ -328,7 +328,7 @@ begin
add(Pointer(aValue)); add(Pointer(aValue));
end; end;
function TLexTokenEnumerator.GetCurrent: TLexToken; function TLexTokenEnumerator.GetCurrent: PLexToken;
begin begin
exit(fList.token[fIndex]); exit(fList.token[fIndex]);
end; end;
@ -352,11 +352,7 @@ var
reader: TReaderHead; reader: TReaderHead;
identifier: string; identifier: string;
nestedCom: integer; nestedCom: integer;
rstring: boolean;
function isOutOfBound: boolean;
begin
exit(reader.AbsoluteIndex >= length(aText))
end;
procedure addToken(aTk: TLexTokenKind); procedure addToken(aTk: TLexTokenKind);
var var
@ -370,6 +366,13 @@ var
aList.Add(ptk); aList.Add(ptk);
end; end;
function isOutOfBound: boolean;
begin
result := reader.AbsoluteIndex >= length(aText);
if result and (identifier <> '') then
addToken(ltkIllegal);
end;
function callBackDoStop: boolean; function callBackDoStop: boolean;
begin begin
Result := False; Result := False;
@ -483,6 +486,7 @@ begin
// string 1, note: same escape error as in SynD2Syn // string 1, note: same escape error as in SynD2Syn
if (reader.head^ in ['r', 'x']) then if (reader.head^ in ['r', 'x']) then
begin begin
rstring := reader.head^ = 'r';
if not (reader.Next^ = '"') then if not (reader.Next^ = '"') then
reader.previous; reader.previous;
end; end;
@ -493,7 +497,8 @@ begin
exit; exit;
if (reader.head^ = '"') then if (reader.head^ = '"') then
begin begin
reader.Next; if isStringPostfix(reader.Next^) then
reader.Next;
addToken(ltkString); addToken(ltkString);
if callBackDoStop then if callBackDoStop then
exit; exit;
@ -503,14 +508,18 @@ begin
begin begin
if reader.head^ = '\' then if reader.head^ = '\' then
begin begin
identifier += reader.head^;
reader.Next; reader.Next;
if (reader.head^ = '"') then if isOutOfBound then
begin exit;
reader.Next; if rstring then
continue; continue;
end; identifier += reader.head^;
end; reader.Next;
if (reader.head^ = '"') then if isOutOfBound then
exit;
end
else if (reader.head^ = '"') then
break; break;
identifier += reader.head^; identifier += reader.head^;
reader.Next; reader.Next;
@ -518,7 +527,10 @@ begin
exit; exit;
end; end;
if isStringPostfix(reader.Next^) then if isStringPostfix(reader.Next^) then
begin
identifier += reader.head^;
reader.Next; reader.Next;
end;
addToken(ltkString); addToken(ltkString);
if callBackDoStop then if callBackDoStop then
exit; exit;
@ -554,15 +566,8 @@ begin
reader.Next; reader.Next;
if isOutOfBound then if isOutOfBound then
exit; exit;
while (reader.head^ <> '}') do identifier := 'q{';
begin addToken(ltkSymbol);
identifier += reader.head^;
reader.Next;
if isOutOfBound then
exit;
end;
reader.Next;
addToken(ltkString);
if callBackDoStop then if callBackDoStop then
exit; exit;
continue; continue;
@ -576,33 +581,28 @@ begin
reader.Next; reader.Next;
if isOutOfBound then if isOutOfBound then
exit; exit;
if (reader.head^ = #39) then while true do
begin
reader.Next;
addToken(ltkString);
if callBackDoStop then
exit;
continue;
end;
while (True) do
begin begin
if reader.head^ = '\' then if reader.head^ = '\' then
begin begin
reader.Next; reader.Next;
if (reader.head^ = #39) then if isOutOfBound then
begin exit;
reader.Next; if reader.head^ = #10 then
continue; exit;
end; reader.Next;
if isOutOfBound then
exit;
end; end;
if (reader.head^ = #39) then if reader.head^ = #39 then
break; break;
identifier += reader.head^;
reader.Next; reader.Next;
if isOutOfBound then if isOutOfBound then
exit; exit;
end; end;
reader.Next; reader.Next;
if isOutOfBound then
exit;
addToken(ltkChar); addToken(ltkChar);
if callBackDoStop then if callBackDoStop then
exit; exit;
@ -858,7 +858,10 @@ procedure checkSyntacticErrors(const aTokenList: TLexTokenList; const anErrorLis
const const
errPrefix = 'syntactic error: '; errPrefix = 'syntactic error: ';
var var
tk, old1, old2, lastSignifiant: TLexToken; tk: PLexToken = nil;
old1:PLexToken = nil;
old2: PLexToken = nil;
lastSignifiant: PLexToken = nil;
err: PLexError; err: PLexError;
tkIndex: NativeInt; tkIndex: NativeInt;
pareCnt, curlCnt, squaCnt: NativeInt; pareCnt, curlCnt, squaCnt: NativeInt;
@ -868,7 +871,7 @@ var
begin begin
err := new(PLexError); err := new(PLexError);
err^.msg := errPrefix + aMsg; err^.msg := errPrefix + aMsg;
err^.position := aTokenList.token[tkIndex].position; err^.position := aTokenList.token[tkIndex]^.position;
anErrorList.addError(err); anErrorList.addError(err);
end; end;
@ -892,9 +895,9 @@ begin
Inc(tkIndex); Inc(tkIndex);
// brackets count // brackets count
if tk.kind = ltkSymbol then if tk^.kind = ltkSymbol then
begin begin
case tk.Data of case tk^.Data of
'(': Inc(pareCnt); '(': Inc(pareCnt);
'{': Inc(curlCnt); '{': Inc(curlCnt);
'[': Inc(squaCnt); '[': Inc(squaCnt);
@ -938,9 +941,9 @@ begin
end; end;
// lexer invalid token // lexer invalid token
if tk.kind = ltkIllegal then if tk^.kind = ltkIllegal then
begin begin
addError(tk.Data); addError(tk^.Data);
goto _preSeq; goto _preSeq;
end; end;
@ -950,19 +953,19 @@ begin
if tkIndex > 0 then if tkIndex > 0 then
begin begin
// empty statements: // empty statements:
if (tk.kind = ltkSymbol) and (tk.Data = ';') then if (tk^.kind = ltkSymbol) and (tk^.Data = ';') then
if (lastSignifiant.kind = ltkSymbol) and (lastSignifiant.Data = ';') then if (lastSignifiant^.kind = ltkSymbol) and (lastSignifiant^.Data = ';') then
addError('invalid syntax for empty statement'); addError('invalid syntax for empty statement');
if tk.kind <> ltkComment then if tk^.kind <> ltkComment then
lastSignifiant := tk; lastSignifiant := tk;
// suspicious double keywords // suspicious double keywords
if (old1.kind = ltkKeyword) and (tk.kind = ltkKeyword) then if (old1^.kind = ltkKeyword) and (tk^.kind = ltkKeyword) then
if old1.Data = tk.Data then if old1^.Data = tk^.Data then
addError('keyword is duplicated'); addError('keyword is duplicated');
// suspicious double numbers // suspicious double numbers
if (old1.kind = ltkNumber) and (tk.kind = ltkNumber) then if (old1^.kind = ltkNumber) and (tk^.kind = ltkNumber) then
addError('symbol or operator expected after number'); addError('symbol or operator expected after number');
end; end;
if tkIndex > 1 then if tkIndex > 1 then
@ -978,7 +981,7 @@ end;
function getModuleName(const aTokenList: TLexTokenList): string; function getModuleName(const aTokenList: TLexTokenList): string;
var var
ltk: TLexToken; ltk: PLexToken;
mtok: boolean; mtok: boolean;
begin begin
Result := ''; Result := '';
@ -987,19 +990,19 @@ begin
begin begin
if mtok then if mtok then
begin begin
case ltk.kind of case ltk^.kind of
ltkIdentifier, ltkKeyword: ltkIdentifier, ltkKeyword:
Result += ltk.Data; Result += ltk^.Data;
ltkSymbol: ltkSymbol:
case ltk.Data of case ltk^.Data of
'.': Result += ltk.Data; '.': Result += ltk^.Data;
';': exit; ';': exit;
end; end;
end; end;
end end
else else
if ltk.kind = ltkKeyword then if ltk^.kind = ltkKeyword then
if ltk.Data = 'module' then if ltk^.Data = 'module' then
mtok := True; mtok := True;
end; end;
end; end;

7
src/ce_synmemo.pas
View File

@ -1171,11 +1171,14 @@ var
begin begin
for i := 0 to fLexToks.Count-1 do for i := 0 to fLexToks.Count-1 do
begin begin
tok := PLexToken(fLexToks[i]); tok := fLexToks[i];
c += byte((tok^.kind = TLexTokenKind.ltkSymbol) and (tok^.Data = '{')); c += byte((tok^.kind = TLexTokenKind.ltkSymbol) and (tok^.Data = '{'));
c -= byte((tok^.kind = TLexTokenKind.ltkSymbol) and (tok^.Data = '}')); c -= byte((tok^.kind = TLexTokenKind.ltkSymbol) and (tok^.Data = '}'));
end; end;
exit(c > 0); if (tok <> nil) and (tok^.kind = ltkIllegal) then
result := false
else
result := c > 0;
end; end;
procedure TCESynMemo.SetHighlighter(const Value: TSynCustomHighlighter); procedure TCESynMemo.SetHighlighter(const Value: TSynCustomHighlighter);