Леворекурсивный парсер

Введение
Иногда надо взять текст и разобрать его на составляющие, но не просто разобрать, а ещё и сделать анализ, и на основании этого получить другие данные.

Для такого преобразования обычно применяют алгоритмы, которые называются парсерами. Для определённого круга задач уже давно написаны свои готовые парсеры. Например для анализа XML. В случае простых данных можно обычно обойтись простыми функциями Pos/Copy. Но как только данные чуточку усложняются – код становится огромным и неудобным. И каждое новое добавление функциональности превращается в пытку и бессонные ночи отладки.

Простое решение
Чтобы решить эту проблему, множество ученых долго и нудно писали трактаты. Читать их – скучно, засыпаешь на первых страницах. А примеров реального кода они почему-то не приводят, даже примитивного наброска алгоритма. Только одни греческие буквы и неведомые значки.

В нескольких статьях я попробую рассказать, как написать один из простейших вариантов парсера – леворекурсивный. При правильной реализации этот парсер является одним из самых быстрых. Но он не может распарсить абсолютно всё. Например, код на языке Pascal можно распарсить с помощью чистого леворекурсивного парсера. Начиная с первых версий Delphi, парсер не такой уж и чисто леворекурсивный, однако он и не слишком усложнён. Код на языке С++ нельзя распарсить этим парсером. Для этого языка применяется парсер с возвратами. Это одна из причин, почему компилятор Делфи значительно быстрее компилятора С++. Хотя есть и ещё десяток причин :-)

Не бойтесь, если многие слова непонятны. Через какое-то время они будут восприниматься подсознательно.

Как это работает?
Суть леворекурсивного парсера проста. Символ за символом читается входной поток (например, файл или строка), и на основании прочитанного символа и некоторого множества переменных состояния делается вывод, в какое новое состояние надо перейти и как интерпретировать текущий прочитанный символ. Благодаря этому время парсинга прямо пропорционально размеру входных данных. Парсер не возвращается назад – это открывает интересные перспективы, но о них позже.

Примитивный парсер или изобретаем свой StrToInt
Скорее всего, вам известна функция StrToInt. Она позволяет из строки, которая содержит целое число, получить собственно само число, с которым может работать процессор. Строки, содержащие числа, мы ведь не можем уммножать...

Важное замечание для дотошных! Возможно, некоторые функции или конструкции покажутся вам некорректными или крайне неоптимально написанными. Не надо обвинять меня – это сделано сознательно с целью упростить код и сделать его более понятным и доходчивым. В следующих статьях некоторые функции будут переписаны, некоторые удалены, а назначение некоторых странностей станет понятным. С другой стороны, я не запрещаю вам эксперементировать и пытаться написать более «отимизированно».

Для начала сделаем примитивную форму для тестов, которую мы будем использовать в большинстве последующих примеров. Для кнопки «Расчёт!» напишем такой код:


procedure TForm1.Button1Click(Sender:TObject);  
begin  
  Edit2.Text := FloatToStr(Parser(Edit1.Text));  
end;  



Функция Parser – это наша функция, которая получает строку и отдаёт число. Правда мы тут же его преобразовываем снова в строку. Но это пока. И пусть не смущает то, что я говорил о IntToStr, а использую дробные числа. Всё станет на свои места позже.

Заготовка парсера
Привожу код самого парсера с комментариями. (Полный проект – в папке Demo1).


unit MyParser;  
   
interface  
  uses SysUtils;  
function Parser(s: string): double;  
   
implementation  
   
var  
  InpStr:   string; //Копия входной строки  
  InpPos:   integer;//Номер текущего символа  
  CurrChar: char;   //Копия текущего символа  
   
//Процедура берёт следующий символ из строки  
procedure GetNextChar;  
begin  
  if InpPos < length(InpStr) then begin  
    Inc(InpPos);  
    CurrChar := InpStr[InpPos];  
  end  
  else  
    CurrChar := #0;  
end;  
   
//Функция чтения числа  
function GetNumber:Double;  
begin  
  result := 0;  
  while CurrChar in ['0'..'9'] do begin  
    result := result * 10 + ord(CurrChar) -  
ord('0');  
    GetNextChar;  
  end;  
end;  
   
//Парсер :)  
function Parse: double;  
begin  
  result := GetNumber;  
  if CurrChar <> #0 then  
    raise Exception.create('В конце строки неизвестные символы!');  
end;  
   
//Иницализация и запуск парсера  
function Parser(s: string): double;  
begin  
  InpStr := s;  
  InpPos := 0;  
  GetNextChar;  
  Result := Parse;  
end;  
   
end.  

Этот код будет основой для всех последующих парсеров. Давайте кратко разберём фунции.

Функция Parser. Эта функция вначале инициализирует внутренние переменные (первые две строки), читает первый символ (он автоматически помещается в глобальную переменную CurrChar) и последней строкой вызывает функцию, которая, собственно, и делает парсинг.

Функция Parse также не делает ничего сложного. Она читает число из потока (об этом ниже). После того, как она прочитала число, там больше ничего не должно быть, это ведь функция преобразования строки в число. Если там что-то обнаружено – генерируем исключение.

Продвигаемся дальше вглубь. Функция GetNumber. Перед её анализом, давайте подумаем, что такое обычное целое число. Это просто последовательность цифр. А теперь смотрим на функцию. Она работает просто. Проверяет текущий символ: если он - цифра, то сохранённый результат умножает на 10 и добавляет значение цифры. Перевод из символа цифры в число я делаю конструкцией Ord(CurrChar) - Ord('0'). Это очень старый, но очень быстрый способ. Можно было, конечно, использовать функцию StrToInt, но смысл? :-) После обработки текущего символа переходим к новому (процедура GetNextChar).

Попробуйте пробежать глазами всю эту цепочку снова, и понять как она работает. Весь дальнейший код будет основан на этом же принципе.

Заметье, что функция GetNumber читает до тех пор, пока в входном потоке есть цифры. Если их там нет – она выходит. Её абсолютно не волнует, что там дальше. Это забота другого кода.

И на последок рассмотрим процедуру GetNextChar. Она работает тоже крайне примитивно. Пока в строке есть ещё символы – она увеличивает счётчик и присваевает CurrChar текущий символ. Если символов больше нет – возвращает нулевой символ.

А теперь попробуйте ответить на простой вопрос. Знает ли функция Parse или GetNumber о том, откуда берутся следующие символы? Нет! Им этого и не нужно знать. Только процедура GetNextChar знает, как их получить, ну и функция Parser умеет подготовить данные. Это позволяет с лёгкостью заметить источник данных без переделки всего кода. Например, захотели мы читать данные из файла. Нам надо переделать только эти две функции. А как именно – это будет первым домашним заданием.

Первое улучшение
Парсер у нас хороший, но если ввести не просто число, а добавить пару пробелов в начало и в конец, то он уже ругается. Непорядок! Надо исправить. И для этого нам нужно всего пару строк (этот пример можно найти в папке Demo2).

Первое – напишем простую процедуру:


procedure SkipSpace;  
begin  
  while CurrChar in [' ', #9] do  
    GetNextChar;  
end;  

Эта процедура читает из входного потока символы, и, пока они пробелы или символы табуляции, пропускает их. Если вам захочется, что бы символ подчёркивания тоже был пробельным символом – просто добавьте его в этот список.

Теперь осталось добавить вызов. Пока я сделал так:


//Функция чтения числа  
function GetNumber:Double;  
begin  
  result := 0;  
  SkipSpace;  
  while CurrChar in ['0'..'9'] do begin  
    result := result * 10 + ord(CurrChar) - ord('0');  
    GetNextChar;  
  end;  
  SkipSpace;  
end;  

Запустите программу и попробуйте вводить различные строки. Она с лёгкостью переваривает их!

Простой калькулятор
Я надеюсь, вы заметили название формы – простой калькулятор. И мы сейчас его сделаем! Правда, он будет уметь только складывать и вычитать числа. Но зато он будет уметь это делать!

Итак, научим наш калькулятор понимать выражения вида «1 + 23 + 456 - 789» Заметьте, с пробелами, и со знаками плюс и минус. Для начала посмотрим на эту строку. Что же мы видим? Вначале надо прочитать число, потом в цикле читать знак и ещё одно число, и производить операцию.

Посмотрите на то, что написано ниже:


//Парсер :)  
function Parse: double;  
begin  
  Result := GetNumber;  
  repeat  
    case CurrChar of  
      #0: exit; //Достигли конца строки  
      '+':      //Нужно сложить  
      begin  
        GetNextChar;  
        Result := Result + GetNumber;  
      end;  
      '-':      //Нужно вычесть  
      begin  
        GetNextChar;  
        Result := Result - GetNumber;  
      end;  
      else  //Какой-то неизвестный символ.  
        raise Exception.CreateFmt(  
          'Я пока умею складывать и вычитать!'#13#10+  
          ' В строке обнаружен символ %s в позиции %d',  
          [CurrChar, InpPos]);  
    end;  
  until False;  
end;  

Как видно – ничего больше, чем я сказал, когда давал определение.

Домашнее задание

Если не работать над собой, а пользоваться только чужим кодом, долго не протянешь. Поэтому я предлагаю небольшие задания. Одно уже было озвучено. Вот ещё несколько.

Научите парсер уммножать и делить. Пока что без учёта старшинства операций. Можно и степень ввести (символ ^).

Научите парсер понимать выражение вида PI * 2, где PI – это 3.14, то есть, число пи. Хотя это и кажется сложным заданием, на самом деле оно очень простое.

Найдите и попробуйте исправить как минимум две ошибки в реализации функции GetNumber.

А дальше?
В следующей части мы научим наш парсер работать с дробными числами и с шестнадцатеричными.

Примеры к статье (исходники 3 демо-проектов)

Добавлено: 02 Августа 2018 08:14:16 Добавил: Андрей Ковальчук

Быстрый парсер html кода на Delphi

Что такое парсер? Парсер – это программа, которая парсит текст, по заданному алгоритму.

Что такое парсить? Парсить – анализировать и расставлять символы, входящие в текст в соответствии заложенного алгоритма, например, для удобного восприятия текста программистом.

Для чего нужен парсер? Парсер я использую для приведения html тегов к единой структуре: одинаковый размер букв, новый тег на новой строчке, удаление пустых строк.

Кроме структурирования информации с помощью парсера, можно добавить алгоритмы логического изменения текстов. Исправления орфографических ошибок, перевода на другой язык, в том числе и на машинные коды, скрипты.

Распарсить можно любую информацию по любому алгоритму, результатом проделанной работы будет та же информация, представленная в ином виде.

Далее привожу код структурирования тегов, цель работы алгоритма – разместить по 1 тегу на каждую строчку memo. В рабочей версии кода программа загружает Html страницы согласно их вложенности в сайте и парсит их, после чего заменяет их.

Для зашиты от дураков оставлю часть кода, который был в основной программе, для демонстрации просто удалите код под комментариями – ///


unit Unit1;  
interface  
  
uses  
  
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  
  Dialogs, StdCtrls;  
  
type  
  
  TForm1 = class(TForm)  
    Button7: TButton;  
    Button13: TButton;  
    Memo1: TMemo;  
    Memo2: TMemo;  
    procedure Button7Click(Sender: TObject);  
    procedure Button13Click(Sender: TObject);  
      
  private  
    { Private declarations }  
  
  public  
    { Public declarations }  
  
  end;  
  
var  
  Form1: TForm1;  
  
implementation  
  
{$R *.dfm}  
  
procedure TForm1.Button7Click(Sender: TObject);  
label 1;  
var  
i,j,k,g:integer;  
bol:boolean;  
position:integer;  
str:string;  
begin  
//chdir(edit1.Text);   /// рабочая папка  
//poiskpapki;         /// процедура для создания списка файлов в папке.  
       memo2.Clear;  
     ///здесь был код загрузки следующего файла  
     for i:= 0 to memo1.Lines.Count - 1 do  
       begin  
          str:= memo1.Lines;  
          1:  
          position := AnsiPos('>',  str);  
          if  position<>0 then  
                           begin  
                           memo2.Lines.Add(copy(str,1,position));  
                           delete(str,1,position);  
                           goto 1;  
                           end;  
        if  position=0    then    memo2.Lines.Add(str);  
         end;  
        memo1.Text:=memo2.Text;  
     ///здесь был код сохранения следующего файла  
  //продолжаем парсить  
  button13.Click;  
end;  
  
procedure TForm1.Button13Click(Sender: TObject);  
label 1;  
var  
i,j,k,g:integer;  
bol:boolean;  
position:integer;  
str:string;  
begin  
//chdir(edit1.Text);     /// рабочая папка  
//poiskpapki;           /// процедура для создания списка файлов в папке.  
          memo2.Clear;  
    ///здесь был код загрузки следующего файла  
     for i:= 0 to memo1.Lines.Count - 1 do  
       begin  
          str:= memo1.Lines;  
          1:  
          position := AnsiPos('<',  str);  
          if  position>1 then  
                           begin  
                           memo2.Lines.Add(copy(str,1,position-1));  
                           delete(str,1,position-1);  
                           goto 1;  
                           end;  
          memo2.Lines.Add(str);  
///здесь был код сохранения следующего файла.  
  end;  
 //продолжаем парсить убираем пустые строки  
 // здесь был код.  
end;  
end.  

В алгоритме используется рекурсивный цикл перенос до и после знаков открытии закрытии тегов.

Что называют парсерами? Я сделал поиск по форуму по ключевому слову – парсер, движок мне предложил ряд тем, в которых обсуждалось использование и применение парсера. Попробую прокомментировать эти темы, и по возможности дать ответ.

26.04.2007, 16:39 на форуме – programmersforum.ru была создана тема – XML Parser с поддержкой XSLT

Я пишу электронный учебник. Текст хранится в XML файле. При загрузке файла строится дерево по главам в TreeView, а сам текст отображается в RichView. И вот надо чтобы текст отображался со всеми ссылками, картинками, мультимедиа и т.д. В данный момент я добиться этого не могу. У меня отображается простой текст

На тот момент я ничего не смог посоветовать, а сейчас могу сказать, что вопрос был не совсем корректный. Парсером можно только создать структуру, изменить ее, но для отображения нужно создавать инструменты, которые будут по-другому называться.

27.10.2007, 18:29 на форуме – programmersforum.ru была создана тема – Парсер для обработки тагов

Есть некоторый текст из N символов. В этом тексте содержатся разные таги (table, tr, td, img, a). Нужно этот текст разделить на несколько равных частей, т.е сделать постраничный вывод для этого текста. Возникают такие ситуации, когда при разделении текста половина тага находится в одной части, другая половина находится в другой. Чтобы этого избежать, нужно обрабатывать эти таги. Может быть кто-нибудь подскажет, есть ли готовые решения подобных парсеров или же может кто делал что-то подобное. Буду признателен за любую информацию.

Отвечаю, есть решение, с него и начал эту статью, код представлен выше.

07.01.2008, 00:54 на форуме – programmersforum.ru была создана тема – пример парсинга


procedure TForm1.Button1Click(Sender: TObject);  
var  
  Stream: TStream;  
  s: string;  
begin  
  Stream := TMemoryStream.Create;  
  try  
    { получаем текст области редактирования и помещаем его в поток }  
    s := memo1.Text;  
   Stream.WriteBuffer(s[1], length(s));  
    { сбрасываем стартовую позицию потока и создаем парсер }  
    Stream.Position := 0;  
    with TParser.Create(Stream) do  
    try  
      { "добываем" числа и добавляем их в список }  
      while Token <> toEOF do  
      begin  
        CheckToken(toInteger); { возбуждаем исключение, если не toInteger }  
        Listbox1.Items.Add(IntToStr(TokenInt));  
        NextToken;  
      end;  
    finally  
      Free;  
    end;  
  finally  
    Stream.Free;  
  end;  

Пыталься переделать под String не чего не выходит он в listbox выводит по буквено тоесть слово:
Например
Выведет так:
Н
а
п
р
и
м
е
р


Ответ дали там же на форуме –


procedure TForm1.Button1Click(Sender: TObject);  
var  
  Stream: TStream;  
  s: string;  
begin  
  Stream := TMemoryStream.Create;  
  try  
    { получаем текст области редактирования и помещаем его в поток }  
    s := memo1.Text;  
    Stream.WriteBuffer(s[1], length(s));  
    { сбрасываем стартовую позицию потока и создаем парсер }  
    Stream.Position := 0;  
    with TParser.Create(Stream) do  
    try  
      { "добываем" числа и добавляем их в список }  
      s := '';  
      while Token <> toEOF do  
      begin  
        CheckToken(toInteger); { возбуждаем исключение, если не toInteger }  
        //Listbox1.Items.Add(IntToStr(TokenInt));   -->  
        s := s + IntToStr(TokenInt);  
        NextToken;  
      end;  
    finally  
      Free;  
    end;  
  finally  
    Stream.Free;  
  end;  

Вован вам ответил на ваш вопрос – как сделать, чтобы символы выводились в строку, а не в столбец (упустил, правда, один оператор – Listbox1.Items.Add(s), но это только от того, что торопился вам помочь побыстрее).

Добавлено: 01 Августа 2018 07:13:31 Добавил: Андрей Ковальчук

Разбор XML


{ **** ubpfd *********** by delphibase.endimus.com **** 
>> Разбор xml 
 
Данный прасер не такой универсальный, как предыдущий, 
за то - почти в 1000 раз эффективнее! 
 
Зависимости: windows, forms, sysutils, strutils 
Автор: delirium, videodvd@hotmail.com, icq:118395746, Москва 
copyright: delirium (master brain) 2003 
Дата: 22 октября 2003 г. 
***************************************************** }  
  
unit bnfxmlparser2;  
  
interface  
  
uses windows, forms, sysutils, strutils;  
  
type  
pxmlnode = ^txmlnode;  
pxmltree = ^txmltree;  
txmlattr = record  
nameindex, namesize: integer;  
textindex, textsize: integer;  
end;  
txmlnode = record  
nameindex, namesize: integer;  
attributes: array of txmlattr;  
textindex, textsize: integer;  
subnodes: array of pxmlnode;  
parent: pxmlnode;  
data: pstring;  
end;  
txmltree = record  
data: pstring;  
textsize: integer;  
nodescount: integer;  
nodes: array of pxmlnode;  
end;  
  
function bnfxmltree(value: string): pxmltree;  
function getxmlnodename(node: pxmlnode): string;  
function getxmlnodetext(node: pxmlnode): string;  
function getxmlnodeattr(attrname: string; node: pxmlnode): string;  
  
implementation  
  
function bnfxmltree(value: string): pxmltree;  
var  
lpos, k, state, curattr: integer;  
i: integer;  
curnode: pxmlnode;  
begin  
new(result);  
result^.textsize := pos('<', value) - 1;  
new(result^.data);  
result^.data^ := value;  
k := 0;  
state := 0;  
curnode := nil;  
curattr := -1;  
for lpos := result.textsize + 1 to length(value) do  
case state of  
0: case value[lpos] of  
'<':  
begin  
i := length(result.nodes);  
setlength(result.nodes, i + 1);  
new(result.nodes[i]);  
inc(k);  
if k mod 10 = 0 then  
begin  
application.processmessages;  
if k mod 100 = 0 then  
sleepex(1, true);  
end;  
curnode := result.nodes[i];  
curnode^.nameindex := 0;  
curnode^.namesize := 0;  
curnode^.textindex := 0;  
curnode^.parent := nil;  
curnode^.data := result^.data;  
state := 1;  
end;  
end;  
1: case value[lpos] of  
' ': ;  
'>': state := 9;  
'/': state := 10;  
else  
begin  
curnode^.nameindex := lpos;  
curnode^.namesize := 1;  
state := 2;  
end;  
end;  
2: case value[lpos] of  
' ': state := 3;  
'>': state := 9;  
'/': state := 10;  
else  
inc(curnode^.namesize);  
end;  
3: case value[lpos] of  
' ': ;  
'>': state := 9;  
'/': state := 10;  
else  
begin  
i := length(curnode^.attributes);  
setlength(curnode^.attributes, i + 1);  
curnode^.attributes[i].nameindex := lpos;  
curnode^.attributes[i].namesize := 1;  
curattr := i;  
state := 4;  
end;  
end;  
4: case value[lpos] of  
'=': state := 5;  
else  
inc(curnode^.attributes[curattr].namesize);  
end;  
5: case value[lpos] of  
'''': state := 6;  
'"': state := 7;  
end;  
6: case value[lpos] of  
'''':  
begin  
curnode^.attributes[curattr].textindex := lpos;  
curnode^.attributes[curattr].textsize := 0;  
state := 8;  
end;  
else  
begin  
curnode^.attributes[curattr].textindex := lpos;  
curnode^.attributes[curattr].textsize := 1;  
state := 61;  
end;  
end;  
7: case value[lpos] of  
'"':  
begin  
curnode^.attributes[curattr].textindex := lpos;  
curnode^.attributes[curattr].textsize := 0;  
state := 8;  
end;  
else  
begin  
curnode^.attributes[curattr].textindex := lpos;  
curnode^.attributes[curattr].textsize := 1;  
state := 71;  
end;  
end;  
61: case value[lpos] of  
'''': state := 8;  
else  
inc(curnode^.attributes[curattr].textsize);  
end;  
71: case value[lpos] of  
'"': state := 8;  
else  
inc(curnode^.attributes[curattr].textsize);  
end;  
8: case value[lpos] of  
' ': state := 3;  
'>': state := 9;  
'/': state := 10;  
end;  
9: case value[lpos] of  
'>': ;  
else  
begin  
curnode^.textindex := lpos;  
curnode^.textsize := 1;  
state := 11;  
end;  
end;  
10: case value[lpos] of  
'>':  
begin  
curnode := curnode^.parent;  
if curnode = nil then  
state := 0  
else  
state := 9;  
end;  
end;  
11: case value[lpos] of  
'<': state := 12;  
else  
inc(curnode^.textsize);  
end;  
12: case value[lpos] of  
'/': state := 10;  
else  
begin  
i := length(curnode^.subnodes);  
setlength(curnode^.subnodes, i + 1);  
new(curnode^.subnodes[i]);  
inc(k);  
if k mod 10 = 0 then  
begin  
application.processmessages;  
if k mod 100 = 0 then  
sleepex(1, true);  
end;  
curnode^.subnodes[i]^.parent := curnode;  
curnode^.subnodes[i]^.data := result^.data;  
curnode^.subnodes[i].nameindex := lpos;  
curnode^.subnodes[i].namesize := 1;  
curnode^.subnodes[i].textindex := 0;  
curnode := curnode^.subnodes[i];  
state := 2;  
end;  
end;  
end;  
result^.nodescount := k;  
end;  
  
function getxmlnodename(node: pxmlnode): string;  
begin  
result := copy(node^.data^, node^.nameindex, node^.namesize);  
end;  
  
function getxmlnodetext(node: pxmlnode): string;  
begin  
result := copy(node^.data^, node^.textindex, node^.textsize);  
end;  
  
function getxmlnodeattr(attrname: string; node: pxmlnode): string;  
var  
i: integer;  
begin  
result := '';  
if length(node^.attributes) = 0 then  
exit;  
i := 0;  
while (i < length(node^.attributes))  
and (ansilowercase(attrname) <> ansilowercase(trim(copy(node^.data^,  
node^.attributes[i].nameindex, node^.attributes[i].namesize)))) do  
inc(i);  
result := copy(node^.data^, node^.attributes[i].textindex,  
node^.attributes[i].textsize);  
end;  
  
end.  

Добавлено: 31 Июля 2018 06:57:48 Добавил: Андрей Ковальчук

Delphi парсинг

Нужно спарсить слово "ПлОхО=И=ОдИнОкО". Как это сделать ?


<img src="115" h="14" w="14" /> <a title="" lst="Перелететь:Инфо планеты" lst_action="-JOIN   
ПлОхО=И=ОдИнОкО:GET #huyo2#usercur=7424930&a=channels_w   
hois&chanid=536444&">ПлОхО=И=ОдИнОк О</a> [50]<br /> 

Решение:


procedure TForm1.Button1Click(Sender: TObject);   
var   
 text_pars,out_s:string;   
begin   
   text_pars:='<img src="115" h="14" w="14" /> <a title=""   
lst="Перелететь:Инфо планеты" lst_action="-JOIN ПлОхО=И=ОдИнОкО:GET   
#huyo2#usercur=7424930&a=channels_w   
hois&chanid=536444&">ПлОхО=И=ОдИнОк</a> [50] <br />';   
   delete(text_pars,1,pos('&">',text_pars)+length('&">')-1);   
   out_s:=copy(text_pars,1,pos('</a>',text_pars)-1);   
   Caption:=out_s;   
end;   

Добавлено: 26 Июля 2018 21:09:37 Добавил: Андрей Ковальчук