Компилятор синтаксических выражений
Автор: Сергей Втюрин 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
|
|
