Компилятор синтаксических выражений

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: Сергей Втюрин aka Nemo

Что это и зачем или Немного наглой саморекламы

Эта программа представляет собой простенький компилятор синтаксических выражений. «Ну опять», — скажет невнимательный читатель, но мы то с тобой внимательные, и понимаем что компилятор, это совсем не то что валяется на каждом программистском сайте. В отличие от парсера (или интерпретатора) такую штуку встретить можно несколько реже. Если честно, то когда она мне была нужна, я ее нигде не встретил. И поэтому родилась эта программа.

Что он может или Какие мы маленькие

Да в общем-то немного, и ценности в ней мало :). Она может вычислять выражения (тип — вещественное число с плавающей точкой (на момент написания это называлось Real)) с использованием операций ( ,-,/,*). Мало… А разве сложно дописать пару строк чтобы обработать Y или экспоненту коли они будут нужны?

Так зачем же это нужно.

В силу своей огромной нескромности я полагаю, что кому-нибудь это все может быть интересно как пример непосредственного формирования кода в памяти и его исполнения.

Отдельное спасибо

(да я знаю, что благодарности помещают в конце, но там их редко кто читает :)) так вот отдельное спасибо: Спасибо человеку, который сделал из меня программиста. Спасибо Королеве Елене Филипповой. Если вы здесь, то вы знаете за что.:) Эта программа написана в то время когда меня можно было легко «взять на «слабо»». Так вот спасибо тому кто меня подначил на ее написание 🙂

Но к делу

Взявшись оформлять этот пример для общественности, я понял, что меняются не только времена и люди, но и исходники лежащие в архиве. Да их не узнать! Да неужели это писал я? Да… точно… странно… Но ведь он все еще работает! Вдвойне странно… Так что если что — сильно не ругаться — я был молодой и временами делал некрасивости. Старинный закон гласит: последняя ошибка программы выявляется через 7 лет эксплуатации. Если вы заметили ошибку, которой не заметил я — то буду благодарен, если вы мне о ней напишите. Я, пожалуй, не буду следовать примеру Д. Кнута и высылать деньги за замеченные ошибки, но спасибо скажу :).

Как все это работает:

Компилятор он и есть компилятор. Сначала выражение надо скомпилировать. Делается это с помощью функции

function Prepare(Ex:String):real;

которая вызывает

function preCalc(Ex:String):real;

формирующую код, вычисляющий заданное выражение. Как можно догадаться, Ex — это строка, содержащая математическое выражение. Функция preCalc рекурсивна и распознавая полученную математику, попутно формируя исполняемый код. Она имеет мало проверок на корректность и нет нужды вводить туда мусор и радоваться, когда увидите что все повисло. Помните правило GIGO (Garbage in Garbage Out). Не надо также ставить 0 под знак деления. Но это уже не моя ошибка :)))

ВНИМАНИЕ:

ограничение на глубина рекурсии: полученый код не должен помещать в стек более 8 значений.Снятие этого ограничения опять же лишь вопрос практической реализации.

Для понятности формируемый код представляется в ближайшем Memo. Функция возвращает: а фиг его знает что она возвращает 🙂 лучше не обращайте внимания 🙂 Скомпилировали? Теперь можно и запускать: При компиляции мы сформировали процедуру с красноречивым названием:

proc:TProc;

где

type TProc=procedure;

пример запуска можно найти в

procedure TForm1.BitBtn1Click(Sender: TObject);

Также встречаются процедуры и функции:

function SecindBracket(Ex:String;first:integer):Integer;

вот уж и не помню, отчего появилось такое красивое название (скорее всего от очепятки), но все это призвано обработать скобки в выражении ,

procedure TForm1.BitBtn1Click(Sender: TObject); // Вычисляй

запускает вычисление, а также

procedure TForm1.Button2Click(Sender: TObject); // Speed test

для того чтобы посмотреть какой за быстрый получился код. К сему прилагается слегка комментированный исходный код. Вряд ли кому нужны комментарии типа:

I:=0; // обнуляем счетчик

а по структуре программы там комментариев хватает. Ну вот и все… Буду рад если вам это пригодиться. Если какие пожелания — пишите. Конструктивная критика — пишите. Неконструктивная критика — тоже пишите — у меня файлы удаляются без помещения в корзину.

// Это Unit1.pas

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls, Buttons, StrEx, Math;

type

TForm1 = class(TForm)

Edit1: TEdit;

BitBtn1: TBitBtn;

Label1: TLabel;

Memo1: TMemo;

Button1: TButton;

Edit2: TEdit;

Label2: TLabel;

Button2: TButton;

procedure BitBtn1Click(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure Edit1Change(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure Button2Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

TProc = procedure;

var

Form1: TForm1;

A: array of real;

CS: array of Byte;

DS: array of Real;

Res, X, Y: real;

proc: TProc;

function preCalc(Ex: string): real;

function Prepare(Ex: string): real;

function SecindBracket(Ex: string; first: integer): Integer;

implementation

{$R *.DFM}

// это про скобки… это просто и не заслуживает большого внимания.

function SecindBracket(Ex: string; first: integer): Integer;

var

i, BrQ: integer;

begin

Result := 0;

case Ex[first] of

‘(‘:

begin

i := first 1;

BrQ := 0;

while (i <= length(Ex)) do

begin

if (BrQ = 0) and (Ex[i] = ‘)’) then

begin

Result := i;

exit;

end;

if Ex[i] = ‘(‘ then

Inc(BrQ)

else if Ex[i] = ‘)’ then

Dec(BrQ);

i := i 1;

end;

end;

‘)’:

begin

i := first — 1;

BrQ := 0;

while (i > 0) do

begin

if (BrQ = 0) and (Ex[i] = ‘(‘) then

begin

Result := i;

exit;

end;

if Ex[i] = ‘(‘ then

Inc(BrQ)

else if Ex[i] = ‘)’ then

Dec(BrQ);

i := i — 1;

end;

end;

end;

end;

// а вот тут мы собственно и формируем процедуру

function Prepare(Ex: string): real;

begin

SetLength(Ds, 1);

// вот это будет заголовок

SetLength(CS, 6);

cs[0] := $8B;

cs[1] := $05;

cs[2] := (integer(@ds) and $000000FF) shr 0;

cs[3] := (integer(@ds) and $0000FF00) shr 8;

cs[4] := (integer(@ds) and $00FF0000) shr 16;

cs[5] := (integer(@ds) and $FF000000) shr 24;

// вот это — вычисление

X := 1; //догадайтесь зачем 🙂

preCalc(Ex);

// а вот это — завершение

SetLength(CS, high(CS) 7);

cs[high(CS) — 5] := $DD;

cs[high(CS) — 4] := $1D;

cs[high(CS) — 3] := (integer(@res) and $000000FF) shr 0;

cs[high(CS) — 2] := (integer(@res) and $0000FF00) shr 8;

cs[high(CS) — 1] := (integer(@res) and $00FF0000) shr 16;

cs[high(CS) — 0] := (integer(@res) and $FF000000) shr 24;

SetLength(CS, high(CS) 2);

// ну и не забудем про RET

cs[high(CS)] := $C3; // ret

proc := pointer(cs);

end;

// будем формировать код рассчета.

function preCalc(Ex: string): real;

var

Sc, i, j: integer;

s, s1: string;

A, B: real;

const

Op: array[0..3] of char = (‘ ‘, ‘-‘, ‘/’, ‘*’);

begin

s := »; // да всегда инициализируйте переменные ваши

for i := 1 to length(Ex) do

if ex[i] ‘ ‘ then

s := s ex[i];

// чтобы под ногами не путались 🙂

while SecindBracket(s, Length(s)) = 1 do

s := copy(s, 2, Length(s) — 2); // скобки

if s = » then

begin

Result := 0;

ShowMessage(‘Error !’);

exit;

end;

val(s, Result, i); // это число ? а какое ?

if i = 0 then

begin // ага это число. так и запишем

Form1.Memo1.Lines.Add(‘fld ‘ FloatToStr(result));

SetLength(Ds, high(ds) 2);

Ds[high(ds)] := Result;

SetLength(CS, high(CS) 4);

cs[high(Cs)] := high(ds) * 8;

cs[high(Cs) — 1] := $40;

cs[high(Cs) — 2] := $DD;

exit;

end;

if (s = ‘x’) or (s = ‘X’) then

begin // опа, да это же Икс !

Form1.Memo1.Lines.Add(‘fld X’);

SetLength(CS, high(CS) 7);

cs[high(CS) — 5] := $DD;

cs[high(CS) — 4] := $05;

cs[high(CS) — 3] := (integer(@x) and $000000FF) shr 0;

cs[high(CS) — 2] := (integer(@x) and $0000FF00) shr 8;

cs[high(CS) — 1] := (integer(@x) and $00FF0000) shr 16;

cs[high(CS) — 0] := (integer(@x) and $FF000000) shr 24;

end;

// это все еще выражение 🙁 ох не кончились наши мучения

i := -1;

j := 0;

while j <= 1 do

begin

i := length(s);

Sc := 0;

while i > 0 do

begin // ну скобки надо обойти

if s[i] = ‘)’ then

Inc(Sc);

if s[i] = ‘(‘ then

Dec(Sc);

if Sc 0 then

begin

dec(i);

continue;

end;

if (s[i] = Op[j * 2]) then

begin

j := j * 2 10;

break;

end;

if (s[i] = Op[j * 2 1]) then

begin

j := j * 2 11;

break;

end;

dec(i);

end;

inc(j);

end;

//(‘ ‘,’-‘,’/’,’*’);

// а вот и рекурсия — все что справа и слева от меня пусть обработает …

// ой да это же я:) Ну а я так уж и быть сформирую код операции в середине 🙂

case j of

11:

begin

preCalc(copy(s, 1, i — 1));

preCalc(copy(s, i 1, length(s) — i));

Form1.Memo1.Lines.Add(‘FAddp St(1),st’);

// cs

//fAddP st(1),st // [DE C1]

SetLength(CS, high(CS) 3);

cs[high(Cs)] := $C1; // вот такой код сформируем

cs[high(Cs) — 1] := $DE;

end;

// далее — аналогично для каждой операции

12:

begin

preCalc(copy(s, 1, i — 1));

preCalc(copy(s, i 1, length(s) — i));

Form1.Memo1.Lines.Add(‘FSubP St(1),st’);

//fSubP st(1),st // [DE E9]

SetLength(CS, high(CS) 3);

cs[high(Cs)] := $E9;

cs[high(Cs) — 1] := $DE;

end;

13:

begin

try

preCalc(copy(s, 1, i — 1));

preCalc(copy(s, i 1, length(s) — i));

Form1.Memo1.Lines.Add(‘fdivP st(1),st’);

//fDivP st(1),st // [DE F9]

SetLength(CS, high(CS) 3);

cs[high(Cs)] := $F9;

cs[high(Cs) — 1] := $DE;

except

ShowMessage(‘Division by zero !… ‘);

preCalc(copy(s, 1, i — 1));

preCalc(copy(s, i 1, length(s) — i));

exit;

end;

end;

14:

begin

preCalc(copy(s, 1, i — 1));

preCalc(copy(s, i 1, length(s) — i));

Form1.Memo1.Lines.Add(‘FMulp St(1),st’);

//fMulP st(1),st // [DE C9]

SetLength(CS, high(CS) 3);

cs[high(Cs)] := $C9;

cs[high(Cs) — 1] := $DE;

end;

end;

end;

// Вычисляй

procedure TForm1.BitBtn1Click(Sender: TObject);

begin

x := StrToFloat(Edit2.text);

if (@proc nil) then

proc; // Вычисляй

Label1.caption := FloatToStr(res);

end;

// это всякие сервисные функции

procedure TForm1.Button1Click(Sender: TObject);

begin

Memo1.Clear;

Prepare(Edit1.text);

BitBtn1.Enabled := true;

end;

procedure TForm1.Edit1Change(Sender: TObject);

begin

BitBtn1.Enabled := false;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

Edit1.OnChange(self);

end;

// а это для того чтобы посмотреть какой за быстрый получился код

procedure TForm1.Button2Click(Sender: TObject); //Speed test

var

t: TDateTime;

i: integer;

const

N = $5000000; //количество повторений

begin

if @proc = nil then

exit;

t := now;

for i := 0 to N do

begin

x := i;

proc;

x := res;

end;

t := now — t;

Memo1.lines.add(‘work time for ‘ inttostr(N) ‘ repeats =’ TimeToStr(t)

‘ sec’);

Memo1.lines.add(‘=’ FloatToStr(t) ‘ days’);

end;

end.

// а это Unit1.dfm

object Form1: TForm1

Left = 175

Top = 107

Width = 596

Height = 375

Caption = ‘Form1’

Color = clBtnFace

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = ‘MS Sans Serif’

Font.Style = []

OldCreateOrder = False

OnCreate = FormCreate

PixelsPerInch = 96

TextHeight = 13

object Label1: TLabel

Left = 448

Top = 56

Width = 6

Height = 13

Caption = ‘[]’

end

object Label2: TLabel

Left = 19

Top = 12

Width = 13

Height = 13

Caption = ‘X=’

end

object Edit1: TEdit

Left = 16

Top = 32

Width = 417

Height = 21

TabOrder = 0

Text = ‘((24/2) 3*(7-x))’

OnChange = Edit1Change

end

object BitBtn1: TBitBtn

Left = 448

Top = 32

Width = 75

Height = 22

TabOrder = 1

OnClick = BitBtn1Click

Kind = bkOK

end

object Memo1: TMemo

Left = 16

Top = 80

Width = 241

Height = 249

TabOrder = 2

end

object Button1: TButton

Left = 448

Top = 2

Width = 75

Height = 25

Caption = ‘prepare’

TabOrder = 3

OnClick = Button1Click

end

object Edit2: TEdit

Left = 36

Top = 8

Width = 53

Height = 21

TabOrder = 4

Text = ‘2’

end

object Button2: TButton

Left = 264

Top = 80

Width = 75

Height = 25

Caption = ‘Speed test’

TabOrder = 5

OnClick = Button2Click

end

end

{/codecitation}

Добавить комментарий