From 4792f0ed875299b078ab70958d6b5ba023c9cc13 Mon Sep 17 00:00:00 2001 From: Basile Burg Date: Fri, 18 Mar 2016 20:08:12 +0100 Subject: [PATCH] added a range-based parser, experimented in the message parser --- lazproj/coedit.lpi | 6 +- lazproj/coedit.lpr | 2 +- src/ce_defines.inc | 1 + src/ce_messages.pas | 80 ++++-------- src/ce_stringrange.pas | 290 +++++++++++++++++++++++++++++++++++++++++ 5 files changed, 319 insertions(+), 60 deletions(-) create mode 100644 src/ce_stringrange.pas diff --git a/lazproj/coedit.lpi b/lazproj/coedit.lpi index 3f593c4c..6dee4eaf 100644 --- a/lazproj/coedit.lpi +++ b/lazproj/coedit.lpi @@ -137,7 +137,7 @@ - + @@ -380,6 +380,10 @@ + + + + diff --git a/lazproj/coedit.lpr b/lazproj/coedit.lpr index d8940306..3e79e1e3 100644 --- a/lazproj/coedit.lpr +++ b/lazproj/coedit.lpr @@ -11,7 +11,7 @@ uses ce_writableComponent, ce_symstring, ce_staticmacro, ce_inspectors, ce_editoroptions, ce_dockoptions, ce_shortcutseditor, ce_mru, ce_processes, ce_dubproject, ce_dialogs, ce_dubprojeditor, ce_controls, ce_dfmt, - ce_lcldragdrop; + ce_lcldragdrop, ce_stringrange; {$R *.res} diff --git a/src/ce_defines.inc b/src/ce_defines.inc index 2aed2614..a8ddbf59 100644 --- a/src/ce_defines.inc +++ b/src/ce_defines.inc @@ -1,3 +1,4 @@ {$MODE OBJFPC}{$H+} {$INTERFACES CORBA} {$MODESWITCH TYPEHELPERS} +{$MODESWITCH ADVANCEDRECORDS} diff --git a/src/ce_messages.pas b/src/ce_messages.pas index f4ff4b44..c8042993 100644 --- a/src/ce_messages.pas +++ b/src/ce_messages.pas @@ -9,7 +9,7 @@ uses EditBtn, lcltype, ce_widget, ActnList, Menus, clipbrd, AnchorDocking, math, TreeFilterEdit, Buttons, process, GraphType, fgl, ce_writableComponent, ce_common, ce_synmemo, ce_dlangutils, ce_interfaces, - ce_observer, ce_symstring, ce_processes, ce_sharedres; + ce_observer, ce_symstring, ce_processes, ce_sharedres, ce_stringrange; type @@ -975,8 +975,8 @@ end; function guessMessageKind(const aMessg: string): TCEAppMessageKind; var - pos: Integer = 1; - idt: string = ''; + idt: string; + rng: TStringRange; function checkIdent: TCEAppMessageKind; begin case idt of @@ -995,71 +995,35 @@ begin exit(amkBub); end; end; +const + alp = ['a'..'z', 'A'..'Z']; begin result := amkBub; - while(true) do + rng.init(aMessg); + while true do begin - if pos > aMessg.length then + idt := rng.popUntil(alp)^.takeWhile(alp).yield; + if idt = '' then + exit; + result := checkIdent; + if result <> amkBub then exit; - if aMessg[pos] in [#0..#32, ',', ':', ';'] then - begin - Inc(pos); - result := checkIdent; - if result <> amkBub then - exit; - idt := ''; - continue; - end; - if not (aMessg[pos] in ['a'..'z', 'A'..'Z']) then - begin - Inc(pos); - result := checkIdent; - if result <> amkBub then exit; - idt := ''; - continue; - end; - idt += aMessg[pos]; - Inc(pos); end; end; function getLineFromMessage(const aMessage: string): TPoint; var - i, j: Integer; - ident: string = ''; + rng: TStringRange; + lne: string; + col: string = ''; begin - result.x := 0; - result.y := 0; - i := 1; - while (true) do - begin - if i > aMessage.length then exit; - if aMessage[i] = '(' then - begin - inc(i); - if i > aMessage.length then exit; - while( isNumber(aMessage[i]) or (aMessage[i] = ',') or (aMessage[i] = ':')) do - begin - ident += aMessage[i]; - inc(i); - if i > aMessage.length then exit; - end; - if aMessage[i] = ')' then - begin - j := Pos(',', ident); - if j = 0 then j := Pos(':', ident); - if j = 0 then - result.y := strToIntDef(ident, -1) - else - begin - result.y := strToIntDef(ident[1..j-1], -1); - result.x := strToIntDef(ident[j+1..ident.length], -1); - end; - exit; - end; - end; - inc(i); - end; + rng.init(aMessage); + rng.popUntil(['('])^.popWhile(['(']); + lne := rng.takeUntil([',', ':', ')']).yield; + if rng.front in [',', ':'] then + col := rng.popWhile([',', ':'])^.takeUntil([')']).yield; + result.y := strToIntDef(lne, -1); + result.x := strToIntDef(col, -1); end; function openFileFromDmdMessage(const aMessage: string): boolean; diff --git a/src/ce_stringrange.pas b/src/ce_stringrange.pas new file mode 100644 index 00000000..6c3ca0a8 --- /dev/null +++ b/src/ce_stringrange.pas @@ -0,0 +1,290 @@ +unit ce_stringrange; + +{$I ce_defines.inc} + +interface + +uses + SysUtils; + +type + + PStringRange = ^TStringRange; + + (** + * Iterator specialized for strings. + * + * This structure allows to easily scan strings. + * Most of the operations can be chained because the functions + * return either a pointer to a TStringRange (in this case this is always + * the "Self") or a new TStringRange (in this case this is always a copy). + * + * This is based on a more generic work which tries to implement some kind + * of "D" ranges in Object Pascal (see https://github.com/BBasile/ArrayOps). + * Even if Object Pascal doesn't provide the expressivness required to mimic + * D ranges, a few good stuff are still possible. + *) + TStringRange = record + private + ptr: PChar; + pos: integer; + len: integer; + + public + + // returns a new range initialized with a string. + class function create(const str: string): TStringRange; static; + // returns a new range initialized from a pointer. + class function create(const pchr: PChar; length: integer): TStringRange; static; + + // initializes the range with a string. + function init(const str: string): PStringRange; inline; + // initialized the range from a pointer. + function init(const pchr: PChar; length: integer): PStringRange; inline; + + // advances. + procedure popFront; inline; + // returns the current element. + function front: char; inline; + // indicates wether the range is consumed. + function empty: boolean; inline; + + // yields the state of the range to a string. + function yield: string; inline; + // returns a copy. + function save: TStringRange; inline; + // resets the range. + function reset: PStringRange; inline; + + // advances the range while the front is in value, returns a copy. + function takeWhile(value: TSysCharSet): TStringRange; overload; inline; + function takeWhile(value: Char): TStringRange; overload; inline; + // advances the range until the front is in value, returns a copy. + function takeUntil(value: TSysCharSet): TStringRange; overload; inline; + function takeUntil(value: Char): TStringRange; overload; inline; + // advances the range while the front is in value. + function popWhile(value: TSysCharSet): PStringRange; overload; inline; + function popWhile(value: Char): PStringRange; overload; inline; + // advances the range until the front is in value. + function popUntil(value: TSysCharSet): PStringRange; overload; inline; + function popUntil(value: Char): PStringRange; overload; inline; + + // returns the next word. + function nextWord: string; inline; + // returns the next line. + function nextLine: string; inline; + // indicates wether the range starts with value. + function startsWith(const value: string): boolean; inline; + // indicates wether the range starts with value. + function startsWith(var value: TStringRange): boolean; inline; + end; + +implementation + +class function TStringRange.create(const str: string): TStringRange; +begin + result.ptr := @str[1]; + result.pos := 0; + result.len := length(str); +end; + +class function TStringRange.create(const pchr: PChar; length: integer): TStringRange; +begin + result.ptr := pchr; + result.pos := 0; + result.len := length; +end; + +function TStringRange.init(const str: string): PStringRange; +begin + ptr := @str[1]; + pos := 0; + len := length(str); + Result := @self; +end; + +function TStringRange.init(const pchr: PChar; length: integer): PStringRange; +begin + ptr := pchr; + pos := 0; + len := length; + Result := @self; +end; + +procedure TStringRange.popFront; +begin + pos += 1; +end; + +function TStringRange.front: char; +begin + result := (ptr + pos)^; +end; + +function TStringRange.empty: boolean; +begin + result := pos >= len; +end; + +function TStringRange.yield: string; +begin + Result := ptr[pos .. len-1]; +end; + +function TStringRange.save: TStringRange; +begin + Result.len:= len; + Result.pos:= pos; + Result.ptr:= ptr; +end; + +function TStringRange.reset: PStringRange; +begin + pos := 0; + Result := @Self; +end; + +function TStringRange.takeWhile(value: TSysCharSet): TStringRange; +begin + Result.ptr := ptr + pos; + Result.pos := 0; + Result.len := 0; + while true do + begin + if empty or not (front in value) then + break; + Result.len += 1; + popFront; + end; +end; + +function TStringRange.takeWhile(value: Char): TStringRange; +begin + Result.ptr := ptr + pos; + Result.pos := 0; + Result.len := 0; + while true do + begin + if empty or not (front = value) then + break; + Result.len += 1; + popFront; + end; +end; + +function TStringRange.takeUntil(value: TSysCharSet): TStringRange; +begin + Result.ptr := ptr + pos; + Result.pos := 0; + Result.len := 0; + while true do + begin + if empty or (front in value) then + break; + Result.len += 1; + popFront; + end; +end; + +function TStringRange.takeUntil(value: Char): TStringRange; +begin + Result.ptr := ptr + pos; + Result.pos := 0; + Result.len := 0; + while true do + begin + if empty or (front = value) then + break; + Result.len += 1; + popFront; + end; +end; + +function TStringRange.popWhile(value: TSysCharSet): PStringRange; +begin + while true do + begin + if empty or not (front in value) then + break; + popFront; + end; + Result := @self; +end; + +function TStringRange.popWhile(value: Char): PStringRange; +begin + while true do + begin + if empty or not (front = value) then + break; + popFront; + end; + Result := @self; +end; + +function TStringRange.popUntil(value: TSysCharSet): PStringRange; +begin + while true do + begin + if empty or (front in value) then + break; + popFront; + end; + Result := @self; +end; + +function TStringRange.popUntil(value: Char): PStringRange; +begin + while true do + begin + if empty or (front = value) then + break; + popFront; + end; + Result := @self; +end; + +function TStringRange.nextWord: string; +const + blk = [#0 .. #32]; +begin + Result := popWhile(blk)^.takeUntil(blk).yield; +end; + +function TStringRange.nextLine: string; +const + lsp = [#10, #13]; +begin + Result := popWhile(lsp)^.takeUntil(lsp).yield; +end; + +function TStringRange.startsWith(const value: string): boolean; +begin + Result := false; + if len - pos <= length(value) then + Result := ptr[pos .. pos + length(value)] = value; +end; + +function TStringRange.startsWith(var value: TStringRange): boolean; +var + p0, p1: integer; +begin + p0 := pos; + p1 := value.pos; + Result := true; + while not empty and not value.empty do + begin + if front <> value.front then + begin + Result := false; + break; + end; + popFront; + value.popFront; + end; + pos := p0; + value.pos := p1; +end; + +end. +