Курсовая работа. / РЯП_Ксю / Other / Bosk_tjp / proga / src / LEX

(*
 * Lex.pas - модуль Лексического Анализа
 * ver. 0.37
 * 21.05.2007 serg
 *)

(* Список Fix-ов
 * 1) isKeyword(): "Уничтожение" токенов _LOW и _HIGH  (для OR и NOT), добавление токена "MOP"
 * 2) get_token(): "Уничтожение" токена _LOW (для + и -)
 *
 * BigFix
 * 3) missSpace(): фунциия теперь "пожирает" и комментарии тоже
 *
 * 4##)  добавление операции WRTS и строк (_STR)
 *
 *)
unit Lex;
interface
uses uStack;
const
(* Fix 4## 1 edit - добавлен токен WRITES*)
  keywords: array[0..29] of String[8] =
    ('AND', 'ARRAY', 'BEGIN', 'BOOLEAN', 'CONST', 'DIV', 'ELSE',
     'END', 'FALSE', 'GOTO', 'IF', 'INTEGER', 'LABEL', 'MOD', 'NOT', 'OF',
     'OR', 'PROGRAM', 'READ', 'REPEAT', 'THEN', 'TRUE', 'TYPE',
     'UNTIL', 'VAR', 'WRITE', 'WRITES','WRITEM','CON', 'DIS');
type
  Tokens = String[8];
var
  lines: Word;

(* Fix 4## 2 add*)
const strMaxCount = 100;
var strTable:array[1..strMaxCount] of string[50];
var strCount: Integer;
(*end Fix 4## 2*)


function get_token(var f_in: Text; var value1, value2: String; var c: Char; var w: Boolean): Tokens;

implementation


function toUpperCase(str_in: Tokens): Tokens;
var
  j: Byte;
begin
  for j := 1 to Length(str_in) do
    str_in[j] := UpCase(str_in[j]);
  toUpperCase := str_in;
end;

function isLetter(c: Char): boolean;
var x: Byte;
begin
  x := Ord(c);
  if(x>64) and (x<91) or (x>96) and (x<123) then
    isLetter := true
  else
    isLetter := false;
end;

function isNum(c: Char): boolean;
var x: Byte;
begin
  x := Ord(c);
  if (x>47) and (x<58) then
    isNum := true
  else
    isNum := false;
end;

function isId(c: Char): boolean;
begin
  if isLetter(c) or isNum(c) or (c='_') then
    isId := true
  else
    isId := false;
end;

procedure isKeyword(lexem: String; var token: Tokens);
var
  j: Byte;
  t: String;
  q: Boolean;
begin
  token := '_ID';
  q := false;
  j := 0;
  repeat
    if (keywords[j] = toUpperCase(lexem)) then begin
      q := true;
      t := toUpperCase(lexem);
(* Fix 1 edit *)
(* "Уничтожение" токенов _LOW и _HIGH (для OR и NOT)*)
(* было *)
(*
      if t = 'OR' then token := '_LOW'
      else
      if (t = 'AND')or(t = 'DIV')or(t = 'MOD') then token := '_MID'
      else
      if t = 'NOT' then token := '_HIGH'
*)
(* стало *)
      if (t = 'AND')or(t = 'DIV')or(t = 'MOD') then token := '_MID'
      else
      if (t = 'CON')or(t = 'DIS') then
        token := '_MOP'
(*end Fix 1*)

      else
        token := '_' + t;
    end;
    j := j + 1;
(* Fix 4## 3 edit *)
(*  until q or (j = 27); *)
  until q or (j = 30);
(* end Fix 4## 3 *)

end;


(* BigFix3 edit - фунциия теперь "пожирает" и комментарии тоже *)
function missSpace(var f_in: Text; var c: Char): Boolean;
var isComment : boolean;
begin
(* стало *)
  if not (Ord(c) in [10, 13, 32, Ord('{')]) then
    missSpace := false
  else begin
    isComment := (c='{');
    while ((Ord(c) in [10, 13, 32, Ord('{')]) or isComment) and not Eof(f_in) do begin
      if isComment then
         isComment := (c<>'}')
      else
         isComment := (c='{');
      Read(f_in,c);
      if Ord(c) = 10 then Inc(lines);
    end;
    if Ord(c) in [10, 13, 32] then begin
      missSpace := true
    end
    else
      missSpace := false
  end;
(* было *)
(*
  if not (Ord(c) in [10, 13, 32]) then
    missSpace := false
  else begin
    while (Ord(c) in [10, 13, 32]) and not Eof(f_in) do begin
      Read(f_in,c);
      if Ord(c) = 10 then Inc(lines);
    end;
    if Ord(c) in [10, 13, 32] then begin
{      Inc(lines);}
      missSpace := true
    end
    else
      missSpace := false
  end;
*)
end;
(* BigFix3 end*)

function GoNextT(var f_in: Text; var c: Char): Boolean;
begin
  if not Eof(f_in) then begin
    Read(f_in, c);
    GoNextT := missSpace(f_in, c);
  end
  else
    GoNextT := true;
end;

function get_token(var f_in: Text; var value1, value2: String; var c: Char; var w: Boolean): Tokens;
var
  q: Boolean;
  token,s: Tokens;
  p: tTable;
(*Fix 4##  4 add*)
var myStr: string;
(*end Fix 4##  4*)
begin
  q := false;
  value1 := '';
  w := missSpace(f_in, c);
  if isLetter(c) then begin
    if not Eof(f_in) then
      repeat
        value1 := value1 + c;
        Read(f_in,c);
      until not isId(c) or Eof(f_in)
    else w := true;
    if isId(c) then begin
      value1 := value1 + c;
      w := true;
    end
    else begin
      w := missSpace(f_in, c);
    end;
    isKeyword(value1,token);
    if token = '_FALSE' then begin
      value1 := 'false';
      value2 := 'BOOLEAN'
    end;
    if token = '_TRUE' then begin
      value1 := 'true';
      value2 := 'BOOLEAN'
    end;
    if token = '_ID' then begin
{      value2 := 'INTEGER';}
      p := isExist(value1);
{      Str(p^.col1,s);}
      value2 := p^.col1
    end;
    get_token := token;
    q := true;
  end;
  if not q and isNum(c) then begin
    if not Eof(f_in) then
      repeat
        value1 := value1 + c;
        Read(f_in,c);
      until not isNum(c) or Eof(f_in)
    else w := true;
    if isNum(c) then begin
      value1 := value1 + c;
      w := true;
    end
    else
      w := missSpace(f_in, c);
    get_token := '_NUM';
    value2 := 'INTEGER';
    q := true;
  end;
  if not q and (c = '.') then begin
    value1 := c;
    get_token := value1;
    if not Eof(f_in) then begin
      Read(f_in,c);
      if (c = '.') then begin
        value1 := value1 + c;
        w := GoNextT(f_in, c);
        get_token := '_DDOT';
      end
    end
    else w := true;
    q := true;
  end;
  if not q and (c = ':') then begin
    value1 := c;
    get_token := value1;
    if not Eof(f_in) then begin
      Read(f_in,c);
      if (c = '=') then begin
        value1 := value1 + c;
        w := GoNextT(f_in, c);
        get_token := '_EQ';
      end
    end
    else w := true;
    q := true;
  end;
  if not q and (c = '<') then begin
    value1 := c;
    if not Eof(f_in) then begin
      Read(f_in, c);
      if c in ['=', '>'] then begin
        value1 := value1 + c;
        w := GoNextT(f_in, c);
      end;
    end
    else w := true;
    get_token := '_REL';
    q := true;
  end;
  if not q and (c = '>') then begin
    value1 := c;
    if not Eof(f_in) then begin
      Read(f_in, c);
      if (c = '=') then begin
        value1 := value1 + c;
        w := GoNextT(f_in, c);
      end;
    end
    else w := true;
    get_token := '_REL';
    q := true;
  end;
  if not q and (c = '=') then
  begin
    value1 := c;
    get_token := '_REL';
    w := GoNextT(f_in, c);
    q := true;
  end;
  if not q and (c = '*') then
  begin
    value1 := c;
    get_token := '_MID';
    w := GoNextT(f_in, c);
    q := true;
  end;
  if not q and (c in ['+', '-']) then
  begin
    value1 := c;
(* Fix 2 edit *)
(* "Уничтожение" токена _LOW (для + и -)*)
(* было *)
    (* get_token := '_LOW';*)
(* стало *)
    get_token := c;
(* end Fix 2 *)
    w := GoNextT(f_in, c);
    q := true;
  end;
  if not q and (c in [';', ',', '[', ']', '(', ')']) then
  begin
    value1 := c;
    get_token := c;
    w := GoNextT(f_in, c);
    q := true;
  end;


(*Fix 4## 5 add*)
  if not q and (c = '''') then
  begin
    myStr := '';
    if not Eof(f_in) then
      repeat
        if c<>'''' then myStr:= myStr+c;
        Read(f_in,c);
      until (c='''') or (Ord(c) in [10, 13]) or Eof(f_in)
    else w := true; {==EOF}

    w := GoNextT(f_in, c);
    q := true;

    inc(strCount);
    strTable[strCount] := myStr;
    str(strCount,myStr);
    value1 := myStr;
    value2 := 'STRING';
    get_token := '_STR';
 end;

(*end Fix 4## 5 *)

  if not q then
    get_token := 'nil';
end;

end.