找来的，代码如下，但对与A=3，B=3，C=A+B的情况还不能
很好处理，但可以计数了，但看不懂程序，不知道各位大侠能否
给这个程序关键部分加点注释和完善它呢？
unit zmain;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
const
MaxStack=1000;
EpsReal=1e-5;
type
TOperator=(opAdd,opSub,opMul,opDiv,opLBracket,opRBracket);
//定义操作运
算符，oplbracker括号
TTokenType=(ttOperator,ttVariable,ttError);
TToken=record
kind: TTokenType;
case integer of
1
areg:integer;value:Extended
;
2
aop:TOperator);
end;
TMainForm = class(TForm)
Panel1: TPanel;
Splitter1: TSplitter;
Panel2: TPanel;
fromMemo: TMemo;
Splitter2: TSplitter;
toMemo: TMemo;
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Panel1Click(Sender: TObject);
private
{ Private declarations }
stack: array [1..maxstack] of TToken;
sp: integer;
function push(const T:TToken):boolean;
function pop:TToken;
function parse: integer;
public
{ Public declarations }
end;
var
MainForm: TMainForm;
implementation
{$R *.dfm}
function TMainForm.push(const T:TToken):boolean;
//进栈操作
begin
result:=false;
if sp>=maxstack then
exit;
inc(sp);
stack[sp]:=T;
result:=true;
end;
function TMainForm.pop:TToken;
//出栈操作
begin
pop:=stack[sp];
dec(sp);
end;
function TMainForm.parse:integer;
const
lev:array [TOperator] of integer=(1,1,2,2,-2,-1);//定义操作优先级
opStr:array [TOperator] of string=('ADD','SUB','MUL','DIV','NONAME','NONAM
E');
var
i,state,b:integer;
s:string;
token,t1,t2,t3,tnew:TToken;
regused:integer;
function nexttoken:TToken;
var
r,q:string;
e:integer;
begin
result.kind:=ttOperator;
result.aop:=opRBracket;
if length(s)=0 then
exit;
case s[1] of
'a'..'z','A'..'Z','0'..'9':begin
result.kind:=ttVariable;
inc(regused);
result.areg:=regused;
while (length(s)>0) and (s[1] in ['a'..'z','A'..'Z','0'..'9','.']) d
o
begin
r:=r+s[1];
delete(s,1,1);
end;
val(r,result.value,e);
if e<>0 then
begin
while e<>0do
begin
if not InputQuery('Value?','Please input the value of variable '
+r,q) then
begin
result.kind:=ttError;
exit;
end;
val(q,result.value,e);
end;
//END WHILE
end;
//END IF
toMemo.Lines.Add('MOV t'+inttostr(regused)+' <- '+r+'('+FloatToStrF(
result.value,ffFixed,18,3)+')');
end;
//END 字母情况
'+':begin
result.kind:=ttOperator;result.aop:=opAdd;delete(s,1,1);
end;
'-':begin
result.kind:=ttOperator;result.aop:=opSub;delete(s,1,1);
end;
'*':begin
result.kind:=ttOperator;result.aop:=opMul;delete(s,1,1);
end;
'/':begin
result.kind:=ttOperator;result.aop:=opDiv;delete(s,1,1);
end;
'(':begin
result.kind:=ttOperator;result.aop:=opLBracket;delete(s,1,1)
;
end;
')':begin
result.kind:=ttOperator;result.aop:=opRBracket;delete(s,1,1)
;
end;
else
result.kind:=ttError;
end;
end;
procedure InitStack;
//初始栈
begin
sp:=1;
stack[1].kind:=ttOperator;
stack[1].aop:=opLBracket;
end;
procedure Shift(const NextState:integer);
begin
State:=NextState;
end;
begin
//主体解释函数
result:=3;
s:=fromMemo.Lines.Text;
i:=1;
while i<=length(s)do
if (s
<=#32) or (s>=#127) then
delete(s,i,1) el
se begin
s:=upcase(s);inc(i);
end;
fromMemo.Lines.Text:=s;
b:=0;
for i:=1 to length(s)do
//检验括号是否匹配
begin
if s='(' then
inc(b) else
if s=')' then
dec(b);
if b<0 then
exit;
end;
if b<>0 then
exit;
result:=1;
toMemo.Lines.Clear;
InitStack;
state:=1;
regused:=0;
while (length(s)>0) or (sp>1)do
begin
case state of
1:begin
token:=nexttoken;
if not ((token.kind = ttVariable) or
((token.kind = ttOperator) and (token.aop = opLBracket))) then
exit
;
if not push(token) then
begin
result:=5;exit;
end;
if token.kind = ttVariable then
shift(2);
end;
2:begin
token:=nexttoken;
if token.kind <> ttOperator then
begin
result:=2;exit;
end;
if token.aop = opLBracket then
begin
result:=4;exit;
end;
t3:=pop;t2:=pop;
while lev[token.aop]<=lev[t2.aop]do
begin
t1:=pop;
inc(regused);
case t2.aop of
opAdd:tnew.value:=t1.value+t3.value;
opSub:tnew.value:=t1.value-t3.value;
opMul:tnew.value:=t1.value*t3.value;
opDiv:begin
if abs(tnew.value)<EpsReal then
begin
result:=7;
exit;
end;
tnew.value:=t1.value/t3.value;
end;
end;
tnew.areg:=regused;
tnew.kind:=ttVariable;
toMemo.Lines.Add(opstr[t2.aop]+' t'+inttostr(t1.areg)+', t'+inttos
tr(t3.areg)+' -> t'+inttostr(regused)+'('+FloatToStrF(tnew.value,ffFixed,18,
3)+')');
t3:=tnew;
t2:=pop;
end;
if token.aop=opRBracket then
push(t3) else
begin
push(t2);
push(t3);
if not push(token) then
begin
result:=5;exit;
end;
shift(1);
end;
end;
end;
end;
toMemo.Lines.Add('Result: t'+inttostr(stack[1].areg)+'('+FloatToStrF(stack
[1].value,ffFixed,18,3)+')');
result:=0;
end;
procedure TMainForm.Button1Click(Sender: TObject);
var
r:integer;
begin
r:=parse;
if r<>0 then
begin
MessageDlg('Error!',mtWarning,[mbOK],0);
toMemo.Lines.Clear;
case r of //显示出错信息
1:toMemo.Lines.Add('Variable was expected but not found!');
2:toMemo.Lines.Add('Operator was expected but not found!');
3:toMemo.Lines.Add('Bracketsdo
n''t match!!!');
4:toMemo.Lines.Add('Operator was expected but ''('' found!');
5:toMemo.Lines.Add('Stack overflow!!!');
6:toMemo.Lines.Add('Warning: variable not assigned!!!');
7:toMemo.Lines.Add('FPE: Division by zero!!!');
else
toMemo.Lines.Add('Unknow error!');
end;
end;
end;
procedure TMainForm.Button2Click(Sender: TObject);
begin
Application.Terminate;
end;
