编译原理的一个简单的枚举算法

模仿C

能判断#include<>;main();int;char;for;printf;scanf;{};

private
//在str中找第一个单词 如果 找到则返回第一个单词的地址（phrase）和下一个要分析单词的入口（nextptr）
//如果str是空串则返回false
function phrase(str:string;phrase,nextptr:pchar):bool; //
//括号匹配函数
//p；判断字符的地址，char：什么括号（包括：<>;()2种)，deep:允许嵌套么？匹配成功返回true;
function brkmatch(p:pchar;brk:char;deep:bool;next:pchar):bool;
function corbeil(r:trichedit;line,col:pinteger):bool; //line 返回出错的行,col返回出错的列;
function semicolon(p,next:pchar):bool;//p:入口地址 next:下一个字符的地址
//semicolon 如果没找到 返回false next=nil 找到其他字符 返回false且 next便指向他的下一个
function analys(sour,dest:trichedit):bool;

public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}
function tform1.corbeil(r:trichedit;line,col:pinteger):bool;
var
n,l,i,c:integer;
temp:pchar;
ptr:pchar;
begin
i:=0;
c:=r.Lines.Count;
n:=0;
while c>1 do
begin
getmem(temp,length(r.Lines.Strings[i]) 1);
strcopy(temp,pchar(r.Lines.Strings[i]));
ptr:=temp;
l:=length(r.Lines.Strings[i]);
while l>1 do
begin
if ptr^=''''{'''' then
begin
n:=n 1;
end
else
if ptr^=''''}''''then
if n>0 then
n:=n-1
else
begin
result:=false;
break;
line^:=r.Lines.Count-c 1;
col^:=length(r.Lines.Strings[i])-l 1;
end;
l:=l-1;
end;// while l>1 do
freemem(temp);
i:=i 1;
c:=c-1;
end;//while line less than linecount
if n=0 then
result:=true
else
result:=false;
end;

function tform1.phrase(str:string;phrase,nextptr:pchar):bool;
var
phr:pchar;
n:pchar;
temp:pchar;
ptr:pchar; //指向下一个要分析的单词的地址

begin
n:='''' '''';
str:=trim(str);
if length(str)<>0 then
begin
getmem(temp,length(str) 1);
strcopy(temp,pchar(str));
ptr:=strpos(temp,n);
getmem(phr,integer(ptr-temp) 1);
strlcopy(phr,temp,integer(ptr-temp));
phrase:=phr;
nextptr:=ptr;//是空格
result:=true;
end
else
result:=false;
freemem(temp);
end;
function tform1.brkmatch(p:pchar;brk:char;deep:bool;next:pchar):bool;
var
n,len:integer;
begin
len:=strlen(p)-1;
if deep=true then
begin
if p^=''''(''''then
begin
n:=1;
while len>0 do
begin
p:=p 1;
if p^=''''('''' then
n:=n 1
else
if p^='''')'''' then
if n>0 then
n:=n-1
else
begin
result:=false;
next:=p 1; //不成功 flase next不为空表示)多余
break;
end;

end; //while over;
if n>0 then
begin
result:=false;
next:=nil;//result=false且next为空表示(多余
end
else
begin
result:=true; //如果''''(''''匹配成功则 true next 为 null
next:=nil;
end;//else
end; //if p^=''''(''''then over

end //if deep=true then over
else
if deep=false then
begin
if p^=''''<'''' then
begin
while len>0 do
begin
len:=len-1;
p:=p 1;
if p^=''''>''''then
begin
result:=true;
break;
next:=p 1; //如果是''''<''''匹配成功,true且next指向下一个要分析的字符
end; // if p^=''''>''''then
end;//while len>0 do
if len=0 then
begin
result:=false;
next:=nil;
end;//len=0 over
end// if
else //如果第一个字符不是‘<’ 则返回错误 并带回下一个 指针
begin
result:=false;
next:=p 1;

end; //

end; //if deep=false then ovser

end; //function over;
function tform1.semicolon(p,next:pchar):bool;//p:入口地址
var
temp,ptr:pchar;
i:integer;
begin
i:=strlen(p);
while i>1 do
begin
if p^='''';''''then
begin
result:=true;
next:=p 1;
break;
end;//if p^='''';''''then
if p^='''' ''''then
begin
i:=i-1;
p:=p 1;

end;// if p^='''' ''''
if ((p^<>'''' '''')or (p^<>'''';''''))then
begin
result:=false;
next:=p 1;
break;
end;
end;//while
if i=1 then
begin
result:=false;
next:=nil;
end;
end;//function semicolon(p:pchar)over;

标签：

版权申明：本站文章部分自网络，如有侵权，请联系：west999com@outlook.com
特别注意：本站所有转载文章言论不代表本站观点，本站所提供的摄影照片，插画，设计作品，如需使用，请与原作者联系，版权归原作者所有