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

王朝delphi·作者佚名  2006-01-09
窄屏简体版  字體: |||超大  

模仿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;

function analys(sour,dest:trichedit):bool;

var

able,unable:bool;

lcount,lwords,i :integer;

phr,nextp:pchar;

phr2,nextp2,temp21,temp22:pchar;

phr3,nextp3:pchar;

braket:char;

s:string;

begin

temp21:=nil;

temp22:=nil;

able:=true;

unable:=false;

lcount:=sour.Lines.Count;

i:=0;

while lcount >1 do

begin

s:=sour.Lines.Strings[i]; //将行赋给 s

if trim(pchar(s))<>nil then //非空串

begin

if phrase(s;phr;nextp)=true then //如果还有字符

//以下开始处理标志符识别和简单的语法分析

begin

if phr^='#' then

begin //判断下一个字符是不是include

if phrase(nextp,phr2,nextp2)=true then

begin

if phr2='include' then //找下一个非空字符

begin

while ((nextp2^=' ')and (strlen(nextp2)<>0))do

begin

temp22:= nextp2;

nextp2:=nextp2+1;

end; // while nextp2^<>' 'over

if nextp2^<>' 'then ////调用尖括号识别函数

begin

braket:='<';

if brakmatch(nextp2,braket,unabel)=true then

begin

end;

end;

end;// if phr2='include' then over

end;

end;

end;

end;

end;//while lcount >1

end;

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
 
 
© 2005- 王朝網路 版權所有 導航