expressiony4.pas

语法分析 语法分析

(* Yacc parser template (TP Yacc V3.0), V1.2 6-17-91 AG *)

(* global definitions: *)

{*
   计算支持简单变量的数学表达式的yacc程序
   编译：yacc Expression4 ExpressionY4
 *}
unit ExpressionY4;

interface
uses
  SysUtils, LexLib, YaccLib, Classes, ExpressionL4;

{指定不同于整数的类型时，一定要使用%type <Real> expression 指定表达式的类型}
{同时要使用 %token <Real> Number来指定token的类型}
{注意, tp lex yacc不支持%union 标签，我们直接指定类型就可以了}

var
  SymList:TStringList;

{查找符号是否在符号表中}
function symlook(symp:string):TSymtab;

const NAME = 257;
const NUMBER = 258;
const UMINUS = 259;

type YYSType = record case Integer of
                 1 : ( yyReal : Real );
                 2 : ( yyinteger : integer );
               end(*YYSType*);

var yylval : YYSType;

function yyparse: integer;

implementation

function yyparse : Integer;

var yystate, yysp, yyn : Integer;
    yys : array [1..yymaxdepth] of Integer;
    yyv : array [1..yymaxdepth] of YYSType;
    yyval : YYSType;

procedure yyaction ( yyruleno : Integer );
  (* local definitions: *)
begin
  (* actions: *)
  case yyruleno of
   1 : begin
         yyval := yyv[yysp-1];
       end;
   2 : begin
         yyval := yyv[yysp-2];
       end;
   3 : begin
         TSymtab(yyv[yysp-2].yyinteger).Value := yyv[yysp-0].yyReal; 
       end;
   4 : begin
         writeln(format('= %f', [yyv[yysp-0].yyReal])); 
       end;
   5 : begin
         yyval.yyReal := yyv[yysp-2].yyReal + yyv[yysp-0].yyReal; 
       end;
   6 : begin
         yyval.yyReal := yyv[yysp-2].yyReal - yyv[yysp-0].yyReal; 
       end;
   7 : begin
         yyval.yyReal := yyv[yysp-2].yyReal * yyv[yysp-0].yyReal; 
       end;
   8 : begin
         	if(yyv[yysp-0].yyReal = 0.0) then
         						yyerror('除零错误')
         					else
         						yyval.yyReal := yyv[yysp-2].yyReal / yyv[yysp-0].yyReal;
         				
       end;
   9 : begin
         yyval.yyReal := -yyv[yysp-0].yyReal; 
       end;
  10 : begin
         yyval.yyReal := yyv[yysp-1].yyReal; 
       end;
  11 : begin
         yyval := yyv[yysp-0];
       end;
  12 : begin
         yyval.yyReal := TSymtab(yyv[yysp-0].yyinteger).value; 
       end;
  13 : begin
         
         			if Assigned(TSymtab(yyv[yysp-3].yyinteger).funcptr) then
         			  yyval.yyReal := TSymtab(yyv[yysp-3].yyinteger).funcptr(yyv[yysp-1].yyReal)
         			else
         			begin
         			  writeln(format('%s 不是函数', [TSymtab(yyv[yysp-3].yyinteger).name]));
         			  yyval.yyReal := 0.0;
         			end;
         		
       end;
  end;
end(*yyaction*);

(* parse table: *)

type YYARec = record
                sym, act : Integer;
              end;
     YYRRec = record
                len, sym : Integer;
              end;

const

yynacts   = 89;
yyngotos  = 13;
yynstates = 28;
yynrules  = 13;

yya : array [1..yynacts] of YYARec = (
{ 0: }
  ( sym: 40; act: 4 ),
  ( sym: 45; act: 5 ),
  ( sym: 257; act: 6 ),
  ( sym: 258; act: 7 ),
{ 1: }
  ( sym: 10; act: 8 ),
{ 2: }
  ( sym: 0; act: 0 ),
  ( sym: 40; act: 4 ),
  ( sym: 45; act: 5 ),
  ( sym: 257; act: 6 ),
  ( sym: 258; act: 7 ),
{ 3: }
  ( sym: 42; act: 10 ),
  ( sym: 43; act: 11 ),
  ( sym: 45; act: 12 ),
  ( sym: 47; act: 13 ),
  ( sym: 10; act: -4 ),
{ 4: }
  ( sym: 40; act: 4 ),
  ( sym: 45; act: 5 ),
  ( sym: 257; act: 15 ),
  ( sym: 258; act: 7 ),
{ 5: }
  ( sym: 40; act: 4 ),
  ( sym: 45; act: 5 ),
  ( sym: 257; act: 15 ),
  ( sym: 258; act: 7 ),
{ 6: }
  ( sym: 40; act: 17 ),
  ( sym: 61; act: 18 ),
  ( sym: 10; act: -12 ),
  ( sym: 42; act: -12 ),
  ( sym: 43; act: -12 ),
  ( sym: 45; act: -12 ),
  ( sym: 47; act: -12 ),
{ 7: }
{ 8: }
{ 9: }
  ( sym: 10; act: 19 ),
{ 10: }
  ( sym: 40; act: 4 ),
  ( sym: 45; act: 5 ),
  ( sym: 257; act: 15 ),
  ( sym: 258; act: 7 ),
{ 11: }
  ( sym: 40; act: 4 ),
  ( sym: 45; act: 5 ),
  ( sym: 257; act: 15 ),
  ( sym: 258; act: 7 ),
{ 12: }
  ( sym: 40; act: 4 ),
  ( sym: 45; act: 5 ),
  ( sym: 257; act: 15 ),
  ( sym: 258; act: 7 ),
{ 13: }
  ( sym: 40; act: 4 ),
  ( sym: 45; act: 5 ),
  ( sym: 257; act: 15 ),
  ( sym: 258; act: 7 ),
{ 14: }
  ( sym: 41; act: 24 ),
  ( sym: 42; act: 10 ),
  ( sym: 43; act: 11 ),
  ( sym: 45; act: 12 ),
  ( sym: 47; act: 13 ),
{ 15: }
  ( sym: 40; act: 17 ),
  ( sym: 10; act: -12 ),
  ( sym: 41; act: -12 ),
  ( sym: 42; act: -12 ),
  ( sym: 43; act: -12 ),
  ( sym: 45; act: -12 ),
  ( sym: 47; act: -12 ),
{ 16: }
{ 17: }
  ( sym: 40; act: 4 ),
  ( sym: 45; act: 5 ),
  ( sym: 257; act: 15 ),
  ( sym: 258; act: 7 ),
{ 18: }
  ( sym: 40; act: 4 ),
  ( sym: 45; act: 5 ),
  ( sym: 257; act: 15 ),
  ( sym: 258; act: 7 ),
{ 19: }
{ 20: }
{ 21: }
  ( sym: 42; act: 10 ),
  ( sym: 47; act: 13 ),
  ( sym: 10; act: -5 ),
  ( sym: 41; act: -5 ),
  ( sym: 43; act: -5 ),
  ( sym: 45; act: -5 ),
{ 22: }
  ( sym: 42; act: 10 ),
  ( sym: 47; act: 13 ),
  ( sym: 10; act: -6 ),
  ( sym: 41; act: -6 ),
  ( sym: 43; act: -6 ),
  ( sym: 45; act: -6 ),
{ 23: }
{ 24: }
{ 25: }
  ( sym: 41; act: 27 ),
  ( sym: 42; act: 10 ),
  ( sym: 43; act: 11 ),
  ( sym: 45; act: 12 ),
  ( sym: 47; act: 13 ),
{ 26: }
  ( sym: 42; act: 10 ),
  ( sym: 43; act: 11 ),
  ( sym: 45; act: 12 ),
  ( sym: 47; act: 13 ),
  ( sym: 10; act: -3 )
{ 27: }
);

yyg : array [1..yyngotos] of YYARec = (
{ 0: }
  ( sym: -4; act: 1 ),
  ( sym: -3; act: 2 ),
  ( sym: -2; act: 3 ),
{ 1: }
{ 2: }
  ( sym: -4; act: 9 ),
  ( sym: -2; act: 3 ),
{ 3: }
{ 4: }
  ( sym: -2; act: 14 ),
{ 5: }
  ( sym: -2; act: 16 ),
{ 6: }
{ 7: }
{ 8: }
{ 9: }
{ 10: }
  ( sym: -2; act: 20 ),
{ 11: }
  ( sym: -2; act: 21 ),
{ 12: }
  ( sym: -2; act: 22 ),
{ 13: }
  ( sym: -2; act: 23 ),
{ 14: }
{ 15: }
{ 16: }
{ 17: }
  ( sym: -2; act: 25 ),
{ 18: }
  ( sym: -2; act: 26 )
{ 19: }
{ 20: }
{ 21: }
{ 22: }
{ 23: }
{ 24: }
{ 25: }
{ 26: }
{ 27: }
);

yyd : array [0..yynstates-1] of Integer = (
{ 0: } 0,
{ 1: } 0,
{ 2: } 0,
{ 3: } 0,
{ 4: } 0,
{ 5: } 0,
{ 6: } 0,
{ 7: } -11,
{ 8: } -1,
{ 9: } 0,
{ 10: } 0,
{ 11: } 0,
{ 12: } 0,
{ 13: } 0,
{ 14: } 0,
{ 15: } 0,
{ 16: } -9,
{ 17: } 0,
{ 18: } 0,
{ 19: } -2,
{ 20: } -7,
{ 21: } 0,
{ 22: } 0,
{ 23: } -8,
{ 24: } -10,
{ 25: } 0,
{ 26: } 0,
{ 27: } -13
);

yyal : array [0..yynstates-1] of Integer = (
{ 0: } 1,
{ 1: } 5,
{ 2: } 6,
{ 3: } 11,
{ 4: } 16,
{ 5: } 20,
{ 6: } 24,
{ 7: } 31,
{ 8: } 31,
{ 9: } 31,
{ 10: } 32,
{ 11: } 36,
{ 12: } 40,
{ 13: } 44,
{ 14: } 48,
{ 15: } 53,
{ 16: } 60,
{ 17: } 60,
{ 18: } 64,
{ 19: } 68,
{ 20: } 68,
{ 21: } 68,
{ 22: } 74,
{ 23: } 80,
{ 24: } 80,
{ 25: } 80,
{ 26: } 85,
{ 27: } 90
);

yyah : array [0..yynstates-1] of Integer = (
{ 0: } 4,
{ 1: } 5,
{ 2: } 10,
{ 3: } 15,
{ 4: } 19,
{ 5: } 23,
{ 6: } 30,
{ 7: } 30,
{ 8: } 30,
{ 9: } 31,
{ 10: } 35,
{ 11: } 39,
{ 12: } 43,
{ 13: } 47,
{ 14: } 52,
{ 15: } 59,
{ 16: } 59,
{ 17: } 63,
{ 18: } 67,
{ 19: } 67,
{ 20: } 67,
{ 21: } 73,
{ 22: } 79,
{ 23: } 79,
{ 24: } 79,
{ 25: } 84,
{ 26: } 89,
{ 27: } 89
);

yygl : array [0..yynstates-1] of Integer = (
{ 0: } 1,
{ 1: } 4,
{ 2: } 4,
{ 3: } 6,
{ 4: } 6,
{ 5: } 7,
{ 6: } 8,
{ 7: } 8,
{ 8: } 8,
{ 9: } 8,
{ 10: } 8,
{ 11: } 9,
{ 12: } 10,
{ 13: } 11,
{ 14: } 12,
{ 15: } 12,
{ 16: } 12,
{ 17: } 12,
{ 18: } 13,
{ 19: } 14,
{ 20: } 14,
{ 21: } 14,
{ 22: } 14,
{ 23: } 14,
{ 24: } 14,
{ 25: } 14,
{ 26: } 14,
{ 27: } 14
);

yygh : array [0..yynstates-1] of Integer = (
{ 0: } 3,
{ 1: } 3,
{ 2: } 5,
{ 3: } 5,
{ 4: } 6,
{ 5: } 7,
{ 6: } 7,
{ 7: } 7,
{ 8: } 7,
{ 9: } 7,
{ 10: } 8,
{ 11: } 9,
{ 12: } 10,
{ 13: } 11,
{ 14: } 11,
{ 15: } 11,
{ 16: } 11,
{ 17: } 12,
{ 18: } 13,
{ 19: } 13,
{ 20: } 13,
{ 21: } 13,
{ 22: } 13,
{ 23: } 13,
{ 24: } 13,
{ 25: } 13,
{ 26: } 13,
{ 27: } 13
);

yyr : array [1..yynrules] of YYRRec = (
{ 1: } ( len: 2; sym: -3 ),
{ 2: } ( len: 3; sym: -3 ),
{ 3: } ( len: 3; sym: -4 ),
{ 4: } ( len: 1; sym: -4 ),
{ 5: } ( len: 3; sym: -2 ),
{ 6: } ( len: 3; sym: -2 ),
{ 7: } ( len: 3; sym: -2 ),
{ 8: } ( len: 3; sym: -2 ),
{ 9: } ( len: 2; sym: -2 ),
{ 10: } ( len: 3; sym: -2 ),
{ 11: } ( len: 1; sym: -2 ),
{ 12: } ( len: 1; sym: -2 ),
{ 13: } ( len: 4; sym: -2 )
);


const _error = 256; (* error token *)

function yyact(state, sym : Integer; var act : Integer) : Boolean;
  (* search action table *)
  var k : Integer;
  begin
    k := yyal[state];
    while (k<=yyah[state]) and (yya[k].sym<>sym) do inc(k);
    if k>yyah[state] then
      yyact := false
    else
      begin
        act := yya[k].act;
        yyact := true;
      end;
  end(*yyact*);

function yygoto(state, sym : Integer; var nstate : Integer) : Boolean;
  (* search goto table *)
  var k : Integer;
  begin
    k := yygl[state];
    while (k<=yygh[state]) and (yyg[k].sym<>sym) do inc(k);
    if k>yygh[state] then
      yygoto := false
    else
      begin
        nstate := yyg[k].act;
        yygoto := true;
      end;
  end(*yygoto*);

label parse, next, error, errlab, shift, reduce, accept, abort;

begin(*yyparse*)

  (* initialize: *)

  yystate := 0; yychar := -1; yynerrs := 0; yyerrflag := 0; yysp := 0;

{$ifdef yydebug}
  yydebug := true;
{$else}
  yydebug := false;
{$endif}

parse:

  (* push state and value: *)

  inc(yysp);
  if yysp>yymaxdepth then
    begin
      yyerror('yyparse stack overflow');
      goto abort;
    end;
  yys[yysp] := yystate; yyv[yysp] := yyval;

next:

  if (yyd[yystate]=0) and (yychar=-1) then
    (* get next symbol *)
    begin
      yychar := yylex; if yychar<0 then yychar := 0;
    end;

  if yydebug then writeln('state ', yystate, ', char ', yychar);

  (* determine parse action: *)

  yyn := yyd[yystate];
  if yyn<>0 then goto reduce; (* simple state *)

  (* no default action; search parse table *)

  if not yyact(yystate, yychar, yyn) then goto error
  else if yyn>0 then                      goto shift
  else if yyn<0 then                      goto reduce
  else                                    goto accept;

error:

  (* error; start error recovery: *)

  if yyerrflag=0 then yyerror('syntax error');

errlab:

  if yyerrflag=0 then inc(yynerrs);     (* new error *)

  if yyerrflag<=2 then                  (* incomplete recovery; try again *)
    begin
      yyerrflag := 3;
      (* uncover a state with shift action on error token *)
      while (yysp>0) and not ( yyact(yys[yysp], _error, yyn) and
                               (yyn>0) ) do
        begin
          if yydebug then
            if yysp>1 then
              writeln('error recovery pops state ', yys[yysp], ', uncovers ',
                      yys[yysp-1])
            else
              writeln('error recovery fails ... abort');
          dec(yysp);
        end;
      if yysp=0 then goto abort; (* parser has fallen from stack; abort *)
      yystate := yyn;            (* simulate shift on error *)
      goto parse;
    end
  else                                  (* no shift yet; discard symbol *)
    begin
      if yydebug then writeln('error recovery discards char ', yychar);
      if yychar=0 then goto abort; (* end of input; abort *)
      yychar := -1; goto next;     (* clear lookahead char and try again *)
    end;

shift:

  (* go to new state, clear lookahead character: *)

  yystate := yyn; yychar := -1; yyval := yylval;
  if yyerrflag>0 then dec(yyerrflag);

  goto parse;

reduce:

  (* execute action, pop rule from stack, and go to next state: *)

  if yydebug then writeln('reduce ', -yyn);

  yyflag := yyfnone; yyaction(-yyn);
  dec(yysp, yyr[-yyn].len);
  if yygoto(yys[yysp], yyr[-yyn].sym, yyn) then yystate := yyn;

  (* handle action calls to yyaccept, yyabort and yyerror: *)

  case yyflag of
    yyfaccept : goto accept;
    yyfabort  : goto abort;
    yyferror  : goto errlab;
  end;

  goto parse;

accept:

  yyparse := 0; exit;

abort:

  yyparse := 1; exit;

end(*yyparse*);

function symlook(symp:string):TSymtab;
var
  I:integer;
  sym:TSymtab;
begin
  I:=SymList.Indexof(symp);
  if I>-1 then
    result:=TSymtab(SymList.Objects[I])
  else
  begin
    sym:=TSymtab.Create;
    sym.name:=symp;
    Symlist.addObject(symp, sym);
    result:=sym;
  end;
end;

//添加函数定义
procedure addfunc(name:string;func:TOneParamFunc);
var
  sym:TSymtab;
begin
  sym:= symlook(name);
  sym.funcptr := func;
end;

function newSqrt(argc:extended):Extended;
begin
  Result:=sqrt(argc);
end;

initialization
  SymList:=TStringList.Create;
  //添加函数定义
  addfunc('sqrt', newSqrt);
finalization
  // todo: 释放同字符串绑定的TSymtab对象
  SymList.free;
end.