Formalni jezici i prevodioci

Formalni jezici i prevodioci

offline
  • brexx 
  • Novi MyCity građanin
  • Pridružio: 01 Jul 2012
  • Poruke: 2

Evo volio bi kolegama podjelit jedan zadatak koji sam zavrsio pa ako nekog zanima da si ima Razz
PROGRAM Realni_Izrazi;   (*    Leksiźka analiza, sintaksna analiza    (rekurzivni spust - recursive descent - Wirth),    prevoĐenje i izraźunavanje realnih izraza napisanih prema sintaksi:    izraz    : term { ş + | - ş term }    term     : faktor { ş * | / ş faktor }    faktor   : [+ | -] broj | ^faktor | funkcija | ( izraz )    funkcija : ime ( izraz )    ime      : ABS | SIN | COS | EXP | LN | FRAC | INT | SQR | SQRT | ROUND    broj     : brojka { brojka } [ . brojka { brojka} ]    brojka   : 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9    *) USES Crt,StrUtils; CONST   Brojke   = ['0'..'9']; Slova = ['A'..'Z'];   Simboli  = ['+','-','*','/','^','(',')'];   Alfabet  = Brojke +Slova +Simboli;   Funkcije : string = 'ABS  SIN  COS  EXP  LN   FRAC INT  SQR  SQRT ROUND';   L        = 20; VAR   Niz : STRING;                  { Ulazni niz             }   R   : ARRAY [1..10] OF real;   { Rezultat izraźunavanja }   Dr,uVar  : integer;                 { Duljina polja R        }   Z   : char;                    { Tekuci znak niza       }   S   : char;   Sim : STRING [L];              { Teku†i simbol          }   i,x   : integer;                 { Pozicija teku†eg znaka }   Gr  : boolean;                 { varijabla koja oznacava je li u gresci ili nije }   p   : integer;   BrF : byte;   Izl : STRING;   aPV : array of string;         // polje-vrijednost pohranjivanje varijabli PROCEDURE Znak;{ ide kroz niz dok ne naide na znak } BEGIN   REPEAT     Z := upcase (Niz[i]);     i := i+1;   UNTIL (Z <> ' ') END; function UpperCase1(Str : String):string; var y: integer; begin   for y := 1 to Length(Str) do     Str[y] := upcase (Str[y]);   UpperCase1 := str;   end; function Trim1(Str: string):string; var j,p,k : integer; begin   p := 0;k:= 0;   for j := 1 to Length(Str) do     if Str[j]<>' ' then     begin       if p=0 then p := J;       k := j;     end;   Trim1 := Copy(Str,p,k-p+1); end; PROCEDURE Ucitaj;{ ucitava niz prekida na @ } BEGIN   ReadLN (Niz);   Niz := Niz + '#';   Niz := UpperCase1(Niz);   IF Niz [1] = '@' THEN   BEGIN     WriteLN ('STOP');     HALT;   END;   Dr := 0;   Gr := False;   i := 1;   Znak; END; PROCEDURE Greska (Poruka: STRING);{ ispisuje gresku } BEGIN   Writeln (chr(24):i-1, Poruka);   Gr := True; END; FUNCTION dulji_sim : Boolean;{postavlja boolean varijable Gr,dulji_sim} BEGIN   Gr := (length (Sim) = L);   dulji_sim := Gr; END; PROCEDURE Broj;{dodaje znak u sim} BEGIN   WHILE (Z IN Brojke) DO   BEGIN     IF Dulji_sim THEN EXIT;     Sim := Sim + Z;     Znak;   END END; function IsVar : Boolean; var J,k,l : integer;TempS : string; begin   IsVar := False;   for j := 0 to Length(aPV)-1 do     if (j mod 2 = 0) then       if (Sim=aPV[j]) then       begin         Sim := aPV[j+1];         for k := (i-1) downto 1 do           if Trim1(Copy(Niz,k,i-k))=Trim1(aPV[j]) then           begin             l := k;             break;           end;         if l>1 then TempS := Copy(Niz,1,l-1)+Sim         else TempS := Sim;         if (Length(Niz)>=i) then TempS := TempS + Copy(Niz,i,Length(Niz)+1-i);         Niz := TempS;         i := (l+Length(aPV[j+1]));         IsVar := True;         break;       end; end; function UcitajBrojUSim:Boolean; begin   UcitajBrojUSim := True;   Broj;   IF Gr THEN   begin     UcitajBrojUSim := not(Gr);     EXIT;//ako je length 20 izlaz   end;   IF (Z = '.') THEN   BEGIN     Sim := Sim + Z;     Znak;     IF (Z IN Brojke) THEN Broj  //slijedeci znak u sim broja     ELSE     BEGIN       Gr := True;       UcitajBrojUSim := not(Gr);       Greska ('* Leks. pogreska!');       EXIT;     END;   END;   S := 'B'; end; procedure Str2Sim; begin   Sim := '';   if Z in Slova then Sim := Sim+Z;   Z := Niz[i];   while Z in Slova do   begin     IF Dulji_sim THEN EXIT;     Sim := Sim + Z;     i := i + 1;    Z := Niz[i];   end; end; function In2PV: Boolean; var j,l : integer; begin   In2PV := False;   if not(Z in slova) then exit;   Str2Sim;//ucitava rijec   IF (length(Sim) < 5) THEN FOR j := length(Sim)+1 TO 5 DO Sim := Sim + ' ';   if (Pos(sim,Funkcije)>0) then exit;   Znak;   if (Z<>'=') then exit;   Znak;   if not (Z IN Brojke) Then exit;   j := -1;   for l := 0 to Length(aPV)-1 do if (aPV[l]=Sim) then j := l;   if j<0 then   begin     SetLength(aPV,Length(aPV)+1);     aPV[ Length(aPV)-1 ] := sim;   end;   sim := '';   if not UcitajBrojUSim then   begin   if j<0 then setLength(aPv,Length(aPv)-1);   exit;   end;   In2PV := True;   if j<0 then   begin   SetLength(aPv,Length(aPv)+1);   aPV[Length(aPv)-1] := Sim;   end   else aPV[j+1] := Sim;   S:='V'; end; procedure Var2Num; var J,it:integer;ZT:Char; begin   uVar := 0;   if gr then exit;   i := 1;   Znak;   while i<=Length(Niz) do   begin     if (Z in slova) then     begin       Str2Sim;       IF (length(Sim) < 5) THEN FOR j := length(Sim)+1 TO 5 DO Sim := Sim + ' ';       if (Pos(sim,Funkcije)=0) then       begin         if not IsVar then         begin           Greska ('* Nedef. ime '+ 'funkcije!');           exit;         end;{pokusaj zamjene varijable sa vrjednosti}         if dulji_sim then exit;         if (uVar>10) then         begin           Greska('Dozvoljavamo izraz sa max 10 varijabli.Ne dozvoljavamo cirkularno dodjeljene varijable');           SetLength(aPV,0);           Niz := '#';           exit;         end;       end;     end     else Znak;   end;   i := 1;   Znak; end; PROCEDURE Leks_an; VAR j : byte; BEGIN   Sim := '';   S := ' ';   IF (Z in ['#', '@']) THEN EXIT;   IF not (Z in Alfabet) THEN   BEGIN     Greska ('* ilegalan znak');     EXIT;   END;   IF (Z in Simboli) THEN   BEGIN     //if (BrF>0) then exit;     S := Z;     if not((brF>0) and (Z=')')) then Znak;   END   ELSE IF (Z in Brojke) THEN   BEGIN     if not UcitajBrojUSim then exit;   END   ELSE   BEGIN     Str2Sim;     IF (length(Sim) < 5) THEN       FOR j := length(Sim)+1 TO 5 DO Sim := Sim + ' ';     BrF := pos (Sim, Funkcije);     IF BrF = 0 THEN       Greska ('* Nedef. ime '+ 'funkcije!')     ELSE     BEGIN       S := 'F';       BrF := (BrF div 5) + 1     END;   END; END;   PROCEDURE Izraz;   VAR M, Q : char; F    : byte;     PROCEDURE Izr_fun;     BEGIN       CASE F OF         1: R [Dr] := abs  (R[Dr]);         2: R [Dr] := sin  (R[Dr]);         3: R [Dr] := cos  (R[Dr]);         4: R [Dr] := exp  (R[Dr]);         5: IF R[Dr] <= 0 THEN             Greska ('*** LN nije def. '+ 'za arg. <= 0')            ELSE R [Dr] := ln (R[Dr]);         6: R [Dr] := frac (R[Dr]);         7: R [Dr] := int  (R[Dr]);         8: R [Dr] := sqr  (R[Dr]);         9: IF R[Dr] < 0 THEN              Greska ('*** SQRT nije def. '+ 'za arg. < 0')            ELSE              R [Dr] := sqrt (R[Dr]);         10: R [Dr] := round(R[Dr]);       END;       BrF := 0;       F := 0;       Leks_an;     END;//PROCEDURE Izr_fun;     PROCEDURE Term;       PROCEDURE Faktor;         VAR B : real; C, i : integer; Pr : char;       BEGIN         IF S = 'B'  THEN         BEGIN           Val (Sim, B, C);           Inc (Dr);           R [Dr] := B;           Leks_an;         END         ELSE IF (S = '(') THEN         BEGIN           Leks_an;           Izraz;           IF (S <> ')') THEN           BEGIN             Greska('* Sint.'+ 'pogreska');             EXIT;           END           ELSE Leks_an;         END         ELSE IF (S = 'F') THEN         BEGIN           F := BrF;           Leks_an;           IF (S = '(') THEN           BEGIN             Leks_an;             Izraz;             IF (S = ')') THEN             BEGIN               Izr_fun;               IF Gr THEN EXIT;               Leks_an;             END             ELSE             BEGIN               Greska ('* Sint.'+ 'pogreska');               EXIT;             END           END           ELSE           BEGIN             Greska ('* nep. '+ 'izraz');             EXIT;           END;         END         ELSE IF (S IN ['+','-']) THEN         BEGIN           Pr := S;           Leks_an;           Faktor;           IF (Pr='-') THEN R[Dr]:= -R[Dr];         END         ELSE         BEGIN           Greska ('* nep.'+ 'izraz');           EXIT         END;         WHILE (S = '^') DO         BEGIN           Leks_an;           Faktor;           IF (R [Dr-1] <= 0) and (frac (R[Dr]) <> 0) THEN           BEGIN             Greska ('* St.neg.'+ 'broja');             EXIT;           END;           IF (R[Dr -1] > 0) THEN R[Dr-1] := exp(R[Dr]*ln(R[Dr-1]))         ELSE         BEGIN           B := 1;           C := round (R[Dr]);           FOR i := 1 TO abs(C) DO B := B*R[Dr-1];           IF C < 0 THEN B := 1/B;           R[Dr-1] := B;         END;         Dec (Dr);       END;     END;     BEGIN (* Term *)       Faktor;       WHILE S IN ['*','/'] DO      BEGIN         M := S;       Leks_an;       Faktor;         CASE  M  OF          '*': R[Dr-1]:=R[Dr-1]*R[Dr];          '/': IF R[Dr] = 0 THEN             BEGIN                 Greska ('* Dijeljenje'+ ' s nulom');                 EXIT;               END               ELSE R[Dr-1] := R[Dr-1] / R[Dr];           END;           Dec (Dr);         END     END;   BEGIN { Izraz }     Term;     WHILE S IN ['+', '-'] DO BEGIN       Q := S; Leks_an; Term;       CASE  Q  OF         '+': R[Dr-1] := R[Dr-1] +R[Dr];         '-': R[Dr-1] := R[Dr-1] -R[Dr];       END;       Dec (Dr);       END     END; PROCEDURE Ispis_rezultata; var TempS : string;j: integer; BEGIN   Str (R[1] :32 :12, Izl);   WHILE Izl[1] = ' ' DO Delete (Izl, 1, 1);   i := pos ('.', Izl);   p := length (Izl);   WHILE (p > i) and (Izl[p] = '0') DO   BEGIN     Delete (Izl, p, 1);     Dec (p);   END;   IF length(Izl) = i THEN Delete (Izl, i, 1);   if (S='V') then   begin     TempS := '';     for j := 0 to Length(aPV)-1 do     begin       TempS := Temps + Trim1(aPV[j]);       if (j mod 2=0) then TempS := Temps + '='       else TempS := Temps + ';';     end;     Writeln('Var.: '+TempS);     Writeln('Upisi izraz, prekid sa "@"');   end   else Write (' = ', Izl);   END; BEGIN   ClrScr;   Writeln ('Upisi izraz, prekid sa "@"');   REPEAT     for x := 1 to 10 do R[x] := 0;     Writeln;     Ucitaj;    if not In2PV then     begin       Var2Num;      Leks_an;      Izraz;    end;     IF not Gr THEN Ispis_rezultata;     UNTIL Z = '@' END.



Registruj se da bi učestvovao u diskusiji. Registrovanim korisnicima se NE prikazuju reklame unutar poruka.
offline
  • Fil  Male
  • Legendarni građanin
  • Pridružio: 11 Jun 2009
  • Poruke: 16586

Lepo je sto zelis da podelis Ziveli
Preporucujem ti da nam kazes o cemu se radi. Opis zadatka i sl. da korisnici znaju odmah o cemu se radi bez analize koda.



Ko je trenutno na forumu
 

Ukupno su 1326 korisnika na forumu :: 37 registrovanih, 11 sakrivenih i 1278 gosta   ::   [ Administrator ] [ Supermoderator ] [ Moderator ] :: Detaljnije

Najviše korisnika na forumu ikad bilo je 3466 - dana 01 Jun 2021 17:07

Korisnici koji su trenutno na forumu:
Korisnici trenutno na forumu: ajo baba, Areal84, Asparagus, bladesu, BORUTUS, debeli, Dimitrise93, Dorcolac, DPera, draganl, dushan, Georgius, hyla, ikan, jackreacher011011, Karla, kihot, kovinacc, kuntalo, ljuba, mgolub, Mi lao shu, MikeHammer, milenko crazy north, Milometer, MilosKop, Mixelotti, nemkea71, nextyamb, procesor, royst33, shone34, srbijaiznadsvega, vasa.93, vathra, W123, zlaya011