Untitled

unit Comprobar;


interface


Uses
  Lista;




Procedure Linea (Var f:tFichero; Var fs:tFichero; Var lpi:tListaPI; Var er:tBool; ct:tCont; Var e:tBool; Var nvac:tBool);
Function Especiales (cad:String):tBool;




implementation




Function noTerminal (c:tCar):tBool;

begin
  If (c>='A') and (c<='Z') then noTerminal:=true
  Else noTerminal:=false;
end;




Function Terminal (c:tCar):tBool;
begin
  If ((c>='A') and (c<='Z')) or ((c>='a') and (c<='z')) or ((c>='0') and (c<='9')) then Terminal:=true
   else if ((Ord(c)>=33) and ((Ord(c)<=47))) or ((Ord(c)>=91) and ((Ord(c)<=96))) then Terminal:=true
    else if (Ord(c)=123) or (Ord(c)=125) or (Ord(c)=126) then Terminal:=true
     else if ((Ord(c)>=58) and ((ord(c)<=63))) then Terminal:=true
       else Terminal:=false;

end;




Function esEspacio (c:tCar):tBool;

begin
  If (c=' ') or (Ord(c)=9) or (Ord(c)=11) then esEspacio:=true
  Else esEspacio:=false
end;




Function Especiales (cad:String):tBool;
begin
    if (cad='@ESP') or (cad='@TAB') or (cad='@FDL') or (cad='@FDF') or (cad='@ARR') or (cad='@BAR')then Especiales:=true
    else Especiales:=false;
end;




Procedure error1 (Var fs:tFichero; ct:tCont);

begin
  writeln (fs,'Error en lnea ',ct);
  writeln (fs,'La parte izquierda de la gramtica no es un NT vlido.');
  writeln ('Error en linea ',ct);
  writeln ('La parte izquierda de la gramatica no es un NT valido.');
end;




Procedure error2 (Var fs:tFichero; ct:tCont);

begin
  writeln (fs,'Error en lnea ',ct);
  writeln (fs,'Falta un espacio entre smbolos.');
  writeln ('Error en linea ',ct);
  writeln ('Falta un espacio entre simbolos.');
end;




Procedure error3 (Var fs:tFichero; ct:tCont);

begin
  writeln (fs,'Error en lnea ',ct);
  writeln (fs,'Smbolo no apropiado para un TERMINAL.');
  writeln ('Error en linea ',ct);
  writeln ('Simbolo no apropiado para un TERMINAL.');
end;




Procedure error4 (Var fs:tFichero; ct:tCont);

begin
  writeln (fs,'Error en lnea ',ct);
  writeln (fs,'Smbolo no apropiado para un NO TERMINAL.');
  writeln ('Error en linea ',ct);
  writeln ('Simbolo no apropiado para un NO TERMINAL.');
end;




Procedure error5 (Var fs:tFichero; ct:tCont);

begin
  writeln (fs,'Error en lnea ',ct);
  writeln (fs,'Smbolo invlido en la parte derecha.');
  writeln ('Error en linea ',ct);
  writeln ('Simbolo invalido en la parte derecha.');
end;




Procedure Espacio (Var f:tFichero; Var fs:tFichero; Var c:tCar; Var er:tBool; ct:tCont);

begin
  er:=false;
  If esEspacio (c) then
  begin
    While (not eoln (f)) and (esEspacio (c)) do
      read (f,c);
  end
  Else
  begin
    er:=true;
    error2 (fs,ct);
  end;
end;




Procedure NT (Var f:tFichero; Var fs:tFichero; Var lpi:tListaPI; Var p:tListaPI; Var lx:tListaAux; Var c:tCar; Var er:tBool; ct:tCont; Var e:tBool; op:tCont; Var ps:tCont);

Var
  cad:String;

begin
  inc (ps); // Contador de la posicion que ocupa el smbolo en la parte derecha
  er:=false;
  cad:='';
  If not noTerminal (c) and (c<>'@') then
  begin
    er:=true;
    error4 (fs,ct);
  end
  Else
  begin
    If c='@' then
    begin
       cad:=cad+c;
       read(f,c);
    end
    else
    begin
       er:=true;
       error4(fs,ct);
    end;
    While (not eoln (f)) and (noTerminal (c)) do
    begin
      cad:=cad+c;
      read (f,c);
    end;
    If eoln (f) then
    begin
      If (eoln (f)) and (noTerminal (c)) then cad:=cad+c
      Else
      begin
        If not esEspacio(c) then
        begin
          er:=true;
          error4 (fs,ct);
        end;
      end;
    end;
    If (not eoln (f)) and (not esEspacio (c)) and (Ord (c)<>13) then
    begin
      er:=true;
      error4 (fs,ct);
    end;
    If (cad='@') and (not er) then
    begin
      er:=true;
      error4 (fs,ct);
    end;
    If op=1 then
    begin
      If cad='@AXIOMA' then e:=true;
      If Especiales(cad) then
      begin
        er:=true;
        error1(fs,ct);
      end;
      insertarPI (lpi,p,cad);
    end
    Else insertarAux (lx,cad,0,ps);
  end;
end;




Procedure T (Var f:tFichero; Var fs:tFichero; Var lx:tListaAux; Var c:tCar; Var er:tBool; ct:tCont; Var ps:tCont);

Var
  cad:String;

begin
  inc (ps); // Contador de la posicion que ocupa el smbolo en la parte derecha
  er:=false;
  cad:='';
  If not Terminal (c) then
  begin
    er:=true;
    error3 (fs,ct);
  end
  Else
  begin
    While not eoln (f) and (Terminal (c)) do
    begin
      cad:=cad+c;
      read (f,c);
    end;
     If eoln (f) then
     begin
       If (eoln (f)) and (Terminal (c)) then cad:=cad+c
       else
       begin
        if not esEspacio(c) then
         begin
          er:=true;
          error3 (fs,ct);
         end;
       end;
     end;
    If (not eoln (f)) and (not esEspacio (c)) and (Ord (c)<>13) then
    begin
      er:=true;
      error3 (fs,ct);
    end;
  end;
  insertarAux (lx,cad,1,ps);
end;




Procedure PI (Var f:tFichero; Var fs:tFichero; Var lpi:tListaPI; Var p:tListaPI; Var c:tCar; Var er:tBool; ct:tCont; Var e:tBool; op:tCont);

Var
  ps:tCont;
  lx:tListaAux;

begin
  er:=false;
  If c='@' then NT (f,fs,lpi,p,lx,c,er,ct,e,op,ps)
  Else
  begin
    er:=true;
    error1 (fs,ct);
  end;
end;




Procedure PD (Var f:tFichero; Var fs:tFichero; Var lx:tListaAux; Var c:tCar; Var er:tBool; ct:tCont; Var e:tBool; op:tCont);

Var
  ps:tCont;
  lpi,p:tListaPI;

begin
  ps:=0;
  er:=false;
  If Terminal(c) then
  begin
    T (f,fs,lx,c,er,ct,ps);
    Repeat
      If esEspacio(c) and not er then
      begin
         Espacio (f,fs,c,er,ct);
         If Terminal(c) then T (f,fs,lx,c,er,ct,ps)
         Else If c='@' then  NT (f,fs,lpi,p,lx,c,er,ct,e,op,ps)
              Else
              begin
                If not eoln(f) then
                begin
                  er:=true;
                  error5(fs,ct);
                end;
              end;
      end;
      If (not eoln(f)) and (not esEspacio(c)) and not er then
      begin
         If (Ord (c)<>13) then
         begin
           er:=true;
           error2(fs,ct);
         end;
      end;
    Until eoln(f) or er or (Ord (c)=13);
  end
  Else If c='@' then
  begin
    NT (f,fs,lpi,p,lx,c,er,ct,e,op,ps);
    Repeat
      If esEspacio(c) and (not er) then
      begin
        Espacio (f,fs,c,er,ct);
        If Terminal(c) then T (f,fs,lx,c,er,ct,ps)
        Else If c='@' then  NT (f,fs,lpi,p,lx,c,er,ct,e,op,ps)
             Else
             begin
               If ord(c)<>13 then
               begin
                 If not esEspacio(c) then
                 begin
                   er:=true;
                   error5(fs,ct);
                 end;
               end;
             end;
      end;
      If (not eoln(f)) and (not esEspacio(c))and not er then
      begin
        If (Ord (c)<>13) then
        begin
          er:=true;
          error2(fs,ct);
        end;
      end;
    Until eoln(f) or er or (Ord (c)=13);
  end
  Else
  begin
    er:=true;
    error5(fs,ct);
  end;
end;




Procedure Regla (Var f:tFichero; Var fs:tFichero; Var lpi:tListaPI; Var c:tCar; Var er:tBool; ct:tCont;Var e:tBool);

Var
  p:tListaPI;
  lx:tListaAux;

begin
  crearListaAux (lx);
  er:=false;
  If esEspacio (c) then Espacio (f,fs,c,er,ct);
  PI (f,fs,lpi,p,c,er,ct,e,1);
  If (not eoln (f)) and (not er) then
  begin
    Espacio (f,fs,c,er,ct);
    If (not er) then
    begin
      PD (f,fs,lx,c,er,ct,e,2);
      If (not eoln (f)) and (not er)and (Ord (c)<>13) then Espacio (f,fs,c,er,ct);
    end
    Else If (not er) and ((eoln (f))) then
    begin
      er:=true;
      error4 (fs,ct);
    end;
  end
  Else If (not er) and ((eoln (f))) then
       begin
         er:=true;
         error5 (fs,ct);
       end;
  If not er then insertarPD (p^.pdch,lx);
end;




Procedure Linea (Var f:tFichero; Var fs:tFichero; Var lpi:tListaPI; Var er:tBool; ct:tCont; Var e:tBool; Var nvac:tBool);

Var
  c:tCar;

begin
  Repeat
    read (f,c);
  Until (Ord (c)<>13) and (Ord (c)<>10);
  If esEspacio (c) then Espacio (f,fs,c,er,ct);
  If (not eoln (f)) then
  begin
    Regla (f,fs,lpi,c,er,ct,e);
    nvac:=true;
  end;
end;




end.