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 LR_Parser.bas
Option ExplicitPrivate Output() As Symbol, cp_out As Long
Public Function Parse(x() As Symbol, endsymptr As Long) As Long
Dim i As Long, stack() As Long, c As Long, nextstate As Long
Dim l As Long, valstack() As Long, r As String, outptr As Long
Dim s_stack() As String, out As Symbol, end_s As Long
Const cn_ind As Long = 40
Output = x
cp_out = UBound(Output) + 2
SetSym out, BR_Open, "("
Insert_Sym Output, 0, out
ReDim Preserve Output(UBound(Output) * 2)
SetSym out, BR_Close, ")"
AddSymbolToStream out
SetSym out, Meta, "#"
endsymptr = cp_out
AddSymbolToStream out
SetSym out, Ende, "$"
end_s = cp_out
AddSymbolToStream out
ReDim stack(0), valstack(0), s_stack(0)
Static tran(0 To 10, 1 To 7) As Long, init As Boolean
Static jump(0, 0 To 10) As Long
Const ac As Long = 100
If Not init Then
SetRow tran, 0, 2, 0, 0, 0, 3, 4, 0
SetRow tran, 1, 2, 0, 7, 6, 3, 4, ac
SetRow tran, 2, 2, 0, 0, 0, 3, 4, 0
SetRow tran, 3, -6, -6, -6, -6, -6, -6, -6
SetRow tran, 4, -7, -7, -7, -7, -7, -7, -7
SetRow tran, 5, -2, -2, 7, -2, -2, -2, -2
SetRow tran, 6, 2, 0, 0, 0, 3, 4, 0
SetRow tran, 7, -4, -4, -4, -4, -4, -4, -4
SetRow tran, 8, 2, 10, 7, 6, 3, 4, 0
SetRow tran, 9, 2, -3, 7, 6, 3, 4, -3
SetRow tran, 10, -5, -5, -5, -5, -5, -5, -5
SetRow jump, 0, 1, 5, 8, 0, 0, 5, 9, 0, 5, 5, 0
init = True
End If
push stack, 0
push valstack, 0
push_s s_stack, "$"
i = 0: c = 0: nextstate = 0
r = lexcat(Output, i, end_s)
Debug.Print CStr(top(stack)), Trim$(Join(s_stack, "")),
If Len(r) <= cn_ind Then
Debug.Print Space(cn_ind - Len(r)) & r
Else
Debug.Print r
End If
Do While i <= UBound(Output)
c = Output(i).id
nextstate = tran(top(stack), c)
If nextstate = ac Then
Output(i - 1).id = Ende
Debug.Print "Akzeptiert"
Exit Do
ElseIf nextstate > 0 Then
push stack, nextstate
push valstack, i
push_s s_stack, Output(i).lexeme
r = lexcat(Output, i + 1, end_s)
Debug.Print CStr(top(stack)), Trim$(Join(s_stack, "")),
If Len(r) <= cn_ind Then
Debug.Print Space(cn_ind - Len(r)) & r
Else
Debug.Print r
End If
i = i + 1
ElseIf nextstate < 0 Then
ClearSym out
Select Case Abs(nextstate)
Case 1
Debug.Print "E' -> E"
l = 1: c = 0
outptr = top(valstack)
Case 2
Debug.Print "E -> E E"
l = 2: c = 0
SetSym out, Cat, "cat"
AddChild out, top1(valstack)
AddChild out, top(valstack)
outptr = cp_out
AddSymbolToStream out
Case 3
Debug.Print "E -> E or E"
l = 3: c = 0
outptr = top1(valstack)
AddChild Output(outptr), top2(valstack)
AddChild Output(outptr), top(valstack)
Case 4
Debug.Print "E -> E op"
l = 2: c = 0
outptr = top(valstack)
AddChild Output(outptr), top1(valstack)
Case 5
Debug.Print "E -> ( E )"
l = 3: c = 0
outptr = top1(valstack)
Case 6
Debug.Print "E -> meta"
l = 1: c = 0
outptr = top(valstack)
Case 7
Debug.Print "E -> char"
l = 1: c = 0
outptr = top(valstack)
Case Else
Debug.Print "Fehler beim Parser"
Exit Function
End Select
Do While l > 0: pop stack: pop valstack: pop_s s_stack: l _
= l - 1: Loop
push stack, jump(c, top(stack))
push valstack, outptr
push_s s_stack, "E"
r = lexcat(Output, i, end_s)
Debug.Print CStr(top(stack)), Trim$(Join(s_stack, "")),
If Len(r) <= cn_ind Then
Debug.Print Space(cn_ind - Len(r)) & r
Else
Debug.Print r
End If
Else
Debug.Print "Fehler aufgetreten"
Exit Function
End If
Loop
Parse = top(valstack)
x = Output
End Function
Public Sub SetRow(arr() As Long, row As Long, ParamArray t())
Dim i As Long
For i = LBound(arr, 2) To UBound(arr, 2)
arr(row, i) = CLng(t(i - LBound(arr, 2)))
Next i
End Sub
Private Sub push(arr() As Long, x As Long)
ReDim Preserve arr(UBound(arr) + 1)
arr(UBound(arr)) = x
End Sub
Private Sub pop(arr() As Long)
If UBound(arr) > 0 Then
ReDim Preserve arr(UBound(arr) - 1)
End If
End Sub
Private Function top(arr() As Long) As Long
top = arr(UBound(arr))
End Function
Private Function top1(arr() As Long) As Long
top1 = arr(UBound(arr) - 1)
End Function
Private Function top2(arr() As Long) As Long
top2 = arr(UBound(arr) - 2)
End Function
Private Sub push_n(arr() As Node, x As Node)
ReDim Preserve arr(UBound(arr) + 1)
Set arr(UBound(arr)) = x
End Sub
Private Sub pop_n(arr() As Node)
If UBound(arr) > 0 Then
ReDim Preserve arr(UBound(arr) - 1)
End If
End Sub
Private Function top_n(arr() As Node) As Node
Set top_n = arr(UBound(arr))
End Function
Private Function top1_n(arr() As Node) As Node
Set top1_n = arr(UBound(arr) - 1)
End Function
Private Function top2_n(arr() As Node) As Node
Set top2_n = arr(UBound(arr) - 2)
End Function
Public Sub push_s(arr() As String, x As String)
ReDim Preserve arr(UBound(arr) + 1)
arr(UBound(arr)) = x
End Sub
Public Sub pop_s(arr() As String)
If UBound(arr) > 0 Then
ReDim Preserve arr(UBound(arr) - 1)
End If
End Sub
Public Function OnStack_String(arr() As String, x As String) As _
Boolean
Dim i As Long
OnStack_String = False
For i = 0 To UBound(arr)
If arr(i) = x Then
OnStack_String = True: Exit Function
End If
Next i
End Function
Public Function lexcat(x() As Symbol, start As Long, Ende As _
Long) As String
Dim i As Long
For i = start To Ende
lexcat = lexcat & x(i).lexeme
Next i
End Function
Private Sub AddChild(x As Symbol, ptr As Long)
Dim i As Long
On Error Resume Next
i = x.Child(0)
If Err.Number <> 0 Then
Err.Clear
ReDim x.Child(0)
x.Child(0) = -1
End If
If Not (UBound(x.Child) = 0 And x.Child(0) = -1) Then
ReDim Preserve x.Child(UBound(x.Child) + 1)
End If
x.Child(UBound(x.Child)) = ptr
End Sub
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
Public Sub ClearSym(x As Symbol)
x.id = 0
x.lexeme = ""
ReDim x.attr(0)
ReDim x.Child(0)
x.Child(0) = -1
ReDim x.First(0)
x.First(0) = -1
ReDim x.Last(0)
x.Last(0) = -1
End Sub
Public Sub SetSym(x As Symbol, id As Sym_ID, lex As String)
x.id = id
x.lexeme = lex
End Sub
Public Sub AddAttr(x As Symbol, id As Sym_Attr_ID, val As Long)
Dim n As Long
On Error Resume Next
n = x.attr(0).val
If Err.Number <> 0 Then
ReDim x.attr(0)
Err.Clear
Else
If Not (UBound(x.attr) = 0 And x.attr(0).id = 0) Then
ReDim Preserve x.attr(UBound(x.attr) + 1)
End If
End If
x.attr(UBound(x.attr)).id = id
x.attr(UBound(x.attr)).val = val
End Sub
Public Sub SetAttr(x As Symbol, id As Sym_Attr_ID, val As Long)
Dim n As Long
On Error Resume Next
n = x.attr(0).val
If Err.Number <> 0 Then
Err.Clear
AddAttr x, id, val
Exit Sub
End If
For n = LBound(x.attr) To UBound(x.attr)
If x.attr(n).id = id Then
x.attr(n).val = val
Exit Sub
End If
Next n
AddAttr x, id, val
End Sub
Public Function FindAttr(x As Symbol, id As Sym_Attr_ID, attr As _
Sym_Attr) As Boolean
Dim i As Long
On Error Resume Next
i = x.attr(0).val
If Err.Number <> 0 Then
Err.Clear
FindAttr = False
attr.id = 0: attr.val = 0
Exit Function
End If
For i = LBound(x.attr) To UBound(x.attr)
If x.attr(i).id = id Then
attr = x.attr(i)
FindAttr = True
Exit Function
End If
Next i
FindAttr = False
End Function
Public Sub ChangeSym(x As Symbol, id As Sym_ID)
x.id = id
End Sub
Private Sub Insert_Sym(ByRef x() As Symbol, pos As Long, sym As _
Symbol)
Dim g As Long, e As Long
g = UBound(x)
ReDim Preserve x(g + 1)
For e = UBound(x) To pos + 1 Step -1
x(e) = x(e - 1)
Next e
x(pos) = sym
End Sub
Public Sub Test(x() As Symbol, ParamArray t())
Dim i As Long
ReDim x(Int(UBound(t) / 2))
For i = 0 To Int(UBound(t) / 2)
x(i).id = t(2 * i)
x(i).lexeme = t(2 * i + 1)
Next i
End Sub
