Automaten für reguläre Ausdrücke erstellen
Zum Code
Ein DFA ist ein deterministischer finiter Automat, manchmal auch deterministischer endlicher Automat genannt. Um zu erfahren, was ein Automat oder ein regulärer Ausdruck ist, empfehle ich, mal im Internet zu suchen oder bei genügend Interesse gleich die passenden Bücher zu kaufen (Reguläre Ausdrücke von O'Reilly und Compilerbau Teil 1 im Oldenbourgverlag, das "Drachenbuch").

Dieses Projekt erzeugt Zustände für einen DFA in VB. Der DFA-Code liegt dem Projekt bei, es ist die Funktion Test_DFA im Modul DFAs. Um einen eigenen DFA zu erstellen, muss man die Funktion nur kopieren und ggf. anpassen, u.a. den Pfad der Übergangstabelle.

Diese DFAs hier können im Prinzip nur sagen, ob ein übergebener String ab einer angegebenen Position einem regulären Ausdruck entspricht, also akzeptiert wird. Die Automaten geben die letzte Stelle des längsten gefundenen Musters zurück. Ein Beispiel für den Einsatz eines DFAs ist der Scanner, welcher praktischerweise mit dem Programm selber erstellt wurde.

Das Projekt besteht aus drei Teilen, dem Scanner, dem LR(1)-Parser und dem Konstruktor. Der Scanner wandelt den Eingabestring, welcher einen korrekten regulären Ausdruck beinhaltet, in einen Symbolstrom um. Der Parser konstruiert einen Syntaxbaum und der Konstruktor bildet die verschiedenen Mengen und schließlich die Zustände.

Ein Erfassen von Teilmengen mit Klammern ist auf Grund der Natur der DFAs nicht möglich (siehe "Reguläre Ausdrücke", O'Reilly). Dafür benötigt man einen NFA (Nichtdeterministischen finiten Automaten) oder einen hybriden Automaten. Wer Spaß dran hat - die Menge Followpos ist nichts anderes als ein NFA.

Der Vorteil eines DFAs ist die Geschwindigkeit. DFAs sind textorientiert, ihre Laufzeit entspricht O(n) wenn die Eingabe n Zeichen hat. Die Laufzeit von NFAs entspricht O(r*n) wenn r die Länge des regulären Ausdrucks ist. Der Nachteil eines DFAs ist der Platzbedarf im Vergleich zu einem NFA. Dieser beträgt beim DFA O(2^r) während er beim NFA nur O(r) beträgt (siehe hierzu das "Drachenbuch" s.o.).

Der vorliegende Code hat einige Einschränkungen bei den regulären Ausdrücken. Er unterstützt nicht alle Konstrukte, die man aus Sprachen wie Perl oder PHP kennt.

Ihm sind einfache Zeichenklassen \w, \d, \s, \W, \D, \S, "." und [] bekannt. Unterstütze Metazeichen sind \n für vbLf, \r für vbCr und \t für vbTab. Beliebige ASCII-Zeichen können durch \xFF angegeben werden, wobei die beiden Fs durch den hexadezimalen ASCII-Code des Zeichens zu ersetzen sind. Die Metazeichen sowie die Zeichenklassen bis auf den Punkt werden auch innerhalb von Zeichenklassen [] selber unterstützt. Ein Bindestrich kann hier einen Bereich angeben, dies funktioniert aber nur zwischen Buchstaben, Zahlen und dem Metazeichen \xFF. Z.B. repräsentiert [a-f] eine Zeichenklasse mit allen Kleinbuchstaben von a bis f. Hier werden alle ASCII-Zeichen zwischen dem ersten Zeichen und dem zweiten Zeichen eingefügt! Der Backslash dient als Escapezeichen, muss daher auch selbst escaped werden. Durch ein Dach ^ als erstes Zeichen wird die Zeichenklasse invertiert.

Die Metaoperationen *, + und ? sind verfügbar, alle jedoch gierig. Da DFAs erstellt werden, welche textgesteuert sind, sind nicht-gierige Ausdrücke nicht ohne weiteres möglich. Dies den DFAs beizubringen ist meist unsauber - ein NFA könnte das von Haus aus.

Der Backslash kann die besondere Bedeutung beliebiger Zeichen innerhalb und ausserhalb von Zeichenklassen aufheben. Ausdrücke können beliebig durch Klammern verschachtelt werden. Die Alternation mit "|" wird unterstützt.

Bei fehlerhaften regulären Ausdrücken als Eingabe kann es vorkommen, dass kein Fehler gemeldet wird oder der Automat sich seltsam verhält. Sollten Fehler entdeckt werden, bitte ich darum, mir eine Email zu schicken.

History
05.10.2003 Hinzugefügt

Autor: Dominik Auras <Dominik_auf_vbInside.de> 

Code aus Scanner.bas
Option Explicit
Public Enum Sym_ID
  BR_Open = 1
  BR_Close = 2
  MetaOp = 3
  Meta_Or = 4
  Meta = 5
  Char = 6
  Ende = 7
  Cat = 8
End Enum
Public Enum Sym_Attr_ID
  pos = 1
  nullable = 2
  Klasse = 3
End Enum
Public Type Sym_Attr
  id As Sym_Attr_ID
  val As Long
End Type
Public Type Symbol
  id As Sym_ID
  lexeme As String
  Child() As Long
  attr() As Sym_Attr
  First() As Long
  Last() As Long
End Type
Private Output() As Symbol, cp_out As Long
Public Sub Scan(inp As String, Stream() As Symbol)
  Dim x As Long, n As Long, out As Symbol, t As Long
  Dim temp As String, i As Long, temp2 As String
  Dim meta_x As Boolean
    
    cp_out = 0
    ReDim Output(100)
    
    ReDim classes(1 To 7)
    init_classes classes
    
    x = 1
    Do While x <= Len(inp)
      ClearSym out: n = 0
      Select Case Mid$(inp, x, 1)
        Case "*", "+", "?": SetSym out, MetaOp, Mid$(inp, x, 1): n = x
        Case "|": SetSym out, Meta_Or, "|": n = x
        Case "(": SetSym out, BR_Open, "(": n = x
        Case ")": SetSym out, BR_Close, ")": n = x
        Case Else
          n = DFA_Meta(inp, x)
          If n > 0 Then
            SetSym out, Meta, Mid$(inp, x, n - x + 1)
          Else
            SetSym out, Char, Mid$(inp, x, 1): n = x
          End If
      End Select
      x = n + 1
      
      If out.id = Meta Then
        Select Case out.lexeme
          Case "\w": SetAttr out, Klasse, 1: AddSymbolToStream out
          Case "\d": SetAttr out, Klasse, 2: AddSymbolToStream out
          Case ".":  SetAttr out, Klasse, 3: AddSymbolToStream out
          Case "\W": SetAttr out, Klasse, 4: AddSymbolToStream out
          Case "\D": SetAttr out, Klasse, 5: AddSymbolToStream out
          Case "\s": SetAttr out, Klasse, 6: AddSymbolToStream out
          Case "\S": SetAttr out, Klasse, 7: AddSymbolToStream out
          Case Else
            If Left$(out.lexeme, 1) = "[" Then
              temp = Scan_Class(Mid$(out.lexeme, 2, _
                  Len(out.lexeme) - 2))
              
              If Len(temp) = 0 Then
                warn "Leere Zeichenklasse"
              Else
                If Left$(temp, 1) = "^" Then
                  temp2 = temp
                  temp = ""
                  For i = 0 To 255
                    If InStr(temp2, Chr$(i)) = 0 Then
                      temp = temp & Chr$(i)
                    End If
                  Next i
                End If
                
                ReDim Preserve classes(1 To UBound(classes) + 1)
                n = UBound(classes)
                For i = 1 To Len(temp)
                  AddElement classes(n), Asc(Mid$(temp, i, 1))
                Next i
                
                SetAttr out, Klasse, n
                AddSymbolToStream out
              End If
            ElseIf Left$(out.lexeme, 1) = "\" Then
              meta_x = False
              Select Case Mid$(out.lexeme, 2, 1)
                Case "x"
                  t = val("&H" & Mid$(out.lexeme, 3) & "&")
                  If t <= 255 And t >= 0 Then
                    SetSym out, Char, Chr$(t)
                    AddSymbolToStream out
                  Else
                    warn "ASCII-Code > 255 oder < 0"
                  End If
                  meta_x = True
                Case "n": SetSym out, Char, vbLf
                Case "r": SetSym out, Char, vbCr
                Case "t": SetSym out, Char, vbTab
                Case Else: SetSym out, Char, Mid$(out.lexeme, 2, 1)
              End Select
              
              If Not meta_x Then
                AddSymbolToStream out
                If Len(Mid$(out.lexeme, 2)) > 1 Then
                  For i = 1 To Len(Mid$(out.lexeme, 3))
                    SetSym out, Char, Mid$(out.lexeme, 2 + i, 1)
                    AddSymbolToStream out
                  Next i
                End If
              End If
            End If
        End Select
      Else
        AddSymbolToStream out
      End If
    Loop
    
    If cp_out > 0 Then
      ReDim Preserve Output(cp_out - 1)
    Else
      ReDim Output(0)
    End If
    Stream = Output
End Sub
Private Function Scan_Class(term As String) As String
  Dim x As Long, n As Long, out As String, e As Long, g As Long
  Dim zw As String, f1 As String, f2 As String, temp As String
    
    x = 1
    
    '\\.|\\x[\da-fA-F]+|([\w\d]|\\x[\da-fA-F]+)-([\w\d]|\\x[\da-fA-F]+)
    
    Do While x <= Len(term)
      n = DFA_Class(term, x)
      
      If n = 0 Then
        out = out & Mid$(term, x, 1)
        n = x
      Else
        zw = Mid$(term, x, n - x + 1)
        
        If InStr(zw, "-") > 0 Then
          e = DFA_Class_Meta(zw, 1)
          f1 = Left$(zw, e)
          
          If Mid$(zw, e + 1, 1) <> "-" Then
            Stop
          End If
          
          g = DFA_Class_Meta(zw, e + 2)
          f2 = Mid$(zw, e + 2, g - e - 1)
          
          If Left$(f1, 1) = "\" Then
            f1 = Chr$(val("&H" & Mid$(f1, 3) & "&"))
          End If
          
          If Left$(f1, 1) = "\" Then
            f1 = Chr$(val("&H" & Mid$(f1, 3) & "&"))
          End If
          
          If Asc(f1) > Asc(f2) Then
            temp = f1
            f1 = f2
            f2 = temp
          End If
          
          For e = Asc(f1) To Asc(f2)
            out = out & Chr$(e)
          Next e
        Else
          If Left$(zw, 1) = "\" Then
            Select Case Mid$(zw, 2, 1)
              Case "x": out = out & Chr$(val("&H" & Mid$(zw, 3) & "&"))
              Case "n": out = out & vbLf
              Case "r": out = out & vbCr
              Case "t": out = out & vbTab
              Case "w": out = out & _
                  "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUV" & _
                  "WXYZäöüÄÖÜß"
              Case "d": out = out & "0123456789"
              Case "s": out = out & " " & vbTab & vbLf
              Case "W"
                temp = _
                    "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRST" & _
                    "UVWXYZäöüÄÖÜß"
                For e = 0 To 255
                  If InStr(temp, Chr$(e)) = 0 Then
                    out = out & Chr$(e)
                  End If
                Next e
              Case "D"
                temp = "0123456789"
                For e = 0 To 255
                  If InStr(temp, Chr$(e)) = 0 Then
                    out = out & Chr$(e)
                  End If
                Next e
              Case "S"
                temp = " " & vbTab & vbLf
                For e = 0 To 255
                  If InStr(temp, Chr$(e)) = 0 Then
                    out = out & Chr$(e)
                  End If
                Next e
              Case Else
                out = out & Mid$(zw, 2, 1)
            End Select
          End If
        End If
      End If
      
      x = n + 1
    Loop
    
    Scan_Class = out
End Function
Private Sub AddSymbolToStream(x As Symbol)
    Output(cp_out) = x
    cp_out = cp_out + 1
    If cp_out > UBound(Output) Then
      ReDim Preserve Output(UBound(Output) * 2)
    End If
End Sub