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: 16459

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 594 korisnika na forumu :: 15 registrovanih, 4 sakrivenih i 575 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: 8u47, amaterSRB, cikadeda, Dannyboy, djo97, Doca, draggan, GreenMan, Imperator41, nebkv, Niske, nuke92, Snorks, zixmix, zodiac94