Koodit: QB: Säännölliset lausekkeet

' SÄÄNNÖLLISTEN LAUSEKKEIDEN KÄSITTELY
' Antti Laaksonen, 2009

TYPE TTila
   alku AS INTEGER         ' onko tila alkutila
   loppu AS INTEGER        ' onko tila lopputila
   eka AS INTEGER          ' ensimmäinen tilasta lähtevä kaari
   vika AS INTEGER         ' viimeinen tilasta lähtevä kaari
END TYPE

TYPE TKaari
   mista AS INTEGER        ' mistä tilasta kaari lähtee
   minne AS INTEGER        ' mihin tilaan kaari johtaa
   merkit AS STRING * 1    ' millä merkillä kaarta voi kulkea
   suora AS INTEGER        ' saako kaarta kulkea ilman merkkiä
   seuraava AS INTEGER     ' seuraava samasta tilasta lähtevä kaari
END TYPE

CONST TILAR = 1000         ' suurin sallittu tilojen määrä
CONST KAARIR = 1000        ' suurin sallittu kaarten määrä

' tilat ja kaaret sisältävät taulukot
DIM SHARED Tilat(TILAR) AS TTila
DIM SHARED Kaaret(KAARIR) AS TKaari
' tilojen ja kaarten määrä
DIM SHARED TMaara AS INTEGER
DIM SHARED KMaara AS INTEGER
' tilat, joissa automaatti voi olla
DIM SHARED Valitut(TILAR) AS INTEGER
' edellisten tilojen määrä
DIM SHARED VMaara AS INTEGER
' säännöllisten lausekkeiden merkistö
DIM SHARED MTaulu(256) AS INTEGER

TeeMerkit

CLS

lauseke$ = "(maanan|tiis|tors|perjan|lauan|sunnun)tai|keskiviikko"
INPUT "Kirjoita viikonpäivän nimi: ", paiva$
IF Tasmays(lauseke$, paiva$) THEN
   PRINT "Oikein meni!"
ELSE
   PRINT "Pieleen meni!"
END IF

lauseke$ = "A(BB)+C?"
INPUT "Kirjoita tekstiä: ", teksti$
PRINT "Seuraavissa kohdissa on ensin A, sitten"
PRINT "parillinen määrä B:tä ja lopuksi ehkä C:"
Haku lauseke$, teksti$

' aloittaa automaatin simuloinnin alusta
SUB Aloitus
   VMaara = 0
   FOR i% = 1 TO TMaara
      IF Tilat(i%).alku THEN
         VMaara = VMaara + 1
         Valitut(VMaara) = i%
      END IF
   NEXT
   Laajennus
END SUB

' etsii merkkijonosta säännöllistä lauseketta vastaavia osia
SUB Haku (lauseke$, mjono$)
   TeeLauseke lauseke$
   FOR i% = 1 TO LEN(mjono$)
      Aloitus
      j% = i%
      DO WHILE VMaara > 0 AND j% <= LEN(mjono$)
         UusiMerkki MID$(mjono$, j%, 1)
         IF OnkoLoppu THEN
            PRINT MID$(mjono$, i%, j% - i% + 1)
         END IF
         j% = j% + 1
      LOOP
   NEXT
END SUB

' laajentaa automaatin tilajoukkoa käyttämällä kaaria,
' joita voi kulkea ilman merkkiä
SUB Laajennus
   DIM Vanhat(TILAR) AS INTEGER
   FOR i% = 1 TO VMaara
      Vanhat(Valitut(i%)) = 1
   NEXT
   i% = 1
   DO UNTIL i% > VMaara
      kaari% = Tilat(Valitut(i%)).eka
      DO WHILE kaari% <> 0
         IF Kaaret(kaari%).suora THEN
            IF Vanhat(Kaaret(kaari%).minne) = 0 THEN
               VMaara = VMaara + 1
               Valitut(VMaara) = Kaaret(kaari%).minne
               Vanhat(Kaaret(kaari%).minne) = 1
            END IF
         END IF
         kaari% = Kaaret(kaari%).seuraava
      LOOP
      i% = i% + 1
   LOOP
END SUB

' vastaako merkki kaaren merkkiä?
FUNCTION MerkkiKelpaa% (merkit$, merkki$)
   IF merkit$ = "." THEN
      MerkkiKelpaa% = 1
   ELSEIF INSTR(merkit$, merkki$) THEN
      MerkkiKelpaa% = 1
   ELSE
      MerkkiKelpaa% = 0
   END IF
END FUNCTION

' muuttaa säännöllisen lausekkeen automaatiksi
' (tätä aliohjelmaa kutsutaan rekursiivisesti)
SUB MuutaLauseke (lauseke$)
   kohta% = 1
   UusiTila 0, 0
   UusiTila 0, 0
   lahto% = TMaara - 1
   maali% = TMaara
   viime% = lahto%
   DO UNTIL kohta% > LEN(lauseke$)
      merkki$ = MID$(lauseke$, kohta%, 1)
      ' sulkulausekkeet (rekursiivinen käsittely)
      IF merkki$ = "(" THEN
         sulut% = 1
         alku% = kohta%
         DO
            kohta% = kohta% + 1
            merkki$ = MID$(lauseke$, kohta%, 1)
            IF merkki$ = "(" THEN sulut% = sulut% + 1
            IF merkki$ = ")" THEN sulut% = sulut% - 1
            IF kohta% > LEN(lauseke$) THEN ERROR 2
         LOOP UNTIL sulut% = 0
         osa$ = MID$(lauseke$, alku% + 1, kohta% - alku% - 1)
         MuutaLauseke osa$
      ' tavalliset merkit
      ELSE
         merkki$ = MID$(lauseke$, kohta%, 1)
         IF merkki$ = "\" THEN kohta% = kohta% + 1
         merkki$ = MID$(lauseke$, kohta%, 1)
         IF merkki$ = "." OR MTaulu(ASC(merkki$)) THEN
            UusiTila 0, 0
            UusiTila 0, 0
            UusiKaari TMaara - 1, TMaara, merkki$
         ELSE
            ERROR 2
         END IF
      END IF
      kohta% = kohta% + 1
      merkki$ = MID$(lauseke$, kohta%, 1)
      ' toistomerkinnät
      IF merkki$ = "*" OR merkki$ = "+" OR merkki$ = "?" THEN
         UusiTila 0, 0
         UusiTila 0, 0
         UusiKaari TMaara - 1, TMaara - 3, ""
         UusiKaari TMaara - 2, TMaara, ""
         IF merkki$ = "*" OR merkki$ = "?" THEN
            UusiKaari TMaara - 1, TMaara, ""
         END IF
         IF merkki$ = "*" OR merkki$ = "+" THEN
            UusiKaari TMaara, TMaara - 3, ""
         END IF
         kohta% = kohta% + 1
      END IF
      UusiKaari viime%, TMaara - 1, ""
      viime% = TMaara
      merkki$ = MID$(lauseke$, kohta%, 1)
      ' vaihtoehdot
      IF merkki$ = "|" OR kohta% > LEN(lauseke$) THEN
         UusiKaari TMaara, maali%, ""
         viime% = lahto%
         kohta% = kohta% + 1
      END IF
   LOOP
   UusiTila 0, 0
   UusiTila 0, 0
   UusiKaari TMaara - 1, lahto%, ""
   UusiKaari maali%, TMaara, ""
END SUB

' onko automaatti lopputilassa?
FUNCTION OnkoLoppu%
   FOR i% = 1 TO VMaara
      IF Tilat(Valitut(i%)).loppu THEN
         OnkoLoppu% = 1
         EXIT FUNCTION
      END IF
   NEXT
   OnkoLoppu% = 0
END FUNCTION

' täsmääkö merkkijono säännölliseen lausekkeeseen?
FUNCTION Tasmays% (lauseke$, mjono$)
   TeeLauseke lauseke$
   Aloitus
   FOR i% = 1 TO LEN(mjono$)
      UusiMerkki MID$(mjono$, i%, 1)
   NEXT
   Tasmays% = OnkoLoppu
END FUNCTION

' muuttaa säännöllisen lausekkeen automaatiksi
' (tätä aliohjelmaa kutsutaan muualta koodista)
SUB TeeLauseke (lauseke$)
   TMaara = 0
   KMaara = 0
   MuutaLauseke lauseke$
   UusiTila 1, 0
   UusiTila 0, 1
   UusiKaari TMaara - 1, TMaara - 3, ""
   UusiKaari TMaara - 2, TMaara, ""
END SUB

' listaa säännöllisen lausekkeen sallitut merkit
SUB TeeMerkit
   FOR i% = ASC("0") TO ASC("9")
      MTaulu(i%) = 1
   NEXT
   FOR i% = ASC("A") TO ASC("Z")
      MTaulu(i%) = 1
   NEXT
   FOR i% = ASC("a") TO ASC("z")
      MTaulu(i%) = 1
   NEXT
END SUB

' lisää automaattiin kaaren
SUB UusiKaari (mista%, minne%, merkit$)
   KMaara = KMaara + 1
   Kaaret(KMaara).mista = mista%
   Kaaret(KMaara).minne = minne%
   IF merkit$ = "" THEN
      Kaaret(KMaara).suora = 1
   ELSE
      Kaaret(KMaara).suora = 0
      Kaaret(KMaara).merkit = merkit$
   END IF
   Kaaret(KMaara).seuraava = 0
   IF Tilat(mista%).vika = 0 THEN
      Tilat(mista%).eka = KMaara
      Tilat(mista%).vika = KMaara
   ELSE
      Kaaret(Tilat(mista%).vika).seuraava = KMaara
      Tilat(mista%).vika = KMaara
   END IF
END SUB

' liikkuu automaatissa merkkiä vastaavasti
SUB UusiMerkki (merkki$)
   DIM Vanhat(TILAR) AS INTEGER
   DIM UMaara AS INTEGER
   FOR i% = 1 TO VMaara
      kaari% = Tilat(Valitut(i%)).eka
      DO WHILE kaari% <> 0
         IF MerkkiKelpaa(Kaaret(kaari%).merkit$, merkki$) THEN
            IF Vanhat(Kaaret(kaari%).minne) = 0 THEN
               UMaara = UMaara + 1
               Valitut(UMaara) = Kaaret(kaari%).minne
               Vanhat(Kaaret(kaari%).minne) = 1
            END IF
         END IF
         kaari% = Kaaret(kaari%).seuraava
      LOOP
   NEXT
   VMaara = UMaara
   Laajennus
END SUB

' lisää automaattiin tilan
SUB UusiTila (alku%, loppu%)
   TMaara = TMaara + 1
   Tilat(TMaara).alku = alku%
   Tilat(TMaara).loppu = loppu%
   Tilat(TMaara).eka = 0
   Tilat(TMaara).vika = 0
END SUB