📄 cra.pas
字号:
END;
RETURN FALSE
END Match;
BEGIN
len := Length(str) - 1; (*strip quotes*)
RETURN Match(1, rootState)
END MatchesDFA;
}
PROCEDURE MatchDFA (str : STRING; sp : INTEGER; VAR matchedSp : INTEGER);
LABEL
999;
VAR
s, sto : INTEGER (*State*) ;
a : Action;
gn : CRTable.GraphNode;
i, len : INTEGER;
BEGIN (* s with quotes *)
s := rootState;
i := 2; len := Length(str);
WHILE TRUE DO BEGIN
(* try to match str against existing DFA *)
IF i = len THEN GOTO 999;
a := TheAction(stateArray[s], str[i]);
IF a = NIL THEN GOTO 999;
s := a^.target^.theState;
INC(i)
END;
999:
WHILE i < len DO BEGIN
(* make new DFA for str[i..len-1] *)
sto := NewState;
gn.typ := CRTable.chart;
gn.p1 := ORD(str[i]); gn.p2 := CRTable.normTrans;
NewTransition(s, gn, sto); s := sto;
INC(i)
END;
matchedSp := stateArray[s].endOf;
IF stateArray[s].endOf = CRTable.noSym THEN stateArray[s].endOf := sp;
END;
(* SplitActions Generate unique actions from two overlapping actions
-----------------------------------------------------------------------*)
PROCEDURE SplitActions (a, b : Action);
VAR
c : Action;
seta, setb, setc : CRTable.CRTSet;
PROCEDURE CombineTransCodes (t1, t2 : INTEGER; VAR result : INTEGER);
BEGIN
IF t1 = CRTable.contextTrans THEN result := t1 ELSE result := t2
END;
BEGIN
MakeSet(a, seta);
MakeSet(b, setb);
IF Sets.Equal(seta, setb)
THEN
BEGIN
AddTargetList(b^.target, a^.target);
DeleteTargetList(b^.target);
CombineTransCodes(a^.tc, b^.tc, a^.tc);
DetachAction(b, a);
DISPOSE(b);
END
ELSE IF Sets.Includes(seta, setb) THEN
BEGIN
setc := seta;
Sets.Differ(setc, setb);
AddTargetList(a^.target, b^.target);
CombineTransCodes(a^.tc, b^.tc, b^.tc);
ChangeAction(a, setc)
END
ELSE IF Sets.Includes(setb, seta) THEN
BEGIN
setc := setb;
Sets.Differ(setc, seta);
AddTargetList(b^.target, a^.target);
CombineTransCodes(a^.tc, b^.tc, a^.tc);
ChangeAction(b, setc)
END
ELSE
BEGIN
Sets.Intersect(seta, setb, setc);
Sets.Differ(seta, setc);
Sets.Differ(setb, setc);
ChangeAction(a, seta);
ChangeAction(b, setb);
NEW(c);
c^.target := NIL;
CombineTransCodes(a^.tc, b^.tc, c^.tc);
AddTargetList(a^.target, c^.target);
AddTargetList(b^.target, c^.target);
ChangeAction(c, setc);
AddAction(c, a)
END
END;
(* MakeUnique Make all actions in this state unique
-------------------------------------------------------------------------*)
PROCEDURE MakeUnique (s : INTEGER; VAR changed : BOOLEAN);
VAR
a, b : Action;
FUNCTION Overlap (a, b : Action) : BOOLEAN;
VAR
seta, setb : CRTable.CRTSet;
BEGIN
IF a^.typ = CRTable.chart
THEN
BEGIN
IF b^.typ = CRTable.chart
THEN BEGIN Overlap := a^.sym = b^.sym END
ELSE
BEGIN
CRTable.GetClass(b^.sym, setb);
Overlap := Sets.IsIn(setb, a^.sym)
END
END
ELSE
BEGIN
CRTable.GetClass(a^.sym, seta);
IF b^.typ = CRTable.chart
THEN BEGIN Overlap := Sets.IsIn(seta, b^.sym) END
ELSE
BEGIN
CRTable.GetClass(b^.sym, setb);
Overlap := NOT Sets.Different(seta, setb)
END
END
END;
BEGIN
a := stateArray[s].firstAction;
changed := FALSE;
WHILE a <> NIL DO BEGIN
b := a^.next;
WHILE b <> NIL DO BEGIN
IF Overlap(a, b)
THEN
BEGIN
SplitActions(a, b);
changed := TRUE; EXIT
(* originally no RETURN. FST blows up if we leave RETURN out.
Somewhere there is a field that is not properly set, but I
have not chased this down completely Fri 08-20-1993 *)
END;
b := b^.next;
END;
a := a^.next
END;
END;
(* MeltStates Melt states appearing with a shift of the same symbol
-----------------------------------------------------------------------*)
PROCEDURE MeltStates (s : INTEGER; VAR correct : BOOLEAN);
VAR
anAction : Action;
ctx : BOOLEAN;
endOf : INTEGER;
melt : Melted;
sset : CRTable.CRTSet;
s1 : INTEGER;
changed : BOOLEAN;
PROCEDURE AddMeltedSet (nr : INTEGER; VAR sset : CRTable.CRTSet);
VAR
m : Melted;
BEGIN
m := firstMelted;
WHILE (m <> NIL) AND (m^.theState <> nr) DO m := m^.next;
IF m = NIL THEN CRTable.Restriction( - 1, 0);
Sets.Unite(sset, m^.sset);
END;
PROCEDURE GetStateSet (t : Target; VAR sset : CRTable.CRTSet; VAR endOf : INTEGER;
VAR ctx : BOOLEAN);
(* Modified back to match Oberon version Fri 08-20-1993
This seemed to cause problems with some larger automata *)
(* new bug fix Wed 11-24-1993 from ETHZ incorporated *)
VAR
lastS : INTEGER;
BEGIN
Sets.Clear(sset); endOf := CRTable.noSym; ctx := FALSE;
lastS := lastState; (* Fri 08-20-1993 *)
WHILE t <> NIL DO BEGIN
IF t^.theState <= lastSimState
THEN Sets.Incl(sset, t^.theState)
ELSE AddMeltedSet(t^.theState, sset);
IF stateArray[t^.theState].endOf <> CRTable.noSym THEN
BEGIN
IF (endOf = CRTable.noSym) OR (endOf = stateArray[t^.theState].endOf)
THEN
BEGIN
endOf := stateArray[t^.theState].endOf;
lastS := t^.theState
END
ELSE
BEGIN
WriteLn(CRS.lst);
WriteLn(CRS.lst, 'Tokens ', endOf, ' and ',
stateArray[t^.theState].endOf, ' cannot be distinguished.');
correct := FALSE;
END;
END;
IF stateArray[t^.theState].ctx THEN
BEGIN
ctx := TRUE;
IF stateArray[t^.theState].endOf <> CRTable.noSym THEN
BEGIN
WriteLn(CRS.lst); WriteLn(CRS.lst, 'Ambiguous CONTEXT clause.');
correct := FALSE
END
END;
t := t^.next
END
END;
PROCEDURE FillWithActions (s : INTEGER; targ : Target);
VAR
anAction, a : Action;
BEGIN
WHILE targ <> NIL DO BEGIN
anAction := stateArray[targ^.theState].firstAction;
WHILE anAction <> NIL DO BEGIN
NEW(a);
a^ := anAction^;
a^.target := NIL;
AddTargetList(anAction^.target, a^.target);
AddAction(a, stateArray[s].firstAction);
anAction := anAction^.next
END;
targ := targ^.next
END;
END;
FUNCTION KnownMelted (sset : CRTable.CRTSet; VAR melt : Melted) : BOOLEAN;
BEGIN
melt := firstMelted;
WHILE melt <> NIL DO BEGIN
IF Sets.Equal(sset, melt^.sset) THEN BEGIN KnownMelted := TRUE; EXIT END;
melt := melt^.next
END;
KnownMelted := FALSE
END;
BEGIN
anAction := stateArray[s].firstAction;
WHILE anAction <> NIL DO BEGIN
IF anAction^.target^.next <> NIL THEN
BEGIN
GetStateSet(anAction^.target, sset, endOf, ctx);
IF NOT KnownMelted(sset, melt) THEN
BEGIN
s1 := NewState;
stateArray[s1].endOf := endOf;
stateArray[s1].ctx := ctx;
FillWithActions(s1, anAction^.target);
REPEAT
MakeUnique(s1, changed)
UNTIL NOT changed;
melt := NewMelted(sset, s1);
END;
DeleteTargetList(anAction^.target^.next);
anAction^.target^.next := NIL;
anAction^.target^.theState := melt^.theState
END;
anAction := anAction^.next
END
END;
(* MakeDeterministic Make NDFA --> DFA
------------------------------------------------------------------------*)
PROCEDURE MakeDeterministic (VAR correct : BOOLEAN);
VAR
s : INTEGER;
changed : BOOLEAN;
PROCEDURE FindCtxStates;
(* Find states reached by a context transition *)
VAR
a : Action;
s : INTEGER;
BEGIN
s := rootState;
WHILE s <= lastState DO BEGIN
a := stateArray[s].firstAction;
WHILE a <> NIL DO BEGIN
IF a^.tc = CRTable.contextTrans THEN
stateArray[a^.target^.theState].ctx := TRUE;
a := a^.next
END;
INC(s)
END;
END;
BEGIN
lastSimState := lastState;
FindCtxStates;
s := rootState;
WHILE s <= lastState DO BEGIN
REPEAT
MakeUnique(s, changed)
UNTIL NOT changed;
INC(s)
END;
correct := TRUE;
s := rootState;
WHILE s <= lastState DO BEGIN
MeltStates(s, correct);
INC(s)
END;
DeleteRedundantStates;
CombineShifts;
(* ==== IF CRTable.ddt["A"] THEN PrintStates END ==== *)
END;
(* GenComment Generate a procedure to scan comments
-------------------------------------------------------------------------*)
PROCEDURE GenComment (leftMarg : INTEGER; com : Comment);
PROCEDURE GenBody (leftMarg : INTEGER);
BEGIN
PutB(leftMarg); PutS('WHILE TRUE DO BEGIN$');
PutB(leftMarg + 2); PutS('IF ');
PutChCond(com^.stop[1]); PutS(' THEN BEGIN$');
IF Length(com^.stop) = 1
THEN
BEGIN
PutB(leftMarg + 4);
PutS('DEC(level); oldEols := curLine - startLine; NextCh;$');
PutB(leftMarg + 4);
PutS('IF level = 0 THEN BEGIN Comment := TRUE; GOTO 999; END;$');
END
ELSE
BEGIN
PutB(leftMarg + 4); PutS('NextCh;$');
PutB(leftMarg + 4); PutS('IF ');
PutChCond(com^.stop[2]); PutS(' THEN BEGIN$');
PutB(leftMarg + 6); PutS('DEC(level); NextCh;$');
PutB(leftMarg + 6);
PutS('IF level = 0 THEN BEGIN Comment := TRUE; GOTO 999; END$');
PutB(leftMarg + 4); PutS('END$');
END;
IF com^.nested
THEN
BEGIN
PutB(leftMarg + 2); PutS('END ELSE IF '); PutChCond(com^.start[1]);
PutS(' THEN BEGIN$');
IF Length(com^.start) = 1
THEN
BEGIN PutB(leftMarg + 4); PutS('INC(level); NextCh;$'); END
ELSE
BEGIN
PutB(leftMarg + 4); PutS('NextCh;$');
PutB(leftMarg + 4); PutS('IF '); PutChCond(com^.start[2]);
PutS(' THEN BEGIN '); PutS('INC(level); NextCh '); PutS('END$');
END;
END;
PutB(leftMarg + 2);
PutS('END ELSE IF ch = EF THEN BEGIN Comment := FALSE; GOTO 999; END$');
PutB(leftMarg + 2); PutS('ELSE NextCh;$');
PutB(leftMarg); PutS('END; (* WHILE TRUE *)$');
END;
BEGIN
PutS('IF '); PutChCond(com^.start[1]); PutS(' THEN BEGIN$');
IF Length(com^.start) = 1
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -