{Petr Hruska} {$B+} {$R+} Program Grep; Const MaxRE = 50; SOUBOR_VYRAZ = 'vyraz.txt'; SOUBOR_VSTUP = 'vstup.txt'; SOUBOR_VYSTUP = 'vystup.txt'; Type TSeznam = Array[1 .. MaxRE+1] Of Integer; TPrechody = Array[1 .. MaxRE+1] Of TSeznam; TZnacky = Array[1 .. MaxRE+1] Of Boolean; { tecky nebo krizky } Var P : TPrechody; posl_sez : Integer; { cislo posledniho neprazneho seznamu v poli P } vstup, vystup : Text; vyraz, radek : String; { Zjisti, zda pozice je na konci retezce, nebo pred otaznikem, nebo pred obycejnym znakem. Pozice je cislo od 1 do delky re vcetne znaku '$'. } Function DobraTecka(Var re : String; pozice : Integer) : Boolean; Begin DobraTecka := (re[pozice] In ['0' .. '9', 'A' .. 'Z', 'a' .. 'z', '?', '$']); End; Procedure VymazZnacky(Var z : TZnacky); Var i : Integer; Begin For i := 1 To MaxRE + 1 Do z[i] := False; End; Procedure KopirujZnacky(Var zdroj, cil : TZnacky; posledni : Integer); Var i : Integer; Begin For i := 1 To posledni Do cil[i] := zdroj[i]; End; Procedure ZnackyNaSeznam(Var z : TZnacky; Var s : TSeznam); Var i, j : Integer; Begin j := 1; For i := 1 To MaxRE + 1 Do If z[i] Then Begin s[j] := i; j := j + 1; End; s[j] := -1; { zarazka } End; Procedure SeznamNaZnacky(Var s : TSeznam; Var z : TZnacky); Var i : Integer; Begin VymazZnacky(z); i := 1; While s[i] <> -1 Do Begin z[s[i]] := True; i := i + 1; End; End; { Najde spatnou tecku, pokud existuje a vrati jeji pozici. Pokud jsou vsechny tecky dobre, tak vraci -1 } Function SpatnaTecka(Var re : String; Var tecky : TZnacky) : Integer; Var i : Integer; Begin i := 1; While (i <= Length(re)) And (Not tecky[i] Or DobraTecka(re, i)) Do i := i + 1; If i <= Length(re) Then SpatnaTecka := i Else SpatnaTecka := -1; End; { Vraci pozici odpovidajici leve zavorky na zaklade pozice prave zavorky. Predpoklada spravne uzavorkovani. } Function PravaKulataZavorka(Var re : String; leva : Integer) : Integer; Var c, i : Integer; Begin i := leva + 1; c := 1; While c <> 0 Do Begin If re[i] = '(' Then Inc(c) Else If re[i] = ')' Then Dec(c); i := i + 1; End; PravaKulataZavorka := i - 1; End; { Vraci pozici odpovidajici prave zavorky na zaklade pozice leve zavorky. Predpoklada spravne uzavorkovani. } Function LevaKulataZavorka(Var re : String; prava : Integer) : Integer; Var c, i : Integer; Begin i := prava - 1; c := 1; While c <> 0 Do Begin If re[i] = ')' Then Inc(c) Else If re[i] = '(' Then Dec(c); i := i - 1; End; LevaKulataZavorka := i + 1; End; { Najde nejblizsi pravou slozenou zavorku, ktera ma protejsek na pozici pocatek, nebo mensi. } Function PravaSlozenaZavorka(Var re : String; pocatek : Integer) : Integer; Var c, i : Integer; Begin i := pocatek + 1; c := 1; While c <> 0 Do Begin If re[i] = '{' Then Inc(c) Else If re[i] = '}' Then Dec(c); i := i + 1; End; PravaSlozenaZavorka := i - 1; End; Procedure RozmistiVarianty(Var re : String; leva : Integer; var tecky, krizky : TZnacky); Var c, i : Integer; Begin i := leva + 1; If Not krizky[i] Then tecky[i] := True; c := 1; While c > 0 Do Begin If (re[i-1] = '|') And (c = 1) Then If Not krizky[i] Then tecky[i] := True; If re[i] = '{' Then Inc(c) Else If re[i] = '}' Then dec(c); i := i + 1; End; End; Procedure NastavSeznam(Var seznam : TSeznam; pozice : Integer; Var re : String); Var tecky, krizky : TZnacky; t, z : Integer; Begin VymazZnacky(tecky); VymazZnacky(krizky); If pozice <> Length(re) Then If DobraTecka(re, pozice) Then tecky[pozice + 1] := True Else tecky[pozice] := True; t := SpatnaTecka(re, tecky); While t >= 0 Do Begin tecky[t] := False; krizky[t] := True; Case re[t] Of '(' : Begin z := PravaKulataZavorka(re, t); If Not krizky[z+2] Then tecky[z+2] := True; If Not krizky[t+1] Then tecky[t+1] := True; End; ')' : Begin z := LevaKulataZavorka(re, t); If Not krizky[z+1] Then tecky[z+1] := True; If Not krizky[t+2] Then tecky[t+2] := True; End; '{' : RozmistiVarianty(re, t, tecky, krizky); '|' : Begin z := PravaSlozenaZavorka(re, t); If Not krizky[z+1] Then tecky[z+1] := True; End; '}' : If Not krizky[t+1] Then tecky[t+1] := True; End; t := SpatnaTecka(re, tecky); End; ZnackyNaSeznam(tecky, seznam); End; { Nastavi globalni pole prechodu P } Procedure NastavPrechody(re : String); Var i : Integer; Begin posl_sez := Length(re); For i := 1 To posl_sez Do NastavSeznam(P[i], i, re); End; { Vraci True, odpovida-li retezec regularnimu vyrazu. Pouziva globalni pole P a posl_sez. } Function Match(s : String; var re : String) : Boolean; Var t1, t2 : TZnacky; i, j, k : Integer; Begin VymazZnacky(t1); If DobraTecka(re, 1) Then t1[1] := True Else { na pocatku byla spatna pozice, preskocime ji} SeznamNaZnacky(P[1], t1); { i bezi pres vsechny pismena v retezci } For i := 1 To Length(s) Do Begin { j bezi pres "vsechny tecky" } VymazZnacky(t2); For j := 1 To posl_sez Do If t1[j] And ((re[j] = '?') Or (re[j] = s[i])) Then Begin { k je ridici promenna pro pruchod seznamu } k := 1; While P[j][k] <> -1 Do Begin t2[P[j][k]] := True; k := k + 1; End; End; KopirujZnacky(t2, t1, posl_sez); End; Match := t1[posl_sez]; End; Procedure NactiVyraz(Var re : String); Var f : Text; Begin Assign(f, SOUBOR_VYRAZ); Reset(f); Readln(f, re); Close(f); End; Procedure OtevriSoubory(Var vstup, vystup : Text); Begin Assign(vstup, SOUBOR_VSTUP); Reset(vstup); Assign(vystup, SOUBOR_VYSTUP); Rewrite(vystup); End; Procedure ZavriSoubory(Var vstup, vystup : Text); Begin Close(vstup); Close(vystup); End; Begin NactiVyraz(vyraz); vyraz := vyraz + '$'; NastavPrechody(vyraz); OtevriSoubory(vstup, vystup); While Not Eof(vstup) Do Begin Readln(vstup, radek); If Match(radek, vyraz) Then Writeln(vystup, radek); End; ZavriSoubory(vstup, vystup); End.