unit mainUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, LEXAN, lexlib;

const
  stackMaxSize=300;
  eol=0;

type
  TfrmMain = class(TForm)
    mmoIn: TMemo;
    btnRun: TButton;
    lbl: TLabel;
    procedure btnRunClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  Trule=record
    ruleLeft: Integer;
    ruleLength: Word;
  end;

  _Action=(shift,reduce,accept,error_state);

  Taction=record
    act: _Action;
    state: Integer;
  end;

const
  rule: array[2..4] of Trule=((ruleLeft:_GOAL;     ruleLength:6),
                              (ruleLeft:_SOME;     ruleLength:1),
                              (ruleLeft:_SOME;     ruleLength:1));

var
  frmMain: TfrmMain;
  terminals: array[0..stackMaxSize] of Integer; cterminals: Integer=0; //терминалы
  stack: array[0..stackMaxSize] of Integer; cstack: Integer=0;

procedure lexicalAnalysis;
function action(state:Integer; terminal:Integer): Taction;
function res(act: _Action; state: Integer): Taction;
function gotoTbl(state:Integer; noterm:Integer): Integer;
procedure LRanalyzer;

implementation

{$R *.dfm}

procedure lexicalAnalysis;
var t,tmp:Integer;
begin
  yylineno := 0; yyclear;
  yyline := frmMain.mmoIn.Lines.Text;
  cterminals := 0;
  repeat
    t := yylex;
    Inc(cterminals);
    terminals[cterminals-1] := t;
  until (t = eol);
  for t := 0 to (cterminals div 2)-1 do //overwind
  begin             //swap
    tmp := terminals[t];
    terminals[t] := terminals[cterminals-1-t];
    terminals[cterminals-1-t] := tmp;
  end;
  Dec(cterminals);
end;

function res(act: _Action; state: Integer): Taction;
begin
  Result.act := act;
  Result.state := state;
end;

function action(state:Integer; terminal:Integer): Taction;
begin
  Result := res(error_state,0);
  case state of
    0:  case terminal of
          _update:    Result := res(shift,2);
          _string:    Result := res(shift,3);
          _num:       Result := res(shift,4);
        end;
    1:  case terminal of
          eol:     Result := res(accept,0);
        end;
    2:  case terminal of
          _id:     Result := res(shift,5);
        end;
    3:  case terminal of
          eol:     Result := res(reduce,3);
        end;
    4:  case terminal of
         eol:      Result := res(reduce,4);
        end;
    5:  case terminal of
          _set:    Result := res(shift,6);
        end;
    6:  case terminal of
          _id:     Result := res(shift,7);
        end;
    7:  case terminal of
          ord('='):Result := res(shift,8);
        end;
    8:  case terminal of
          _string:    Result := res(shift,3);
          _num:       Result := res(shift,4);
        end;
    9:  case terminal of
          eol:        Result := res(reduce,2)
        end;
  end {case state}
end;

function gotoTbl(state:Integer; noterm:Integer): Integer;
begin
  case state of
    0:  case noterm of
          _GOAL:     Result := 1;
        end;
    8:  case noterm of
          _SOME:     Result := 9;
        end;
  end;
end;

procedure LRanalyzer;
var yy: Integer;
    act: Taction;
begin
  cstack := 1;
  stack[0] := eol; // end of line
  stack[1] := 0; //state S0
  yy := terminals[cterminals];
  repeat
    act := action(stack[cstack], yy);
    case act.act of
      shift:       begin
                     cstack := cstack + 2;
                     stack[cstack-1] := yy;
                     stack[cstack] := act.state;
                     Dec(cterminals);
                     yy := terminals[cterminals];
                   end;
      reduce:      begin
                     cstack := cstack - rule[act.state].ruleLength*2 +2;
                     stack[cstack-1] := rule[act.state].ruleLeft;
                     stack[cstack] := gotoTbl(stack[cstack-2],stack[cstack-1]);
                   end;
      error_state: begin
                     frmMain.lbl.Caption := 'Fail';
                     Break;
                   end;
      accept:      begin
                     frmMain.lbl.Caption := 'Luck';
                     Break;
                   end;
    end;
  until 1=2;
end;

procedure TfrmMain.btnRunClick(Sender: TObject);
begin
  lexicalAnalysis;
  LRanalyzer;
end;

end.